From ed910b5d31a47e5c3cb33d7453e9dec6b6c962e5 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sat, 18 Mar 2006 22:25:41 +0000
Subject: [PATCH]   * support goto/label by default in tp/delphi/macpas modes
 (bug 4893)

git-svn-id: trunk@2958 -
---
 .gitattributes          |  5 +++++
 compiler/scanner.pas    |  9 +++++++++
 tests/webtbf/tw4893d.pp | 10 ++++++++++
 tests/webtbf/tw4893e.pp | 10 ++++++++++
 tests/webtbs/tw4893a.pp |  8 ++++++++
 tests/webtbs/tw4893b.pp |  8 ++++++++
 tests/webtbs/tw4893c.pp |  8 ++++++++
 7 files changed, 58 insertions(+)
 create mode 100644 tests/webtbf/tw4893d.pp
 create mode 100644 tests/webtbf/tw4893e.pp
 create mode 100644 tests/webtbs/tw4893a.pp
 create mode 100644 tests/webtbs/tw4893b.pp
 create mode 100644 tests/webtbs/tw4893c.pp

diff --git a/.gitattributes b/.gitattributes
index 00b24a9142..afd832cad8 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -6017,6 +6017,8 @@ tests/webtbf/tw4777.pp svneol=native#text/plain
 tests/webtbf/tw4778a.pp svneol=native#text/plain
 tests/webtbf/tw4781a.pp svneol=native#text/plain
 tests/webtbf/tw4781b.pp svneol=native#text/plain
+tests/webtbf/tw4893d.pp svneol=native#text/plain
+tests/webtbf/tw4893e.pp svneol=native#text/plain
 tests/webtbf/tw4913.pp -text
 tests/webtbf/uw0744.pp svneol=native#text/plain
 tests/webtbf/uw0840a.pp svneol=native#text/plain
@@ -6752,6 +6754,9 @@ tests/webtbs/tw4768.pp -text
 tests/webtbs/tw4778.pp svneol=native#text/plain
 tests/webtbs/tw4789.pp svneol=native#text/plain
 tests/webtbs/tw4809.pp svneol=native#text/plain
+tests/webtbs/tw4893a.pp svneol=native#text/plain
+tests/webtbs/tw4893b.pp svneol=native#text/plain
+tests/webtbs/tw4893c.pp svneol=native#text/plain
 tests/webtbs/tw4898.pp -text
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
diff --git a/compiler/scanner.pas b/compiler/scanner.pas
index 3b6df7de27..d8092af753 100644
--- a/compiler/scanner.pas
+++ b/compiler/scanner.pas
@@ -301,6 +301,15 @@ implementation
               if changeinit then
                exclude(initlocalswitches,cs_ansistrings);
             end;
+
+           { support goto/label by default in delphi/tp7/mac modes }
+           if ([m_delphi,m_tp7,m_mac] * aktmodeswitches <> []) then
+             begin
+               include(aktmoduleswitches,cs_support_goto);
+               if changeinit then
+                 include(initmoduleswitches,cs_support_goto);
+             end;
+
            { Default enum packing for delphi/tp7 }
            if (m_tp7 in aktmodeswitches) or
               (m_delphi in aktmodeswitches) then
diff --git a/tests/webtbf/tw4893d.pp b/tests/webtbf/tw4893d.pp
new file mode 100644
index 0000000000..e84544be74
--- /dev/null
+++ b/tests/webtbf/tw4893d.pp
@@ -0,0 +1,10 @@
+{ %fail }
+
+{$mode fpc}
+
+label a;
+
+begin
+  goto a;
+ a:
+end.
diff --git a/tests/webtbf/tw4893e.pp b/tests/webtbf/tw4893e.pp
new file mode 100644
index 0000000000..603f4bcbbe
--- /dev/null
+++ b/tests/webtbf/tw4893e.pp
@@ -0,0 +1,10 @@
+{ %fail }
+
+{$mode objfpc}
+
+label a;
+
+begin
+  goto a;
+ a:
+end.
diff --git a/tests/webtbs/tw4893a.pp b/tests/webtbs/tw4893a.pp
new file mode 100644
index 0000000000..46d00fd92e
--- /dev/null
+++ b/tests/webtbs/tw4893a.pp
@@ -0,0 +1,8 @@
+{$mode delphi}
+
+label a;
+
+begin
+  goto a;
+ a:
+end.
diff --git a/tests/webtbs/tw4893b.pp b/tests/webtbs/tw4893b.pp
new file mode 100644
index 0000000000..d3886aada8
--- /dev/null
+++ b/tests/webtbs/tw4893b.pp
@@ -0,0 +1,8 @@
+{$mode tp}
+
+label a;
+
+begin
+  goto a;
+ a:
+end.
diff --git a/tests/webtbs/tw4893c.pp b/tests/webtbs/tw4893c.pp
new file mode 100644
index 0000000000..8bd8eec688
--- /dev/null
+++ b/tests/webtbs/tw4893c.pp
@@ -0,0 +1,8 @@
+{$mode macpas}
+
+label a;
+
+begin
+  goto a;
+ a:
+end.