Kaynağa Gözat

- 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 yıl önce
ebeveyn
işleme
2e2f2eb784
3 değiştirilmiş dosya ile 24 ekleme ve 4 silme
  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.