* several fixes to run also with kylix

tests/test/cg/taddset.pp

@@ -18,6 +18,9 @@
 
 Program tneg;
 
+var
+  Err : boolean;
+
 type
        { DO NOT CHANGE THE VALUES OF THESE ENUMERATIONS! }
        tsmallenum = (dA,dB,dC,dd,de,df,dg,dh,di,dj,dk,dl,dm,dn,dop,dp,dq,dr);
@@ -116,6 +119,16 @@ const
    );
 
 
+ procedure CheckPassed(passed:boolean);
+ begin
+   if passed then
+     WriteLn('Success.')
+   else
+     begin
+       WriteLn('Failure.');
+       Err:=true;
+     end;
+ end;
 
  procedure SetTestEqual;
  { FPC_SET_COMP_SETS }
@@ -136,10 +149,7 @@ const
      passed := false;
    if not (constset1[1] = [A_MOVE,A_FTST,A_CPSAVE]) then
      passed := false;
-   if passed then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+    CheckPassed(passed);
   end;
 
  procedure SetTestNotEqual;
@@ -165,10 +175,7 @@ const
      passed := false; }
    if (constset1[1] <> [A_MOVE,A_FTST,A_CPSAVE]) then
      passed := false;
-   if passed then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+    CheckPassed(passed);
   end;
 
   procedure SetTestLt;
@@ -188,10 +195,7 @@ const
     oplist := [A_MOVE,A_CPRESTORE..A_CPSAVE];
     if oplist <= op2list then
      passed := false;
-    if passed then
-       WriteLn('Success.')
-    else
-       WriteLn('Failure.');
+    CheckPassed(passed);
    end;
 
   Procedure SetTestAddOne;
@@ -205,14 +209,7 @@ const
     op:=A_LABEL;
     oplist:=[];
     oplist:=oplist+[op];
-    if oplist = [A_LABEL] then
-      Begin
-        WriteLn('Success.');
-      end
-    else
-      Begin
-        WriteLn('Failure.');
-      end;
+    CheckPassed(oplist = [A_LABEL]);
   end;
 
 Procedure SetTestAddTwo;
@@ -227,14 +224,7 @@ Begin
  oplist:=[A_MOVE]+[A_JSR];
  op2list:=[A_LABEL];
  oplist:=op2list+oplist;
- if oplist = [A_MOVE,A_JSR,A_LABEL] then
-   Begin
-      WriteLn('Success.');
-   end
- else
-    Begin
-      WriteLn('Failure.');
-    end;
+ CheckPassed(oplist = [A_MOVE,A_JSR,A_LABEL]);
 end;
 
 
@@ -265,10 +255,7 @@ Begin
  oplist:=op2list-oplist;
  if oplist <> [] then
    passed := false;
- if passed then
-   WriteLn('Success.')
- else
-   WriteLn('Failure.');
+ CheckPassed(passed);
 end;
 
 Procedure SetTestSubTwo;
@@ -298,10 +285,7 @@ Begin
  oplist := oplist - [b];
  if oplist <> [] then
    passed := false;
- if not passed then
-   WriteLn('Failure.')
- else
-   WriteLn('Success.');
+ CheckPassed(passed);
 end;
 
 
@@ -326,10 +310,7 @@ Begin
  oplist := oplist * op2list;
  if oplist <> [A_MOVE,A_FTST] then
    passed := false;
- if passed then
-   WriteLn('Success.')
- else
-   WriteLn('Failure.');
+ CheckPassed(passed);
 end;
 
 procedure SetTestRange;
@@ -348,10 +329,7 @@ begin
  oplist := [op1..op2];
  if oplist <> constset1[2] then
    passed := false;
- if not passed then
-  WriteLn('Failure,')
- else
-  WriteLn('Success.');
+ CheckPassed(passed);
 end;
 
 procedure SetTestByte;
@@ -369,10 +347,7 @@ begin
  oplist := [A_MOVE,op,A_JSR];
  if oplist <> [A_MOVE,A_LABEL,A_JSR] then
    passed := false;
-  if not passed then
-    WriteLn('Failure,')
-  else
-    WriteLn('Success.');
+ CheckPassed(passed);
 end;
 
 
@@ -395,10 +370,7 @@ end;
      passed := false;
    if not (constset3[1] = [DA,DD,DM]) then
      passed := false;
-   if passed then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+ CheckPassed(passed);
   end;
 
  procedure SmallSetTestNotEqual;
@@ -423,10 +395,7 @@ end;
      passed := false; }
    if (constset3[1] <> [DA,DD,DM]) then
      passed := false;
-   if passed then
-     WriteLn('Success.')
-   else
-     WriteLn('Failure.');
+ CheckPassed(passed);
   end;
 
   procedure SmallSetTestLt;
