a68: allow joined list of revelations in access clauses

This commit adds support for having a joined list of revelations in
access clauses, like in:

  access Module18a,
         Module18b,
         Module18c
  begin assert (foo = 10);
        assert (bar = 20);
        assert (baz = 30)
  end

Signed-off-by: Jose E. Marchesi <jemarch@gnu.org>
gcc/algol68/ChangeLog

	* a68-parser-bottom-up.cc (reduce_enclosed_clauses): Reduce joined
	list of revelations.
	* a68-low-clauses.cc (a68_lower_revelation_ludes): New function.
	(a68_lower_access_clause): Use a68_lower_revelation_ludes.

gcc/testsuite/ChangeLog

	* algol68/compile/modules/module10.a68: New test.
	* algol68/execute/modules/program-18.a68: Likewise.
	* algol68/execute/modules/module18c.a68: Likewise.
	* algol68/execute/modules/module18b.a68: Likewise.
	* algol68/execute/modules/module18a.a68: Likewise.
	* algol68/compile/modules/program-11.a68: Likewise.
	* algol68/compile/modules/program-10.a68: Likewise.
	* algol68/compile/modules/module12.a68: Likewise.
	* algol68/compile/modules/module11.a68: Likewise.

diff --git a/gcc/algol68/a68-low-clauses.cc b/gcc/algol68/a68-low-clauses.cc
index d36b4cc282ac1da9b239ff089c7e83a73205e8da..20ab22929bc084fa857a2c54db78311f936480bd 100644 (file)
--- a/gcc/algol68/a68-low-clauses.cc
+++ b/gcc/algol68/a68-low-clauses.cc
@@ -1389,42 +1389,54 @@ a68_lower_closed_clause (NODE_T *p, LOW_CTX_T ctx)
   return a68_pop_serial_clause_range ();
 }
 
+/* Lower calls to preludes or postludes for all revelations in subtree.  */
+
+static void
+a68_lower_revelation_ludes (NODE_T *p, bool prelude)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, MODULE_INDICANT))
+       {
+         TAG_T *tag = a68_find_tag_global (TABLE (p), MODULE_SYMBOL, NSYMBOL (p));
+         gcc_assert (tag != NO_TAG);
+         MOIF_T *moif = MOIF (tag);
+         gcc_assert (moif != NO_MOIF);
+         const char *fname = (prelude ? PRELUDE (moif) : POSTLUDE (moif));
+
+         tree fdecl = build_decl (UNKNOWN_LOCATION, FUNCTION_DECL,
+                                  get_identifier (fname),
+                                  build_function_type_list (void_type_node,
+                                                            void_type_node,
+                                                            NULL_TREE));
+         DECL_EXTERNAL (fdecl) = 1;
+         TREE_PUBLIC (fdecl) = 1;
+         a68_add_decl (fdecl);
+         a68_add_stmt (build_call_expr_loc (a68_get_node_location (p),
+                                            fdecl, 0));
+
+       }
+      else
+       a68_lower_revelation_ludes (SUB (p), prelude);
+    }
+}
+
 /* Lower an access clause.
 
-     access clause : access symbol, joined module indication sequence,
-                       enclosed clause.
+     access clause : access symbol, access revelation, enclosed clause.
+     access revelation : access symbol, module indicant ;
+                         access revelation, comma symbol, module indicant.
 */
 
 tree
 a68_lower_access_clause (NODE_T *p, LOW_CTX_T ctx)
 {
-  NODE_T *controlled_clause = NEXT (NEXT_SUB (p));
+  NODE_T *controlled_clause = NEXT_SUB (p);
 
   a68_push_range (MOID (p));
 
   /* Call preludes of all ACCESSed modules.  */
-  for (NODE_T *q = SUB (p); q != NO_NODE; FORWARD (q))
-    {
-      if (IS (q, MODULE_INDICANT))
-       {
-         TAG_T *tag = a68_find_tag_global (TABLE (q), MODULE_SYMBOL, NSYMBOL (q));
-         gcc_assert (tag != NO_TAG);
-         MOIF_T *moif = MOIF (tag);
-         gcc_assert (moif != NO_MOIF);
-         const char *prelude = PRELUDE (moif);
-
-         tree prelude_decl = build_decl (UNKNOWN_LOCATION, FUNCTION_DECL,
-                                         get_identifier (prelude),
-                                         build_function_type_list (void_type_node,
-                                                                   void_type_node,
-                                                                   NULL_TREE));
-         DECL_EXTERNAL (prelude_decl) = 1;
-         TREE_PUBLIC (prelude_decl) = 1;
-         a68_add_decl (prelude_decl);
-         a68_add_stmt (build_call_expr_loc (a68_get_node_location (q),
-                                            prelude_decl, 0));
-       }
-    }
+  a68_lower_revelation_ludes (SUB (p), true /* prelude */);
 
   /* Now the controlled clause.  */
   tree controlled_clause_tree = a68_lower_tree (controlled_clause, ctx);
@@ -1433,29 +1445,7 @@ a68_lower_access_clause (NODE_T *p, LOW_CTX_T ctx)
                               controlled_clause_tree);
 
   /* Call postludes of all ACCESSed modules.  */
