blob: 45f6e7b64a8bd9d05946aff3c9cf16cbac92ffc6 [file] [log] [blame]
! { dg-do run }
! { dg-options "-ftest-forall-temp" }
!
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