unit testfpu;

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 sysutils, math,
 _crw_alloc, _crw_fpu;

 {
 Тест проверяет работу модуля _FPU.
 Обычно вычисления выражений типа ln(-1) или 1/0 генерируют исключение.
 Однако во многих приложениях удобнее обойтись без исключений и считать, что
 ln(-1)=NAN (Not A Number,не число)
 1/0=INF (INFinity,бесконечность)
 Тест пробует вычислять ln(-1) и 1/0 сначала без исключений (должно все работать),
 а потом с ними (при этом должно возникнуть исключение).
 }

procedure Test_FPU;

implementation

function hexw(w:word): String; begin Result:=Format('%4.4X',[w]); end;
function f2s(f:Double):String; begin Result:=Format('%g',[f]); end;

procedure Test_FPU;
 procedure Test;
 var X,Y,O:double; e:boolean;
 begin

  X:=0;
  try
   e:=false;
   X:=ln(-1);
  except
   e:=true;
  end;
  writeln('ln(-1) = ':14,X:14);
  writeln('Exception = ':14,e:14);

  Y:=0;
  O:=0;
  try
   e:=false;
   Y:=1/O;
  except
   e:=true;
  end;
  writeln('1/0 = ':14,Y:14);
  writeln('Exception = ':14,e:14);

  X:=_NAN;
  writeln('_NAN = ':14,X:14);
  X:=_PlusINF;
  writeln('_PlusINF = ':14,X:14);

  X:=_MinusINF;
  writeln('_MinusINF = ':14,X:14);

 end;
var
 f,r:double;
begin
 writeln;
 writeln('****** _fpu unit test ***************');
 writeln('Math chip installed = ',FpuInstalled);
 writeln('Get8087CW           = ',hexw(Get8087CW));
 writeln('Fpu Startup Modes   = ',GetFpuModesAsText(FpuStartupModes));
 writeln('Fpu Current Modes   = ',GetFpuModesAsText(FpuGetCurrentModes));
 writeln;
 writeln('Let''s generate ln(-1) and 1/0 situation with exceptions is off.');
 writeln('NAN and INF expected:');
 FpuSetExceptions(false);
 Test;
 writeln;
 writeln('Let''s generate ln(-1) and 1/0 situation with exceptions is on.');
 writeln('Now program may halted becouse invalid float operation');
 FpuSetExceptions(true);
 Test;
 FpuSetExceptions(false);
 writeln;
 writeln('function isnan,isinf,isnanorinf:');
 f:=_nan;
 writeln('  ',f:4,' isnan=',isnan(f):5,' isinf=',isinf(f):5,' isnanorinf=',isnanorinf(f):5);
 f:=_plusinf;
 writeln('  ',f:4,' isnan=',isnan(f):5,' isinf=',isinf(f):5,' isnanorinf=',isnanorinf(f):5);
 f:=_minusinf;
 writeln('  ',f:4,' isnan=',isnan(f):5,' isinf=',isinf(f):5,' isnanorinf=',isnanorinf(f):5);
 writeln;
 f:=ln(-1);
 writeln('  ',f:4,' isnan=',isnan(f):5,' isinf=',isinf(f):5,' isnanorinf=',isnanorinf(f):5);
 f:=1/0;
 writeln('  ',f:4,' isnan=',isnan(f):5,' isinf=',isinf(f):5,' isnanorinf=',isnanorinf(f):5);
 f:=-1/0;
 writeln('  ',f:4,' isnan=',isnan(f):5,' isinf=',isinf(f):5,' isnanorinf=',isnanorinf(f):5);
 writeln;
 writeln('FPU status:');
 writeln('Clear FPU:');
 f:=0;
 FpuSetExceptions(false);
 FpuClearExceptions;

 writeln('  ',f2s(f),' FPU: ',GetFpuModesAsText(FpuGetCurrentModes));
 writeln('ln(-1):');
 f:=ln(-1);
 writeln('  ',f2s(f),' FPU: ',GetFpuModesAsText(FpuGetCurrentModes));
 FpuClearExceptions;
 f:=frac(f);
 writeln(f);
 writeln('1/0:');
 f:=1/0;
 writeln('  ',f2s(f),' FPU: ',GetFpuModesAsText(FpuGetCurrentModes));
 FpuClearExceptions;
 f:=frac(f);
 writeln('  ',f2s(f),' FPU: ',GetFpuModesAsText(FpuGetCurrentModes));
 //writeln('Press a key...');
 //readln;

 {
 check rounding
 }
 FpuSetExceptions(false);
 FpuClearExceptions;
 r:=ln(-1);     writeln('  ',r:30,'  ',f2s(r));
 r:=frac(r);
 r:=+1.0/0.0;   writeln('  ',r:30,'  ',f2s(r));
 r:=frac(r);
 r:=-1.0/0.0;   writeln('  ',r:30,'  ',f2s(r));
 r:=frac(r);

 writeln('********** End Test *****************');
 FpuSetExceptions(false);
end;


end.
