From 050627ea1da17ddaaec3f0668a735670413475e6 Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Thu, 17 Jul 2008 19:49:38 +0000
Subject: [PATCH] * allow goto inside finally blocks

git-svn-id: trunk@11392 -
---
 .gitattributes      |  2 ++
 compiler/ncgflw.pas |  4 +++-
 tests/tbf/tb0209.pp | 18 ++++++++++++++++++
 tests/tbs/tb0553.pp | 17 +++++++++++++++++
 4 files changed, 40 insertions(+), 1 deletion(-)
 create mode 100644 tests/tbf/tb0209.pp
 create mode 100644 tests/tbs/tb0553.pp

diff --git a/.gitattributes b/.gitattributes
index e93ed1edfd..10be9d5856 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -6437,6 +6437,7 @@ tests/tbf/tb0205.pp svneol=native#text/plain
 tests/tbf/tb0206.pp svneol=native#text/plain
 tests/tbf/tb0207.pp svneol=native#text/plain
 tests/tbf/tb0208.pp svneol=native#text/plain
+tests/tbf/tb0209.pp svneol=native#text/plain
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain
@@ -6986,6 +6987,7 @@ tests/tbs/tb0550a.pp svneol=native#text/plain
 tests/tbs/tb0550b.pp svneol=native#text/plain
 tests/tbs/tb0551.pp svneol=native#text/plain
 tests/tbs/tb0552.pp svneol=native#text/plain
+tests/tbs/tb0553.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
diff --git a/compiler/ncgflw.pas b/compiler/ncgflw.pas
index 8ab1b91b90..59251b3a92 100644
--- a/compiler/ncgflw.pas
+++ b/compiler/ncgflw.pas
@@ -1501,7 +1501,9 @@ implementation
          { finally code }
          flowcontrol:=[fc_inflowcontrol];
          secondpass(right);
-         if flowcontrol<>[fc_inflowcontrol] then
+         { goto is allowed if it stays inside the finally block,
+           this is checked using the exception block number }
+         if (flowcontrol-[fc_gotolabel])<>[fc_inflowcontrol] then
            CGMessage(cg_e_control_flow_outside_finally);
          if codegenerror then
            exit;
diff --git a/tests/tbf/tb0209.pp b/tests/tbf/tb0209.pp
new file mode 100644
index 0000000000..38715db379
--- /dev/null
+++ b/tests/tbf/tb0209.pp
@@ -0,0 +1,18 @@
+{ %fail }
+{$mode objfpc}
+{$goto on}
+var
+  a : longint;
+label
+  g;
+
+begin
+  try
+    a:=2;
+  finally
+    if a>1 then
+      goto g;
+    writeln('Error');
+  end;
+  g:
+end.
diff --git a/tests/tbs/tb0553.pp b/tests/tbs/tb0553.pp
new file mode 100644
index 0000000000..45d6020d28
--- /dev/null
+++ b/tests/tbs/tb0553.pp
@@ -0,0 +1,17 @@
+{$mode objfpc}
+{$goto on}
+var
+  a : longint;
+label
+  g;
+
+begin
+  try
+    a:=2;
+  finally
+    if a>1 then
+      goto g;
+    writeln('Error');
+    g:
+  end;
+end.