1! { dg-do run }
2! { dg-options "-fcoarray=single" }
3!
4! PR fortran/50981
5! PR fortran/54618
6!
7
8  implicit none
9  type t
10   integer, allocatable :: i
11  end type t
12  type, extends (t):: t2
13   integer, allocatable :: j
14  end type t2
15
16  class(t), allocatable :: xa, xa2(:), xac[:], xa2c(:)[:]
17  class(t), pointer :: xp, xp2(:)
18
19  xp => null()
20  xp2 => null()
21
22  call suba(alloc=.false., prsnt=.false.)
23  call suba(xa, alloc=.false., prsnt=.true.)
24  if (.not. allocated (xa)) call abort ()
25  if (.not. allocated (xa%i)) call abort ()
26  if (xa%i /= 5) call abort ()
27  xa%i = -3
28  call suba(xa, alloc=.true., prsnt=.true.)
29  if (allocated (xa)) call abort ()
30
31  call suba2(alloc=.false., prsnt=.false.)
32  call suba2(xa2, alloc=.false., prsnt=.true.)
33  if (.not. allocated (xa2)) call abort ()
34  if (size (xa2) /= 1) call abort ()
35  if (.not. allocated (xa2(1)%i)) call abort ()
36  if (xa2(1)%i /= 5) call abort ()
37  xa2(1)%i = -3
38  call suba2(xa2, alloc=.true., prsnt=.true.)
39  if (allocated (xa2)) call abort ()
40
41  call subp(alloc=.false., prsnt=.false.)
42  call subp(xp, alloc=.false., prsnt=.true.)
43  if (.not. associated (xp)) call abort ()
44  if (.not. allocated (xp%i)) call abort ()
45  if (xp%i /= 5) call abort ()
46  xp%i = -3
47  call subp(xp, alloc=.true., prsnt=.true.)
48  if (associated (xp)) call abort ()
49
50  call subp2(alloc=.false., prsnt=.false.)
51  call subp2(xp2, alloc=.false., prsnt=.true.)
52  if (.not. associated (xp2)) call abort ()
53  if (size (xp2) /= 1) call abort ()
54  if (.not. allocated (xp2(1)%i)) call abort ()
55  if (xp2(1)%i /= 5) call abort ()
56  xp2(1)%i = -3
57  call subp2(xp2, alloc=.true., prsnt=.true.)
58  if (associated (xp2)) call abort ()
59
60  call subac(alloc=.false., prsnt=.false.)
61  call subac(xac, alloc=.false., prsnt=.true.)
62  if (.not. allocated (xac)) call abort ()
63  if (.not. allocated (xac%i)) call abort ()
64  if (xac%i /= 5) call abort ()
65  xac%i = -3
66  call subac(xac, alloc=.true., prsnt=.true.)
67  if (allocated (xac)) call abort ()
68
69  call suba2c(alloc=.false., prsnt=.false.)
70  call suba2c(xa2c, alloc=.false., prsnt=.true.)
71  if (.not. allocated (xa2c)) call abort ()
72  if (size (xa2c) /= 1) call abort ()
73  if (.not. allocated (xa2c(1)%i)) call abort ()
74  if (xa2c(1)%i /= 5) call abort ()
75  xa2c(1)%i = -3
76  call suba2c(xa2c, alloc=.true., prsnt=.true.)
77  if (allocated (xa2c)) call abort ()
78
79contains
80 subroutine suba2c(x, prsnt, alloc)
81   class(t), optional, allocatable :: x(:)[:]
82   logical prsnt, alloc
83   if (present (x) .neqv. prsnt) call abort ()
84   if (prsnt) then
85     if (alloc .neqv. allocated(x)) call abort ()
86     if (.not. allocated (x)) then
87       allocate (x(1)[*])
88       x(1)%i = 5
89     else
90       if (x(1)%i /= -3) call abort()
91       deallocate (x)
92     end if
93   end if
94 end subroutine suba2c
95
96 subroutine subac(x, prsnt, alloc)
97   class(t), optional, allocatable :: x[:]
98   logical prsnt, alloc
99   if (present (x) .neqv. prsnt) call abort ()
100   if (present (x)) then
101     if (alloc .neqv. allocated(x)) call abort ()
102     if (.not. allocated (x)) then
103       allocate (x[*])
104       x%i = 5
105     else
106       if (x%i /= -3) call abort()
107       deallocate (x)
108     end if
109   end if
110 end subroutine subac
111
112 subroutine suba2(x, prsnt, alloc)
113   class(t), optional, allocatable :: x(:)
114   logical prsnt, alloc
115   if (present (x) .neqv. prsnt) call abort ()
116   if (prsnt) then
117     if (alloc .neqv. allocated(x)) call abort ()
118     if (.not. allocated (x)) then
119       allocate (x(1))
120       x(1)%i = 5
121     else
122       if (x(1)%i /= -3) call abort()
123       deallocate (x)
124     end if
125   end if
126 end subroutine suba2
127
128 subroutine suba(x, prsnt, alloc)
129   class(t), optional, allocatable :: x
130   logical prsnt, alloc
131   if (present (x) .neqv. prsnt) call abort ()
132   if (present (x)) then
133     if (alloc .neqv. allocated(x)) call abort ()
134     if (.not. allocated (x)) then
135       allocate (x)
136       x%i = 5
137     else
138       if (x%i /= -3) call abort()
139       deallocate (x)
140     end if
141   end if
142 end subroutine suba
143
144 subroutine subp2(x, prsnt, alloc)
145   class(t), optional, pointer :: x(:)
146   logical prsnt, alloc
147   if (present (x) .neqv. prsnt) call abort ()
148   if (present (x)) then
149     if (alloc .neqv. associated(x)) call abort ()
150     if (.not. associated (x)) then
151       allocate (x(1))
152       x(1)%i = 5
153     else
154       if (x(1)%i /= -3) call abort()
155       deallocate (x)
156     end if
157   end if
158 end subroutine subp2
159
160 subroutine subp(x, prsnt, alloc)
161   class(t), optional, pointer :: x
162   logical prsnt, alloc
163   if (present (x) .neqv. prsnt) call abort ()
164   if (present (x)) then
165     if (alloc .neqv. associated(x)) call abort ()
166     if (.not. associated (x)) then
167       allocate (x)
168       x%i = 5
169     else
170       if (x%i /= -3) call abort()
171       deallocate (x)
172     end if
173   end if
174 end subroutine subp
175end
176