+ currency testing

  * more system unit routine testing

tests/test/units/system/tabs.pp

@@ -0,0 +1,274 @@
+{ Part of System unit testsuit        }
+{ Carl Eric Codere Copyright (c) 2002 }
+program tabs;
+
+{$APPTYPE CONSOLE}
+{$R+}
+{$Q+}
+
+const
+  RESULT_ONE_INT = 65536;
+  VALUE_ONE_INT = -65536;
+  RESULT_CONST_ONE_INT = abs(VALUE_ONE_INT);
+  RESULT_TWO_INT = 12345;
+  VALUE_TWO_INT = 12345;
+  RESULT_CONST_TWO_INT = abs(VALUE_TWO_INT);
+  
+  RESULT_THREE_INT = 2147483647;
+  VALUE_THREE_INT = -2147483647;
+  RESULT_CONST_THREE_INT = abs(VALUE_THREE_INT);
+  RESULT_FOUR_INT = 2147483647;
+  VALUE_FOUR_INT = 2147483647;
+  RESULT_CONST_FOUR_INT = abs(VALUE_FOUR_INT);
+  
+
+  RESULT_ONE_REAL = 12345.6789;
+  VALUE_ONE_REAL = -12345.6789;
+  RESULT_CONST_ONE_REAL = abs(VALUE_ONE_REAL);
+  RESULT_TWO_REAL = 54321.6789E+02;
+  VALUE_TWO_REAL = 54321.6789E+02;
+  RESULT_CONST_TWO_REAL = abs(VALUE_TWO_REAL);
+  
+  RESULT_THREE_REAL = 0.0;
+  VALUE_THREE_REAL = 0.0;
+  RESULT_CONST_THREE_REAL = abs(VALUE_THREE_REAL);
+  RESULT_FOUR_REAL = 12.0;
+  VALUE_FOUR_REAL = -12.0;
+  RESULT_CONST_FOUR_REAL = abs(VALUE_FOUR_REAL);
+
+ 
+procedure fail;
+ begin
+  WriteLn('Failure!');
+  halt(1);
+ end;
+ 
+
+ procedure test_abs_currency;
+  var
+   _result : boolean;
+   value : currency;
+   value1: currency;
+  begin
+    Write('Abs() test with currency type...');
+    _result := true;
+    
+    value := VALUE_ONE_REAL;
+    if (trunc(abs(value)) <> trunc(RESULT_CONST_ONE_REAL))  then
+       _result := false;
+       
+    value := VALUE_TWO_REAL;
+    if trunc(abs(value)) <> trunc(RESULT_CONST_TWO_REAL) then
+       _result := false;
+
+    value := VALUE_THREE_REAL;
+    if trunc(abs(value)) <> trunc(RESULT_CONST_THREE_REAL) then
+       _result := false;
+       
+    value := VALUE_FOUR_REAL;
+    if trunc(abs(value)) <> trunc(RESULT_CONST_FOUR_REAL) then
+       _result := false;
+
+    value := VALUE_ONE_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_ONE_REAL) then
+       _result := false;
+       
+    value := VALUE_TWO_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_TWO_REAL) then
+       _result := false;
+
+    value := VALUE_THREE_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_THREE_REAL) then
+       _result := false;
+       
+    value := VALUE_FOUR_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_FOUR_REAL) then
+       _result := false;
+
+       
+    if not _result then
+      fail
+    else
+      WriteLn('Success!');
+  end;
+
+
+
+ procedure test_abs_int64;
+  var
+   _result : boolean;
+   value : int64;
+   value1: int64;
+  begin
+    Write('Abs() test with int64 type...');
+    _result := true;
+
+   value := VALUE_ONE_INT;
+    if (abs(value) <> (RESULT_CONST_ONE_INT))  then
+       _result := false;
+       
+       
+    value := VALUE_TWO_INT;
+    if abs(value) <> (RESULT_CONST_TWO_INT) then
+       _result := false;
+
+    value := VALUE_THREE_INT;
+    if abs(value) <> (RESULT_CONST_THREE_INT) then
+       _result := false;
+       
+    value := VALUE_FOUR_INT;
+    if abs(value) <> (RESULT_CONST_FOUR_INT) then
+       _result := false;
+
+    value := VALUE_ONE_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_ONE_INT) then
+       _result := false;
+       
+    value := VALUE_TWO_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_TWO_INT) then
+       _result := false;
+
+    value := VALUE_THREE_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_THREE_INT) then
+       _result := false;
+       
+    value := VALUE_FOUR_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_FOUR_INT) then
+       _result := false;
+    
+    if not _result then
+      fail
+    else
+      WriteLn('Success!');
+  end;
+
+  
+ procedure test_abs_longint;
+  var
+   _result : boolean;
+   value : longint;
+   value1: longint;
+  begin
+    Write('Abs() test with longint type...');
+    _result := true;
+    
+   value := VALUE_ONE_INT;
+    if (abs(value) <> (RESULT_CONST_ONE_INT))  then
+       _result := false;
+       
+       
+    value := VALUE_TWO_INT;
+    if abs(value) <> (RESULT_CONST_TWO_INT) then
+       _result := false;
+
+    value := VALUE_THREE_INT;
+    if abs(value) <> (RESULT_CONST_THREE_INT) then
+       _result := false;
+       
+    value := VALUE_FOUR_INT;
+    if abs(value) <> (RESULT_CONST_FOUR_INT) then
+       _result := false;
+
+    value := VALUE_ONE_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_ONE_INT) then
+       _result := false;
+       
+    value := VALUE_TWO_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_TWO_INT) then
+       _result := false;
+
+    value := VALUE_THREE_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_THREE_INT) then
+       _result := false;
+       
+    value := VALUE_FOUR_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_FOUR_INT) then
+       _result := false;
+    
+    if not _result then
+      fail
+    else
+      WriteLn('Success!');
+  end;
+  
+ procedure test_abs_real; 
+  var
+   _result : boolean;
+   value : real;
+   value1: real;
+  begin
+    _result := true;
+    Write('Abs() test with real type...');
+    
+    value := VALUE_ONE_REAL;
+    if (trunc(abs(value)) <> trunc(RESULT_CONST_ONE_REAL))  then
+       _result := false;
+       
+    value := VALUE_TWO_REAL;
+    if trunc(abs(value)) <> trunc(RESULT_CONST_TWO_REAL) then
+       _result := false;
+
+    value := VALUE_THREE_REAL;
+    if trunc(abs(value)) <> trunc(RESULT_CONST_THREE_REAL) then
+       _result := false;
+       
+    value := VALUE_FOUR_REAL;
+    if trunc(abs(value)) <> trunc(RESULT_CONST_FOUR_REAL) then
+       _result := false;
+
+    value := VALUE_ONE_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_ONE_REAL) then
+       _result := false;
+       
+    value := VALUE_TWO_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_TWO_REAL) then
+       _result := false;
+
+    value := VALUE_THREE_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_THREE_REAL) then
+       _result := false;
+       
+    value := VALUE_FOUR_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_FOUR_REAL) then
+       _result := false;
+    
+    if not _result then
+      fail
+    else
+      WriteLn('Success!');
+  end;
+
+var
+ r: longint;
+ _success : boolean;
+ l: boolean;
+Begin
+  test_abs_currency;
+  test_abs_real;
+  test_abs_longint;
+  test_abs_int64;
+end.
+
+{
+ $Log$
+ Revision 1.1  2002-09-18 18:30:30  carl
+   + currency testing
+   * more system unit routine testing
+
+} 

