瀏覽代碼

* Adapted for automated testing

carl 23 年之前
父節點
當前提交
312902b36a

+ 42 - 33
tests/test/cg/taddbool.pp

@@ -13,6 +13,12 @@ TYPE
 {$ENDIF}
 
 
+procedure fail;
+begin
+  WriteLn('Failure.');
+  halt(1);
+end;
+
 { ---------------------------- BOOLEAN TEST ----------------------------- }
 {                              secondadd()                                }
 { ----------------------------------------------------------------------- }
@@ -50,10 +56,10 @@ begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end
  else
-   WriteLn('Failure.');
+   Fail;
 
  { WORDBOOL AND WORDBOOL }
  result := true;
@@ -82,10 +88,10 @@ begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end
  else
-   WriteLn('Failure.');
+   Fail;
 
  { LONGBOOL AND LONGBOOL }
  result := true;
@@ -114,10 +120,10 @@ begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end
  else
-   WriteLn('Failure.');
+   Fail;
 end;
 
 
@@ -154,10 +160,10 @@ begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end
  else
-   WriteLn('Failure.');
+   Fail;
 
  { WORDBOOL AND WORDBOOL }
  result := false;
@@ -184,10 +190,10 @@ begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end
  else
-   WriteLn('Failure.');
+   Fail;
 
  { LONGBOOL AND LONGBOOL }
  result := false;
@@ -216,10 +222,10 @@ begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end
  else
-   WriteLn('Failure.');
+   Fail;
 end;
 
 
@@ -253,14 +259,14 @@ begin
  bb2 := true;
  if bb1 xor bb2 then
   begin
-     WriteLn('Failure.');
+     Fail;
   end
  else
   begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end;
 
  { WORDBOOL XOR WORDBOOL }
@@ -285,14 +291,14 @@ begin
  wb2 := true;
  if wb1 xor wb2 then
   begin
-      WriteLn('Failure.');
+      Fail;
   end
  else
    begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
    end;
 
  { LONGBOOL XOR LONGBOOL }
@@ -319,14 +325,14 @@ begin
  lb2 := true;
  if lb1 xor lb2 then
   begin
-      WriteLn('Failure.');
+      Fail;
   end
  else
    begin
      if result then
        WriteLn('Success.')
      else
-       WriteLn('Failure.');
+       Fail;
    end;
 end;
 
@@ -359,10 +365,10 @@ Begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end
  else
-   WriteLn('Failure.');
+   Fail;
  { WORDBOOL = WORDBOOL }
  result := true;
  Write('wordbool = wordbool test...');
@@ -383,10 +389,10 @@ Begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end
  else
-   WriteLn('Failure.');
+   Fail;
  Write('wordbool conversion to boolean...');
  result := TRUE;
  move(values,lb1,sizeof(lb1));
@@ -395,7 +401,7 @@ Begin
  if result then
     WriteLn('Success.')
  else
-    WriteLn('Failure.');
+    Fail;
  { LONGBOOL = LONGBOOL }
  result := true;
  Write('longbool = longbool test...');
@@ -416,10 +422,10 @@ Begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end
  else
-   WriteLn('Failure.');
+   Fail;
  Write('longbool conversion to boolean...');
  result := TRUE;
  move(values,lb1,sizeof(lb1));
@@ -428,7 +434,7 @@ Begin
  if result then
     WriteLn('Success.')
  else
-    WriteLn('Failure.');
+    Fail;
 end;
 
 
@@ -458,14 +464,14 @@ Begin
  bb2 := false;
  if bb1 <> bb2 then
   begin
-      WriteLn('Failure.');
+      Fail;
   end
  else
   begin
    if result then
      WriteLn('Success.')
    else
-     WriteLn('Failure.');
+     Fail;
   end;
  { WORDBOOL <> WORDBOOL }
  result := true;
@@ -486,14 +492,14 @@ Begin
  wb2 := false;
  if wb1 <> wb2 then
   begin
-      WriteLn('Failure.');
+      Fail;
   end
  else
   begin
    if result then
      WriteLn('Success.')
    else
-     WriteLn('Failure.');
+     Fail;
   end;
  { LONGBOOL <> LONGBOOL }
  result := true;
@@ -514,14 +520,14 @@ Begin
  lb2 := false;
  if lb1 <> lb2 then
   begin
-      WriteLn('Failure.');
+      Fail;
   end
  else
   begin
    if result then
      WriteLn('Success.')
    else
-     WriteLn('Failure.');
+     Fail;
   end;
 
 end;
