Subversion Repositories openrisc

! { dg-do run }

! Tests the fix for PR41772 in which the empty array reference

! 'qname(1:n-1)' was not handled correctly in TRANSFER.

!

! Contributed by Tobias Burnus 

!

module m

  implicit none

contains

  pure function str_vs(vs) result(s)

    character, dimension(:), intent(in) :: vs

    character(len=size(vs)) :: s

    s = transfer(vs, s)

  end function str_vs

  subroutine has_key_ns(uri, localname, n)

    character(len=*), intent(in) :: uri, localname

    integer, intent(in) :: n

    if ((n .lt. 2) .and. (len (uri) .ne. 0)) then

      call abort

    else IF ((n .ge. 2) .and. (len (uri) .ne. n - 1)) then

      call abort

    end if

  end subroutine

end module m

  use m

  implicit none

  character, dimension(:), pointer :: QName

  integer :: n

  allocate(qname(6))

  qname = (/ 'a','b','c','d','e','f' /)

  do n = 0, 3

    call has_key_ns(str_vs(qname(1:n-1)),"", n)

  end do

  deallocate(qname)

end

! { dg-final { cleanup-modules "m" } }