re PR fortran/78865 (ICE in create_tmp_var, at gimple-expr.c:473)

2019-03-24  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-24  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.

From-SVN: r269895

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index dd4347e..3ce7de3 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2019-03-24  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-21  Thomas Schwinge  <thomas@codesourcery.com>
 
        PR fortran/72741

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index c9781d7..5b8a0f9 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2969,17 +2969,19 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 
       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;
        }
 
       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;
        }
 

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e1cd200..3513a44 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2498,62 +2498,64 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
       && 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)
-           {
-             ns->sibling = gsym->ns->sibling;
-             gsym->ns->sibling = gfc_global_ns_list;
-             gfc_global_ns_list = gsym->ns;
-             break;
+             /* Restore the derived types of this namespace.  */
+             gfc_derived_types = old_dt_list;
            }
-       }
 
-      def_sym = gsym->ns->proc_name;
+         /* 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)
+               {
+                 ns->sibling = gsym->ns->sibling;
+                 gsym->ns->sibling = gfc_global_ns_list;
+                 gfc_global_ns_list = gsym->ns;
+                 break;
+               }
+           }
 
-      /* 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))

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5626696..7d2a0b1 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+2019-03-24  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  Vladimir Makarov  <vmakarov@redhat.com>
 
        PR rtl-optimization/89676

diff --git a/gcc/testsuite/gfortran.dg/altreturn_10.f90 b/gcc/testsuite/gfortran.dg/altreturn_10.f90
new file mode 100644 (file)
index 0000000..7e5d569
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/altreturn_10.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options -Os }
+! PR 78865 - this used to ICE.
+program p
+   call sub (3)
+end
+subroutine sub (x)
+   integer :: x, i, n
+   do i = 1, x
+      if ( n /= 0 ) stop
+      call sub2
+   end do
+   print *, x, n
+end
+subroutine sub2
+   call sub (*99) ! { dg-error "Unexpected alternate return specifier" }
+   call sub (99.) ! { dg-warning "Type mismatch in argument" }
+99 stop
+end

diff --git a/gcc/testsuite/gfortran.dg/whole_file_3.f90 b/gcc/testsuite/gfortran.dg/whole_file_3.f90
index 9b4f5a7..0689827 100644 (file)
--- a/gcc/testsuite/gfortran.dg/whole_file_3.f90
+++ b/gcc/testsuite/gfortran.dg/whole_file_3.f90
@@ -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