tests/test/units/system/tassert7.pp

@@ -0,0 +1,30 @@
+program tassert7;
+{$C+}
+{$mode objfpc}
+
+uses sysutils;
+
+procedure Success;
+ Begin
+   WriteLn('Success!');
+   halt;
+ end;
+
+Begin
+  Write('Try..catch of assertion...');
+  try
+    assert(false);
+  except
+    on EAssertionFailed do Success;
+  end;  
+  WriteLn('Failed!');
+  Halt(1);
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-09-18 18:30:30  carl
+    + currency testing
+    * more system unit routine testing
+
+}

tests/test/units/system/tint.pp

@@ -18,11 +18,12 @@ const
     halt(1);
   end;
 
+procedure test_int_real;
 var
  r: real;
  _success : boolean;
 Begin
- Write('Int() testing...');
+ Write('Int() real testing...');
  _success := true;
  r:=INT_VALUE_ONE;
  if Int(r)<>INT_RESULT_ONE then
@@ -61,11 +62,160 @@ Begin
  if not _success then
    fail;
  WriteLn('Success!');
+end;
+
+procedure test_int_single;
+var
+ r: single;
+ _success : boolean;
+Begin
+ Write('Int() single testing...');
+ _success := true;
+ r:=INT_VALUE_ONE;
+ if Int(r)<>INT_RESULT_ONE then
+   _success:=false;
+ if Int(INT_VALUE_ONE)<>INT_RESULT_ONE then
+   _success:=false;
+ r:=INT_VALUE_ONE;
+ if Int(r)<>INT_RESULT_CONST_ONE then
+   _success := false;
+ r:=INT_VALUE_ONE;
+ r:=Int(r);
+ if r<>INT_RESULT_ONE then
+   _success:=false;
+ r:=Int(INT_VALUE_ONE);
+ if r<>INT_RESULT_ONE then
+   _success:=false;
+
+
+ r:=INT_VALUE_TWO;
+ if Int(r)<>INT_RESULT_TWO then
+   _success:=false;
+ if Int(INT_VALUE_TWO)<>INT_RESULT_TWO then
+   _success:=false;
+ r:=INT_VALUE_TWO;
+ if Int(r)<>INT_RESULT_CONST_TWO then
+   _success := false;
+ r:=INT_VALUE_TWO;
+ r:=Int(r);
+ if r<>INT_RESULT_TWO then
+   _success:=false;
+ r:=Int(INT_VALUE_TWO);
+ if r<>INT_RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+
+procedure test_int_double;
+var
+ r: double;
+ _success : boolean;
+Begin
+ Write('Int() double testing...');
+ _success := true;
+ r:=INT_VALUE_ONE;
+ if Int(r)<>INT_RESULT_ONE then
+   _success:=false;
+ if Int(INT_VALUE_ONE)<>INT_RESULT_ONE then
+   _success:=false;
+ r:=INT_VALUE_ONE;
+ if Int(r)<>INT_RESULT_CONST_ONE then
+   _success := false;
+ r:=INT_VALUE_ONE;
+ r:=Int(r);
+ if r<>INT_RESULT_ONE then
+   _success:=false;
+ r:=Int(INT_VALUE_ONE);
+ if r<>INT_RESULT_ONE then
+   _success:=false;
+
+
+ r:=INT_VALUE_TWO;
+ if Int(r)<>INT_RESULT_TWO then
+   _success:=false;
+ if Int(INT_VALUE_TWO)<>INT_RESULT_TWO then
+   _success:=false;
+ r:=INT_VALUE_TWO;
+ if Int(r)<>INT_RESULT_CONST_TWO then
+   _success := false;
+ r:=INT_VALUE_TWO;
+ r:=Int(r);
+ if r<>INT_RESULT_TWO then
+   _success:=false;
+ r:=Int(INT_VALUE_TWO);
+ if r<>INT_RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+
+procedure test_int_currency;
+var
+ r: currency;
+ _success : boolean;
+Begin
+ Write('Int() currency testing...');
+ _success := true;
+ r:=INT_VALUE_ONE;
+ if Int(r)<>INT_RESULT_ONE then
+   _success:=false;
+ if Int(INT_VALUE_ONE)<>INT_RESULT_ONE then
+   _success:=false;
+ r:=INT_VALUE_ONE;
+ if Int(r)<>INT_RESULT_CONST_ONE then
+   _success := false;
+ r:=INT_VALUE_ONE;
+ r:=Int(r);
+ if r<>INT_RESULT_ONE then
+   _success:=false;
+ r:=Int(INT_VALUE_ONE);
+ if r<>INT_RESULT_ONE then
+   _success:=false;
+
+
+ r:=INT_VALUE_TWO;
+ if Int(r)<>INT_RESULT_TWO then
+   _success:=false;
+ if Int(INT_VALUE_TWO)<>INT_RESULT_TWO then
+   _success:=false;
+ r:=INT_VALUE_TWO;
+ if Int(r)<>INT_RESULT_CONST_TWO then
+   _success := false;
+ r:=INT_VALUE_TWO;
+ r:=Int(r);
+ if r<>INT_RESULT_TWO then
+   _success:=false;
+ r:=Int(INT_VALUE_TWO);
+ if r<>INT_RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+
+Begin
+  test_int_real;
+  test_int_double;
+  test_int_single;
+  test_int_currency;
 end.
 
 {
   $Log$
-  Revision 1.1  2002-09-16 19:15:54  carl
+  Revision 1.2  2002-09-18 18:30:30  carl
+    + currency testing
+    * more system unit routine testing
+
+  Revision 1.1  2002/09/16 19:15:54  carl
     * several new routines have a testsuit.
 
 }

