1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
! { 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 <burnus@gcc.gnu.org>
!
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
|
