Browse Source

* fixed for 1.1 compiler

peter 22 years ago
parent
commit
60e33861a5

+ 19 - 16
tests/test/units/system/tassert2.pp

@@ -4,12 +4,12 @@ program tassert2;
 var
  global_boolean : boolean;
  counter : longint;
- 
-const 
+
+const
   RESULT_BOOLEAN = false;
-  
-  
-  
+
+
+
 procedure fail;
  begin
    Writeln('Failure!');
@@ -26,7 +26,7 @@ procedure test_assert_reference_global;
   global_boolean:=RESULT_BOOLEAN;
   assert(global_boolean);
  end;
- 
+
 procedure test_assert_reference_local;
  var
   b: boolean;
@@ -34,8 +34,8 @@ procedure test_assert_reference_local;
   b:=RESULT_BOOLEAN;
   assert(b);
  end;
- 
- 
+
+
 procedure test_assert_register;
  begin
   assert(get_boolean);
@@ -49,23 +49,23 @@ procedure test_assert_flags;
   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 
+
+  { Handle the assertion failed ourselves, so we can test everything in
     one shot.
   }
-  Procedure MyAssertRoutine(const msg,fname:ShortString;lineno,erroraddr:longint);
+  Procedure MyAssertRoutine(const msg,fname:ShortString;lineno:longint;erroraddr:{$ifdef VER1_0}longint{$else}pointer{$endif});
    begin
      Inc(counter);
    end;
-   
-   
 
- 
+
+
+
 begin
   counter:=0;
   AssertErrorProc := @MyAssertRoutine;
@@ -83,7 +83,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-09-16 19:16:36  carl
+  Revision 1.2  2003-03-17 19:27:00  peter
+    * fixed for 1.1 compiler
+
+  Revision 1.1  2002/09/16 19:16:36  carl
     * several new routines have a testsuit.
 
 }

+ 18 - 15
tests/test/units/system/tassert3.pp

@@ -4,11 +4,11 @@ program tassert1;
 var
  global_boolean : boolean;
  counter : longint;
- 
-const 
+
+const
   RESULT_BOOLEAN = false;
-  
-  
+
+
 procedure fail;
  begin
    Writeln('Failure!');
@@ -25,7 +25,7 @@ procedure test_assert_reference_global;
   global_boolean:=RESULT_BOOLEAN;
   assert(global_boolean);
  end;
- 
+
 procedure test_assert_reference_local;
  var
   b: boolean;
@@ -33,8 +33,8 @@ procedure test_assert_reference_local;
   b:=RESULT_BOOLEAN;
   assert(b);
  end;
- 
- 
+
+
 procedure test_assert_register;
  begin
   assert(get_boolean);
@@ -48,23 +48,23 @@ procedure test_assert_flags;
   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 
+
+  { Handle the assertion failed ourselves, so we can test everything in
     one shot.
   }
-  Procedure MyAssertRoutine(const msg,fname:ShortString;lineno,erroraddr:longint);
+  Procedure MyAssertRoutine(const msg,fname:ShortString;lineno:longint;addr:{$ifdef VER1_0}longint{$else}pointer{$endif});
    begin
      Inc(counter);
    end;
-   
-   
 
- 
+
+
+
 begin
   counter:=0;
   AssertErrorProc := @MyAssertRoutine;
@@ -82,7 +82,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-09-16 19:16:36  carl
+  Revision 1.2  2003-03-17 19:27:00  peter
+    * fixed for 1.1 compiler
+
+  Revision 1.1  2002/09/16 19:16:36  carl
     * several new routines have a testsuit.
 
 }

+ 17 - 14
tests/test/units/system/tassert4.pp

@@ -4,11 +4,11 @@ program tassert4;
 var
  global_boolean : boolean;
  counter : longint;
- 
-const 
+
+const
   RESULT_BOOLEAN = false;
   RESULT_STRING = 'hello world';
-  
+
 procedure fail;
  begin
    Writeln('Failure!');
