https://gcc.gnu.org/g:887ddb4d8c3ddd27c3a5cfd79f21dd52403c82fa
commit r15-9934-g887ddb4d8c3ddd27c3a5cfd79f21dd52403c82fa Author: Andre Vehreschild <ve...@gcc.gnu.org> Date: Fri Jun 27 14:39:13 2025 +0200 Fortran: Fix non-conformable corank on this_image ref [PR120843] PR fortran/120843 gcc/fortran/ChangeLog: * resolve.cc (resolve_operator): Report inconsistent coranks only when not referencing this_image. (gfc_op_rank_conformable): Treat coranks as inconformable only when a coindex other then implicit this_image is used. gcc/testsuite/ChangeLog: * gfortran.dg/coarray/coindexed_6.f90: New test. (cherry picked from commit 1b0930e9046e0b6201fa03c2843f3b06e522acd1) Diff: --- gcc/fortran/resolve.cc | 7 ++++--- gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90 | 17 +++++++++++++++++ 2 files changed, 21 insertions(+), 3 deletions(-) diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index ee5b22a728d4..2fbe7c451428 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -4828,7 +4828,8 @@ resolve_operator (gfc_expr *e) if (e->shape == NULL) e->shape = gfc_copy_shape (op2->shape, op2->corank); } - else + else if ((op1->ref && !gfc_ref_this_image (op1->ref)) + || (op2->ref && !gfc_ref_this_image (op2->ref))) { gfc_error ("Inconsistent coranks for operator at %L and %L", &op1->where, &op2->where); @@ -6070,8 +6071,8 @@ gfc_op_rank_conformable (gfc_expr *op1, gfc_expr *op2) gfc_expression_rank (op2); return (op1->rank == 0 || op2->rank == 0 || op1->rank == op2->rank) - && (op1->corank == 0 || op2->corank == 0 - || op1->corank == op2->corank); + && (op1->corank == 0 || op2->corank == 0 || op1->corank == op2->corank + || (!gfc_is_coindexed (op1) && !gfc_is_coindexed (op2))); } /* Resolve a variable expression. */ diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90 new file mode 100644 index 000000000000..8f5dcabb859a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90 @@ -0,0 +1,17 @@ +!{ dg-do compile } + +! Check PR120843 is fixed + +program p + implicit none + + integer, allocatable :: arr(:,:) [:,:] + integer :: c[*] + + c = 7 + + allocate(arr(4,3)[2,*], source=6) + + if (arr(2,2)* c /= 42) stop 1 + +end program p