1! { dg-do run }
2!
3! PR fortran/49074
4! ICE on defined assignment with class arrays.
5
6      module foo
7        type bar
8          integer :: i
9
10          contains
11
12          generic :: assignment (=) => assgn_bar
13          procedure, private :: assgn_bar
14        end type bar
15
16        contains
17
18        elemental subroutine assgn_bar (a, b)
19          class (bar), intent (inout) :: a
20          class (bar), intent (in) :: b
21
22          select type (b)
23          type is (bar)
24            a%i = b%i
25          end select
26
27          return
28        end subroutine assgn_bar
29      end module foo
30
31      program main
32        use foo
33
34        type (bar), allocatable :: foobar(:)
35
36        allocate (foobar(2))
37        foobar = [bar(1), bar(2)]
38        if (any(foobar%i /= [1, 2])) STOP 1
39      end program
40