mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 08:59:27 +02:00
* Test for negcurrformat values 11-15 from Zeljan Rikalo
git-svn-id: trunk@15983 -
This commit is contained in:
parent
154c6ec4d2
commit
cd196c5622
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -9552,6 +9552,7 @@ tests/test/tstrreal1.pp svneol=native#text/plain
|
||||
tests/test/tstrreal2.pp svneol=native#text/plain
|
||||
tests/test/tstrreal3.pp svneol=native#text/plain
|
||||
tests/test/tstrreal4.pp svneol=native#text/plain
|
||||
tests/test/tstrreal5.pp svneol=native#text/plain
|
||||
tests/test/tsubdecl.pp svneol=native#text/plain
|
||||
tests/test/tsymlibrary1.pp svneol=native#text/pascal
|
||||
tests/test/ttpara1.pp svneol=native#text/plain
|
||||
|
56
tests/test/tstrreal5.pp
Normal file
56
tests/test/tstrreal5.pp
Normal file
@ -0,0 +1,56 @@
|
||||
program tstrreal4;
|
||||
{ test for NegCurFormat values by Zeljan Rikalo
|
||||
valid values are at:
|
||||
http://msdn.microsoft.com/en-us/library/dd373791%28VS.85%29.aspx
|
||||
}
|
||||
uses SysUtils;
|
||||
|
||||
procedure test;
|
||||
const
|
||||
MaxNegCurFormats = 15;
|
||||
var
|
||||
s: string;
|
||||
r: double;
|
||||
i: integer;
|
||||
begin
|
||||
DecimalSeparator := '.';
|
||||
r := -1.1;
|
||||
writeln('NegCurrFormat test pass 1 ...');
|
||||
for i := 0 to MaxNegCurFormats do
|
||||
begin
|
||||
NegCurrFormat := i;
|
||||
s := FloatToStrF(r, ffCurrency, 12, 1);
|
||||
writeln('NegCurrFormat: ',i,' value: ',s);
|
||||
case i of
|
||||
0,4,14,15:
|
||||
if (Pos('(', s) = 0) and (Pos(')', s) = 0) then
|
||||
halt(1);
|
||||
else
|
||||
if Pos('-', s) = 0 then
|
||||
halt(1);
|
||||
end;
|
||||
end;
|
||||
|
||||
r := -0.001;
|
||||
writeln('NegCurrFormat test pass 2 ...');
|
||||
for i := 0 to MaxNegCurFormats do
|
||||
begin
|
||||
NegCurrFormat := i;
|
||||
s := FloatToStrF(r, ffCurrency, 12, 4);
|
||||
writeln('NegCurrFormat: ',i,' value: ',s);
|
||||
case i of
|
||||
0,4,14,15:
|
||||
if (Pos('(', s) = 0) and (Pos(')', s) = 0) then
|
||||
halt(1);
|
||||
else
|
||||
if Pos('-', s) = 0 then
|
||||
halt(1);
|
||||
end;
|
||||
end;
|
||||
|
||||
writeln('Tests for NegCurrFormat: SUCCESS');
|
||||
end;
|
||||
|
||||
begin
|
||||
test;
|
||||
end.
|
Loading…
Reference in New Issue
Block a user