See attached patch,
This one was buried in my worktree. I started working on TEAM stuff and
rediscovered it.
Regression tested on x86_64.
OK for mainline?
Regards,
Jerry
---
fortran: [PR103474] Fix ICEs for the cobounds of a subobject
of a coarray
F2018:5.4.7(5) makes a subobject of a coarray a coarray with the same
codimensions, unless it is reached through a cosubscript, an image
selector, or an allocatable or pointer component selector. Querying the
cobounds of such a subobject, as in LCOBOUND (X%A), reached three places
that were not prepared for it, and a coarray whose declaration had already
been rejected reached a fourth.
PR fortran/103474
gcc/fortran/ChangeLog:
* simplify.cc (simplify_cobound): Take the array spec from the
base symbol, using its class data for a CLASS coarray, so that a
subobject of a coarray finds the codimensions. Return NULL for a
symbol already flagged as erroneous and in place of the two
gcc_unreachable calls reached on invalid code.
* resolve.cc (gfc_expression_rank): Track the reference carrying
the codimensions and take the corank from it rather than from the
last array reference. Clear it at an allocatable or pointer
component selector, which ends the coarray.
* trans-intrinsic.cc (strip_subobject_of_coarray): New function.
Return a copy of the expression cut back to the reference carrying
the codimensions.
(conv_intrinsic_cobound, trans_this_image, trans_image_index): Use
it, so that the descriptor queried for the cobounds is that of the
coarray and not that of a component of it.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray_52.f90: New test.
* gfortran.dg/coarray/cobounds_subobject_1.f90: New test.
---From ce53a20cc85be3938e8f08d854699a26645925da Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Sun, 9 Aug 2026 20:22:58 -0700
Subject: [PATCH] fortran: [PR103474] Fix ICEs for the cobounds of a subobject
of a coarray
F2018:5.4.7(5) makes a subobject of a coarray a coarray with the same
codimensions, unless it is reached through a cosubscript, an image
selector, or an allocatable or pointer component selector. Querying the
cobounds of such a subobject, as in LCOBOUND (X%A), reached three places
that were not prepared for it, and a coarray whose declaration had already
been rejected reached a fourth.
PR fortran/103474
gcc/fortran/ChangeLog:
* simplify.cc (simplify_cobound): Take the array spec from the
base symbol, using its class data for a CLASS coarray, so that a
subobject of a coarray finds the codimensions. Return NULL for a
symbol already flagged as erroneous and in place of the two
gcc_unreachable calls reached on invalid code.
* resolve.cc (gfc_expression_rank): Track the reference carrying
the codimensions and take the corank from it rather than from the
last array reference. Clear it at an allocatable or pointer
component selector, which ends the coarray.
* trans-intrinsic.cc (strip_subobject_of_coarray): New function.
Return a copy of the expression cut back to the reference carrying
the codimensions.
(conv_intrinsic_cobound, trans_this_image, trans_image_index): Use
it, so that the descriptor queried for the cobounds is that of the
coarray and not that of a component of it.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray_52.f90: New test.
* gfortran.dg/coarray/cobounds_subobject_1.f90: New test.
---
gcc/fortran/resolve.cc | 46 +++++++----
gcc/fortran/simplify.cc | 22 +++---
gcc/fortran/trans-intrinsic.cc | 76 +++++++++++++++----
.../coarray/cobounds_subobject_1.f90 | 54 +++++++++++++
gcc/testsuite/gfortran.dg/coarray_52.f90 | 17 +++++
5 files changed, 179 insertions(+), 36 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/cobounds_subobject_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/coarray_52.f90
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 249b4b4f253..a43de5f6171 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -6344,7 +6344,7 @@ fail:
void
gfc_expression_rank (gfc_expr *e)
{
- gfc_ref *ref, *last_arr_ref = nullptr;
+ gfc_ref *ref, *coarray_ref = nullptr;
int i, rank, corank;
/* Just to make sure, because EXPR_COMPCALL's also have an e->ref and that
@@ -6389,10 +6389,27 @@ gfc_expression_rank (gfc_expr *e)
corank = ref->u.c.component->as ? ref->u.c.component->as->corank : 0;
}
+ /* F2018:5.4.7(5): an allocatable or pointer component selector ends the
+ codimensions inherited from an enclosing coarray. */
+ if (ref->type == REF_COMPONENT)
+ {
+ gfc_component *comp = ref->u.c.component;
+
+ if (comp->ts.type == BT_CLASS && comp->attr.class_ok)
+ {
+ if (CLASS_DATA (comp)->attr.class_pointer
+ || CLASS_DATA (comp)->attr.allocatable)
+ coarray_ref = nullptr;
+ }
+ else if (comp->attr.pointer || comp->attr.allocatable)
+ coarray_ref = nullptr;
+ }
+
if (ref->type != REF_ARRAY)
continue;
- last_arr_ref = ref;
+ if (!coarray_ref && ref->u.ar.as && ref->u.ar.as->corank > 0)
+ coarray_ref = ref;
if (ref->u.ar.type == AR_FULL && ref->u.ar.as)
{
rank = ref->u.ar.as->rank;
@@ -6413,25 +6430,26 @@ gfc_expression_rank (gfc_expr *e)
break;
}
}
- if (last_arr_ref && last_arr_ref->u.ar.as
- && last_arr_ref->u.ar.as->rank != -1)
+ /* The codimensions come from the reference carrying them, which need not be
+ the last array reference: a subobject of a coarray is itself a coarray. */
+ if (coarray_ref && coarray_ref->u.ar.as->rank != -1)
{
- for (i = last_arr_ref->u.ar.as->rank;
- i < last_arr_ref->u.ar.as->rank + last_arr_ref->u.ar.as->corank; ++i)
+ for (i = coarray_ref->u.ar.as->rank;
+ i < coarray_ref->u.ar.as->rank + coarray_ref->u.ar.as->corank; ++i)
{
/* For unknown dimen in non-resolved as assume full corank. */
- if (last_arr_ref->u.ar.dimen_type[i] == DIMEN_STAR
- || (last_arr_ref->u.ar.dimen_type[i] == DIMEN_UNKNOWN
- && !last_arr_ref->u.ar.as->resolved))
+ if (coarray_ref->u.ar.dimen_type[i] == DIMEN_STAR
+ || (coarray_ref->u.ar.dimen_type[i] == DIMEN_UNKNOWN
+ && !coarray_ref->u.ar.as->resolved))
{
- corank = last_arr_ref->u.ar.as->corank;
+ corank = coarray_ref->u.ar.as->corank;
break;
}
- else if (last_arr_ref->u.ar.dimen_type[i] == DIMEN_RANGE
- || last_arr_ref->u.ar.dimen_type[i] == DIMEN_VECTOR
- || last_arr_ref->u.ar.dimen_type[i] == DIMEN_THIS_IMAGE)
+ else if (coarray_ref->u.ar.dimen_type[i] == DIMEN_RANGE
+ || coarray_ref->u.ar.dimen_type[i] == DIMEN_VECTOR
+ || coarray_ref->u.ar.dimen_type[i] == DIMEN_THIS_IMAGE)
corank++;
- else if (last_arr_ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
+ else if (coarray_ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
gfc_internal_error ("Illegal coarray index");
}
}
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 3340a20e227..b1448a8f684 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -4816,15 +4816,22 @@ simplify_cobound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
{
gfc_ref *ref;
gfc_array_spec *as;
+ gfc_symbol *sym;
int d;
if (array->expr_type != EXPR_VARIABLE)
return NULL;
- /* Follow any component references. */
- as = (array->ts.type == BT_CLASS && CLASS_DATA (array))
- ? CLASS_DATA (array)->as
- : array->symtree->n.sym->as;
+ /* Do not attempt to resolve if an error has already been issued. */
+ if (array->symtree->n.sym->error)
+ return NULL;
+
+ /* Follow any component references, starting from the base symbol's array
+ spec; ARRAY itself may be a subobject of the coarray. */
+ sym = array->symtree->n.sym;
+ as = (sym->ts.type == BT_CLASS && sym->attr.class_ok && CLASS_DATA (sym))
+ ? CLASS_DATA (sym)->as
+ : sym->as;
for (ref = array->ref; ref; ref = ref->next)
{
switch (ref->type)
@@ -4835,7 +4842,7 @@ simplify_cobound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
case AR_ELEMENT:
if (ref->u.ar.as->corank > 0)
{
- gcc_assert (as == ref->u.ar.as);
+ as = ref->u.ar.as;
goto done;
}
as = NULL;
@@ -4866,12 +4873,9 @@ simplify_cobound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
}
}
- if (!as)
- gcc_unreachable ();
-
done:
- if (as->cotype == AS_DEFERRED || as->cotype == AS_ASSUMED_SHAPE)
+ if (!as || as->cotype == AS_DEFERRED || as->cotype == AS_ASSUMED_SHAPE)
return NULL;
if (dim == NULL)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 20516640656..4761195bf50 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1820,12 +1820,50 @@ conv_caf_sendget (gfc_code *code)
}
+/* F2018:5.4.7(5): a subobject of a coarray is a coarray with the codimensions
+ of that coarray. Return a copy of E cut back to the reference carrying the
+ codimensions, so that the descriptor built for it holds the cobounds. */
+
+static gfc_expr *
+strip_subobject_of_coarray (gfc_expr *e)
+{
+ gfc_expr *coarray;
+ gfc_ref *ref;
+ gfc_typespec ts;
+
+ ts = e->symtree->n.sym->ts;
+ for (ref = e->ref; ref; ref = ref->next)
+ {
+ if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+ break;
+ if (ref->type == REF_COMPONENT)
+ ts = ref->u.c.component->ts;
+ }
+
+ coarray = gfc_copy_expr (e);
+ if (!ref || !ref->next)
+ return coarray;
+
+ for (ref = coarray->ref; ref; ref = ref->next)
+ if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+ break;
+
+ gfc_free_ref_list (ref->next);
+ ref->next = NULL;
+ coarray->ts = ts;
+ gfc_expression_rank (coarray);
+
+ return coarray;
+}
+
+
static void
trans_this_image (gfc_se * se, gfc_expr *expr)
{
stmtblock_t loop;
tree type, desc, dim_arg, cond, tmp, m, loop_var, exit_label, min_var, lbound,
ubound, extent, ml, team;
+ gfc_expr *coarray;
gfc_se argse;
int rank, corank;
@@ -1857,16 +1895,19 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
/* Coarray-argument version: THIS_IMAGE(coarray [, dim]). */
type = gfc_get_int_type (gfc_default_integer_kind);
- corank = expr->value.function.actual->expr->corank;
- rank = expr->value.function.actual->expr->rank;
+
+ coarray = strip_subobject_of_coarray (expr->value.function.actual->expr);
+ corank = coarray->corank;
+ rank = coarray->rank;
/* Obtain the descriptor of the COARRAY. */
gfc_init_se (&argse, NULL);
argse.want_coarray = 1;
- gfc_conv_expr_descriptor (&argse, expr->value.function.actual->expr);
+ gfc_conv_expr_descriptor (&argse, coarray);
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
desc = argse.expr;
+ gfc_free_expr (coarray);
if (se->ss)
{
@@ -2118,20 +2159,24 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
{
tree num_images, cond, coindex, type, lbound, ubound, desc, subdesc, tmp,
invalid_bound, team = null_pointer_node, team_number = null_pointer_node;
+ gfc_expr *coarray;
gfc_se argse, subse;
int rank, corank, codim;
type = gfc_get_int_type (gfc_default_integer_kind);
- corank = expr->value.function.actual->expr->corank;
- rank = expr->value.function.actual->expr->rank;
+
+ coarray = strip_subobject_of_coarray (expr->value.function.actual->expr);
+ corank = coarray->corank;
+ rank = coarray->rank;
/* Obtain the descriptor of the COARRAY. */
gfc_init_se (&argse, NULL);
argse.want_coarray = 1;
- gfc_conv_expr_descriptor (&argse, expr->value.function.actual->expr);
+ gfc_conv_expr_descriptor (&argse, coarray);
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
desc = argse.expr;
+ gfc_free_expr (coarray);
/* Obtain a handle to the SUB argument. */
gfc_init_se (&subse, NULL);
@@ -2628,6 +2673,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
{
gfc_actual_arglist *arg;
gfc_actual_arglist *arg2;
+ gfc_expr *coarray;
gfc_se argse;
tree bound, lbound, resbound, resbound2, desc, cond, tmp;
tree type;
@@ -2642,12 +2688,14 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
arg2 = arg->next;
gcc_assert (arg->expr->expr_type == EXPR_VARIABLE);
- corank = arg->expr->corank;
+
+ coarray = strip_subobject_of_coarray (arg->expr);
+ corank = coarray->corank;
gfc_init_se (&argse, NULL);
argse.want_coarray = 1;
- gfc_conv_expr_descriptor (&argse, arg->expr);
+ gfc_conv_expr_descriptor (&argse, coarray);
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
desc = argse.expr;
@@ -2663,7 +2711,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
bound = fold_convert_loc (input_location, gfc_array_dim_rank_type,
se->loop->loopvar[0]);
- tree rank = gfc_rank_cst[arg->expr->rank];
+ tree rank = gfc_rank_cst[coarray->rank];
bound = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_dim_rank_type, bound, rank);
gfc_advance_se_ss_chain (se);
@@ -2703,7 +2751,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
/* Subtract 1 to get to zero based and add dimensions. */
- switch (arg->expr->rank)
+ switch (coarray->rank)
{
case 0:
bound = fold_build2_loc (input_location, MINUS_EXPR,
@@ -2713,7 +2761,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
break;
default:
{
- tree rank = gfc_rank_cst[arg->expr->rank - 1];
+ tree rank = gfc_rank_cst[coarray->rank - 1];
bound = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_dim_rank_type, bound, rank);
}
@@ -2744,7 +2792,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
{
tree cosize;
- cosize = gfc_conv_descriptor_cosize (desc, arg->expr->rank, corank);
+ cosize = gfc_conv_descriptor_cosize (desc, coarray->rank, corank);
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
2, null_pointer_node, null_pointer_node);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
@@ -2775,7 +2823,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
bound,
build_int_cst (TREE_TYPE (bound),
- arg->expr->rank + corank - 1));
+ coarray->rank + corank - 1));
resbound2 = gfc_conv_descriptor_ubound_get (desc, bound);
se->expr = fold_build3_loc (input_location, COND_EXPR,
@@ -2802,6 +2850,8 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
type = gfc_typenode_for_spec (&expr->ts);
se->expr = convert (type, se->expr);
+
+ gfc_free_expr (coarray);
}
diff --git a/gcc/testsuite/gfortran.dg/coarray/cobounds_subobject_1.f90 b/gcc/testsuite/gfortran.dg/coarray/cobounds_subobject_1.f90
new file mode 100644
index 00000000000..418c652bf12
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/cobounds_subobject_1.f90
@@ -0,0 +1,54 @@
+! { dg-do run }
+!
+! PR fortran/103474
+!
+! F2018:5.4.7(5) - a subobject of a coarray is a coarray with the
+! codimensions of that coarray. Check LCOBOUND, UCOBOUND, COSHAPE,
+! THIS_IMAGE and IMAGE_INDEX applied to a component of a coarray.
+!
+! Contributed by G. Steinmetz <[email protected]>
+
+program cobounds_subobject_1
+ type t
+ integer :: a
+ integer :: b(2)
+ integer :: c(1,2)
+ end type
+
+ type(t), save :: u[2,3:*]
+ type(t), save :: v(4)[5:*]
+ type(t), allocatable :: y[:,:]
+ class(t), allocatable :: x[:]
+ class(t), allocatable :: z(:)[:]
+
+ ! Explicit cobounds are simplified at compile time.
+ if (lcobound (u%a, dim=1) /= 1) stop 1
+ if (lcobound (u%b, dim=2) /= 3) stop 2
+ if (ucobound (u%b, dim=1) /= 2) stop 3
+ if (lcobound (v(1)%b, dim=1) /= 5) stop 4
+
+ if (any (lcobound (u%c) /= lcobound (u))) stop 5
+ if (any (lcobound (v(2)%b) /= lcobound (v))) stop 6
+ if (any (ucobound (v(2)%b) /= ucobound (v))) stop 7
+ if (any (this_image (u%b) /= this_image (u))) stop 8
+ if (any (coshape (u%c) /= coshape (u))) stop 9
+
+ ! Deferred cobounds are resolved at run time.
+ allocate (x[3:*])
+ allocate (y[2,3:*])
+ allocate (z(2)[3:*])
+
+ if (any (lcobound (x%a) /= lcobound (x))) stop 10
+ if (any (lcobound (x%b) /= [3])) stop 11
+ if (any (ucobound (x%c) /= ucobound (x))) stop 12
+ if (any (lcobound (y%b) /= lcobound (y))) stop 13
+ if (any (ucobound (y%b) /= ucobound (y))) stop 14
+ if (any (lcobound (z(1)%b) /= lcobound (z))) stop 15
+ if (any (ucobound (z(1)%b) /= ucobound (z))) stop 16
+ if (lcobound (y%c, dim=2) /= lcobound (y, dim=2)) stop 17
+ if (ucobound (y%c, dim=1) /= ucobound (y, dim=1)) stop 18
+ if (any (this_image (x%b) /= this_image (x))) stop 19
+ if (any (this_image (y%c) /= this_image (y))) stop 20
+ if (any (coshape (y%b) /= coshape (y))) stop 21
+ if (image_index (y%b, [1,3]) /= image_index (y, [1,3])) stop 22
+end program
diff --git a/gcc/testsuite/gfortran.dg/coarray_52.f90 b/gcc/testsuite/gfortran.dg/coarray_52.f90
new file mode 100644
index 00000000000..120062ab81e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_52.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/103474
+!
+! ICE in simplify_cobound on a coarray whose declaration was rejected.
+!
+! Contributed by G. Steinmetz <[email protected]>
+
+program p
+ type t
+ integer :: a
+ end type
+ class(t) :: x[:] ! { dg-error "shall not have codimensions with deferred shape" }
+ print *, ucobound (x)
+ if (any (lcobound (x) < 1)) stop
+end
--
2.55.0
