diff --git a/tests/test/tstack.pp b/tests/test/tstack.pp new file mode 100644 index 0000000000..da7e23fe07 --- /dev/null +++ b/tests/test/tstack.pp @@ -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.