Dear All, here's a proposed fix for another 14 year old diagnostics bug. We did not properly check procedures passed as actual argument whether they are declared EXTERNAL or have an explicit interface.
Since I am not sure if there is some legacy code out there that relies on the old bug, we'll generate a warning for -std=legacy but an error by default. (There's an existing testcase pr41011 whose provenance I do not know but which looks like legacy.) Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald
From 52ee235811442e9331a6fba6482d3be59364bace Mon Sep 17 00:00:00 2001 From: Harald Anlauf <[email protected]> Date: Fri, 10 Oct 2025 22:02:51 +0200 Subject: [PATCH] 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. --- gcc/fortran/resolve.cc | 24 +++++++++++++++++++ .../gfortran.dg/actual_procedure_2.f | 22 +++++++++++++++++ gcc/testsuite/gfortran.dg/pr41011.f | 2 ++ 3 files changed, 48 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/actual_procedure_2.f diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 75270064ed4..4c45de08f03 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 00000000000..247ebc1d9e3 --- /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 c0323102a0c..376ae8b0e41 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, -- 2.51.0
