--- /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