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