gcc/testsuite/gfortran.dg/char_pointer_assign.f90

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