https://gcc.gnu.org/g:7c4d1a6a78e45e3a9fee21b09ad664346ede25a2
commit r16-7266-g7c4d1a6a78e45e3a9fee21b09ad664346ede25a2 Author: Paul Thomas <[email protected]> Date: Tue Feb 3 18:00:54 2026 +0000 Fortran: Fix module proc with array valued dummy procedure [PR123952] 2026-01-14 Paul Thomas <[email protected]> gcc/fortran PR fortran/123952 * symbol.cc (gfc_copy_dummy_sym): Ensure that external, array valued destination symbols have the correct interface so that conflicts do not arise when adding attributes. gcc/testsuite PR fortran/123952 * gfortran.dg/pr123952.f90: New test. Diff: --- gcc/fortran/symbol.cc | 4 ++++ gcc/testsuite/gfortran.dg/pr123952.f90 | 35 ++++++++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+) diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc index 0f04cfea16ee..d521bf1012b6 100644 --- a/gcc/fortran/symbol.cc +++ b/gcc/fortran/symbol.cc @@ -2284,6 +2284,10 @@ gfc_copy_dummy_sym (gfc_symbol **dsym, gfc_symbol *sym, int result) if (!gfc_add_type (*dsym, &(sym->ts), &gfc_current_locus)) return 1; + if (sym->attr.external + && (sym->attr.codimension || sym->attr.dimension)) + (*dsym)->attr.if_source = IFSRC_DECL; + if (!gfc_copy_attr (&(*dsym)->attr, &(sym->attr), &gfc_current_locus)) return 1; diff --git a/gcc/testsuite/gfortran.dg/pr123952.f90 b/gcc/testsuite/gfortran.dg/pr123952.f90 new file mode 100644 index 000000000000..54be1b0385fe --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr123952.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } +! +! Test the fix for PR123952, which failed as below. +! +! Contributed by Damian.Rouson <[email protected]> +! +module tensors_1D_m + abstract interface + function scalar_1D_initializer_i() result(f) + double precision, allocatable :: f(:) + end function + end interface + + type :: scalar_1D_t + integer gradient_operator_1D_ + end type + + interface scalar_1D_t + module function construct_1D_scalar_from_function(initializer) result(scalar_1D) + procedure(scalar_1D_initializer_i), pointer :: initializer + type(scalar_1D_t) scalar_1D + end function + end interface + +end module tensors_1D_m + +submodule(tensors_1D_m) scalar_1D_s +contains + + module procedure construct_1D_scalar_from_function ! "MODULE PROCEDURE at (1) must be + ! in a generic module interface" + scalar_1D = scalar_1D_t (42) ! "Unexpected assignment statement..." + end procedure ! "Expecting END SUBMODULE statement at (1)" + +end submodule scalar_1D_s