@@ -563,7 +569,10 @@ end.
 
 {
   $Log$
-  Revision 1.2  2001-07-27 02:55:35  carl
+  Revision 1.3  2002-03-05 21:54:52  carl
+  * Adapted for automated testing
+
+  Revision 1.2  2001/07/27 02:55:35  carl
   + more complex testing
 
   Revision 1.1  2001/05/19 11:51:50  peter

+ 17 - 12
tests/test/cg/taddcard.pp

@@ -8,6 +8,11 @@
   type cardinal = longint;
 {$endif}
 
+procedure fail;
+begin
+  Fail;
+  halt(1);
+end;
 
 
 procedure CardinalTestAdd;
@@ -36,7 +41,7 @@ begin
  if i <> 30000 then
   result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -65,7 +70,7 @@ begin
  if i <> 800 then
   result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -112,7 +117,7 @@ begin
  if i <> 10000000 then
    result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -141,7 +146,7 @@ begin
  if i <> $FFFFFFFF then
    result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -171,7 +176,7 @@ Begin
  if i <> $FFFFFFFF then
    result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -212,7 +217,7 @@ Begin
  if i <> 0 then
    result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -233,7 +238,7 @@ Begin
  if j = i then
   result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -255,7 +260,7 @@ Begin
  if j <> i then
   result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -285,10 +290,10 @@ begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end
  else
-  WriteLn('Failure.');
+  Fail;
 {$endif}
 end;
 
@@ -319,10 +324,10 @@ begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end
  else
-  WriteLn('Failure.');
+  Fail;
 {$endif}
 end;
 

+ 17 - 12
tests/test/cg/taddlong.pp

@@ -5,6 +5,11 @@
 {   - if statements function correctly.                      }
 {   - subroutine calls function correctly.                   }
 
+procedure fail;
+begin
+  Fail;
+  halt(1);
+end;
 
 
 procedure LongintTestAdd;
@@ -33,7 +38,7 @@ begin
  if i <> 30000 then
   result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -62,7 +67,7 @@ begin
  if i <> 800 then
   result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -104,7 +109,7 @@ begin
  if i <> 256000 then
     result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -133,7 +138,7 @@ begin
  if i <> $FFFFFFFF then
    result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -163,7 +168,7 @@ Begin
  if i <> $FFFFFFFF then
    result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -204,7 +209,7 @@ Begin
  if i <> 0 then
    result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -225,7 +230,7 @@ Begin
  if j = i then
   result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -247,7 +252,7 @@ Begin
  if j <> i then
   result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -276,10 +281,10 @@ begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end
  else
-  WriteLn('Failure.');
+  Fail;
 end;
 
 
@@ -308,10 +313,10 @@ begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end
  else
-  WriteLn('Failure.');
+  Fail;
 end;
 
 

+ 18 - 9
tests/test/cg/taddreal.pp

@@ -24,6 +24,12 @@
 {  LOC_FPU                                                      }
 {  LOC_REFERENCE / LOC_MEM                                      }
 {$E+}
+procedure fail;
+begin
+  Fail;
+  halt(1);
+end;
+
 
  Procedure RealTestSub;
  var
@@ -48,7 +54,7 @@
     result := false;
   WriteLn('Result (0.0) :',j);
   if not result then
-    WriteLn('Failure.')
+    Fail
   else
     WriteLn('Success.');
  end;
@@ -73,7 +79,7 @@
      result := false;
    WriteLn('Result (212.5) :',i);
    if not result then
-    WriteLn('Failure.')
+    Fail
    else
     WriteLn('Success.');
  end;
@@ -100,7 +106,7 @@
     result := false;
   WriteLn('Result (-1200.0) :',i);
   if not result then
-    WriteLn('Failure.')
+    Fail
   else
     WriteLn('Success.');
  end;
@@ -130,7 +136,7 @@
     result := false;
   WriteLn('Result (-0.1001) :',j);
   if not result then
-    WriteLn('Failure.')
+    Fail
   else
     WriteLn('Success.');
  end;
@@ -166,7 +172,7 @@
   if not (trunc(i) = trunc(1000.0)) then
     result := false;
   if not result then
-    WriteLn('Failure.')
+    Fail
   else
     WriteLn('Success.');
  end;
@@ -186,7 +192,7 @@
   if (trunc(i) <> trunc(1000.0)) then
     result := false;
   if not result then
-    WriteLn('Failure.')
+    Fail
   else
     WriteLn('Success.');
  end;
@@ -213,7 +219,7 @@
   if trunc(i) < trunc(999.0) then
     result := false;
   if not result then
-    WriteLn('Failure.')
+    Fail
   else
     WriteLn('Success.');
  end;
@@ -239,7 +245,7 @@
   if trunc(i) > trunc(999.0) then
     result := false;
   if not result then
-    WriteLn('Failure.')
+    Fail
   else
     WriteLn('Success.');
  end;
@@ -260,7 +266,10 @@ end.
 
 {
   $Log$
-  Revision 1.3  2001-07-31 01:55:23  carl
+  Revision 1.4  2002-03-05 21:55:11  carl
+  * Adapted for automated testing
+
+  Revision 1.3  2001/07/31 01:55:23  carl
   * corrected comparing value for real
 
   Revision 1.2  2001/06/12 01:12:34  carl

+ 5 - 1
tests/test/cg/taddset.pp

@@ -126,6 +126,7 @@ const
    else
      begin
        WriteLn('Failure.');
+       Halt(1);
        Err:=true;
      end;
  end;
@@ -639,7 +640,10 @@ end.
 
 {
   $Log$
-  Revision 1.4  2001-10-20 17:26:13  peter
+  Revision 1.5  2002-03-05 21:55:11  carl
+  * Adapted for automated testing
+
+  Revision 1.4  2001/10/20 17:26:13  peter
     * several fixes to run also with kylix
 
   Revision 1.3  2001/06/24 22:30:19  carl

+ 21 - 13
tests/test/cg/tadint64.pp

@@ -5,6 +5,11 @@
 {   - if statements function correctly.                      }
 {   - subroutine calls function correctly.                   }
 
+procedure fail;
+begin
+  Fail;
+  halt(1);
+end;
 
 
 procedure int64TestAdd;
@@ -33,7 +38,7 @@ begin
  if i <> 30000 then
   result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -62,7 +67,7 @@ begin
  if i <> 800 then
   result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -104,7 +109,7 @@ begin
  if i <> 256000 then
     result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -133,7 +138,7 @@ begin
  if i <> $FFFFFFFF then
    result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -163,7 +168,7 @@ Begin
  if i <> $FFFFFFFF then
    result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -204,7 +209,7 @@ Begin
  if i <> 0 then
    result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -225,7 +230,7 @@ Begin
  if j = i then
   result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -247,7 +252,7 @@ Begin
  if j <> i then
   result := false;
  if not result then
-  WriteLn('Failure.')
+  Fail
  else
   WriteLn('Success.');
 end;
@@ -276,10 +281,10 @@ begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end
  else
-  WriteLn('Failure.');
+  Fail;
 end;
 
 
@@ -308,10 +313,10 @@ begin
     if result then
       WriteLn('Success.')
     else
-      WriteLn('Failure.');
+      Fail;
   end
  else
-  WriteLn('Failure.');
+  Fail;
 end;
 
 
@@ -334,7 +339,10 @@ end.
 
 {
  $Log$
- Revision 1.2  2001-06-24 23:58:14  carl
+ Revision 1.3  2002-03-05 21:55:11  carl
+ * Adapted for automated testing
+
+ Revision 1.2  2001/06/24 23:58:14  carl
  * fixed problem with log
 
 }

+ 12 - 2
tests/test/cg/tcnvset.pp

@@ -71,6 +71,13 @@ type
 type
   tnormalset = set of tbigenum;
   tsmallset = set of tsmallenum;
+  
+procedure fail;
+begin
+  Fail;
+  halt(1);
+end;
+  
 
 
   procedure SmallSet2NormalSet;
@@ -95,7 +102,7 @@ type
     if op2 <> [A_BCS,A_MOVE] then
       passed := false;
     if not passed then
-       WriteLn('Failure,')
+       Fail
     else
        WriteLn('Success.');
    end;
@@ -108,7 +115,10 @@ end.
 {
 
  $Log$
- Revision 1.1  2001-06-24 23:01:22  carl
+ Revision 1.2  2002-03-05 21:55:42  carl
+ * Adapted for automated testing
+
+ Revision 1.1  2001/06/24 23:01:22  carl
  + completed small set -. normal set conversion tests
 
 

+ 10 - 2
tests/test/cg/tderef.pp

@@ -22,6 +22,11 @@ type
   pbyte = ^byte;
 
 
+procedure fail;
+begin
+  Fail;
+  halt(1);
+end;
 
 
 var
@@ -53,12 +58,15 @@ Begin
  if passed then
    WriteLn('Success.')
  else
-   WriteLn('Failure.');
+   Fail;
 end.
 
 {
    $Log$
-   Revision 1.1  2001-06-30 02:02:06  carl
+   Revision 1.2  2002-03-05 21:56:02  carl
+   * Adapted for automated testing
+
+   Revision 1.1  2001/06/30 02:02:06  carl
    + secondderef()
 
 }

+ 20 - 17
tests/test/cg/tin.pp

@@ -73,6 +73,18 @@ type
 type
   tnormalset = set of tbigenum;
   tsmallset = set of tsmallenum;
+  
+  
+  procedure checkpassed(passed : boolean);
+   begin
+    if passed then
+      WriteLn('Passed!')
+    else
+      begin
+        WriteLn('Failure.');
+        Halt(1);
+      end;
+   end;
 
 { The following cases are possible                                  }
 {     jump table usage                                              }
@@ -124,10 +136,7 @@ type
      op3 := [DF];
      if not (DB in (op2+op3)) then
        passed := false;
-     if passed then
-        WriteLn('Success.')
-     else
-        WriteLn('Failure.');
+     checkpassed(passed);  
    end;
 
 
@@ -165,10 +174,7 @@ type
       passed := false;
      { LEFT : LOC_REGISTER                        }
      { RIGHT : range constant set (carry flag)    }
-     if passed then
-        WriteLn('Success.')
-     else
-        WriteLn('Failure.');
+     checkpassed(passed);  
    end;
 
   { returns result in register }
@@ -207,10 +213,7 @@ type
      if not (A_MOVE in op1) then
        passed := false;
 
-     if passed then
-        WriteLn('Success.')
-     else
-        WriteLn('Failure.');
+     checkpassed(passed);  
    end;
 
 
@@ -241,10 +244,7 @@ type
      if not (getop in [A_BFSET,A_MOVE,A_ASL..A_BCC]) then
        passed := false;
 
-     if passed then
-        WriteLn('Success.')
-     else
-        WriteLn('Failure.');
+     checkpassed(passed);  
    end;
 
 
@@ -258,7 +258,10 @@ end.
 {
 
   $Log$
-  Revision 1.1  2001-06-25 01:34:03  carl
+  Revision 1.2  2002-03-05 21:56:02  carl
+  * Adapted for automated testing
+
+  Revision 1.1  2001/06/25 01:34:03  carl
   + secondin() node testing
 
 

+ 45 - 137
tests/test/cg/tmoddiv.pp

@@ -44,6 +44,17 @@ function getint64cnt: int64;
  end;
 
   {$ENDIF}
+  
+procedure test(value, required: longint);
+begin
+  if value <> required then
+    begin
+      writeln('Got ',value,' instead of ',required);
+      halt(1);
+    end
+  else
+    writeln('Passed!');
+end;
 
 var
  longres : longint;
@@ -63,20 +74,14 @@ begin
   longres := 24;
   longres := longres div 4;
   Write('Value should be 6...');
-  if longres = 6 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(longres, 6);
 
   { RIGHT : power of 2 ordconstn   }
   { LEFT : LOC_REFERENCE           }
   longres := 24;
   longres := longres mod 4;
   Write('Value should be 0...');
-  if longres = 0 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(longres, 0);
 
 
   WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REFERENCE');
@@ -86,10 +91,7 @@ begin
   longcnt := -13;
   longres := longres div longcnt;
   Write('Value should be -10...');
-  if longres = -10 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(longres, -10);
 
   { RIGHT : LOC_REFERENCE      }
   { LEFT : LOC_REFERENCE       }
@@ -97,10 +99,7 @@ begin
   longcnt := -13;
   longres := longres mod longcnt;
   Write('Value should be 10...');
-  if longres = 10 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(longres, 10);
 
   WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REGISTER');
   { RIGHT : LOC_REGISTER       }
@@ -108,40 +107,28 @@ begin
   longres := -11111111;
   longres := longres div getlongcnt;
   Write('Value should be 1111111...');
-  if longres = 1111111 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(longres, 1111111);
 
   { RIGHT : LOC_REGISTER       }
   { LEFT : LOC_REFERENCE       }
   longres := -1111111;
   longres := longres mod getlongcnt;
   Write('Value should be -1...');
-  if longres = -1 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(longres, -1);
 
   { RIGHT : LOC_REFERENCE }
   { LEFT : LOC_REGISTER   }
   longcnt := 2;
   longres := getlongcnt div longcnt;
   Write('Value should be -5...');
-  if longres = -5 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(longres, -5);
 
   { RIGHT : LOC_REFERENCE }
   { LEFT : LOC_REGISTER   }
   longcnt := 3;
   longres := getlongcnt mod longcnt;
   Write('Value should be -1...');
-  if longres = -1 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(longres, -1);
 
   { special tests for results }
   Writeln('special numeric values tests...');
@@ -149,30 +136,21 @@ begin
   longcnt := $80000000;
   longres := longres div longcnt;
   Write('Value should be 0...');
-  if longres = 0 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(longres, 0);
 
   Writeln('special numeric values tests...');
   longres := $7FFFFFFF;
   longcnt := $80000000;
   longres := longcnt div longres;
   Write('Value should be -1...');
-  if longres = -1 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(longres, -1);
 
   Writeln('special numeric values tests...');
   cardinalcnt := $80000;
   cardinalres := $12345;
   cardinalres := cardinalcnt div cardinalres;
   Write('Value should be 7...');
-  if cardinalres = 7 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(cardinalres, 7);
 
 {$IFDEF FPC}
   WriteLn('------------------- CARDINAL -----------------------');
@@ -182,30 +160,20 @@ begin
   cardinalcnt := $80000000;
   cardinalres := cardinalres div cardinalcnt;
   Write('Value should be 0...');
-  if cardinalres = 0 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(cardinalres, 0);
 
   Writeln('special numeric values tests...');
   cardinalres := $7FFFFFFF;
   cardinalcnt := $80000000;
   cardinalres := cardinalcnt div cardinalres;
   Write('Value should be 1...');
-  if cardinalres = 1 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(cardinalres, 1);
 
   Writeln('special numeric values tests...');
   cardinalcnt := $80000;
   cardinalres := $12345;
   cardinalres := cardinalcnt div cardinalres;
-  Write('Value should be 7...');
-  if cardinalres = 7 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(cardinalres, 7);
 
   WriteLn('(left) : LOC_REFERENCE; (right) : ordinal constant');
   { RIGHT : power of 2 ordconstn   }
@@ -213,20 +181,14 @@ begin
   cardinalres := 24;
   cardinalres := cardinalres div 4;
   Write('Value should be 6...');
-  if cardinalres = 6 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(cardinalres, 6);
 
   { RIGHT : power of 2 ordconstn   }
   { LEFT : LOC_REFERENCE           }
   cardinalres := 24;
   cardinalres := cardinalres mod 4;
   Write('Value should be 0...');
-  if cardinalres = 0 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(cardinalres, 0);
 
 
   WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REFERENCE');
@@ -236,10 +198,7 @@ begin
   cardinalcnt := 13;
   cardinalres := cardinalres div cardinalcnt;
   Write('Value should be 10...');
-  if cardinalres = 10 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(cardinalres, 10);
 
   { RIGHT : LOC_REFERENCE      }
   { LEFT : LOC_REFERENCE       }
@@ -247,10 +206,7 @@ begin
   cardinalcnt := 13;
   cardinalres := cardinalres mod cardinalcnt;
   Write('Value should be 10...');
-  if cardinalres = 10 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(cardinalres, 10);
 
   WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REGISTER');
   { RIGHT : LOC_REGISTER       }
@@ -258,40 +214,28 @@ begin
   cardinalres := 11111111;
   cardinalres := cardinalres div getcardinalcnt;
   Write('Value should be 1111111...');
-  if cardinalres = 1111111 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(cardinalres, 1111111);
 
   { RIGHT : LOC_REGISTER       }
   { LEFT : LOC_REFERENCE       }
   cardinalres := 1111111;
   cardinalres := cardinalres mod getcardinalcnt;
   Write('Value should be 1...');
-  if cardinalres = 1 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(cardinalres, 1);
 
   { RIGHT : LOC_REFERENCE }
   { LEFT : LOC_REGISTER   }
   cardinalcnt := 2;
   cardinalres := getcardinalcnt div cardinalcnt;
   Write('Value should be 5...');
-  if cardinalres = 5 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(cardinalres, 5);
 
   { RIGHT : LOC_REFERENCE }
   { LEFT : LOC_REGISTER   }
   cardinalcnt := 3;
   cardinalres := getcardinalcnt mod cardinalcnt;
   Write('Value should be 1...');
-  if cardinalres = 1 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(cardinalres, 1);
 
   WriteLn('--------------------- INT64 ------------------------');
   { special tests for results }
@@ -300,39 +244,27 @@ begin
   int64cnt := $80000000 shl 32;
   int64res := int64res div int64cnt;
   Write('Value should be 0...');
-  if int64res = 0 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(int64res and $FFFFFFFF, 0);
 
   Writeln('special numeric values tests...');
   int64res := $7FFFFFFF shl 32;
   int64cnt := $80000000 shl 32;
   int64res := int64cnt div int64res;
   Write('Value should be -1...');
-  if int64res = -1 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(int64res and $FFFFFFFF, -1);
 
   int64res := $7FFFFFFF;
   int64cnt := $80000000;
   int64res := int64res div int64cnt;
   Write('Value should be 0...');
-  if int64res = 0 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(int64res and $FFFFFFFF, 0);
 
   Writeln('special numeric values tests...');
   int64res := $7FFFFFFF;
   int64cnt := $80000000;
   int64res := int64cnt div int64res;
   Write('Value should be -1...');
-  if int64res = -1 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(int64res and $FFFFFFFF, -1);
 
   WriteLn('(left) : LOC_REFERENCE; (right) : ordinal constant');
   { RIGHT : power of 2 ordconstn   }
@@ -340,20 +272,14 @@ begin
   int64res := 24;
   int64res := int64res div 4;
   Write('Value should be 6...');
-  if int64res = 6 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(int64res and $FFFFFFFF, 6);
 
   { RIGHT : power of 2 ordconstn   }
   { LEFT : LOC_REFERENCE           }
   int64res := 24;
   int64res := int64res mod 4;
   Write('Value should be 0...');
-  if int64res = 0 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(int64res and $FFFFFFFF, 0);
 
 
   WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REFERENCE');
@@ -363,10 +289,7 @@ begin
   int64cnt := -13;
   int64res := int64res div int64cnt;
   Write('Value should be -10...');
-  if int64res = -10 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(int64res and $FFFFFFFF, -10);
 
   { RIGHT : LOC_REFERENCE      }
   { LEFT : LOC_REFERENCE       }
@@ -374,10 +297,7 @@ begin
   int64cnt := -13;
   int64res := int64res mod int64cnt;
   Write('Value should be 10...');
-  if int64res = 10 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(int64res and $FFFFFFFF, 10);
 
   WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REGISTER');
   { RIGHT : LOC_REGISTER       }
@@ -385,40 +305,28 @@ begin
   int64res := -11111111;
   int64res := int64res div getint64cnt;
   Write('Value should be 1111111...');
-  if int64res = 1111111 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(int64res and $FFFFFFFF, 1111111);
 
   { RIGHT : LOC_REGISTER       }
   { LEFT : LOC_REFERENCE       }
   int64res := -1111111;
   int64res := int64res mod getint64cnt;
   Write('Value should be -1...');
-  if int64res = -1 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(int64res and $FFFFFFFF, -1);
 
   { RIGHT : LOC_REFERENCE }
   { LEFT : LOC_REGISTER   }
   int64cnt := 2;
   int64res := getint64cnt div int64cnt;
   Write('Value should be -5...');
-  if int64res = -5 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(int64res and $FFFFFFFF, -5);
 
   { RIGHT : LOC_REFERENCE }
   { LEFT : LOC_REGISTER   }
   int64cnt := 3;
   int64res := getint64cnt mod int64cnt;
   Write('Value should be -1...');
-  if int64res = -1 then
-    WriteLn('Success.')
-  else
-    WriteLn('Failure.');
+  test(int64res and $FFFFFFFF, -1);
 
 {$ENDIF}
 end.

+ 25 - 20
tests/test/cg/tneg.pp

@@ -30,6 +30,23 @@ Program tneg;
 {     - LOC_FPU                                      }
 {----------------------------------------------------}
 
+procedure test(value, required: longint);
+begin
+  if value <> required then
+    begin
+      writeln('Got ',value,' instead of ',required);
+      halt(1);
+    end
+  else
+    writeln('Passed!');
+end;
+
+procedure fail;
+ begin
+   writeln('Failure.');
+   halt(1);
+ end;
+
 
   function getreal: real;
    begin
@@ -50,20 +67,14 @@ Begin
    longval := 1;
    longval := - longval;
    Write('Value should be -1...');
-   if longval = -1 then
-      WriteLn('Success.')
-   else
-      WriteLn('Failure.');
+   test(longval, -1);
 
    { CURRENT NODE : REGISTER }
    { LEFT NODE: REGISTER     }
    byteval := 2;
    longval := - byteval;
    Write('Value should be -2...');
-   if longval = -2 then
-      WriteLn('Success.')
-   else
-      WriteLn('Failure.');
+   test(longval, -2);
 
    { CURRENT NODE: LOC_FPU }
    { LEFT NODE : LOC_REFERENCE }
@@ -71,9 +82,9 @@ Begin
    realval := - realval;
    Write('Value should 1.0...');
    if realval - 1.0 = 0.0 then
-      WriteLn('Success.')
+      WriteLn('Passed!')
    else
-      WriteLn('Failure');
+      Fail;
 
    { LEFT NODE : LOC_FPU }
    { CURRENT NODE : LOC_FPU }
@@ -81,9 +92,9 @@ Begin
    realval := -(getreal*(realval));
    Write('Value should 1.0...');
    if realval - 1.0 = 0.0 then
-      WriteLn('Success.')
+      WriteLn('Passed!')
    else
-      WriteLn('Failure');
+      Fail;
 
 {$IFDEF FPC}
    WriteLn('------------------------------  INT64  --------------------------------');
@@ -92,20 +103,14 @@ Begin
    int64val := 1;
    int64val := - int64val;
    Write('Value should be -1...');
-   if int64val = -1 then
-      WriteLn('Success.')
-   else
-      WriteLn('Failure.');
+   test(int64val and $FFFFFFFF, -1);
 
    { CURRENT NODE : REGISTER }
    { LEFT NODE: REGISTER     }
    byteval := 2;
    int64val := - byteval;
    Write('Value should be -2...');
-   if int64val = -2 then
-      WriteLn('Success.')
-   else
-      WriteLn('Failure.');
+   test(int64val and $FFFFFFFF, -2);
 {$ENDIF}
 end.
 

+ 22 - 36
tests/test/cg/tnot.pp

@@ -46,6 +46,18 @@ begin
   getbyteboolval := TRUE;
 end;
 
+procedure test(value, required: longint);
+begin
+  if value <> required then
+    begin
+      writeln('Got ',value,' instead of ',required);
+      halt(1);
+    end
+  else
+    writeln('Passed!');
+end;
+
+
 
 var
  longres :  longint;
@@ -67,20 +79,15 @@ Begin
    longres := $7F7F7F7F;
    longres := not longres;
    Write('Value should be $80808080...');
-   if longres = $80808080 then
-      WriteLn('Success.')
-   else
-      WriteLn('Failure.');
+   test(longres,$80808080);
 
    { CURRENT NODE : REGISTER }
    { LEFT NODE : REGISTER    }
    WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
    longres := not getintres;
    Write('Value should be $8080...');
-   if longres = $FFFF8080 then
-      WriteLn('Success.')
-   else
-      WriteLn('Failure.');
+   test(longres, $FFFF8080);
+
    WriteLn('----------------------------- BOOLEAN -----------------------------------');
 
    { CURRENT NODE : LOC_REGISTER }
@@ -89,36 +96,24 @@ Begin
    byteboolval := TRUE;
    byteboolres := not byteboolval;
    Write('Value should be FALSE...');
-   if byteboolres = FALSE then
-      WriteLn('Success.')
-   else
-      WriteLn('Failure.');
+   test(ord(byteboolres),0);
 
    wordboolval := TRUE;
    wordboolres := not wordboolval;
    Write('Value should be FALSE...');
-   if wordboolres = FALSE then
-      WriteLn('Success.')
-   else
-      WriteLn('Failure.');
+   test(longint(wordboolres),0);
 
    longboolval := TRUE;
    longboolres := not longboolval;
    Write('Value should be FALSE...');
-   if longboolres = FALSE then
-      WriteLn('Success.')
-   else
-      WriteLn('Failure.');
+   test(longint(longboolres),0);
 
    { CURRENT NODE : LOC_REGISTER }
    { LEFT NODE :  LOC_REGISTER  }
    WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
    longboolres := not getbyteboolval;
    Write('Value should be FALSE...');
-   if longboolres = FALSE then
-      WriteLn('Success.')
-   else
-      WriteLn('Failure.');
+   test(longint(longboolres),0);
 
    { CURRENT NODE : LOC_FLAGS }
    { LEFT NODE :  LOC_FLAGS  }
@@ -127,10 +122,7 @@ Begin
    byteboolres := TRUE;
    byteboolres:= not ((intres = 1));
    Write('Value should be FALSE...');
-   if byteboolres = FALSE then
-      WriteLn('Success.')
-   else
-      WriteLn('Failure.');
+   test(ord(byteboolres),0);
 
   { !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! }
   { CURRENT_NODE : LOC_JUMP }
@@ -148,20 +140,14 @@ Begin
    int64res := $7F7F7F7F;
    int64res := not int64res;
    Write('Value should be $80808080...');
-   if int64res = $80808080 then
-      WriteLn('Success.')
-   else
-      WriteLn('Failure.');
+   test(int64res and $FFFFFFFF,$80808080);
 
    { CURRENT NODE : REGISTER }
    { LEFT NODE : REGISTER    }
    WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
    int64res := not (word(getintres));
    Write('Value should be $8080...');
-   if int64res = $00008080 then
-      WriteLn('Success.')
-   else
-      WriteLn('Failure.');
+   test(int64res and $FFFFFFFF,$00008080);
 {$ENDIF}
 end.
 

+ 55 - 144
tests/test/cg/tshlshr.pp

@@ -28,6 +28,16 @@ Program tshlshr;
 {     - LOC_REFERENCE / LOC_MEM                      }
 {     - LOC_REGISTER                                 }
 {----------------------------------------------------}
+procedure test(value, required: longint);
+begin
+  if value <> required then
+    begin
+      writeln('Got ',value,' instead of ',required);
+      halt(1);
+    end
+  else
+    writeln('Passed!');
+end;
 
 
 var
@@ -47,48 +57,32 @@ Begin
    longres:=1;
    longres := longres shl 15;
    Write('(SHL) Value should be 32768...');
-   if longres = 32768 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, 32768);
+   
    longres:=-1;
    longres := longres shl 15;
    Write('(SHL) Value should be -32768...');
-   if longres = -32768 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, -32768);
+
    longres:=1;
    longres := longres shl 33;
    Write('(SHL) Value should be 2...');
-   if longres = 2 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, 2);
 
    longres:=$8000;
    longres := longres shr 15;
    Write('(SHR) Value should be 1...');
-   if longres = 1 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, 1);
 
    longres:=-1;
    longres := longres shr 15;
    Write('(SHR) Value should be 131071...');
-   if longres = 131071 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, 131071);
 
    longres:=$FFFF;
    longres := longres shr 33;
    Write('(SHR) Value should be 32767...');
