gcc/testsuite/gfortran.dg/unlimited_polymorphic_12.f90

   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 !
   9 module 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
  24 end module
  25
  26 module lists
  27   use gen_lists, only: node => list_node
  28 end module lists
  29
  30
  31 module sexp
  32   use lists
  33 contains
  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
  44 end module