2 ! { dg-options "-fcoarray=single" }
13 integer :: global_count1
, global_count2
18 if (global_count1
== -1) call abort ()
19 if (x
%i
/= 42) call abort()
21 global_count1
= global_count1
+ 1
25 !print *, 'fini2', x%i
26 if (global_count2
== -1) call abort ()
27 if (size(x
) /= 5) call abort()
28 if (any (x
%i
/= [1,2,3,4,5]) .and
. any (x
%i
/= [6,7,8,9,10])) call abort()
30 global_count2
= global_count2
+ 10
37 type(t
), allocatable
:: ya
38 class(t
), allocatable
:: yc
39 type(t
), allocatable
:: yaa(:)
40 class(t
), allocatable
:: yca(:)
42 type(t
), allocatable
:: ca
[:]
43 class(t
), allocatable
:: cc
[:]
44 type(t
), allocatable
:: caa(:)[:]
45 class(t
), allocatable
:: cca(:)[:]
49 allocate (ya
, yc
, yaa(5), yca(5))
57 call foo(ya
, yc
, yaa
, yca
)
58 if (global_count1
/= 2) call abort ()
59 if (global_count2
/= 20) call abort ()
61 ! Coarray finalization
62 allocate (ca
[*], cc
[*], caa(5)[*], cca(5)[*])
69 deallocate (ca
, cc
, caa
, cca
)
70 if (global_count1
/= 2) call abort ()
71 if (global_count2
/= 20) call abort ()
76 type(t
), allocatable
:: za
77 class(t
), allocatable
:: zc
78 type(t
), allocatable
:: zaa(:)
79 class(t
), allocatable
:: zca(:)
81 ! Test intent(out) finalization
82 allocate (za
, zc
, zaa(5), zca(5))
90 call foo(za
, zc
, zaa
, zca
)
91 if (global_count1
/= 2) call abort ()
92 if (global_count2
/= 20) call abort ()
94 ! Test intent(out) finalization with optional
98 ! Test intent(out) finalization with optional
99 allocate (za
, zc
, zaa(5), zca(5))
107 call foo_opt(za
, zc
, zaa
, zca
)
108 if (global_count1
/= 2) call abort ()
109 if (global_count2
/= 20) call abort ()
111 ! Test DEALLOCATE finalization
112 allocate (za
, zc
, zaa(5), zca(5))
119 deallocate (za
, zc
, zaa
, zca
)
120 if (global_count1
/= 2) call abort ()
121 if (global_count2
/= 20) call abort ()
123 ! Test end-of-scope finalization
124 allocate (za
, zc
, zaa(5), zca(5))
133 if (global_count1
/= 2) call abort ()
134 if (global_count2
/= 20) call abort ()
136 ! Test that no end-of-scope finalization occurs
137 ! for SAVED variable in main
138 allocate (ya
, yc
, yaa(5), yca(5))
144 subroutine opt(xa
, xc
, xaa
, xca
)
145 type(t
), allocatable
, optional
:: xa
146 class(t
), allocatable
, optional
:: xc
147 type(t
), allocatable
, optional
:: xaa(:)
148 class(t
), allocatable
, optional
:: xca(:)
149 call foo_opt(xc
, xc
, xaa
)
150 !call foo_opt(xa, xc, xaa, xca) ! FIXME: Fails (ICE) due to PR 57445
152 subroutine foo_opt(xa
, xc
, xaa
, xca
)
153 type(t
), allocatable
, intent(out
), optional
:: xa
154 class(t
), allocatable
, intent(out
), optional
:: xc
155 type(t
), allocatable
, intent(out
), optional
:: xaa(:)
156 class(t
), allocatable
, intent(out
), optional
:: xca(:)
158 if (.not
. present(xa
)) &
160 if (allocated (xa
)) call abort ()
161 if (allocated (xc
)) call abort ()
162 if (allocated (xaa
)) call abort ()
163 if (allocated (xca
)) call abort ()
164 end subroutine foo_opt
165 subroutine foo(xa
, xc
, xaa
, xca
)
166 type(t
), allocatable
, intent(out
) :: xa
167 class(t
), allocatable
, intent(out
) :: xc
168 type(t
), allocatable
, intent(out
) :: xaa(:)
169 class(t
), allocatable
, intent(out
) :: xca(:)
170 if (allocated (xa
)) call abort ()
171 if (allocated (xc
)) call abort ()
172 if (allocated (xaa
)) call abort ()
173 if (allocated (xca
)) call abort ()