1! { dg-do run }
2! Tests the fix for PR41772 in which the empty array reference
3! 'qname(1:n-1)' was not handled correctly in TRANSFER.
4!
5! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
6!
7module m
8  implicit none
9contains
10  pure function str_vs(vs) result(s)
11    character, dimension(:), intent(in) :: vs
12    character(len=size(vs)) :: s
13    s = transfer(vs, s)
14  end function str_vs
15  subroutine has_key_ns(uri, localname, n)
16    character(len=*), intent(in) :: uri, localname
17    integer, intent(in) :: n
18    if ((n .lt. 2) .and. (len (uri) .ne. 0)) then
19      call abort
20    else IF ((n .ge. 2) .and. (len (uri) .ne. n - 1)) then
21      call abort
22    end if
23  end subroutine
24end module m
25
26  use m
27  implicit none
28  character, dimension(:), pointer :: QName
29  integer :: n
30  allocate(qname(6))
31  qname = (/ 'a','b','c','d','e','f' /)
32
33  do n = 0, 3
34    call has_key_ns(str_vs(qname(1:n-1)),"", n)
35  end do
36  deallocate(qname)
37end
38