mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-19 17:49:14 +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
|
uses
|
||||||
Math;
|
Math;
|
||||||
|
|
||||||
|
procedure DoTestSingle;
|
||||||
|
var
|
||||||
|
val: Single;
|
||||||
begin
|
begin
|
||||||
if not(isnan(nan)) then
|
val := nan;
|
||||||
|
if not(isnan(val)) then
|
||||||
begin
|
begin
|
||||||
writeln('error 1');
|
writeln('error single 1');
|
||||||
halt(1);
|
halt(1);
|
||||||
end;
|
end;
|
||||||
if not(isinfinite(infinity)) then
|
val := infinity;
|
||||||
|
if not(isinfinite(val)) then
|
||||||
begin
|
begin
|
||||||
writeln('error 2');
|
writeln('error single 2');
|
||||||
halt(1);
|
halt(1);
|
||||||
end;
|
end;
|
||||||
if isnan(12341234) then
|
val := 12341234;
|
||||||
|
if isnan(val) then
|
||||||
begin
|
begin
|
||||||
writeln('error 3');
|
writeln('error single 3');
|
||||||
halt(1);
|
halt(1);
|
||||||
end;
|
end;
|
||||||
if isinfinite(0) then
|
val := 0;
|
||||||
|
if isinfinite(val) then
|
||||||
begin
|
begin
|
||||||
writeln('error 4');
|
writeln('error single 4');
|
||||||
halt(1);
|
halt(1);
|
||||||
end;
|
end;
|
||||||
if isinfinite(12341234) then
|
val := 12341234;
|
||||||
|
if isinfinite(val) then
|
||||||
begin
|
begin
|
||||||
writeln('error 5');
|
writeln('error single 5');
|
||||||
halt(1);
|
halt(1);
|
||||||
end;
|
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.
|
end.
|
||||||
|
Loading…
Reference in New Issue
Block a user