Quellcode durchsuchen

- 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 vor 4 Jahren
Ursprung
Commit
2e2f2eb784
3 geänderte Dateien mit 24 neuen und 4 gelöschten Zeilen
  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.