mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 00:42:06 +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