paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 17:49:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* small update

Browse Source
This commit is contained in:
florian 1999-11-29 22:55:25 +00:00
parent 7e458d9519
commit 55bb8c7de7
1 changed files with 30 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
tests/testpvar.pp
View File

@ -38,8 +38,19 @@ procedure callmethodparam(s : pointer;addr : pointer;param : longint);
type type
to1 = object to1 = object
constructor init;
procedure test1; procedure test1;
procedure test2(l : longint); procedure test2(l : longint);
procedure test3(l : longint);virtual;abstract;
end;
to2 = object(to1)
procedure test3(l : longint);virtual;
end;
constructor to1.init;
begin
end; end;
procedure to1.test1; procedure to1.test1;
@ -62,17 +73,26 @@ type
globalvar:=l; globalvar:=l;
end; end;
procedure to2.test3(l : longint);
begin
globalvar:=l;
end;
const const
constmethodaddr : pointer = @to1.test2; constmethodaddr : pointer = @to1.test2;
var var
o1 : to1; o1 : to1;
o2 : to2;
p : procedure(l : longint) of object; p : procedure(l : longint) of object;
begin begin
{ } { }
{ Procedures of objects } { Procedures of objects }
{ } { }
o1.init;
o2.init;
writeln('Procedures of objects'); writeln('Procedures of objects');
p:=@o1.test2; p:=@o1.test2;
globalvar:=0; globalvar:=0;
@ -80,6 +100,12 @@ begin
if globalvar<>12 then if globalvar<>12 then
do_error(1002); do_error(1002);
writeln('Ok'); writeln('Ok');
p:=@o2.test3;
globalvar:=0;
p(12);
if globalvar<>12 then
do_error(1004);
writeln('Ok');
{ } { }
{ Pointers and addresses of procedures } { Pointers and addresses of procedures }
{ } { }
@ -93,7 +119,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.1 1999-09-11 19:45:33 florian Revision 1.2 1999-11-29 22:55:25 florian
* small update
Revision 1.1 1999/09/11 19:45:33 florian
* first version, please keep it up-to-date * first version, please keep it up-to-date
} }