1! { dg-do run }
2! PR51870 - ALLOCATE with class function expression for SOURCE failed.
3! This version of the test allocates class arrays.
4!
5! Reported by Tobias Burnus  <burnus@gcc.gnu.org>
6!
7module show_producer_class
8  implicit none
9  type integrand
10    integer :: variable = 0
11  end type integrand
12
13  type show_producer
14  contains
15    procedure ,nopass :: create_show
16    procedure ,nopass :: create_show_array
17  end type
18contains
19  function create_show () result(new_integrand)
20    class(integrand) ,allocatable :: new_integrand
21    allocate(new_integrand)
22    new_integrand%variable = -1
23  end function
24  function create_show_array (n) result(new_integrand)
25    class(integrand) ,allocatable :: new_integrand(:)
26    integer :: n, i
27    allocate(new_integrand(n))
28    select type (new_integrand)
29      type is (integrand); new_integrand%variable = [(i, i= 1, n)]
30    end select
31  end function
32end module
33
34program main
35  use show_producer_class
36  implicit none
37  class(integrand) ,allocatable :: kernel(:)
38  type(show_producer) :: executive_producer
39
40  allocate(kernel(5),source=executive_producer%create_show_array (5))
41  select type(kernel)
42    type is (integrand);  if (any (kernel%variable .ne. [1,2,3,4,5])) call abort
43  end select
44
45  deallocate (kernel)
46
47  allocate(kernel(3),source=executive_producer%create_show ())
48  select type(kernel)
49    type is (integrand); if (any (kernel%variable .ne. -1)) call abort
50  end select
51end program
52