This commit fixes the support for having an access clause as the
controlled clause of another access clause.

Signed-off-by: Jose E. Marchesi <[email protected]>

gcc/algol68/ChangeLog

        * a68-parser-top-down.cc (top_down_access): An access clause may
        be nested in another access clause.
        * a68-parser-extract.cc (a68_extract_indicants): Coalesce 'pub'
        symbols.
        (a68_extract_indicants): Nested access are not allowed in module
        texts.
        * a68-parser-bottom-up.cc (expected_module_text): New function.
        (reduce_prelude_packet): Use expected_module_text.
        (a68_bottom_up_error_check): Add comment.

gcc/testsuite/ChangeLog

        * algol68/compile/error-module-nested-access-1.a68: New test.
        * algol68/execute/modules/program-21.a68: Likewise.
---
 gcc/algol68/a68-parser-bottom-up.cc           | 14 ++++++-
 gcc/algol68/a68-parser-extract.cc             | 40 +++++++++++++------
 gcc/algol68/a68-parser-top-down.cc            |  9 ++++-
 .../compile/error-module-nested-access-1.a68  |  6 +++
 .../algol68/execute/modules/program-21.a68    |  5 +++
 5 files changed, 58 insertions(+), 16 deletions(-)
 create mode 100644 
gcc/testsuite/algol68/compile/error-module-nested-access-1.a68
 create mode 100644 gcc/testsuite/algol68/execute/modules/program-21.a68

diff --git a/gcc/algol68/a68-parser-bottom-up.cc 
b/gcc/algol68/a68-parser-bottom-up.cc
index 2bbdbaec30e..c9a17246aa7 100644
--- a/gcc/algol68/a68-parser-bottom-up.cc
+++ b/gcc/algol68/a68-parser-bottom-up.cc
@@ -201,6 +201,14 @@ empty_clause (NODE_T *p)
   a68_error (p, "clause does not yield a value");
 }
 
+/* Diagnose for invalid module text.  */
+
+static void
+expected_module_text (NODE_T *p)
+{
+  a68_error (p, "expected module text in module definition");
+}
+
 /* Diagnose for missing symbol.  */
 
 static void
@@ -453,7 +461,7 @@ reduce_prelude_packet (NODE_T *p)
   /* Single module declaration.  */
   reduce (p, NO_NOTE, NO_TICK,
          MODULE_DECLARATION, MODULE_SYMBOL, DEFINING_MODULE_INDICANT, 
EQUALS_SYMBOL, MODULE_TEXT, STOP);
-  reduce (p, strange_tokens, NO_TICK,
+  reduce (p, expected_module_text, NO_TICK,
          MODULE_DECLARATION, MODULE_SYMBOL, DEFINING_MODULE_INDICANT, 
EQUALS_SYMBOL, -MODULE_TEXT, STOP);
 
 #if 0
@@ -2881,7 +2889,9 @@ a68_bottom_up_error_check (NODE_T *p)
        }
       else if (IS (p, PUBLIC_SYMBOL))
        {
-         /* These should have been removed by a68_bottom_up_coalesce_pub.  */
+         /* These should have been removed by a68_bottom_up_coalesce_pub and
+            by a68_extract_indicants.  */
+         /* XXX get rid of this.  */
          gcc_unreachable ();
        }
       else if (a68_is_one_of (p, DEFINING_INDICANT, DEFINING_IDENTIFIER, 
DEFINING_OPERATOR, STOP))
diff --git a/gcc/algol68/a68-parser-extract.cc 
b/gcc/algol68/a68-parser-extract.cc
index 06f18975536..ec43dc1719c 100644
--- a/gcc/algol68/a68-parser-extract.cc
+++ b/gcc/algol68/a68-parser-extract.cc
@@ -343,17 +343,24 @@ a68_extract_indicants (NODE_T *p)
          do
            {
              FORWARD (q);
-             detect_redefined_keyword (q, MODE_DECLARATION);
-             if (IS (q, BOLD_TAG))
+             if (q != NO_NODE)
                {
-                 extract_revelation (q, false /* is_public */);
-                 FORWARD (q);
-               }
-             else if (a68_whether (q, PUBLIC_SYMBOL, BOLD_TAG, STOP))
-               {
-                 extract_revelation (q, true /* is_public */);
-                 FORWARD (q);
-                 FORWARD (q);
+                 detect_redefined_keyword (q, MODULE_DECLARATION);
+                 if (IS (q, BOLD_TAG))
+                   {
+                     extract_revelation (q, false /* is_public */);
+                     FORWARD (q);
+                   }
+                 else if (a68_whether (q, PUBLIC_SYMBOL, BOLD_TAG, STOP))
+                   {
+                     NODE_T *pub_node = q;
+                     extract_revelation (NEXT (pub_node), true /* is_public 
*/);
+                     /* XXX get rid of this crap.  */
+                     PREVIOUS (NEXT (pub_node)) = PREVIOUS (pub_node);
+                     if (PREVIOUS (pub_node) != NO_NODE)
+                       NEXT (PREVIOUS (pub_node)) = NEXT (pub_node);
+                     FORWARD (q);
+                   }
                }
            }
          while (q != NO_NODE && IS (q, COMMA_SYMBOL));
