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