1! { dg-do run } 2! 3! Test move_alloc for polymorphic scalars 4! 5! 6module myalloc 7 implicit none 8 9 type :: base_type 10 integer :: i =2 11 end type base_type 12 13 type, extends(base_type) :: extended_type 14 integer :: j = 77 15 end type extended_type 16contains 17 subroutine myallocate (a) 18 class(base_type), allocatable, intent(inout) :: a 19 class(base_type), allocatable :: tmp 20 21 allocate (extended_type :: tmp) 22 23 select type(tmp) 24 type is(base_type) 25 call abort () 26 type is(extended_type) 27 if (tmp%i /= 2 .or. tmp%j /= 77) call abort() 28 tmp%i = 5 29 tmp%j = 88 30 end select 31 32 select type(a) 33 type is(base_type) 34 if (a%i /= -44) call abort() 35 a%i = -99 36 class default 37 call abort () 38 end select 39 40 call move_alloc (from=tmp, to=a) 41 42 select type(a) 43 type is(extended_type) 44 if (a%i /= 5) call abort() 45 if (a%j /= 88) call abort() 46 a%i = 123 47 a%j = 9498 48 class default 49 call abort () 50 end select 51 52 if (allocated (tmp)) call abort() 53 end subroutine myallocate 54end module myalloc 55 56program main 57 use myalloc 58 implicit none 59 class(base_type), allocatable :: a 60 61 allocate (a) 62 63 select type(a) 64 type is(base_type) 65 if (a%i /= 2) call abort() 66 a%i = -44 67 class default 68 call abort () 69 end select 70 71 call myallocate (a) 72 73 select type(a) 74 type is(extended_type) 75 if (a%i /= 123) call abort() 76 if (a%j /= 9498) call abort() 77 class default 78 call abort () 79 end select 80end program main 81