mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-27 12:50:30 +02:00
* check that an infinite recursion generates RTE 202 or at least 216
This commit is contained in:
parent
87fb801dcb
commit
6f2a3683f8
60
tests/test/tstack.pp
Normal file
60
tests/test/tstack.pp
Normal file
@ -0,0 +1,60 @@
|
|||||||
|
{$S+}
|
||||||
|
|
||||||
|
{ Program to check that an infinite recursion
|
||||||
|
does generate a RTE ... }
|
||||||
|
|
||||||
|
{$R-}
|
||||||
|
{ make that recursion really infinite
|
||||||
|
needs that range check is disabled }
|
||||||
|
|
||||||
|
const
|
||||||
|
level : longint = 0;
|
||||||
|
|
||||||
|
function inf_rec(x : longint) : longint;
|
||||||
|
|
||||||
|
begin
|
||||||
|
inc(level);
|
||||||
|
inf_rec:=x+inf_rec(x-1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
saveexit : pointer = nil;
|
||||||
|
x : longint = 0;
|
||||||
|
|
||||||
|
procedure stack_check_exit;
|
||||||
|
|
||||||
|
begin
|
||||||
|
exitproc:=saveexit;
|
||||||
|
if errorcode<>0 then
|
||||||
|
begin
|
||||||
|
Writeln('An error occured at level ',level);
|
||||||
|
if errorcode=202 then
|
||||||
|
begin
|
||||||
|
Writeln('Stack overflow correctly handled');
|
||||||
|
erroraddr:=nil;
|
||||||
|
errorcode:=0;
|
||||||
|
exitcode:=0;
|
||||||
|
end
|
||||||
|
else if errorcode=216 then
|
||||||
|
begin
|
||||||
|
Writeln('RTL returns an RTE 216 on stack overflow');
|
||||||
|
Writeln('Not perfect, but acceptable');
|
||||||
|
erroraddr:=nil;
|
||||||
|
errorcode:=0;
|
||||||
|
exitcode:=0;
|
||||||
|
end;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
exitcode:=1;
|
||||||
|
errorcode:=1;
|
||||||
|
end;
|
||||||
|
exitproc:=saveexit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
saveexit:=exitproc;
|
||||||
|
exitproc:=@stack_check_exit;
|
||||||
|
x:=inf_rec(5000);
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user