mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-18 05:00:07 +02:00
* adjust test so that it tests all three floating point types
git-svn-id: trunk@39134 -
This commit is contained in:
parent
58be30a0fd
commit
ee2c573deb
@ -1,30 +1,124 @@
|
||||
uses
|
||||
Math;
|
||||
|
||||
procedure DoTestSingle;
|
||||
var
|
||||
val: Single;
|
||||
begin
|
||||
if not(isnan(nan)) then
|
||||
val := nan;
|
||||
if not(isnan(val)) then
|
||||
begin
|
||||
writeln('error 1');
|
||||
writeln('error single 1');
|
||||
halt(1);
|
||||
end;
|
||||
if not(isinfinite(infinity)) then
|
||||
val := infinity;
|
||||
if not(isinfinite(val)) then
|
||||
begin
|
||||
writeln('error 2');
|
||||
writeln('error single 2');
|
||||
halt(1);
|
||||
end;
|
||||
if isnan(12341234) then
|
||||
val := 12341234;
|
||||
if isnan(val) then
|
||||
begin
|
||||
writeln('error 3');
|
||||
writeln('error single 3');
|
||||
halt(1);
|
||||
end;
|
||||
if isinfinite(0) then
|
||||
val := 0;
|
||||
if isinfinite(val) then
|
||||
begin
|
||||
writeln('error 4');
|
||||
writeln('error single 4');
|
||||
halt(1);
|
||||
end;
|
||||
if isinfinite(12341234) then
|
||||
val := 12341234;
|
||||
if isinfinite(val) then
|
||||
begin
|
||||
writeln('error 5');
|
||||
writeln('error single 5');
|
||||
halt(1);
|
||||
end;
|
||||
end;
|
||||
|
||||
{$ifdef FPC_HAS_TYPE_DOUBLE}
|
||||
procedure DoTestDouble;
|
||||
var
|
||||
val: Double;
|
||||
begin
|
||||
val := nan;
|
||||
if not(isnan(val)) then
|
||||
begin
|
||||
writeln('error double 1');
|
||||
halt(1);
|
||||
end;
|
||||
val := infinity;
|
||||
if not(isinfinite(val)) then
|
||||
begin
|
||||
writeln('error double 2');
|
||||
halt(1);
|
||||
end;
|
||||
val := 12341234;
|
||||
if isnan(val) then
|
||||
begin
|
||||
writeln('error double 3');
|
||||
halt(1);
|
||||
end;
|
||||
val := 0;
|
||||
if isinfinite(val) then
|
||||
begin
|
||||
writeln('error double 4');
|
||||
halt(1);
|
||||
end;
|
||||
val := 12341234;
|
||||
if isinfinite(val) then
|
||||
begin
|
||||
writeln('error double 5');
|
||||
halt(1);
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{$ifdef FPC_HAS_TYPE_EXTENDED}
|
||||
procedure DoTestExtended;
|
||||
var
|
||||
val: Extended;
|
||||
begin
|
||||
val := nan;
|
||||
if not(isnan(val)) then
|
||||
begin
|
||||
writeln('error extended 1');
|
||||
halt(1);
|
||||
end;
|
||||
val := infinity;
|
||||
if not(isinfinite(val)) then
|
||||
begin
|
||||
writeln('error extended 2');
|
||||
halt(1);
|
||||
end;
|
||||
val := 12341234;
|
||||
if isnan(val) then
|
||||
begin
|
||||
writeln('error extended 3');
|
||||
halt(1);
|
||||
end;
|
||||
val := 0;
|
||||
if isinfinite(val) then
|
||||
begin
|
||||
writeln('error extended 4');
|
||||
halt(1);
|
||||
end;
|
||||
val := 12341234;
|
||||
if isinfinite(val) then
|
||||
begin
|
||||
writeln('error extended 5');
|
||||
halt(1);
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
begin
|
||||
DoTestSingle;
|
||||
{$ifdef FPC_HAS_TYPE_DOUBLE}
|
||||
DoTestDouble;
|
||||
{$endif}
|
||||
{$ifdef FPC_HAS_TYPE_EXTENDED}
|
||||
DoTestExtended;
|
||||
{$endif}
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user