-  for (NODE_T *q = SUB (p); q != NO_NODE; FORWARD (q))
-    {
-      if (IS (q, MODULE_INDICANT))
-       {
-         TAG_T *tag = a68_find_tag_global (TABLE (q), MODULE_SYMBOL, NSYMBOL (q));
-         gcc_assert (tag != NO_TAG);
-         MOIF_T *moif = MOIF (tag);
-         gcc_assert (moif != NO_MOIF);
-         const char *postlude = POSTLUDE (moif);
-
-         tree postlude_decl = build_decl (UNKNOWN_LOCATION, FUNCTION_DECL,
-                                          get_identifier (postlude),
-                                          build_function_type_list (void_type_node,
-                                                                    void_type_node,
-                                                                    NULL_TREE));
-         DECL_EXTERNAL (postlude_decl) = 1;
-         TREE_PUBLIC (postlude_decl) = 1;
-         a68_add_decl (postlude_decl);
-         a68_add_stmt (build_call_expr_loc (a68_get_node_location (q),
-                                            postlude_decl, 0));
-       }
-    }
-
+  a68_lower_revelation_ludes (SUB (p), false /* prelude */);
   a68_add_stmt (tmp);
   return a68_pop_range ();
 }

diff --git a/gcc/algol68/a68-parser-bottom-up.cc b/gcc/algol68/a68-parser-bottom-up.cc
index c9a17246aa77f6e4b5ee19b40c06f43ef2be2eb9..6b35fef43871c355557157478e34722ec05014e0 100644 (file)
--- a/gcc/algol68/a68-parser-bottom-up.cc
+++ b/gcc/algol68/a68-parser-bottom-up.cc
@@ -2553,9 +2553,22 @@ reduce_enclosed_clauses (NODE_T *q, enum a68_attribute expect)
              reduce (s, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, LOOP_CLAUSE, STOP);
              reduce (s, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, ACCESS_CLAUSE, STOP);
            }
