mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 07:39:25 +02:00
Try to update test to adapt to softfpu source changes
git-svn-id: trunk@20120 -
This commit is contained in:
pierre
parent
06192a8137
commit
c6be9b29ee
@ -3,25 +3,32 @@
|
||||
{****************************************************************}
|
||||
{ Copyright (c) 2002 Carl Eric Codere }
|
||||
{****************************************************************}
|
||||
|
||||
{$E+}
|
||||
|
||||
program sfttst;
|
||||
|
||||
uses softfpu;
|
||||
{$E+}
|
||||
|
||||
const
|
||||
softresult_ok : boolean = false;
|
||||
softresult_error_count : longint = 0;
|
||||
|
||||
procedure fail;
|
||||
begin
|
||||
WriteLn('Failed!');
|
||||
halt(1);
|
||||
inc(softresult_error_count);
|
||||
end;
|
||||
|
||||
function singletofloat32(r: single):float32;
|
||||
function singletofloat32(r: single):float32rec;
|
||||
var
|
||||
_result: float32;
|
||||
_result: float32rec;
|
||||
begin
|
||||
move(r,_result, sizeof(r));
|
||||
singletofloat32 := _result;
|
||||
end;
|
||||
|
||||
function float32tosingle(r: float32): single;
|
||||
function float32tosingle(r: float32rec): single;
|
||||
var
|
||||
_result : single;
|
||||
begin
|
||||
@ -54,11 +61,10 @@ function float64todouble(r: float64): double;
|
||||
var
|
||||
i : single;
|
||||
j : single;
|
||||
val1,val2 : float32;
|
||||
result : boolean;
|
||||
val1,val2 : float32rec;
|
||||
Begin
|
||||
Write('single - single test...');
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
i:=99.9;
|
||||
j:=10.0;
|
||||
val1:=singletofloat32(i);
|
||||
@ -68,7 +74,7 @@ function float64todouble(r: float64): double;
|
||||
i:=float32tosingle(val1);
|
||||
j:=float32tosingle(val2);
|
||||
if trunc(i) <> trunc(89.9) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (89.9) :',i);
|
||||
val1:=singletofloat32(i);
|
||||
val2:=singletofloat32(j);
|
||||
@ -77,7 +83,7 @@ function float64todouble(r: float64): double;
|
||||
i:=float32tosingle(val1);
|
||||
j:=float32tosingle(val2);
|
||||
if trunc(i) <> trunc(-79.9) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (-79.9) :',i);
|
||||
val1:=singletofloat32(j);
|
||||
val2:=singletofloat32(10.0);
|
||||
@ -85,9 +91,9 @@ function float64todouble(r: float64): double;
|
||||
val1:= float32_sub(val1,val2);
|
||||
j:=float32tosingle(val1);
|
||||
if j <> 0.0 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (0.0) :',j);
|
||||
if not result then
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -97,17 +103,16 @@ function float64todouble(r: float64): double;
|
||||
var
|
||||
i : single;
|
||||
j : single;
|
||||
result : boolean;
|
||||
val1, val2 : float32;
|
||||
val1, val2 : float32rec;
|
||||
Begin
|
||||
WriteLn('single + single test...');
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
i:= 9;
|
||||
{ i:=i+1.5;}
|
||||
val1:=float32_add(singletofloat32(i),singletofloat32(1.5));
|
||||
i:=float32tosingle(val1);
|
||||
if trunc(i) <> trunc(10.5) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (10.5) :',i);
|
||||
i := 326788.12345;
|
||||
j := 100.0;
|
||||
@ -118,9 +123,9 @@ function float64todouble(r: float64): double;
|
||||
val1:=float32_add(val1,singletofloat32(12.5));
|
||||
i:=float32tosingle(val1);
|
||||
if trunc(i) <> trunc(326900.12345) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (326900.12345) :',i);
|
||||
if not result then
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -131,18 +136,17 @@ function float64todouble(r: float64): double;
|
||||
var
|
||||
i : single;
|
||||
j : single;
|
||||
result : boolean;
|
||||
val1 : float32;
|
||||
val1 : float32rec;
|
||||
begin
|
||||
WriteLn('single * single test...');
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
i:= 21111.0;
|
||||
j:= 11.1;
|
||||
{ i := i * j * i; }
|
||||
val1:=float32_mul(singletofloat32(i),singletofloat32(j));
|
||||
i:=float32tosingle(val1);
|
||||
if trunc(i) <> trunc(234332.1) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (234332.1) :',i);
|
||||
i := 10.0;
|
||||
j := -12.0;
|
||||
@ -150,9 +154,9 @@ function float64todouble(r: float64): double;
|
||||
val1:=float32_mul(float32_mul(singletofloat32(i),singletofloat32(j)),singletofloat32(10.0));
|
||||
i:=float32tosingle(val1);
|
||||
if trunc(i) <> trunc(-1200.0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (-1200.0) :',i);
|
||||
if not result then
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -164,10 +168,9 @@ function float64todouble(r: float64): double;
|
||||
var
|
||||
i : single;
|
||||
j : single;
|
||||
val1 : float32;
|
||||
result : boolean;
|
||||
val1 : float32rec;
|
||||
Begin
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
WriteLn('single / single test...');
|
||||
i:=-99.9;
|
||||
j:=10.0;
|
||||
@ -175,21 +178,21 @@ function float64todouble(r: float64): double;
|
||||
val1:=float32_div(singletofloat32(i),singletofloat32(j));
|
||||
i:=float32tosingle(val1);
|
||||
if trunc(i) <> trunc(-9.9) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (-9.9) :',i);
|
||||
{i:=j / i;}
|
||||
val1:=float32_div(singletofloat32(j),singletofloat32(i));
|
||||
i:=float32tosingle(val1);
|
||||
if trunc(i) <> trunc(-1.01) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLN('Result (-1.01) :',i);
|
||||
{ j:=i / 10.0; }
|
||||
val1:=float32_div(singletofloat32(i),singletofloat32(10.0));
|
||||
j:=float32tosingle(val1);
|
||||
if trunc(j) <> trunc(-0.1001) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (-0.1001) :',j);
|
||||
if not result then
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -199,42 +202,41 @@ function float64todouble(r: float64): double;
|
||||
var
|
||||
i : single;
|
||||
j : single;
|
||||
result : boolean;
|
||||
val1,val2 : float32;
|
||||
val1,val2 : float32rec;
|
||||
begin
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
Write('single = single test...');
|
||||
i := 1000.0;
|
||||
j := 1000.0;
|
||||
val1 := singletofloat32(i);
|
||||
val2 := singletofloat32(j);
|
||||
if (float32_eq(val1,val2)=0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := -112345.1;
|
||||
j := -112345.1;
|
||||
val1 := singletofloat32(i);
|
||||
val2 := singletofloat32(j);
|
||||
if (float32_eq(val1,val2)=0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := 4502020.1125E+03;
|
||||
j := 4502020.1125E+03;
|
||||
val1 := singletofloat32(i);
|
||||
val2 := singletofloat32(j);
|
||||
if (float32_eq(val1,val2)=0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := -4502028.1125E+03;
|
||||
j := -4502028.1125E+03;
|
||||
val1 := singletofloat32(i);
|
||||
val2 := singletofloat32(j);
|
||||
if (float32_eq(val1,val2)=0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := -4502030.1125E+03;
|
||||
j := -4502028.1125E+03;
|
||||
val1 := singletofloat32(i);
|
||||
val2 := singletofloat32(j);
|
||||
if (float32_eq(val1,val2)<>0) then
|
||||
result := false;
|
||||
if not result then
|
||||
softresult_ok := false;
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -244,30 +246,29 @@ function float64todouble(r: float64): double;
|
||||
var
|
||||
i : single;
|
||||
j : single;
|
||||
result : boolean;
|
||||
val1,val2: float32;
|
||||
val1,val2: float32rec;
|
||||
begin
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
Write('single <= single test...');
|
||||
i := 1000.0;
|
||||
j := 1000.0;
|
||||
val1 := singletofloat32(i);
|
||||
val2 := singletofloat32(j);
|
||||
if (float32_le(val1,val2)=0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := 10000.0;
|
||||
j := 999.0;
|
||||
val1 := singletofloat32(i);
|
||||
val2 := singletofloat32(j);
|
||||
if (float32_le(val2,val1)=0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := -10000.0;
|
||||
j := -999.0;
|
||||
val1 := singletofloat32(i);
|
||||
val2 := singletofloat32(j);
|
||||
if (float32_le(val2,val1)<>0) then
|
||||
result := false;
|
||||
if not result then
|
||||
softresult_ok := false;
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -278,30 +279,29 @@ function float64todouble(r: float64): double;
|
||||
var
|
||||
i : single;
|
||||
j : single;
|
||||
val1,val2 : float32;
|
||||
result : boolean;
|
||||
val1,val2 : float32rec;
|
||||
begin
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
Write('single < single test...');
|
||||
i := 1000.0;
|
||||
j := 1000.0;
|
||||
val1 := singletofloat32(i);
|
||||
val2 := singletofloat32(j);
|
||||
if (float32_lt(val1,val2)<>0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := 999.0;
|
||||
j := 1000.0;
|
||||
val1 := singletofloat32(i);
|
||||
val2 := singletofloat32(j);
|
||||
if (float32_lt(val1,val2)=0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := -10000.0;
|
||||
j := -999.0;
|
||||
val1 := singletofloat32(i);
|
||||
val2 := singletofloat32(j);
|
||||
if (float32_lt(val2,val1)<>0) then
|
||||
result := false;
|
||||
if not result then
|
||||
softresult_ok := false;
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -310,46 +310,44 @@ function float64todouble(r: float64): double;
|
||||
procedure Float32TestInt;
|
||||
var
|
||||
_result : longint;
|
||||
result : boolean;
|
||||
begin
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
Write('Single to Longint test...');
|
||||
_result:=float32_to_int32(singletofloat32(-12.12345));
|
||||
if _result <> -12 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
_result:=float32_to_int32(singletofloat32(12.52345));
|
||||
if _result <> 13 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
_result:=float32_to_int32(singletofloat32(-0.01));
|
||||
if _result <> 0 then
|
||||
result := false;
|
||||
if not result then
|
||||
softresult_ok := false;
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
end;
|
||||
|
||||
{Procedure int32_to_float32( a: int32; var c: float32 ); }
|
||||
{Procedure int32_to_float32( a: int32; var c: float32rec ); }
|
||||
procedure IntTestFloat32;
|
||||
var
|
||||
result : boolean;
|
||||
val1 : float32;
|
||||
val1 : float32rec;
|
||||
begin
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
Write('Longint to single test...');
|
||||
val1:=int32_to_float32($8000);
|
||||
if float32tosingle(val1) <> $8000 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
val1:=int32_to_float32(-1);
|
||||
if float32tosingle(val1) <> -1 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
val1:=int32_to_float32(0);
|
||||
if (float32tosingle(val1)) <> 0.0 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
val1:=int32_to_float32(-217000000);
|
||||
if float32tosingle(val1) <> -217000000 then
|
||||
result := false;
|
||||
if not result then
|
||||
softresult_ok := false;
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -363,39 +361,38 @@ procedure IntTestFloat32;
|
||||
i : double;
|
||||
j : double;
|
||||
val1,val2 : float64;
|
||||
result : boolean;
|
||||
Begin
|
||||
Write('Double - Double test...');
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
i:=99.9;
|
||||
j:=10.0;
|
||||
val1:=doubletofloat64(i);
|
||||
val2:=doubletofloat64(j);
|
||||
{ i:=i-j }
|
||||
float64_sub(val1,val2,val1);
|
||||
val1:=float64_sub(val1,val2);
|
||||
i:=float64todouble(val1);
|
||||
j:=float64todouble(val2);
|
||||
if trunc(i) <> trunc(89.9) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (89.9) :',i);
|
||||
val1:=doubletofloat64(i);
|
||||
val2:=doubletofloat64(j);
|
||||
{ i:=j-i }
|
||||
float64_sub(val2,val1,val1);
|
||||
val1:=float64_sub(val2,val1);
|
||||
i:=float64todouble(val1);
|
||||
j:=float64todouble(val2);
|
||||
if trunc(i) <> trunc(-79.9) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (-79.9) :',i);
|
||||
val1:=doubletofloat64(j);
|
||||
val2:=doubletofloat64(10.0);
|
||||
{ j:=j-10.0 }
|
||||
float64_sub(val1,val2,val1);
|
||||
val1:=float64_sub(val1,val2);
|
||||
j:=float64todouble(val1);
|
||||
if j <> 0.0 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (0.0) :',j);
|
||||
if not result then
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -405,30 +402,29 @@ procedure IntTestFloat32;
|
||||
var
|
||||
i : double;
|
||||
j : double;
|
||||
result : boolean;
|
||||
val1, val2 : float64;
|
||||
Begin
|
||||
WriteLn('Double + Double test...');
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
i:= 9;
|
||||
{ i:=i+1.5;}
|
||||
float64_add(doubletofloat64(i),doubletofloat64(1.5),val1);
|
||||
val1:=float64_add(doubletofloat64(i),doubletofloat64(1.5));
|
||||
i:=float64todouble(val1);
|
||||
if trunc(i) <> trunc(10.5) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (10.5) :',i);
|
||||
i := 326788.12345;
|
||||
j := 100.0;
|
||||
{ i := i + j + 12.5;}
|
||||
val1 := doubletofloat64(i);
|
||||
val2 := doubletofloat64(j);
|
||||
float64_add(val1,val2,val1); { i:=i+j }
|
||||
float64_add(val1,doubletofloat64(12.5),val1);
|
||||
val1:=float64_add(val1,val2); { i:=i+j }
|
||||
val1:=float64_add(val1,doubletofloat64(12.5));
|
||||
i:=float64todouble(val1);
|
||||
if trunc(i) <> trunc(326900.12345) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (326900.12345) :',i);
|
||||
if not result then
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -439,29 +435,28 @@ procedure IntTestFloat32;
|
||||
var
|
||||
i : double;
|
||||
j : double;
|
||||
result : boolean;
|
||||
val1 : float64;
|
||||
begin
|
||||
WriteLn('Double * Double test...');
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
i:= 21111.0;
|
||||
j:= 11.1;
|
||||
{ i := i * j * i; }
|
||||
float64_mul(doubletofloat64(i),doubletofloat64(j),val1);
|
||||
val1:=float64_mul(doubletofloat64(i),doubletofloat64(j));
|
||||
i:=float64todouble(val1);
|
||||
if trunc(i) <> trunc(234332.1) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (234332.1) :',i);
|
||||
i := 10.0;
|
||||
j := -12.0;
|
||||
{ i := i * j * 10.0;}
|
||||
float64_mul(doubletofloat64(i),doubletofloat64(j),val1);
|
||||
float64_mul(val1,doubletofloat64(10.0),val1);
|
||||
val1:=float64_mul(doubletofloat64(i),doubletofloat64(j));
|
||||
val1:=float64_mul(val1,doubletofloat64(10.0));
|
||||
i:=float64todouble(val1);
|
||||
if trunc(i) <> trunc(-1200.0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (-1200.0) :',i);
|
||||
if not result then
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -474,31 +469,30 @@ procedure IntTestFloat32;
|
||||
i : double;
|
||||
j : double;
|
||||
val1 : float64;
|
||||
result : boolean;
|
||||
Begin
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
WriteLn('Double / Double test...');
|
||||
i:=-99.9;
|
||||
j:=10.0;
|
||||
{ i:=i / j; }
|
||||
float64_div(doubletofloat64(i),doubletofloat64(j),val1);
|
||||
val1:=float64_div(doubletofloat64(i),doubletofloat64(j));
|
||||
i:=float64todouble(val1);
|
||||
if trunc(i) <> trunc(-9.9) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (-9.9) :',i);
|
||||
{i:=j / i;}
|
||||
float64_div(doubletofloat64(j),doubletofloat64(i),val1);
|
||||
val1:=float64_div(doubletofloat64(j),doubletofloat64(i));
|
||||
i:=float64todouble(val1);
|
||||
if trunc(i) <> trunc(-1.01) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLN('Result (-1.01) :',i);
|
||||
{ j:=i / 10.0; }
|
||||
float64_div(doubletofloat64(i),doubletofloat64(10.0),val1);
|
||||
val1:=float64_div(doubletofloat64(i),doubletofloat64(10.0));
|
||||
j:=float64todouble(val1);
|
||||
if trunc(j) <> trunc(-0.1001) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
WriteLn('Result (-0.1001) :',j);
|
||||
if not result then
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -508,42 +502,41 @@ procedure IntTestFloat32;
|
||||
var
|
||||
i : double;
|
||||
j : double;
|
||||
result : boolean;
|
||||
val1,val2 : float64;
|
||||
begin
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
Write('Double = Double test...');
|
||||
i := 1000.0;
|
||||
j := 1000.0;
|
||||
val1 := doubletofloat64(i);
|
||||
val2 := doubletofloat64(j);
|
||||
if (float64_eq(val1,val2)=0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := -112345.1;
|
||||
j := -112345.1;
|
||||
val1 := doubletofloat64(i);
|
||||
val2 := doubletofloat64(j);
|
||||
if (float64_eq(val1,val2)=0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := 4502020.1125E+03;
|
||||
j := 4502020.1125E+03;
|
||||
val1 := doubletofloat64(i);
|
||||
val2 := doubletofloat64(j);
|
||||
if (float64_eq(val1,val2)=0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := -4502028.1125E+03;
|
||||
j := -4502028.1125E+03;
|
||||
val1 := doubletofloat64(i);
|
||||
val2 := doubletofloat64(j);
|
||||
if (float64_eq(val1,val2)=0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := -4502030.1125E+03;
|
||||
j := -4502028.1125E+03;
|
||||
val1 := doubletofloat64(i);
|
||||
val2 := doubletofloat64(j);
|
||||
if (float64_eq(val1,val2)<>0) then
|
||||
result := false;
|
||||
if not result then
|
||||
softresult_ok := false;
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -553,30 +546,29 @@ procedure IntTestFloat32;
|
||||
var
|
||||
i : double;
|
||||
j : double;
|
||||
result : boolean;
|
||||
val1,val2: float64;
|
||||
begin
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
Write('Double <= Double test...');
|
||||
i := 1000.0;
|
||||
j := 1000.0;
|
||||
val1 := doubletofloat64(i);
|
||||
val2 := doubletofloat64(j);
|
||||
if (float64_le(val1,val2)=0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := 10000.0;
|
||||
j := 999.0;
|
||||
val1 := doubletofloat64(i);
|
||||
val2 := doubletofloat64(j);
|
||||
if (float64_le(val2,val1)=0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := -10000.0;
|
||||
j := -999.0;
|
||||
val1 := doubletofloat64(i);
|
||||
val2 := doubletofloat64(j);
|
||||
if (float64_le(val2,val1)<>0) then
|
||||
result := false;
|
||||
if not result then
|
||||
softresult_ok := false;
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -588,29 +580,28 @@ procedure IntTestFloat32;
|
||||
i : double;
|
||||
j : double;
|
||||
val1,val2 : float64;
|
||||
result : boolean;
|
||||
begin
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
Write('Double < Double test...');
|
||||
i := 1000.0;
|
||||
j := 1000.0;
|
||||
val1 := doubletofloat64(i);
|
||||
val2 := doubletofloat64(j);
|
||||
if (float64_lt(val1,val2)<>0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := 999.0;
|
||||
j := 1000.0;
|
||||
val1 := doubletofloat64(i);
|
||||
val2 := doubletofloat64(j);
|
||||
if (float64_lt(val1,val2)=0) then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
i := -10000.0;
|
||||
j := -999.0;
|
||||
val1 := doubletofloat64(i);
|
||||
val2 := doubletofloat64(j);
|
||||
if (float64_lt(val2,val1)<>0) then
|
||||
result := false;
|
||||
if not result then
|
||||
softresult_ok := false;
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -619,20 +610,19 @@ procedure IntTestFloat32;
|
||||
procedure Float64TestInt;
|
||||
var
|
||||
_result : longint;
|
||||
result : boolean;
|
||||
begin
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
Write('double to Longint test...');
|
||||
_result:=float64_to_int32(doubletofloat64(-12.12345));
|
||||
if _result <> -12 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
_result:=float64_to_int32(doubletofloat64(12.52345));
|
||||
if _result <> 13 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
_result:=float64_to_int32(doubletofloat64(-0.01));
|
||||
if _result <> 0 then
|
||||
result := false;
|
||||
if not result then
|
||||
softresult_ok := false;
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -641,24 +631,23 @@ procedure Float64TestInt;
|
||||
{Procedure int32_to_float64( a: int32; var c: float64 ); }
|
||||
procedure IntTestFloat64;
|
||||
var
|
||||
result : boolean;
|
||||
val1 : float64;
|
||||
begin
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
Write('Longint to double test...');
|
||||
int32_to_float64($8000,val1);
|
||||
val1:=int32_to_float64($8000);
|
||||
if float64todouble(val1) <> $8000 then
|
||||
result := false;
|
||||
int32_to_float64(-1,val1);
|
||||
softresult_ok := false;
|
||||
val1:=int32_to_float64(-1);
|
||||
if float64todouble(val1) <> -1 then
|
||||
result := false;
|
||||
int32_to_float64(0,val1);
|
||||
softresult_ok := false;
|
||||
val1:=int32_to_float64(0);
|
||||
if (float64todouble(val1)) <> 0.0 then
|
||||
result := false;
|
||||
int32_to_float64(-217000000,val1);
|
||||
softresult_ok := false;
|
||||
val1:=int32_to_float64(-217000000);
|
||||
if float64todouble(val1) <> -217000000 then
|
||||
result := false;
|
||||
if not result then
|
||||
softresult_ok := false;
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -667,66 +656,65 @@ procedure IntTestFloat64;
|
||||
{ test procedure int64_to_float32 }
|
||||
procedure Int64TestFloat32;
|
||||
var
|
||||
result : boolean;
|
||||
val1 : float32;
|
||||
val1 : float32rec;
|
||||
a : int64;
|
||||
sgl : single;
|
||||
begin
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
Write('int64 to single test...');
|
||||
{ cases to test : a = 0; a < 0; a > 0 }
|
||||
a:=0;
|
||||
{ reset floating point exceptions flag }
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
sgl:=float32tosingle(int64_to_float32(a));
|
||||
if trunc(sgl) <> 0 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
a:=-32768;
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
sgl:=float32tosingle(int64_to_float32(a));
|
||||
if trunc(sgl) <> -32768 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
a:=-1000001;
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
sgl:=float32tosingle(int64_to_float32(a));
|
||||
if trunc(sgl) <> -1000001 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
a:=12567;
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
sgl:=float32tosingle(int64_to_float32(a));
|
||||
if trunc(sgl) <> 12567 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
a:=high(longint);
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
sgl:=float32tosingle(int64_to_float32(a));
|
||||
{ the result might be inexact, so can't really test }
|
||||
if (trunc(sgl) <> high(longint)) and
|
||||
((float_exception_flags and float_flag_inexact)=0) then
|
||||
result := false;
|
||||
((softfloat_exception_flags and float_flag_inexact)=0) then
|
||||
softresult_ok := false;
|
||||
a:=low(longint);
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
sgl:=float32tosingle(int64_to_float32(a));
|
||||
if (trunc(sgl) <> low(longint)) and
|
||||
((float_exception_flags and float_flag_inexact)=0) then
|
||||
result := false;
|
||||
((softfloat_exception_flags and float_flag_inexact)=0) then
|
||||
softresult_ok := false;
|
||||
{$ifndef ver1_0}
|
||||
{ version 1.0 returns a longint for trunc }
|
||||
{ so these routines will automatically fail }
|
||||
a:=1 shl 33;
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
sgl:=float32tosingle(int64_to_float32(a));
|
||||
if (int64(trunc(sgl)) <> int64(1) shl 33) and
|
||||
((float_exception_flags and float_flag_inexact)=0) then
|
||||
result := false;
|
||||
((softfloat_exception_flags and float_flag_inexact)=0) then
|
||||
softresult_ok := false;
|
||||
a:=1 shl 33;
|
||||
a:=-a;
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
sgl:=float32tosingle(int64_to_float32(a));
|
||||
if (int64(trunc(sgl)) <> -(int64(1) shl 33)) and
|
||||
((float_exception_flags and float_flag_inexact)=0) then
|
||||
result := false;
|
||||
((softfloat_exception_flags and float_flag_inexact)=0) then
|
||||
softresult_ok := false;
|
||||
{$endif}
|
||||
if not result then
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -735,66 +723,65 @@ end;
|
||||
{ test procedure int64_to_float32 }
|
||||
procedure Int64TestFloat64;
|
||||
var
|
||||
result : boolean;
|
||||
val1 : float32;
|
||||
val1 : float32rec;
|
||||
a : int64;
|
||||
float : double;
|
||||
begin
|
||||
result := true;
|
||||
softresult_ok := true;
|
||||
Write('int64 to double test...');
|
||||
{ cases to test : a = 0; a < 0; a > 0 }
|
||||
a:=0;
|
||||
{ reset floating point exceptions flag }
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
float:=float64todouble(int64_to_float64(a));
|
||||
if trunc(float) <> 0 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
a:=-32768;
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
float:=float64todouble(int64_to_float64(a));
|
||||
if trunc(float) <> -32768 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
a:=-1000001;
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
float:=float64todouble(int64_to_float64(a));
|
||||
if trunc(float) <> -1000001 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
a:=12567;
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
float:=float64todouble(int64_to_float64(a));
|
||||
if trunc(float) <> 12567 then
|
||||
result := false;
|
||||
softresult_ok := false;
|
||||
a:=high(longint);
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
float:=float64todouble(int64_to_float64(a));
|
||||
{ the result might be inexact, so can't really test }
|
||||
if (trunc(float) <> high(longint)) and
|
||||
((float_exception_flags and float_flag_inexact)=0) then
|
||||
result := false;
|
||||
((softfloat_exception_flags and float_flag_inexact)=0) then
|
||||
softresult_ok := false;
|
||||
a:=low(longint);
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
float:=float64todouble(int64_to_float64(a));
|
||||
if (trunc(float) <> low(longint)) and
|
||||
((float_exception_flags and float_flag_inexact)=0) then
|
||||
result := false;
|
||||
((softfloat_exception_flags and float_flag_inexact)=0) then
|
||||
softresult_ok := false;
|
||||
{$ifndef ver1_0}
|
||||
{ version 1.0 returns a longint for trunc }
|
||||
{ so these routines will automatically fail }
|
||||
a:=1 shl 33;
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
float:=float64todouble(int64_to_float64(a));
|
||||
if (int64(trunc(float)) <> int64(1) shl 33) and
|
||||
((float_exception_flags and float_flag_inexact)=0) then
|
||||
result := false;
|
||||
((softfloat_exception_flags and float_flag_inexact)=0) then
|
||||
softresult_ok := false;
|
||||
a:=1 shl 33;
|
||||
a:=-a;
|
||||
float_exception_flags := 0;
|
||||
softfloat_exception_flags := 0;
|
||||
float:=float64todouble(int64_to_float64(a));
|
||||
if (int64(trunc(float)) <> -(int64(1) shl 33)) and
|
||||
((float_exception_flags and float_flag_inexact)=0) then
|
||||
result := false;
|
||||
((softfloat_exception_flags and float_flag_inexact)=0) then
|
||||
softresult_ok := false;
|
||||
{$endif}
|
||||
if not result then
|
||||
if not softresult_ok then
|
||||
Fail
|
||||
else
|
||||
WriteLn('Success.');
|
||||
@ -822,6 +809,11 @@ Begin
|
||||
float64TestInt;
|
||||
IntTestfloat64;
|
||||
{ int64 conversion routines }
|
||||
{ int64testfloat32;}
|
||||
int64testfloat32;
|
||||
int64testfloat64;
|
||||
if (softresult_error_count>0) then
|
||||
begin
|
||||
WriteLn(softresult_error_count,' failures!');
|
||||
halt(1);
|
||||
end;
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user