Hello world, I have just committed the attached patch to master as obvious and simple. Explanation is in the ChangeLog below.
Best regards Thomas Fix ICE on warning with new interface check (the patch for PR 27318). In the test case, there was a warning about INTENT where an EXTERNAL masked an interface in an outer scope, when the location of the symbol was not set, leading to an ICE. Two problems, two-part solution: It makes no sense to warn about INTENT for artificially generated formal argument lists, and the location should be set. gcc/fortran/ChangeLog: PR fortran/96073 * frontend-passes.c (check_externals_procedure): Add locus information for new_sym. * interface.c (gfc_check_dummy_characteristics): Do not warn about INTENT for artificially generated variables. gcc/testsuite/ChangeLog: PR fortran/96073 * gfortran.dg/interface_48.f90: New test
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 69f9ca64c97..7768fdc25ca 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -5441,6 +5441,7 @@ check_externals_procedure (gfc_symbol *sym, locus *loc, gfc_current_ns = gsym->ns; gfc_get_formal_from_actual_arglist (new_sym, actual); + new_sym->declared_at = *loc; gfc_current_ns = save_ns; return 0; diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 0cc504f4e04..e51820918b8 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1343,7 +1343,8 @@ gfc_check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, } /* Check INTENT. */ - if (s1->attr.intent != s2->attr.intent) + if (s1->attr.intent != s2->attr.intent && !s1->attr.artificial + && !s2->attr.artificial) { snprintf (errmsg, err_len, "INTENT mismatch in argument '%s'", s1->name); diff --git a/gcc/testsuite/gfortran.dg/interface_48.f90 b/gcc/testsuite/gfortran.dg/interface_48.f90 new file mode 100644 index 00000000000..f7513324172 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_48.f90 @@ -0,0 +1,31 @@ +! { dg-do compile } +! PR 96073 - this used to cause an ICE. +! Test case by Jürgen Reuter. + +module m + implicit none + private + + interface + subroutine GetXminM (set, xmin) + integer, intent(in) :: set + real, intent(out) :: xmin + end subroutine GetXminM + end interface + interface + subroutine foo(a) ! { dg-warning "Type mismatch" } + integer, intent(in) :: a + end subroutine foo + end interface + +contains + + subroutine s () + real :: xmin + integer :: set + external :: GetXminM, foo + call GetXminM (set, xmin) + call foo(1.0) ! { dg-warning "Type mismatch" } + end subroutine s + +end module m