* several new routines have a testsuit.

tests/test/units/system/tassert1.pp

@@ -0,0 +1,69 @@
+{$C+}
+program tassert1;
+
+var
+ global_boolean : boolean;
+ 
+const 
+  RESULT_BOOLEAN = true;
+
+function get_boolean : boolean;
+ begin
+   get_boolean := RESULT_BOOLEAN;
+ end;
+
+procedure test_assert_reference_global;
+ begin
+  global_boolean:=RESULT_BOOLEAN;
+  assert(global_boolean);
+ end;
+ 
+procedure test_assert_reference_local;
+ var
+  b: boolean;
+ begin
+  b:=RESULT_BOOLEAN;
+  assert(b);
+ end;
+ 
+ 
+procedure test_assert_register;
+ var
+  b: boolean;
+ begin
+  assert(get_boolean);
+ end;
+
+procedure test_assert_flags;
+ var
+  b: boolean;
+  i,j : integer;
+ begin
+  i:=0;
+  j:=-12;
+  assert(i > j);
+ end;
+ 
+procedure test_assert_constant;
+  begin
+    assert(RESULT_BOOLEAN);
+  end;
+  
+ 
+ 
+begin
+  Write('Assert test (TRUE)...');
+  test_assert_reference_global;
+  test_assert_reference_local;
+  test_assert_register;
+  test_assert_flags;
+  test_assert_constant;
+  WriteLn('Success!');
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-09-16 19:16:36  carl
+    * several new routines have a testsuit.
+
+}

tests/test/units/system/tassert2.pp

@@ -0,0 +1,89 @@
+{$C+}
+program tassert2;
+
+var
+ global_boolean : boolean;
+ counter : longint;
+ 
+const 
+  RESULT_BOOLEAN = false;
+  
+  
+  
+procedure fail;
+ begin
+   Writeln('Failure!');
+   Halt(1);
+ end;
+
+function get_boolean : boolean;
+ begin
+   get_boolean := RESULT_BOOLEAN;
+ end;
+
+procedure test_assert_reference_global;
+ begin
+  global_boolean:=RESULT_BOOLEAN;
+  assert(global_boolean);
+ end;
+ 
+procedure test_assert_reference_local;
+ var
+  b: boolean;
+ begin
+  b:=RESULT_BOOLEAN;
+  assert(b);
+ end;
+ 
+ 
+procedure test_assert_register;
+ begin
+  assert(get_boolean);
+ end;
+
+procedure test_assert_flags;
+ var
+  i,j : integer;
+ begin
+  i:=0;
+  j:=-12;
+  assert(i < j);
+ end;
+ 
+ procedure test_assert_constant;
+  begin
+    assert(RESULT_BOOLEAN);
+  end;
+ 
+  { Handle the assertion failed ourselves, so we can test everything in 
+    one shot.
+  }
+  Procedure MyAssertRoutine(const msg,fname:ShortString;lineno,erroraddr:longint);
+   begin
+     Inc(counter);
+   end;
+   
+   
+
+ 
+begin
+  counter:=0;
+  AssertErrorProc := @MyAssertRoutine;
+  Write('Assert test (FALSE)...');
+  test_assert_reference_global;
+  test_assert_reference_local;
+  test_assert_register;
+  test_assert_flags;
+  test_assert_constant;
+  if counter <> 5 then
+     fail
+  else
+     WriteLn('Success!');
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-09-16 19:16:36  carl
+    * several new routines have a testsuit.
+
+}

tests/test/units/system/tassert3.pp

