paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-23 20:49:43 +02:00
Code Issues Packages Projects Releases Wiki Activity

* extended the tests with inherited call

Browse Source
This commit is contained in:
peter 2003-03-30 21:00:19 +00:00
parent 4a0b87ac59
commit a78099a64f
2 changed files with 61 additions and 4 deletions

32
tests/test/tclass1.pp
View File

@ -7,33 +7,61 @@ type
procedure afterconstruction;override;
end;
to2 = class(to1)
constructor create;
procedure afterconstruction;override;
end;
var
i : longint;
constructor to1.create;
begin
writeln('to1.create');
inherited create;
if i<>1000 then
halt(1);
i:=2000;
end;
constructor to2.create;
begin
writeln('to2.create');
if i<>3000 then
halt(1);
i:=1000;
inherited create;
i:=4000;
end;
procedure to1.afterconstruction;
begin
writeln('to1.afterconstruction');
if i<>2000 then
halt(1);
i:=3000;
end;
procedure to2.afterconstruction;
begin
writeln('to2.afterconstruction');
if i<>4000 then
halt(1);
i:=5000;
end;
var
o1 : to1;
o2 : to2;
begin
i:=1000;
o1:=to1.create;
if i<>3000 then
o2:=to2.create;
if i<>5000 then
halt(1);
o1.destroy;
writeln('ok');

33
tests/test/tclass2.pp
View File

@ -7,12 +7,18 @@ type
procedure beforedestruction;override;
end;
to2 = class(to1)
destructor destroy;override;
procedure beforedestruction;override;
end;
var
i : longint;
destructor to1.destroy;
begin
writeln('to1.destroy');
if i<>2000 then
halt(1);
i:=3000;
@ -22,19 +28,42 @@ var
procedure to1.beforedestruction;
begin
writeln('to1.beforedestruction');
if i<>1000 then
halt(1);
i:=2000;
end;
destructor to2.destroy;
begin
writeln('to2.destroy');
if i<>4000 then
halt(1);
i:=1000;
inherited destroy;
i:=5000;
end;
procedure to2.beforedestruction;
begin
writeln('to2.beforedestruction');
if i<>3000 then
halt(1);
i:=4000;
end;
var
o1 : to1;
o2 : to2;
begin
o1:=to1.create;
o2:=to2.create;
i:=1000;
o1.destroy;
if i<>3000 then
o2.destroy;
if i<>5000 then
halt(1);
writeln('ok');
end.