tests/test/units/system/todd.pp

@@ -0,0 +1,72 @@
+{ Part of System unit testsuit        }
+{ Carl Eric Codere Copyright (c) 2002 }
+program todd;
+
+const
+  RESULT_ONE = FALSE;
+  VALUE_ONE = -65536;
+  RESULT_CONST_ONE = odd(VALUE_ONE);
+  RESULT_TWO = TRUE;
+  VALUE_TWO = 12345;
+  RESULT_CONST_TWO = odd(VALUE_TWO);
+  
+ 
+procedure fail;
+ begin
+  WriteLn('Failure!');
+  halt(1);
+ end;
+
+var
+ r: longint;
+ _success : boolean;
+ l: boolean;
+Begin
+ Write('Odd() testing...');
+ _success := true;
+ r:=VALUE_ONE;
+ if odd(r)<>RESULT_ONE then
+   _success:=false;
+ if odd(VALUE_ONE)<>RESULT_ONE then
+   _success:=false;
+ r:=VALUE_ONE;
+ if odd(r)<>RESULT_CONST_ONE then
+   _success := false;
+ r:=VALUE_ONE;
+ l:=odd(r);
+ if l<>RESULT_ONE then
+   _success:=false;
+ l:=odd(VALUE_ONE);
+ if l<>RESULT_ONE then
+   _success:=false;
+
+
+ r:=VALUE_TWO;
+ if odd(r)<>RESULT_TWO then
+   _success:=false;
+ if odd(VALUE_TWO)<>RESULT_TWO then
+   _success:=false;
+ r:=VALUE_TWO;
+ if odd(r)<>RESULT_CONST_TWO then
+   _success := false;
+ r:=VALUE_TWO;
+ l:=odd(r);
+ if l<>RESULT_TWO then
+   _success:=false;
+ l:=odd(VALUE_TWO);
+ if l<>RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end.
+
+{
+ $Log$
+ Revision 1.1  2002-09-18 18:30:30  carl
+   + currency testing
+   * more system unit routine testing
+
+} 

