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