1! { dg-do run }
2!
3! PR fortran/57445
4!
5! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
6!
7! Spurious assert was added at revision 192495
8!
9module m
10  implicit none
11  type t
12    integer :: i
13  end type t
14contains
15  subroutine opt(xa, xc, xaa, xca)
16    type(t),  allocatable, intent(out), optional :: xa
17    class(t), allocatable, intent(out), optional :: xc
18    type(t),  allocatable, intent(out), optional :: xaa(:)
19    class(t), allocatable, intent(out), optional :: xca(:)
20    if (present (xca)) call foo_opt(xca=xca)
21  end subroutine opt
22  subroutine foo_opt(xa, xc, xaa, xca)
23    type(t),  allocatable, intent(out), optional :: xa
24    class(t), allocatable, intent(out), optional :: xc
25    type(t),  allocatable, intent(out), optional :: xaa(:)
26    class(t), allocatable, intent(out), optional :: xca(:)
27    if (present (xca)) then
28      if (allocated (xca)) deallocate (xca)
29      allocate (xca(3), source = [t(9),t(99),t(999)])
30    end if
31  end subroutine foo_opt
32end module m
33  use m
34  class(t), allocatable :: xca(:)
35  allocate (xca(1), source = t(42))
36  select type (xca)
37    type is (t)
38      if (any (xca%i .ne. [42])) call abort
39  end select
40  call opt (xca = xca)
41  select type (xca)
42    type is (t)
43      if (any (xca%i .ne. [9,99,999])) call abort
44  end select
45end
46