1! { dg-do run }
2!
3implicit none
4integer, allocatable :: A[:], B[:,:]
5integer :: n1, n2, n3
6
7if (allocated (a)) call abort ()
8if (allocated (b)) call abort ()
9
10allocate(a[*])
11a = 5 + this_image ()
12if (a[this_image ()] /= 5 + this_image ()) call abort
13
14a[this_image ()] = 8 - 2*this_image ()
15if (a[this_image ()] /= 8 - 2*this_image ()) call abort
16
17if (lcobound(a, dim=1) /= 1 .or. ucobound(a,dim=1) /= num_images()) &
18  call abort ()
19deallocate(a)
20
21allocate(a[4:*])
22a[this_image ()] = 8 - 2*this_image ()
23
24if (lcobound(a, dim=1) /= 4 .or. ucobound(a,dim=1) /= 3 + num_images()) &
25  call abort ()
26
27n1 = -1
28n2 = 5
29n3 = 3
30allocate (B[n1:n2, n3:*])
31if (any (lcobound(b) /= [-1, 3]) .or. lcobound(B, dim=2) /= n3) &
32  call abort()
33call sub(A, B)
34
35if (allocated (a)) call abort ()
36if (.not.allocated (b)) call abort ()
37
38call two(.true.)
39call two(.false.)
40
41! automatically deallocate "B"
42contains
43  subroutine sub(x, y)
44    integer, allocatable :: x[:], y[:,:]
45
46    if (any (lcobound(y) /= [-1, 3]) .or. lcobound(y, dim=2) /= n3) &
47      call abort()
48    if (lcobound(x, dim=1) /= 4 .or. ucobound(x,dim=1) /= 3 + num_images()) &
49      call abort ()
50    if (x[this_image ()] /= 8 - 2*this_image ()) call abort
51    deallocate(x)
52  end subroutine sub
53
54  subroutine two(init)
55    logical, intent(in) :: init
56    integer, allocatable, SAVE :: a[:]
57
58    if (init) then
59      if (allocated(a)) call abort()
60      allocate(a[*])
61      a = 45
62   else
63      if (.not. allocated(a)) call abort()
64      if (a /= 45) call abort()
65      deallocate(a)
66    end if
67  end subroutine two
68end
69