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

* Test for 24274

Browse Source 
git-svn-id: trunk@24250 -
This commit is contained in:
michael 2013-04-15 07:42:55 +00:00
parent c47443e492
commit 0490480523
1 changed files with 25 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -66,6 +66,24 @@ begin
end;
end;
procedure testBCDToCurr(const s: string; c1: currency);
var c2: currency;
b1, b2: boolean;
begin
b1 := c1<>0;
b2 := BCDToCurr(StrToBCD(s), c2);
if b1 <> b2 then
begin
writeln('BCDToCurr for ', s, ' returned ', b2,' but expected ', b1);
inc(ErrorCount);
end
else if b2 and (c1 <> c2) then
begin
writeln('BCDToCurr for ', s, ' returned ', c2,' but expected ', c1);
inc(ErrorCount);
end;
end;
procedure testBCDCompare(bcd1,bcd2: TBCD; res: integer);
begin
if (BCDCompare(bcd1,bcd2) <> res) then
@ -190,6 +208,13 @@ begin
testBCDPrecScale('1001', 4, 0);
testBCDPrecScale('1001.1001', 8, 4);
// test BCDToCurr:
testBCDToCurr( '922337203685477.5807', MaxCurrency); // test boundary values
testBCDToCurr('-922337203685477.5807', MinCurrency);
testBCDToCurr('-922337203685477.5808', StrToCurr('-922337203685477.5808'));
testBCDToCurr( '922337203685477.5808', 0); // out-of-range values
testBCDToCurr('-922337203685477.5809', 0);
DefaultFormatSettings := DFS;
// test BCDMultiply: