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  <vehre@gcc.gnu.org>
	    Paul Thomas  <pault@gcc.gnu.org>

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.

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index dcf4bbfdbf4f01bf5f4e630b56446af3f9a0ebb3..1bcbfdfd2c9782e172ef92bcb4f2f31b5e043db9 100644 (file)
--- 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.  */
@@ -8290,7 +8290,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 dbf645886f551647c0e688135224e15da462f2ee..391e8061db7bc8c04dc7fd26dc15f08f2fca2dd3 100644 (file)
--- 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 538ba04553042ae81a3f30d49a21cc67a2a72c11..b9c09d114b7385a216796603aa6cabd76de566b0 100644 (file)
--- 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 (file)
index 0000000..9097340
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/pr125051.f90
@@ -0,0 +1,34 @@
+!{ dg-do link }
+
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+! 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
+