1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
! { dg-do run }
!
! Tests the fix for PR89363, in which the rank of unallocated or unassociated
! entities, argument associated with assumed rank dummies, was not being set.
!
! Contributed by Reinhold Bader <Bader@lrz.de>
!
module mod_ass_rank_02
implicit none
contains
subroutine procr(this,flag)
real, allocatable :: this(..)
logical :: flag
if (rank(this) /= 2 .or. allocated(this)) then
write(*,*) 'FAIL procr', rank(this), allocated(this)
flag = .FALSE.
end if
end subroutine procr
subroutine procs(this,flag)
real, allocatable :: this(..)
logical :: flag
if (rank(this) /= 2 .or. .not. allocated(this)) then
write(*,*) 'FAIL procs status', rank(this), allocated(this)
flag = .FALSE.
end if
if (size(this,1) /= 2 .and. size(this,2) /= 5) then
write(*,*) 'FAIL procs shape', size(this)
flag = .FALSE.
end if
end subroutine procs
end module mod_ass_rank_02
program ass_rank_02
use mod_ass_rank_02
implicit none
real, allocatable :: x(:,:)
logical :: flag
flag = .TRUE.
call procr(x,flag)
if (.not.flag) stop 1
allocate(x(2,5))
call procs(x,flag)
if (.not.flag) stop 2
deallocate(x)
end program ass_rank_02
|
