+ reinstate test

  - remove virtual method calls

tests/test/cg/tcalobj3.pp

@@ -1,6 +1,3 @@
-{ %FAIL }
-{ this test should fail at compilation
-  because cdecl and virtual are incompatible PM }
 {****************************************************************}
 {  CODE GENERATOR TEST PROGRAM                                   }
 {  Copyright (c) 2002 Carl Eric Codere                           }
@@ -201,9 +198,9 @@ type
    procedure method_normal_params_mixed(u8 :byte; u16: word;
       bigstring: shortstring; s32: longint; s64: int64);cdecl;
    procedure method_virtual_params_mixed(u8 :byte; u16: word;
-      bigstring: shortstring; s32: longint; s64: int64);virtual;cdecl;
+      bigstring: shortstring; s32: longint; s64: int64);virtual;
    procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word;
-      bigstring: shortstring; s32: longint; s64: int64);virtual;cdecl;
+      bigstring: shortstring; s32: longint; s64: int64);virtual;
    procedure method_static_params_mixed(u8 :byte; u16: word;
       bigstring: shortstring; s32: longint; s64: int64);static;cdecl;
    procedure method_normal_call_inherited_params_mixed(
@@ -211,17 +208,17 @@ type
 
    { virtual methods which call other methods }
    procedure method_virtual_call_static_params_mixed(
-      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;cdecl;
+      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
    procedure method_virtual_call_virtual_params_mixed(
-      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;cdecl;
+      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
    procedure method_virtual_call_overriden_params_mixed(
-      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;cdecl;
+      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
    procedure method_virtual_call_normal_params_mixed(
-      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;cdecl;
+      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
    procedure method_virtual_call_constructor_params_mixed(
-      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;cdecl;
+      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
    procedure method_virtual_call_inherited_params_mixed(
-      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;cdecl;
+      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
 
  end;
 
@@ -238,7 +235,7 @@ type
    constructor constructor_params_mixed_call_inherited(u8 :byte; u16: word;
       bigstring: shortstring; s32: longint; s64: int64);cdecl;
    procedure method_virtual_overriden_params_mixed(
-    u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;cdecl;
+    u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
 
    { normal methods which call other methods }
    procedure method_normal_call_static_params_mixed(
@@ -256,7 +253,7 @@ type
 
    { virtual methods which call other methods }
    procedure method_virtual_call_inherited_params_mixed(
-      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;cdecl;
+      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
 
  end;
 
@@ -455,7 +452,7 @@ procedure tvmtobject.method_normal_params_mixed(
  end;
 
 procedure tvmtobject.method_virtual_params_mixed(
-    u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+    u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  begin
    object_u8bit := u8;
    object_u16bit := u16;
@@ -466,7 +463,7 @@ procedure tvmtobject.method_virtual_params_mixed(
 
 { this one should be overriden }
 procedure tvmtobject.method_virtual_overriden_params_mixed(
-    u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+    u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  begin
     RunError(211);
  end;
@@ -494,38 +491,38 @@ procedure tvmtobject.method_normal_call_inherited_params_mixed(
 
 
 procedure tvmtobject.method_virtual_call_static_params_mixed(
-      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
   begin
     method_static_params_mixed(u8, u16, bigstring, s32, s64);
   end;
 
 procedure tvmtobject.method_virtual_call_virtual_params_mixed(
-      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
    begin
     method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
    end;
 
 procedure tvmtobject.method_virtual_call_overriden_params_mixed(
-      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
    begin
     method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
    end;
 
 
 procedure tvmtobject.method_virtual_call_normal_params_mixed(
-      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
    begin
     method_normal_params_mixed(u8, u16, bigstring, s32, s64);
    end;
 
 procedure tvmtobject.method_virtual_call_constructor_params_mixed(
-      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
    begin
      constructor_params_mixed(u8, u16, bigstring, s32, s64);
    end;
 
 procedure tvmtobject.method_virtual_call_inherited_params_mixed(
-      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
   begin
    object_u8bit := u8;
    object_u16bit := u16;
@@ -595,7 +592,7 @@ constructor theritedvmtobject.constructor_params_mixed_call_inherited
 
 { this one should be overriden }
 procedure theritedvmtobject.method_virtual_overriden_params_mixed(
-    u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+    u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
  begin
    object_u8bit := u8;
    object_u16bit := u16;
@@ -643,7 +640,7 @@ procedure theritedvmtobject.method_normal_call_inherited_params_mixed(
   end;
 
 procedure theritedvmtobject.method_virtual_call_inherited_params_mixed(
-      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+      u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
   begin
    Inherited method_virtual_call_inherited_params_mixed(u8, u16, bigstring,
      s32, s64);
@@ -3297,7 +3294,11 @@ end.
 
 {
   $Log$
-  Revision 1.4  2002-10-21 08:03:14  pierre
+  Revision 1.5  2002-10-21 19:07:08  carl
+    + reinstate test
+    - remove virtual method calls
+
+  Revision 1.4  2002/10/21 08:03:14  pierre
    * added %FAIL because cdecl and virtual are not compatible
 
   Revision 1.3  2002/09/07 15:40:53  peter

tests/test/cg/tcalpvr3.pp

@@ -1,6 +1,3 @@
-{ %FAIL }
-{  fail added because cdecl and virtual methods are 
-   incompatible PM }
 {****************************************************************}
 {  CODE GENERATOR TEST PROGRAM                                   }
 {****************************************************************}
@@ -38,17 +35,14 @@ type
     constructor init;cdecl;
     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;cdecl;
     procedure test_normal(x: byte);cdecl;
     class procedure test_static(x: byte);cdecl;
-    procedure test_virtual(x: byte);virtual;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_self(self : tsimpleclass; x: byte);virtual;message 2;cdecl;
   end;
 
   tobjectmethod = procedure (x: byte) of object ;cdecl;
@@ -130,15 +124,7 @@ var
      get_object_method_normal := @obj.test_normal;
    end;
 
-  function get_object_type_method_virtual : tobjectmethod;
-   begin
-     get_object_type_method_virtual := @tsimpleobject.test_virtual;
-   end;
 
-  function get_object_method_virtual : tobjectmethod;
-   begin
-     get_object_method_virtual := @obj.test_virtual;
-   end;
 
   { class access }
   function get_class_method_normal_self : tclassmethodself;
@@ -154,12 +140,7 @@ var
    end;
 }
 
-  function get_class_method_virtual_self : tclassmethodself;
-   begin
-     get_class_method_virtual_self := @tsimpleclass.test_virtual_self;
-   end;
-
-
+  
   function get_class_method_normal : tclassmethod;
    begin
      get_class_method_normal := @tsimpleclass.test_normal;
@@ -170,10 +151,6 @@ var
      get_class_method_static := @tsimpleclass.test_static;
    end;}
 
-  function get_class_method_virtual : tclassmethod;
-   begin
-     get_class_method_virtual := @tsimpleclass.test_virtual;
-   end;
 
  {****************************************************************************************************}
 
@@ -191,11 +168,6 @@ var
      global_u8bit := x;
    end;
 
-  procedure tsimpleobject.test_virtual(x: byte);cdecl;
-   begin
-     global_u8bit := x;
-   end;
-
  {****************************************************************************************************}
   constructor tsimpleclass.create;cdecl;
    begin
@@ -212,10 +184,6 @@ var
      global_u8bit := x;
    end;
 
-  procedure tsimpleclass.test_virtual(x: byte);cdecl;
-   begin
-     global_u8bit := x;
-   end;
 
   procedure tsimpleclass.test_normal_self(self : tsimpleclass; x: byte);cdecl;
    begin
@@ -227,10 +195,6 @@ var
      global_u8bit := x;
    end;
 
-  procedure tsimpleclass.test_virtual_self(self : tsimpleclass; x: byte);cdecl;
-   begin
-     global_u8bit := x;
-   end;
 
 
 var
@@ -380,19 +344,6 @@ 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;
@@ -402,22 +353,6 @@ 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
@@ -438,36 +373,12 @@ 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;
@@ -498,27 +409,10 @@ Begin
  clear_globals;
  clear_values;
 
-
- 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);
  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
@@ -536,22 +430,6 @@ Begin
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
- clear_globals;
- clear_values;
-
-
- cla_method := @tsimpleclass.test_virtual;
- cla_method(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
- cla_method := @tsimpleclass.test_virtual;
- cla_method(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
 
  clear_globals;
  clear_values;
@@ -570,22 +448,6 @@ Begin
  if global_u8bit <> RESULT_U8BIT then
    failed := true;
 
- clear_globals;
- clear_values;
-
-
- cla_method_self := @tsimpleclass.test_virtual_self;
- cla_method_self(cla,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
-
- clear_globals;
- clear_values;
-
- cla_method_self := @tsimpleclass.test_virtual_self;
- cla_method_self(cla, RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
-   failed := true;
 
  clear_globals;
  clear_values;
@@ -604,7 +466,11 @@ end.
 
 {
    $Log$
-   Revision 1.3  2002-10-21 08:03:14  pierre
+   Revision 1.4  2002-10-21 19:07:08  carl
+     + reinstate test
+     - remove virtual method calls
+
+   Revision 1.3  2002/10/21 08:03:14  pierre
     * added %FAIL because cdecl and virtual are not compatible
 
    Revision 1.2  2002/09/07 15:40:54  peter