1! { dg-do run }
2!
3! PR fortran/54618
4!
5! Check whether default initialization works with INTENT(OUT)
6! and ALLOCATABLE and no segfault occurs with OPTIONAL.
7!
8
9subroutine test1()
10  type typ1
11    integer :: i = 6
12  end type typ1
13
14  type(typ1) :: x
15
16  x%i = 77
17  call f(x)
18  if (x%i /= 6) call abort ()
19  call f()
20contains
21  subroutine f(y1)
22    class(typ1), intent(out), optional :: y1
23  end subroutine f
24end subroutine test1
25
26subroutine test2()
27  type mytype
28  end type mytype
29  type, extends(mytype):: mytype2
30  end type mytype2
31
32  class(mytype), allocatable :: x,y
33  allocate (mytype2 :: x)
34  call g(x)
35  if (allocated (x) .or. .not. same_type_as (x,y)) call abort()
36
37  allocate (mytype2 :: x)
38  call h(x)
39  if (allocated (x) .or. .not. same_type_as (x,y)) call abort()
40
41  call h()
42contains
43  subroutine g(y2)
44    class(mytype), intent(out), allocatable :: y2
45  end subroutine g
46  subroutine h(y3)
47    class(mytype), optional, intent(out), allocatable :: y3
48  end subroutine h
49end subroutine test2
50
51call test1()
52call test2()
53end
54