-   if longres = 32767 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, 32767);
 
    { left : LOC_REFERENCE }
    { right : LOC_REFERENCE }
@@ -98,54 +92,37 @@ Begin
    longcnt := -2;
    longres:=longres shl longcnt ;
    Write('(SHL) Value should be 1073741824...');
-   if longres = 1073741824 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, 1073741824);
 
    longres:=1;
    longcnt:=15;
    longres := longres shl longcnt;
    Write('(SHL) Value should be 32768...');
-   if longres = 32768 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, 32768);
 
    longres:=-1;
    longcnt := 15;
    longres := longres shl longcnt;
    Write('(SHL) Value should be -32768...');
-   if longres = -32768 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, -32768);
 
    longres := 1;
    longcnt := -2;
    longres:=longres shr longcnt ;
    Write('(SHR) Value should be 0...');
-   if longres = 0 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, 0);
 
    longres:=32768;
    longcnt:=15;
    longres := longres shr longcnt;
    Write('(SHR) Value should be 1...');
-   if longres = 1 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, 1);
+
    longres:=-1;
    longcnt := 15;
    longres := longres shl longcnt;
    Write('(SHR) Value should be -32768...');
-   if longres = -32768 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, -32768);
 
    { left : LOC_REFERENCE }
    { right : LOC_REGISRER }
