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