Thanks, Jerry and Harald! The more that I wrote to the .diff file, the less and less of the patch I saw. In the end, all that was left was half of the title line. I have never seen the likes before.
The attached should be complete. Paul On Thu, 7 May 2026 at 19:04, Paul Richard Thomas <[email protected]> wrote: > > Hello All, > > Please find attached the patch for the above PR, which is one of the > few bugs found so far in the shared memory implementation of coarrays. > > Passes regtesting on FC43/x86_64. OK for mainline and, after a decent > interval, backporting to 16-branch? > > Regards > > Paul (and Andre)
From e4c75e4ebb47643df8053e27c8eee9c1fa1a4f6b Mon Sep 17 00:00:00 2001 From: Paul Thomas <[email protected]> Date: Fri, 8 May 2026 06:34:21 +0100 Subject: [PATCH] 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-08 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 (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/pr125051.f90: New test. --- gcc/fortran/trans-decl.cc | 15 ++++++-- gcc/fortran/trans-intrinsic.cc | 1 + gcc/fortran/trans-openmp.cc | 7 ++++ .../gfortran.dg/coarray/pr125051.f90 | 34 +++++++++++++++++++ 4 files changed, 54 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/coarray/pr125051.f90 diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 4b3f75ced71..5e81d264906 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -1717,14 +1717,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. */ @@ -8300,7 +8300,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 dbf645886f5..391e8061db7 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 538ba045530..b9c09d114b7 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 00000000000..9097340b706 --- /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 + -- 2.54.0
