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

*** empty log message ***

Browse Source
This commit is contained in:
florian 2000-02-10 23:40:37 +00:00
parent c815eeb430
commit ec8222a642
3 changed files with 437 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
tests/test/dotest.pp
View File

@ -3,7 +3,7 @@ unit dotest;
interface
{$ifdef go32v2}
uses
dpmiexcp;
dpmiexcp,lineinfo;
{$endif go32v2}
procedure do_error(l : longint);

1
tests/test/readme.txt
View File

@ -5,3 +5,4 @@ Ansistrings .................. testansi.pp
Classes ...................... testdom.pp
Exceptions ................... testexc.pp
testexc2.pp
testexc3.pp

430
tests/test/testexc3.pp
View File

@ -257,10 +257,353 @@ procedure test102;
end;
end;
{ tests continue in try...except...end; statements }
procedure test103;
var
j,k : longint;
begin
i:=0;
for j:=1 to 10 do
try
for k:=1 to 10 do
try
inc(i);
if (i mod 10)>5 then
do_raise
else
continue;
except
continue
end;
if i>50 then
do_raise
else
continue;
except
continue;
end;
end;
procedure test104;
begin
try
i:=1;
exit;
// we should never get there
do_raise;
except
i:=-1;
end;
i:=-2;
end;
procedure test105;
begin
try
i:=0;
do_raise;
// we should never get there
i:=-1;
except
inc(i);
exit;
end;
end;
procedure test106;
begin
try
try
i:=1;
exit;
// we should never get there
do_raise;
except
i:=-1;
end;
i:=-2;
except
end;
end;
procedure test107;
begin
try
do_raise;
except
try
i:=0;
do_raise;
// we should never get there
i:=-1;
except
inc(i);
exit;
end;
end;
end;
{ tests break in try...except...end; statements }
procedure test108;
begin
i:=0;
while true do
try
while true do
try
inc(i);
break;
except
end;
inc(i);
break;
except
end;
end;
procedure test109;
begin
i:=0;
while true do
try
repeat
try
do_raise;
i:=-1;
except
inc(i);
break;
end;
until false;
do_raise;
i:=-1;
except
inc(i);
break;
end;
end;
{ test the on statement }
procedure test110;
begin
try
i:=0;
do_raise;
except
on e : exception do
inc(i);
end;
end;
procedure test111;
begin
try
try
i:=0;
do_raise;
except
on e : exception do
begin
inc(i);
do_raise;
end;
end;
except
on e : exception do
inc(i);
end;
end;
procedure test112;
begin
try
try
i:=0;
do_raise;
except
on e : exception do
begin
inc(i);
raise;
end;
end;
except
on e : exception do
inc(i);
end;
end;
procedure test113;
var
j,k : longint;
begin
i:=0;
for j:=1 to 10 do
try
for k:=1 to 10 do
try
inc(i);
if (i mod 10)>5 then
do_raise
else
continue;
except
on e : exception do
continue
end;
if i>50 then
do_raise
else
continue;
except
on e : exception do
continue;
end;
end;
procedure test114;
begin
try
i:=1;
exit;
// we should never get there
do_raise;
except
on e : exception do
i:=-1;
end;
i:=-2;
end;
procedure test115;
begin
try
i:=0;
do_raise;
// we should never get there
i:=-1;
except
on e : exception do
begin
inc(i);
exit;
end;
end;
end;
procedure test116;
begin
try
try
i:=1;
exit;
// we should never get there
do_raise;
except
on e : exception do
i:=-1;
end;
i:=-2;
except
on e : exception do
;
end;
end;
procedure test117;
begin
try
do_raise;
except
try
i:=0;
do_raise;
// we should never get there
i:=-1;
except
on e : exception do
begin
inc(i);
exit;
end;
end;
end;
end;
{ tests break in try...except...end; statements }
procedure test118;
begin
i:=0;
while true do
try
while true do
try
inc(i);
break;
except
on e : exception do
;
end;
inc(i);
break;
except
on e : exception do
;
end;
end;
procedure test119;
begin
i:=0;
while true do
try
repeat
try
do_raise;
i:=-1;
except
on e : exception do
begin
inc(i);
break;
end;
end;
until false;
do_raise;
i:=-1;
except
on e : exception do
begin
inc(i);
break;
end;
end;
end;
var
startmemavail : longint;
begin
writeln('Testing exception handling');
startmemavail:=memavail;
i:=-1;
try
@ -339,6 +682,93 @@ begin
if i<>2 then
do_error(1102);
i:=-1;
test103;
if i<>100 then
do_error(1103);
i:=-1;
test104;
if i<>1 then
do_error(1104);
i:=-1;
test105;
if i<>1 then
do_error(1105);
i:=-1;
test106;
if i<>1 then
do_error(1106);
i:=-1;
test107;
if i<>1 then
do_error(1107);
i:=-1;
test108;
if i<>2 then
do_error(1108);
i:=-1;
test109;
if i<>2 then
do_error(1109);
i:=-1;
test110;
if i<>1 then
do_error(1110);
i:=-1;
test111;
if i<>2 then
do_error(1111);
i:=-1;
test112;
if i<>2 then
do_error(1112);
i:=-1;
test113;
if i<>100 then
do_error(1113);
i:=-1;
test114;
if i<>1 then
do_error(1114);
i:=-1;
test115;
if i<>1 then
do_error(1115);
i:=-1;
test116;
if i<>1 then
do_error(1116);
i:=-1;
test117;
if i<>1 then
do_error(1117);
i:=-1;
test118;
if i<>2 then
do_error(1118);
i:=-1;
test119;
if i<>2 then
do_error(1119);
if memavail<>startmemavail then
do_error(99999);
writeln('Test successfully passed');