-         // XXX reduce revelations
+
+         /* Reduce revelations.  */
+
+         reduce (p, NO_NOTE, NO_TICK,
+                 REVELATION, ACCESS_SYMBOL, MODULE_INDICANT, STOP);
+
+         bool siga;
+         do
+           {
+             siga = false;
+             reduce (p, NO_NOTE, &siga,
+                     REVELATION, REVELATION, COMMA_SYMBOL, MODULE_INDICANT, STOP);
+           }
+         while (siga);
          reduce (p, NO_NOTE, NO_TICK,
-                 ACCESS_CLAUSE, ACCESS_SYMBOL, MODULE_INDICANT, ENCLOSED_CLAUSE, STOP);
+                 ACCESS_CLAUSE, REVELATION, ENCLOSED_CLAUSE, STOP);
        }
       else if (IS (p, IF_SYMBOL))
        {

diff --git a/gcc/testsuite/algol68/compile/modules/module10.a68 b/gcc/testsuite/algol68/compile/modules/module10.a68
new file mode 100644 (file)
index 0000000..70546a0
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/modules/module10.a68
@@ -0,0 +1 @@
+module Module_10 = def pub int foo = 10; skip fed

diff --git a/gcc/testsuite/algol68/compile/modules/module11.a68 b/gcc/testsuite/algol68/compile/modules/module11.a68
new file mode 100644 (file)
index 0000000..a871db2
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/modules/module11.a68
@@ -0,0 +1,5 @@
+module Module_11 = access pub Module_10
+def
+    pub int bar = foo + 10;
+    skip
+fed

diff --git a/gcc/testsuite/algol68/compile/modules/module12.a68 b/gcc/testsuite/algol68/compile/modules/module12.a68
new file mode 100644 (file)
index 0000000..7335f25
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/modules/module12.a68
@@ -0,0 +1 @@
+module Module12 = def int baz = 30; skip fed

diff --git a/gcc/testsuite/algol68/compile/modules/program-10.a68 b/gcc/testsuite/algol68/compile/modules/program-10.a68
new file mode 100644 (file)
index 0000000..f0de0f9
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/modules/program-10.a68
@@ -0,0 +1,8 @@
+{ dg-modules "module10 module11 module12" }
+
+access Module10,
+       NonExistantModule, { dg-error "" }
+       Module12
+begin assert (foo = 10);
+      assert (bar = 20)
+end

diff --git a/gcc/testsuite/algol68/compile/modules/program-11.a68 b/gcc/testsuite/algol68/compile/modules/program-11.a68
new file mode 100644 (file)
index 0000000..9da676d
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/modules/program-11.a68
@@ -0,0 +1,12 @@
+{ dg-modules "module10 module11 module12" }
+
+{ Check that mode checking and coercion is performed
+  inside controlled clauses in access clauses with
+  several revelations.  }
+
+access Module10,
+       Module11,
+       Module12
+begin assert (foo = 10);
+      assert (bar = "foo") { dg-error "" }
+end

diff --git a/gcc/testsuite/algol68/execute/modules/module18a.a68 b/gcc/testsuite/algol68/execute/modules/module18a.a68
new file mode 100644 (file)
index 0000000..c89e5b4
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/modules/module18a.a68
@@ -0,0 +1 @@
+module Module_18a = def pub int foo = 10; skip fed

diff --git a/gcc/testsuite/algol68/execute/modules/module18b.a68 b/gcc/testsuite/algol68/execute/modules/module18b.a68
new file mode 100644 (file)
index 0000000..63aa245
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/modules/module18b.a68
@@ -0,0 +1 @@
+module Module_18b = access Module_18a def pub int bar = foo + 10; skip fed

diff --git a/gcc/testsuite/algol68/execute/modules/module18c.a68 b/gcc/testsuite/algol68/execute/modules/module18c.a68
new file mode 100644 (file)
index 0000000..d41b30c
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/modules/module18c.a68
@@ -0,0 +1 @@
+module Module_18c = def pub int baz = 30; skip fed

diff --git a/gcc/testsuite/algol68/execute/modules/program-18.a68 b/gcc/testsuite/algol68/execute/modules/program-18.a68
new file mode 100644 (file)
index 0000000..26ca694
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/modules/program-18.a68
@@ -0,0 +1,9 @@
+{ dg-modules "module18a module18b module18c" }
+
+access Module18a,
+       Module18b,
+       Module18c
+begin assert (foo = 10);
+      assert (bar = 20);
+      assert (baz = 30)
+end