diff options
| author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2025-04-13 10:22:07 +0200 |
|---|---|---|
| committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2025-04-13 10:23:41 +0200 |
| commit | 64319b2ccae2fdfae06347545e031e56d790dad7 (patch) | |
| tree | 7e134c6d19b1ea532252e04e8f1d9f9d661270f5 | |
| parent | 1fda2deeea862072543035b6005c65d4c160691f (diff) | |
| download | gcc-64319b2ccae2fdfae06347545e031e56d790dad7.zip gcc-64319b2ccae2fdfae06347545e031e56d790dad7.tar.gz gcc-64319b2ccae2fdfae06347545e031e56d790dad7.tar.bz2 | |
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.
| -rw-r--r-- | gcc/fortran/interface.cc | 31 | ||||
| -rw-r--r-- | 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 c702239..1e552a3 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 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 |