@@ -154,75 +131,51 @@ Begin
    bytecnt := -2;
    longres:=longres shl bytecnt ;
    Write('(SHL) Value should be 1073741824...');
-   if longres = 1073741824 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, 1073741824);
 
    longres:=1;
    bytecnt:=15;
    longres := longres shl bytecnt;
    Write('(SHL) Value should be 32768...');
-   if longres = 32768 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, 32768);
 
    longres:=-1;
    bytecnt := 15;
    longres := longres shl bytecnt;
    Write('(SHL) Value should be -32768...');
-   if longres = -32768 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, -32768);
 
    longres := 1;
    bytecnt := -2;
    longres:=longres shr bytecnt ;
    Write('(SHR) Value should be 0...');
-   if longres = 0 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, 0);
 
    longres:=32768;
    bytecnt:=15;
    longres := longres shr bytecnt;
    Write('(SHR) Value should be 1...');
-   if longres = 1 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, 1);
 
    longres:=-1;
    bytecnt := 15;
    longres := longres shr bytecnt;
    Write('(SHR) Value should be 131071...');
-   if longres = 131071 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(longres, 131071);
 
    WriteLn('(left) : LOC_REGISTER; (right) : LOC_REGISTER');
    byteres := 1;
    bytecnt := 2;
    byteres := byteres shl bytecnt;
    Write('(SHL) Value should be 4...');
