https://gcc.gnu.org/g:64319b2ccae2fdfae06347545e031e56d790dad7
commit r15-9406-g64319b2ccae2fdfae06347545e031e56d790dad7
Author: Thomas Koenig <tkoe...@gcc.gnu.org>
Date: Sun Apr 13 10:22:07 2025 +0200
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:
---
gcc/fortran/interface.cc | 31 +++++++++++++++++++++++-------
gcc/testsuite/gfortran.dg/interface_59.f90 | 15 +++++++++++++++
2 files changed, 39 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index c702239d64da..1e552a3df861 100644
--- 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
index 000000000000..c9ccd67f1a12
--- /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
