1! { dg-do compile }
2!
3! PR fortran/58652
4!
5! Contributed by Vladimir Fuka
6!
7! The passing of a CLASS(*) to a CLASS(*) was reject before
8!
9module gen_lists
10  type list_node
11    class(*),allocatable :: item
12    contains
13      procedure :: move_alloc => list_move_alloc
14  end type
15
16  contains
17
18    subroutine list_move_alloc(self,item)
19      class(list_node),intent(inout) :: self
20      class(*),intent(inout),allocatable :: item
21
22      call move_alloc(item, self%item)
23    end subroutine
24end module
25
26module lists
27  use gen_lists, only: node => list_node
28end module lists
29
30
31module sexp
32  use lists
33contains
34 subroutine parse(ast)
35    class(*), allocatable, intent(out) :: ast
36    class(*), allocatable :: expr
37    integer :: ierr
38    allocate(node::ast)
39    select type (ast)
40      type is (node)
41        call ast%move_alloc(expr)
42    end select
43  end subroutine
44end module
45