[gcc r16-9332] a68: improve diagnostics for malformed modes

https://gcc.gnu.org/g:8899ba27f7a59bb37bcaef1219c0d0139eade58c

commit r16-9332-g8899ba27f7a59bb37bcaef1219c0d0139eade58c
Author: Jose E. Marchesi <[email protected]>
Date:   Tue Jun 2 18:20:33 2026 +0200

    a68: improve diagnostics for malformed modes
    
    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.
    
    (cherry picked from commit f95105f02768d3ca404ea5afc846d378fe1e16a2)

Diff:
---
 gcc/algol68/a68-parser-modes.cc                    | 68 +++++++++++++++-------
 gcc/testsuite/algol68/compile/malformed-mode-1.a68 |  6 ++
 gcc/testsuite/algol68/compile/malformed-mode-2.a68 |  5 ++
 3 files changed, 57 insertions(+), 22 deletions(-)

diff --git a/gcc/algol68/a68-parser-modes.cc b/gcc/algol68/a68-parser-modes.cc
index 97e0cdef55e9..9cbf4f962e41 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 000000000000..a113926cfe5e
--- /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 000000000000..0cec23850c86
--- /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
+