Browse Source

new test for bug #1152

pierre 25 years ago
parent
commit
522544200b
1 changed files with 39 additions and 0 deletions
  1. 39 0
      tests/webtbs/tbug1152.pp

+ 39 - 0
tests/webtbs/tbug1152.pp

@@ -0,0 +1,39 @@
+{ Source provided for Free Pascal Bug Report 1152 }
+{ Submitted by "Dirk Verwiebe" on  2000-09-30 }
+{ e-mail: [email protected] }
+
+{$mode objfpc}
+
+program exception;
+uses sysutils,crt;
+var
+  saveexit : pointer;
+  finally_called : boolean;
+
+procedure my_exit;
+  begin
+    exitproc:=saveexit;
+    if not finally_called then
+      begin
+        Writeln('Problem with exception handling if crt unit is used');
+        RunError(1);
+      end
+    else
+      begin
+        Writeln('Exception handling works');
+        exitcode:=0;
+      end;
+  end;
+
+
+BEGIN
+  saveexit:=exitproc;
+  exitproc:=@my_exit;
+  finally_called:=false;
+try
+  mem[$ffffffff]:=0;
+finally
+  finally_called:=true;
+  writeln('Error !!!');
+end;
+END.