diff mbox series

[fortran] Fix PR 78865, ICE on invalid

Message ID b83020d6-9266-dec1-5c49-cdd555f7721c@netcologne.de
State New
Headers show
Series [fortran] Fix PR 78865, ICE on invalid | expand

Commit Message

Thomas Koenig March 22, 2019, 10:55 p.m. UTC 
Hello world,

the attached patch fixes a 7/8/9 regression.  The problem was twofold:
If a subroutine was called more than once from a different subroutine,
the call was only checked the first time.  Also, a type change in the
backend_decl initiated when there was already a declaration led to an
ICE.

The solution also has two parts: Make sure that a hard error is
delivered in this case, and make sure the check is done every time.

Regression-tested. OK for trunk and other affected branches?

Regards

	Thomas

2019-03-22  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/78865
	* interface.c (compare_actual_formal): Change errors about
	missing or extra to gfc_error_now to make sure they are issued.
	Change "spec" to "specifier" in message.
	* resolve.c (resolve_global_procedure): Also check for mismatching
	interface with global symbols if the namespace has already been
	resolved.

2019-03-22  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/78865
	* gfortran.dg/altreturn_10.f90: New test.
	* gfortran.dg/whole_file_3.f90: Change dg-warning to dg-error.

Comments

Paul Richard Thomas March 24, 2019, 10:29 a.m. UTC | #1 
Hi Thomas,

This is OK for trunk and, after a wee delay for the other active branches.

Thanks

Paul

On Fri, 22 Mar 2019 at 22:56, Thomas Koenig <tkoenig@netcologne.de> wrote:
>
> Hello world,
>
> the attached patch fixes a 7/8/9 regression.  The problem was twofold:
> If a subroutine was called more than once from a different subroutine,
> the call was only checked the first time.  Also, a type change in the
> backend_decl initiated when there was already a declaration led to an
> ICE.
>
> The solution also has two parts: Make sure that a hard error is
> delivered in this case, and make sure the check is done every time.
>
> Regression-tested. OK for trunk and other affected branches?
>
> Regards
>
>         Thomas
>
> 2019-03-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
>
>         PR fortran/78865
>         * interface.c (compare_actual_formal): Change errors about
>         missing or extra to gfc_error_now to make sure they are issued.
>         Change "spec" to "specifier" in message.
>         * resolve.c (resolve_global_procedure): Also check for mismatching
>         interface with global symbols if the namespace has already been
>         resolved.
>
> 2019-03-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
>
>         PR fortran/78865
>         * gfortran.dg/altreturn_10.f90: New test.
>         * gfortran.dg/whole_file_3.f90: Change dg-warning to dg-error.
diff mbox series

Patch

