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.
This commit is contained in:
parent
1fda2deeea
commit
64319b2cca
2 changed files with 39 additions and 7 deletions
|
@ -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;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
15
gcc/testsuite/gfortran.dg/interface_59.f90
Normal file
15
gcc/testsuite/gfortran.dg/interface_59.f90
Normal file
|
@ -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
|
Loading…
Add table
Reference in a new issue