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;