https://gcc.gnu.org/g:053bde6ca9b490c6426740f8e3168054c4a43463
commit r17-1343-g053bde6ca9b490c6426740f8e3168054c4a43463 Author: Paul Thomas <[email protected]> Date: Thu Jun 4 11:55:50 2026 +0100 Fortran: fix always_explicit not copied by gfc_copy_attr [PR121204] gfc_copy_attr omitted the always_explicit attribute, so when gfc_copy_dummy_sym created a fresh copy of a dummy procedure symbol in a submodule module procedure (gfc_match_submod_proc), the flag was silently lost. At translation time nodesc_arg was set true for calls through that dummy procedure, causing array constructors to be passed as raw data pointers instead of array descriptors. Callers with assumed-shape dummy arguments then read garbage bounds. 2026-06-04 Paul Thomas <[email protected]> gcc/fortran PR fortran/121204 * symbol.cc (gfc_copy_attr): Copy the always_explicit attribute. gcc/testsuite PR fortran/121204 * gfortran.dg/submodule_38.f90: New test. Co-Authored-By: Claude Sonnet 4.6 <[email protected]> Diff: --- gcc/fortran/symbol.cc | 2 ++ gcc/testsuite/gfortran.dg/submodule_38.f90 | 38 ++++++++++++++++++++++++++++++ 2 files changed, 40 insertions(+) diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc index 26e4b40d48e3..d2e93755c537 100644 --- a/gcc/fortran/symbol.cc +++ b/gcc/fortran/symbol.cc @@ -2224,6 +2224,8 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where) goto fail; if (src->recursive && !gfc_add_recursive (dest, where)) goto fail; + if (src->always_explicit) + dest->always_explicit = 1; if (src->flavor != FL_UNKNOWN && !gfc_add_flavor (dest, src->flavor, NULL, where)) diff --git a/gcc/testsuite/gfortran.dg/submodule_38.f90 b/gcc/testsuite/gfortran.dg/submodule_38.f90 new file mode 100644 index 000000000000..ac80e2bddda9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/submodule_38.f90 @@ -0,0 +1,38 @@ +! { dg-do run } +! +! Test fix for a bug where the always_explicit attribute was not copied +! by gfc_copy_attr, causing array descriptors not to be passed when +! calling a dummy procedure with an assumed-shape argument from a +! submodule module procedure. +! +module test_m + implicit none (type, external) + interface + module subroutine call_proc (proc) + interface + subroutine proc (a) + real, intent(in) :: a(:) + end subroutine proc + end interface + end subroutine call_proc + end interface +end module test_m + +submodule (test_m) test_sm + implicit none (type, external) +contains + module procedure call_proc + call proc ([1., 2., .3]) + end procedure call_proc +end submodule test_sm + +program test + use test_m + implicit none (type, external) + call call_proc (print_proc) +contains + subroutine print_proc (a) + real, intent(in) :: a(:) + if (size (a, 1) /= 3) stop 1 + end subroutine print_proc +end program test
