paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-21 04:39:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ test for fail

Browse Source
This commit is contained in:
pierre 1999-08-19 13:56:34 +00:00
parent 82999520e4
commit 588efe2ed1
1 changed files with 90 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
tests/testfail.pp Normal file
View File

@ -0,0 +1,90 @@
{$R+}
program test_fail;
type
parrayobj = ^tarrayobj;
tarrayobj = object
ar : array [1..4] of real;
constructor init(do_fail : boolean);
procedure test;virtual;
destructor done;virtual;
end;
pbigarrayobj = ^tbigarrayobj;
tbigarrayobj = object(tarrayobj)
ar2 : array [1..10000] of real;
constructor good_init;
constructor wrong_init;
procedure test;virtual;
end;
var
pa1, pa2 : parrayobj;
ta1, ta2 : tarrayobj;
availmem : longint;
constructor tarrayobj.init(do_fail : boolean);
begin
ar[1]:=1;
if do_fail then
fail;
ar[2]:=2;
end;
destructor tarrayobj.done;
begin
end;
procedure tarrayobj.test;
begin
Writeln('@self = ',longint(@self));
Writeln('typeof = ',longint(typeof(self)));
if ar[1]=1 then
Writeln('Init called');
if ar[2]=2 then
Writeln('Init successful');
end;
constructor tbigarrayobj.good_init;
begin
inherited init(false);
Writeln('End of tbigarrayobj.good_init');
end;
constructor tbigarrayobj.wrong_init;
begin
inherited init(true);
Writeln('End of tbigarrayobj.wrong_init');
end;
procedure tbigarrayobj.test;
begin
Writeln('tbigarrayobj.test called');
Inherited test;
end;
begin
availmem:=memavail;
new(pa1,init(false));
writeln('After successful new(pa1,init), memory used = ',availmem - memavail);
new(pa2,init(true));
writeln('After unsuccessful new(pa2,init), memory used = ',availmem - memavail);
writeln('pa1 = ',longint(pa1),' pa2 = ',longint(pa2));
writeln('Call to pa1^.test after successful init');
pa1^.test;
dispose(pa1,done);
writeln('After release of pa1, memory used = ',availmem - memavail);
pa1:=new(pbigarrayobj,good_init);
writeln('After successful pa1:=new(pbigarrayobj,good_init), memory used = ',availmem - memavail);
pa2:=new(pbigarrayobj,wrong_init);
writeln('After unsuccessful pa2:=new(pbigarrayobj,wrong_init), memory used = ',availmem - memavail);
writeln('pa1 = ',longint(pa1),' pa2 = ',longint(pa2));
writeln('Call to pa1^.test after successful init');
pa1^.test;
ta1.init(false);
writeln('Call to ta1.test after successful init');
ta1.test;
ta2.init(true);
writeln('typeof(ta2) = ',longint(typeof(ta2)),' after unsuccessful init');
Writeln('Trying to call ta2.test (should generate a Run Time Error)');
ta2.test;
end.