* int64 to float conversion testing (crashes under FPC :()

tests/test/units/softfpu/sfttst.pp

@@ -1,6 +1,8 @@
 {****************************************************************}
 {  Softfloat module testsuit                                     }
 {****************************************************************}
+{  Copyright (c) 2002 Carl Eric Codere                           }
+{****************************************************************}
 program sfttst;
 
 uses softfpu;
@@ -18,7 +20,7 @@ end;
     move(r,_result, sizeof(r));
     singletofloat32 := _result;
   end;
-  
+
 function float32tosingle(r: float32): single;
  var
   _result : single;
@@ -26,8 +28,8 @@ function float32tosingle(r: float32): single;
    move(r, _result, sizeof(r));
    float32tosingle := _result;
  end;
- 
- 
+
+
  function doubletofloat64(r: double):float64;
   var
    _result: float64;
@@ -35,7 +37,7 @@ function float32tosingle(r: float32): single;
     move(r,_result, sizeof(r));
     doubletofloat64 := _result;
   end;
-  
+
 function float64todouble(r: float64): double;
  var
   _result : double;
@@ -43,7 +45,7 @@ function float64todouble(r: float64): double;
    move(r, _result, sizeof(r));
    float64todouble := _result;
  end;
- 
+
 
 {******************************************************************************}
 {*                            single arithmetic                               *}
@@ -170,19 +172,19 @@ function float64todouble(r: float64): double;
   i:=-99.9;
   j:=10.0;
 {  i:=i / j; }
-  val1:=float32_div(singletofloat32(i),singletofloat32(j));    
+  val1:=float32_div(singletofloat32(i),singletofloat32(j));
   i:=float32tosingle(val1);
   if trunc(i) <> trunc(-9.9) then
     result := false;
   WriteLn('Result (-9.9) :',i);
   {i:=j / i;}
-  val1:=float32_div(singletofloat32(j),singletofloat32(i));    
+  val1:=float32_div(singletofloat32(j),singletofloat32(i));
   i:=float32tosingle(val1);
   if trunc(i) <> trunc(-1.01) then
     result := false;
   WriteLN('Result (-1.01) :',i);
 {  j:=i / 10.0; }
-  val1:=float32_div(singletofloat32(i),singletofloat32(10.0));    
+  val1:=float32_div(singletofloat32(i),singletofloat32(10.0));
   j:=float32tosingle(val1);
   if trunc(j) <> trunc(-0.1001) then
     result := false;
@@ -205,31 +207,31 @@ function float64todouble(r: float64): double;
   i := 1000.0;
   j := 1000.0;
   val1 := singletofloat32(i);
-  val2 := singletofloat32(j); 
+  val2 := singletofloat32(j);
   if (float32_eq(val1,val2)=0) then
     result := false;
   i := -112345.1;
   j := -112345.1;
   val1 := singletofloat32(i);
-  val2 := singletofloat32(j); 
+  val2 := singletofloat32(j);
   if (float32_eq(val1,val2)=0) then
     result := false;
   i := 4502020.1125E+03;
   j := 4502020.1125E+03;
   val1 := singletofloat32(i);
-  val2 := singletofloat32(j); 
+  val2 := singletofloat32(j);
   if (float32_eq(val1,val2)=0) then
     result := false;
   i := -4502028.1125E+03;
   j := -4502028.1125E+03;
   val1 := singletofloat32(i);
-  val2 := singletofloat32(j); 
+  val2 := singletofloat32(j);
   if (float32_eq(val1,val2)=0) then
     result := false;
   i := -4502030.1125E+03;
   j := -4502028.1125E+03;
   val1 := singletofloat32(i);
-  val2 := singletofloat32(j); 
+  val2 := singletofloat32(j);
   if (float32_eq(val1,val2)<>0) then
     result := false;
   if not result then
@@ -250,19 +252,19 @@ function float64todouble(r: float64): double;
   i := 1000.0;
   j := 1000.0;
   val1 := singletofloat32(i);
-  val2 := singletofloat32(j); 
+  val2 := singletofloat32(j);
   if (float32_le(val1,val2)=0) then
     result := false;
   i := 10000.0;
   j := 999.0;
   val1 := singletofloat32(i);
-  val2 := singletofloat32(j); 
+  val2 := singletofloat32(j);
   if (float32_le(val2,val1)=0) then
     result := false;
   i := -10000.0;
   j := -999.0;
   val1 := singletofloat32(i);
-  val2 := singletofloat32(j); 
+  val2 := singletofloat32(j);
   if (float32_le(val2,val1)<>0) then
     result := false;
   if not result then
@@ -284,19 +286,19 @@ function float64todouble(r: float64): double;
   i := 1000.0;
   j := 1000.0;
   val1 := singletofloat32(i);
-  val2 := singletofloat32(j); 
+  val2 := singletofloat32(j);
   if (float32_lt(val1,val2)<>0) then
     result := false;
   i := 999.0;
   j := 1000.0;
   val1 := singletofloat32(i);
-  val2 := singletofloat32(j); 
+  val2 := singletofloat32(j);
   if (float32_lt(val1,val2)=0) then
     result := false;
   i := -10000.0;
   j := -999.0;
   val1 := singletofloat32(i);
-  val2 := singletofloat32(j); 
+  val2 := singletofloat32(j);
   if (float32_lt(val2,val1)<>0) then
     result := false;
   if not result then
@@ -326,7 +328,7 @@ procedure Float32TestInt;
   else
     WriteLn('Success.');
  end;
- 
+
 {Procedure int32_to_float32( a: int32; var c: float32 ); }
 procedure IntTestFloat32;
  var
@@ -352,7 +354,7 @@ procedure IntTestFloat32;
   else
     WriteLn('Success.');
  end;
- 
+
 {******************************************************************************}
 {*                            double arithmetic                               *}
 {******************************************************************************}
@@ -479,19 +481,19 @@ procedure IntTestFloat32;
   i:=-99.9;
   j:=10.0;
 {  i:=i / j; }
-  float64_div(doubletofloat64(i),doubletofloat64(j),val1);    
+  float64_div(doubletofloat64(i),doubletofloat64(j),val1);
   i:=float64todouble(val1);
   if trunc(i) <> trunc(-9.9) then
     result := false;
   WriteLn('Result (-9.9) :',i);
   {i:=j / i;}
-  float64_div(doubletofloat64(j),doubletofloat64(i),val1);    
+  float64_div(doubletofloat64(j),doubletofloat64(i),val1);
   i:=float64todouble(val1);
   if trunc(i) <> trunc(-1.01) then
     result := false;
   WriteLN('Result (-1.01) :',i);
 {  j:=i / 10.0; }
-  float64_div(doubletofloat64(i),doubletofloat64(10.0),val1);    
+  float64_div(doubletofloat64(i),doubletofloat64(10.0),val1);
   j:=float64todouble(val1);
   if trunc(j) <> trunc(-0.1001) then
     result := false;
@@ -514,31 +516,31 @@ procedure IntTestFloat32;
   i := 1000.0;
   j := 1000.0;
   val1 := doubletofloat64(i);
-  val2 := doubletofloat64(j); 
+  val2 := doubletofloat64(j);
   if (float64_eq(val1,val2)=0) then
     result := false;
   i := -112345.1;
   j := -112345.1;
   val1 := doubletofloat64(i);
-  val2 := doubletofloat64(j); 
+  val2 := doubletofloat64(j);
   if (float64_eq(val1,val2)=0) then
     result := false;
   i := 4502020.1125E+03;
   j := 4502020.1125E+03;
   val1 := doubletofloat64(i);
-  val2 := doubletofloat64(j); 
+  val2 := doubletofloat64(j);
   if (float64_eq(val1,val2)=0) then
     result := false;
   i := -4502028.1125E+03;
   j := -4502028.1125E+03;
   val1 := doubletofloat64(i);
-  val2 := doubletofloat64(j); 
+  val2 := doubletofloat64(j);
   if (float64_eq(val1,val2)=0) then
     result := false;
   i := -4502030.1125E+03;
   j := -4502028.1125E+03;
   val1 := doubletofloat64(i);
-  val2 := doubletofloat64(j); 
+  val2 := doubletofloat64(j);
   if (float64_eq(val1,val2)<>0) then
     result := false;
   if not result then
@@ -559,19 +561,19 @@ procedure IntTestFloat32;
   i := 1000.0;
   j := 1000.0;
   val1 := doubletofloat64(i);
-  val2 := doubletofloat64(j); 
+  val2 := doubletofloat64(j);
   if (float64_le(val1,val2)=0) then
     result := false;
   i := 10000.0;
   j := 999.0;
   val1 := doubletofloat64(i);
-  val2 := doubletofloat64(j); 
+  val2 := doubletofloat64(j);
   if (float64_le(val2,val1)=0) then
     result := false;
   i := -10000.0;
   j := -999.0;
   val1 := doubletofloat64(i);
-  val2 := doubletofloat64(j); 
+  val2 := doubletofloat64(j);
   if (float64_le(val2,val1)<>0) then
     result := false;
   if not result then
@@ -593,19 +595,19 @@ procedure IntTestFloat32;
   i := 1000.0;
   j := 1000.0;
   val1 := doubletofloat64(i);
-  val2 := doubletofloat64(j); 
+  val2 := doubletofloat64(j);
   if (float64_lt(val1,val2)<>0) then
     result := false;
   i := 999.0;
   j := 1000.0;
   val1 := doubletofloat64(i);
-  val2 := doubletofloat64(j); 
+  val2 := doubletofloat64(j);
   if (float64_lt(val1,val2)=0) then
     result := false;
   i := -10000.0;
   j := -999.0;
   val1 := doubletofloat64(i);
-  val2 := doubletofloat64(j); 
+  val2 := doubletofloat64(j);
   if (float64_lt(val2,val1)<>0) then
     result := false;
   if not result then
@@ -635,7 +637,7 @@ procedure Float64TestInt;
   else
     WriteLn('Success.');
  end;
- 
+
 {Procedure int32_to_float64( a: int32; var c: float64 ); }
 procedure IntTestFloat64;
  var
@@ -662,6 +664,143 @@ procedure IntTestFloat64;
     WriteLn('Success.');
  end;
 
+{ test procedure int64_to_float32 }
+procedure Int64TestFloat32;
+ var
+  result : boolean;
+  val1 : float32;
+  a : int64;
+  sgl : single;
+ begin
+  result := 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;
+  sgl:=float32tosingle(int64_to_float32(a));
+  if sgl <> 0.0 then
+    result := false;
+  a:=-32768;
+  float_exception_flags := 0;
+  sgl:=float32tosingle(int64_to_float32(a));
+  if trunc(sgl) <> -32768 then
+    result := false;
+  a:=-1000001;
+  float_exception_flags := 0;
+  sgl:=float32tosingle(int64_to_float32(a));
+  if trunc(sgl) <> -1000001 then
+    result := false;
+  a:=12567;
+  float_exception_flags := 0;
+  sgl:=float32tosingle(int64_to_float32(a));
+  if trunc(sgl) <> 12567 then
+    result := false;
+  a:=high(longint);
+  float_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;
+  a:=low(longint);
+  float_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;
+{$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;
+  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;
+  a:=1 shl 33;
+  a:=-a;
+  float_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;
+{$endif}    
+  if not result then
+    Fail
+  else
+    WriteLn('Success.');
+end;
+
+{ test procedure int64_to_float32 }
+procedure Int64TestFloat64;
+ var
+  result : boolean;
+  val1 : float32;
+  a : int64;
+  float : double;
+ begin
+  result := 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;
+  float:=float64todouble(int64_to_float64(a));
+  if float <> 0.0 then
+    result := false;
+  a:=-32768;
+  float_exception_flags := 0;
+  float:=float64todouble(int64_to_float64(a));
+  if trunc(float) <> -32768 then
+    result := false;
+  a:=-1000001;
+  float_exception_flags := 0;
+  float:=float64todouble(int64_to_float64(a));
+  if trunc(float) <> -1000001 then
+    result := false;
+  a:=12567;
+  float_exception_flags := 0;
+  float:=float64todouble(int64_to_float64(a));
+  if trunc(float) <> 12567 then
+    result := false;
+  a:=high(longint);
+  float_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;
+  a:=low(longint);
+  float_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;
+{$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;
+  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;
+  a:=1 shl 33;
+  a:=-a;
+  float_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;
+{$endif}    
+  if not result then
+    Fail
+  else
+    WriteLn('Success.');
+end;
+
+
 Begin
  Float32TestEqual;
  Float32TestLE;
@@ -672,7 +811,7 @@ Begin
  Float32TestMul;
  Float32TestInt;
  IntTestFloat32;
- 
+
  float64TestEqual;
  float64TestLE;
  float64TestLT;
@@ -682,13 +821,18 @@ Begin
  float64TestMul;
  float64TestInt;
  IntTestfloat64;
-
+ { int64 conversion routines }
+ int64testfloat32;
+ int64testfloat64;
 end.
 
 
 {
   $Log$
-  Revision 1.2  2002-10-08 20:09:46  carl
+  Revision 1.3  2002-10-12 20:35:14  carl
+   * int64 to float conversion testing (crashes under FPC :()
+
+  Revision 1.2  2002/10/08 20:09:46  carl
     + reinstated all tests, as they all work correctly now
 
   Revision 1.1  2002/09/16 19:08:30  carl