-   if longres = 4 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(byteres, 4);
 
 
    byteres := 4;
    bytecnt := 2;
    byteres := byteres shr bytecnt;
    Write('(SHR) Value should be 1...');
-   if longres = 1 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(byteres, 1);
 
 {$IFDEF FPC}
    WriteLn('------------------------------  INT64  --------------------------------');
@@ -232,35 +185,23 @@ Begin
    int64res:=1;
    int64res := int64res shl 15;
    Write('(SHL) Value should be 32768...');
-   if int64res = 32768 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, 32768);
 
    int64res:=-1;
    int64res := int64res shl 15;
    Write('(SHL) Value should be -32768...');
-   if int64res = -32768 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, -32768);
 
 
    int64res:=1;
    int64res := int64res shl 65;
    Write('(SHL) Value should be 2...');
-   if int64res = 2 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, 2);
 
    int64res:=$8000;
    int64res := int64res shr 15;
    Write('(SHR) Value should be 1...');
-   if int64res = 1 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, 1);
 
 {   int64res:=-1;
    int64res := int64res shr 15;
@@ -268,10 +209,7 @@ Begin
    int64res:=$FFFF;
    int64res := int64res shr 65;
    Write('(SHR) Value should be 0...');
-   if int64res = 0 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, 0);
 
    { left : LOC_REFERENCE }
    { right : LOC_REFERENCE }
