1! { dg-do run }
2! Check that allocatable/pointer variables of derived types with initialized
3! components are are initialized when allocated
4! PR 21625
5program test
6
7    implicit none
8    type :: t
9        integer :: a = 3
10    end type t
11    type :: s
12        type(t), pointer :: p(:)
13        type(t), pointer :: p2
14    end type s
15    type(t), pointer :: p
16    type(t), allocatable :: q(:,:)
17    type(s) :: z
18    type(s) :: x(2)
19
20    allocate(p, q(2,2))
21    if (p%a /= 3) call abort()
22    if (any(q(:,:)%a /= 3)) call abort()
23
24    allocate(z%p2, z%p(2:3))
25    if (z%p2%a /= 3) call abort()
26    if (any(z%p(:)%a /= 3)) call abort()
27
28    allocate(x(1)%p2, x(1)%p(2))
29    if (x(1)%p2%a /= 3) call abort()
30    if (any(x(1)%p(:)%a /= 3)) call abort()
31end program test
32
33