1! { dg-do run } 2! PR48705 - ALLOCATE with class function expression for SOURCE failed. 3! This is the original test in the PR. 4! 5! Reported by Tobias Burnus <burnus@gcc.gnu.org> 6! 7module generic_deferred 8 implicit none 9 type, abstract :: addable 10 contains 11 private 12 procedure(add), deferred :: a 13 generic, public :: operator(+) => a 14 end type addable 15 abstract interface 16 function add(x, y) result(res) 17 import :: addable 18 class(addable), intent(in) :: x, y 19 class(addable), allocatable :: res 20 end function add 21 end interface 22 type, extends(addable) :: vec 23 integer :: i(2) 24 contains 25 procedure :: a => a_vec 26 end type 27contains 28 function a_vec(x, y) result(res) 29 class(vec), intent(in) :: x 30 class(addable), intent(in) :: y 31 class(addable), allocatable :: res 32 integer :: ii(2) 33 select type(y) 34 class is (vec) 35 ii = y%i 36 end select 37 allocate(vec :: res) 38 select type(res) 39 type is (vec) 40 res%i = x%i + ii 41 end select 42 end function 43end module generic_deferred 44program prog 45 use generic_deferred 46 implicit none 47 type(vec) :: x, y 48 class(addable), allocatable :: z 49! x = vec( (/1,2/) ); y = vec( (/2,-2/) ) 50 x%i = (/1,2/); y%i = (/2,-2/) 51 allocate(z, source= x + y) 52 select type(z) 53 type is(vec) 54 if (z%i(1) /= 3 .or. z%i(2) /= 0) then 55 write(*,*) 'FAIL' 56 else 57 write(*,*) 'OK' 58 end if 59 end select 60end program prog 61