@@ -25,7 +25,7 @@ procedure test_assert_reference_global;
   global_boolean:=RESULT_BOOLEAN;
   assert(global_boolean,RESULT_STRING);
  end;
- 
+
 procedure test_assert_reference_local;
  var
   b: boolean;
@@ -33,8 +33,8 @@ procedure test_assert_reference_local;
   b:=RESULT_BOOLEAN;
   assert(b,RESULT_STRING);
  end;
- 
- 
+
+
 procedure test_assert_register;
  begin
   assert(get_boolean,RESULT_STRING);
@@ -48,25 +48,25 @@ procedure test_assert_flags;
   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 
+
+  { Handle the assertion failed ourselves, so we can test everything in
     one shot.
   }
-  Procedure MyAssertRoutine(const msg,fname:ShortString;lineno,erroraddr:longint);
+  Procedure MyAssertRoutine(const msg,fname:ShortString;lineno:longint;erroraddr:{$ifdef VER1_0}longint{$else}pointer{$endif});
    begin
      Inc(counter);
      if msg <> RESULT_STRING then
        fail;
    end;
-   
-   
 
- 
+
+
+
 begin
   counter:=0;
   AssertErrorProc := @MyAssertRoutine;
@@ -84,7 +84,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-09-16 19:16:36  carl
+  Revision 1.2  2003-03-17 19:27:00  peter
+    * fixed for 1.1 compiler
+
+  Revision 1.1  2002/09/16 19:16:36  carl
     * several new routines have a testsuit.
 
 }

+ 17 - 14
tests/test/units/system/tassert5.pp

@@ -4,11 +4,11 @@ program tassert5;
 var
  global_boolean : boolean;
  counter : longint;
- 
-const 
+
+const
   RESULT_BOOLEAN = false;
   RESULT_STRING = 'hello world';
-  
+
 procedure fail;
  begin
    Writeln('Failure!');
@@ -25,7 +25,7 @@ procedure test_assert_reference_global;
   global_boolean:=RESULT_BOOLEAN;
   assert(global_boolean,RESULT_STRING);
  end;
- 
+
 procedure test_assert_reference_local;
  var
   b: boolean;
@@ -33,8 +33,8 @@ procedure test_assert_reference_local;
   b:=RESULT_BOOLEAN;
   assert(b,RESULT_STRING);
  end;
- 
- 
+
+
 procedure test_assert_register;
  begin
   assert(get_boolean,RESULT_STRING);
@@ -48,25 +48,25 @@ procedure test_assert_flags;
   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 
+
+  { Handle the assertion failed ourselves, so we can test everything in
     one shot.
   }
-  Procedure MyAssertRoutine(const msg,fname:ShortString;lineno,erroraddr:longint);
+  Procedure MyAssertRoutine(const msg,fname:ShortString;lineno:longint;erroraddr:{$ifdef VER1_0}longint{$else}pointer{$endif});
    begin
      Inc(counter);
      if msg <> RESULT_STRING then
        fail;
    end;
-   
-   
 
- 
+
+
+
 begin
   counter:=0;
   AssertErrorProc := @MyAssertRoutine;
@@ -84,7 +84,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-09-16 19:16:36  carl
+  Revision 1.2  2003-03-17 19:27:00  peter
+    * fixed for 1.1 compiler
+
+  Revision 1.1  2002/09/16 19:16:36  carl
     * several new routines have a testsuit.
 
 }

+ 39 - 38
tests/test/units/system/tassignd.pp

@@ -10,30 +10,33 @@ type
   tmyobject = object
     procedure myroutine(x: byte);
   end;
-  
+
   tmyclass = class
     procedure myroutine(x: byte);
   end;
-  
-  
+
+
   tobjectmethod = procedure (x: byte) of object;
   tclassmethod = procedure (x: byte) of object;
   tproc = procedure (x: byte);
-  
-  
-  type 
+
+
+  type
     objpointer = packed record
       _method : pointer;
       _vmt : pointer;
     end;
