* when implicit try...finallys are turned off, do not throw an error if a procedure

is left which would need but does not have an implicit try...finally block, resolves #37823

git-svn-id: trunk@46974 -

.gitattributes

@@ -18479,6 +18479,7 @@ tests/webtbs/tw37796.pp svneol=native#text/pascal
 tests/webtbs/tw3780.pp svneol=native#text/plain
 tests/webtbs/tw37806.pp svneol=native#text/pascal
 tests/webtbs/tw3782.pp svneol=native#text/plain
+tests/webtbs/tw37823.pp svneol=native#text/pascal
 tests/webtbs/tw3796.pp svneol=native#text/plain
 tests/webtbs/tw3805.pp svneol=native#text/plain
 tests/webtbs/tw3814.pp svneol=native#text/plain

compiler/nflw.pas

@@ -2193,7 +2193,8 @@ implementation
                     p2:=current_procinfo;
                     while true do
                       begin
-                        if (p2.flags*[pi_needs_implicit_finally,pi_uses_exceptions,pi_has_implicit_finally])<>[] then
+                        if ((cs_implicit_exceptions in current_settings.moduleswitches) and ((p2.flags*[pi_needs_implicit_finally,pi_has_implicit_finally])<>[])) or
+                        ((p2.flags*[pi_uses_exceptions])<>[]) then
                           Message(cg_e_goto_across_procedures_with_exceptions_not_allowed);
                         if labelsym.owner=p2.procdef.localst then
                           break;

tests/webtbs/tw37823.pp

@@ -0,0 +1,21 @@
+{$MODE ISO}
+{$implicitExceptions off}
+{$Q+}
+{$R+}
+program gt;
+  label 1;
+  procedure jump;
+  var
+    a: integer;
+    b: rawbytestring;
+  begin
+    b := 'nanu';
+    writeln('nanu');
+    goto 1;
+  end;
+begin
+  jump;
+  writeln('not jumped!');
+1:
+writeln('jumped!');
+end.