tests/test/units/system/tround.pp

@@ -1,5 +1,7 @@
 { this tests the round routine }
-program ttrunc;
+program tround;
+
+{$APPTYPE CONSOLE}
 
 const
   RESULT_ONE = 1235;
@@ -16,12 +18,108 @@ const
     halt(1);
   end;
 
+procedure test_round_real;
 var
  r: real;
  _success : boolean;
  l: longint;
 Begin
- Write('Round() testing...');
+ Write('Round() real testing...');
+ _success := true;
+ r:=VALUE_ONE;
+ if round(r)<>RESULT_ONE then
+   _success:=false;
+ if round(VALUE_ONE)<>RESULT_ONE then
+   _success:=false;
+ r:=VALUE_ONE;
+ if round(r)<>RESULT_CONST_ONE then
+   _success := false;
+ r:=VALUE_ONE;
+ l:=round(r);
+ if l<>RESULT_ONE then
+   _success:=false;
+ l:=round(VALUE_ONE);
+ if l<>RESULT_ONE then
+   _success:=false;
+
+
+ r:=VALUE_TWO;
+ if round(r)<>RESULT_TWO then
+   _success:=false;
+ if round(VALUE_TWO)<>RESULT_TWO then
+   _success:=false;
+ r:=VALUE_TWO;
+ if round(r)<>RESULT_CONST_TWO then
+   _success := false;
+ r:=VALUE_TWO;
+ l:=round(r);
+ if l<>RESULT_TWO then
+   _success:=false;
+ l:=round(VALUE_TWO);
+ if l<>RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+
+
+procedure test_round_single;
+var
+ r: single;
+ _success : boolean;
+ l: longint;
+Begin
+ Write('Round() single testing...');
+ _success := true;
+ r:=VALUE_ONE;
+ if round(r)<>RESULT_ONE then
+   _success:=false;
+ if round(VALUE_ONE)<>RESULT_ONE then
+   _success:=false;
+ r:=VALUE_ONE;
+ if round(r)<>RESULT_CONST_ONE then
+   _success := false;
+ r:=VALUE_ONE;
+ l:=round(r);
+ if l<>RESULT_ONE then
+   _success:=false;
+ l:=round(VALUE_ONE);
+ if l<>RESULT_ONE then
+   _success:=false;
+
+
+ r:=VALUE_TWO;
+ if round(r)<>RESULT_TWO then
+   _success:=false;
+ if round(VALUE_TWO)<>RESULT_TWO then
+   _success:=false;
+ r:=VALUE_TWO;
+ if round(r)<>RESULT_CONST_TWO then
+   _success := false;
+ r:=VALUE_TWO;
+ l:=round(r);
+ if l<>RESULT_TWO then
+   _success:=false;
+ l:=round(VALUE_TWO);
+ if l<>RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+
+procedure test_round_double;
+var
+ r: double;
+ _success : boolean;
+ l: longint;
+Begin
+ Write('Round() double testing...');
  _success := true;
  r:=VALUE_ONE;
  if round(r)<>RESULT_ONE then
