[Bug fortran/93635] Get ICE instead of error message if user incorrectly equivalences allocateable variables that are in a NAMELIST group

[kargl at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93635

kargl at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|UNCONFIRMED                 |NEW
   Last reconfirmed|                            |2020-02-09
                 CC|                            |kargl at gcc dot gnu.org
     Ever confirmed|0                           |1

--- Comment #1 from kargl at gcc dot gnu.org ---
The problem is in symbol.c (gfc_check_conflict).  This check

   if (attr->in_namelist && (attr->allocatable || attr->pointer))
     {
       a1 = in_namelist;
       a2 = attr->allocatable ? allocatable : pointer;
       standard = GFC_STD_F2003;
       goto conflict_std;
     }

jumps to conflict_std, where an error may or may not be issued.
In either case, gfc_check_conflict returns without any futher
checking of other attributes.  There are four cases with the 
conflict_std jump.  This patch removes these jumps.  It causes
a regression with pr87907.f90 where a correct error is emitted,
which is then followed by bunch of run-on errors.  Removing the
of pr87907.f90 that leads to the run-on errors, then results in
a correct error message followed by an ICE.  Likely, the bug 
fix for pr87907.f90 needs to be re-evaluated.  Fortuantely, I 
use neither namelist nor equivalence, so have no skin in the 
game.  Someone else can complete the fix.

Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c        (revision 280157)
+++ gcc/fortran/symbol.c        (working copy)
@@ -394,18 +395,35 @@ gfc_check_function_type (gfc_namespace *ns)

 /******************** Symbol attribute stuff *********************/

+/* Older standard produced conflicts for some attributes that are now
+   allowed in newer standards.  Check for the conflict and issue an
+   error depending on the standard in play.  */
+
+static bool
+conflict_std (int standard, const char *a1, const char *a2, const char *name,
+             locus *where)
+{
+  if (name == NULL)
+    {
+      return gfc_notify_std (standard, "%s attribute conflicts "
+                             "with %s attribute at %L", a1, a2,
+                             where);
+    }
+  else
+    {
+      return gfc_notify_std (standard, "%s attribute conflicts "
+                            "with %s attribute in %qs at %L",
+                             a1, a2, name, where);
+    }
+}
+
+
+
 /* This is a generic conflict-checker.  We do this to avoid having a
    single conflict in two places.  */

 #define conf(a, b) if (attr->a && attr->b) { a1 = a; a2 = b; goto conflict; }
 #define conf2(a) if (attr->a) { a2 = a; goto conflict; }
-#define conf_std(a, b, std) if (attr->a && attr->b)\
-                              {\
-                                a1 = a;\
-                                a2 = b;\
-                                standard = std;\
-                                goto conflict_std;\
-                              }

 bool
 gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
@@ -438,7 +456,7 @@ gfc_check_conflict (symbol_attribute *attr, const char
                                                "OACC DECLARE DEVICE_RESIDENT";

   const char *a1, *a2;
-  int standard;
+  bool standard;

   if (attr->artificial)
     return true;
@@ -450,16 +468,18 @@ gfc_check_conflict (symbol_attribute *attr, const char
     {
       a1 = pointer;
       a2 = intent;
-      standard = GFC_STD_F2003;
-      goto conflict_std;
+      standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
+      if (!standard)
+         return standard;
     }

   if (attr->in_namelist && (attr->allocatable || attr->pointer))
     {
       a1 = in_namelist;
       a2 = attr->allocatable ? allocatable : pointer;
-      standard = GFC_STD_F2003;
-      goto conflict_std;
+      standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
+      if (!standard)
+         return standard;
     }

   /* Check for attributes not allowed in a BLOCK DATA.  */
@@ -566,9 +586,31 @@ gfc_check_conflict (symbol_attribute *attr, const char
     return false;

   conf (allocatable, pointer);
-  conf_std (allocatable, dummy, GFC_STD_F2003);
-  conf_std (allocatable, function, GFC_STD_F2003);
-  conf_std (allocatable, result, GFC_STD_F2003);
+  if (attr->allocatable && attr->dummy)
+    {
+      a1 = allocatable;
+      a2 = dummy;
+      standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
+      if (!standard)
+         return standard;
+    }
+  if (attr->allocatable && attr->function)
+    {
+      a1 = allocatable;
+      a2 = function;
+      standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
+      if (!standard)
+         return standard;
+    }
+  if (attr->allocatable && attr->result)
+    {
+      a1 = allocatable;
+      a2 = result;
+      standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
+      if (!standard)
+         return standard;
+    }
+
   conf (elemental, recursive);

   conf (in_common, dummy);
@@ -908,25 +950,10 @@ conflict:
               a1, a2, name, where);

   return false;
-
-conflict_std:
-  if (name == NULL)
-    {
-      return gfc_notify_std (standard, "%s attribute conflicts "
-                             "with %s attribute at %L", a1, a2,
-                             where);
-    }
-  else
-    {
-      return gfc_notify_std (standard, "%s attribute conflicts "
-                            "with %s attribute in %qs at %L",
-                             a1, a2, name, where);
-    }
 }

 #undef conf
 #undef conf2
-#undef conf_std


 /* Mark a symbol as referenced.  */