1! { dg-do compile }
2!
3! Test diagnostic for MOVE_ALLOC:
4! FROM=type, TO=class is OK
5! FROM=class, TO=type is INVALID
6!
7module m2
8  type, abstract :: t2
9  contains
10    procedure(intf), deferred, nopass :: f
11  end type t2
12
13  interface
14    function intf()
15      import
16      class(t2), allocatable :: intf
17    end function intf
18  end interface
19end module m2
20
21module m3
22  use m2
23  type, extends(t2) :: t3
24  contains
25    procedure,nopass :: f => my_f
26  end type t3
27contains
28   function my_f()
29     class(t2), allocatable :: my_f
30   end function my_f
31end module m3
32
33subroutine my_test
34use m3
35type(t3), allocatable :: x
36class(t2), allocatable :: y
37call move_alloc (x, y)
38end subroutine my_test
39
40program testmv1
41  type bar
42  end type
43
44  type, extends(bar) ::  bar2
45  end type
46
47  class(bar), allocatable :: sm
48  type(bar2), allocatable :: sm2
49
50  allocate (sm2)
51  call move_alloc (sm,sm2) ! { dg-error "must be polymorphic if FROM is polymorphic" }
52
53  if (allocated(sm2)) call abort()
54  if (.not. allocated(sm)) call abort()
55end program
56