1! { dg-do run } 2! 3! PR 54917: [OOP] TRANSFER on polymorphic variable causes ICE 4! 5! Contributed by Janus Weil <janus@gcc.gnu.org> 6 7module m 8 implicit none 9 type test_type 10 integer :: i = 0 11 contains 12 procedure :: ass 13 generic :: assignment(=) => ass 14 end type 15contains 16 subroutine ass (a, b) 17 class(test_type), intent(out) :: a 18 class(test_type), intent(in) :: b 19 a%i = b%i 20 end subroutine 21end module 22 23 24program p 25 use m 26 implicit none 27 28 class(test_type), allocatable :: c 29 type(test_type) :: t 30 31 allocate(c) 32 33 ! (1) check CLASS-to-TYPE transfer 34 c%i=3 35 t = transfer(c, t) 36 if (t%i /= 3) STOP 1 37 38 ! (2) check TYPE-to-CLASS transfer 39 t%i=4 40 c = transfer(t, c) 41 if (c%i /= 4) STOP 2 42 43end 44