https://gcc.gnu.org/g:52ee235811442e9331a6fba6482d3be59364bace
commit r16-4372-g52ee235811442e9331a6fba6482d3be59364bace Author: Harald Anlauf <[email protected]> Date: Fri Oct 10 22:02:51 2025 +0200 Fortran: improve checking of procedures passed as actual argument [PR50377] Procedures passed as actual argument require either an explicit interface or must be declared EXTERNAL. Add a check and generate an error (default) or a warning when -std=legacy is specified. PR fortran/50377 gcc/fortran/ChangeLog: * resolve.cc (resolve_actual_arglist): Check procedure actual arguments. gcc/testsuite/ChangeLog: * gfortran.dg/pr41011.f: Fix invalid testcase. * gfortran.dg/actual_procedure_2.f: New test. Diff: --- gcc/fortran/resolve.cc | 24 ++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/actual_procedure_2.f | 22 ++++++++++++++++++++++ gcc/testsuite/gfortran.dg/pr41011.f | 2 ++ 3 files changed, 48 insertions(+) diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 75270064ed43..4c45de08f035 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -2295,6 +2295,30 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, goto cleanup; } + if (e->expr_type == EXPR_VARIABLE + && e->ts.type == BT_PROCEDURE + && no_formal_args + && sym->attr.flavor == FL_PROCEDURE + && sym->attr.if_source == IFSRC_UNKNOWN + && !sym->attr.external + && !sym->attr.intrinsic + && !sym->attr.artificial + && !sym->ts.interface) + { + /* Emit a warning for -std=legacy and an error otherwise. */ + if (gfc_option.warn_std == 0) + gfc_warning (0, "Procedure %qs at %L used as actual argument but " + "does neither have an explicit interface nor the " + "EXTERNAL attribute", sym->name, &e->where); + else + { + gfc_error ("Procedure %qs at %L used as actual argument but " + "does neither have an explicit interface nor the " + "EXTERNAL attribute", sym->name, &e->where); + goto cleanup; + } + } + first_actual_arg = false; } diff --git a/gcc/testsuite/gfortran.dg/actual_procedure_2.f b/gcc/testsuite/gfortran.dg/actual_procedure_2.f new file mode 100644 index 000000000000..247ebc1d9e37 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/actual_procedure_2.f @@ -0,0 +1,22 @@ +! { dg-do compile } +! PR fortran/50377 +! +! Reject procedures passed as actual argument if there is no explicit +! interface and they are not declared EXTERNAL +! +! Contributed by Vittorio Zecca + +! external sub ! Required for valid code +! external fun ! Required for valid code + call sub(sub) ! { dg-error "used as actual argument" } + z = fun(fun) ! { dg-error "used as actual argument" } + end + + subroutine sub(y) + external y + end + + real function fun(z) + external z + f = 1. + end diff --git a/gcc/testsuite/gfortran.dg/pr41011.f b/gcc/testsuite/gfortran.dg/pr41011.f index c0323102a0c7..376ae8b0e41c 100644 --- a/gcc/testsuite/gfortran.dg/pr41011.f +++ b/gcc/testsuite/gfortran.dg/pr41011.f @@ -1,5 +1,7 @@ ! { dg-do compile } ! { dg-options "-O3 -std=legacy" } + SUBROUTINE PR41011 (DCDX) + DIMENSION DCDX(*) CALL UVSET(NX,NY,NZ,HVAR,ZET,NP,DZ,DKM,UM,VM,UG,VG,TM,DCDX, ! { dg-warning "Rank mismatch|Invalid procedure argument" } *ITY,ISH,NSMT,F) CALL DCTDX(NX,NY,NX1,NFILT,C(MLAG),DCDX(MLAG),HELP,HELPA,
