[gcc r16-6406] a68: fix support for nested access clauses
Jose E. Marchesi
jemarch@gcc.gnu.org
Sat Dec 27 11:08:28 GMT 2025
https://gcc.gnu.org/g:791d7e85cc6326151dd12ca9f2b22db9b0e30476
commit r16-6406-g791d7e85cc6326151dd12ca9f2b22db9b0e30476
Author: Jose E. Marchesi <jose.marchesi@oracle.com>
Date: Tue Dec 23 15:53:36 2025 +0100
a68: fix support for nested access clauses
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.
Diff:
---
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(-)
diff --git a/gcc/algol68/a68-parser-bottom-up.cc b/gcc/algol68/a68-parser-bottom-up.cc
index 2bbdbaec30ec..c9a17246aa77 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 06f18975536e..ec43dc1719c4 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 79100a0a4af5..e4a3bf8c854a 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 000000000000..97b5566592e3
--- /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 000000000000..e99a72ed9448
--- /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))
More information about the Gcc-cvs
mailing list