aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHarald Anlauf <anlauf@gmx.de>2022-08-18 21:24:29 +0200
committerHarald Anlauf <anlauf@gmx.de>2022-08-18 21:24:29 +0200
commitca170ed9f8a086ca7e1eec841882b6bed9ec1a3a (patch)
tree03a41cb1afdf8b04b8d6407af2d65637e7d79a3a
parent7f5ec900e53f6c7f7c06c641b4fb303ebdc83785 (diff)
downloadgcc-ca170ed9f8a086ca7e1eec841882b6bed9ec1a3a.zip
gcc-ca170ed9f8a086ca7e1eec841882b6bed9ec1a3a.tar.gz
gcc-ca170ed9f8a086ca7e1eec841882b6bed9ec1a3a.tar.bz2
Revert "Fortran: fix invalid rank error in ASSOCIATED when rank is remapped [PR77652]"
This reverts commit 0110cfd5449bae3a772f45ea2e4c5dab5b7a8ccd.
-rw-r--r--gcc/fortran/check.cc23
-rw-r--r--gcc/testsuite/gfortran.dg/associated_target_9a.f9027
-rw-r--r--gcc/testsuite/gfortran.dg/associated_target_9b.f9023
3 files changed, 2 insertions, 71 deletions
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 1da0b3c..91d87a1 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -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
index 708645d..0000000
--- a/gcc/testsuite/gfortran.dg/associated_target_9a.f90
+++ /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
index 1daa0a7..0000000
--- a/gcc/testsuite/gfortran.dg/associated_target_9b.f90
+++ /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