1! { dg-do run }
2!
3! PR fortran/45489
4!
5! Check that non-referenced variables are default
6! initialized if they are INTENT(OUT) or function results.
7! Only the latter (i.e. "x=f()") was not working before
8! PR 45489 was fixed.
9!
10program test_init
11  implicit none
12  integer, target :: tgt
13  type A
14    integer, pointer:: p => null ()
15    integer:: i=3
16  end type A
17  type(A):: x, y(3)
18  x=f()
19  if (associated(x%p) .or. x%i /= 3) call abort ()
20  y(1)%p => tgt
21  y%i = 99
22  call sub1(3,y)
23  if (associated(y(1)%p) .or. any(y(:)%i /= 3)) call abort ()
24  y(1)%p => tgt
25  y%i = 99
26  call sub2(y)
27  if (associated(y(1)%p) .or. any(y(:)%i /= 3)) call abort ()
28contains
29 function f() result (fr)
30    type(A):: fr
31 end function f
32 subroutine sub1(n,x)
33   integer :: n
34   type(A), intent(out) :: x(n:n+2)
35 end subroutine sub1
36 subroutine sub2(x)
37   type(A), intent(out) :: x(:)
38 end subroutine sub2
39end program test_init
40