@@ -60,11 +158,73 @@ Begin
  if not _success then
    fail;
  WriteLn('Success!');
+end;
+
+
+procedure test_round_currency;
+var
+ r: currency;
+ _success : boolean;
+ l: longint;
+Begin
+ Write('Round() currency testing...');
+ _success := true;
+ r:=VALUE_ONE;
+ if round(r)<>RESULT_ONE then
+   _success:=false;
+ if round(VALUE_ONE)<>RESULT_ONE then
+   _success:=false;
+ r:=VALUE_ONE;
+ if round(r)<>RESULT_CONST_ONE then
+   _success := false;
+ r:=VALUE_ONE;
+ l:=round(r);
+ if l<>RESULT_ONE then
+   _success:=false;
+ l:=round(VALUE_ONE);
+ if l<>RESULT_ONE then
+   _success:=false;
+
+
+ r:=VALUE_TWO;
+ if round(r)<>RESULT_TWO then
+   _success:=false;
+ if round(VALUE_TWO)<>RESULT_TWO then
+   _success:=false;
+ r:=VALUE_TWO;
+ if round(r)<>RESULT_CONST_TWO then
+   _success := false;
+ r:=VALUE_TWO;
+ l:=round(r);
+ if l<>RESULT_TWO then
+   _success:=false;
+ l:=round(VALUE_TWO);
+ if l<>RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+
+
+
+
+Begin
+  test_round_real;
+  test_round_single;
+  test_round_double;
+  test_round_currency;
 end.
 
 {
   $Log$
-  Revision 1.1  2002-09-16 19:15:54  carl
+  Revision 1.2  2002-09-18 18:30:30  carl
+    + currency testing
+    * more system unit routine testing
+
+  Revision 1.1  2002/09/16 19:15:54  carl
     * several new routines have a testsuit.
 
 }

tests/test/units/system/ttrunc.pp

@@ -1,6 +1,8 @@
 { this tests the trunc routine }
 program ttrunc;
 
+{$APPTYPE CONSOLE}
+
 const
   RESULT_ONE = 1234;
   VALUE_ONE = 1234.5678;
@@ -16,12 +18,156 @@ const
     halt(1);
   end;
 
+procedure test_trunc_real;
 var
  r: real;
  _success : boolean;
  l: longint;
 Begin
