view gcc/testsuite/gfortran.dg/unlimited_polymorphic_12.f90 @ 158:494b0b89df80 default tip

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 18:13:55 +0900
parents 04ced10e8804
children
line wrap: on
line source

! { dg-do compile }
!
! PR fortran/58652
!
! Contributed by Vladimir Fuka
!
! The passing of a CLASS(*) to a CLASS(*) was reject before
!
module gen_lists
  type list_node
    class(*),allocatable :: item
    contains
      procedure :: move_alloc => list_move_alloc
  end type

  contains

    subroutine list_move_alloc(self,item)
      class(list_node),intent(inout) :: self
      class(*),intent(inout),allocatable :: item

      call move_alloc(item, self%item)
    end subroutine
end module

module lists
  use gen_lists, only: node => list_node
end module lists


module sexp
  use lists
contains
 subroutine parse(ast)
    class(*), allocatable, intent(out) :: ast
    class(*), allocatable :: expr
    integer :: ierr
    allocate(node::ast)
    select type (ast)
      type is (node)
        call ast%move_alloc(expr)
    end select
  end subroutine
end module