diff options
author | Harald Anlauf <anlauf@gmx.de> | 2022-08-18 21:24:29 +0200 |
---|---|---|
committer | Harald Anlauf <anlauf@gmx.de> | 2022-08-18 21:24:29 +0200 |
commit | ca170ed9f8a086ca7e1eec841882b6bed9ec1a3a (patch) | |
tree | 03a41cb1afdf8b04b8d6407af2d65637e7d79a3a | |
parent | 7f5ec900e53f6c7f7c06c641b4fb303ebdc83785 (diff) | |
download | gcc-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.cc | 23 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/associated_target_9a.f90 | 27 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/associated_target_9b.f90 | 23 |
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 |