2 ! { dg-options "-fcoarray=single" }
10 integer, allocatable :: i
12 type, extends (t):: t2
13 integer, allocatable :: j
16 class(t), allocatable :: xa, xa2(:), xac[:], xa2c(:)[:]
17 class(t), pointer :: xp, xp2(:)
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 ()
28 call suba(xa, alloc=.true., prsnt=.true.)
29 if (allocated (xa)) call abort ()
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 ()
38 call suba2(xa2, alloc=.true., prsnt=.true.)
39 if (allocated (xa2)) call abort ()
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 ()
47 call subp(xp, alloc=.true., prsnt=.true.)
48 if (associated (xp)) call abort ()
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 ()
57 call subp2(xp2, alloc=.true., prsnt=.true.)
58 if (associated (xp2)) call abort ()
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 ()
66 call subac(xac, alloc=.true., prsnt=.true.)
67 if (allocated (xac)) call abort ()
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 ()
76 call suba2c(xa2c, alloc=.true., prsnt=.true.)
77 if (allocated (xa2c)) call abort ()
80 subroutine suba2c(x, prsnt, alloc)
81 class(t), optional, allocatable :: x(:)[:]
83 if (present (x) .neqv. prsnt) call abort ()
85 if (alloc .neqv. allocated(x)) call abort ()
86 if (.not. allocated (x)) then
90 if (x(1)%i /= -3) call abort()
96 subroutine subac(x, prsnt, alloc)
97 class(t), optional, allocatable :: x[:]
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
106 if (x%i /= -3) call abort()
112 subroutine suba2(x, prsnt, alloc)
113 class(t), optional, allocatable :: x(:)
115 if (present (x) .neqv. prsnt) call abort ()
117 if (alloc .neqv. allocated(x)) call abort ()
118 if (.not. allocated (x)) then
122 if (x(1)%i /= -3) call abort()
128 subroutine suba(x, prsnt, alloc)
129 class(t), optional, allocatable :: x
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
138 if (x%i /= -3) call abort()
144 subroutine subp2(x, prsnt, alloc)
145 class(t), optional, pointer :: x(:)
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
154 if (x(1)%i /= -3) call abort()
160 subroutine subp(x, prsnt, alloc)
161 class(t), optional, pointer :: x
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
170 if (x%i /= -3) call abort()