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

commit r16-9186-gc5367155f20de603d8975328c36cc39b114309f0
Author: Paul Thomas <[email protected]>
Date:   Fri May 8 06:34:21 2026 +0100

    Fortran: Allow access to coarray elements within modules. [PR125051]
    
    The parts of this patch is fix the problem are chunks 2 and 3. Chunk3 
prevents
    gfc_conv_intrinsic_caf_get from working in the module namespace, when the 
array
    symbol is in a module. Equally, though, gfc_current_ns is not necessarily in
    the referencing procedure namespace. The second chunk makes sure that this 
is
    the case. As an aside, it seems to us that it makes considerably more sense 
that
    gfc_current_ns be that of the current procedure. The first chunk makes sure 
that
    result symbol initialization does not occur outside the function.
    
    Passes regtesting with FC44/x86_64.
    
    2026-05-10  Andre Vehreschild  <[email protected]>
                Paul Thomas  <[email protected]>
    
    gcc/fortran
            PR fortran/125051
            * trans-decl.cc (gfc_get_symbol_decl): gfc_defer_symbol_init
            must not be called for PDT types, classes or types with PDT
            (gfc_generate_function_code): If gfc_current_ns is not the same
            as the function namespace, stash it,change it to the function
            namespace and restore after translation of the code.
            * trans-intrinsic.cc (gfc_conv_intrinsic_caf_get): If the array
            is in a module, use the symbol namespace.
            * trans-openmp.cc (gfc_trans_omp_array_reduction_or_udr): If the
            current namespace is not that of the procedure, change to the
            procedure namspace and revert on leaving this function.
    
    gcc/testsuite/
            PR fortran/125051
            * gfortran.dg/coarray/pr125051.f90: New test.
    
    (cherry picked from commit 3e281ae5d6a814585b884d693ef354e75bf12be7)

Diff:
---
 gcc/fortran/trans-decl.cc                      | 15 +++++++++---
 gcc/fortran/trans-intrinsic.cc                 |  1 +
 gcc/fortran/trans-openmp.cc                    |  7 ++++++
 gcc/testsuite/gfortran.dg/coarray/pr125051.f90 | 34 ++++++++++++++++++++++++++
 4 files changed, 54 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 4e691199f812..ee33616556cd 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1707,14 +1707,14 @@ gfc_get_symbol_decl (gfc_symbol * sym)
       && (gfc_current_ns == sym->ns
          || (gfc_current_ns == sym->ns->parent
              && gfc_current_ns->proc_name->attr.flavor != FL_MODULE))
-      && !(sym->attr.use_assoc || sym->attr.dummy))
+      && !(sym->attr.use_assoc || sym->attr.dummy || sym->attr.result))
     gfc_defer_symbol_init (sym);
 
   if ((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.pdt_comp)
       && (gfc_current_ns == sym->ns
          || (gfc_current_ns == sym->ns->parent
              && gfc_current_ns->proc_name->attr.flavor != FL_MODULE))
-      && !(sym->attr.use_assoc || sym->attr.dummy))
+      && !(sym->attr.use_assoc || sym->attr.dummy || sym->attr.result))
     gfc_defer_symbol_init (sym);
 
   /* Dummy PDT 'len' parameters should be checked when they are explicit.  */
@@ -8311,7 +8311,16 @@ gfc_generate_function_code (gfc_namespace * ns)
 
   finish_oacc_declare (ns, sym, false);
 
-  tmp = gfc_trans_code (ns->code);
+  if (gfc_current_ns != ns)
+    {
+      gfc_namespace *old_current_ns = gfc_current_ns;
+      gfc_current_ns = ns;
+      tmp = gfc_trans_code (ns->code);
+      gfc_current_ns = old_current_ns;
+    }
+  else
+    tmp = gfc_trans_code (ns->code);
+
   gfc_add_expr_to_block (&body, tmp);
 
   /* This permits the return value to be correctly initialized, even when the
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 898f5a911495..9bb39597f40a 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1238,6 +1238,7 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, 
tree lhs,
   array_expr = expr->value.function.actual->expr;
   ns = array_expr->expr_type == EXPR_VARIABLE
           && !array_expr->symtree->n.sym->attr.associate_var
+          && !array_expr->symtree->n.sym->module
         ? array_expr->symtree->n.sym->ns
         : gfc_current_ns;
   type = gfc_typenode_for_spec (&array_expr->ts);
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 538ba0455304..b9c09d114b73 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -2917,6 +2917,11 @@ gfc_trans_omp_array_reduction_or_udr (tree c, 
gfc_omp_namelist *n, locus where)
   const char *iname;
   bool t;
   gfc_omp_udr *udr = n->u2.udr ? n->u2.udr->udr : NULL;
+  gfc_namespace *old_ns = gfc_current_ns;
+
+  if (gfc_current_ns->proc_name
+      && gfc_current_ns->proc_name->ns != gfc_current_ns)
+    gfc_current_ns = gfc_current_ns->proc_name->ns;
 
   decl = OMP_CLAUSE_DECL (c);
   gfc_current_locus = where;
@@ -3199,6 +3204,8 @@ gfc_trans_omp_array_reduction_or_udr (tree c, 
gfc_omp_namelist *n, locus where)
          *udr->omp_orig = omp_var_copy[3];
        }
     }
+
+  gfc_current_ns = old_ns;
 }
 
 static tree
diff --git a/gcc/testsuite/gfortran.dg/coarray/pr125051.f90 
b/gcc/testsuite/gfortran.dg/coarray/pr125051.f90
new file mode 100644
index 000000000000..9097340b706d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/pr125051.f90
@@ -0,0 +1,34 @@
+!{ dg-do link }
+
+! Contributed by Paul Thomas  <[email protected]>
+! Check PR fortran/125051 is fixed.
+
+module m
+  integer, parameter :: ncells = 8, nsize = ncells+2
+  integer, parameter :: head =2, tail = ncells + 1
+  real :: second_derivative(ncells+2, ncells+2)
+  type :: density_t
+    real :: density(nsize)
+    real:: derivative(nsize)
+  end type
+  type (density_t) :: n[*]
+  real :: n_tail[*] = 0.0
+  real :: n_head[*] = 0.0
+contains
+  subroutine sub
+    integer :: image_no
+    image_no = this_image()
+    sync all
+    if (image_no > 1) n_head = n[image_no -1]%density(tail)
+    if (image_no < num_images()) n_tail = n[image_no +1]%density(head)
+    sync all
+  end
+end module
+
+program main
+  use m
+  implicit none
+  call sub
+contains
+end program
+

Reply via email to