Index: fortran/interface.c
===================================================================
--- fortran/interface.c	(Revision 269825)
+++ fortran/interface.c	(Arbeitskopie)
@@ -2969,9 +2969,11 @@  compare_actual_formal (gfc_actual_arglist **ap, gf
 
       if (f->sym == NULL)
 	{
+	  /* These errors have to be issued, otherwise an ICE can occur.
+	     See PR 78865.  */
 	  if (where)
-	    gfc_error ("Missing alternate return spec in subroutine call "
-		       "at %L", where);
+	    gfc_error_now ("Missing alternate return specifier in subroutine "
+			   "call at %L", where);
 	  return false;
 	}
 
@@ -2978,8 +2980,8 @@  compare_actual_formal (gfc_actual_arglist **ap, gf
       if (a->expr == NULL)
 	{
 	  if (where)
-	    gfc_error ("Unexpected alternate return spec in subroutine "
-		       "call at %L", where);
+	    gfc_error_now ("Unexpected alternate return specifier in "
+			   "subroutine call at %L", where);
 	  return false;
 	}
 
Index: fortran/resolve.c
===================================================================
--- fortran/resolve.c	(Revision 269825)
+++ fortran/resolve.c	(Arbeitskopie)
@@ -2498,62 +2498,64 @@  resolve_global_procedure (gfc_symbol *sym, locus *
       && gsym->type != GSYM_UNKNOWN
       && !gsym->binding_label
       && gsym->ns
-      && gsym->ns->resolved != -1
       && gsym->ns->proc_name
       && not_in_recursive (sym, gsym->ns)
       && not_entry_self_reference (sym, gsym->ns))
     {
       gfc_symbol *def_sym;
+      def_sym = gsym->ns->proc_name;
 
-      /* Resolve the gsymbol namespace if needed.  */
-      if (!gsym->ns->resolved)
+      if (gsym->ns->resolved != -1)
 	{
-	  gfc_symbol *old_dt_list;
 
-	  /* Stash away derived types so that the backend_decls do not
-	     get mixed up.  */
-	  old_dt_list = gfc_derived_types;
-	  gfc_derived_types = NULL;
+	  /* Resolve the gsymbol namespace if needed.  */
+	  if (!gsym->ns->resolved)
+	    {
+	      gfc_symbol *old_dt_list;
 
-	  gfc_resolve (gsym->ns);
+	      /* Stash away derived types so that the backend_decls
+		 do not get mixed up.  */
+	      old_dt_list = gfc_derived_types;
+	      gfc_derived_types = NULL;
 
-	  /* Store the new derived types with the global namespace.  */
-	  if (gfc_derived_types)
-	    gsym->ns->derived_types = gfc_derived_types;
+	      gfc_resolve (gsym->ns);
 
-	  /* Restore the derived types of this namespace.  */
-	  gfc_derived_types = old_dt_list;
-	}
+	      /* Store the new derived types with the global namespace.  */
+	      if (gfc_derived_types)
+		gsym->ns->derived_types = gfc_derived_types;
 
-      /* Make sure that translation for the gsymbol occurs before
-	 the procedure currently being resolved.  */
-      ns = gfc_global_ns_list;
-      for (; ns && ns != gsym->ns; ns = ns->sibling)
-	{
-	  if (ns->sibling == gsym->ns)
+	      /* Restore the derived types of this namespace.  */
+	      gfc_derived_types = old_dt_list;
+	    }
+
+	  /* Make sure that translation for the gsymbol occurs before
+	     the procedure currently being resolved.  */
+	  ns = gfc_global_ns_list;
+	  for (; ns && ns != gsym->ns; ns = ns->sibling)
 	    {
-	      ns->sibling = gsym->ns->sibling;
-	      gsym->ns->sibling = gfc_global_ns_list;
-	      gfc_global_ns_list = gsym->ns;
-	      break;
+	      if (ns->sibling == gsym->ns)
+		{
+		  ns->sibling = gsym->ns->sibling;
+		  gsym->ns->sibling = gfc_global_ns_list;
+		  gfc_global_ns_list = gsym->ns;
+		  break;
+		}
 	    }
-	}
 
-      def_sym = gsym->ns->proc_name;
+	  /* This can happen if a binding name has been specified.  */
+	  if (gsym->binding_label && gsym->sym_name != def_sym->name)
+	    gfc_find_symbol (gsym->sym_name, gsym->ns, 0, &def_sym);
 
-      /* This can happen if a binding name has been specified.  */
-      if (gsym->binding_label && gsym->sym_name != def_sym->name)
-	gfc_find_symbol (gsym->sym_name, gsym->ns, 0, &def_sym);
-
-      if (def_sym->attr.entry_master)
-	{
-	  gfc_entry_list *entry;
-	  for (entry = gsym->ns->entries; entry; entry = entry->next)
-	    if (strcmp (entry->sym->name, sym->name) == 0)
-	      {
-		def_sym = entry->sym;
-		break;
-	      }
+	  if (def_sym->attr.entry_master)
+	    {
+	      gfc_entry_list *entry;
+	      for (entry = gsym->ns->entries; entry; entry = entry->next)
+		if (strcmp (entry->sym->name, sym->name) == 0)
+		  {
+		    def_sym = entry->sym;
+		    break;
+		  }
+	    }
 	}
 
       if (sym->attr.function && !gfc_compare_types (&sym->ts, &def_sym->ts))
Index: testsuite/gfortran.dg/whole_file_3.f90
===================================================================
--- testsuite/gfortran.dg/whole_file_3.f90	(Revision 269825)
+++ testsuite/gfortran.dg/whole_file_3.f90	(Arbeitskopie)
@@ -14,8 +14,8 @@ 
 
       program test
       EXTERNAL R
-      call PHLOAD (R, 1) ! { dg-warning "Missing alternate return spec" }
-      CALL PHLOAD (R, 2) ! { dg-warning "Missing alternate return spec" }
+      call PHLOAD (R, 1) ! { dg-error "Missing alternate return specifier" }
+      CALL PHLOAD (R, 2) ! { dg-error "Missing alternate return specifier" }
       CALL PHLOAD (R, *999) ! This one is OK
  999  continue
       END program test