administrator/blaise
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

feat(stdlib): add Numerics.Decimal — exact decimal (TDecimal)

Browse source 
A single exact base-10 decimal type for financial / exact-decimal use,
replacing the historical Currency/Comp/Extended proliferation with one type.

  - Construction: DecFromInt/Int64/Str, plus a safe/exact float split
    (DecFromFloat takes the shortest decimal — 0.1 stays 0.1 — while the
    dangerous binary-exact path is the explicitly-named DecFromFloatExact).
  - Value semantics + value-based equality: 2.0 = 2.00 with a consistent hash,
    so it is safe as a dictionary key (unlike Java BigDecimal).
  - Arithmetic: Add/Subtract (scale = max), Multiply (scale = sum), Negate, Abs,
    arbitrary precision via a decimal-digit magnitude (compact Int64 fast path
    inflating on overflow).
  - Division + rounding: a layered design — a TRoundingMode enum (8 modes,
    banker's default) over an IRoundingStrategy interface users can implement
    for custom rounding.  Division always carries an explicit scale + mode.
  - Formatting: ToString/ToPlainString never use scientific notation;
    StripTrailingZeros keeps integer zeros (600 stays 600, never 6E+2).
  - Conversions out: ToDouble (lossy), ToInt64 (truncating).

IR tests (32) + e2e tests (46).  Add/Subtract/Multiply and the value-semantics
run dual-backend; Divide/RoundTo and float conversion run QBE-only pending
native codegen fixes (logic verified on QBE; see bugs.txt).
This commit is contained in:
Graeme Geldenhuys 2026-06-19 16:41:23 +01:00
parent 13a8a39af0
commit 718ee45e20
6 changed files with 3105 additions and 41 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
compiler/src/test/pascal/TestRunner.pas
View file

@ -133,6 +133,8 @@ uses
cp.test.dynarray,
cp.test.math,
cp.test.e2e.math,
cp.test.numerics.decimal,
cp.test.e2e.numerics.decimal,
cp.test.streams,
cp.test.e2e.streams,
cp.test.e2e.dateutils,

914
compiler/src/test/pascal/cp.test.e2e.numerics.decimal.pas Normal file
View file

@ -0,0 +1,914 @@
{
Blaise - An Object Pascal Compiler
Copyright (c) 2026 Graeme Geldenhuys
SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
Licensed under the Apache License v2.0 with Runtime Library Exception.
See LICENSE file in the project root for full license terms.
}
unit cp.test.e2e.numerics.decimal;
{ E2E tests for the Numerics.Decimal stdlib unit (TDecimal).
These compile -> assemble -> link -> run real programs that use TDecimal and
assert on stdout/exit code, on BOTH backends (CompileAndRunWithRTL runs QBE
and native and requires parity). The IR-only harness cannot see RTL contract
or ABI issues, so the e2e layer is mandatory for this unit.
Phase 0 coverage: construction (DecFromInt / DecFromInt64 / DecFromStr),
ToString / ToPlainString (scale-preserving, never scientific), Scale, IsZero,
Sign. }
interface
uses
blaise.testing, cp.test.e2e.base;
type
[Threaded]
TE2EDecimalTests = class(TE2ETestCase)
protected
procedure SetUp; override;
published
{ --- Construction + ToString round-trips --- }
procedure TestRun_FromStr_RoundTrip_TwoDp;
procedure TestRun_FromStr_NegativeFraction;
procedure TestRun_FromStr_WholeNumber;
procedure TestRun_FromStr_LeadingZeroFraction;
procedure TestRun_FromStr_PreservesTrailingZeros;
procedure TestRun_FromStr_PlusSign;
{ --- Scale --- }
procedure TestRun_Scale_TwoDp;
procedure TestRun_Scale_WholeNumberIsZero;
{ --- IsZero / Sign --- }
procedure TestRun_IsZero_True;
procedure TestRun_IsZero_FalseForSmallFraction;
procedure TestRun_Sign_Negative;
procedure TestRun_Sign_PositiveAndZero;
{ --- Integer construction --- }
procedure TestRun_FromInt;
procedure TestRun_FromInt64_Large;
{ --- ToPlainString never scientific --- }
procedure TestRun_ToPlainString_NoExponent;
{ --- Value equality (the Java pitfall fix) --- }
procedure TestRun_Equals_DifferentScale_True;
procedure TestRun_Compare_OrdersByValue;
procedure TestRun_Compare_NegativeOrdering;
procedure TestRun_Hash_ValueEqualHashesMatch;
procedure TestRun_Equals_ZeroScaleInsensitive;
{ --- Arithmetic --- }
procedure TestRun_Add_SameScale;
procedure TestRun_Add_MixedScale_ResultMaxScale;
procedure TestRun_Subtract_Basic;
procedure TestRun_Subtract_ToNegative;
procedure TestRun_Negate;
procedure TestRun_Abs_Negative;
{ --- Multiply + arbitrary precision (dual-backend) --- }
procedure TestRun_Multiply_ScalesAdd;
procedure TestRun_Multiply_Squared;
procedure TestRun_Multiply_NegativeTimesPositive;
procedure TestRun_FromStr_LargeValue_RoundTrip;
procedure TestRun_Add_OverflowsInt64_Inflates;
procedure TestRun_Multiply_BigProduct;
{ --- Division + rounding (QBE-only: native Divide/RoundTo blocked by a
documented stack-corruption codegen bug; see bugs.txt) --- }
procedure TestRun_Divide_ExactToScale;
procedure TestRun_Divide_NonTerminating_HalfEven;
procedure TestRun_Divide_BankersRoundsToEven;
procedure TestRun_Divide_HalfUp;
procedure TestRun_RoundTo_HalfEven;
procedure TestRun_RoundTo_IncreaseScaleIsExact;
procedure TestRun_CustomStrategy_Truncates;
procedure TestRun_Divide_ByZero_Raises;
procedure TestRun_Money_TaxThenRound;
{ --- Float conversion + strip + out-conversions (QBE-only: native blocked
by the float-literal-to-managed-record-return and Divide/RoundTo
codegen bugs; see bugs.txt) --- }
procedure TestRun_DecFromFloat_Safe;
procedure TestRun_DecFromFloatExact_ShowsBinaryError;
procedure TestRun_StripTrailingZeros_Fraction;
procedure TestRun_StripTrailingZeros_KeepsIntegerZeros;
procedure TestRun_ToInt64_TruncatesTowardZero;
end;
implementation
procedure TE2EDecimalTests.SetUp;
begin
inherited SetUp();
SetUpScratch('compiler/target/test-e2e-numerics-decimal');
end;
{ ------------------------------------------------------------------ }
{ Construction + ToString round-trips }
{ ------------------------------------------------------------------ }
procedure TE2EDecimalTests.TestRun_FromStr_RoundTrip_TwoDp;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A: TDecimal;
begin A := DecFromStr('19.99'); WriteLn(A.ToString()) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('19.99', '19.99', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_FromStr_NegativeFraction;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A: TDecimal;
begin A := DecFromStr('-0.0001'); WriteLn(A.ToString()) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('-0.0001', '-0.0001', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_FromStr_WholeNumber;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A: TDecimal;
begin A := DecFromStr('600'); WriteLn(A.ToString()) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('600', '600', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_FromStr_LeadingZeroFraction;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A: TDecimal;
begin A := DecFromStr('0.50'); WriteLn(A.ToString()) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('0.50', '0.50', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_FromStr_PreservesTrailingZeros;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ Scale is retained for formatting; '4.0000' must NOT collapse to '4'. }
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A: TDecimal;
begin A := DecFromStr('4.0000'); WriteLn(A.ToString()) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('4.0000', '4.0000', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_FromStr_PlusSign;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A: TDecimal;
begin A := DecFromStr('+5'); WriteLn(A.ToString()) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('+5 -> 5', '5', Trim(Output));
end;
{ ------------------------------------------------------------------ }
{ Scale }
{ ------------------------------------------------------------------ }
procedure TE2EDecimalTests.TestRun_Scale_TwoDp;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A: TDecimal;
begin A := DecFromStr('19.99'); WriteLn(IntToStr(A.Scale())) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('scale of 19.99', '2', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Scale_WholeNumberIsZero;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A: TDecimal;
begin A := DecFromStr('42'); WriteLn(IntToStr(A.Scale())) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('scale of 42', '0', Trim(Output));
end;
{ ------------------------------------------------------------------ }
{ IsZero / Sign }
{ ------------------------------------------------------------------ }
procedure TE2EDecimalTests.TestRun_IsZero_True;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal, SysUtils;
var A: TDecimal;
begin A := DecFromInt(0); WriteLn(BoolToStr(A.IsZero(), True)) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('IsZero(0)', 'True', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_IsZero_FalseForSmallFraction;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal, SysUtils;
var A: TDecimal;
begin A := DecFromStr('0.0001'); WriteLn(BoolToStr(A.IsZero(), True)) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('IsZero(0.0001)', 'False', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Sign_Negative;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A: TDecimal;
begin A := DecFromInt64(-42); WriteLn(IntToStr(A.Sign())) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('Sign(-42)', '-1', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Sign_PositiveAndZero;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A, B: TDecimal;
begin
A := DecFromStr('3.14');
B := DecFromInt(0);
WriteLn(IntToStr(A.Sign()), ' ', IntToStr(B.Sign()))
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('Sign(+) Sign(0)', '1 0', Trim(Output));
end;
{ ------------------------------------------------------------------ }
{ Integer construction }
{ ------------------------------------------------------------------ }
procedure TE2EDecimalTests.TestRun_FromInt;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A: TDecimal;
begin A := DecFromInt(12345); WriteLn(A.ToString()) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('12345', '12345', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_FromInt64_Large;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A: TDecimal;
begin A := DecFromInt64(9223372036854775807); WriteLn(A.ToString()) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('max int64', '9223372036854775807', Trim(Output));
end;
{ ------------------------------------------------------------------ }
{ ToPlainString never scientific }
{ ------------------------------------------------------------------ }
procedure TE2EDecimalTests.TestRun_ToPlainString_NoExponent;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A: TDecimal;
begin A := DecFromStr('0.00007'); WriteLn(A.ToPlainString()) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('no exponent', '0.00007', Trim(Output));
end;
{ ------------------------------------------------------------------ }
{ Value equality (2.0 = 2.00) — the Java BigDecimal pitfall fix }
{ ------------------------------------------------------------------ }
procedure TE2EDecimalTests.TestRun_Equals_DifferentScale_True;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal, SysUtils;
var A, B: TDecimal;
begin
A := DecFromStr('2.0');
B := DecFromStr('2.00');
WriteLn(BoolToStr(A.Equals(B), True))
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('2.0 = 2.00', 'True', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Compare_OrdersByValue;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A, B: TDecimal;
begin
A := DecFromStr('2.0');
B := DecFromStr('2.5');
WriteLn(IntToStr(A.Compare(B)), ' ', IntToStr(B.Compare(A)), ' ',
IntToStr(A.Compare(A)))
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('lt gt eq', '-1 1 0', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Compare_NegativeOrdering;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A, B: TDecimal;
begin
A := DecFromStr('-1.5');
B := DecFromStr('-2.0');
WriteLn(IntToStr(A.Compare(B)))
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('-1.5 > -2.0', '1', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Hash_ValueEqualHashesMatch;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ Value-equal decimals must hash identically (safe as dictionary keys). }
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal, SysUtils;
var A, B: TDecimal;
begin
A := DecFromStr('2.0');
B := DecFromStr('2.00');
WriteLn(BoolToStr(A.GetHashCode() = B.GetHashCode(), True))
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('hash(2.0)=hash(2.00)', 'True', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Equals_ZeroScaleInsensitive;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal, SysUtils;
var A, B: TDecimal;
begin
A := DecFromStr('0.00');
B := DecFromInt(0);
WriteLn(BoolToStr(A.Equals(B), True))
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('0.00 = 0', 'True', Trim(Output));
end;
{ ------------------------------------------------------------------ }
{ Arithmetic }
{ ------------------------------------------------------------------ }
procedure TE2EDecimalTests.TestRun_Add_SameScale;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A, B, C: TDecimal;
begin
A := DecFromStr('19.99'); B := DecFromStr('0.01');
C := A.Add(B); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('19.99 + 0.01', '20.00', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Add_MixedScale_ResultMaxScale;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ Result scale is max of the two operand scales (the exact-arithmetic rule). }
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A, B, C: TDecimal;
begin
A := DecFromStr('10'); B := DecFromStr('3.5');
C := A.Add(B); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('10 + 3.5', '13.5', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Subtract_Basic;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A, B, C: TDecimal;
begin
A := DecFromStr('19.99'); B := DecFromStr('0.01');
C := A.Subtract(B); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('19.99 - 0.01', '19.98', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Subtract_ToNegative;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A, B, C: TDecimal;
begin
A := DecFromStr('1.5'); B := DecFromStr('2.25');
C := A.Subtract(B); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('1.5 - 2.25', '-0.75', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Negate;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A, C: TDecimal;
begin
A := DecFromStr('5.00'); C := A.Negate(); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('neg 5.00', '-5.00', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Abs_Negative;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A, C: TDecimal;
begin
A := DecFromStr('-7.25'); C := A.Abs(); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('abs -7.25', '7.25', Trim(Output));
end;
{ ------------------------------------------------------------------ }
{ Multiply + arbitrary precision (dual-backend) }
{ ------------------------------------------------------------------ }
procedure TE2EDecimalTests.TestRun_Multiply_ScalesAdd;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ Result scale = sum of operand scales: 2 + 2 = 4. }
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A, B, C: TDecimal;
begin
A := DecFromStr('19.99'); B := DecFromStr('0.20');
C := A.Multiply(B); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('19.99 * 0.20', '3.9980', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Multiply_Squared;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A, B, C: TDecimal;
begin
A := DecFromStr('1.5'); B := DecFromStr('1.5');
C := A.Multiply(B); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('1.5 * 1.5', '2.25', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Multiply_NegativeTimesPositive;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A, B, C: TDecimal;
begin
A := DecFromStr('-3'); B := DecFromStr('7');
C := A.Multiply(B); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('-3 * 7', '-21', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_FromStr_LargeValue_RoundTrip;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ 20 nines: exceeds Int64, must inflate and round-trip exactly. }
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A: TDecimal;
begin
A := DecFromStr('99999999999999999999'); WriteLn(A.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('20 nines', '99999999999999999999', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Add_OverflowsInt64_Inflates;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ 9e18 + 9e18 = 1.8e19 overflows Int64 and must inflate. }
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A, B, C: TDecimal;
begin
A := DecFromStr('9000000000000000000');
B := DecFromStr('9000000000000000000');
C := A.Add(B); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('9e18 + 9e18', '18000000000000000000', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Multiply_BigProduct;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Decimal;
var A, B, C: TDecimal;
begin
A := DecFromStr('1000000000000'); B := DecFromStr('1000000000000');
C := A.Multiply(B); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('1e12 * 1e12', '1000000000000000000000000', Trim(Output));
end;
{ ------------------------------------------------------------------ }
{ Division + rounding (QBE-only — see class note) }
{ ------------------------------------------------------------------ }
procedure TE2EDecimalTests.TestRun_Divide_ExactToScale;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTLQBEOnly(
'''
program P; uses Numerics.Decimal;
var A, B, C: TDecimal;
begin
A := DecFromStr('10'); B := DecFromStr('4');
C := A.Divide(B, 2, rmHalfEven); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('10/4 @2', '2.50', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Divide_NonTerminating_HalfEven;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ 1/3 never terminates — must round at the target scale, never throw. }
AssertTrue('compile+run', CompileAndRunWithRTLQBEOnly(
'''
program P; uses Numerics.Decimal;
var A, B, C: TDecimal;
begin
A := DecFromStr('1'); B := DecFromStr('3');
C := A.Divide(B, 4, rmHalfEven); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('1/3 @4', '0.3333', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Divide_BankersRoundsToEven;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ 2.5 -> 2 and 3.5 -> 4 under banker's rounding (ties to even). }
AssertTrue('compile+run', CompileAndRunWithRTLQBEOnly(
'''
program P; uses Numerics.Decimal;
var A, One, C: TDecimal;
begin
One := DecFromStr('1');
A := DecFromStr('2.5'); C := A.Divide(One, 0, rmHalfEven); Write(C.ToString(), ' ');
A := DecFromStr('3.5'); C := A.Divide(One, 0, rmHalfEven); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('2.5->2 3.5->4', '2 4', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Divide_HalfUp;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTLQBEOnly(
'''
program P; uses Numerics.Decimal;
var A, One, C: TDecimal;
begin
One := DecFromStr('1');
A := DecFromStr('2.5'); C := A.Divide(One, 0, rmHalfUp); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('2.5 half-up', '3', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_RoundTo_HalfEven;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTLQBEOnly(
'''
program P; uses Numerics.Decimal;
var A, C: TDecimal;
begin
A := DecFromStr('3.14159'); C := A.RoundTo(2, rmHalfEven); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('pi @2', '3.14', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_RoundTo_IncreaseScaleIsExact;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTLQBEOnly(
'''
program P; uses Numerics.Decimal;
var A, C: TDecimal;
begin
A := DecFromStr('1.5'); C := A.RoundTo(4, rmHalfEven); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('1.5 @4', '1.5000', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_CustomStrategy_Truncates;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ Inject a user IRoundingStrategy that always truncates: 2/3 @2 -> 0.66. }
AssertTrue('compile+run', CompileAndRunWithRTLQBEOnly(
'''
program P; uses Numerics.Decimal;
type
TTrunc = class(TObject, IRoundingStrategy)
function RoundIncrement(Negative: Boolean; LastKeptDigit: Integer;
DiscardedCompareHalf: Integer; AnyDiscarded: Boolean): Boolean;
end;
function TTrunc.RoundIncrement(Negative: Boolean; LastKeptDigit: Integer;
DiscardedCompareHalf: Integer; AnyDiscarded: Boolean): Boolean;
begin Result := False end;
var A, B, C: TDecimal; S: IRoundingStrategy;
begin
S := TTrunc.Create();
A := DecFromStr('2'); B := DecFromStr('3');
C := A.Divide(B, 2, S); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('2/3 truncated @2', '0.66', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_Divide_ByZero_Raises;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ Division by zero raises EDivByZero -> non-zero exit. }
AssertTrue('compile+run', CompileAndRunWithRTLQBEOnly(
'''
program P; uses Numerics.Decimal;
var A, B, C: TDecimal;
begin
A := DecFromStr('1'); B := DecFromStr('0');
C := A.Divide(B, 2, rmHalfEven); WriteLn(C.ToString())
end.
''', Output, RCode));
AssertTrue('nonzero exit on div-by-zero', RCode <> 0);
end;
procedure TE2EDecimalTests.TestRun_Money_TaxThenRound;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ 19.99 * 0.20 = 3.9980 exact; rounded to cents (banker's) = 4.00. }
AssertTrue('compile+run', CompileAndRunWithRTLQBEOnly(
'''
program P; uses Numerics.Decimal;
var Price, Rate, Tax, Rounded: TDecimal;
begin
Price := DecFromStr('19.99'); Rate := DecFromStr('0.20');
Tax := Price.Multiply(Rate);
Rounded := Tax.RoundTo(2, rmHalfEven);
WriteLn(Tax.ToString(), ' ', Rounded.ToString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('tax exact + rounded', '3.9980 4.00', Trim(Output));
end;
{ ------------------------------------------------------------------ }
{ Float conversion + strip + out-conversions (QBE-only) }
{ ------------------------------------------------------------------ }
procedure TE2EDecimalTests.TestRun_DecFromFloat_Safe;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ Safe conversion takes the shortest decimal: 0.1 stays 0.1 (the Java trap fix). }
AssertTrue('compile+run', CompileAndRunWithRTLQBEOnly(
'''
program P; uses Numerics.Decimal;
var A: TDecimal;
begin A := DecFromFloat(0.1); WriteLn(A.ToString()) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('safe 0.1', '0.1', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_DecFromFloatExact_ShowsBinaryError;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ The exact path exposes the binary tail — it must NOT equal a clean 0.1. }
AssertTrue('compile+run', CompileAndRunWithRTLQBEOnly(
'''
program P; uses Numerics.Decimal;
var A, Clean: TDecimal;
begin
A := DecFromFloatExact(0.1);
Clean := DecFromStr('0.1');
WriteLn(BoolToStr(A.Equals(Clean), True))
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('exact 0.1 <> clean 0.1', 'False', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_StripTrailingZeros_Fraction;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTLQBEOnly(
'''
program P; uses Numerics.Decimal;
var A, C: TDecimal;
begin A := DecFromStr('1.2300'); C := A.StripTrailingZeros(); WriteLn(C.ToString()) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('1.2300 stripped', '1.23', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_StripTrailingZeros_KeepsIntegerZeros;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ 600 must stay 600 (never 6E+2) — integer-part zeros are not stripped. }
AssertTrue('compile+run', CompileAndRunWithRTLQBEOnly(
'''
program P; uses Numerics.Decimal;
var A, C: TDecimal;
begin A := DecFromStr('600'); C := A.StripTrailingZeros(); WriteLn(C.ToString()) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('600 stays 600', '600', Trim(Output));
end;
procedure TE2EDecimalTests.TestRun_ToInt64_TruncatesTowardZero;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTLQBEOnly(
'''
program P; uses Numerics.Decimal;
var A: TDecimal;
begin
A := DecFromStr('42.99'); Write(Int64ToStr(A.ToInt64()), ' ');
A := DecFromStr('-7.5'); WriteLn(Int64ToStr(A.ToInt64()))
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('trunc toward zero', '42 -7', Trim(Output));
end;
initialization
RegisterTest(TE2EDecimalTests);
end.

451
compiler/src/test/pascal/cp.test.numerics.decimal.pas Normal file
View file

@ -0,0 +1,451 @@
{
Blaise - An Object Pascal Compiler
Copyright (c) 2026 Graeme Geldenhuys
SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
Licensed under the Apache License v2.0 with Runtime Library Exception.
See LICENSE file in the project root for full license terms.
}
unit cp.test.numerics.decimal;
{ IR-level tests for the Numerics.Decimal stdlib unit (TDecimal).
These resolve Numerics.Decimal via TUnitLoader, run the semantic pass, and
inspect the generated QBE IR. They cover the parser / semantic / codegen path
for TDecimal usage. They CANNOT see RTL-contract or runtime-behaviour issues —
those are covered by cp.test.e2e.numerics.decimal.pas.
Phase 0 surface: construction (DecFromInt / DecFromInt64 / DecFromStr),
ToString / ToPlainString, Scale, IsZero, Sign. }
interface
uses
blaise.testing, strutils,
uLexer, uParser, uAST, uSymbolTable, uSemantic, blaise.codegen.qbe, uUnitLoader;
type
TDecimalIRTests = class(TTestCase)
private
FRTLUnitPath: string;
FStdlibUnitPath: string;
function GenIR(const ASrc: string): string;
procedure SemanticOK(const ASrc: string);
procedure AnalyseExpectError(const ASrc: string);
function IRContains(const AIR, AFragment: string): Boolean;
protected
procedure SetUp; override;
published
{ --- Semantic resolution through the unit loader --- }
procedure TestSemantic_FromStr_OK;
procedure TestSemantic_FromInt_OK;
procedure TestSemantic_FromInt64_OK;
procedure TestSemantic_ToString_OK;
procedure TestSemantic_ToPlainString_OK;
procedure TestSemantic_Scale_ReturnsInteger_OK;
procedure TestSemantic_IsZero_ReturnsBoolean_OK;
procedure TestSemantic_Sign_ReturnsInteger_OK;
{ --- Comparison / equality / hash --- }
procedure TestSemantic_Compare_ReturnsInteger_OK;
procedure TestSemantic_Equals_ReturnsBoolean_OK;
procedure TestSemantic_GetHashCode_ReturnsInteger_OK;
{ --- Arithmetic (add/subtract/negate/abs) --- }
procedure TestSemantic_Add_ReturnsDecimal_OK;
procedure TestSemantic_Subtract_ReturnsDecimal_OK;
procedure TestSemantic_Negate_ReturnsDecimal_OK;
procedure TestSemantic_Abs_ReturnsDecimal_OK;
procedure TestSemantic_Multiply_ReturnsDecimal_OK;
procedure TestSemantic_FromStr_LargeValue_OK;
{ --- Division / rounding --- }
procedure TestSemantic_Divide_EnumMode_OK;
procedure TestSemantic_Divide_Strategy_OK;
procedure TestSemantic_RoundTo_EnumMode_OK;
procedure TestSemantic_SetScale_OK;
procedure TestSemantic_StandardRounding_ReturnsStrategy_OK;
procedure TestSemantic_CustomStrategy_OK;
{ --- Float conversion / strip / out-conversions --- }
procedure TestSemantic_DecFromFloat_OK;
procedure TestSemantic_DecFromFloatExact_OK;
procedure TestSemantic_StripTrailingZeros_OK;
procedure TestSemantic_ToDouble_ReturnsDouble_OK;
procedure TestSemantic_ToInt64_ReturnsInt64_OK;
{ --- Type errors --- }
procedure TestSemantic_FromInt_WrongArgType_Error;
procedure TestSemantic_AssignDecimalToInt_Error;
{ --- IR shape --- }
procedure TestIR_FromStr_EmitsCall;
procedure TestIR_MethodCall_EmitsCall;
end;
implementation
procedure TDecimalIRTests.SetUp;
var
ExeDir: string;
begin
inherited SetUp();
ExeDir := ExtractFilePath(ParamStr(0));
FRTLUnitPath := ExpandFileName(ExeDir + '../../runtime/src/main/pascal');
FStdlibUnitPath := ExpandFileName(ExeDir + '../../stdlib/src/main/pascal');
end;
function TDecimalIRTests.GenIR(const ASrc: string): string;
var
Lexer: TLexer;
Parser: TParser;
Prog: TProgram;
Semantic: TSemanticAnalyser;
CG: TCodeGenQBE;
Loader: TUnitLoader;
Units: TObjectList;
SearchPaths: TStringList;
I: Integer;
begin
Lexer := nil; Parser := nil; Prog := nil; Semantic := nil; CG := nil;
Loader := nil; Units := nil; SearchPaths := nil;
try
Lexer := TLexer.Create(ASrc);
Parser := TParser.Create(Lexer);
Prog := Parser.Parse();
Semantic := TSemanticAnalyser.Create();
SearchPaths := TStringList.Create();
SearchPaths.Add(FRTLUnitPath);
SearchPaths.Add(FStdlibUnitPath);
Loader := TUnitLoader.Create(SearchPaths);
Units := Loader.LoadAll(Prog.UsedUnits);
for I := 0 to Units.Count - 1 do
Semantic.AnalyseUnitForExport(TUnit(Units.Items[I]));
Semantic.Analyse(Prog);
CG := TCodeGenQBE.Create();
CG.SetSymbolTable(Prog.SymbolTable);
for I := 0 to Units.Count - 1 do
CG.AppendUnit(TUnit(Units.Items[I]));
CG.AppendProgram(Prog);
Result := CG.GetOutput();
finally
CG.Free(); Semantic.Free();
Units.Free(); Loader.Free(); SearchPaths.Free();
Prog.Free(); Parser.Free(); Lexer.Free();
end;
end;
procedure TDecimalIRTests.SemanticOK(const ASrc: string);
var
Lexer: TLexer;
Parser: TParser;
Prog: TProgram;
Semantic: TSemanticAnalyser;
Loader: TUnitLoader;
Units: TObjectList;
SearchPaths: TStringList;
I: Integer;
begin
Lexer := nil; Parser := nil; Prog := nil; Semantic := nil;
Loader := nil; Units := nil; SearchPaths := nil;
try
Lexer := TLexer.Create(ASrc);
Parser := TParser.Create(Lexer);
Prog := Parser.Parse();
Semantic := TSemanticAnalyser.Create();
SearchPaths := TStringList.Create();
SearchPaths.Add(FRTLUnitPath);
SearchPaths.Add(FStdlibUnitPath);
Loader := TUnitLoader.Create(SearchPaths);
Units := Loader.LoadAll(Prog.UsedUnits);
for I := 0 to Units.Count - 1 do
Semantic.AnalyseUnitForExport(TUnit(Units.Items[I]));
Semantic.Analyse(Prog);
finally
Semantic.Free();
Units.Free(); Loader.Free(); SearchPaths.Free();
Prog.Free(); Parser.Free(); Lexer.Free();
end;
end;
procedure TDecimalIRTests.AnalyseExpectError(const ASrc: string);
begin
try
SemanticOK(ASrc);
Fail('Expected ESemanticError');
except
on E: ESemanticError do ; { expected }
end;
end;
function TDecimalIRTests.IRContains(const AIR, AFragment: string): Boolean;
begin
Result := Pos(AFragment, AIR) >= 0;
end;
{ ------------------------------------------------------------------ }
{ Semantic resolution }
{ ------------------------------------------------------------------ }
procedure TDecimalIRTests.TestSemantic_FromStr_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A: TDecimal; ' +
'begin A := DecFromStr(''1.50'') end.');
end;
procedure TDecimalIRTests.TestSemantic_FromInt_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A: TDecimal; ' +
'begin A := DecFromInt(5) end.');
end;
procedure TDecimalIRTests.TestSemantic_FromInt64_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A: TDecimal; ' +
'begin A := DecFromInt64(5) end.');
end;
procedure TDecimalIRTests.TestSemantic_ToString_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A: TDecimal; S: string; ' +
'begin A := DecFromInt(5); S := A.ToString() end.');
end;
procedure TDecimalIRTests.TestSemantic_ToPlainString_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A: TDecimal; S: string; ' +
'begin A := DecFromInt(5); S := A.ToPlainString() end.');
end;
procedure TDecimalIRTests.TestSemantic_Scale_ReturnsInteger_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A: TDecimal; N: Integer; ' +
'begin A := DecFromStr(''1.50''); N := A.Scale() end.');
end;
procedure TDecimalIRTests.TestSemantic_IsZero_ReturnsBoolean_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A: TDecimal; B: Boolean; ' +
'begin A := DecFromInt(0); B := A.IsZero() end.');
end;
procedure TDecimalIRTests.TestSemantic_Sign_ReturnsInteger_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A: TDecimal; N: Integer; ' +
'begin A := DecFromInt(-3); N := A.Sign() end.');
end;
procedure TDecimalIRTests.TestSemantic_Compare_ReturnsInteger_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A, B: TDecimal; N: Integer; ' +
'begin A := DecFromStr(''2.0''); B := DecFromStr(''2.00''); ' +
'N := A.Compare(B) end.');
end;
procedure TDecimalIRTests.TestSemantic_Equals_ReturnsBoolean_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A, B: TDecimal; E: Boolean; ' +
'begin A := DecFromStr(''2.0''); B := DecFromStr(''2.00''); ' +
'E := A.Equals(B) end.');
end;
procedure TDecimalIRTests.TestSemantic_GetHashCode_ReturnsInteger_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A: TDecimal; H: Integer; ' +
'begin A := DecFromStr(''2.0''); H := A.GetHashCode() end.');
end;
procedure TDecimalIRTests.TestSemantic_Add_ReturnsDecimal_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A, B, C: TDecimal; ' +
'begin A := DecFromStr(''1.5''); B := DecFromStr(''2.25''); ' +
'C := A.Add(B) end.');
end;
procedure TDecimalIRTests.TestSemantic_Subtract_ReturnsDecimal_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A, B, C: TDecimal; ' +
'begin A := DecFromStr(''1.5''); B := DecFromStr(''2.25''); ' +
'C := A.Subtract(B) end.');
end;
procedure TDecimalIRTests.TestSemantic_Negate_ReturnsDecimal_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A, C: TDecimal; ' +
'begin A := DecFromStr(''5.00''); C := A.Negate() end.');
end;
procedure TDecimalIRTests.TestSemantic_Abs_ReturnsDecimal_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A, C: TDecimal; ' +
'begin A := DecFromStr(''-7.25''); C := A.Abs() end.');
end;
procedure TDecimalIRTests.TestSemantic_Multiply_ReturnsDecimal_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A, B, C: TDecimal; ' +
'begin A := DecFromStr(''19.99''); B := DecFromStr(''0.20''); ' +
'C := A.Multiply(B) end.');
end;
procedure TDecimalIRTests.TestSemantic_FromStr_LargeValue_OK;
begin
{ A 20+ digit literal exceeds Int64 and must still parse (inflated path). }
SemanticOK(
'program P; uses Numerics.Decimal; var A: TDecimal; S: string; ' +
'begin A := DecFromStr(''99999999999999999999''); S := A.ToString() end.');
end;
procedure TDecimalIRTests.TestSemantic_Divide_EnumMode_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A, B, C: TDecimal; ' +
'begin A := DecFromStr(''10''); B := DecFromStr(''4''); ' +
'C := A.Divide(B, 2, rmHalfEven) end.');
end;
procedure TDecimalIRTests.TestSemantic_Divide_Strategy_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A, B, C: TDecimal; S: IRoundingStrategy; ' +
'begin A := DecFromStr(''1''); B := DecFromStr(''3''); ' +
'S := StandardRounding(rmHalfUp); C := A.Divide(B, 4, S) end.');
end;
procedure TDecimalIRTests.TestSemantic_RoundTo_EnumMode_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A, C: TDecimal; ' +
'begin A := DecFromStr(''3.14159''); C := A.RoundTo(2, rmHalfEven) end.');
end;
procedure TDecimalIRTests.TestSemantic_SetScale_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A, C: TDecimal; ' +
'begin A := DecFromStr(''1.5''); C := A.SetScale(4, rmHalfEven) end.');
end;
procedure TDecimalIRTests.TestSemantic_StandardRounding_ReturnsStrategy_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var S: IRoundingStrategy; ' +
'begin S := StandardRounding(rmHalfEven) end.');
end;
procedure TDecimalIRTests.TestSemantic_CustomStrategy_OK;
begin
{ A user class implementing IRoundingStrategy must satisfy the interface. }
SemanticOK(
'program P; uses Numerics.Decimal;' +
'type TMy = class(TObject, IRoundingStrategy)' +
' function RoundIncrement(Negative: Boolean; LastKeptDigit: Integer;' +
' DiscardedCompareHalf: Integer; AnyDiscarded: Boolean): Boolean;' +
'end;' +
'function TMy.RoundIncrement(Negative: Boolean; LastKeptDigit: Integer;' +
' DiscardedCompareHalf: Integer; AnyDiscarded: Boolean): Boolean;' +
'begin Result := False end;' +
'var A, B, C: TDecimal; S: IRoundingStrategy;' +
'begin S := TMy.Create(); A := DecFromStr(''1''); B := DecFromStr(''3'');' +
'C := A.Divide(B, 4, S) end.');
end;
procedure TDecimalIRTests.TestSemantic_DecFromFloat_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A: TDecimal; D: Double; ' +
'begin D := 0.1; A := DecFromFloat(D) end.');
end;
procedure TDecimalIRTests.TestSemantic_DecFromFloatExact_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A: TDecimal; D: Double; ' +
'begin D := 0.1; A := DecFromFloatExact(D) end.');
end;
procedure TDecimalIRTests.TestSemantic_StripTrailingZeros_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A, C: TDecimal; ' +
'begin A := DecFromStr(''4.0000''); C := A.StripTrailingZeros() end.');
end;
procedure TDecimalIRTests.TestSemantic_ToDouble_ReturnsDouble_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A: TDecimal; D: Double; ' +
'begin A := DecFromStr(''3.14''); D := A.ToDouble() end.');
end;
procedure TDecimalIRTests.TestSemantic_ToInt64_ReturnsInt64_OK;
begin
SemanticOK(
'program P; uses Numerics.Decimal; var A: TDecimal; N: Int64; ' +
'begin A := DecFromStr(''42.99''); N := A.ToInt64() end.');
end;
{ ------------------------------------------------------------------ }
{ Type errors }
{ ------------------------------------------------------------------ }
procedure TDecimalIRTests.TestSemantic_FromInt_WrongArgType_Error;
begin
{ DecFromInt expects an integer, not a string. }
AnalyseExpectError(
'program P; uses Numerics.Decimal; var A: TDecimal; ' +
'begin A := DecFromInt(''x'') end.');
end;
procedure TDecimalIRTests.TestSemantic_AssignDecimalToInt_Error;
begin
{ A TDecimal value is not assignable to an Integer. }
AnalyseExpectError(
'program P; uses Numerics.Decimal; var A: TDecimal; N: Integer; ' +
'begin A := DecFromInt(5); N := A end.');
end;
{ ------------------------------------------------------------------ }
{ IR shape }
{ ------------------------------------------------------------------ }
procedure TDecimalIRTests.TestIR_FromStr_EmitsCall;
var IR: string;
begin
IR := GenIR(
'program P; uses Numerics.Decimal; var A: TDecimal; ' +
'begin A := DecFromStr(''1.50'') end.');
AssertTrue('emits DecFromStr call',
IRContains(IR, 'DecFromStr'));
end;
procedure TDecimalIRTests.TestIR_MethodCall_EmitsCall;
var IR: string;
begin
IR := GenIR(
'program P; uses Numerics.Decimal; var A: TDecimal; N: Integer; ' +
'begin A := DecFromInt(7); N := A.Sign() end.');
AssertTrue('emits TDecimal_Sign call',
IRContains(IR, 'Sign'));
end;
initialization
RegisterTest(TDecimalIRTests);
end.

63
docs/future-improvements.adoc
View file

@ -180,53 +180,34 @@ local record variables at scope exit.
== StdLib Packages — Numeric Types
=== `Currency` and `BigDecimal` as StdLib units
The exact-decimal type itself (`TDecimal` in `Numerics.Decimal`) is implemented;
the design decision — one `TDecimal`, no separate `Currency`/`BigDecimal` — is
recorded in `docs/language-rationale.adoc` ("Decimal Arithmetic — One `TDecimal`,
No `Currency` Primitive"). The following numeric items remain genuinely future
work.
*What.* Two numeric types useful in financial and high-precision contexts that
were deliberately omitted from the Blaise primitive type set:
=== `Numerics.Money` — currency-aware wrapper
* `Currency` — a fixed-point decimal type represented as a 64-bit integer
scaled by 10,000. Exact decimal arithmetic with four decimal places;
fast (integer operations), bounded range (~±922 trillion). Equivalent to
Delphi's `Currency` type.
A thin type layering currency onto `TDecimal`: a `TMoney` carrying an amount plus
an ISO-4217 currency tag, with mismatched-currency arithmetic raising and a
per-currency default scale (JPY 0, USD 2, KWD 3). This is the universal pattern —
Moneta (Java), the `money` gem (Ruby) and `rusty-money` (Rust) all wrap a decimal
rather than baking currency into the numeric core. Deferred so currency/locale
policy stays out of `TDecimal`.
* `BigDecimal` — arbitrary-precision decimal arithmetic, heap-allocated.
Exact representation of any decimal value; no rounding error. Equivalent
to Java's `java.math.BigDecimal`.
=== Operator overloading for `TDecimal`
*Why deferred.* Both are library-level concerns, not compiler primitives. The
string-type consolidation precedent (all string variants → a single `string`)
applies equally here: the proliferation of `Currency`, `Comp`, `Extended`, and
`Real` came from hardware limitations and legacy concerns that no longer apply.
Blaise's two float primitives (`Double` and `Single`) cover the vast majority
of numeric use cases.
`TDecimal` currently exposes arithmetic as named methods (`A.Add(B)`,
`A.Multiply(B)`, `A.Divide(B, Scale, Mode)`) because operator overloading is not
yet a language feature. Once it lands, `A + B` / `A * B` / comparisons can layer
on additively (division stays a named method — it requires an explicit scale and
rounding mode). Operator overloading is a compiler feature in its own right and
warrants a separate design document.
*Where they belong.* Once the StdLib (`stdlib/`) exists:
=== Migration-analyser rule for legacy numeric types
* `numerics.fixed` — `TFixedDecimal` (Currency semantics, operator
overloading, 4 decimal places).
* `numerics.bigdecimal` — `TBigDecimal` (arbitrary precision, operator
overloading).
With operator overloading, both types will look like builtins from user code:
[source,pascal]
----
uses numerics.fixed;
var Price, Tax: TFixedDecimal;
begin
Price := TFixedDecimal.FromStr('19.99');
Tax := Price * TFixedDecimal.FromStr('0.20');
WriteLn(Tax.ToString); { '4.0000' }
end.
----
*Migration path from FPC.* The migration analyser (future phase) will flag
`Currency` and `Comp` types and suggest `TFixedDecimal` or `TBigDecimal` as
replacements. `Extended` maps to `Double` with a precision-loss warning.
*Effort.* Medium — primarily RTL/stdlib work once operator overloading is in place.
No compiler changes needed.
The migration analyser should flag FPC/Delphi `Currency` and `Comp` and suggest
`TDecimal`; `Extended` maps to `Double` with a precision-loss warning.
== StdLib — String operations

70
docs/language-rationale.adoc
View file

@ -4958,3 +4958,73 @@ suspected internal-assembler or internal-linker defect:
The default native build emits a single whole-program object; `--incremental`
opts in to per-unit object emission with a warm cache.
== Decimal Arithmetic — One `TDecimal`, No `Currency` Primitive
=== Decision
Exact decimal arithmetic is provided by a single StdLib type, `TDecimal`
(`Numerics.Decimal`), not by a compiler primitive and not by a family of types.
There is deliberately no fixed-point `Currency`/`Comp` type and no separate
`BigDecimal`; the one `TDecimal` serves money, billing, tax and every other
exact-decimal need. Scientific and engineering computation is explicitly out of
scope for `TDecimal` and remains the domain of `Double` and the `Math` unit.
`TDecimal` is a value-type record holding an unsigned magnitude, a signed scale,
and a sign, with a compact `Int64` fast path that inflates to an arbitrary-
precision decimal-digit magnitude only when a value exceeds `Int64` range.
Equality is value-based: `2.0` and `2.00` are equal and hash identically.
=== Rationale
The string-consolidation precedent applies directly. Just as Blaise replaced
the `string`/`AnsiString`/`WideString`/`ShortString` family with one `string`,
it replaces the `Currency`/`Comp`/`Extended`/`Real` numeric proliferation — which
came from hardware limitations and legacy concerns that no longer apply — with
one exact-decimal type plus the two float primitives (`Double`, `Single`).
The single-type choice matches the dominant industry pattern. .NET (`decimal`),
Swift (`Decimal`), Rust (`rust_decimal`) and Python (`decimal.Decimal`) each ship
exactly one decimal type and treat "money" as decimal + a currency tag in a
separate library layer. Java is the outlier in having no built-in money type at
all (`java.util.Currency` is only an ISO-4217 descriptor); `BigDecimal` is its
de-facto money type, and even Java has no second fixed type.
A value-type record gives immutable value semantics without Java `BigDecimal`'s
per-operation heap garbage: the common money case lives entirely in the inline
`Int64` and allocates nothing, while still presenting a pure, immutable API.
The design deliberately fixes the well-known `BigDecimal` pitfalls: value-based
equality (so the type is safe in hash containers), a safe-by-default float
constructor (`DecFromFloat` takes the shortest decimal; the binary-exact path is
the explicitly-named `DecFromFloatExact`), mandatory explicit rounding on every
division (no throw-on-`1/3` and no silent truncation), and plain-string
formatting that never emits scientific notation.
Rounding is injected through a layered design — a `TRoundingMode` enum for the
eight standard modes (banker's rounding the default) over an `IRoundingStrategy`
interface for custom algorithms — so jurisdiction-specific rules (e.g. cash
rounding) need no change to the library.
=== Alternatives considered
* *A fixed-point `Currency` type (Int64 scaled by 10000), as in Delphi/FPC.*
Rejected as a separate type. Hard-coding four decimal places is a footgun
(JPY has zero, crypto/FX want eight), and a hidden `*10000` representation
invites scale confusion. Its one virtue — speed — is captured instead by the
compact `Int64` fast path inside the single `TDecimal`, with no second type
and no cross-type conversion friction.
* *A separate arbitrary-precision `BigDecimal` alongside `Currency`.* Rejected.
Two types double the API surface and force conversions at their boundary for
no functional gain; one type with an internal fast path covers both roles.
* *Making `TDecimal` cover scientific use too.* Rejected. Scientific work wants
hardware floating point and transcendental functions over irrational results,
where exact decimal representation is impossible and pointless. `Double` +
`Math` already serve this; `TDecimal` ships no such functions.
* *Baking currency (ISO-4217) into the numeric core.* Deferred to a future
`Numerics.Money` wrapper. Currency is a policy layer (which currencies, how to
format, per-jurisdiction rounding) that should not be frozen into the numeric
type — matching Moneta / money-gem / rusty-money, which all wrap a decimal.

1646
stdlib/src/main/pascal/numerics.decimal.pas Normal file
View file

File diff suppressed because it is too large Load diff