[COMMITTED 2/6] a68: fix support for nested access clauses

Jose E. Marchesi jose.marchesi@oracle.com
Sat Dec 27 11:10:02 GMT 2025


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

Signed-off-by: Jose E. Marchesi <jemarch@gnu.org>

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



More information about the Algol68 mailing list