gcc/testsuite/gfortran.dg/char_pointer_assign.f90

   1 ! { dg-do run }
   2 program char_pointer_assign
   3 ! Test character pointer assignments, required
   4 ! to fix PR18890 and PR21297
   5 ! Provided by Paul Thomas pault@gcc.gnu.org
   6   implicit none
   7   character*4, target        :: t1
   8   character*4, target        :: t2(4) =(/"lmno","lmno","lmno","lmno"/)
   9   character*4                :: const
  10   character*4, pointer       :: c1, c3
  11   character*4, pointer       :: c2(:), c4(:)
  12   allocate (c3, c4(4))
  13 ! Scalars first.
  14   c3 = "lmno"          ! pointer = constant
  15   t1 = c3              ! target = pointer
  16   c1 => t1             ! pointer =>target
  17   c1(2:3) = "nm"
  18   c3 = c1              ! pointer = pointer
  19   c3(1:1) = "o"
  20   c3(4:4) = "l"
  21   c1 => c3             ! pointer => pointer
  22   if (t1 /= "lnmo") call abort ()
  23   if (c1 /= "onml") call abort ()
  24
  25 ! Now arrays.
  26   c4 = "lmno"          ! pointer = constant
  27   t2 = c4              ! target = pointer
  28   c2 => t2             ! pointer =>target
  29   const = c2(1)
  30   const(2:3) ="nm"     ! c2(:)(2:3) = "nm" is still broken
  31   c2 = const
  32   c4 = c2              ! pointer = pointer
  33   const = c4(1)
  34   const(1:1) ="o"      ! c4(:)(1:1) = "o" is still broken
  35   const(4:4) ="l"      ! c4(:)(4:4) = "l" is still broken
  36   c4 = const
  37   c2 => c4             ! pointer => pointer
  38   if (any (t2 /= "lnmo")) call abort ()
  39   if (any (c2 /= "onml")) call abort ()
  40   deallocate (c3, c4)
  41 end program char_pointer_assign