- Write('Trunc() testing...');
+ Write('Trunc() real testing...');
+ _success := true;
+ r:=VALUE_ONE;
+ if Trunc(r)<>RESULT_ONE then
+   _success:=false;
+ if Trunc(VALUE_ONE)<>RESULT_ONE then
+   _success:=false;
+ r:=VALUE_ONE;
+ if Trunc(r)<>RESULT_CONST_ONE then
+   _success := false;
+ r:=VALUE_ONE;
+ l:=Trunc(r);
+ if l<>RESULT_ONE then
+   _success:=false;
+ l:=Trunc(VALUE_ONE);
+ if l<>RESULT_ONE then
+   _success:=false;
+
+
+ r:=VALUE_TWO;
+ if Trunc(r)<>RESULT_TWO then
+   _success:=false;
+ if Trunc(VALUE_TWO)<>RESULT_TWO then
+   _success:=false;
+ r:=VALUE_TWO;
+ if Trunc(r)<>RESULT_CONST_TWO then
+   _success := false;
+ r:=VALUE_TWO;
+ l:=Trunc(r);
+ if l<>RESULT_TWO then
+   _success:=false;
+ l:=Trunc(VALUE_TWO);
+ if l<>RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+
+procedure test_trunc_single;
+var
+ r: single;
+ _success : boolean;
+ l: longint;
+Begin
+ Write('Trunc() single testing...');
+ _success := true;
+ r:=VALUE_ONE;
+ if Trunc(r)<>RESULT_ONE then
+   _success:=false;
+ if Trunc(VALUE_ONE)<>RESULT_ONE then
+   _success:=false;
+ r:=VALUE_ONE;
+ if Trunc(r)<>RESULT_CONST_ONE then
+   _success := false;
+ r:=VALUE_ONE;
+ l:=Trunc(r);
+ if l<>RESULT_ONE then
+   _success:=false;
+ l:=Trunc(VALUE_ONE);
+ if l<>RESULT_ONE then
+   _success:=false;
+
+
+ r:=VALUE_TWO;
+ if Trunc(r)<>RESULT_TWO then
+   _success:=false;
+ if Trunc(VALUE_TWO)<>RESULT_TWO then
+   _success:=false;
+ r:=VALUE_TWO;
+ if Trunc(r)<>RESULT_CONST_TWO then
+   _success := false;
+ r:=VALUE_TWO;
+ l:=Trunc(r);
+ if l<>RESULT_TWO then
+   _success:=false;
+ l:=Trunc(VALUE_TWO);
+ if l<>RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+
+
+procedure test_trunc_double;
+var
+ r: double;
+ _success : boolean;
+ l: longint;
+Begin
+ Write('Trunc() double testing...');
+ _success := true;
+ r:=VALUE_ONE;
+ if Trunc(r)<>RESULT_ONE then
+   _success:=false;
+ if Trunc(VALUE_ONE)<>RESULT_ONE then
+   _success:=false;
+ r:=VALUE_ONE;
+ if Trunc(r)<>RESULT_CONST_ONE then
+   _success := false;
+ r:=VALUE_ONE;
+ l:=Trunc(r);
+ if l<>RESULT_ONE then
+   _success:=false;
+ l:=Trunc(VALUE_ONE);
+ if l<>RESULT_ONE then
+   _success:=false;
+
+
+ r:=VALUE_TWO;
+ if Trunc(r)<>RESULT_TWO then
+   _success:=false;
+ if Trunc(VALUE_TWO)<>RESULT_TWO then
+   _success:=false;
+ r:=VALUE_TWO;
+ if Trunc(r)<>RESULT_CONST_TWO then
+   _success := false;
+ r:=VALUE_TWO;
+ l:=Trunc(r);
+ if l<>RESULT_TWO then
+   _success:=false;
+ l:=Trunc(VALUE_TWO);
+ if l<>RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+
+
+procedure test_trunc_currency;
+var
+ r: currency;
+ _success : boolean;
+ l: longint;
+Begin
+ Write('Trunc() currency testing...');
  _success := true;
  r:=VALUE_ONE;
  if Trunc(r)<>RESULT_ONE then
@@ -60,11 +206,23 @@ Begin
  if not _success then
    fail;
  WriteLn('Success!');
+end;
+
+
+Begin
+  test_trunc_real;
+  test_trunc_single;
+  test_trunc_double;
+  test_trunc_currency;
 end.
 
 {
   $Log$
-  Revision 1.1  2002-09-16 19:15:54  carl
+  Revision 1.2  2002-09-18 18:30:30  carl
+    + currency testing
+    * more system unit routine testing
+
+  Revision 1.1  2002/09/16 19:15:54  carl
     * several new routines have a testsuit.
 
 }