paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 08:09:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ reinstate test

Browse Source 
- remove virtual method calls
This commit is contained in:
carl 2002-10-21 19:07:08 +00:00
parent 22beab1c43
commit e800227924
2 changed files with 31 additions and 164 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
tests/test/cg/tcalobj3.pp
View File

@ -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

146
tests/test/cg/tcalpvr3.pp
View File

@ -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:=@tsimpleobject.test_virtual;
obj_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then
failed := true;
clear_globals;
clear_values;
obj_method:=@obj.test_virtual;
obj_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then
failed := true;
clear_globals;
clear_values;
value_u8bit := RESULT_U8BIT;
obj_method:=@obj.test_normal;
obj_method(value_u8bit);
if global_u8bit <> RESULT_U8BIT then
failed := true;
clear_globals;
clear_values;
value_u8bit := RESULT_U8BIT;
obj_method:=@tsimpleobject.test_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