1! { dg-do run }
2!
3! PR fortran/57354
4!
5! Contributed by Vladimir Fuka  <vladimir.fuka@gmail.com>
6!
7  type t
8    integer,allocatable :: i
9  end type
10
11  type(t) :: e
12  type(t), allocatable :: a(:)
13  integer :: chksum = 0
14
15  do i=1,3   ! Was 100 in original
16    e%i = i
17    chksum = chksum + i
18    if (.not.allocated(a)) then
19      a = [e]
20    else
21      call foo
22    end if
23  end do
24
25  if (sum ([(a(i)%i, i=1,size(a))]) .ne. chksum) call abort
26contains
27  subroutine foo
28    a = [a, e]
29  end subroutine
30end
31