@@ -0,0 +1,88 @@
+{$C-}
+program tassert1;
+
+var
+ global_boolean : boolean;
+ counter : longint;
+ 
+const 
+  RESULT_BOOLEAN = false;
+  
+  
+procedure fail;
+ begin
+   Writeln('Failure!');
+   Halt(1);
+ end;
+
+function get_boolean : boolean;
+ begin
+   get_boolean := RESULT_BOOLEAN;
+ end;
+
+procedure test_assert_reference_global;
+ begin
+  global_boolean:=RESULT_BOOLEAN;
+  assert(global_boolean);
+ end;
+ 
+procedure test_assert_reference_local;
+ var
+  b: boolean;
+ begin
+  b:=RESULT_BOOLEAN;
+  assert(b);
+ end;
+ 
+ 
+procedure test_assert_register;
+ begin
+  assert(get_boolean);
+ end;
+
+procedure test_assert_flags;
+ var
+  i,j : integer;
+ begin
+  i:=0;
+  j:=-12;
+  assert(i < j);
+ end;
+ 
+ procedure test_assert_constant;
+  begin
+    assert(RESULT_BOOLEAN);
+  end;
+ 
+  { Handle the assertion failed ourselves, so we can test everything in 
+    one shot.
+  }
+  Procedure MyAssertRoutine(const msg,fname:ShortString;lineno,erroraddr:longint);
+   begin
+     Inc(counter);
+   end;
+   
+   
+
+ 
+begin
+  counter:=0;
+  AssertErrorProc := @MyAssertRoutine;
+  Write('Assert test (FALSE) with assertions off...');
+  test_assert_reference_global;
+  test_assert_reference_local;
+  test_assert_register;
+  test_assert_flags;
+  test_assert_constant;
+  if counter <> 0 then
+     fail
+  else
+     WriteLn('Success!');
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-09-16 19:16:36  carl
+    * several new routines have a testsuit.
+
+}

tests/test/units/system/tassert4.pp

@@ -0,0 +1,90 @@
+{$C+}
+program tassert4;
+
+var
+ global_boolean : boolean;
+ counter : longint;
+ 
+const 
+  RESULT_BOOLEAN = false;
+  RESULT_STRING = 'hello world';
+  
+procedure fail;
+ begin
+   Writeln('Failure!');
+   Halt(1);
+ end;
+
+function get_boolean : boolean;
+ begin
+   get_boolean := RESULT_BOOLEAN;
+ end;
+
+procedure test_assert_reference_global;
+ begin
+  global_boolean:=RESULT_BOOLEAN;
+  assert(global_boolean,RESULT_STRING);
+ end;
+ 
+procedure test_assert_reference_local;
+ var
+  b: boolean;
+ begin
+  b:=RESULT_BOOLEAN;
+  assert(b,RESULT_STRING);
+ end;
+ 
+ 
+procedure test_assert_register;
+ begin
+  assert(get_boolean,RESULT_STRING);
+ end;
+
+procedure test_assert_flags;
+ var
+  i,j : integer;
+ begin
+  i:=0;
+  j:=-12;
+  assert(i < j,RESULT_STRING);
+ end;
+ 
+ procedure test_assert_constant;
+  begin
+    assert(RESULT_BOOLEAN,RESULT_STRING);
+  end;
+ 
+  { Handle the assertion failed ourselves, so we can test everything in 
+    one shot.
+  }
+  Procedure MyAssertRoutine(const msg,fname:ShortString;lineno,erroraddr:longint);
+   begin
+     Inc(counter);
+     if msg <> RESULT_STRING then
+       fail;
+   end;
+   
+   
+
+ 
+begin
+  counter:=0;
+  AssertErrorProc := @MyAssertRoutine;
+  Write('Assert test (FALSE) with assertions on...');
+  test_assert_reference_global;
+  test_assert_reference_local;
+  test_assert_register;
+  test_assert_flags;
+  test_assert_constant;
+  if counter <> 5 then
+     fail
+  else
+     WriteLn('Success!');
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-09-16 19:16:36  carl
+    * several new routines have a testsuit.
+
+}

tests/test/units/system/tassert5.pp

