Mercurial > hg > CbC > CbC_gcc
diff gcc/testsuite/gfortran.dg/pr55086_1.f90 @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 (2017-10-27) |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gcc/testsuite/gfortran.dg/pr55086_1.f90 Fri Oct 27 22:46:09 2017 +0900 @@ -0,0 +1,63 @@ +! { 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