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 <[email protected]> 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. --- 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