@@ -0,0 +1,90 @@
+{$C-}
+program tassert5;
+
+var
+ global_boolean : boolean;
+ counter : longint;
+ 
+const 
+  RESULT_BOOLEAN = false;
+  RESULT_STRING = 'hello world';
+  
+procedure fail;
+ begin
+   Writeln('Failure!');
+   Halt(1);
+ end;
+
+function get_boolean : boolean;
+ begin
+   get_boolean := RESULT_BOOLEAN;
+ end;
+
+procedure test_assert_reference_global;
+ begin
+  global_boolean:=RESULT_BOOLEAN;
+  assert(global_boolean,RESULT_STRING);
+ end;
+ 
+procedure test_assert_reference_local;
+ var
+  b: boolean;
+ begin
+  b:=RESULT_BOOLEAN;
+  assert(b,RESULT_STRING);
+ end;
+ 
+ 
+procedure test_assert_register;
+ begin
+  assert(get_boolean,RESULT_STRING);
+ end;
+
+procedure test_assert_flags;
+ var
+  i,j : integer;
+ begin
+  i:=0;
+  j:=-12;
+  assert(i < j,RESULT_STRING);
+ end;
+ 
+ procedure test_assert_constant;
+  begin
+    assert(RESULT_BOOLEAN,RESULT_STRING);
+  end;
+ 
+  { Handle the assertion failed ourselves, so we can test everything in 
+    one shot.
+  }
+  Procedure MyAssertRoutine(const msg,fname:ShortString;lineno,erroraddr:longint);
+   begin
+     Inc(counter);
+     if msg <> RESULT_STRING then
+       fail;
+   end;
+   
+   
+
+ 
+begin
+  counter:=0;
+  AssertErrorProc := @MyAssertRoutine;
+  Write('Assert test (FALSE) with assertions off...');
+  test_assert_reference_global;
+  test_assert_reference_local;
+  test_assert_register;
+  test_assert_flags;
+  test_assert_constant;
+  if counter <> 0 then
+     fail
+  else
+     WriteLn('Success!');
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-09-16 19:16:36  carl
+    * several new routines have a testsuit.
+
+}

tests/test/units/system/tassert6.pp

@@ -0,0 +1,31 @@
+{ %RESULT=227 }
+{$C+}
+program tassert6;
+
+var
+ global_boolean : boolean;
+ 
+const 
+  RESULT_BOOLEAN = false;
+  
+
+
+procedure test_assert_reference_global;
+ begin
+  global_boolean:=RESULT_BOOLEAN;
+  assert(global_boolean);
+ end;
+ 
+   
+
+ 
+begin
+  test_assert_reference_global;
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-09-16 19:16:36  carl
+    * several new routines have a testsuit.
+
+}

tests/test/units/system/tint.pp

@@ -0,0 +1,72 @@
+{ this tests the int routine }
+{ Contrary to TP, int can be used in the constant section,
+  just like in Delphi }
+program tint;
+
+const
+  INT_RESULT_ONE = 1234;
+  INT_VALUE_ONE = 1234.5678;
+  INT_RESULT_CONST_ONE = Int(INT_VALUE_ONE);
+  INT_RESULT_TWO = -1234;
+  INT_VALUE_TWO = -1234.5678;
+  INT_RESULT_CONST_TWO = Int(INT_VALUE_TWO);
+
+
+ procedure fail;
+  begin
+    WriteLn('Failed!');
+    halt(1);
+  end;
+
+var
+ r: real;
+ _success : boolean;
+Begin
+ Write('Int() 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.
+
+{
+  $Log$
+  Revision 1.1  2002-09-16 19:15:54  carl
+    * several new routines have a testsuit.
+
+}
+

tests/test/units/system/tpi.pp

@@ -0,0 +1,38 @@
+{ this tests the pi routine, as an inline }
+program tpi;
+
+const
+ PI_CONST = 3.1459;
+ { the following expression also works on constants }
+ PI_CONST_VALUE = pi;
+
+ procedure fail;
+  begin
+    WriteLn('Failed!');
+    halt(1);
+  end;
+ 
+var
+ value : real;
+ _result : boolean;
+Begin
+  Write('Pi() test...');
+  _result := true;
+  value:=pi;
+  if trunc(value) <> trunc(PI_CONST) then
+     _result := false;
+  If trunc(Pi) <> trunc(PI_CONST) then
+     _result := false;
+  If trunc(Pi) <> trunc(PI_CONST_VALUE) then
+     _result := false;
+  if not _result then
+     fail;
+  WriteLn('Success!');     
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-09-16 19:15:54  carl
+    * several new routines have a testsuit.
+
+}  

