https://gcc.gnu.org/g:2a273f75b1877c092e4d169ef3c18fecabb9f40d
commit r16-6408-g2a273f75b1877c092e4d169ef3c18fecabb9f40d Author: Jose E. Marchesi <[email protected]> Date: Sat Dec 27 11:09:04 2025 +0100 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 <[email protected]> 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: --- gcc/algol68/a68-low-clauses.cc | 86 ++++++++++------------ gcc/algol68/a68-parser-bottom-up.cc | 17 ++++- gcc/testsuite/algol68/compile/modules/module10.a68 | 1 + gcc/testsuite/algol68/compile/modules/module11.a68 | 5 ++ gcc/testsuite/algol68/compile/modules/module12.a68 | 1 + .../algol68/compile/modules/program-10.a68 | 8 ++ .../algol68/compile/modules/program-11.a68 | 12 +++ .../algol68/execute/modules/module18a.a68 | 1 + .../algol68/execute/modules/module18b.a68 | 1 + .../algol68/execute/modules/module18c.a68 | 1 + .../algol68/execute/modules/program-18.a68 | 9 +++ 11 files changed, 92 insertions(+), 50 deletions(-) diff --git a/gcc/algol68/a68-low-clauses.cc b/gcc/algol68/a68-low-clauses.cc index d36b4cc282ac..20ab22929bc0 100644 --- 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 c9a17246aa77..6b35fef43871 100644 --- 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 index 000000000000..70546a008321 --- /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 index 000000000000..a871db23e2f5 --- /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 index 000000000000..7335f257b4bb --- /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 index 000000000000..f0de0f9bc686 --- /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 index 000000000000..9da676df7033 --- /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 index 000000000000..c89e5b413be9 --- /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 index 000000000000..63aa2457f97b --- /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 index 000000000000..d41b30cef7a0 --- /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 index 000000000000..26ca6944a3e5 --- /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
