* removed po_containsself tests

tests/test/cg/tcalpvr1.pp

@@ -43,22 +43,16 @@ type
     procedure test_normal(x: byte);
     class procedure test_static(x: byte);
     procedure test_virtual(x: byte);virtual;
-    procedure test_normal_self(self : tsimpleclass; x: byte); message 0;
-    class procedure test_static_self(self : tsimpleclass; x: byte); message 1;
-    procedure test_virtual_self(self : tsimpleclass; x: byte);virtual;message 2;
   end;
 
   tobjectmethod = procedure (x: byte) of object ;
   tclassmethod = procedure (x: byte) of object;
-  { used for testing pocontainsself explicit parameter }
-  tclassmethodself = procedure (self : tsimpleclass; x: byte) of object;
 
 var
   proc : troutine;
   func : troutineresult;
   obj_method : tobjectmethod;
   cla_method : tclassmethod;
-  cla_method_self : tclassmethodself;
   global_s32bit : longint;
   global_s64bit : int64;
   global_u8bit : byte;
@@ -137,26 +131,6 @@ var
      get_object_method_virtual := @obj.test_virtual;
    end;
 
-  { class access }
-  function get_class_method_normal_self : tclassmethodself;
-   begin
-     get_class_method_normal_self := @cla.test_normal_self;
-   end;
-
-{
-  HOW CAN WE GET THIS ADDRESS???
-  function get_class_method_static_self : tclassmethodself;
-   begin
-     get_class_method_static_self := @cla.test_static_self;
-   end;
-}
-
-  function get_class_method_virtual_self : tclassmethodself;
-   begin
-     get_class_method_virtual_self := @cla.test_virtual_self;
-   end;
-
-
   function get_class_method_normal : tclassmethod;
    begin
      get_class_method_normal := @cla.test_normal;
@@ -214,22 +188,6 @@ var
      global_u8bit := x;
    end;
 
-  procedure tsimpleclass.test_normal_self(self : tsimpleclass; x: byte);
-   begin
-     global_u8bit := x;
-   end;
-
-  class procedure tsimpleclass.test_static_self(self : tsimpleclass; x: byte);
-   begin
-     global_u8bit := x;
-   end;
-
-  procedure tsimpleclass.test_virtual_self(self : tsimpleclass; x: byte);
-   begin
-     global_u8bit := x;
-   end;
-
-
 var
  failed : boolean;
 Begin
