[COMMITTED 4/6] a68: allow joined list of revelations in access clauses
Jose E. Marchesi
jose.marchesi@oracle.com
Sat Dec 27 11:10:04 GMT 2025
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.
---
gcc/algol68/a68-low-clauses.cc | 86 ++++++++-----------
gcc/algol68/a68-parser-bottom-up.cc | 17 +++-
.../algol68/compile/modules/module10.a68 | 1 +
.../algol68/compile/modules/module11.a68 | 5 ++
.../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(-)
create mode 100644 gcc/testsuite/algol68/compile/modules/module10.a68
create mode 100644 gcc/testsuite/algol68/compile/modules/module11.a68
create mode 100644 gcc/testsuite/algol68/compile/modules/module12.a68
create mode 100644 gcc/testsuite/algol68/compile/modules/program-10.a68
create mode 100644 gcc/testsuite/algol68/compile/modules/program-11.a68
create mode 100644 gcc/testsuite/algol68/execute/modules/module18a.a68
create mode 100644 gcc/testsuite/algol68/execute/modules/module18b.a68
create mode 100644 gcc/testsuite/algol68/execute/modules/module18c.a68
create mode 100644 gcc/testsuite/algol68/execute/modules/program-18.a68
diff --git a/gcc/algol68/a68-low-clauses.cc b/gcc/algol68/a68-low-clauses.cc
index d36b4cc282a..20ab22929bc 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 c9a17246aa7..6b35fef4387 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 00000000000..70546a00832
--- /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 00000000000..a871db23e2f
--- /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 00000000000..7335f257b4b
--- /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 00000000000..f0de0f9bc68
--- /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 00000000000..9da676df703
--- /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 00000000000..c89e5b413be
--- /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 00000000000..63aa2457f97
--- /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 00000000000..d41b30cef7a
--- /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 00000000000..26ca6944a3e
--- /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
--
2.30.2
More information about the Algol68
mailing list