[GCC16][COMMITTED 05/29] a68: improve diagnostics for malformed modes
Jose E. Marchesi
jemarch@gnu.org
Tue Jul 21 11:02:49 GMT 2026
An Algol 68 mode can be non well formed for two reasons:
- When the mode denotes values that are infinite in size.
- When the mode is strongly coercible to itself.
The yin-yang algorithm implemented by is_well_formed is currently
just reporting a boolean indicating whether the given mode is well
formed.
This patch changes is_well_formed so it returns also the reason for
the particular mode to not be ok: missing a yin means an infinite
mode, whereas missing a yang means the mode is strongly coercible to
itself.
This allows to improve diagnostics, guiding the user on why the mode
is not well formed.
Signed-off-by: Jose E. Marchesi <jemarch@gnu.org>
gcc/algol68/ChangeLog
* a68-parser-modes.cc (WELL): Define.
(NO_YIN): Likewise.
(NO_YANG): Likewise.
(UNWELL): Likewise.
(is_well_formed): Discriminate reason for the given mode to not be
well formed.
(a68_make_moid_list): Emit note explaining why a mode is not well
formed.
gcc/testsuite/ChangeLog
* algol68/compile/malformed-mode-1.a68: New test.
* algol68/compile/malformed-mode-2.a68: Likewise.
(cherry picked from commit f95105f02768d3ca404ea5afc846d378fe1e16a2)
---
gcc/algol68/a68-parser-modes.cc | 68 +++++++++++++------
.../algol68/compile/malformed-mode-1.a68 | 6 ++
.../algol68/compile/malformed-mode-2.a68 | 5 ++
3 files changed, 57 insertions(+), 22 deletions(-)
create mode 100644 gcc/testsuite/algol68/compile/malformed-mode-1.a68
create mode 100644 gcc/testsuite/algol68/compile/malformed-mode-2.a68
diff --git a/gcc/algol68/a68-parser-modes.cc b/gcc/algol68/a68-parser-modes.cc
index 97e0cdef55e..9cbf4f962e4 100644
--- a/gcc/algol68/a68-parser-modes.cc
+++ b/gcc/algol68/a68-parser-modes.cc
@@ -801,17 +801,22 @@ get_mode_from_proc_var_declarations_tree (NODE_T *p)
/* Whether a mode declaration refers to self or relates to void.
This uses Lindsey's ying-yang algorithm. */
-static bool
-is_well_formed (MOID_T *def, MOID_T *z, bool yin, bool yang, bool video)
+#define WELL 0
+#define NO_YIN 1
+#define NO_YANG 2
+#define UNWELL 3
+
+static int
+is_well_formed (MOID_T *def, MOID_T *z, bool yin, bool yang, int video)
{
if (z == NO_MOID)
- return false;
+ return UNWELL;
else if (yin && yang)
- return z == M_VOID ? video : true;
+ return z == M_VOID ? video : WELL;
else if (z == M_VOID)
return video;
else if (IS (z, STANDARD))
- return true;
+ return WELL;
else if (IS (z, INDICANT))
{
if (def == NO_MOID)
@@ -822,50 +827,59 @@ is_well_formed (MOID_T *def, MOID_T *z, bool yin, bool yang, bool video)
if (z == M_VOID)
return video;
else
- return true;
+ return WELL;
}
else
{
if (z == def || USE (z))
- return yin && yang;
+ {
+ if (!yin)
+ return NO_YIN;
+ else if (!yang)
+ return NO_YANG;
+ else
+ return WELL;
+ }
else
{
USE (z) = true;
- bool wwf = is_well_formed (def, EQUIVALENT (z), yin, yang, video);
+ int wwf = is_well_formed (def, EQUIVALENT (z), yin, yang, video);
USE (z) = false;
- return wwf;
+ return wwf;
}
}
}
else if (IS_REF (z))
- return is_well_formed (def, SUB (z), true, yang, false);
+ return is_well_formed (def, SUB (z), true, yang, UNWELL);
else if (IS (z, PROC_SYMBOL))
- return PACK (z) != NO_PACK ? true : is_well_formed (def, SUB (z), true, yang, true);
+ return PACK (z) != NO_PACK ? WELL : is_well_formed (def, SUB (z), true, yang, WELL);
else if (IS_ROW (z))
- return is_well_formed (def, SUB (z), yin, yang, false);
+ return is_well_formed (def, SUB (z), yin, yang, UNWELL);
else if (IS_FLEX (z))
- return is_well_formed (def, SUB (z), yin, yang, false);
+ return is_well_formed (def, SUB (z), yin, yang, UNWELL);
else if (IS (z, STRUCT_SYMBOL))
{
for (PACK_T *s = PACK (z); s != NO_PACK; FORWARD (s))
{
- if (!is_well_formed (def, MOID (s), yin, true, false))
- return false;
+ int wwf = is_well_formed (def, MOID (s), yin, true, UNWELL);
+ if (wwf != WELL)
+ return wwf;
}
- return true;
+ return WELL;
}
else if (IS (z, UNION_SYMBOL))
{
for (PACK_T *s = PACK (z); s != NO_PACK; FORWARD (s))
{
- if (!is_well_formed (def, MOID (s), yin, yang, true))
- return false;
+ int wwf = is_well_formed (def, MOID (s), yin, yang, WELL);
+ if (wwf != WELL)
+ return wwf;
}
- return true;
+ return WELL;
}
else
{
- return false;
+ return UNWELL;
}
}
@@ -1334,10 +1348,15 @@ a68_make_moid_list (MODULE_T *mod)
{
if (IS (z, INDICANT) && EQUIVALENT (z) != NO_MOID)
{
- if (!is_well_formed (z, EQUIVALENT (z), false, false, true))
+ int wwf = is_well_formed (z, EQUIVALENT (z), false, false, WELL);
+ if (wwf != WELL)
{
a68_moid_format_token m (z);
a68_error (NODE (z), "%e does not specify a well formed mode", &m);
+ if (wwf == NO_YIN)
+ a68_inform (NODE (z), "mode %e is infinite", &m);
+ else if (wwf == NO_YANG)
+ a68_inform (NODE (z), "mode %e is strongly coercible to itself", &m);
cont = false;
}
}
@@ -1349,10 +1368,15 @@ a68_make_moid_list (MODULE_T *mod)
;
else if (NODE (z) != NO_NODE)
{
- if (!is_well_formed (NO_MOID, z, false, false, true))
+ int wwf = is_well_formed (NO_MOID, z, false, false, WELL);
+ if (wwf != WELL)
{
a68_moid_format_token m (z);
a68_error (NODE (z), "%e does not specify a well formed mode", &m);
+ if (wwf == NO_YIN)
+ a68_inform (NODE (z), "mode %e is infinite", &m);
+ else if (wwf == NO_YANG)
+ a68_inform (NODE (z), "mode %e is strongly coercible to itself", &m);
}
}
}
diff --git a/gcc/testsuite/algol68/compile/malformed-mode-1.a68 b/gcc/testsuite/algol68/compile/malformed-mode-1.a68
new file mode 100644
index 00000000000..a113926cfe5
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/malformed-mode-1.a68
@@ -0,0 +1,6 @@
+begin mode Set = ref[]Elem, { dg-error "" }
+ { dg-message "coercible to itself" "" { target *-*-* } .-1 }
+ Elem = union (int,Set); { dg-error "" }
+ { dg-message "coercible to itself" "" { target *-*-* } .-1 }
+ skip
+end
diff --git a/gcc/testsuite/algol68/compile/malformed-mode-2.a68 b/gcc/testsuite/algol68/compile/malformed-mode-2.a68
new file mode 100644
index 00000000000..0cec23850c8
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/malformed-mode-2.a68
@@ -0,0 +1,5 @@
+begin mode Node = struct (int i, Node n); { dg-error "" }
+ { dg-message "infinite" "" { target *-*-* } .-1 }
+ skip
+end
+
--
2.39.5
More information about the Algol68
mailing list