1! { dg-do run } 2! 3! Test the fix for PR78990 in which the scalarization of the assignment 4! in the main program failed for two reasons: (i) The conversion of 'v1' 5! into a class actual was being done after the call to 'return_t1', giving 6! rise to the ICE reported in comment #1; and (ii) The 'info' descriptor, 7! required for scalarization was not set, which gave rise to the ICE noted 8! by the contributor. 9! 10! Contributed by Chris Macmackin <cmacmackin@gmail.com> 11! 12module test_type 13 implicit none 14 15 type t1 16 integer :: i 17 contains 18 procedure :: assign 19 generic :: assignment(=) => assign 20 end type t1 21 22contains 23 24 elemental subroutine assign(this,rhs) 25 class(t1), intent(inout) :: this 26 class(t1), intent(in) :: rhs 27 this%i = rhs%i 28 end subroutine assign 29 30 function return_t1(arg) 31 class(t1), dimension(:), intent(in) :: arg 32 class(t1), dimension(:), allocatable :: return_t1 33 allocate(return_t1(size(arg)), source=arg) 34 end function return_t1 35 36 function return_t1_p(arg) 37 class(t1), dimension(:), intent(in), target :: arg 38 class(t1), dimension(:), pointer :: return_t1_p 39 return_t1_p => arg 40 end function return_t1_p 41end module test_type 42 43program test 44 use test_type 45 implicit none 46 47 type(t1), dimension(3) :: v1, v2 48 v1%i = [1,2,3] 49 v2 = return_t1(v1) 50 if (any (v2%i .ne. v1%i)) STOP 1 51 52 v1%i = [4,5,6] 53 v2 = return_t1_p(v1) 54 if (any (v2%i .ne. v1%i)) STOP 2 55end program test 56