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