Fortran: Fix rank of assumed-rank array [PR99043]
gcc/fortran/ChangeLog: PR fortran/99043 * trans-expr.c (gfc_conv_procedure_call): Don't reset rank of assumed-rank array. gcc/testsuite/ChangeLog: PR fortran/99043 * gfortran.dg/assumed_rank_20.f90: New test.
This commit is contained in:
parent
6cc886bf42
commit
f699e0b165
@ -6403,9 +6403,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|
||||
|
||||
/* Unallocated allocatable arrays and unassociated pointer arrays
|
||||
need their dtype setting if they are argument associated with
|
||||
assumed rank dummies. */
|
||||
assumed rank dummies, unless already assumed rank. */
|
||||
if (!sym->attr.is_bind_c && e && fsym && fsym->as
|
||||
&& fsym->as->type == AS_ASSUMED_RANK)
|
||||
&& fsym->as->type == AS_ASSUMED_RANK
|
||||
&& e->rank != -1)
|
||||
{
|
||||
if (gfc_expr_attr (e).pointer
|
||||
|| gfc_expr_attr (e).allocatable)
|
||||
|
36
gcc/testsuite/gfortran.dg/assumed_rank_20.f90
Normal file
36
gcc/testsuite/gfortran.dg/assumed_rank_20.f90
Normal file
@ -0,0 +1,36 @@
|
||||
! { dg-do run }
|
||||
!
|
||||
! PR fortran/99043
|
||||
!
|
||||
module assumed_rank_module
|
||||
implicit none
|
||||
private
|
||||
|
||||
public :: rank_of_pointer_level1
|
||||
contains
|
||||
subroutine rank_of_pointer_level1(ap,aa)
|
||||
real, dimension(..), intent(in), pointer :: ap
|
||||
real, dimension(..), intent(in), allocatable :: aa
|
||||
if (rank(ap) /= 3) stop 1
|
||||
if (rank(aa) /= 3) stop 2
|
||||
call rank_of_pointer_level2(ap, aa)
|
||||
end subroutine rank_of_pointer_level1
|
||||
|
||||
subroutine rank_of_pointer_level2(ap,aa)
|
||||
real, dimension(..), intent(in), pointer :: ap
|
||||
real, dimension(..), intent(in), allocatable :: aa
|
||||
|
||||
if (rank(ap) /= 3) stop 3
|
||||
if (rank(aa) /= 3) stop 4
|
||||
end subroutine rank_of_pointer_level2
|
||||
end module assumed_rank_module
|
||||
|
||||
program assumed_rank
|
||||
use :: assumed_rank_module, only : rank_of_pointer_level1
|
||||
implicit none
|
||||
real, dimension(:,:,:), pointer :: ap
|
||||
real, dimension(:,:,:), allocatable :: aa
|
||||
|
||||
ap => null()
|
||||
call rank_of_pointer_level1(ap, aa)
|
||||
end program assumed_rank
|
Loading…
x
Reference in New Issue
Block a user