[patch, fortran] Fix ICE on invalid, PR 94090

[Fritz Reese]

> Yes.  Looking back at the code, I think it can also be cleaned up
> a little - turning the error to warnings is only needed on that
> particular branch, and resetting it to the default can also
> happen there, and at the target of a goto statement.
>
> So, here's an updated patch.  OK for trunk?
>
> Regards
>
>         Thomas

Looks great, thank you for the cleanup!

While you're touching the code anyway, how would you feel about
replacing the nearby "goto done"s with a chain of "else if"? There's
really no reason I can see for goto here, since the block following
the conditions is already "done". Here (and attached) is a diff on top
of your latest changes, in case you think it's appropriate:

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2371ab23645..617e8d01a59 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2511,6 +2511,7 @@ resolve_global_procedure (gfc_symbol *sym, locus
*where, int sub)
   gfc_namespace *ns;
   enum gfc_symbol_type type;
   char reason[200];
+  bool bad_result_characteristics;

   type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;

@@ -2586,23 +2587,16 @@ resolve_global_procedure (gfc_symbol *sym,
locus *where, int sub)
     }

       if (sym->attr.function && !gfc_compare_types (&sym->ts, &def_sym->ts))
-    {
-      gfc_error ("Return type mismatch of function %qs at %L (%s/%s)",
-             sym->name, &sym->declared_at, gfc_typename (&sym->ts),
-             gfc_typename (&def_sym->ts));
-      goto done;
-    }
+    gfc_error ("Return type mismatch of function %qs at %L (%s/%s)",
+           sym->name, &sym->declared_at, gfc_typename (&sym->ts),
+           gfc_typename (&def_sym->ts));

-      if (sym->attr.if_source == IFSRC_UNKNOWN
+      else if (sym->attr.if_source == IFSRC_UNKNOWN
       && gfc_explicit_interface_required (def_sym, reason, sizeof(reason)))
-    {
-      gfc_error ("Explicit interface required for %qs at %L: %s",
-             sym->name, &sym->declared_at, reason);
-      goto done;
-    }
+    gfc_error ("Explicit interface required for %qs at %L: %s",
+           sym->name, &sym->declared_at, reason);

-      bool bad_result_characteristics;
-      if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
+      else if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
                    reason, sizeof(reason), NULL, NULL,
                    &bad_result_characteristics))
     {
@@ -2617,12 +2611,9 @@ resolve_global_procedure (gfc_symbol *sym,
locus *where, int sub)
       gfc_error ("Interface mismatch in global procedure %qs at %L: %s",
              sym->name, &sym->declared_at, reason);
       gfc_errors_to_warnings (false);
-      goto done;
     }
     }

-done:
-
   if (gsym->type == GSYM_UNKNOWN)
     {
       gsym->type = type;
---

Even if you don't want to include this, your patch LGTM. Thanks again.

---
Fritz Reese
-------------- next part --------------
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2371ab23645..617e8d01a59 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2511,6 +2511,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub)
   gfc_namespace *ns;
   enum gfc_symbol_type type;
   char reason[200];
+  bool bad_result_characteristics;
 
   type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
 
@@ -2586,23 +2587,16 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub)
 	}
 
       if (sym->attr.function && !gfc_compare_types (&sym->ts, &def_sym->ts))
-	{
-	  gfc_error ("Return type mismatch of function %qs at %L (%s/%s)",
-		     sym->name, &sym->declared_at, gfc_typename (&sym->ts),
-		     gfc_typename (&def_sym->ts));
-	  goto done;
-	}
+	gfc_error ("Return type mismatch of function %qs at %L (%s/%s)",
+		   sym->name, &sym->declared_at, gfc_typename (&sym->ts),
+		   gfc_typename (&def_sym->ts));
 
-      if (sym->attr.if_source == IFSRC_UNKNOWN
+      else if (sym->attr.if_source == IFSRC_UNKNOWN
 	  && gfc_explicit_interface_required (def_sym, reason, sizeof(reason)))
-	{
-	  gfc_error ("Explicit interface required for %qs at %L: %s",
-		     sym->name, &sym->declared_at, reason);
-	  goto done;
-	}
+	gfc_error ("Explicit interface required for %qs at %L: %s",
+		   sym->name, &sym->declared_at, reason);
 
-      bool bad_result_characteristics;
-      if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
+      else if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
 				   reason, sizeof(reason), NULL, NULL,
 				   &bad_result_characteristics))
 	{
@@ -2617,12 +2611,9 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub)
 	  gfc_error ("Interface mismatch in global procedure %qs at %L: %s",
 		     sym->name, &sym->declared_at, reason);
 	  gfc_errors_to_warnings (false);
-	  goto done;
 	}
     }
 
-done:
-
   if (gsym->type == GSYM_UNKNOWN)
     {
       gsym->type = type;