2 ! { dg-options "-fdump-tree-original" }
3 ! Test constructors of derived type with allocatable components (PR 20541).
5 ! Contributed by Erik Edelmann <eedelmann@gcc.gnu.org>
6 ! and Paul Thomas <pault@gcc.gnu.org>
9 Program test_constructor
18 integer(4), allocatable
:: a(:, :)
19 type(thytype
), allocatable
:: q(:)
22 type (thytype
) :: foo
= thytype(reshape ([43, 100, 54, 76], [2,2]))
23 integer :: y(0:1, -1:0) = reshape ([42, 99, 55, 77], [2,2])
25 BLOCK
! Add scoping unit as the vars are otherwise implicitly SAVEd
28 integer, allocatable
:: yy(:,:)
29 type (thytype
), allocatable
:: bar(:)
32 ! Check that null() works
33 x
= mytype(null(), null())
34 if (allocated(x
%a
) .or
. allocated(x
%q
)) call abort()
36 ! Check that unallocated allocatables work
38 if (allocated(x
%a
) .or
. allocated(x
%q
)) call abort()
40 ! Check that non-allocatables work
41 x
= mytype(y
, [foo
, foo
])
42 if (.not
.allocated(x
%a
) .or
. .not
.allocated(x
%q
)) call abort()
43 if (any(lbound(x
%a
) /= lbound(y
))) call abort()
44 if (any(ubound(x
%a
) /= ubound(y
))) call abort()
45 if (any(x
%a
/= y
)) call abort()
46 if (size(x
%q
) /= 2) call abort()
48 if (any(x
%q(i
)%a
/= foo
%a
)) call abort()
51 ! Check that allocated allocatables work
52 allocate(yy(size(y
,1), size(y
,2)))
57 if (.not
.allocated(x
%a
) .or
. .not
.allocated(x
%q
)) call abort()
58 if (any(x
%a
/= y
)) call abort()
59 if (size(x
%q
) /= 2) call abort()
61 if (any(x
%q(i
)%a
/= foo
%a
)) call abort()
64 ! Functions returning arrays
65 x
= mytype(bluhu(), null())
66 if (.not
.allocated(x
%a
) .or
. allocated(x
%q
)) call abort()
67 if (any(x
%a
/= reshape ([41, 98, 54, 76], [2,2]))) call abort()
69 ! Functions returning allocatable arrays
70 x
= mytype(blaha(), null())
71 if (.not
.allocated(x
%a
) .or
. allocated(x
%q
)) call abort()
72 if (any(x
%a
/= reshape ([40, 97, 53, 75], [2,2]))) call abort()
74 ! Check that passing the constructor to a procedure works
75 call check_mytype (mytype(y
, [foo
, foo
]))
79 subroutine check_mytype(x
)
80 type(mytype
), intent(in
) :: x
83 if (.not
.allocated(x
%a
) .or
. .not
.allocated(x
%q
)) call abort()
84 if (any(lbound(x
%a
) /= lbound(y
))) call abort()
85 if (any(ubound(x
%a
) /= ubound(y
))) call abort()
86 if (any(x
%a
/= y
)) call abort()
87 if (size(x
%q
) /= 2) call abort()
89 if (any(x
%q(i
)%a
/= foo
%a
)) call abort()
92 end subroutine check_mytype
98 bluhu
= reshape ([41, 98, 54, 76], [2,2])
103 integer, allocatable
:: blaha(:,:)
106 blaha
= reshape ([40, 97, 53, 75], [2,2])
109 end program test_constructor
110 ! { dg-final { scan-tree-dump-times "builtin_free" 19 "original" } }
111 ! { dg-final { cleanup-tree-dump "original" } }