]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Revert "Fortran: fix invalid rank error in ASSOCIATED when rank is remapped [PR77652]"
authorHarald Anlauf <anlauf@gmx.de>
Thu, 18 Aug 2022 19:24:29 +0000 (21:24 +0200)
committerHarald Anlauf <anlauf@gmx.de>
Thu, 18 Aug 2022 19:24:29 +0000 (21:24 +0200)
This reverts commit 0110cfd5449bae3a772f45ea2e4c5dab5b7a8ccd.

gcc/fortran/check.cc
gcc/testsuite/gfortran.dg/associated_target_9a.f90 [deleted file]
gcc/testsuite/gfortran.dg/associated_target_9b.f90 [deleted file]

index 1da0b3cbe152fb41efbd0d4bd2ceb8580e7c2e71..91d87a1b2c1d05cc6dd5be6c0e6fd7bc354a2097 100644 (file)
@@ -1502,27 +1502,8 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
     t = false;
   /* F2018 C838 explicitly allows an assumed-rank variable as the first
      argument of intrinsic inquiry functions.  */
-  if (pointer->rank != -1 && pointer->rank != target->rank)
-    {
-      if (pointer->rank == 0 || target->rank == 0)
-       {
-         /* There exists no valid pointer assignment using bounds
-            remapping for scalar => array or array => scalar. */
-         if (!rank_check (target, 0, pointer->rank))
-           t = false;
-       }
-      else if (target->rank != 1)
-       {
-         if (!gfc_notify_std (GFC_STD_F2008, "Rank remapping target is not "
-                              "rank 1 at %L", &target->where))
-           t = false;
-       }
-      else if ((gfc_option.allow_std & GFC_STD_F2003) == 0)
-       {
-         if (!rank_check (target, 0, pointer->rank))
-           t = false;
-       }
-    }
+  if (pointer->rank != -1 && !rank_check (target, 0, pointer->rank))
+    t = false;
   if (target->rank > 0 && target->ref)
     {
       for (i = 0; i < target->rank; i++)
diff --git a/gcc/testsuite/gfortran.dg/associated_target_9a.f90 b/gcc/testsuite/gfortran.dg/associated_target_9a.f90
deleted file mode 100644 (file)
index 708645d..0000000
+++ /dev/null
@@ -1,27 +0,0 @@
-! { dg-do run }
-! { dg-options "-std=f2018" }
-! PR fortran/77652 - Invalid rank error in ASSOCIATED when rank is remapped
-! Contributed by Paul Thomas
-
-program p
-  real, dimension(100),  target  :: array
-  real, dimension(:,:),  pointer :: matrix
-  real, dimension(20,5), target  :: array2
-  real, dimension(:),    pointer :: matrix2
-  matrix(1:20,1:5) => array
-  matrix2(1:100)   => array2
-  !
-  ! F2018:16.9.16, ASSOCIATED (POINTER [, TARGET])
-  ! Case(v): If TARGET is present and is an array target, the result is
-  ! true if and only if POINTER is associated with a target that has
-  ! the same shape as TARGET, ...
-  if (associated (matrix, array )) stop 1
-  if (associated (matrix2,array2)) stop 2
-  call check (matrix2, array2)
-contains
-  subroutine check (ptr, tgt)
-    real, pointer :: ptr(..)
-    real, target  :: tgt(:,:)
-    if (associated (ptr, tgt)) stop 3
-  end subroutine check
-end
diff --git a/gcc/testsuite/gfortran.dg/associated_target_9b.f90 b/gcc/testsuite/gfortran.dg/associated_target_9b.f90
deleted file mode 100644 (file)
index 1daa0a7..0000000
+++ /dev/null
@@ -1,23 +0,0 @@
-! { dg-do compile }
-! { dg-options "-std=f2003" }
-! PR fortran/77652 - Invalid rank error in ASSOCIATED when rank is remapped
-! Contributed by Paul Thomas
-
-subroutine s
-  real, dimension(100),  target  :: array
-  real, dimension(:,:),  pointer :: matrix
-  real, dimension(20,5), target  :: array2
-  real, dimension(:),    pointer :: matrix2
-  real,                  pointer :: scalar, scalar2
-  scalar => scalar2
-  print *, associated (scalar, scalar2)
-
-  matrix(1:20,1:5) => array            ! F2003+
-! matrix2(1:100)   => array2           ! F2008+
-  print *, associated (matrix, array ) ! Technically legal F2003
-  print *, associated (matrix2,array2) ! { dg-error "is not rank 1" }
-
-  ! There exists no related valid pointer assignment for these cases:
-  print *, associated (scalar,matrix2) ! { dg-error "must be of rank 0" }
-  print *, associated (matrix2,scalar) ! { dg-error "must be of rank 1" }
-end