! { dg-do run }
!
  implicit none
  character(len=5), pointer :: a(:), b(:)
  character(len=5), pointer :: c, d
  allocate (a(2), b(2), c, d)
  a = [ "abcde", "ABCDE" ]
  call aloct_pointer_copy_4 (b, a)
  !print *, b(1)
  !print *, b(2)
  if (any (a /= b)) stop 'WRONG'

  call aloct_copy_4 (b, a)
  !print *, b(1)
  !print *, b(2)
  if (any (a /= b)) stop 'WRONG'

  d = '12345'
  c = "abcde"
  call test2 (d, c)
  !print *, d
  if (d /= '1cb15') stop 'WRONG'

  call test2p (d, c)
  !print *, d
  if (d /= '1cb15') stop 'WRONG'

contains
 subroutine aloct_pointer_copy_4(o, i)
  character(len=*), pointer :: o(:), i(:)
  integer :: nl1, nu1
  integer :: i1
  nl1 = lbound(i,dim=1)
  nu1 = ubound(i,dim=1)
  forall (i1 = nl1:nu1) o(i1) = i(i1)
 end subroutine aloct_pointer_copy_4
 subroutine aloct_copy_4(o, i)
  character(len=*), pointer :: o(:), i(:)
  integer :: nl1, nu1
  integer :: i1
  nl1 = lbound(i,dim=1)
  nu1 = ubound(i,dim=1)
  forall (i1 = nl1:nu1) o(i1) = i(i1)
 end subroutine aloct_copy_4
 subroutine test2(o, i)
  character(len=*) :: o, i
  integer :: nl1, nu1
  integer :: i1
  nl1 = 2
  nu1 = 4
  forall (i1 = nl1:nu1) o(i1:i1) = i(i1:i1)
  forall (i1 = nl1:nu1) o(i1:i1) = o(nu1+1-i1:nu1+1-i1)
 end subroutine test2
 subroutine test2p(o, i)
  character(len=*), pointer :: o, i
  integer :: nl1, nu1
  integer :: i1
  nl1 = 2
  nu1 = 4
  forall (i1 = nl1:nu1) o(i1:i1) = i(i1:i1)   ! <<<< ICE
  forall (i1 = nl1:nu1) o(i1:i1) = o(nu1+1-i1:nu1+1-i1)
 end subroutine test2p
end