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