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