structconst04.f90
5.7 KB
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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
! RUN: %S/test_errors.sh %s %t %f18
! Error tests for structure constructors: C1594 violations
! from assigning globally-visible data to POINTER components.
! This test is structconst03.f90 with the type parameters removed.
module usefrom
real, target :: usedfrom1
end module usefrom
module module1
use usefrom
implicit none
type :: has_pointer1
real, pointer :: ptop
type(has_pointer1), allocatable :: link1 ! don't loop during analysis
end type has_pointer1
type :: has_pointer2
type(has_pointer1) :: pnested
type(has_pointer2), allocatable :: link2
end type has_pointer2
type, extends(has_pointer2) :: has_pointer3
type(has_pointer3), allocatable :: link3
end type has_pointer3
type :: t1
real, pointer :: pt1
type(t1), allocatable :: link
end type t1
type :: t2
type(has_pointer1) :: hp1
type(t2), allocatable :: link
end type t2
type :: t3
type(has_pointer2) :: hp2
type(t3), allocatable :: link
end type t3
type :: t4
type(has_pointer3) :: hp3
type(t4), allocatable :: link
end type t4
real, target :: modulevar1
type(has_pointer1) :: modulevar2
type(has_pointer2) :: modulevar3
type(has_pointer3) :: modulevar4
contains
pure subroutine ps1(dummy1, dummy2, dummy3, dummy4)
real, target :: local1
type(t1) :: x1
type(t2) :: x2
type(t3) :: x3
type(t4) :: x4
real, intent(in), target :: dummy1
real, intent(inout), target :: dummy2
real, pointer :: dummy3
real, intent(inout), target :: dummy4[*]
real, target :: commonvar1
common /cblock/ commonvar1
x1 = t1(local1)
!ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure
x1 = t1(usedfrom1)
!ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure
x1 = t1(modulevar1)
!ERROR: Externally visible object 'cblock' may not be associated with pointer component 'pt1' in a pure procedure
x1 = t1(commonvar1)
!ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure
x1 = t1(dummy1)
x1 = t1(dummy2)
!ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
x1 = t1(dummy3)
! TODO when semantics handles coindexing:
! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
! TODO x1 = t1(dummy4[0])
x1 = t1(dummy4)
!ERROR: Externally visible object 'modulevar2' may not be associated with pointer component 'ptop' in a pure procedure
x2 = t2(modulevar2)
!ERROR: Externally visible object 'modulevar3' may not be associated with pointer component 'ptop' in a pure procedure
x3 = t3(modulevar3)
!ERROR: Externally visible object 'modulevar4' may not be associated with pointer component 'ptop' in a pure procedure
x4 = t4(modulevar4)
contains
pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
real, target :: local1a
type(t1) :: x1a
type(t2) :: x2a
type(t3) :: x3a
type(t4) :: x4a
real, intent(in), target :: dummy1a
real, intent(inout), target :: dummy2a
real, pointer :: dummy3a
real, intent(inout), target :: dummy4a[*]
x1a = t1(local1a)
!ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure
x1a = t1(usedfrom1)
!ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure
x1a = t1(modulevar1)
!ERROR: Externally visible object 'commonvar1' may not be associated with pointer component 'pt1' in a pure procedure
x1a = t1(commonvar1)
!ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure
x1a = t1(dummy1)
!ERROR: Externally visible object 'dummy1a' may not be associated with pointer component 'pt1' in a pure procedure
x1a = t1(dummy1a)
x1a = t1(dummy2a)
!ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
x1a = t1(dummy3)
!ERROR: Externally visible object 'dummy3a' may not be associated with pointer component 'pt1' in a pure procedure
x1a = t1(dummy3a)
! TODO when semantics handles coindexing:
! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
! TODO x1a = t1(dummy4a[0])
x1a = t1(dummy4a)
!ERROR: Externally visible object 'modulevar2' may not be associated with pointer component 'ptop' in a pure procedure
x2a = t2(modulevar2)
!ERROR: Externally visible object 'modulevar3' may not be associated with pointer component 'ptop' in a pure procedure
x3a = t3(modulevar3)
!ERROR: Externally visible object 'modulevar4' may not be associated with pointer component 'ptop' in a pure procedure
x4a = t4(modulevar4)
end subroutine subr
end subroutine
impure real function ipf1(dummy1, dummy2, dummy3, dummy4)
real, target :: local1
type(t1) :: x1
type(t2) :: x2
type(t3) :: x3
type(t4) :: x4
real, intent(in), target :: dummy1
real, intent(inout), target :: dummy2
real, pointer :: dummy3
real, intent(inout), target :: dummy4[*]
real, target :: commonvar1
common /cblock/ commonvar1
ipf1 = 0.
x1 = t1(local1)
x1 = t1(usedfrom1)
x1 = t1(modulevar1)
x1 = t1(commonvar1)
x1 = t1(dummy1)
x1 = t1(dummy2)
x1 = t1(dummy3)
! TODO when semantics handles coindexing:
! TODO x1 = t1(dummy4[0])
x1 = t1(dummy4)
x2 = t2(modulevar2)
x3 = t3(modulevar3)
x4 = t4(modulevar4)
end function ipf1
end module module1