paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 11:26:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed wrong methodpointer loads

Browse Source
This commit is contained in:
peter 2003-01-16 22:14:49 +00:00
parent 34de6782a5
commit 674d7a80b8
8 changed files with 152 additions and 128 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
tests/test/cg/tcalpvr1.pp
View File

@ -129,7 +129,7 @@ var
function get_object_type_method_virtual : tobjectmethod; function get_object_type_method_virtual : tobjectmethod;
begin begin
get_object_type_method_virtual := @tsimpleobject.test_virtual; get_object_type_method_virtual := @obj.test_virtual;
end; end;
function get_object_method_virtual : tobjectmethod; function get_object_method_virtual : tobjectmethod;
@ -140,7 +140,7 @@ var
{ class access } { class access }
function get_class_method_normal_self : tclassmethodself; function get_class_method_normal_self : tclassmethodself;
begin begin
get_class_method_normal_self := @tsimpleclass.test_normal_self; get_class_method_normal_self := @cla.test_normal_self;
end; end;
{ {
@ -153,23 +153,23 @@ var
function get_class_method_virtual_self : tclassmethodself; function get_class_method_virtual_self : tclassmethodself;
begin begin
get_class_method_virtual_self := @tsimpleclass.test_virtual_self; get_class_method_virtual_self := @cla.test_virtual_self;
end; end;
function get_class_method_normal : tclassmethod; function get_class_method_normal : tclassmethod;
begin begin
get_class_method_normal := @tsimpleclass.test_normal; get_class_method_normal := @cla.test_normal;
end; end;
{ {
function get_class_method_static : tclassmethod; function get_class_method_static : tclassmethod;
begin begin
get_class_method_static := @tsimpleclass.test_static; get_class_method_static := @cla.test_static;
end;} end;}
function get_class_method_virtual : tclassmethod; function get_class_method_virtual : tclassmethod;
begin begin
get_class_method_virtual := @tsimpleclass.test_virtual; get_class_method_virtual := @cla.test_virtual;
end; end;
{****************************************************************************************************} {****************************************************************************************************}
@ -435,7 +435,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
obj_method:=@tsimpleobject.test_virtual; obj_method:=@obj.test_virtual;
obj_method(RESULT_U8BIT); obj_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -461,7 +461,7 @@ Begin
clear_values; clear_values;
value_u8bit := RESULT_U8BIT; value_u8bit := RESULT_U8BIT;
obj_method:=@tsimpleobject.test_virtual; obj_method:=@obj.test_virtual;
obj_method(value_u8bit); obj_method(value_u8bit);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -528,7 +528,7 @@ Begin
failed := false; failed := false;
cla_method := @tsimpleclass.test_normal; cla_method := @cla.test_normal;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -537,7 +537,7 @@ Begin
clear_values; clear_values;
cla_method := @tsimpleclass.test_virtual; cla_method := @cla.test_virtual;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -545,7 +545,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
cla_method := @tsimpleclass.test_virtual; cla_method := @cla.test_virtual;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -553,7 +553,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -562,7 +562,7 @@ Begin
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_normal_self; cla_method_self := @cla.test_normal_self;
cla_method_self(cla, RESULT_U8BIT); cla_method_self(cla, RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -571,7 +571,7 @@ Begin
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_virtual_self; cla_method_self := @cla.test_virtual_self;
cla_method_self(cla,RESULT_U8BIT); cla_method_self(cla,RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -579,7 +579,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_virtual_self; cla_method_self := @cla.test_virtual_self;
cla_method_self(cla, RESULT_U8BIT); cla_method_self(cla, RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -587,7 +587,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -601,7 +601,10 @@ end.
{ {
$Log$ $Log$
Revision 1.4 2002-09-07 15:40:54 peter Revision 1.5 2003-01-16 22:14:49 peter
* fixed wrong methodpointer loads
Revision 1.4 2002/09/07 15:40:54 peter
* old logs removed and tabs fixed * old logs removed and tabs fixed
Revision 1.3 2002/04/15 14:40:45 carl Revision 1.3 2002/04/15 14:40:45 carl

37
tests/test/cg/tcalpvr2.pp
View File

@ -129,7 +129,7 @@ var
function get_object_type_method_virtual : tobjectmethod; function get_object_type_method_virtual : tobjectmethod;
begin begin
get_object_type_method_virtual := @tsimpleobject.test_virtual; get_object_type_method_virtual := @obj.test_virtual;
end; end;
function get_object_method_virtual : tobjectmethod; function get_object_method_virtual : tobjectmethod;
@ -140,7 +140,7 @@ var
{ class access } { class access }
function get_class_method_normal_self : tclassmethodself; function get_class_method_normal_self : tclassmethodself;
begin begin
get_class_method_normal_self := @tsimpleclass.test_normal_self; get_class_method_normal_self := @cla.test_normal_self;
end; end;
{ {
@ -153,23 +153,23 @@ var
function get_class_method_virtual_self : tclassmethodself; function get_class_method_virtual_self : tclassmethodself;
begin begin
get_class_method_virtual_self := @tsimpleclass.test_virtual_self; get_class_method_virtual_self := @cla.test_virtual_self;
end; end;
function get_class_method_normal : tclassmethod; function get_class_method_normal : tclassmethod;
begin begin
get_class_method_normal := @tsimpleclass.test_normal; get_class_method_normal := @cla.test_normal;
end; end;
{ {
function get_class_method_static : tclassmethod; function get_class_method_static : tclassmethod;
begin begin
get_class_method_static := @tsimpleclass.test_static; get_class_method_static := @cla.test_static;
end;} end;}
function get_class_method_virtual : tclassmethod; function get_class_method_virtual : tclassmethod;
begin begin
get_class_method_virtual := @tsimpleclass.test_virtual; get_class_method_virtual := @cla.test_virtual;
end; end;
{****************************************************************************************************} {****************************************************************************************************}
@ -435,7 +435,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
obj_method:=@tsimpleobject.test_virtual; obj_method:=@obj.test_virtual;
obj_method(RESULT_U8BIT); obj_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -461,7 +461,7 @@ Begin
clear_values; clear_values;
value_u8bit := RESULT_U8BIT; value_u8bit := RESULT_U8BIT;
obj_method:=@tsimpleobject.test_virtual; obj_method:=@obj.test_virtual;
obj_method(value_u8bit); obj_method(value_u8bit);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -528,7 +528,7 @@ Begin
failed := false; failed := false;
cla_method := @tsimpleclass.test_normal; cla_method := @cla.test_normal;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -537,7 +537,7 @@ Begin
clear_values; clear_values;
cla_method := @tsimpleclass.test_virtual; cla_method := @cla.test_virtual;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -545,7 +545,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
cla_method := @tsimpleclass.test_virtual; cla_method := @cla.test_virtual;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -553,7 +553,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -562,7 +562,7 @@ Begin
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_normal_self; cla_method_self := @cla.test_normal_self;
cla_method_self(cla, RESULT_U8BIT); cla_method_self(cla, RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -571,7 +571,7 @@ Begin
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_virtual_self; cla_method_self := @cla.test_virtual_self;
cla_method_self(cla,RESULT_U8BIT); cla_method_self(cla,RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -579,7 +579,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_virtual_self; cla_method_self := @cla.test_virtual_self;
cla_method_self(cla, RESULT_U8BIT); cla_method_self(cla, RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -587,7 +587,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -601,7 +601,10 @@ end.
{ {
$Log$ $Log$
Revision 1.3 2003-01-05 18:21:30 peter 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 * removed more conflicting calling directives
Revision 1.2 2002/09/07 15:40:54 peter Revision 1.2 2002/09/07 15:40:54 peter

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

@ -129,7 +129,7 @@ var
{ class access } { class access }
function get_class_method_normal_self : tclassmethodself; function get_class_method_normal_self : tclassmethodself;
begin begin
get_class_method_normal_self := @tsimpleclass.test_normal_self; get_class_method_normal_self := @cla.test_normal_self;
end; end;
{ {
@ -140,15 +140,15 @@ var
end; end;
} }
function get_class_method_normal : tclassmethod; function get_class_method_normal : tclassmethod;
begin begin
get_class_method_normal := @tsimpleclass.test_normal; get_class_method_normal := @cla.test_normal;
end; end;
{ {
function get_class_method_static : tclassmethod; function get_class_method_static : tclassmethod;
begin begin
get_class_method_static := @tsimpleclass.test_static; get_class_method_static := @cla.test_static;
end;} end;}
@ -425,7 +425,7 @@ Begin
failed := false; failed := false;
cla_method := @tsimpleclass.test_normal; cla_method := @cla.test_normal;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -434,7 +434,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -443,7 +443,7 @@ Begin
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_normal_self; cla_method_self := @cla.test_normal_self;
cla_method_self(cla, RESULT_U8BIT); cla_method_self(cla, RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -452,7 +452,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -466,7 +466,10 @@ end.
{ {
$Log$ $Log$
Revision 1.6 2002-10-29 20:44:31 carl 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) * updated with corrects testing (removed cdecl in constructors)
Revision 1.5 2002/10/21 19:21:28 carl Revision 1.5 2002/10/21 19:21:28 carl

37
tests/test/cg/tcalpvr4.pp
View File

@ -129,7 +129,7 @@ var
function get_object_type_method_virtual : tobjectmethod; function get_object_type_method_virtual : tobjectmethod;
begin begin
get_object_type_method_virtual := @tsimpleobject.test_virtual; get_object_type_method_virtual := @obj.test_virtual;
end; end;
function get_object_method_virtual : tobjectmethod; function get_object_method_virtual : tobjectmethod;
@ -140,7 +140,7 @@ var
{ class access } { class access }
function get_class_method_normal_self : tclassmethodself; function get_class_method_normal_self : tclassmethodself;
begin begin
get_class_method_normal_self := @tsimpleclass.test_normal_self; get_class_method_normal_self := @cla.test_normal_self;
end; end;
{ {
@ -153,23 +153,23 @@ var
function get_class_method_virtual_self : tclassmethodself; function get_class_method_virtual_self : tclassmethodself;
begin begin
get_class_method_virtual_self := @tsimpleclass.test_virtual_self; get_class_method_virtual_self := @cla.test_virtual_self;
end; end;
function get_class_method_normal : tclassmethod; function get_class_method_normal : tclassmethod;
begin begin
get_class_method_normal := @tsimpleclass.test_normal; get_class_method_normal := @cla.test_normal;
end; end;
{ {
function get_class_method_static : tclassmethod; function get_class_method_static : tclassmethod;
begin begin
get_class_method_static := @tsimpleclass.test_static; get_class_method_static := @cla.test_static;
end;} end;}
function get_class_method_virtual : tclassmethod; function get_class_method_virtual : tclassmethod;
begin begin
get_class_method_virtual := @tsimpleclass.test_virtual; get_class_method_virtual := @cla.test_virtual;
end; end;
{****************************************************************************************************} {****************************************************************************************************}
@ -435,7 +435,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
obj_method:=@tsimpleobject.test_virtual; obj_method:=@obj.test_virtual;
obj_method(RESULT_U8BIT); obj_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -461,7 +461,7 @@ Begin
clear_values; clear_values;
value_u8bit := RESULT_U8BIT; value_u8bit := RESULT_U8BIT;
obj_method:=@tsimpleobject.test_virtual; obj_method:=@obj.test_virtual;
obj_method(value_u8bit); obj_method(value_u8bit);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -528,7 +528,7 @@ Begin
failed := false; failed := false;
cla_method := @tsimpleclass.test_normal; cla_method := @cla.test_normal;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -537,7 +537,7 @@ Begin
clear_values; clear_values;
cla_method := @tsimpleclass.test_virtual; cla_method := @cla.test_virtual;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -545,7 +545,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
cla_method := @tsimpleclass.test_virtual; cla_method := @cla.test_virtual;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -553,7 +553,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -562,7 +562,7 @@ Begin
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_normal_self; cla_method_self := @cla.test_normal_self;
cla_method_self(cla, RESULT_U8BIT); cla_method_self(cla, RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -571,7 +571,7 @@ Begin
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_virtual_self; cla_method_self := @cla.test_virtual_self;
cla_method_self(cla,RESULT_U8BIT); cla_method_self(cla,RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -579,7 +579,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_virtual_self; cla_method_self := @cla.test_virtual_self;
cla_method_self(cla, RESULT_U8BIT); cla_method_self(cla, RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -587,7 +587,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -601,7 +601,10 @@ end.
{ {
$Log$ $Log$
Revision 1.3 2002-12-29 15:30:55 peter 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 * updated for 1.1 compiler that does not allow calling conventions
for constructor/destructor for constructor/destructor

37
tests/test/cg/tcalpvr5.pp
View File

@ -129,7 +129,7 @@ var
function get_object_type_method_virtual : tobjectmethod; function get_object_type_method_virtual : tobjectmethod;
begin begin
get_object_type_method_virtual := @tsimpleobject.test_virtual; get_object_type_method_virtual := @obj.test_virtual;
end; end;
function get_object_method_virtual : tobjectmethod; function get_object_method_virtual : tobjectmethod;
@ -140,7 +140,7 @@ var
{ class access } { class access }
function get_class_method_normal_self : tclassmethodself; function get_class_method_normal_self : tclassmethodself;
begin begin
get_class_method_normal_self := @tsimpleclass.test_normal_self; get_class_method_normal_self := @cla.test_normal_self;
end; end;
{ {
@ -153,23 +153,23 @@ var
function get_class_method_virtual_self : tclassmethodself; function get_class_method_virtual_self : tclassmethodself;
begin begin
get_class_method_virtual_self := @tsimpleclass.test_virtual_self; get_class_method_virtual_self := @cla.test_virtual_self;
end; end;
function get_class_method_normal : tclassmethod; function get_class_method_normal : tclassmethod;
begin begin
get_class_method_normal := @tsimpleclass.test_normal; get_class_method_normal := @cla.test_normal;
end; end;
{ {
function get_class_method_static : tclassmethod; function get_class_method_static : tclassmethod;
begin begin
get_class_method_static := @tsimpleclass.test_static; get_class_method_static := @cla.test_static;
end;} end;}
function get_class_method_virtual : tclassmethod; function get_class_method_virtual : tclassmethod;
begin begin
get_class_method_virtual := @tsimpleclass.test_virtual; get_class_method_virtual := @cla.test_virtual;
end; end;
{****************************************************************************************************} {****************************************************************************************************}
@ -435,7 +435,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
obj_method:=@tsimpleobject.test_virtual; obj_method:=@obj.test_virtual;
obj_method(RESULT_U8BIT); obj_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -461,7 +461,7 @@ Begin
clear_values; clear_values;
value_u8bit := RESULT_U8BIT; value_u8bit := RESULT_U8BIT;
obj_method:=@tsimpleobject.test_virtual; obj_method:=@obj.test_virtual;
obj_method(value_u8bit); obj_method(value_u8bit);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -528,7 +528,7 @@ Begin
failed := false; failed := false;
cla_method := @tsimpleclass.test_normal; cla_method := @cla.test_normal;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -537,7 +537,7 @@ Begin
clear_values; clear_values;
cla_method := @tsimpleclass.test_virtual; cla_method := @cla.test_virtual;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -545,7 +545,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
cla_method := @tsimpleclass.test_virtual; cla_method := @cla.test_virtual;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -553,7 +553,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -562,7 +562,7 @@ Begin
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_normal_self; cla_method_self := @cla.test_normal_self;
cla_method_self(cla, RESULT_U8BIT); cla_method_self(cla, RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -571,7 +571,7 @@ Begin
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_virtual_self; cla_method_self := @cla.test_virtual_self;
cla_method_self(cla,RESULT_U8BIT); cla_method_self(cla,RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -579,7 +579,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_virtual_self; cla_method_self := @cla.test_virtual_self;
cla_method_self(cla, RESULT_U8BIT); cla_method_self(cla, RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -587,7 +587,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -601,7 +601,10 @@ end.
{ {
$Log$ $Log$
Revision 1.3 2002-12-29 15:30:55 peter 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 * updated for 1.1 compiler that does not allow calling conventions
for constructor/destructor for constructor/destructor

37
tests/test/cg/tcalpvr6.pp
View File

@ -129,7 +129,7 @@ var
function get_object_type_method_virtual : tobjectmethod; function get_object_type_method_virtual : tobjectmethod;
begin begin
get_object_type_method_virtual := @tsimpleobject.test_virtual; get_object_type_method_virtual := @obj.test_virtual;
end; end;
function get_object_method_virtual : tobjectmethod; function get_object_method_virtual : tobjectmethod;
@ -140,7 +140,7 @@ var
{ class access } { class access }
function get_class_method_normal_self : tclassmethodself; function get_class_method_normal_self : tclassmethodself;
begin begin
get_class_method_normal_self := @tsimpleclass.test_normal_self; get_class_method_normal_self := @cla.test_normal_self;
end; end;
{ {
@ -153,23 +153,23 @@ var
function get_class_method_virtual_self : tclassmethodself; function get_class_method_virtual_self : tclassmethodself;
begin begin
get_class_method_virtual_self := @tsimpleclass.test_virtual_self; get_class_method_virtual_self := @cla.test_virtual_self;
end; end;
function get_class_method_normal : tclassmethod; function get_class_method_normal : tclassmethod;
begin begin
get_class_method_normal := @tsimpleclass.test_normal; get_class_method_normal := @cla.test_normal;
end; end;
{ {
function get_class_method_static : tclassmethod; function get_class_method_static : tclassmethod;
begin begin
get_class_method_static := @tsimpleclass.test_static; get_class_method_static := @cla.test_static;
end;} end;}
function get_class_method_virtual : tclassmethod; function get_class_method_virtual : tclassmethod;
begin begin
get_class_method_virtual := @tsimpleclass.test_virtual; get_class_method_virtual := @cla.test_virtual;
end; end;
{****************************************************************************************************} {****************************************************************************************************}
@ -435,7 +435,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
obj_method:=@tsimpleobject.test_virtual; obj_method:=@obj.test_virtual;
obj_method(RESULT_U8BIT); obj_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -461,7 +461,7 @@ Begin
clear_values; clear_values;
value_u8bit := RESULT_U8BIT; value_u8bit := RESULT_U8BIT;
obj_method:=@tsimpleobject.test_virtual; obj_method:=@obj.test_virtual;
obj_method(value_u8bit); obj_method(value_u8bit);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -528,7 +528,7 @@ Begin
failed := false; failed := false;
cla_method := @tsimpleclass.test_normal; cla_method := @cla.test_normal;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -537,7 +537,7 @@ Begin
clear_values; clear_values;
cla_method := @tsimpleclass.test_virtual; cla_method := @cla.test_virtual;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -545,7 +545,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
cla_method := @tsimpleclass.test_virtual; cla_method := @cla.test_virtual;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -553,7 +553,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -562,7 +562,7 @@ Begin
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_normal_self; cla_method_self := @cla.test_normal_self;
cla_method_self(cla, RESULT_U8BIT); cla_method_self(cla, RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -571,7 +571,7 @@ Begin
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_virtual_self; cla_method_self := @cla.test_virtual_self;
cla_method_self(cla,RESULT_U8BIT); cla_method_self(cla,RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -579,7 +579,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_virtual_self; cla_method_self := @cla.test_virtual_self;
cla_method_self(cla, RESULT_U8BIT); cla_method_self(cla, RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -587,7 +587,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -601,7 +601,10 @@ end.
{ {
$Log$ $Log$
Revision 1.3 2003-01-05 18:21:30 peter 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 * removed more conflicting calling directives
Revision 1.2 2002/09/07 15:40:55 peter Revision 1.2 2002/09/07 15:40:55 peter

37
tests/test/cg/tcalpvr7.pp
View File

@ -129,7 +129,7 @@ var
function get_object_type_method_virtual : tobjectmethod; function get_object_type_method_virtual : tobjectmethod;
begin begin
get_object_type_method_virtual := @tsimpleobject.test_virtual; get_object_type_method_virtual := @obj.test_virtual;
end; end;
function get_object_method_virtual : tobjectmethod; function get_object_method_virtual : tobjectmethod;
@ -140,7 +140,7 @@ var
{ class access } { class access }
function get_class_method_normal_self : tclassmethodself; function get_class_method_normal_self : tclassmethodself;
begin begin
get_class_method_normal_self := @tsimpleclass.test_normal_self; get_class_method_normal_self := @cla.test_normal_self;
end; end;
{ {
@ -153,23 +153,23 @@ var
function get_class_method_virtual_self : tclassmethodself; function get_class_method_virtual_self : tclassmethodself;
begin begin
get_class_method_virtual_self := @tsimpleclass.test_virtual_self; get_class_method_virtual_self := @cla.test_virtual_self;
end; end;
function get_class_method_normal : tclassmethod; function get_class_method_normal : tclassmethod;
begin begin
get_class_method_normal := @tsimpleclass.test_normal; get_class_method_normal := @cla.test_normal;
end; end;
{ {
function get_class_method_static : tclassmethod; function get_class_method_static : tclassmethod;
begin begin
get_class_method_static := @tsimpleclass.test_static; get_class_method_static := @cla.test_static;
end;} end;}
function get_class_method_virtual : tclassmethod; function get_class_method_virtual : tclassmethod;
begin begin
get_class_method_virtual := @tsimpleclass.test_virtual; get_class_method_virtual := @cla.test_virtual;
end; end;
{****************************************************************************************************} {****************************************************************************************************}
@ -435,7 +435,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
obj_method:=@tsimpleobject.test_virtual; obj_method:=@obj.test_virtual;
obj_method(RESULT_U8BIT); obj_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -461,7 +461,7 @@ Begin
clear_values; clear_values;
value_u8bit := RESULT_U8BIT; value_u8bit := RESULT_U8BIT;
obj_method:=@tsimpleobject.test_virtual; obj_method:=@obj.test_virtual;
obj_method(value_u8bit); obj_method(value_u8bit);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -528,7 +528,7 @@ Begin
failed := false; failed := false;
cla_method := @tsimpleclass.test_normal; cla_method := @cla.test_normal;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -537,7 +537,7 @@ Begin
clear_values; clear_values;
cla_method := @tsimpleclass.test_virtual; cla_method := @cla.test_virtual;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -545,7 +545,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
cla_method := @tsimpleclass.test_virtual; cla_method := @cla.test_virtual;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -553,7 +553,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -562,7 +562,7 @@ Begin
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_normal_self; cla_method_self := @cla.test_normal_self;
cla_method_self(cla, RESULT_U8BIT); cla_method_self(cla, RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -571,7 +571,7 @@ Begin
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_virtual_self; cla_method_self := @cla.test_virtual_self;
cla_method_self(cla,RESULT_U8BIT); cla_method_self(cla,RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -579,7 +579,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_virtual_self; cla_method_self := @cla.test_virtual_self;
cla_method_self(cla, RESULT_U8BIT); cla_method_self(cla, RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -587,7 +587,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -601,7 +601,10 @@ end.
{ {
$Log$ $Log$
Revision 1.3 2002-12-29 15:30:55 peter 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 * updated for 1.1 compiler that does not allow calling conventions
for constructor/destructor for constructor/destructor

37
tests/test/cg/tcalpvr8.pp
View File

@ -129,7 +129,7 @@ var
function get_object_type_method_virtual : tobjectmethod; function get_object_type_method_virtual : tobjectmethod;
begin begin
get_object_type_method_virtual := @tsimpleobject.test_virtual; get_object_type_method_virtual := @obj.test_virtual;
end; end;
function get_object_method_virtual : tobjectmethod; function get_object_method_virtual : tobjectmethod;
@ -140,7 +140,7 @@ var
{ class access } { class access }
function get_class_method_normal_self : tclassmethodself; function get_class_method_normal_self : tclassmethodself;
begin begin
get_class_method_normal_self := @tsimpleclass.test_normal_self; get_class_method_normal_self := @cla.test_normal_self;
end; end;
{ {
@ -153,23 +153,23 @@ var
function get_class_method_virtual_self : tclassmethodself; function get_class_method_virtual_self : tclassmethodself;
begin begin
get_class_method_virtual_self := @tsimpleclass.test_virtual_self; get_class_method_virtual_self := @cla.test_virtual_self;
end; end;
function get_class_method_normal : tclassmethod; function get_class_method_normal : tclassmethod;
begin begin
get_class_method_normal := @tsimpleclass.test_normal; get_class_method_normal := @cla.test_normal;
end; end;
{ {
function get_class_method_static : tclassmethod; function get_class_method_static : tclassmethod;
begin begin
get_class_method_static := @tsimpleclass.test_static; get_class_method_static := @cla.test_static;
end;} end;}
function get_class_method_virtual : tclassmethod; function get_class_method_virtual : tclassmethod;
begin begin
get_class_method_virtual := @tsimpleclass.test_virtual; get_class_method_virtual := @cla.test_virtual;
end; end;
{****************************************************************************************************} {****************************************************************************************************}
@ -435,7 +435,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
obj_method:=@tsimpleobject.test_virtual; obj_method:=@obj.test_virtual;
obj_method(RESULT_U8BIT); obj_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -461,7 +461,7 @@ Begin
clear_values; clear_values;
value_u8bit := RESULT_U8BIT; value_u8bit := RESULT_U8BIT;
obj_method:=@tsimpleobject.test_virtual; obj_method:=@obj.test_virtual;
obj_method(value_u8bit); obj_method(value_u8bit);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -528,7 +528,7 @@ Begin
failed := false; failed := false;
cla_method := @tsimpleclass.test_normal; cla_method := @cla.test_normal;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -537,7 +537,7 @@ Begin
clear_values; clear_values;
cla_method := @tsimpleclass.test_virtual; cla_method := @cla.test_virtual;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -545,7 +545,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
cla_method := @tsimpleclass.test_virtual; cla_method := @cla.test_virtual;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -553,7 +553,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -562,7 +562,7 @@ Begin
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_normal_self; cla_method_self := @cla.test_normal_self;
cla_method_self(cla, RESULT_U8BIT); cla_method_self(cla, RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -571,7 +571,7 @@ Begin
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_virtual_self; cla_method_self := @cla.test_virtual_self;
cla_method_self(cla,RESULT_U8BIT); cla_method_self(cla,RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -579,7 +579,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
cla_method_self := @tsimpleclass.test_virtual_self; cla_method_self := @cla.test_virtual_self;
cla_method_self(cla, RESULT_U8BIT); cla_method_self(cla, RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true; failed := true;
@ -587,7 +587,7 @@ Begin
clear_globals; clear_globals;
clear_values; clear_values;
{ cla_method := @tsimpleclass.test_static; { cla_method := @cla.test_static;
cla_method(RESULT_U8BIT); cla_method(RESULT_U8BIT);
if global_u8bit <> RESULT_U8BIT then if global_u8bit <> RESULT_U8BIT then
failed := true;} failed := true;}
@ -601,7 +601,10 @@ end.
{ {
$Log$ $Log$
Revision 1.3 2002-12-29 15:30:55 peter 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 * updated for 1.1 compiler that does not allow calling conventions
for constructor/destructor for constructor/destructor