2 ! { dg-options "-fdump-tree-original" }
\r
3 ! Test constructors of derived type with allocatable components (PR 20541).
\r
5 ! Contributed by Erik Edelmann <eedelmann@gcc.gnu.org>
\r
6 ! and Paul Thomas <pault@gcc.gnu.org>
\r
9 Program test_constructor
\r
14 integer(4) :: a(2,2)
\r
18 integer(4), allocatable :: a(:, :)
\r
19 type(thytype), allocatable :: q(:)
\r
23 type (thytype) :: foo = thytype(reshape ([43, 100, 54, 76], [2,2]))
\r
24 integer :: y(0:1, -1:0) = reshape ([42, 99, 55, 77], [2,2])
\r
25 integer, allocatable :: yy(:,:)
\r
26 type (thytype), allocatable :: bar(:)
\r
29 ! Check that null() works
\r
30 x = mytype(null(), null())
\r
31 if (allocated(x%a) .or. allocated(x%q)) call abort()
\r
33 ! Check that unallocated allocatables work
\r
35 if (allocated(x%a) .or. allocated(x%q)) call abort()
\r
37 ! Check that non-allocatables work
\r
38 x = mytype(y, [foo, foo])
\r
39 if (.not.allocated(x%a) .or. .not.allocated(x%q)) call abort()
\r
40 if (any(lbound(x%a) /= lbound(y))) call abort()
\r
41 if (any(ubound(x%a) /= ubound(y))) call abort()
\r
42 if (any(x%a /= y)) call abort()
\r
43 if (size(x%q) /= 2) call abort()
\r
45 if (any(x%q(i)%a /= foo%a)) call abort()
\r
48 ! Check that allocated allocatables work
\r
49 allocate(yy(size(y,1), size(y,2)))
\r
54 if (.not.allocated(x%a) .or. .not.allocated(x%q)) call abort()
\r
55 if (any(x%a /= y)) call abort()
\r
56 if (size(x%q) /= 2) call abort()
\r
58 if (any(x%q(i)%a /= foo%a)) call abort()
\r
61 ! Functions returning arrays
\r
62 x = mytype(bluhu(), null())
\r
63 if (.not.allocated(x%a) .or. allocated(x%q)) call abort()
\r
64 if (any(x%a /= reshape ([41, 98, 54, 76], [2,2]))) call abort()
\r
66 ! Functions returning allocatable arrays
\r
67 x = mytype(blaha(), null())
\r
68 if (.not.allocated(x%a) .or. allocated(x%q)) call abort()
\r
69 if (any(x%a /= reshape ([40, 97, 53, 75], [2,2]))) call abort()
\r
71 ! Check that passing the constructor to a procedure works
\r
72 call check_mytype (mytype(y, [foo, foo]))
\r
76 subroutine check_mytype(x)
\r
77 type(mytype), intent(in) :: x
\r
80 if (.not.allocated(x%a) .or. .not.allocated(x%q)) call abort()
\r
81 if (any(lbound(x%a) /= lbound(y))) call abort()
\r
82 if (any(ubound(x%a) /= ubound(y))) call abort()
\r
83 if (any(x%a /= y)) call abort()
\r
84 if (size(x%q) /= 2) call abort()
\r
86 if (any(x%q(i)%a /= foo%a)) call abort()
\r
89 end subroutine check_mytype
\r
93 integer :: bluhu(2,2)
\r
95 bluhu = reshape ([41, 98, 54, 76], [2,2])
\r
100 integer, allocatable :: blaha(:,:)
\r
102 allocate(blaha(2,2))
\r
103 blaha = reshape ([40, 97, 53, 75], [2,2])
\r
106 end program test_constructor
\r
107 ! { dg-final { scan-tree-dump-times "builtin_free" 19 "original" } }
\r
108 ! { dg-final { cleanup-tree-dump "original" } }
\r