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.
This commit is contained in:
Tobias Burnus 2021-10-27 10:59:27 +02:00
parent 4f1fe0dc25
commit 7f899b23f3
2 changed files with 6 additions and 1 deletions

View File

@ -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. */

View File

@ -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" } }