paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 18:49:16 +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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
tests/test/tclass1.pp
View File

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

33
tests/test/tclass2.pp
View File

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