! { dg-do run }
!
! Test the fix for PR98342.
!
! Contributed by Martin Stein  <mscfd@gmx.net>
!
module mod
  implicit none
  private
  public get_tuple, sel_rank1, sel_rank2, sel_rank3

  type, public :: tuple
  integer, dimension(:), allocatable :: t
end type tuple

contains

function sel_rank1(x) result(s)
  character(len=:), allocatable :: s
  type(tuple), dimension(..), intent(in) :: x
  select rank (x)
    rank (0)
      s = '10'
    rank (1)
      s = '11'
    rank default
      s = '?'
  end select
end function sel_rank1

function sel_rank2(x) result(s)
  character(len=:), allocatable :: s
  class(tuple), dimension(..), intent(in) :: x
  select rank (x)
    rank (0)
      s = '20'
    rank (1)
      s = '21'
    rank default
      s = '?'
  end select
end function sel_rank2

function sel_rank3(x) result(s)
  character(len=:), allocatable :: s
  class(*), dimension(..), intent(in) :: x
  select rank (x)
    rank (0)
      s = '30'
    rank (1)
      s = '31'
    rank default
      s = '?'
  end select
end function sel_rank3

function get_tuple(t) result(a)
  type(tuple) :: a
  integer, dimension(:), intent(in) :: t
  allocate(a%t, source=t)
end function get_tuple

end module mod


program alloc_rank
  use mod
  implicit none

  integer, dimension(1:3) :: x
  character(len=:), allocatable :: output
  type(tuple) :: z

  x = [1,2,3]
  z = get_tuple (x)
                                       ! Derived type formal arg
  output = sel_rank1(get_tuple (x))    ! runtime: Error in `./alloc_rank.x':
  if (output .ne. '10') stop 1
  output = sel_rank1([z])              ! This worked OK
  if (output .ne. '11') stop 2

                                       ! Class formal arg
  output = sel_rank2(get_tuple (x))    ! runtime: Error in `./alloc_rank.x':
  if (output .ne. '20') stop 3
  output = sel_rank2([z])              ! This worked OK
  if (output .ne. '21') stop 4

                                       ! Unlimited polymorphic formal arg
  output = sel_rank3(get_tuple (x))    ! runtime: Error in `./alloc_rank.x':
  if (output .ne. '30') stop 5
  output = sel_rank3([z])              ! runtime: segmentation fault
  if (output .ne. '31') stop 6

  deallocate (output)
  deallocate (z%t)
end program alloc_rank