Fortran: Fix 'select rank' for allocatables/pointers

gcc/fortran/ChangeLog:

	* trans-stmt.c (gfc_trans_select_rank_cases): Fix condition
	for allocatables/pointers.

gcc/testsuite/ChangeLog:

	* gfortran.dg/PR93963.f90: Extend testcase by scan-tree-dump test.

(cherry picked from commit 7f899b23f36f94f907a025d3eeaf3e4640544927)

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index c1f975072c08d1c939ae745be72a5f8de34166e8..894ca5c78e40b3f93980483d895d234b42e744e3 100644 (file)
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,11 @@
+2021-10-27  Tobias Burnus  <tobias@codesourcery.com>
+
+       Backport from master:
+       2021-10-27  Tobias Burnus  <tobias@codesourcery.com>
+
+       * trans-stmt.c (gfc_trans_select_rank_cases): Fix condition
+       for allocatables/pointers.
+
 2021-10-26  Tobias Burnus  <tobias@codesourcery.com>
 
        Backport from master:

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 64b0529d8b874b2d1e9c50bf71183c26867fec2f..5f576424fc3c143846f06a39d1f383ff4bc2a0b4 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -3685,7 +3685,7 @@ gfc_trans_select_rank_cases (gfc_code * code)
   rank = gfc_conv_descriptor_rank (se.expr);
   rank = gfc_evaluate_now (rank, &block);
   symbol_attribute attr = gfc_expr_attr (code->expr1);
-  if (!attr.pointer || !attr.allocatable)
+  if (!attr.pointer && !attr.allocatable)
     {
       /* Special case for assumed-rank ('rank(*)', internally -1):
         rank = (rank == 0 || ubound[rank-1] != -1) ? rank : -1.  */

diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 2184865b8d9cf086446c35d1a5715c011f5e3d6b..4e978deeff195be0921a2bafaf2c1958a785cefc 100644 (file)
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,10 @@
+2021-10-27  Tobias Burnus  <tobias@codesourcery.com>
+
+       Backport from master:
+       2021-10-27  Tobias Burnus  <tobias@codesourcery.com>
+
+       * gfortran.dg/PR93963.f90: Extend testcase by scan-tree-dump test.
+
 2021-10-27  Tobias Burnus  <tobias@codesourcery.com>
 
        Backported from master:

diff --git a/gcc/testsuite/gfortran.dg/PR93963.f90 b/gcc/testsuite/gfortran.dg/PR93963.f90
index 66c937974ac1c2ff844158557eefb00088bd6fea..6769d7fe061049456291e46b6517e74d92a5cdd0 100644 (file)
--- a/gcc/testsuite/gfortran.dg/PR93963.f90
+++ b/gcc/testsuite/gfortran.dg/PR93963.f90
@@ -1,4 +1,5 @@
 ! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
 !
 ! Test the fix for PR93963
 !
@@ -190,3 +191,7 @@ program selr_p
   deallocate(inta)
 
 end program selr_p
+
+! Special code for assumed rank - but only if not allocatable/pointer
+! Thus, expect it only once for subroutine rank_o but not for rank_a or rank_p
+! { dg-final { scan-tree-dump-times "ubound != -1" 1 "original" } }