2 ! { dg-options "-O2 -fdump-tree-original" }
4 ! Check some basic functionality of allocatable components, including that they
5 ! are nullified when created and automatically deallocated when
6 ! 1. A variable goes out of scope
7 ! 2. INTENT(OUT) dummies
11 ! Contributed by Erik Edelmann <eedelmann@gcc.gnu.org>
12 ! and Paul Thomas <pault@gcc.gnu.org>
19 real, allocatable
:: x(:)
32 type(alloc1
), allocatable
:: a1(:)
33 integer, allocatable
:: a2(:)
38 type(alloc2
), allocatable
:: c(:)
40 if (allocated(b
%a2
) .OR
. allocated(b
%a1
)) then
41 write (0, *) 'main - 1'
45 ! 3 calls to _gfortran_deallocate (INTENT(OUT) dummy)
46 call allocate_alloc2(b
)
50 ! 1 call to _gfortran_deallocate
54 ! 3 calls to _gfortran_deallocate (INTENT(OUT) dummy)
55 call allocate_alloc2(b
)
57 call check_alloc2(return_alloc2())
58 ! 3 calls to _gfortran_deallocate (function result)
61 ! 3 calls to _gfortran_deallocate (INTENT(OUT) dummy)
62 call allocate_alloc2(c(1))
63 ! 4 calls to _gfortran_deallocate
66 ! 7 calls to _gfortran_deallocate (b (3) and c(4) goes aout of scope)
70 subroutine allocate_alloc2(b
)
71 type(alloc2
), intent(out
) :: b
74 if (allocated(b
%a2
) .OR
. allocated(b
%a1
)) then
75 write (0, *) 'allocate_alloc2 - 1'
85 if (allocated(b
%a1(i
)%x
)) then
86 write (0, *) 'allocate_alloc2 - 2', i
89 allocate (b
%a1(i
)%x(3))
90 b
%a1(i
)%x
= i
+ [ 1.0, 2.0, 3.0 ]
93 end subroutine allocate_alloc2
96 type(alloc2
) function return_alloc2() result(b
)
97 if (allocated(b
%a2
) .OR
. allocated(b
%a1
)) then
98 write (0, *) 'return_alloc2 - 1'
108 if (allocated(b
%a1(i
)%x
)) then
109 write (0, *) 'return_alloc2 - 2', i
112 allocate (b
%a1(i
)%x(3))
113 b
%a1(i
)%x
= i
+ [ 1.0, 2.0, 3.0 ]
115 end function return_alloc2
118 subroutine check_alloc2(b
)
119 type(alloc2
), intent(in
) :: b
121 if (.NOT
.(allocated(b
%a2
) .AND
. allocated(b
%a1
))) then
122 write (0, *) 'check_alloc2 - 1'
125 if (any(b
%a2
/= [ 1, 2, 3 ])) then
126 write (0, *) 'check_alloc2 - 2'
130 if (.NOT
.allocated(b
%a1(i
)%x
)) then
131 write (0, *) 'check_alloc2 - 3', i
134 if (any(b
%a1(i
)%x
/= i
+ [ 1.0, 2.0, 3.0 ])) then
135 write (0, *) 'check_alloc2 - 4', i
139 end subroutine check_alloc2
142 ! { dg-final { scan-tree-dump-times "deallocate" 33 "original" } }
143 ! { dg-final { cleanup-tree-dump "original" } }