[gcc r14-12804] Fortran: Fix module proc with array valued dummy procedure [PR123952]

https://gcc.gnu.org/g:ee3ccfd4552398c366d6704474fec1695e2399dc

commit r14-12804-gee3ccfd4552398c366d6704474fec1695e2399dc
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.
    
    (cherry picked from commit 7c4d1a6a78e45e3a9fee21b09ad664346ede25a2)

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 048e81dc666f..422814e2eaca 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -2218,6 +2218,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