@@ -280,57 +218,39 @@ Begin
    int64cnt := -2;
    int64res:=int64res shl int64cnt ;
    Write('(SHL) Value should be 1073741824...');
-   if int64res = 1073741824 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, 1073741824);
 
    int64res:=1;
    int64cnt:=15;
    int64res := int64res shl int64cnt;
    Write('(SHL) Value should be 32768...');
-   if int64res = 32768 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, 32768);
 
 
    int64res:=-1;
    int64cnt := 15;
    int64res := int64res shl int64cnt;
    Write('(SHL) Value should be -32768...');
-   if int64res = -32768 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, -32768);
 
 
    int64res := 1;
    int64cnt := -2;
    int64res:=int64res shr int64cnt ;
    Write('(SHR) Value should be 0...');
-   if int64res = 0 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, 0);
 
    int64res:=32768;
    int64cnt:=15;
    int64res := int64res shr int64cnt;
    Write('(SHR) Value should be 1...');
-   if int64res = 1 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, 1);
 
    int64res:=-1;
    int64cnt := 15;
    int64res := int64res shl int64cnt;
    Write('(SHR) Value should be -32768...');
-   if int64res = -32768 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, -32768);
 
    { left : LOC_REFERENCE }
    { right : LOC_REGISRER }
@@ -339,50 +259,35 @@ Begin
    bytecnt := -2;
    int64res:=int64res shl bytecnt ;
    Write('(SHL) Value should be 1073741824...');
