From e1536bdf263191e2fc14c458ad0c8ffaa9c052eb Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Sun, 27 Sep 2020 16:53:59 +0000
Subject: [PATCH]   * 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          |  1 +
 compiler/nflw.pas       |  3 ++-
 tests/webtbs/tw37823.pp | 21 +++++++++++++++++++++
 3 files changed, 24 insertions(+), 1 deletion(-)
 create mode 100644 tests/webtbs/tw37823.pp

diff --git a/.gitattributes b/.gitattributes
index da06653cd3..22f1115119 100644
--- a/.gitattributes
+++ b/.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
diff --git a/compiler/nflw.pas b/compiler/nflw.pas
index ad8ea8f1f9..210de18b5f 100644
--- a/compiler/nflw.pas
+++ b/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;
diff --git a/tests/webtbs/tw37823.pp b/tests/webtbs/tw37823.pp
new file mode 100644
index 0000000000..180f9dcd12
--- /dev/null
+++ b/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.