{$d-  c strings don't work with memory debug
#  // use c preprocessor
   test program for for using c library functions in p5c
}
program tclib(output);
{$d+  restore dubug, leaving memory debug disabled}

#include "cstr.inc.pas"
#include "clib.inc.pas"

{check it can't be included twice}
#include "clib.inc.pas"
#include "cstr.inc.pas"

const nrSamples = 10000;

var
   x,y       : real;
   sum,sum2  : real;
   old,diff2 : real;
   pi        : real;
   eps       : real;
   i         : integer;
   s         : packed array[1..10] of char;
   s1        : packed array[1..20] of char;
   sp, sp1   : cstringPtr;

   pass      : boolean;
   myProcFlag: boolean;

procedure myproc;
begin
   writeln( 'entered myproc' );
   if pass and myProcFlag then
      writeln( 'c library tests passed' )
   else
      writeln( '>>>>>>>>>>>>>>>> c library tests failed' );

end; { myproc }

begin

   pass := true;
   myProcFlag := false;

   pi := 4*arctan(1.0);

   eps := 1;
   repeat
      eps := eps/2;
      x := 1+eps/2;
   until x <= 1;

   writeln( 'testing maths functions from c lib, tolerance is ', eps:8 );

   { test acos() }
   x := acos(1.0);
   if abs(x) > eps then begin
      pass := false;
      writeln('acos(1.0) failed');
   end;

   x := acos(0.0);
   if abs(x - pi/2) > eps then begin
      pass := false;
      writeln('acos(-1.0) failed');
   end;

   x := acos(-1.0);
   if abs(x - pi) > eps then begin
      pass := false;
      writeln('acos(-1.0) failed');
   end;

   { test asin() }
   x := asin(1.0);
   if abs(x - pi/2) > eps then begin
      pass := false;
      writeln('asin(1.0) failed');
   end;

   x := asin(0.0);
   if abs(x - 0.0) > eps then begin
      pass := false;
      writeln('asin(0.0) failed');
   end;

   x := asin(-1.0);
   if abs(-pi/2 - x) > eps then begin
      pass := false;
      writeln('asin(-1.0) failed');
   end;

   { test atan2() }
   x := atan2(0,1);
   if abs(x) > eps then begin
      pass := false;
      writeln('atan2(0,1) failed');
   end;

   x := atan2(1,0);
   if abs(pi/2 - x) > eps then begin
      pass := false;
      writeln('atan2(1,0) failed');
   end;

   x := atan2(0,-1);
   if abs(pi - x) > eps then begin
      pass := false;
      writeln('atan2(0,-1) failed');
   end;

   x := atan2(-1,0);
   if abs(-pi/2 - x) > eps then begin
      pass := false;
      writeln('atan2(-1,0) failed');
   end;


   { test tan() }
   x := tan(0);
   if abs(x) > eps then begin
      pass := false;
      writeln('tan(0) failed');
   end;

   x := tan(pi/4);
   if abs(1 - x) > eps then begin
      pass := false;
      writeln('tan(pi/4) failed');
   end;

   x := tan(-pi/4);
   if abs(-1 - x) > eps then begin
      pass := false;
      writeln('tan(-pi/4) failed');
   end;

   {test hyperbolic functions }
   x := cosh(0);
   if abs(1 - x) > eps then begin
      pass := false;
      writeln('cosh(0) failed');
   end;

   x := cosh(1);
   if abs((exp(1)+exp(-1))/2 - x) > eps then begin
      pass := false;
      writeln('cosh(1) failed');
   end;

   x := sinh(0);
   if abs(x) > eps then begin
      pass := false;
      writeln('sinh(0) failed');
   end;

   x := sinh(1);
   if abs((exp(1)-exp(-1))/2 - x) > eps then begin
      pass := false;
      writeln('sinh(1) failed');
   end;

   x := tanh(0);
   if abs(x) > eps then begin
      pass := false;
      writeln('tanh(0) failed');
   end;

   x := tanh(1);
   if abs(sinh(1)/cosh(1) - x) > eps then begin
      pass := false;
      writeln('tanh(1) failed');
   end;


   { test floor, ceil }
   x := ceil(1.0);
   if x <> 1 then begin
      pass := false;
      writeln('ceil(1.0) failed');
   end;

   x := ceil(-1.0);
   if x <> -1 then begin
      pass := false;
      writeln('ceil(-1.0) failed');
   end;

   x := ceil(1.1);
   if x <> 2 then begin
      pass := false;
      writeln('ceil(1.1) failed');
   end;

   x := ceil(-1.1);
   if x <> -1 then begin
      pass := false;
      writeln('ceil(-1.1) failed');
   end;

   x := floor(1.0);
   if x <> 1 then begin
      pass := false;
      writeln('floor(1.0) failed');
   end;

   x := floor(-1.0);
   if x <> -1 then begin
      pass := false;
      writeln('floor(-1.0) failed');
   end;

   x := floor(1.1);
   if x <> 1 then begin
      pass := false;
      writeln('floor(1.1) failed');
   end;

   x := floor(-1.1);
   if x <> -2 then begin
      pass := false;
      writeln('floor(-1.1) failed');
   end;


   { test fmod }
   x := fmod(10,3);
   if x <> 1 then begin
      pass := false;
      writeln('fmod(10,3) failed');
   end;

   x := fmod(9,3);
   if x <> 0 then begin
      pass := false;
      writeln('fmod(9,3) failed');
   end;

   x := fmod(8,3);
   if x <> 2 then begin
      pass := false;
      writeln('fmod(8,3) failed');
   end;

   x := fmod(7,3);
   if x <> 1 then begin
      pass := false;
      writeln('fmod(7,3) failed');
   end;

   x := fmod(6,3);
   if x <> 0 then begin
      pass := false;
      writeln('fmod(0,3) failed');
   end;

   x := fmod(-7,3);
   if x <> -1 then begin
      pass := false;
      writeln('fmod(-7,3) failed');
   end;


   { test frexp, ldexp }
   x := frexp(256,i);  { 256 == 2 * 2**8, or 0.5 * 2**9 }
   if (x <> 0.5) or (i<>9) then begin
      pass := false;
      writeln('frexp(256,i) failed');
   end;

   x := ldexp(1,8);
   if x <> 256 then begin
      pass := false;
      writeln('ldexp(1,8) failed');
   end;


   { test log10(x) }
   x := log10(100);
   if abs(2 - x) > eps then begin
      pass := false;
      writeln('log10(100) failed');
   end;


   { test modf }
   x := modf(100.6, y);
   if (y <> 100) or (abs(0.6 - x) > 100*eps) then begin
      pass := false;
      writeln('modf(100.6, y) failed');
   end;


   { test pow }
   x := pow( 4, 2.5 ); { 4 ** 2.5 = 4*4*2 = 32 }
   if abs(32 - x) > 32*eps then begin
      pass := false;
      writeln('pow(4,2.5) failed');
   end;

   { test rand }
   //srand(0);
   write( 'default seed, 5 random integers ... ');
   for i := 1 to 5 do
      write( rand, ', ' );
   writeln( rand );

   srand(2);srand(rand);
   x := 0;
   for i := 1 to 100 do
      x := x + rand/maxint;
   writeln( 'seed(2), 100 random reals ... sum is ', x:1:4);

   srand(0);
   write( 'seed(0), 5 random integers ... ');
   for i := 1 to 5 do
      write( rand, ', ' );
   writeln( rand );

   srand(2); srand(rand);
   y := 0;
   for i := 1 to 100 do
      y := y + rand/maxint;
   if abs(x-y) > 0 then begin
      pass := false;
      writeln( 'fail: seed(2), 10 random reals ... sum should be identical ', y:1:4);
   end;

   sum := 0; sum2 := 0;
   srand(2001);
   old := rand; diff2 := 0;
   for i := 1 to nrSamples do begin
      x := rand;
      sum := sum + x;
      sum2 := sum2 + sqr(x);
      diff2 := diff2 + sqr (x - old);
      old := x;
   end;

   x := sqr(sum)/sum2/nrSamples;
   y := sum2/diff2;
   writeln( 'test ratios are ', x:5:2, ', ', y:5:2, ', expect around 0.75, 2.0' );
   if (abs(x - 0.75) > 0.05) or (abs(y - 2) > 0.05) then begin
      pass := false;
      writeln('rand() failed');
   end;

   if atexit(myproc) <> 0 then begin
      pass := false;
      writeln('atexit failed');
   end;

   writeln( 'testing string functions' );
   s := '123456789 ';
   sp := getcstrPtr(s);
   for i := 1 to 9 do begin
      if s[i] <> sp^[i] then begin
         pass := false;
         writeln('getcstrPtr failed, i is ', i:1);
      end;
   end;
   sp^[10] := chr(0);
   if Strlen(sp^[1]) <> 9 then begin
      pass := false;
      writeln( 'Strlen failed, s length is ', Strlen(sp^[1]) );
   end;
   if Strlen(sp^[2]) <> 8 then begin
      pass := false;
      writeln( 'Strlen failed, s[1] length is ', Strlen(sp^[2]) );
   end;

   s1 := 'abcdefghij          ';
   s1[11] := chr(0);  { s1[11] == ps1^[10] }
   sp1 := getcstrPtr(s1);
   if Strlen(sp1^[1]) <> 10 then begin
      pass := false;
      writeln( 'Strlen failed, s1 length is ', Strlen(sp1^[1]) );
   end;

   Strcpy( sp1^[1], sp^[3] );  {copy starts at 3rd char of src}
   if Strlen(sp1^[1]) <> 7 then begin
      pass := false;
      writeln( 'after Strcpy, s1 length is ', Strlen(sp1^[1]) );
   end;

   { s1 is '3456789' }
   i := 1;
   while i <= Strlen(sp1^[1]) do begin
      if ord(s1[i]) <> ord('3') - 1 + i then begin
         pass := false;
         writeln('after Strcpy, s1[', i:1, '] is ''', s1[i], ''', expected ''',
                 chr(ord('3') + 1 - i), '''');
      end;
      i := i+1;
   end;
   if s1[i] <> chr(0) then begin
      writeln('Strcpy test problem, s1 is ''', s1, '''');
   end;

   { s1 is '34567893456789' }
   Strcat( sp1^[1], sp^[3] );
   if Strlen(sp1^[1]) <> 14 then begin
      pass := false;
      writeln('Strcat failed, s1 length is now ', Strlen(sp1^[1]) );
   end;
   i := 1;
   while i <= Strlen(sp1^[1]) div 2 do begin
      if ord(s1[i]) <> ord('3') - 1 + i then begin
         pass := false;
         writeln('after Strcat, s1[', i:1, '] is ''', s1[i], ''', expected ''',
                 chr(ord('3') + 1 - i), '''');
      end;
      if ord(s1[i+7]) <> ord('3') - 1 + i then begin
         pass := false;
         writeln('after Strcat, s1[', i+7:1, '] is ''', s1[i+7], ''', expected ''',
                 chr(ord('3') + 1 - i), '''');
      end;
      i := i+1;
   end;

   if Strcmp(sp^[3], sp1^[8]) <> 0 then begin
      pass := false;
      writeln('Strcmp failed for equal');
   end;

   sp^[3] := succ(sp^[3]);
   if Strcmp(sp^[3], sp1^[8]) <> 1 then begin
      pass := false;
      writeln('Strcmp failed for greater than');
   end;
   if Strcmp(sp1^[8], sp^[3]) <> -1 then begin
      pass := false;
      writeln('Strcmp failed for less than');
   end;

   { test system() }
   writeln('testing system()');
   s[1] := chr(0); {s is now the empty string}
   if system(s) = 0 then begin
      writeln('system() failed: there is no shell to run a command');
      pass := false;
   end
   else begin
      s1 := 'echo "system is OK" ';
      s1[20] := chr(0); {string must be null terminated}
      {writeln('running a command ... ''', s1, '''');}
      i := system(s1);
      if i <> 0 then begin
         writeln('problem with system(), result is ', i);
         pass := false;
      end;
   end;

   myProcFlag := true;

   exit(0);
   writeln('exit() test failed');
end.

{%%%%%%%%%%%%%%%%%%%%%%%%%%%%% end of tclib.pas %%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