@@ -446,10 +415,7 @@ end;
     oplist := [DC,DF..DM];
     if oplist <= op2list then
      passed := false;
-    if passed then
-       WriteLn('Success.')
-    else
-       WriteLn('Failure.');
+ CheckPassed(passed);
    end;
 
   Procedure SmallSetTestAddOne;
@@ -461,14 +427,7 @@ end;
     op:=DG;
     oplist:=[];
     oplist:=oplist+[op];
-    if oplist = [DG] then
-      Begin
-        WriteLn('Success.');
-      end
-    else
-      Begin
-        WriteLn('Failure.');
-      end;
+    CheckPassed( oplist = [DG] );
   end;
 
 Procedure SmallSetTestAddTwo;
@@ -482,14 +441,7 @@ Begin
  oplist:=[DG]+[DI];
  op2list:=[DM];
  oplist:=op2list+oplist;
- if oplist = [DG,DI,DM] then
-   Begin
-      WriteLn('Success.');
-   end
- else
-    Begin
-      WriteLn('Failure.');
-    end;
+ CheckPassed( oplist = [DG,DI,DM] );
 end;
 
 
@@ -516,10 +468,7 @@ Begin
  oplist:=op2list-oplist;
  if oplist <> [] then
    passed := false;
- if passed then
-   WriteLn('Success.')
- else
-   WriteLn('Failure.');
+ CheckPassed(passed);
 end;
 
 Procedure SmallSetTestSubTwo;
@@ -548,10 +497,7 @@ Begin
  oplist := oplist - [b];
  if oplist <> [] then
    passed := false;
- if not passed then
-   WriteLn('Failure.')
- else
-   WriteLn('Success.');
+ CheckPassed(passed);
 end;
 
 
@@ -575,10 +521,7 @@ Begin
  oplist := oplist * op2list;
  if oplist <> [DG,DK] then
    passed := false;
- if passed then
-   WriteLn('Success.')
- else
-   WriteLn('Failure.');
+ CheckPassed(passed);
 end;
 
 procedure SmallSetTestRange;
@@ -597,10 +540,7 @@ begin
  oplist := [op1..op2];
  if oplist <> constset3[2] then
    passed := false;
- if not passed then
-  WriteLn('Failure,')
- else
-  WriteLn('Success.');
+ CheckPassed(passed);
 end;
 
 procedure SmallSetTestByte;
@@ -618,10 +558,7 @@ begin
  oplist := [DG,op,DI];
  if oplist <> [DG,DD,DI] then
    passed := false;
