]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: Fix non-conformable corank on this_image ref [PR120843]
authorAndre Vehreschild <vehre@gcc.gnu.org>
Fri, 27 Jun 2025 12:39:13 +0000 (14:39 +0200)
committerAndre Vehreschild <vehre@gcc.gnu.org>
Tue, 1 Jul 2025 09:16:50 +0000 (11:16 +0200)
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.

gcc/fortran/resolve.cc
gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90 [new file with mode: 0644]

index 58f7aee29c357dc51b31e1da1c2ecbc6292d0f37..50a6fe7fc52dabf03a957271d726cb246b9d14bc 100644 (file)
@@ -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 (file)
index 0000000..8f5dcab
--- /dev/null
@@ -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