浏览代码

- remove could which prevented that rte is triggered even if we are inside
an exception block but *without* using sysutils. The remove code
was once added to have primitive exception handling even if
no sysutils is used. But if this is desired, an appropriate handler
to ErrorProc should be assigned. Resolves #38201

git-svn-id: trunk@47775 -

florian 4 年之前
父节点
当前提交
2e2f2eb784
共有 3 个文件被更改,包括 24 次插入4 次删除
  1. 1 0
      .gitattributes
  2. 0 4
      rtl/inc/system.inc
  3. 23 0
      tests/webtbs/tw38201.pp

+ 1 - 0
.gitattributes

@@ -18605,6 +18605,7 @@ tests/webtbs/tw3814.pp svneol=native#text/plain
 tests/webtbs/tw38145a.pp svneol=native#text/pascal
 tests/webtbs/tw38145b.pp svneol=native#text/pascal
 tests/webtbs/tw38151.pp svneol=native#text/pascal
+tests/webtbs/tw38201.pp svneol=native#text/pascal
 tests/webtbs/tw38202.pp svneol=native#text/pascal
 tests/webtbs/tw3827.pp svneol=native#text/plain
 tests/webtbs/tw3829.pp svneol=native#text/plain

+ 0 - 4
rtl/inc/system.inc

@@ -1327,10 +1327,6 @@ begin
   errorcode:=word(Errno);
   erroraddr:=addr;
   errorbase:=frame;
-{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
-  if ExceptAddrStack <> nil then
-    raise TObject(nil) at addr,frame;
-{$endif FPC_HAS_FEATURE_EXCEPTIONS}
   Halt(errorcode);
 end;
 

+ 23 - 0
tests/webtbs/tw38201.pp

@@ -0,0 +1,23 @@
+{ %result=201 }
+program Test;
+{$apptype console}
+{$ifdef fpc}
+{$mode objfpc}
+{$endif fpc}
+{$R+}
+
+var
+  Arr: array[1..2] of integer;
+  i: Integer;
+begin
+  i:=5;
+  try
+    try
+      Arr[i] := 1;
+    except
+      writeln('Except block');
+    end;
+  finally
+    writeln('Finally block');
+  end;
+end.