1! { dg-do run }
2! { dg-options "-fdefault-integer-8 -O2" }
3! Tests the fix for PR34143, where the implicit type
4! conversion in the derived type constructor would fail,
5! when 'yy' was not allocated.  The testscase is an
6! extract from alloc_comp_constructor.f90.
7!
8! Reported by Thomas Koenig <tkoenig@gcc.gnu.org>
9!
10Program test_constructor
11    implicit none
12    type :: thytype
13        integer(4) :: a(2,2)
14    end type thytype
15    type :: mytype
16        integer(4), allocatable :: a(:, :)
17        type(thytype), allocatable :: q(:)
18    end type mytype
19    integer, allocatable :: yy(:,:)
20    type (thytype), allocatable :: bar(:)
21    call non_alloc
22    call alloc
23contains
24    subroutine non_alloc
25      type (mytype) :: x
26      x = mytype(yy, bar)
27      if (allocated (x%a) .or. allocated (x%q)) call abort
28    end subroutine non_alloc
29    subroutine alloc
30      type (mytype) :: x
31      allocate (yy(2,2))
32      allocate (bar(2))
33      yy = reshape ([10,20,30,40],[2,2])
34      bar = thytype (reshape ([1,2,3,4],[2,2]))
35      x = mytype(yy, bar)
36      if (.not.allocated (x%a) .or. .not.allocated (x%q)) call abort
37    end subroutine alloc
38end program test_constructor
39