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