paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 05:49:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Applies patch from Laco (bug ID 29113)

Browse Source 
git-svn-id: trunk@32723 -
This commit is contained in:
michael 2015-12-26 11:27:13 +00:00
parent dcefe41fe3
commit 464e40bfd9
1 changed files with 27 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
tests/test/units/fmtbcd/tfmtbcd.pp
View File

@ -9,9 +9,23 @@ var
FS, DFS: TFormatSettings; FS, DFS: TFormatSettings;
bcd: TBCD; bcd: TBCD;
procedure testBCDSubtract(bcd1,bcd2,bcd3: TBCD);
var bcdsub: TBCD;
begin
bcdsub:=0;
BCDSubtract(bcd1,bcd2,bcdsub);
if (BCDCompare(bcd3,bcdsub) <> 0) or
(bcdtostr(bcd3) <> bcdtostr(bcdsub)) then
begin
writeln(bcdtostr(bcd1), ' - ', bcdtostr(bcd2), ' = ', bcdtostr(bcdsub), ' but expected ', bcdtostr(bcd3));
inc(ErrorCount);
end;
end;
procedure testBCDMultiply(bcd1,bcd2,bcd3: TBCD); procedure testBCDMultiply(bcd1,bcd2,bcd3: TBCD);
var bcdmul: TBCD; var bcdmul: TBCD;
begin begin
bcdmul:=0;
BCDMultiply(bcd1,bcd2,bcdmul); BCDMultiply(bcd1,bcd2,bcdmul);
if (BCDCompare(bcd3,bcdmul) <> 0) or if (BCDCompare(bcd3,bcdmul) <> 0) or
(bcdtostr(bcd3) <> bcdtostr(bcdmul)) then (bcdtostr(bcd3) <> bcdtostr(bcdmul)) then
@ -97,10 +111,12 @@ begin
end; end;
procedure testBCDCompare(bcd1,bcd2: TBCD; res: integer); procedure testBCDCompare(bcd1,bcd2: TBCD; res: integer);
var ret: integer;
begin begin
if (BCDCompare(bcd1,bcd2) <> res) then ret := BCDCompare(bcd1,bcd2);
if ret <> res then
begin begin
writeln('BCDCompare failed; bcd1:', bcdtostr(bcd1), ' bcd2:', bcdtostr(bcd2)); writeln('BCDCompare failed; bcd1:', bcdtostr(bcd1), ' bcd2:', bcdtostr(bcd2), ' returned ', ret, ' but expected ', res);
inc(ErrorCount); inc(ErrorCount);
end; end;
end; end;
@ -108,6 +124,7 @@ end;
procedure testNormalizeBCD(const input, expected: string; Precision,Places: integer; res: boolean); procedure testNormalizeBCD(const input, expected: string; Precision,Places: integer; res: boolean);
var outBcd: TBCD; var outBcd: TBCD;
begin begin
outBcd:=0;
if NormalizeBCD(StrToBCD(input,FS), outBcd, Precision, Places) <> res then if NormalizeBCD(StrToBCD(input,FS), outBcd, Precision, Places) <> res then
begin begin
writeln('NormalizeBCD for ', input, ' returned ', not res, ' but expected ', res); writeln('NormalizeBCD for ', input, ' returned ', not res, ' but expected ', res);
@ -246,12 +263,15 @@ begin
testBCDPrecScale('1001.1001', 8, 4); testBCDPrecScale('1001.1001', 8, 4);
// test BCDToCurr: // test BCDToCurr:
testBCDToCurr( '922337203685477.5807', MaxCurrency); // test boundary values testBCDToCurr( '922337203685477.5807', 922337203685477.5807); // boundary values
testBCDToCurr('-922337203685477.5807', MinCurrency); testBCDToCurr('-922337203685477.5807', -922337203685477.5807);
testBCDToCurr('-922337203685477.5808', StrToCurr('-922337203685477.5808')); testBCDToCurr('-922337203685477.5808', StrToCurr('-922337203685477.5808'));
testBCDToCurr( '922337203685477.5808', 0); // out-of-range values testBCDToCurr( '922337203685477.5808', 0); // out-of-range values
testBCDToCurr('-922337203685477.5809', 0); testBCDToCurr('-922337203685477.5809', 0);
// test BCDSubtract:
testBCDSubtract(CurrToBCD(0), CurrToBCD(-0.1), 0.1);
DefaultFormatSettings := DFS; DefaultFormatSettings := DFS;
// test BCDMultiply: // test BCDMultiply:
@ -279,18 +299,13 @@ begin
testBCDCompare(-100.1, 100.1, -1); testBCDCompare(-100.1, 100.1, -1);
testBCDCompare(-100.1, -100.2, 1); testBCDCompare(-100.1, -100.2, 1);
testBCDCompare(100, 100.1, -1); testBCDCompare(100, 100.1, -1);
testBCDCompare(CurrToBcd(0.01), CurrToBcd(0.001), 1); // BCD values with Precision<Scale
testBCDCompare(CurrToBcd(0.01), 0.01, 0);
// test NormalizeBCD: // test NormalizeBCD:
testNormalizeBCD('100.17', '100.17', 5, 3, True); testNormalizeBCD('100.17', '100.17', 5, 3, True);
testNormalizeBCD('100.17', '100.17', 5, 2, True); testNormalizeBCD('100.17', '100.17', 5, 2, True);
testNormalizeBCD('100.17', '100.1' , 5, 1, False); testNormalizeBCD('100.17', '100.1' , 5, 1, False); // truncate, not round
// test NormalizeBCD:
testNormalizeBCD('100.17', '100.17', 5, 3, True);
testNormalizeBCD('100.17', '100.17', 5, 2, True);
testNormalizeBCD('100.17', '100.1' , 5, 1, False);
// test Variant support: // test Variant support:
testVariantOp(varFmtBcdCreate(100), varFmtBcdCreate(-100)); testVariantOp(varFmtBcdCreate(100), varFmtBcdCreate(-100));