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

[sgk at troutmask dot apl.washington.edu]

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

--- Comment #2 from Steve Kargl <sgk at troutmask dot apl.washington.edu> ---
On Sun, Feb 09, 2020 at 06:39:31PM +0000, kargl at gcc dot gnu.org wrote:
>
> Fortuantely, I 
> use neither namelist nor equivalence, so have no skin in the 
> game.  Someone else can complete the fix.
> 

Here's a patch that fixes the issue and cures the ICE in the
old testcase.  Whoever commit patch needs to convert the 
example code here into a testcase.


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.  */
@@ -4039,6 +4066,31 @@ gfc_free_namespace (gfc_namespace *ns)
   ns->refs--;
   if (ns->refs > 0)
     return;
+
+  /* If an error occurred while parsing a submodule, the namespace is freed.
+     However, gfortran reaches a ref count of -1.  Note, gfc_state_stack does
+     not indicate that gfortran was parsing a submodule.  */
+  if (ns->refs == -1)
+    {
+      gcc_assert (ns->sym_root == NULL);
+      gcc_assert (ns->uop_root == NULL);
+      gcc_assert (ns->common_root == NULL);
+      gcc_assert (ns->omp_udr_root == NULL);
+      gcc_assert (ns->tb_sym_root == NULL);
+      gcc_assert (ns->tb_uop_root == NULL);
+      gcc_assert (ns->finalizers == NULL);
+      gcc_assert (ns->omp_declare_simd == NULL);
+      gcc_assert (ns->cl_list == NULL);
+      gcc_assert (ns->st_labels == NULL);
+      gcc_assert (ns->entries == NULL);
+      gcc_assert (ns->equiv == NULL);
+      gcc_assert (ns->equiv_lists == NULL);
+      gcc_assert (ns->use_stmts == NULL);
+      gcc_assert (ns->data == NULL);
+      gcc_assert (ns->contained == NULL);
+      free (ns);
+      return;
+    }

   gcc_assert (ns->refs == 0);

Index: gcc/testsuite/gfortran.dg/pr87907.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr87907.f90       (revision 280157)
+++ gcc/testsuite/gfortran.dg/pr87907.f90       (working copy)
@@ -12,12 +12,6 @@ end

 submodule(m) m2
    contains
-      subroutine g(x)   ! { dg-error "mismatch in argument" }
+      subroutine g(x)   ! { dg-error " attribute conflicts with" }
       end
-end
-
-program p
-   use m                ! { dg-error "has a type" }
-   integer :: x = 3
-   call g(x)            ! { dg-error "which is not consistent with" }
 end