@@ -377,8 +384,17 @@ a68_extract_indicants (NODE_T *p)
                  EXPORTED (tag) = true;
                  FORWARD (q);
                  ATTRIBUTE (q) = EQUALS_SYMBOL; /* XXX why not 
ALT_EQUALS_SYMBOL */
-                 q = skip_module_text (NEXT (q));
-                 FORWARD (q);
+                 if (NEXT (q) != NO_NODE && IS (NEXT (q), ACCESS_SYMBOL))
+                   {
+                     a68_error (NEXT (q),
+                                "nested access clauses not allowed in module 
texts");
+                     siga = false;
+                   }
+                 else
+                   {
+                     q = skip_module_text (NEXT (q));
+                     FORWARD (q);
+                   }
                }
              else
                siga = false;
diff --git a/gcc/algol68/a68-parser-top-down.cc 
b/gcc/algol68/a68-parser-top-down.cc
index 79100a0a4af..e4a3bf8c854 100644
--- a/gcc/algol68/a68-parser-top-down.cc
+++ b/gcc/algol68/a68-parser-top-down.cc
@@ -495,9 +495,9 @@ top_down_def (NODE_T *def_p)
 
 /* Make branch of
 
-   ACCESS REVELATION [DEF_SYMBOL]
+   ACCESS REVELATIONS [DEF_SYMBOL]
    or
-   ACCESS REVELATION ENCLOSED_CLAUSE.   */
+   ACCESS REVELATIONS ENCLOSED_CLAUSE.   */
 
 static void
 top_down_access (NODE_T *p)
@@ -530,6 +530,11 @@ top_down_access (NODE_T *p)
                  a68_make_sub (q, end_p, ALT_ACCESS_SYMBOL);
                }
            }
+         else if (IS (end_p, ACCESS_SYMBOL))
+           {
+             top_down_access (end_p);
+             a68_make_sub (q, end_p, ACCESS_SYMBOL);
+           }
          else
            a68_make_sub (q, end_p, ACCESS_SYMBOL);
        }
diff --git a/gcc/testsuite/algol68/compile/error-module-nested-access-1.a68 
b/gcc/testsuite/algol68/compile/error-module-nested-access-1.a68
new file mode 100644
index 00000000000..97b5566592e
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/error-module-nested-access-1.a68
@@ -0,0 +1,6 @@
+module Foo = { dg-error "expected module text" }
+          access Bar access Baz access Quux { dg-error "nested" }
+def
+    pub int bar = foo + baz;
+    skip
+fed
diff --git a/gcc/testsuite/algol68/execute/modules/program-21.a68 
b/gcc/testsuite/algol68/execute/modules/program-21.a68
new file mode 100644
index 00000000000..e99a72ed944
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/modules/program-21.a68
@@ -0,0 +1,5 @@
+{ dg-modules "module-foo module-bar" }
+{ dg-options 
"-fmodules-map-file=$srcdir/algol68/execute/modules/Modules20.map" }
+
+access Foo
+  access Bar (assert (foo = 10); assert (bar = 20))
-- 
2.30.2

Reply via email to