tests/test/units/system/tround.pp

@@ -0,0 +1,71 @@
+{ this tests the round routine }
+program ttrunc;
+
+const
+  RESULT_ONE = 1235;
+  VALUE_ONE = 1234.5678;
+  RESULT_CONST_ONE = round(VALUE_ONE);
+  RESULT_TWO = -1235;
+  VALUE_TWO = -1234.5678;
+  RESULT_CONST_TWO = round(VALUE_TWO);
+
+
+ procedure fail;
+  begin
+    WriteLn('Failed!');
+    halt(1);
+  end;
+
+var
+ r: real;
+ _success : boolean;
+ l: longint;
+Begin
+ Write('Round() 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.
+
+{
+  $Log$
+  Revision 1.1  2002-09-16 19:15:54  carl
+    * several new routines have a testsuit.
+
+}
+

tests/test/units/system/tseg.pp

@@ -0,0 +1,74 @@
+{ Part of System unit testsuit        }
+{ Carl Eric Codere Copyright (c) 2002 }
+program tseg;
+
+const
+ cst : integer = 0;
+var
+ variable : integer;
+
+procedure fail;
+ begin
+  WriteLn('Failure!');
+  halt(1);
+ end;
+
+procedure test_cseg;
+ begin
+   Write('Testing CSeg()...');
+   if cseg <> 0 then
+     fail
+   else
+     WriteLn('Success!');
+ end;
+ 
+procedure test_dseg;
+ begin
+   Write('Testing DSeg()...');
+   if dseg <> 0 then
+     fail
+   else
+     WriteLn('Success!');
+ end;
+ 
+procedure test_sseg;
+ begin
+   Write('Testing SSeg()...');
+   if sseg <> 0 then
+     fail
+   else
+     WriteLn('Success!');
+ end;
+ 
+procedure test_seg;
+ var
+   x : longint;
+   _result : boolean;
+ begin
+   _result := true;
+   Write('Testing Seg()...');
+   if seg(x) <> 0 then
+     _result := false;
+   if seg(cst) <> 0 then
+     _result := false;
+   if seg(variable) <> 0 then
+     _result := false;
+   if not _result then  
+     fail
+   else
+     WriteLn('Success!');
+ end;
+ 
+Begin
+  test_cseg;
+  test_dseg;
+  test_seg;
+  test_sseg;
+end.
+
+{
+ $Log$
+ Revision 1.1  2002-09-16 19:15:54  carl
+   * several new routines have a testsuit.
+
+} 

tests/test/units/system/ttrunc.pp

@@ -0,0 +1,71 @@
+{ this tests the trunc routine }
+program ttrunc;
+
+const
+  RESULT_ONE = 1234;
+  VALUE_ONE = 1234.5678;
+  RESULT_CONST_ONE = trunc(VALUE_ONE);
+  RESULT_TWO = -1234;
+  VALUE_TWO = -1234.5678;
+  RESULT_CONST_TWO = trunc(VALUE_TWO);
+
+
+ procedure fail;
+  begin
+    WriteLn('Failed!');
+    halt(1);
+  end;
+
+var
+ r: real;
+ _success : boolean;
+ l: longint;
+Begin
+ Write('Trunc() 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.
+
+{
+  $Log$
+  Revision 1.1  2002-09-16 19:15:54  carl
+    * several new routines have a testsuit.
+
+}
+