{$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 "clib.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, 10 random integers ... ');
   for i := 1 to 9 do
      write( rand, ', ' );
   writeln( rand );
   srand(2);
   write( 'seed(2), 10 random integers ... ');
   for i := 1 to 9 do
      write( rand, ', ' );
   writeln( rand );

   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;

   writeln( 'test ratios are ', sqr(sum)/sum2/nrSamples:5:2, sum2/diff2:5:2,
           ', expect around 0.75, 2.0' );

   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;

   myProcFlag := true;

end.

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