Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

TDecimal fix

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-12 15:30:45 +02:00
parent d37862186c
commit 3c8be92b4a
4 changed files with 223 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Data/Myc.Data.Decimal.pas
+153 -70
View File
@@ -2,8 +2,6 @@ unit Myc.Data.Decimal;
interface
{$H+}
type
TScale = 0..7;
@@ -12,18 +10,18 @@ type
FValue: Int64;
public
constructor Create(AValue: Int64; AScale: TScale); overload;
constructor Create(AValue: Double; AScale: TScale); overload;
constructor Create(const AValue: TDecimal; ANewScale: TScale); overload;
class operator Add(const A, B: TDecimal): TDecimal;
class operator Subtract(const A, B: TDecimal): TDecimal;
class operator Add(const A, B: TDecimal): TDecimal; inline;
class operator Subtract(const A, B: TDecimal): TDecimal; inline;
class operator Multiply(const A, B: TDecimal): TDecimal;
class operator Divide(const A, B: TDecimal): TDecimal;
class operator Equal(const A, B: TDecimal): Boolean;
class operator NotEqual(const A, B: TDecimal): Boolean;
class operator Equal(const A, B: TDecimal): Boolean; inline;
class operator NotEqual(const A, B: TDecimal): Boolean; inline;
class operator Implicit(const A: Int64): TDecimal;
class operator Explicit(const A: TDecimal): Int64;
class operator Implicit(const A: Int64): TDecimal; inline;
class operator Explicit(const A: TDecimal): Double;
class function MinValue(AScale: TScale): TDecimal; static;
@@ -45,9 +43,11 @@ const
VALUE_BITS = 61;
SCALE_MASK = $07;
// Range of the 61-bit signed value part
MIN_VALUE_61BIT = -(1 shl 60);
MAX_VALUE_61BIT = (1 shl 60) - 1;
// CRITICAL FIX: Cast '1' to Int64 to force 64-bit constant evaluation.
MIN_VALUE_61BIT = -(Int64(1) shl 60);
MAX_VALUE_61BIT = (Int64(1) shl 60) - 1;
SIGN_BIT_61 = Int64(1) shl (VALUE_BITS - 1); // Bit 60 for sign check
RAW_VALUE_MASK = (Int64(1) shl VALUE_BITS) - 1; // Mask for bits 0..60
// Use a lookup table for powers of 10 for performance
PowersOf10: array[TScale] of Int64 = (1, 10, 100, 1000, 10000, 100000, 1000000, 10000000);
@@ -56,31 +56,30 @@ const
constructor TDecimal.Create(AValue: Int64; AScale: TScale);
begin
FValue := (Int64(AScale) shl VALUE_BITS) or (AValue and ((1 shl VALUE_BITS) - 1));
// Validate that the incoming value fits within the 61-bit storage.
if (AValue < MIN_VALUE_61BIT) or (AValue > MAX_VALUE_61BIT) then
raise EOverflow.Create('Value is out of range for a 61-bit TDecimal.');
FValue := (Int64(AScale) shl VALUE_BITS) or (AValue and RAW_VALUE_MASK);
end;
constructor TDecimal.Create(const AValue: TDecimal; ANewScale: TScale);
var
oldScale: TScale;
newValue: Int64;
scaleDiff: Integer;
i: Integer;
begin
// Create a new decimal by changing the scale of an existing one.
oldScale := AValue.GetScale;
newValue := AValue.GetValue;
var oldScale := AValue.GetScale;
if oldScale = ANewScale then
begin
FValue := AValue.FValue;
exit;
end;
scaleDiff := ANewScale - oldScale;
var newValue := AValue.GetValue;
var scaleDiff := ANewScale - oldScale;
if scaleDiff > 0 then
begin
// Increasing scale: multiply by 10^scaleDiff, checking for overflow at each step.
for i := 1 to scaleDiff do
for var i := 1 to scaleDiff do
begin
if newValue > (MAX_VALUE_61BIT div 10) then
raise EOverflow.Create('Decimal scale up resulted in an overflow.');
@@ -96,71 +95,158 @@ begin
end;
// Pack the new value and scale
FValue := (Int64(ANewScale) shl VALUE_BITS) or (newValue and ((1 shl VALUE_BITS) - 1));
FValue := (Int64(ANewScale) shl VALUE_BITS) or (newValue and RAW_VALUE_MASK);
end;
constructor TDecimal.Create(AValue: Double; AScale: TScale);
begin
// Scale the double by the specified scale and round it to the nearest integer.
// Round() will raise an exception if the value exceeds the Int64 range.
var intValue := Round(AValue * PowersOf10[AScale]);
// Check if the resulting value fits within the 61-bit storage.
if (intValue < MIN_VALUE_61BIT) or (intValue > MAX_VALUE_61BIT) then
raise EOverflow.Create('Double to TDecimal conversion resulted in an overflow.');
// Pack the value and scale into FValue.
FValue := (Int64(AScale) shl VALUE_BITS) or (intValue and RAW_VALUE_MASK);
end;
class operator TDecimal.Add(const A, B: TDecimal): TDecimal;
var
scale: TScale;
resultValue: Int64;
begin
scale := A.GetScale;
if scale <> B.GetScale then
raise EArgumentException.Create('Operands must have the same scale.');
var aScale := A.GetScale;
var bScale := B.GetScale;
resultValue := A.GetValue + B.GetValue;
Result := TDecimal.Create(resultValue, A.GetScale);
// Fast path for performance when scales are identical
if aScale = bScale then
begin
Result := TDecimal.Create(A.GetValue + B.GetValue, aScale);
exit;
end;
// Slower path for different scales: align scales before operation
if aScale > bScale then
begin
var scaledB := TDecimal.Create(B, aScale);
Result := TDecimal.Create(A.GetValue + scaledB.GetValue, aScale);
end
else
begin
var scaledA := TDecimal.Create(A, bScale);
Result := TDecimal.Create(scaledA.GetValue + B.GetValue, bScale);
end;
end;
class operator TDecimal.Subtract(const A, B: TDecimal): TDecimal;
var
scale: TScale;
resultValue: Int64;
begin
scale := A.GetScale;
if scale <> B.GetScale then
raise EArgumentException.Create('Operands must have the same scale.');
var aScale := A.GetScale;
var bScale := B.GetScale;
resultValue := A.GetValue - B.GetValue;
Result := TDecimal.Create(resultValue, scale);
// Fast path for performance when scales are identical
if aScale = bScale then
begin
Result := TDecimal.Create(A.GetValue - B.GetValue, aScale);
exit;
end;
// Slower path for different scales: align scales before operation
if aScale > bScale then
begin
var scaledB := TDecimal.Create(B, aScale);
Result := TDecimal.Create(A.GetValue - scaledB.GetValue, aScale);
end
else
begin
var scaledA := TDecimal.Create(A, bScale);
Result := TDecimal.Create(scaledA.GetValue - B.GetValue, bScale);
end;
end;
class operator TDecimal.Multiply(const A, B: TDecimal): TDecimal;
var
scale: TScale;
resultValue: Int64;
begin
scale := A.GetScale;
if scale <> B.GetScale then
raise EArgumentException.Create('Operands must have the same scale.');
var scaleA := A.GetScale;
var scaleB := B.GetScale;
var valA := A.GetValue;
var valB := B.GetValue;
resultValue := Trunc(A.GetValue * B.GetValue / PowersOf10[scale]);
Result := TDecimal.Create(resultValue, scale);
if scaleA = scaleB then
begin
// Fast path for performance when scales are identical
var resultValue := MulDivInt64(valA, valB, PowersOf10[scaleA]);
Result := TDecimal.Create(resultValue, scaleA);
end
else
begin
// Slower path for different scales
var targetScale := Max(scaleA, scaleB);
// Effective power of 10 to divide by is Min(scaleA, scaleB)
var scaleIndex := Min(scaleA, scaleB);
var resultValue := MulDivInt64(valA, valB, PowersOf10[scaleIndex]);
Result := TDecimal.Create(resultValue, targetScale);
end;
end;
class operator TDecimal.Divide(const A, B: TDecimal): TDecimal;
var
scale: TScale;
resultValue: Int64;
begin
scale := A.GetScale;
if scale <> B.GetScale then
raise EArgumentException.Create('Operands must have the same scale.');
if B.GetValue = 0 then
var bVal := B.GetValue;
if bVal = 0 then
raise EDivByZero.Create('Division by zero');
// Correctly scale the dividend to preserve precision
resultValue := Trunc(A.GetValue * PowersOf10[scale] / B.GetValue);
Result := TDecimal.Create(resultValue, scale);
var aVal := A.GetValue;
var aScale := A.GetScale;
var bScale := B.GetScale;
// Fast path for performance when scales are identical
if aScale = bScale then
begin
var multiplier := PowersOf10[aScale];
var resultValue := MulDivInt64(aVal, multiplier, bVal);
Result := TDecimal.Create(resultValue, aScale);
exit;
end;
// Slower path for different scales: align scales before operation
if aScale > bScale then
begin
var targetScale := aScale;
var tempB := TDecimal.Create(B, targetScale);
var multiplier := PowersOf10[targetScale];
var resultValue := MulDivInt64(aVal, multiplier, tempB.GetValue);
Result := TDecimal.Create(resultValue, targetScale);
end
else // bScale > aScale
begin
var targetScale := bScale;
var tempA := TDecimal.Create(A, targetScale);
var multiplier := PowersOf10[targetScale];
var resultValue := MulDivInt64(tempA.GetValue, multiplier, bVal);
Result := TDecimal.Create(resultValue, targetScale);
end;
end;
class operator TDecimal.Equal(const A, B: TDecimal): Boolean;
begin
if A.GetScale <> B.GetScale then
Result := False
else
var aScale := A.GetScale;
var bScale := B.GetScale;
// Fast path for identical scales
if aScale = bScale then
begin
Result := (A.GetValue = B.GetValue);
exit;
end;
// Slower path: align scales before comparing values
if aScale > bScale then
begin
var scaledB := TDecimal.Create(B, aScale);
Result := (A.GetValue = scaledB.GetValue);
end
else // bScale > aScale
begin
var scaledA := TDecimal.Create(A, bScale);
Result := (scaledA.GetValue = B.GetValue);
end;
end;
class operator TDecimal.NotEqual(const A, B: TDecimal): Boolean;
@@ -174,14 +260,11 @@ begin
Result := TDecimal.Create(A, 0);
end;
class operator TDecimal.Explicit(const A: TDecimal): Int64;
begin
Result := A.GetValue;
end;
class operator TDecimal.Explicit(const A: TDecimal): Double;
begin
Result := A.GetValue / PowersOf10[A.GetScale];
var scale := A.GetScale;
var value := A.GetValue;
Result := value / PowersOf10[scale];
end;
class function TDecimal.MaxValue(AScale: TScale): TDecimal;
@@ -198,10 +281,10 @@ function TDecimal.GetValue: Int64;
var
value: Int64;
begin
value := FValue and ((1 shl VALUE_BITS) - 1);
value := FValue and RAW_VALUE_MASK;
// Perform sign extension from 61 to 64 bits
if (value and (1 shl (VALUE_BITS - 1))) <> 0 then
Result := value or (not ((1 shl VALUE_BITS) - 1))
if (value and SIGN_BIT_61) <> 0 then
Result := value or (not RAW_VALUE_MASK)
else
Result := value;
end;
Src/Data/Myc.Data.Scalar.pas
+1 -1
View File
@@ -41,13 +41,13 @@ type
class function FromDateTime(AValue: TDateTime): TScalarValue; static; inline;
class function FromTimestamp(AValue: TTimestamp): TScalarValue; static; inline;
class function FromBoolean(AValue: Boolean): TScalarValue; static; inline;
class function FromDecimal(AValue: TDecimal): TScalarValue; static; inline;
class function FromChar(AValue: Char): TScalarValue; static; inline;
class function FromPChar(const AValue: String): TScalarValue; overload; static; inline;
class function FromPChar(const AValue: TScalarPChar): TScalarValue; overload; static; inline;
class function FromString(const AValue: String): TScalarValue; overload; static; inline;
class function FromString(const AValue: TScalarString): TScalarValue; overload; static; inline;
class function FromBytes(const AValue: TScalarBytes): TScalarValue; static; inline;
class function FromDecimal(AValue: TDecimal): TScalarValue; static; inline;
// Direct field access for performance.
case TScalarKind of
Src/Data/Myc.Data.Value.pas
+2 -3
View File
@@ -5,8 +5,7 @@ interface
uses
System.SysUtils,
Myc.Data.Scalar,
Myc.Data.Series,
Myc.Data.Decimal;
Myc.Data.Series;
type
TDataValueKind = (vkVoid, vkScalar, vkInterface, vkText, vkSeries, vkRecordSeries, vkRecord, vkMemberSeries, vkGeneric);
@@ -94,7 +93,7 @@ end;
function TDataValue.AsVal<T>: TVal<T>;
begin
if (FKind <> vkGeneric) then
raise EInvalidCast.Create('Cannot read value as ' + PTypeInfo(TypeInfo(T)).Name + '.');
raise EInvalidCast.Create('Cannot read value as ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
Result := TVal<T>(FInterface);
end;
Test/TestDataDecimal.pas
+67 -19
View File
@@ -14,6 +14,8 @@ type
[TestCase('Negative Numbers Add', '-100,0,-200,0,-300,0')]
[TestCase('Mixed Numbers Add', '-100,0,200,0,100,0')]
[TestCase('Zero Add', '0,0,0,0,0,0')]
[TestCase('Add Different Scales 1', '123,2,45,1,573,2')]
[TestCase('Add Different Scales 2', '45,1,123,2,573,2')]
[Test]
procedure TestAdd(const AValue1, AScale1, AValue2, AScale2: Int64; const AResultValue, AResultScale: Int64);
@@ -21,6 +23,7 @@ type
[TestCase('Negative Numbers Subtract', '-300,0,-200,0,-100,0')]
[TestCase('Mixed Numbers Subtract', '100,0,200,0,-100,0')]
[TestCase('Zero Subtract', '0,0,0,0,0,0')]
[TestCase('Subtract Different Scales', '573,2,45,1,123,2')]
[Test]
procedure TestSubtract(const AValue1, AScale1, AValue2, AScale2: Int64; const AResultValue, AResultScale: Int64);
@@ -28,31 +31,40 @@ type
[TestCase('Negative Numbers Multiply', '-10,1,-20,1,20,1')]
[TestCase('Mixed Numbers Multiply', '-10,1,20,1,-20,1')]
[TestCase('Zero Multiply', '10,1,0,1,0,1')]
[TestCase('Multiply Different Scales', '12,1,345,2,414,2')]
[Test]
procedure TestMultiply(const AValue1, AScale1, AValue2, AScale2: Int64; const AResultValue, AResultScale: Int64);
// This test case is moved to its own method to bypass a suspected DUnitX parser bug for large Int64 literals
[Test]
procedure TestMultiply_LargeNumbers;
[Test]
procedure TestDivide_LargeNumbers;
[TestCase('Positive Numbers Divide', '400,2,20,2,2000,2')]
[TestCase('Negative Numbers Divide', '-400,2,-20,2,2000,2')]
[TestCase('Mixed Numbers Divide', '-400,2,20,2,-2000,2')]
[TestCase('Zero Divide', '0,2,20,2,0,2')]
[TestCase('Divide Different Scales', '414,2,12,1,345,2')]
// Note: The large number division test might also fail due to the same parser bug.
// It can be moved to its own method as well if needed.
[TestCase('Divide Large Numbers', '120000000000000000,2,3000000000,2,4000000000,2')]
[Test]
procedure TestDivide(const AValue1, AScale1, AValue2, AScale2: Int64; const AResultValue, AResultScale: Int64);
[TestCase('Equality', '100,1,100,1')]
[TestCase('Equality Same Scale', '100,1,100,1')]
[TestCase('Equality Different Scales (1.2 = 1.20)', '12,1,120,2')]
[TestCase('Equality Different Scales (10.0 = 10.00)', '100,1,1000,2')]
[Test]
procedure TestEqual(const AValue1, AScale1, AValue2, AScale2: Int64);
[TestCase('Inequality', '100,1,200,1')]
[TestCase('Inequality Different Scale', '100,1,100,2')]
[TestCase('Inequality Same Scale', '100,1,200,1')]
[TestCase('Inequality Different Scales Not Equal', '12,1,121,2')]
[Test]
procedure TestNotEqual(const AValue1, AScale1, AValue2, AScale2: Int64);
[Test]
procedure TestImplicitConversion;
[Test]
procedure TestExplicitConversionToInt64;
[Test]
procedure TestExplicitConversionToDouble;
@@ -80,8 +92,8 @@ uses
const
// Expected boundary values for a 61-bit signed integer
MIN_VALUE_61BIT: Int64 = -(1 shl 60);
MAX_VALUE_61BIT: Int64 = (1 shl 60) - 1;
MIN_VALUE_61BIT: Int64 = -(Int64(1) shl 60);
MAX_VALUE_61BIT: Int64 = (Int64(1) shl 60) - 1;
{ TTestDecimal }
@@ -158,16 +170,6 @@ begin
Assert.AreEqual(decimalValue.GetScale, TScale(0), 'Implicit conversion should have scale 0');
end;
procedure TTestDecimal.TestExplicitConversionToInt64;
var
decimalValue: TDecimal;
intValue: Int64;
begin
decimalValue := TDecimal.Create(98765, TScale(3));
intValue := Int64(decimalValue);
Assert.AreEqual(intValue, Int64(98765), 'Explicit conversion to Int64 failed');
end;
procedure TTestDecimal.TestExplicitConversionToDouble;
var
decimalValue: TDecimal;
@@ -218,6 +220,52 @@ begin
Assert.WillRaise(procedure begin TDecimal.Create(d1, 1); end, EOverflow, 'EOverflow was expected on rescale.');
end;
procedure TTestDecimal.TestMultiply_LargeNumbers;
var
d1, d2, d3, expectedDecimal: TDecimal;
begin
// Test case with slightly smaller numbers to avoid compiler edge cases,
// but still large enough to require 128-bit intermediate multiplication.
// 30_000_000.00 * 20_000_000.00 = 600,000,000,000,000.00
var val1: Int64 := 3000000000;
var scale1: TScale := 2;
var val2: Int64 := 2000000000;
var scale2: TScale := 2;
var expectedVal: Int64 := 60000000000000000; // 6 * 10^16
var expectedScale: TScale := 2;
d1 := TDecimal.Create(val1, scale1);
d2 := TDecimal.Create(val2, scale2);
d3 := d1 * d2;
expectedDecimal := TDecimal.Create(expectedVal, expectedScale);
Assert.AreEqual(expectedDecimal.GetValue, d3.GetValue, 'Value mismatch');
Assert.AreEqual(expectedDecimal.GetScale, d3.GetScale, 'Scale mismatch');
Assert.IsTrue(expectedDecimal = d3, 'Decimal instances should be equal');
end;
procedure TTestDecimal.TestDivide_LargeNumbers;
var
d1, d2, d3, expectedDecimal: TDecimal;
begin
// Test case using large numbers for division.
// (6.0*10^14) / (3*10^7) = 2*10^7
var val1: Int64 := 60000000000000000;
var scale1: TScale := 2;
var val2: Int64 := 3000000000;
var scale2: TScale := 2;
var expectedVal: Int64 := 2000000000;
var expectedScale: TScale := 2;
d1 := TDecimal.Create(val1, scale1);
d2 := TDecimal.Create(val2, scale2);
d3 := d1 / d2;
expectedDecimal := TDecimal.Create(expectedVal, expectedScale);
Assert.IsTrue(expectedDecimal = d3, 'Decimal instances should be equal');
end;
initialization
TDUnitX.RegisterTestFixture(TTestDecimal);