https://gcc.gnu.org/g:35dec12b401e1e99df7219542db057e59dbefd02
commit r17-3936-g35dec12b401e1e99df7219542db057e59dbefd02 Author: Jerry DeLisle <[email protected]> Date: Mon Aug 10 16:18:42 2026 -0700 fortran: [PR126777] Fix ICE for IMAGE_INDEX with a TEAM argument trans_image_index translated the scalar TEAM/TEAM_NUMBER argument with gfc_conv_expr_descriptor, which routes rank-0 expressions to walk_coarray and asserts there. Use gfc_conv_expr_val, as trans_num_images and trans_this_image already do. PR fortran/126777 Assisted-by: Claude Opus 5 gcc/fortran/ChangeLog: PR fortran/126777 * trans-intrinsic.cc (trans_image_index): Translate the team argument with gfc_conv_expr_val. (trans_num_images): Force the team_number lvalue into the argument block, not the enclosing one. gcc/testsuite/ChangeLog: PR fortran/126777 * gfortran.dg/coarray/image_index_team_1.f90: New test. Diff: --- gcc/fortran/trans-intrinsic.cc | 5 ++- .../gfortran.dg/coarray/image_index_team_1.f90 | 36 ++++++++++++++++++++++ 2 files changed, 38 insertions(+), 3 deletions(-) diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index b953746d1cd4..205166406567 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -2144,8 +2144,7 @@ trans_image_index (gfc_se * se, gfc_expr *expr) if (expr->value.function.actual->next->next->expr) { gfc_init_se (&argse, NULL); - gfc_conv_expr_descriptor (&argse, - expr->value.function.actual->next->next->expr); + gfc_conv_expr_val (&argse, expr->value.function.actual->next->next->expr); if (expr->value.function.actual->next->next->expr->ts.type == BT_DERIVED) team = argse.expr; else @@ -2263,7 +2262,7 @@ trans_num_images (gfc_se * se, gfc_expr *expr) else team_number = gfc_build_addr_expr ( NULL_TREE, - gfc_trans_force_lval (&se->pre, + gfc_trans_force_lval (&argse.pre, fold_convert (integer_type_node, argse.expr))); gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->post, &argse.post); diff --git a/gcc/testsuite/gfortran.dg/coarray/image_index_team_1.f90 b/gcc/testsuite/gfortran.dg/coarray/image_index_team_1.f90 new file mode 100644 index 000000000000..0ff5476647f5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/image_index_team_1.f90 @@ -0,0 +1,36 @@ +! { dg-do run } +! +! PR fortran/126777 +! +! IMAGE_INDEX ICEd in walk_coarray when given a TEAM or TEAM_NUMBER +! argument. The allocatable coarray is not folded by +! gfc_simplify_image_index, so it reaches trans_image_index with +! -fcoarray=single as well. + +program image_index_team_1 + use iso_fortran_env, only : team_type + implicit none + + integer :: caf[*] + integer, allocatable :: acaf(:)[:] + type(team_type) :: t + integer :: n, tn, ref + + n = num_images () + t = get_team () + tn = team_number () + + ref = image_index (caf, [n]) + if (image_index (caf, [n], t) /= ref) stop 1 + if (image_index (caf, [n], get_team ()) /= ref) stop 2 + if (image_index (caf, [n], tn) /= ref) stop 3 + if (image_index (caf, [n], team_number ()) /= ref) stop 4 + + allocate (acaf(2)[*]) + ref = image_index (acaf, [n]) + if (image_index (acaf, [n], t) /= ref) stop 5 + if (image_index (acaf, [n], get_team ()) /= ref) stop 6 + if (image_index (acaf, [n], tn) /= ref) stop 7 + if (image_index (acaf, [n], team_number ()) /= ref) stop 8 + deallocate (acaf) +end program image_index_team_1
