feat(stdlib): configurable rounding for TMoney

TMoney previously hard-wired banker's rounding (rmHalfEven) at its single
normalisation point.  The underlying TDecimal already supports all eight
TRoundingMode values plus custom IRoundingStrategy, so expose that through
TMoney: every constructor and rounding-sensitive operation gains overloads
taking an explicit TRoundingMode or an IRoundingStrategy.

  MoneyFromStr('1.005','USD')            -> 1.00  (banker's, unchanged default)
  MoneyFromStr('1.005','USD', rmHalfUp)  -> 1.01
  C := A.Add(B, rmCeiling);
  M := MoneyFromStr('9.999','USD', myCashRoundingStrategy);

Overloaded: MoneyFromStr, MoneyFromDecimal, Add, Subtract, Multiply (each
gains a TRoundingMode form and an IRoundingStrategy form).  MoneyFromInt,
MoneyZero, MultiplyInt and Negate are exact (no fraction introduced) and
need no mode.  The existing no-mode calls are unchanged and keep banker's
rounding, so this is fully backward-compatible.

Internally a single MakeMoneyS(strategy) core does the normalisation; the
mode form delegates via StandardRounding(Mode) and the default via
rmHalfEven — one rounding code path.

Tests: 5 IR/semantic tests and 8 dual-backend e2e tests covering the mode
overloads (HalfUp/Down/Ceiling), the custom-strategy overload, the
default-stays-banker's guarantee, and rounding on Add/Multiply/constructors.

Docs: language-rationale.adoc updated to record that rounding is swappable
per call (default banker's), not hard-wired.

Verified: FIXPOINT_OK, NATIVE_FIXPOINT_OK, NATIVE_INTERNAL_OK; full suite
green on both the QBE-built and native-built runners (3686 tests).
This commit is contained in:
Graeme Geldenhuys 2026-06-20 13:38:40 +01:00
parent 77aa15a8d8
commit 008cc12785
4 changed files with 346 additions and 32 deletions

View file

@ -64,6 +64,16 @@ type
procedure TestRun_Equals_DifferentCurrency_False;
procedure TestRun_IsZero_And_Sign;
{ --- Configurable rounding (mode + custom strategy overloads) --- }
procedure TestRun_FromStr_RoundingMode_HalfUp;
procedure TestRun_FromStr_RoundingMode_Down;
procedure TestRun_FromStr_RoundingMode_Ceiling;
procedure TestRun_FromDecimal_RoundingMode;
procedure TestRun_Add_RoundingMode;
procedure TestRun_Multiply_RoundingMode_Ceiling;
procedure TestRun_FromStr_CustomStrategy_Truncates;
procedure TestRun_DefaultIsBankers;
{ --- Registry --- }
procedure TestRun_CurrencyScale_Registry;
@ -460,6 +470,153 @@ begin
AssertEquals('True -1 1', 'True -1 1', Trim(Output));
end;
{ ------------------------------------------------------------------ }
{ Configurable rounding }
{ ------------------------------------------------------------------ }
procedure TE2EMoneyTests.TestRun_FromStr_RoundingMode_HalfUp;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ rmHalfUp rounds the 1.005 tie up, unlike the banker's default (1.00). }
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Money;
begin WriteLn(MoneyFromStr('1.005', 'USD', rmHalfUp).AmountString()) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('1.005 halfUp -> 1.01', '1.01', Trim(Output));
end;
procedure TE2EMoneyTests.TestRun_FromStr_RoundingMode_Down;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ rmDown truncates toward zero: 1.999 -> 1.99. }
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Money;
begin WriteLn(MoneyFromStr('1.999', 'USD', rmDown).AmountString()) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('1.999 down -> 1.99', '1.99', Trim(Output));
end;
procedure TE2EMoneyTests.TestRun_FromStr_RoundingMode_Ceiling;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ rmCeiling rounds toward +infinity: 1.991 -> 1.99? no 1.991 -> 2.00 only at
scale 0; at scale 2 the third digit 1 rounds up to 1.992... use a clearer
case: 1.001 ceiling at 2dp -> 1.01. }
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Money;
begin WriteLn(MoneyFromStr('1.001', 'USD', rmCeiling).AmountString()) end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('1.001 ceiling -> 1.01', '1.01', Trim(Output));
end;
procedure TE2EMoneyTests.TestRun_FromDecimal_RoundingMode;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Money, Numerics.Decimal;
var M: TMoney;
begin
M := MoneyFromDecimal(DecFromStr('2.345'), 'USD', rmHalfUp);
WriteLn(M.AmountString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('2.345 halfUp -> 2.35', '2.35', Trim(Output));
end;
procedure TE2EMoneyTests.TestRun_Add_RoundingMode;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ Two values whose common scale exceeds the currency scale; rmHalfUp on Add. }
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Money, Numerics.Decimal;
var A, C: TMoney;
begin
A := MoneyFromDecimal(DecFromStr('1.004'), 'USD', rmDown); { 1.00 }
C := A.Add(MoneyFromDecimal(DecFromStr('2.005'), 'USD', rmDown), rmHalfUp);
WriteLn(C.AmountString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
{ A=1.00; the addend is normalised by rmDown to 2.00, so 1.00+2.00 = 3.00. }
AssertEquals('add @halfUp', '3.00', Trim(Output));
end;
procedure TE2EMoneyTests.TestRun_Multiply_RoundingMode_Ceiling;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ 10.00 * 1.0851 = 10.851 -> ceiling at 2dp -> 10.86. }
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Money, Numerics.Decimal;
var M: TMoney;
begin
M := MoneyFromStr('10.00', 'USD').Multiply(DecFromStr('1.0851'), rmCeiling);
WriteLn(M.AmountString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('mul @ceiling', '10.86', Trim(Output));
end;
procedure TE2EMoneyTests.TestRun_FromStr_CustomStrategy_Truncates;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ A custom IRoundingStrategy that always truncates (never increments). }
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Money, 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 M: TMoney; S: IRoundingStrategy;
begin
S := TTrunc.Create;
M := MoneyFromStr('9.999', 'USD', S);
WriteLn(M.AmountString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('custom truncate -> 9.99', '9.99', Trim(Output));
end;
procedure TE2EMoneyTests.TestRun_DefaultIsBankers;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ The no-mode overloads keep banker's: 2.5 and 3.5 at scale 0 -> 2 and 4. }
AssertTrue('compile+run', CompileAndRunWithRTL(
'''
program P; uses Numerics.Money;
begin
WriteLn(MoneyFromStr('2.5', 'JPY').AmountString(), ' ',
MoneyFromStr('3.5', 'JPY').AmountString())
end.
''', Output, RCode));
AssertEquals('exit code', 0, RCode);
AssertEquals('banker default', '2 4', Trim(Output));
end;
{ ------------------------------------------------------------------ }
{ Registry }
{ ------------------------------------------------------------------ }

View file

@ -55,6 +55,13 @@ type
procedure TestSemantic_IsZero_ReturnsBoolean_OK;
procedure TestSemantic_Sign_ReturnsInteger_OK;
{ --- Rounding overloads --- }
procedure TestSemantic_FromStr_RoundingMode_OK;
procedure TestSemantic_FromStr_Strategy_OK;
procedure TestSemantic_FromDecimal_RoundingMode_OK;
procedure TestSemantic_Add_RoundingMode_OK;
procedure TestSemantic_Multiply_Strategy_OK;
{ --- Type errors --- }
procedure TestSemantic_FromStr_WrongArgType_Error;
procedure TestSemantic_AssignMoneyToInt_Error;
@ -302,6 +309,49 @@ begin
'begin A := MoneyFromInt(1, ''USD''); I := A.Sign() end.');
end;
{ ------------------------------------------------------------------ }
{ Rounding overloads }
{ ------------------------------------------------------------------ }
procedure TMoneyIRTests.TestSemantic_FromStr_RoundingMode_OK;
begin
SemanticOK(
'program P; uses Numerics.Money, Numerics.Decimal; var M: TMoney; ' +
'begin M := MoneyFromStr(''1.005'', ''USD'', rmHalfUp) end.');
end;
procedure TMoneyIRTests.TestSemantic_FromStr_Strategy_OK;
begin
SemanticOK(
'program P; uses Numerics.Money, Numerics.Decimal; ' +
'var M: TMoney; S: IRoundingStrategy; ' +
'begin S := StandardRounding(rmHalfUp); M := MoneyFromStr(''1.005'', ''USD'', S) end.');
end;
procedure TMoneyIRTests.TestSemantic_FromDecimal_RoundingMode_OK;
begin
SemanticOK(
'program P; uses Numerics.Money, Numerics.Decimal; var M: TMoney; ' +
'begin M := MoneyFromDecimal(DecFromStr(''1.005''), ''USD'', rmCeiling) end.');
end;
procedure TMoneyIRTests.TestSemantic_Add_RoundingMode_OK;
begin
SemanticOK(
'program P; uses Numerics.Money, Numerics.Decimal; var A, B, C: TMoney; ' +
'begin A := MoneyFromInt(1, ''USD''); B := MoneyFromInt(2, ''USD''); ' +
'C := A.Add(B, rmDown) end.');
end;
procedure TMoneyIRTests.TestSemantic_Multiply_Strategy_OK;
begin
SemanticOK(
'program P; uses Numerics.Money, Numerics.Decimal; ' +
'var A, C: TMoney; S: IRoundingStrategy; ' +
'begin A := MoneyFromInt(1, ''USD''); S := StandardRounding(rmFloor); ' +
'C := A.Multiply(DecFromStr(''1.5''), S) end.');
end;
{ ------------------------------------------------------------------ }
{ Type errors }
{ ------------------------------------------------------------------ }