-  
-  
-  procedure fail; 
+
+var
+  myobject : tmyobject;
+  myclass : tmyclass;
+
+  procedure fail;
    begin
      WriteLn('Failure!');
      halt(1);
    end;
-  
+
   procedure mydummyproc(x: byte);
    begin
    end;
@@ -42,28 +45,28 @@ type
    begin
      getpointer := nil;
    end;
-   
+
   function getprocpointer : tproc;
    begin
      getprocpointer:=@mydummyproc;
    end;
-   
-{$ifdef fpc}   
+
+{$ifdef fpc}
   function getobjmethodpointer : tobjectmethod;
    begin
-     getobjmethodpointer:=@tmyobject.myroutine;
+     getobjmethodpointer:[email protected];
    end;
 
   function getclamethodpointer : tclassmethod;
    begin
-     getclamethodpointer:=@tmyclass.myroutine;
+     getclamethodpointer:[email protected];
    end;
-{$endif}   
-   
+{$endif}
+
   procedure tmyclass.myroutine(x: byte);
    begin
    end;
-   
+
   procedure tmyobject.myroutine(x: byte);
    begin
    end;
@@ -80,8 +83,6 @@ var
   p : pointer;
   x: array[1..8] of integer;
   _result : boolean;
-  myobject : tmyobject;
-  myclass : tmyclass;
   ptrrecord : objpointer;
 Begin
   myclass := tmyclass.create;
@@ -93,44 +94,44 @@ Begin
   p:=nil;
   if assigned(p) then
     _result := false;
-{$ifdef fpc}    
+{$ifdef fpc}
   if assigned(getpointer) then
     _result := false;
-{$endif}    
+{$endif}
 
   if _result then
     WriteLn('Success!')
   else
     fail;
-  {*******************************************************}    
+  {*******************************************************}
   Write('Assigned(proc) tests...');
   _result := true;
   proc:=@mydummyproc;
   if not assigned(proc) then
     _result := false;
   proc:=nil;
-{$ifdef fpc}  
+{$ifdef fpc}
   if assigned(proc) then
     _result := false;
   if not assigned(getprocpointer) then
     _result := false;
-{$endif}    
+{$endif}
   if _result then
     WriteLn('Success!')
   else
     fail;
-  {*******************************************************}    
+  {*******************************************************}
   Write('Assigned(object method) tests...');
   _result := true;
-{$ifdef fpc}  
+{$ifdef fpc}
   objmethod:[email protected];
   if not assigned(objmethod) then
     _result := false;
-{$endif}    
+{$endif}
   objmethod:=nil;
   if assigned(objmethod) then
     _result := false;
-  { lets put the individual fields to nil 
+  { lets put the individual fields to nil
     This is a hack which should never occur
   }
   objmethod:={$ifdef fpc}@{$endif}myobject.myroutine;
@@ -150,24 +151,24 @@ Begin
 {$ifdef fpc}
   if not assigned(getobjmethodpointer) then
     _result := false;
-{$endif}    
-  
+{$endif}
+
   if _result then
     WriteLn('Success!')
   else
     fail;
-  {*******************************************************}    
+  {*******************************************************}
   Write('Assigned(class method) tests...');
   _result := true;
-{$ifdef fpc}  
+{$ifdef fpc}
   clamethod:[email protected];
   if not assigned(clamethod) then
     _result := false;
-{$endif}    
+{$endif}
   clamethod:=nil;
   if assigned(clamethod) then
     _result := false;
-  { lets put the individual fields to nil 
+  { lets put the individual fields to nil
     This is a hack which should never occur
   }
   clamethod:={$ifdef fpc}@{$endif}myclass.myroutine;
@@ -187,11 +188,11 @@ Begin
 {$ifdef fpc}
   if not assigned(getclamethodpointer) then
     _result := false;
-{$endif}    
-  
+{$endif}
+
   if _result then
     WriteLn('Success!')
   else
     fail;
-    
+
 end.