! { dg-do run }
!
! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
!
program main
  character(2) :: c

  type :: S
    integer :: n
  end type
  type(S) :: Sobj

  type, extends(S) :: S2
    integer :: m
  end type
  type(S2) :: S2obj

  type :: T
    class(S), allocatable :: x
  end type
  type(T) :: Tobj

  Sobj = S(1)
  Tobj = T(Sobj)

  S2obj = S2(1,2)
  Tobj = T(S2obj)            ! Failed here
  select type (x => Tobj%x)
    type is (S2)
      if ((x%n .ne. 1) .or. (x%m .ne. 2)) stop 1
    class default
      stop 2
  end select

  c = "  "
  call pass_it (T(Sobj))
  if (c .ne. "S ") stop 3
  call pass_it (T(S2obj))    ! and here
  if (c .ne. "S2") stop 4

  call bar

contains

  subroutine pass_it (foo)
    type(T), intent(in) :: foo
    select type (x => foo%x)
      type is (S)
        c = "S "
        if (x%n .ne. 1) stop 5
      type is (S2)
        c = "S2"
        if ((x%n .ne. 1) .or. (x%m .ne. 2)) stop 6
      class default
        stop 7
    end select
  end subroutine

  subroutine bar
   ! Test from comment #29 of the PR - due to Janus Weil
    type tContainer
      class(*), allocatable :: x
    end type
    integer, parameter :: i = 0
    character(7) :: chr = "goodbye"
    type(tContainer) :: cont

    cont%x = i ! linker error: undefined reference to `__copy_INTEGER_4_.3804'

    cont = tContainer(i+42) ! Failed here
    select type (z => cont%x)
      type is (integer)
        if (z .ne. 42) stop 8
      class default
        stop 9
    end select

    cont = tContainer('hello!')
    select type (z => cont%x)
      type is (character(*))
        if (z .ne. 'hello!') stop 10
      class default
        stop 11
    end select

    cont = tContainer(chr)
    select type (z => cont%x)
      type is (character(*))
        if (z .ne. 'goodbye') stop 12
      class default
        stop 13
    end select

  end subroutine bar
end program