]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: Remove corank conformability checks [PR120843]
authorAndre Vehreschild <vehre@gcc.gnu.org>
Wed, 2 Jul 2025 09:06:17 +0000 (11:06 +0200)
committerAndre Vehreschild <vehre@gcc.gnu.org>
Thu, 3 Jul 2025 09:39:48 +0000 (11:39 +0200)
Remove the checks on coranks conformability in expressions,
because there is nothing in the standard about it.  When a coarray
has no coindexes it it treated like a non-coarray, when it has
a full-corank coindex its result is a regular array.  So nothing
to check for corank conformability.

PR fortran/120843

gcc/fortran/ChangeLog:

* resolve.cc (resolve_operator): Remove conformability check,
because it is not in the standard.

gcc/testsuite/ChangeLog:

* gfortran.dg/coarray/coindexed_6.f90: Enhance test to have
coarray components covered.

gcc/fortran/resolve.cc
gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90

index 50a6fe7fc52dabf03a957271d726cb246b9d14bc..4a6e951cdf169407dec018c25ebdca2528398f94 100644 (file)
@@ -4807,35 +4807,6 @@ resolve_operator (gfc_expr *e)
              return false;
            }
        }
-
-      /* coranks have to be equal or one has to be zero to be combinable.  */
-      if (op1->corank == op2->corank || (op1->corank != 0 && op2->corank == 0))
-       {
-         e->corank = op1->corank;
-         /* Only do this, when regular array has not set a shape yet.  */
-         if (e->shape == NULL)
-           {
-             if (op1->corank != 0)
-               {
-                 e->shape = gfc_copy_shape (op1->shape, op1->corank);
-               }
-           }
-       }
-      else if (op1->corank == 0 && op2->corank != 0)
-       {
-         e->corank = op2->corank;
-         /* Only do this, when regular array has not set a shape yet.  */
-         if (e->shape == NULL)
-           e->shape = gfc_copy_shape (op2->shape, op2->corank);
-       }
-      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);
-         return false;
-       }
-
       break;
 
     case INTRINSIC_PARENTHESES:
index 8f5dcabb859a8623fee81eee34aaae44a0d313fe..d566c504134f0f488fbcbf7f4b8555a2ab8b2231 100644 (file)
@@ -5,13 +5,20 @@
 program p
   implicit none
 
-  integer, allocatable :: arr(:,:) [:,:]
+  type T
+    integer, allocatable :: arr(:,:) [:,:]
+  end type
+
+  type(T) :: o
+  integer, allocatable :: vec(:)[:,:]
   integer :: c[*]
 
   c = 7
 
-  allocate(arr(4,3)[2,*], source=6)
+  allocate(o%arr(4,3)[2,*], source=6)
+  allocate(vec(10)[1,*], source=7)
 
-  if (arr(2,2)* c /= 42) stop 1
+  if (vec(3) * c /= 49) stop 1
+  if (o%arr(2,2)* c /= 42) stop 2
 
 end program p