2 ! { dg-options "-std=legacy" }
4 program char_pointer_assign
\r
5 ! Test character pointer assignments, required
\r
6 ! to fix PR18890 and PR21297
\r
7 ! Provided by Paul Thomas pault@gcc.gnu.org
\r
9 character*4, target :: t1
\r
10 character*4, target :: t2(4) =(/"lmno","lmno","lmno","lmno"/)
\r
11 character*4 :: const
\r
12 character*4, pointer :: c1, c3
\r
13 character*4, pointer :: c2(:), c4(:)
14 allocate (c3, c4(4))
\r
16 c3 = "lmno" ! pointer = constant
\r
17 t1 = c3 ! target = pointer
\r
18 c1 => t1 ! pointer =>target
\r
20 c3 = c1 ! pointer = pointer
\r
23 c1 => c3 ! pointer => pointer
\r
24 if (t1 /= "lnmo") call abort ()
\r
25 if (c1 /= "onml") call abort ()
\r
28 c4 = "lmno" ! pointer = constant
\r
29 t2 = c4 ! target = pointer
30 c2 => t2 ! pointer =>target
32 const(2:3) ="nm" ! c2(:)(2:3) = "nm" is still broken
\r
34 c4 = c2 ! pointer = pointer
\r
36 const(1:1) ="o" ! c4(:)(1:1) = "o" is still broken
\r
37 const(4:4) ="l" ! c4(:)(4:4) = "l" is still broken
\r
39 c2 => c4 ! pointer => pointer
\r
40 if (any (t2 /= "lnmo")) call abort ()
\r
41 if (any (c2 /= "onml")) call abort ()
\r
43 end program char_pointer_assign