Subversion Repositories openrisc

! { dg-do run }

program char_pointer_assign

! Test character pointer assignments, required

! to fix PR18890 and PR21297

! Provided by Paul Thomas pault@gcc.gnu.org

  implicit none

  character*4, target        :: t1

  character*4, target        :: t2(4) =(/"lmno","lmno","lmno","lmno"/)

  character*4                :: const

  character*4, pointer       :: c1, c3

  character*4, pointer       :: c2(:), c4(:)

  allocate (c3, c4(4))

! Scalars first.

  c3 = "lmno"          ! pointer = constant

  t1 = c3              ! target = pointer

  c1 => t1             ! pointer =>target

  c1(2:3) = "nm"

  c3 = c1              ! pointer = pointer

  c3(1:1) = "o"

  c3(4:4) = "l"

  c1 => c3             ! pointer => pointer

  if (t1 /= "lnmo") call abort ()

  if (c1 /= "onml") call abort ()

! Now arrays.

  c4 = "lmno"          ! pointer = constant

  t2 = c4              ! target = pointer

  c2 => t2             ! pointer =>target

  const = c2(1)

  const(2:3) ="nm"     ! c2(:)(2:3) = "nm" is still broken

  c2 = const

  c4 = c2              ! pointer = pointer

  const = c4(1)

  const(1:1) ="o"      ! c4(:)(1:1) = "o" is still broken

  const(4:4) ="l"      ! c4(:)(4:4) = "l" is still broken

  c4 = const

  c2 => c4             ! pointer => pointer

  if (any (t2 /= "lnmo")) call abort ()

  if (any (c2 /= "onml")) call abort ()

  deallocate (c3, c4)

end program char_pointer_assign