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
