Browse Source

* check that an infinite recursion generates RTE 202 or at least 216

pierre 22 years ago
parent
commit
6f2a3683f8
1 changed files with 60 additions and 0 deletions
  1. 60 0
      tests/test/tstack.pp

+ 60 - 0
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.