123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827 |
- {****************************************************************}
- { Softfloat module testsuit }
- {****************************************************************}
- { Copyright (c) 2002 Carl Eric Codere }
- {****************************************************************}
- program sfttst;
- uses softfpu;
- {$E+}
- procedure fail;
- begin
- WriteLn('Failed!');
- halt(1);
- end;
- function singletofloat32(r: single):float32;
- var
- _result: float32;
- begin
- move(r,_result, sizeof(r));
- singletofloat32 := _result;
- end;
- function float32tosingle(r: float32): single;
- var
- _result : single;
- begin
- move(r, _result, sizeof(r));
- float32tosingle := _result;
- end;
- function doubletofloat64(r: double):float64;
- var
- _result: float64;
- begin
- move(r,_result, sizeof(r));
- doubletofloat64 := _result;
- end;
- function float64todouble(r: float64): double;
- var
- _result : double;
- begin
- move(r, _result, sizeof(r));
- float64todouble := _result;
- end;
- {******************************************************************************}
- {* single arithmetic *}
- {******************************************************************************}
- Procedure float32TestSub;
- var
- i : single;
- j : single;
- val1,val2 : float32;
- result : boolean;
- Begin
- Write('single - single test...');
- result := true;
- i:=99.9;
- j:=10.0;
- val1:=singletofloat32(i);
- val2:=singletofloat32(j);
- { i:=i-j }
- val1:= float32_sub(val1,val2);
- i:=float32tosingle(val1);
- j:=float32tosingle(val2);
- if trunc(i) <> trunc(89.9) then
- result := false;
- WriteLn('Result (89.9) :',i);
- val1:=singletofloat32(i);
- val2:=singletofloat32(j);
- { i:=j-i }
- val1:= float32_sub(val2,val1);
- i:=float32tosingle(val1);
- j:=float32tosingle(val2);
- if trunc(i) <> trunc(-79.9) then
- result := false;
- WriteLn('Result (-79.9) :',i);
- val1:=singletofloat32(j);
- val2:=singletofloat32(10.0);
- { j:=j-10.0 }
- val1:= float32_sub(val1,val2);
- j:=float32tosingle(val1);
- if j <> 0.0 then
- result := false;
- WriteLn('Result (0.0) :',j);
- if not result then
- Fail
- else
- WriteLn('Success.');
- end;
- procedure float32TestAdd;
- var
- i : single;
- j : single;
- result : boolean;
- val1, val2 : float32;
- Begin
- WriteLn('single + single test...');
- result := 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;
- WriteLn('Result (10.5) :',i);
- i := 326788.12345;
- j := 100.0;
- { i := i + j + 12.5;}
- val1 := singletofloat32(i);
- val2 := singletofloat32(j);
- val1:=float32_add(val1,val2); { i:=i+j }
- val1:=float32_add(val1,singletofloat32(12.5));
- i:=float32tosingle(val1);
- if trunc(i) <> trunc(326900.12345) then
- result := false;
- WriteLn('Result (326900.12345) :',i);
- if not result then
- Fail
- else
- WriteLn('Success.');
- end;
- procedure float32testmul;
- var
- i : single;
- j : single;
- result : boolean;
- val1 : float32;
- begin
- WriteLn('single * single test...');
- result := 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;
- WriteLn('Result (234332.1) :',i);
- i := 10.0;
- j := -12.0;
- { i := i * j * 10.0;}
- val1:=float32_mul(float32_mul(singletofloat32(i),singletofloat32(j)),singletofloat32(10.0));
- i:=float32tosingle(val1);
- if trunc(i) <> trunc(-1200.0) then
- result := false;
- WriteLn('Result (-1200.0) :',i);
- if not result then
- Fail
- else
- WriteLn('Success.');
- end;
- Procedure float32TestDiv;
- var
- i : single;
- j : single;
- val1 : float32;
- result : boolean;
- Begin
- result := true;
- WriteLn('single / single test...');
- i:=-99.9;
- j:=10.0;
- { i:=i / 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));
- 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));
- j:=float32tosingle(val1);
- if trunc(j) <> trunc(-0.1001) then
- result := false;
- WriteLn('Result (-0.1001) :',j);
- if not result then
- Fail
- else
- WriteLn('Success.');
- end;
- procedure float32testequal;
- var
- i : single;
- j : single;
- result : boolean;
- val1,val2 : float32;
- begin
- result := 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;
- i := -112345.1;
- j := -112345.1;
- val1 := singletofloat32(i);
- 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);
- if (float32_eq(val1,val2)=0) then
- result := false;
- i := -4502028.1125E+03;
- j := -4502028.1125E+03;
- val1 := singletofloat32(i);
- 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);
- if (float32_eq(val1,val2)<>0) then
- result := false;
- if not result then
- Fail
- else
- WriteLn('Success.');
- end;
- procedure float32testle;
- var
- i : single;
- j : single;
- result : boolean;
- val1,val2: float32;
- begin
- result := 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;
- i := 10000.0;
- j := 999.0;
- val1 := singletofloat32(i);
- val2 := singletofloat32(j);
- if (float32_le(val2,val1)=0) then
- result := 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
- Fail
- else
- WriteLn('Success.');
- end;
- procedure float32testlt;
- var
- i : single;
- j : single;
- val1,val2 : float32;
- result : boolean;
- begin
- result := 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;
- i := 999.0;
- j := 1000.0;
- val1 := singletofloat32(i);
- val2 := singletofloat32(j);
- if (float32_lt(val1,val2)=0) then
- result := 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
- Fail
- else
- WriteLn('Success.');
- end;
- procedure Float32TestInt;
- var
- _result : longint;
- result : boolean;
- begin
- result := true;
- Write('Single to Longint test...');
- _result:=float32_to_int32(singletofloat32(-12.12345));
- if _result <> -12 then
- result := false;
- _result:=float32_to_int32(singletofloat32(12.52345));
- if _result <> 13 then
- result := false;
- _result:=float32_to_int32(singletofloat32(-0.01));
- if _result <> 0 then
- result := false;
- if not result then
- Fail
- else
- WriteLn('Success.');
- end;
- {Procedure int32_to_float32( a: int32; var c: float32 ); }
- procedure IntTestFloat32;
- var
- result : boolean;
- val1 : float32;
- begin
- result := true;
- Write('Longint to single test...');
- val1:=int32_to_float32($8000);
- if float32tosingle(val1) <> $8000 then
- result := false;
- val1:=int32_to_float32(-1);
- if float32tosingle(val1) <> -1 then
- result := false;
- val1:=int32_to_float32(0);
- if (float32tosingle(val1)) <> 0.0 then
- result := false;
- val1:=int32_to_float32(-217000000);
- if float32tosingle(val1) <> -217000000 then
- result := false;
- if not result then
- Fail
- else
- WriteLn('Success.');
- end;
- {******************************************************************************}
- {* double arithmetic *}
- {******************************************************************************}
- Procedure float64TestSub;
- var
- i : double;
- j : double;
- val1,val2 : float64;
- result : boolean;
- Begin
- Write('Double - Double test...');
- result := true;
- i:=99.9;
- j:=10.0;
- val1:=doubletofloat64(i);
- val2:=doubletofloat64(j);
- { i:=i-j }
- float64_sub(val1,val2,val1);
- i:=float64todouble(val1);
- j:=float64todouble(val2);
- if trunc(i) <> trunc(89.9) then
- result := false;
- WriteLn('Result (89.9) :',i);
- val1:=doubletofloat64(i);
- val2:=doubletofloat64(j);
- { i:=j-i }
- float64_sub(val2,val1,val1);
- i:=float64todouble(val1);
- j:=float64todouble(val2);
- if trunc(i) <> trunc(-79.9) then
- result := false;
- WriteLn('Result (-79.9) :',i);
- val1:=doubletofloat64(j);
- val2:=doubletofloat64(10.0);
- { j:=j-10.0 }
- float64_sub(val1,val2,val1);
- j:=float64todouble(val1);
- if j <> 0.0 then
- result := false;
- WriteLn('Result (0.0) :',j);
- if not result then
- Fail
- else
- WriteLn('Success.');
- end;
- procedure float64TestAdd;
- var
- i : double;
- j : double;
- result : boolean;
- val1, val2 : float64;
- Begin
- WriteLn('Double + Double test...');
- result := true;
- i:= 9;
- { i:=i+1.5;}
- float64_add(doubletofloat64(i),doubletofloat64(1.5),val1);
- i:=float64todouble(val1);
- if trunc(i) <> trunc(10.5) then
- result := 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);
- i:=float64todouble(val1);
- if trunc(i) <> trunc(326900.12345) then
- result := false;
- WriteLn('Result (326900.12345) :',i);
- if not result then
- Fail
- else
- WriteLn('Success.');
- end;
- procedure float64testmul;
- var
- i : double;
- j : double;
- result : boolean;
- val1 : float64;
- begin
- WriteLn('Double * Double test...');
- result := true;
- i:= 21111.0;
- j:= 11.1;
- { i := i * j * i; }
- float64_mul(doubletofloat64(i),doubletofloat64(j),val1);
- i:=float64todouble(val1);
- if trunc(i) <> trunc(234332.1) then
- result := 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);
- i:=float64todouble(val1);
- if trunc(i) <> trunc(-1200.0) then
- result := false;
- WriteLn('Result (-1200.0) :',i);
- if not result then
- Fail
- else
- WriteLn('Success.');
- end;
- Procedure float64TestDiv;
- var
- i : double;
- j : double;
- val1 : float64;
- result : boolean;
- Begin
- result := true;
- WriteLn('Double / Double test...');
- i:=-99.9;
- j:=10.0;
- { i:=i / j; }
- 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);
- 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);
- j:=float64todouble(val1);
- if trunc(j) <> trunc(-0.1001) then
- result := false;
- WriteLn('Result (-0.1001) :',j);
- if not result then
- Fail
- else
- WriteLn('Success.');
- end;
- procedure float64testequal;
- var
- i : double;
- j : double;
- result : boolean;
- val1,val2 : float64;
- begin
- result := 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;
- i := -112345.1;
- j := -112345.1;
- val1 := doubletofloat64(i);
- 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);
- if (float64_eq(val1,val2)=0) then
- result := false;
- i := -4502028.1125E+03;
- j := -4502028.1125E+03;
- val1 := doubletofloat64(i);
- 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);
- if (float64_eq(val1,val2)<>0) then
- result := false;
- if not result then
- Fail
- else
- WriteLn('Success.');
- end;
- procedure float64testle;
- var
- i : double;
- j : double;
- result : boolean;
- val1,val2: float64;
- begin
- result := 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;
- i := 10000.0;
- j := 999.0;
- val1 := doubletofloat64(i);
- val2 := doubletofloat64(j);
- if (float64_le(val2,val1)=0) then
- result := 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
- Fail
- else
- WriteLn('Success.');
- end;
- procedure float64testlt;
- var
- i : double;
- j : double;
- val1,val2 : float64;
- result : boolean;
- begin
- result := 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;
- i := 999.0;
- j := 1000.0;
- val1 := doubletofloat64(i);
- val2 := doubletofloat64(j);
- if (float64_lt(val1,val2)=0) then
- result := 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
- Fail
- else
- WriteLn('Success.');
- end;
- procedure Float64TestInt;
- var
- _result : longint;
- result : boolean;
- begin
- result := true;
- Write('double to Longint test...');
- _result:=float64_to_int32(doubletofloat64(-12.12345));
- if _result <> -12 then
- result := false;
- _result:=float64_to_int32(doubletofloat64(12.52345));
- if _result <> 13 then
- result := false;
- _result:=float64_to_int32(doubletofloat64(-0.01));
- if _result <> 0 then
- result := false;
- if not result then
- Fail
- else
- WriteLn('Success.');
- end;
- {Procedure int32_to_float64( a: int32; var c: float64 ); }
- procedure IntTestFloat64;
- var
- result : boolean;
- val1 : float64;
- begin
- result := true;
- Write('Longint to double test...');
- int32_to_float64($8000,val1);
- if float64todouble(val1) <> $8000 then
- result := false;
- int32_to_float64(-1,val1);
- if float64todouble(val1) <> -1 then
- result := false;
- int32_to_float64(0,val1);
- if (float64todouble(val1)) <> 0.0 then
- result := false;
- int32_to_float64(-217000000,val1);
- if float64todouble(val1) <> -217000000 then
- result := false;
- if not result then
- Fail
- else
- 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 trunc(sgl) <> 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 trunc(float) <> 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;
- Float32TestLT;
- Float32TestSub;
- Float32TestAdd;
- Float32TestDiv;
- Float32TestMul;
- Float32TestInt;
- IntTestFloat32;
- float64TestEqual;
- float64TestLE;
- float64TestLT;
- float64TestSub;
- float64TestAdd;
- float64TestDiv;
- float64TestMul;
- float64TestInt;
- IntTestfloat64;
- { int64 conversion routines }
- { int64testfloat32;}
- int64testfloat64;
- end.
|