https://gcc.gnu.org/g:791d7e85cc6326151dd12ca9f2b22db9b0e30476
commit r16-6406-g791d7e85cc6326151dd12ca9f2b22db9b0e30476 Author: Jose E. Marchesi <[email protected]> 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 <[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. 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))