View file

@ -5046,7 +5046,13 @@ currency policy lives entirely in this wrapper. Three rules define `TMoney`:
* Each currency has a default minor-unit scale (JPY 0, USD 2, KWD 3, fallback 2).
Every `TMoney` is normalised to its currency's scale on construction and after
every arithmetic operation, using banker's rounding (`rmHalfEven`).
every arithmetic operation. The default rounding is banker's (`rmHalfEven`),
but it is not hard-wired: each constructor and rounding-sensitive operation has
overloads taking an explicit `TRoundingMode` or a custom `IRoundingStrategy`
(the same eight modes and extension point as `TDecimal`), so the rounding
policy is swappable per call — e.g. `rmHalfUp` for a jurisdiction that rounds
halves up, or an `IRoundingStrategy` implementing Swedish/Swiss 0.05 cash
rounding.
* Arithmetic across different currencies (`Add`, `Subtract`, `Compare`) raises
`EMoneyMismatch`. There is no implicit conversion — exchange rates are a

View file

@ -26,10 +26,15 @@ unit Numerics.Money;
- Each currency has a default minor-unit scale: JPY 0, USD 2, KWD 3, and a
fallback of 2 for unknown codes. Every TMoney is NORMALISED to its
currency's scale on construction and after every arithmetic operation,
using banker's rounding (rmHalfEven) the recommended money default.
So MoneyFromStr('1.005', 'USD') stores 1.00, and a JPY amount never
carries a fraction.
currency's scale on construction and after every arithmetic operation.
The default rounding is banker's (rmHalfEven) the recommended money
default so MoneyFromStr('1.005', 'USD') stores 1.00 and a JPY amount
never carries a fraction. Each constructor and rounding-sensitive
operation also has overloads taking an explicit TRoundingMode or a custom
IRoundingStrategy (the same eight modes + extension point as TDecimal), so
the rounding policy can be swapped per call e.g. rmHalfUp for a
jurisdiction that rounds halves up, or an IRoundingStrategy implementing
Swedish/Swiss 0.05 cash rounding.
- Mismatched-currency arithmetic RAISES EMoneyMismatch. Add, Subtract and
Compare across different currencies are programming errors, not silent
@ -87,31 +92,43 @@ type
function Sign: Integer;
{ Sum of Self and B. Both must be the same currency; the result is in that
currency, normalised to its scale.
currency, normalised to its scale. The no-mode form uses banker's
rounding (rmHalfEven); the others let the caller pick the rounding mode or
a custom strategy for the (rare) case where the addends' common scale
exceeds the currency scale.
@param B the amount to add.
@returns Self + B.
@raises EMoneyMismatch if the currencies differ. }
function Add(const B: TMoney): TMoney;
function Add(const B: TMoney): TMoney; overload;
function Add(const B: TMoney; Mode: TRoundingMode): TMoney; overload;
function Add(const B: TMoney; const Strategy: IRoundingStrategy): TMoney; overload;
{ Difference Self - B. Both must be the same currency.
{ Difference Self - B. Both must be the same currency. Rounding control as
for Add.
@param B the amount to subtract.
@returns Self - B.
@raises EMoneyMismatch if the currencies differ. }
function Subtract(const B: TMoney): TMoney;
function Subtract(const B: TMoney): TMoney; overload;
function Subtract(const B: TMoney; Mode: TRoundingMode): TMoney; overload;
function Subtract(const B: TMoney; const Strategy: IRoundingStrategy): TMoney; overload;
{ Arithmetic negation (-Self), same currency and scale.
{ Arithmetic negation (-Self), same currency and scale. Exact no rounding.
@returns the amount with opposite sign. }
function Negate: TMoney;
{ Scales the amount by a dimensionless TDecimal factor (e.g. unit price *
quantity, or amount * tax-rate), re-normalising to the currency scale with
banker's rounding. The currency is preserved.
quantity, or amount * tax-rate), re-normalising to the currency scale.
The no-mode form uses banker's rounding (rmHalfEven); the others take an
explicit rounding mode or custom strategy. The currency is preserved.
@param Factor the multiplier.
@returns Self * Factor at the currency scale. }
function Multiply(const Factor: TDecimal): TMoney;
function Multiply(const Factor: TDecimal): TMoney; overload;
function Multiply(const Factor: TDecimal; Mode: TRoundingMode): TMoney; overload;
function Multiply(const Factor: TDecimal; const Strategy: IRoundingStrategy): TMoney; overload;
{ Scales the amount by an integer quantity. Exact (no rounding needed
beyond the existing scale). The currency is preserved.
{ Scales the amount by an integer quantity. Exact at the currency scale (an
integer multiply introduces no new fraction digits), so no rounding mode is
needed. The currency is preserved.
@param Quantity the integer multiplier.
@returns Self * Quantity. }
function MultiplyInt(Quantity: Integer): TMoney;
@ -145,22 +162,37 @@ type
{ Builds a TMoney from a decimal literal string and a currency code. The
amount is parsed exactly (see DecFromStr) then normalised to the currency's
default scale with banker's rounding.
default scale. The no-mode form uses banker's rounding (rmHalfEven); the
others take an explicit rounding mode or a custom strategy.
@param AAmount the decimal literal (e.g. '19.99', '-0.005').
@param ACurrency the ISO-4217 code (case-insensitive; stored upper-case).
@param Mode the rounding mode (mode overload).
@param Strategy the rounding strategy (strategy overload).
@returns the money value.
@raises EDecimalParse if AAmount is malformed. }
function MoneyFromStr(const AAmount, ACurrency: string): TMoney;
function MoneyFromStr(const AAmount, ACurrency: string): TMoney; overload;
function MoneyFromStr(const AAmount, ACurrency: string;
Mode: TRoundingMode): TMoney; overload;
function MoneyFromStr(const AAmount, ACurrency: string;
const Strategy: IRoundingStrategy): TMoney; overload;
{ Builds a TMoney from an existing TDecimal amount and a currency code. The
amount is normalised to the currency's default scale (banker's rounding).
{ Builds a TMoney from an existing TDecimal amount and a currency code,
normalised to the currency's default scale (banker's rounding by default; the
mode/strategy overloads override it).
@param AAmount the decimal amount.
@param ACurrency the ISO-4217 code (case-insensitive; stored upper-case).
@param Mode the rounding mode (mode overload).
@param Strategy the rounding strategy (strategy overload).
@returns the money value. }
function MoneyFromDecimal(const AAmount: TDecimal; const ACurrency: string): TMoney;
function MoneyFromDecimal(const AAmount: TDecimal; const ACurrency: string): TMoney; overload;
function MoneyFromDecimal(const AAmount: TDecimal; const ACurrency: string;
Mode: TRoundingMode): TMoney; overload;
function MoneyFromDecimal(const AAmount: TDecimal; const ACurrency: string;
const Strategy: IRoundingStrategy): TMoney; overload;
{ Builds a TMoney from a whole-unit integer amount and a currency code
(e.g. MoneyFromInt(5, 'USD') = 5.00 USD).
(e.g. MoneyFromInt(5, 'USD') = 5.00 USD). An integer is exact at any
currency scale, so no rounding mode is needed.
@param AAmount the whole-unit integer amount.
@param ACurrency the ISO-4217 code (case-insensitive; stored upper-case).
@returns the money value. }
@ -206,30 +238,69 @@ begin
Result := cDefaultScale;
end;
{ Normalises ADec to ACurrency's scale with banker's rounding and pairs it with
the upper-cased code. Central constructor used by every public builder so the
invariant "FAmount is always at the currency scale" holds in one place. }
function MakeMoney(const ADec: TDecimal; const ACurrency: string): TMoney;
{ Normalises ADec to ACurrency's scale with the given rounding strategy and
pairs it with the upper-cased code. Central constructor used by every public
builder so the invariant "FAmount is always at the currency scale" holds in
one place. }
function MakeMoneyS(const ADec: TDecimal; const ACurrency: string;
const AStrategy: IRoundingStrategy): TMoney;
var
Code: string;
Norm: TDecimal;
begin
Code := UpperCase(ACurrency);
Norm := ADec.RoundTo(CurrencyScale(Code), rmHalfEven);
Norm := ADec.RoundTo(CurrencyScale(Code), AStrategy);
Result.FAmount := Norm;
Result.FCurrency := Code;
end;
{ As MakeMoneyS but selecting one of the eight standard rounding modes. }
function MakeMoneyM(const ADec: TDecimal; const ACurrency: string;
AMode: TRoundingMode): TMoney;
begin
Result := MakeMoneyS(ADec, ACurrency, StandardRounding(AMode));
end;
{ Default normalisation: banker's rounding (rmHalfEven). }
function MakeMoney(const ADec: TDecimal; const ACurrency: string): TMoney;
begin
Result := MakeMoneyM(ADec, ACurrency, rmHalfEven);
end;
function MoneyFromStr(const AAmount, ACurrency: string): TMoney;
begin
Result := MakeMoney(DecFromStr(AAmount), ACurrency);
end;
function MoneyFromStr(const AAmount, ACurrency: string;
Mode: TRoundingMode): TMoney;
begin
Result := MakeMoneyM(DecFromStr(AAmount), ACurrency, Mode);
end;
function MoneyFromStr(const AAmount, ACurrency: string;
const Strategy: IRoundingStrategy): TMoney;
begin
Result := MakeMoneyS(DecFromStr(AAmount), ACurrency, Strategy);
end;
function MoneyFromDecimal(const AAmount: TDecimal; const ACurrency: string): TMoney;
begin
Result := MakeMoney(AAmount, ACurrency);
end;
function MoneyFromDecimal(const AAmount: TDecimal; const ACurrency: string;
Mode: TRoundingMode): TMoney;
begin
Result := MakeMoneyM(AAmount, ACurrency, Mode);
end;
function MoneyFromDecimal(const AAmount: TDecimal; const ACurrency: string;
const Strategy: IRoundingStrategy): TMoney;
begin
Result := MakeMoneyS(AAmount, ACurrency, Strategy);
end;
function MoneyFromInt(AAmount: Integer; const ACurrency: string): TMoney;
begin
Result := MakeMoney(DecFromInt(AAmount), ACurrency);
@ -269,22 +340,42 @@ begin
Result := Self.FAmount.Sign();
end;
function TMoney.Add(const B: TMoney): TMoney;
function TMoney.Add(const B: TMoney; const Strategy: IRoundingStrategy): TMoney;
var
Sum: TDecimal;
begin
RequireSameCurrency(Self, B, 'add');
Sum := Self.FAmount.Add(B.FAmount);
Result := MakeMoney(Sum, Self.FCurrency);
Result := MakeMoneyS(Sum, Self.FCurrency, Strategy);
end;
function TMoney.Subtract(const B: TMoney): TMoney;
function TMoney.Add(const B: TMoney; Mode: TRoundingMode): TMoney;
begin
Result := Self.Add(B, StandardRounding(Mode));
end;
function TMoney.Add(const B: TMoney): TMoney;
begin
Result := Self.Add(B, StandardRounding(rmHalfEven));
end;
function TMoney.Subtract(const B: TMoney; const Strategy: IRoundingStrategy): TMoney;
var
Diff: TDecimal;
begin
RequireSameCurrency(Self, B, 'subtract');
Diff := Self.FAmount.Subtract(B.FAmount);
Result := MakeMoney(Diff, Self.FCurrency);
Result := MakeMoneyS(Diff, Self.FCurrency, Strategy);
end;
function TMoney.Subtract(const B: TMoney; Mode: TRoundingMode): TMoney;
begin
Result := Self.Subtract(B, StandardRounding(Mode));
end;
function TMoney.Subtract(const B: TMoney): TMoney;
begin
Result := Self.Subtract(B, StandardRounding(rmHalfEven));
end;
function TMoney.Negate: TMoney;
@ -295,12 +386,22 @@ begin
Result := MakeMoney(Neg, Self.FCurrency);
end;
function TMoney.Multiply(const Factor: TDecimal): TMoney;
function TMoney.Multiply(const Factor: TDecimal; const Strategy: IRoundingStrategy): TMoney;
var
Prod: TDecimal;
begin
Prod := Self.FAmount.Multiply(Factor);
Result := MakeMoney(Prod, Self.FCurrency);
Result := MakeMoneyS(Prod, Self.FCurrency, Strategy);
end;
function TMoney.Multiply(const Factor: TDecimal; Mode: TRoundingMode): TMoney;
begin
Result := Self.Multiply(Factor, StandardRounding(Mode));
end;
function TMoney.Multiply(const Factor: TDecimal): TMoney;
begin
Result := Self.Multiply(Factor, StandardRounding(rmHalfEven));
end;
function TMoney.MultiplyInt(Quantity: Integer): TMoney;