Fix ICE in compare_parameter.

This patch fixes an ICE by setting the typespec of a dummy argument
from a global function if known. plus setting the correct flag.
This also removes the corresponding assert.  I'm not quite sure
that the code with the subroutine attribute can be reached, but
I thought better safe than sorry.

gcc/fortran/ChangeLog:

	PR fortran/119669
	* interface.cc (compare_parameter): Error when mismatch between
	formal argument as subroutine and function.  If the dummy
	argument is a known function, set its typespec.

gcc/testsuite/ChangeLog:

	PR fortran/119669
	* gfortran.dg/interface_59.f90: New test.

diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index c702239d64da2a379b9c58057eb6e3ea177f57c0..1e552a3df861091e641b644f30b4034c037450c7 100644 (file)
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -2534,16 +2534,33 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
                  gfc_find_symbol (actual_name, gsym->ns, 0, &global_asym);
                  if (global_asym != NULL)
                    {
-                     gcc_assert (formal->attr.function);
-                     if (!gfc_compare_types (&global_asym->ts, &formal->ts))
+                     if (formal->attr.subroutine)
                        {
-                         gfc_error ("Type mismatch at %L passing global "
-                                    "function %qs declared at %L (%s/%s)",
-                                    &actual->where, actual_name, &gsym->where,
-                                    gfc_typename (&global_asym->ts),
-                                    gfc_dummy_typename (&formal->ts));
+                         gfc_error ("Mismatch between subroutine and "
+                                    "function at %L", &actual->where);
                          return false;
                        }
+                     else if (formal->attr.function)
+                       {
+                         if (!gfc_compare_types (&global_asym->ts,
+                                                 &formal->ts))
+                           {
+                             gfc_error ("Type mismatch at %L passing global "
+                                        "function %qs declared at %L (%s/%s)",
+                                        &actual->where, actual_name,
+                                        &gsym->where,
+                                        gfc_typename (&global_asym->ts),
+                                        gfc_dummy_typename (&formal->ts));
+                             return false;
+                           }
+                       }
+                     else
+                       {
+                         /* The global symbol is a function.  Set the formal
+                            argument acordingly.  */
+                         formal->attr.function = 1;
+                         formal->ts = global_asym->ts;
+                       }
                    }
                }
            }

diff --git a/gcc/testsuite/gfortran.dg/interface_59.f90 b/gcc/testsuite/gfortran.dg/interface_59.f90
new file mode 100644 (file)
index 0000000..c9ccd67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_59.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! PR fortran/119669 - this used to generate an ICE.
+
+program a
+  implicit real(a-h,o-z)
+  external abstract_caller, caller, func
+!  real func
+  call abstract_caller (caller, func, 1.5)
+  call abstract_caller (caller, func, 1.5)
+end program a
+
+function func (x)
+  real func, x
+  func = x * x - 1.
+end