https://gcc.gnu.org/g:1f5c34702948eb7591fa3076be3745bd0e0ddf9c
commit r17-3149-g1f5c34702948eb7591fa3076be3745bd0e0ddf9c Author: Christopher Albert <[email protected]> Date: Thu Jul 30 05:06:45 2026 +0200 fortran: Preserve host association for dummy procedures [PR125383] A call statement marks an unresolved procedure as a subroutine before its procedure kind is known. was_declared treated that provisional attribute as a declaration, so resolution did not find an optional dummy procedure in the host scope. Require a known procedure kind before the subroutine attribute counts as a declaration. Fixes #24 Assisted-by: GPT-5.6-sol (OpenAI) PR fortran/125383 gcc/fortran/ChangeLog: * resolve.cc (was_declared): Require a known procedure kind for subroutine declarations. gcc/testsuite/ChangeLog: * gfortran.dg/pr125383.f90: New test. Signed-off-by: Christopher Albert <[email protected]> Diff: --- gcc/fortran/resolve.cc | 3 ++- gcc/testsuite/gfortran.dg/pr125383.f90 | 38 ++++++++++++++++++++++++++++++++++ 2 files changed, 40 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index bae889791df6..fd8c16d5a6e7 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -1655,7 +1655,8 @@ was_declared (gfc_symbol *sym) if (a.allocatable || a.dimension || a.dummy || a.external || a.intrinsic || a.optional || a.pointer || a.save || a.target || a.volatile_ || a.value || a.access != ACCESS_UNKNOWN || a.intent != INTENT_UNKNOWN - || a.asynchronous || a.codimension || a.subroutine || a.result) + || a.asynchronous || a.codimension + || (a.subroutine && a.proc != PROC_UNKNOWN) || a.result) return 1; return 0; diff --git a/gcc/testsuite/gfortran.dg/pr125383.f90 b/gcc/testsuite/gfortran.dg/pr125383.f90 new file mode 100644 index 000000000000..e4a579b56bf0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr125383.f90 @@ -0,0 +1,38 @@ +! { dg-do run } + +module callback_box + implicit none + integer :: result = -1 + + abstract interface + subroutine action(value) + integer, intent(in) :: value + end subroutine action + end interface +contains + subroutine invoke(maybe_action) + procedure(action), optional :: maybe_action + + call nested_invoke + contains + subroutine nested_invoke + if (present(maybe_action)) call maybe_action(17) + end subroutine nested_invoke + end subroutine invoke + + subroutine record_value(value) + integer, intent(in) :: value + + result = value + end subroutine record_value +end module callback_box + +program check_callback + use callback_box, only : invoke, record_value, result + implicit none + + call invoke + if (result /= -1) error stop 1 + call invoke(record_value) + if (result /= 17) error stop 2 +end program check_callback