-   if int64res = 1073741824 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, 1073741824);
 
 
    int64res:=1;
    bytecnt:=15;
    int64res := int64res shl bytecnt;
    Write('(SHL) Value should be 32768...');
-   if int64res = 32768 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, 32768);
 
 
    int64res:=-1;
    bytecnt := 15;
    int64res := int64res shl bytecnt;
    Write('(SHL) Value should be -32768...');
-   if int64res = -32768 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, -32768);
 
 
    int64res := 1;
    bytecnt := -2;
    int64res:=int64res shr bytecnt ;
    Write('(SHR) Value should be 0...');
-   if int64res = 0 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, 0);
 
 
    int64res:=32768;
    bytecnt:=15;
    int64res := int64res shr bytecnt;
    Write('(SHR) Value should be 1...');
-   if int64res = 1 then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+   test(int64res and $FFFFFFFF, 1);
 {   int64res:=-1;
    bytecnt := 15;
    int64res := int64res shr bytecnt;
@@ -391,3 +296,9 @@ Begin
 {$ENDIF}
 end.
 
+{
+  $Log$
+  Revision 1.3  2002-03-05 21:56:32  carl
+  * Adapted for automated testing
+
+}

+ 23 - 13
tests/test/cg/tvec.pp

@@ -90,6 +90,22 @@ var
  globalindex : longint;
  globalansi : ansistring;
  globalboolarray : boolarray;
+ 
+ 
+ procedure checkpassed(passed: boolean);
+ begin
+   if passed then
+     begin
+       writeln('Passed!');
+     end
+   else
+     begin
+       writeln('Failure.');
+       halt(1);
+     end;
+ end;
+
+ 
 
    { this routine clears all arrays     }
    { without calling secondvecn() first }
@@ -220,10 +236,7 @@ var
       end;
 
 
-    if passed then
-      WriteLn('Success.')
-    else
-      WriteLn('Failure.');
+    checkpassed(passed);
    end;
 
 
@@ -341,10 +354,7 @@ var
            passed := false;
       end;
 
-    if passed then
-      WriteLn('Success.')
-    else
-      WriteLn('Failure.');
+    checkpassed(passed);
 
 
 
@@ -388,10 +398,7 @@ var
             passed := false;
         end;
       }
-      if passed then
-        WriteLn('Success.')
-      else
-        WriteLn('Failure.');
+    checkpassed(passed);
     end;
 
 
@@ -421,7 +428,10 @@ end.
 
 {
   $Log$
-  Revision 1.3  2001-06-30 02:16:28  carl
+  Revision 1.4  2002-03-05 21:56:44  carl
+  * Adapted for automated testing
+
+  Revision 1.3  2001/06/30 02:16:28  carl
   - reduced sizes of arrays to make it work under m68k
 
   Revision 1.2  2001/06/30 00:48:37  carl