-  if not passed then
-    WriteLn('Failure,')
-  else
-    WriteLn('Success.');
+ CheckPassed(passed);
 end;
 
 (*
@@ -695,11 +632,17 @@ Begin
   SmallSetTestRange;
   SmallSetTestLt;
   SmallSetTestByte;
+
+  if Err then
+   Halt(1);
 end.
 
 {
   $Log$
-  Revision 1.3  2001-06-24 22:30:19  carl
+  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
   + completed small set tests
 
   Revision 1.2  2001/06/22 02:24:40  carl

tests/test/tpara1.pp

@@ -1,6 +1,8 @@
 { %VERSION=1.1 }
 
-{$mode objfpc}
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
 
 uses
    erroru;
@@ -13,34 +15,24 @@ type
 procedure p1(out b : byte);
 
   begin
-     if b<>0 then
-       do_error(1001);
      b:=$aa;
   end;
 
 procedure p2(out w : word);
 
   begin
-     if w<>0 then
-       do_error(1002);
      w:=$aaaa;
   end;
 
-procedure p3(out d : dword);
+procedure p3(out d : cardinal);
 
   begin
-     if d<>0 then
-       do_error(1003);
      d:=$aaaaaaaa;
   end;
 
 procedure p4(out r : tr1);
 
   begin
-     if r.l1<>0 then
-       do_error(1004);
-     if r.l2<>0 then
-       do_error(1005);
      r.l1:=$aaaaaaaa;
      r.l2:=$aaaaaaaa;
   end;
@@ -56,7 +48,7 @@ procedure p5(out a : ansistring);
 var
    b : byte;
    w : word;
-   d : dword;
+   d : cardinal;
    r1 : tr1;
    a : ansistring;
 

tests/test/trange1.pp

@@ -1,7 +1,16 @@
 { %VERSION=1.1 }
 
-{$mode objfpc}
-uses sysutils;
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+uses SysUtils;
+
+{$ifndef fpc}
+type
+  qword=int64;
+  dword=cardinal;
+{$endif}
 
 var
   error: boolean;
@@ -88,12 +97,11 @@ begin
   writeln(i);
   if not testlongint_int64(i,true) then
     writeln('test3 failed');
-  longint(i) := $80000000;
+  i := $ffffffff80000000;
   writeln(i);
   if not testlongint_int64(i,false) then
     writeln('test4 failed');
-  i := 0;
-  longint(i) := $80000000;
+  i := $80000000;
   writeln(i);
   if not testlongint_int64(i,true) then
     writeln('test5 failed');
@@ -101,8 +109,7 @@ begin
   writeln(i);
   if not testlongint_int64(i,false) then
     writeln('test6 failed');
-  i := 0;
-  longint(i) := $ffffffff;
+  i := $ffffffff;
   writeln(i);
   if not testlongint_int64(i,true) then
     writeln('test7 failed');
@@ -126,12 +133,11 @@ begin
   writeln(q);
   if not testlongint_qword(q,true) then
     writeln('test3 failed');
-  longint(q) := $80000000;
+  q := $ffffffff80000000;
   writeln(q);
   if not testlongint_qword(q,true) then
     writeln('test4 failed');
-  q := 0;
-  longint(q) := $80000000;
+  q := $80000000;
   writeln(q);
   if not testlongint_qword(q,true) then
     writeln('test5 failed');
@@ -139,8 +145,7 @@ begin
   writeln(q);
   if not testlongint_qword(q,false) then
     writeln('test6 failed');
-  q := 0;
-  longint(q) := $ffffffff;
+  q := $ffffffff;
   writeln(q);
   if not testlongint_qword(q,true) then
     writeln('test7 failed');
@@ -164,12 +169,11 @@ begin
   writeln(i);
   if not testdword_int64(i,true) then
     writeln('test3 failed');
-  longint(i) := $80000000;
+  i := $ffffffff80000000;
   writeln(i);
   if not testdword_int64(i,true) then
     writeln('test4 failed');
-  i := 0;
-  longint(i) := $80000000;
+  i := $80000000;
   writeln(i);
   if not testdword_int64(i,false) then
     writeln('test5 failed');
@@ -177,8 +181,7 @@ begin
   writeln(i);
   if not testdword_int64(i,false) then
     writeln('test6 failed');
-  i := 0;
-  longint(i) := $ffffffff;
+  i := $ffffffff;
   writeln(i);
   if not testdword_int64(i,false) then
     writeln('test7 failed');
@@ -202,12 +205,11 @@ begin
   writeln(q);
   if not testdword_qword(q,true) then
     writeln('test3 failed');
-  longint(q) := $80000000;
+  q := $ffffffff80000000;
   writeln(q);
   if not testdword_qword(q,true) then
     writeln('test4 failed');
-  q := 0;
-  longint(q) := $80000000;
+  q := $80000000;
   writeln(q);
   if not testdword_qword(q,false) then
     writeln('test5 failed');
@@ -215,8 +217,7 @@ begin
   writeln(q);
   if not testdword_qword(q,false) then
     writeln('test6 failed');
-  q := 0;
-  longint(q) := $ffffffff;
+  q := $ffffffff;
   writeln(q);
   if not testdword_qword(q,false) then
     writeln('test7 failed');

tests/test/units/system/tdir.pp

@@ -1,11 +1,11 @@
 { Program to test OS-specific features of the system unit }
-{ routines to test: 					  }
-{   mkdir()						  }
-{   chdir()						  }
+{ routines to test:                                       }
+{   mkdir()                                               }
+{   chdir()                                               }
 { This program shoulf not be executed in a roto directory }
 { Creates the following directory, and sets it as the     }
-{ current directory.					  }
-{    ../testdir						  }
+{ current directory.                                      }
+{    ../testdir                                           }
 
 
 Program tdir;
@@ -24,6 +24,10 @@ Begin
    mkdir('testdir2');
    WriteLn('removing directory ...');
    rmdir('testdir2');
+   WriteLn('going directory up ...');
+   chdir('..');
+   WriteLn('removing directory ...');
+   rmdir('testdir');
    WriteLn('getting current directory...');
    getdir(0,s);
    WriteLn(s);
@@ -31,7 +35,10 @@ end.
 
 {
  $Log$
- Revision 1.1  2001-07-14 04:25:17  carl
+ Revision 1.2  2001-10-20 17:26:13  peter
+   * several fixes to run also with kylix
+
+ Revision 1.1  2001/07/14 04:25:17  carl
  system unit testing : basic directory services
 
 }

tests/units/erroru.pp

@@ -1,10 +1,11 @@
+{$J+}
 unit erroru;
 interface
 
   procedure do_error(l : longint);
-  
+
   procedure error;
-  
+
   procedure accept_error(num : longint);
 
   procedure require_error(num : longint);
@@ -80,6 +81,7 @@ begin
 end;
 
 
+initialization
 finalization
   error_unit_exit;
 end.