gcc/testsuite/gfortran.dg/transfer_intrinsic_3.f90

   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 !
   7 module m
   8   implicit none
   9 contains
  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
  24 end 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)
  37 end
  38 ! { dg-final { cleanup-modules "m" } }