view gcc/testsuite/gfortran.dg/transfer_intrinsic_3.f90 @ 144:8f4e72ab4e11

fix segmentation fault caused by nothing next cur_op to end
author Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Sun, 23 Dec 2018 21:23:56 +0900
parents 84e7813d76e9
children
line wrap: on
line source

! { 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
      STOP 1
    else IF ((n .ge. 2) .and. (len (uri) .ne. n - 1)) then 
      STOP 2
    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