@@ -492,18 +450,17 @@ Begin
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
- clear_globals;
- clear_values;
+ If failed then
+   fail
+ else
+   WriteLn('Passed!');
 
 
- tclassmethod(get_class_method_virtual)(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
  clear_globals;
  clear_values;
 
- tclassmethodself(get_class_method_normal_self)(cla,RESULT_U8BIT);
+
+ tclassmethod(get_class_method_virtual)(RESULT_U8BIT);
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
@@ -511,23 +468,12 @@ Begin
  clear_values;
 
 
- tclassmethodself(get_class_method_virtual_self)(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
-
- If failed then
-   fail
- else
-   WriteLn('Passed!');
-
  Write('Testing class method variable call (LOC_REFERENCE)...');
 
  clear_globals;
  clear_values;
  failed := false;
 
-
  cla_method := @cla.test_normal;
  cla_method(RESULT_U8BIT);
  if global_u8bit <> RESULT_U8BIT then
@@ -562,31 +508,6 @@ Begin
  clear_values;
 
 
- cla_method_self := @cla.test_normal_self;
- cla_method_self(cla, RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
-
- cla_method_self := @cla.test_virtual_self;
- cla_method_self(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
- cla_method_self := @cla.test_virtual_self;
- cla_method_self(cla, RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
 { cla_method := @cla.test_static;
  cla_method(RESULT_U8BIT);
  if global_u8bit <> RESULT_U8BIT then
@@ -601,7 +522,10 @@ end.
 
 {
    $Log$
-   Revision 1.5  2003-01-16 22:14:49  peter
+   Revision 1.6  2003-05-15 20:34:29  peter
+     * removed po_containsself tests
+
+   Revision 1.5  2003/01/16 22:14:49  peter
      * fixed wrong methodpointer loads
 
    Revision 1.4  2002/09/07 15:40:54  peter

tests/test/cg/tcalpvr2.pp

@@ -43,22 +43,16 @@ type
     procedure test_normal(x: byte);pascal;
     class procedure test_static(x: byte);pascal;
     procedure test_virtual(x: byte);virtual;pascal;
-    procedure test_normal_self(self : tsimpleclass; x: byte); message 0;pascal;
-    class procedure test_static_self(self : tsimpleclass; x: byte); message 1;pascal;
-    procedure test_virtual_self(self : tsimpleclass; x: byte);virtual;message 2;pascal;
   end;
 
   tobjectmethod = procedure (x: byte) of object ;pascal;
   tclassmethod = procedure (x: byte) of object;pascal;
-  { used for testing pocontainsself explicit parameter }
-  tclassmethodself = procedure (self : tsimpleclass; x: byte) of object;pascal;
 
 var
   proc : troutine;
   func : troutineresult;
   obj_method : tobjectmethod;
   cla_method : tclassmethod;
-  cla_method_self : tclassmethodself;
   global_s32bit : longint;
   global_s64bit : int64;
   global_u8bit : byte;
@@ -137,12 +131,6 @@ var
      get_object_method_virtual := @obj.test_virtual;
    end;
 
-  { class access }
-  function get_class_method_normal_self : tclassmethodself;
-   begin
-     get_class_method_normal_self := @cla.test_normal_self;
-   end;
-
 {
   HOW CAN WE GET THIS ADDRESS???
   function get_class_method_static_self : tclassmethodself;
@@ -151,12 +139,6 @@ var
    end;
 }
 
-  function get_class_method_virtual_self : tclassmethodself;
-   begin
-     get_class_method_virtual_self := @cla.test_virtual_self;
-   end;
-
-
   function get_class_method_normal : tclassmethod;
    begin
      get_class_method_normal := @cla.test_normal;
@@ -214,21 +196,6 @@ var
      global_u8bit := x;
    end;
 
-  procedure tsimpleclass.test_normal_self(self : tsimpleclass; x: byte);pascal;
-   begin
-     global_u8bit := x;
-   end;
-
-  class procedure tsimpleclass.test_static_self(self : tsimpleclass; x: byte);pascal;
-   begin
-     global_u8bit := x;
-   end;
-
-  procedure tsimpleclass.test_virtual_self(self : tsimpleclass; x: byte);pascal;
-   begin
-     global_u8bit := x;
-   end;
-
 
 var
  failed : boolean;
@@ -500,22 +467,6 @@ Begin
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
- clear_globals;
- clear_values;
-
- tclassmethodself(get_class_method_normal_self)(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
-
- tclassmethodself(get_class_method_virtual_self)(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
-
  If failed then
    fail
  else
@@ -562,31 +513,6 @@ Begin
  clear_values;
 
 
- cla_method_self := @cla.test_normal_self;
- cla_method_self(cla, RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
-
- cla_method_self := @cla.test_virtual_self;
- cla_method_self(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
- cla_method_self := @cla.test_virtual_self;
- cla_method_self(cla, RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
 { cla_method := @cla.test_static;
  cla_method(RESULT_U8BIT);
  if global_u8bit <> RESULT_U8BIT then
@@ -601,7 +527,10 @@ end.
 
 {
    $Log$
-   Revision 1.4  2003-01-16 22:14:49  peter
+   Revision 1.5  2003-05-15 20:34:29  peter
+     * removed po_containsself tests
+
+   Revision 1.4  2003/01/16 22:14:49  peter
      * fixed wrong methodpointer loads
 
    Revision 1.3  2003/01/05 18:21:30  peter

tests/test/cg/tcalpvr3.pp

@@ -12,7 +12,7 @@
 { DEFINES:                                                       }
 {****************************************************************}
 { REMARKS: This tests a subset of the secondcalln() , it         }
-{          verifies procedural variables for cdecl               }
+{          verifies procedural variables for cdecl              }
 {          calling conventions.                                  }
 {****************************************************************}
 program tcalpvr3;
@@ -35,27 +35,24 @@ type
     constructor init;
     procedure test_normal(x: byte);cdecl;
     procedure test_static(x: byte);static;cdecl;
+    procedure test_virtual(x: byte);virtual;cdecl;
   end;
 
   tsimpleclass = class
     constructor create;
     procedure test_normal(x: byte);cdecl;
     class procedure test_static(x: byte);cdecl;
-    procedure test_normal_self(self : tsimpleclass; x: byte); message 0;cdecl;
-    class procedure test_static_self(self : tsimpleclass; x: byte); message 1;cdecl;
+    procedure test_virtual(x: byte);virtual;cdecl;
   end;
 
   tobjectmethod = procedure (x: byte) of object ;cdecl;
   tclassmethod = procedure (x: byte) of object;cdecl;
-  { used for testing pocontainsself explicit parameter }
-  tclassmethodself = procedure (self : tsimpleclass; x: byte) of object;cdecl;
 
 var
   proc : troutine;
   func : troutineresult;
   obj_method : tobjectmethod;
   cla_method : tclassmethod;
-  cla_method_self : tclassmethodself;
   global_s32bit : longint;
   global_s64bit : int64;
   global_u8bit : byte;
@@ -124,12 +121,14 @@ var
      get_object_method_normal := @obj.test_normal;
    end;
 
+  function get_object_type_method_virtual : tobjectmethod;
+   begin
+     get_object_type_method_virtual := @obj.test_virtual;
+   end;
 
-
-  { class access }
-  function get_class_method_normal_self : tclassmethodself;
+  function get_object_method_virtual : tobjectmethod;
    begin
-     get_class_method_normal_self := @cla.test_normal_self;
+     get_object_method_virtual := @obj.test_virtual;
    end;
 
 {
@@ -140,7 +139,6 @@ var
    end;
 }
 
-
   function get_class_method_normal : tclassmethod;
    begin
      get_class_method_normal := @cla.test_normal;
@@ -151,6 +149,10 @@ var
      get_class_method_static := @cla.test_static;
    end;}
 
+  function get_class_method_virtual : tclassmethod;
+   begin
+     get_class_method_virtual := @cla.test_virtual;
+   end;
 
  {****************************************************************************************************}
 
@@ -168,6 +170,11 @@ var
      global_u8bit := x;
    end;
 
+  procedure tsimpleobject.test_virtual(x: byte);cdecl;
+   begin
+     global_u8bit := x;
+   end;
+
  {****************************************************************************************************}
   constructor tsimpleclass.create;
    begin
@@ -184,18 +191,11 @@ var
      global_u8bit := x;
    end;
 
-
-  procedure tsimpleclass.test_normal_self(self : tsimpleclass; x: byte);cdecl;
+  procedure tsimpleclass.test_virtual(x: byte);cdecl;
    begin
      global_u8bit := x;
    end;
 
-  class procedure tsimpleclass.test_static_self(self : tsimpleclass; x: byte);cdecl;
-   begin
-     global_u8bit := x;
-   end;
-
-
 
 var
  failed : boolean;
@@ -344,6 +344,19 @@ Begin
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
+ clear_globals;
+ clear_values;
+
+ tobjectmethod(get_object_type_method_virtual)(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+   failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tobjectmethod(get_object_method_virtual)(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+   failed := true;
 
  clear_globals;
  clear_values;
@@ -353,6 +366,22 @@ Begin
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ tobjectmethod(get_object_type_method_virtual)(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+   failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ tobjectmethod(get_object_method_virtual)(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+   failed := true;
+
 
  If failed then
    fail
@@ -373,12 +402,36 @@ Begin
  clear_globals;
  clear_values;
 
+ obj_method:[email protected]_virtual;
+ obj_method(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+   failed := true;
+
+ clear_globals;
+ clear_values;
+
+ obj_method:[email protected]_virtual;
+ obj_method(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+   failed := true;
+
+ clear_globals;
+ clear_values;
+
  value_u8bit := RESULT_U8BIT;
  obj_method:[email protected]_normal;
  obj_method(value_u8bit);
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ obj_method:[email protected]_virtual;
+ obj_method(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+   failed := true;
 
  clear_globals;
  clear_values;
@@ -409,7 +462,8 @@ Begin
  clear_globals;
  clear_values;
 
- tclassmethodself(get_class_method_normal_self)(cla,RESULT_U8BIT);
+
+ tclassmethod(get_class_method_virtual)(RESULT_U8BIT);
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
@@ -430,28 +484,35 @@ Begin
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
-
  clear_globals;
  clear_values;
 
-{ cla_method := @cla.test_static;
+
+ cla_method := @cla.test_virtual;
  cla_method(RESULT_U8BIT);
  if global_u8bit <> RESULT_U8BIT then
-   failed := true;}
+   failed := true;
 
  clear_globals;
  clear_values;
 
-
- cla_method_self := @cla.test_normal_self;
- cla_method_self(cla, RESULT_U8BIT);
+ cla_method := @cla.test_virtual;
+ cla_method(RESULT_U8BIT);
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
+ clear_globals;
+ clear_values;
+
+{ cla_method := @cla.test_static;
+ cla_method(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+   failed := true;}
 
  clear_globals;
  clear_values;
 
+
 { cla_method := @cla.test_static;
  cla_method(RESULT_U8BIT);
  if global_u8bit <> RESULT_U8BIT then
@@ -466,21 +527,14 @@ end.
 
 {
    $Log$
-   Revision 1.7  2003-01-16 22:14:49  peter
-     * fixed wrong methodpointer loads
-
-   Revision 1.6  2002/10/29 20:44:31  carl
-     * updated with corrects testing (removed cdecl in constructors)
+   Revision 1.8  2003-05-15 20:34:29  peter
+     * removed po_containsself tests
 
-   Revision 1.5  2002/10/21 19:21:28  carl
-     * only test on version 1.1 +
-
-   Revision 1.4  2002/10/21 19:07:08  carl
-     + reinstate test
-     - remove virtual method calls
+   Revision 1.4  2003/01/16 22:14:49  peter
+     * fixed wrong methodpointer loads
 
-   Revision 1.3  2002/10/21 08:03:14  pierre
-    * added %FAIL because cdecl and virtual are not compatible
+   Revision 1.3  2003/01/05 18:21:30  peter
+     * removed more conflicting calling directives
 
    Revision 1.2  2002/09/07 15:40:54  peter
      * old logs removed and tabs fixed

tests/test/cg/tcalpvr4.pp

@@ -12,10 +12,10 @@
 { DEFINES:                                                       }
 {****************************************************************}
 { REMARKS: This tests a subset of the secondcalln() , it         }
-{          verifies procedural variables for popstack            }
+{          verifies procedural variables for popstack              }
 {          calling conventions.                                  }
 {****************************************************************}
-program tcalpvr4;
+program tcalpvr3;
 {$MODE OBJFPC}
 {$STATIC ON}
 {$R+}
@@ -43,22 +43,16 @@ type
     procedure test_normal(x: byte);popstack;
     class procedure test_static(x: byte);popstack;
     procedure test_virtual(x: byte);virtual;popstack;
-    procedure test_normal_self(self : tsimpleclass; x: byte); message 0;popstack;
-    class procedure test_static_self(self : tsimpleclass; x: byte); message 1;popstack;
-    procedure test_virtual_self(self : tsimpleclass; x: byte);virtual;message 2;popstack;
   end;
 
   tobjectmethod = procedure (x: byte) of object ;popstack;
   tclassmethod = procedure (x: byte) of object;popstack;
-  { used for testing pocontainsself explicit parameter }
-  tclassmethodself = procedure (self : tsimpleclass; x: byte) of object;popstack;
 
 var
   proc : troutine;
   func : troutineresult;
   obj_method : tobjectmethod;
   cla_method : tclassmethod;
-  cla_method_self : tclassmethodself;
   global_s32bit : longint;
   global_s64bit : int64;
   global_u8bit : byte;
@@ -137,12 +131,6 @@ var
      get_object_method_virtual := @obj.test_virtual;
    end;
 
-  { class access }
-  function get_class_method_normal_self : tclassmethodself;
-   begin
-     get_class_method_normal_self := @cla.test_normal_self;
-   end;
-
 {
   HOW CAN WE GET THIS ADDRESS???
   function get_class_method_static_self : tclassmethodself;
@@ -151,12 +139,6 @@ var
    end;
 }
 
-  function get_class_method_virtual_self : tclassmethodself;
-   begin
-     get_class_method_virtual_self := @cla.test_virtual_self;
-   end;
-
-
   function get_class_method_normal : tclassmethod;
    begin
      get_class_method_normal := @cla.test_normal;
@@ -214,21 +196,6 @@ var
      global_u8bit := x;
    end;
 
-  procedure tsimpleclass.test_normal_self(self : tsimpleclass; x: byte);popstack;
-   begin
-     global_u8bit := x;
-   end;
-
-  class procedure tsimpleclass.test_static_self(self : tsimpleclass; x: byte);popstack;
-   begin
-     global_u8bit := x;
-   end;
-
-  procedure tsimpleclass.test_virtual_self(self : tsimpleclass; x: byte);popstack;
-   begin
-     global_u8bit := x;
-   end;
-
 
 var
  failed : boolean;
@@ -500,22 +467,6 @@ Begin
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
- clear_globals;
- clear_values;
-
- tclassmethodself(get_class_method_normal_self)(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
-
- tclassmethodself(get_class_method_virtual_self)(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
-
  If failed then
    fail
  else
@@ -562,31 +513,6 @@ Begin
  clear_values;
 
 
- cla_method_self := @cla.test_normal_self;
- cla_method_self(cla, RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
-
- cla_method_self := @cla.test_virtual_self;
- cla_method_self(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
- cla_method_self := @cla.test_virtual_self;
- cla_method_self(cla, RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
 { cla_method := @cla.test_static;
  cla_method(RESULT_U8BIT);
  if global_u8bit <> RESULT_U8BIT then
@@ -601,12 +527,14 @@ end.
 
 {
    $Log$
-   Revision 1.4  2003-01-16 22:14:49  peter
+   Revision 1.5  2003-05-15 20:34:29  peter
+     * removed po_containsself tests
+
+   Revision 1.4  2003/01/16 22:14:49  peter
      * fixed wrong methodpointer loads
 
-   Revision 1.3  2002/12/29 15:30:55  peter
-     * updated for 1.1 compiler that does not allow calling conventions
-       for constructor/destructor
+   Revision 1.3  2003/01/05 18:21:30  peter
+     * removed more conflicting calling directives
 
    Revision 1.2  2002/09/07 15:40:54  peter
      * old logs removed and tabs fixed

tests/test/cg/tcalpvr5.pp

@@ -12,10 +12,10 @@
 { DEFINES:                                                       }
 {****************************************************************}
 { REMARKS: This tests a subset of the secondcalln() , it         }
-{          verifies procedural variables for safecall            }
+{          verifies procedural variables for safecall              }
 {          calling conventions.                                  }
 {****************************************************************}
-program tcalpvr5;
+program tcalpvr3;
 {$MODE OBJFPC}
 {$STATIC ON}
 {$R+}
@@ -43,22 +43,16 @@ type
     procedure test_normal(x: byte);safecall;
     class procedure test_static(x: byte);safecall;
     procedure test_virtual(x: byte);virtual;safecall;
-    procedure test_normal_self(self : tsimpleclass; x: byte); message 0;safecall;
-    class procedure test_static_self(self : tsimpleclass; x: byte); message 1;safecall;
-    procedure test_virtual_self(self : tsimpleclass; x: byte);virtual;message 2;safecall;
   end;
 
   tobjectmethod = procedure (x: byte) of object ;safecall;
   tclassmethod = procedure (x: byte) of object;safecall;
-  { used for testing pocontainsself explicit parameter }
-  tclassmethodself = procedure (self : tsimpleclass; x: byte) of object;safecall;
 
 var
   proc : troutine;
   func : troutineresult;
   obj_method : tobjectmethod;
   cla_method : tclassmethod;
-  cla_method_self : tclassmethodself;
   global_s32bit : longint;
   global_s64bit : int64;
   global_u8bit : byte;
@@ -137,12 +131,6 @@ var
      get_object_method_virtual := @obj.test_virtual;
    end;
 
-  { class access }
-  function get_class_method_normal_self : tclassmethodself;
-   begin
-     get_class_method_normal_self := @cla.test_normal_self;
-   end;
-
 {
   HOW CAN WE GET THIS ADDRESS???
   function get_class_method_static_self : tclassmethodself;
@@ -151,12 +139,6 @@ var
    end;
 }
 
-  function get_class_method_virtual_self : tclassmethodself;
-   begin
-     get_class_method_virtual_self := @cla.test_virtual_self;
-   end;
-
-
   function get_class_method_normal : tclassmethod;
    begin
      get_class_method_normal := @cla.test_normal;
@@ -214,21 +196,6 @@ var
      global_u8bit := x;
    end;
 
-  procedure tsimpleclass.test_normal_self(self : tsimpleclass; x: byte);safecall;
-   begin
-     global_u8bit := x;
-   end;
-
-  class procedure tsimpleclass.test_static_self(self : tsimpleclass; x: byte);safecall;
-   begin
-     global_u8bit := x;
-   end;
-
-  procedure tsimpleclass.test_virtual_self(self : tsimpleclass; x: byte);safecall;
-   begin
-     global_u8bit := x;
-   end;
-
 
 var
  failed : boolean;
@@ -500,22 +467,6 @@ Begin
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
- clear_globals;
- clear_values;
-
- tclassmethodself(get_class_method_normal_self)(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
-
- tclassmethodself(get_class_method_virtual_self)(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
-
  If failed then
    fail
  else
@@ -562,31 +513,6 @@ Begin
  clear_values;
 
 
- cla_method_self := @cla.test_normal_self;
- cla_method_self(cla, RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
-
- cla_method_self := @cla.test_virtual_self;
- cla_method_self(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
- cla_method_self := @cla.test_virtual_self;
- cla_method_self(cla, RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
 { cla_method := @cla.test_static;
  cla_method(RESULT_U8BIT);
  if global_u8bit <> RESULT_U8BIT then
@@ -601,12 +527,14 @@ end.
 
 {
    $Log$
-   Revision 1.4  2003-01-16 22:14:49  peter
+   Revision 1.5  2003-05-15 20:34:29  peter
+     * removed po_containsself tests
+
+   Revision 1.4  2003/01/16 22:14:49  peter
      * fixed wrong methodpointer loads
 
-   Revision 1.3  2002/12/29 15:30:55  peter
-     * updated for 1.1 compiler that does not allow calling conventions
-       for constructor/destructor
+   Revision 1.3  2003/01/05 18:21:30  peter
+     * removed more conflicting calling directives
 
    Revision 1.2  2002/09/07 15:40:54  peter
      * old logs removed and tabs fixed

tests/test/cg/tcalpvr6.pp

@@ -12,10 +12,10 @@
 { DEFINES:                                                       }
 {****************************************************************}
 { REMARKS: This tests a subset of the secondcalln() , it         }
-{          verifies procedural variables for register            }
+{          verifies procedural variables for register              }
 {          calling conventions.                                  }
 {****************************************************************}
-program tcalpvr6;
+program tcalpvr3;
 {$MODE OBJFPC}
 {$STATIC ON}
 {$R+}
@@ -43,22 +43,16 @@ type
     procedure test_normal(x: byte);register;
     class procedure test_static(x: byte);register;
     procedure test_virtual(x: byte);virtual;register;
-    procedure test_normal_self(self : tsimpleclass; x: byte); message 0;register;
-    class procedure test_static_self(self : tsimpleclass; x: byte); message 1;register;
-    procedure test_virtual_self(self : tsimpleclass; x: byte);virtual;message 2;register;
   end;
 
   tobjectmethod = procedure (x: byte) of object ;register;
   tclassmethod = procedure (x: byte) of object;register;
-  { used for testing pocontainsself explicit parameter }
-  tclassmethodself = procedure (self : tsimpleclass; x: byte) of object;register;
 
 var
   proc : troutine;
   func : troutineresult;
   obj_method : tobjectmethod;
   cla_method : tclassmethod;
-  cla_method_self : tclassmethodself;
   global_s32bit : longint;
   global_s64bit : int64;
   global_u8bit : byte;
@@ -137,12 +131,6 @@ var
      get_object_method_virtual := @obj.test_virtual;
    end;
 
-  { class access }
-  function get_class_method_normal_self : tclassmethodself;
-   begin
-     get_class_method_normal_self := @cla.test_normal_self;
-   end;
-
 {
   HOW CAN WE GET THIS ADDRESS???
   function get_class_method_static_self : tclassmethodself;
@@ -151,12 +139,6 @@ var
    end;
 }
 
-  function get_class_method_virtual_self : tclassmethodself;
-   begin
-     get_class_method_virtual_self := @cla.test_virtual_self;
-   end;
-
-
   function get_class_method_normal : tclassmethod;
    begin
      get_class_method_normal := @cla.test_normal;
@@ -214,21 +196,6 @@ var
      global_u8bit := x;
    end;
 
-  procedure tsimpleclass.test_normal_self(self : tsimpleclass; x: byte);register;
-   begin
-     global_u8bit := x;
-   end;
-
-  class procedure tsimpleclass.test_static_self(self : tsimpleclass; x: byte);register;
-   begin
-     global_u8bit := x;
-   end;
-
-  procedure tsimpleclass.test_virtual_self(self : tsimpleclass; x: byte);register;
-   begin
-     global_u8bit := x;
-   end;
-
 
 var
  failed : boolean;
@@ -500,22 +467,6 @@ Begin
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
- clear_globals;
- clear_values;
-
- tclassmethodself(get_class_method_normal_self)(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
-
- tclassmethodself(get_class_method_virtual_self)(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
-
  If failed then
    fail
  else
@@ -562,31 +513,6 @@ Begin
  clear_values;
 
 
- cla_method_self := @cla.test_normal_self;
- cla_method_self(cla, RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
-
- cla_method_self := @cla.test_virtual_self;
- cla_method_self(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
- cla_method_self := @cla.test_virtual_self;
- cla_method_self(cla, RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
 { cla_method := @cla.test_static;
  cla_method(RESULT_U8BIT);
  if global_u8bit <> RESULT_U8BIT then
@@ -601,13 +527,16 @@ end.
 
 {
    $Log$
-   Revision 1.4  2003-01-16 22:14:49  peter
+   Revision 1.5  2003-05-15 20:34:29  peter
+     * removed po_containsself tests
+
+   Revision 1.4  2003/01/16 22:14:49  peter
      * fixed wrong methodpointer loads
 
    Revision 1.3  2003/01/05 18:21:30  peter
      * removed more conflicting calling directives
 
-   Revision 1.2  2002/09/07 15:40:55  peter
+   Revision 1.2  2002/09/07 15:40:54  peter
      * old logs removed and tabs fixed
 
    Revision 1.1  2002/05/05 13:58:50  carl

tests/test/cg/tcalpvr7.pp

@@ -12,10 +12,10 @@
 { DEFINES:                                                       }
 {****************************************************************}
 { REMARKS: This tests a subset of the secondcalln() , it         }
-{          verifies procedural variables for stdcall             }
+{          verifies procedural variables for stdcall              }
 {          calling conventions.                                  }
 {****************************************************************}
-program tcalpvr7;
+program tcalpvr3;
 {$MODE OBJFPC}
 {$STATIC ON}
 {$R+}
@@ -43,22 +43,16 @@ type
     procedure test_normal(x: byte);stdcall;
     class procedure test_static(x: byte);stdcall;
     procedure test_virtual(x: byte);virtual;stdcall;
-    procedure test_normal_self(self : tsimpleclass; x: byte); message 0;stdcall;
-    class procedure test_static_self(self : tsimpleclass; x: byte); message 1;stdcall;
-    procedure test_virtual_self(self : tsimpleclass; x: byte);virtual;message 2;stdcall;
   end;
 
   tobjectmethod = procedure (x: byte) of object ;stdcall;
   tclassmethod = procedure (x: byte) of object;stdcall;
-  { used for testing pocontainsself explicit parameter }
-  tclassmethodself = procedure (self : tsimpleclass; x: byte) of object;stdcall;
 
 var
   proc : troutine;
   func : troutineresult;
   obj_method : tobjectmethod;
   cla_method : tclassmethod;
-  cla_method_self : tclassmethodself;
   global_s32bit : longint;
   global_s64bit : int64;
   global_u8bit : byte;
@@ -137,12 +131,6 @@ var
      get_object_method_virtual := @obj.test_virtual;
    end;
 
-  { class access }
-  function get_class_method_normal_self : tclassmethodself;
-   begin
-     get_class_method_normal_self := @cla.test_normal_self;
-   end;
-
 {
   HOW CAN WE GET THIS ADDRESS???
   function get_class_method_static_self : tclassmethodself;
@@ -151,12 +139,6 @@ var
    end;
 }
 
-  function get_class_method_virtual_self : tclassmethodself;
-   begin
-     get_class_method_virtual_self := @cla.test_virtual_self;
-   end;
-
-
   function get_class_method_normal : tclassmethod;
    begin
      get_class_method_normal := @cla.test_normal;
@@ -214,21 +196,6 @@ var
      global_u8bit := x;
    end;
 
-  procedure tsimpleclass.test_normal_self(self : tsimpleclass; x: byte);stdcall;
-   begin
-     global_u8bit := x;
-   end;
-
-  class procedure tsimpleclass.test_static_self(self : tsimpleclass; x: byte);stdcall;
-   begin
-     global_u8bit := x;
-   end;
-
-  procedure tsimpleclass.test_virtual_self(self : tsimpleclass; x: byte);stdcall;
-   begin
-     global_u8bit := x;
-   end;
-
 
 var
  failed : boolean;
@@ -500,22 +467,6 @@ Begin
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
- clear_globals;
- clear_values;
-
- tclassmethodself(get_class_method_normal_self)(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
-
- tclassmethodself(get_class_method_virtual_self)(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
-
  If failed then
    fail
  else
@@ -562,31 +513,6 @@ Begin
  clear_values;
 
 
- cla_method_self := @cla.test_normal_self;
- cla_method_self(cla, RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
-
- cla_method_self := @cla.test_virtual_self;
- cla_method_self(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
- cla_method_self := @cla.test_virtual_self;
- cla_method_self(cla, RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
 { cla_method := @cla.test_static;
  cla_method(RESULT_U8BIT);
  if global_u8bit <> RESULT_U8BIT then
@@ -601,14 +527,16 @@ end.
 
 {
    $Log$
-   Revision 1.4  2003-01-16 22:14:49  peter
+   Revision 1.5  2003-05-15 20:34:29  peter
+     * removed po_containsself tests
+
+   Revision 1.4  2003/01/16 22:14:49  peter
      * fixed wrong methodpointer loads
 
-   Revision 1.3  2002/12/29 15:30:55  peter
-     * updated for 1.1 compiler that does not allow calling conventions
-       for constructor/destructor
+   Revision 1.3  2003/01/05 18:21:30  peter
+     * removed more conflicting calling directives
 
-   Revision 1.2  2002/09/07 15:40:55  peter
+   Revision 1.2  2002/09/07 15:40:54  peter
      * old logs removed and tabs fixed
 
    Revision 1.1  2002/05/05 13:58:50  carl

tests/test/cg/tcalpvr8.pp

@@ -12,10 +12,10 @@
 { DEFINES:                                                       }
 {****************************************************************}
 { REMARKS: This tests a subset of the secondcalln() , it         }
-{          verifies procedural variables for saveregisters       }
+{          verifies procedural variables for saveregisters              }
 {          calling conventions.                                  }
 {****************************************************************}
-program tcalpvr8;
+program tcalpvr3;
 {$MODE OBJFPC}
 {$STATIC ON}
 {$R+}
@@ -43,22 +43,16 @@ type
     procedure test_normal(x: byte);saveregisters;
     class procedure test_static(x: byte);saveregisters;
     procedure test_virtual(x: byte);virtual;saveregisters;
-    procedure test_normal_self(self : tsimpleclass; x: byte); message 0;saveregisters;
-    class procedure test_static_self(self : tsimpleclass; x: byte); message 1;saveregisters;
-    procedure test_virtual_self(self : tsimpleclass; x: byte);virtual;message 2;saveregisters;
   end;
 
   tobjectmethod = procedure (x: byte) of object ;saveregisters;
   tclassmethod = procedure (x: byte) of object;saveregisters;
-  { used for testing pocontainsself explicit parameter }
-  tclassmethodself = procedure (self : tsimpleclass; x: byte) of object;saveregisters;
 
 var
   proc : troutine;
   func : troutineresult;
   obj_method : tobjectmethod;
   cla_method : tclassmethod;
-  cla_method_self : tclassmethodself;
   global_s32bit : longint;
   global_s64bit : int64;
   global_u8bit : byte;
@@ -137,12 +131,6 @@ var
      get_object_method_virtual := @obj.test_virtual;
    end;
 
-  { class access }
-  function get_class_method_normal_self : tclassmethodself;
-   begin
-     get_class_method_normal_self := @cla.test_normal_self;
-   end;
-
 {
   HOW CAN WE GET THIS ADDRESS???
   function get_class_method_static_self : tclassmethodself;
@@ -151,12 +139,6 @@ var
    end;
 }
 
-  function get_class_method_virtual_self : tclassmethodself;
-   begin
-     get_class_method_virtual_self := @cla.test_virtual_self;
-   end;
-
-
   function get_class_method_normal : tclassmethod;
    begin
      get_class_method_normal := @cla.test_normal;
@@ -214,21 +196,6 @@ var
      global_u8bit := x;
    end;
 
-  procedure tsimpleclass.test_normal_self(self : tsimpleclass; x: byte);saveregisters;
-   begin
-     global_u8bit := x;
-   end;
-
-  class procedure tsimpleclass.test_static_self(self : tsimpleclass; x: byte);saveregisters;
-   begin
-     global_u8bit := x;
-   end;
-
-  procedure tsimpleclass.test_virtual_self(self : tsimpleclass; x: byte);saveregisters;
-   begin
-     global_u8bit := x;
-   end;
-
 
 var
  failed : boolean;
@@ -500,22 +467,6 @@ Begin
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
- clear_globals;
- clear_values;
-
- tclassmethodself(get_class_method_normal_self)(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
-
- tclassmethodself(get_class_method_virtual_self)(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
-
  If failed then
    fail
  else
@@ -562,31 +513,6 @@ Begin
  clear_values;
 
 
- cla_method_self := @cla.test_normal_self;
- cla_method_self(cla, RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
-
- cla_method_self := @cla.test_virtual_self;
- cla_method_self(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
- cla_method_self := @cla.test_virtual_self;
- cla_method_self(cla, RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
 { cla_method := @cla.test_static;
  cla_method(RESULT_U8BIT);
  if global_u8bit <> RESULT_U8BIT then
@@ -601,14 +527,16 @@ end.
 
 {
    $Log$
-   Revision 1.4  2003-01-16 22:14:49  peter
+   Revision 1.5  2003-05-15 20:34:29  peter
+     * removed po_containsself tests
+
+   Revision 1.4  2003/01/16 22:14:49  peter
      * fixed wrong methodpointer loads
 
-   Revision 1.3  2002/12/29 15:30:55  peter
-     * updated for 1.1 compiler that does not allow calling conventions
-       for constructor/destructor
+   Revision 1.3  2003/01/05 18:21:30  peter
+     * removed more conflicting calling directives
 
-   Revision 1.2  2002/09/07 15:40:55  peter
+   Revision 1.2  2002/09/07 15:40:54  peter
      * old logs removed and tabs fixed
 
    Revision 1.1  2002/05/05 13:58:50  carl