Fortran: Fix module proc with array valued dummy procedure [PR123952]

2026-01-14  Paul Thomas  <pault@gcc.gnu.org>

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 --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 0f04cfea16ee55f6c567b65fdafe386c72ad49d7..d521bf1012b6eaad5bc2793b82ba87441bf399d2 100644 (file)
--- 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 (file)
index 0000000..54be1b0
--- /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  <damian@archaeologic.codes>
+!
+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