xref: /llvm-project/flang/test/Semantics/structconst03.f90 (revision 191d48723f8b853a6ad65532c173c67155cbe606)
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
2! Error tests for structure constructors: C1594 violations
3! from assigning globally-visible data to POINTER components.
4! test/Semantics/structconst04.f90 is this same test without type
5! parameters.
6
7module usefrom
8  real, target :: usedfrom1
9end module usefrom
10
11module module1
12  use usefrom
13  implicit none
14  type :: has_pointer1
15    real, pointer :: ptop
16    type(has_pointer1), allocatable :: link1 ! don't loop during analysis
17  end type has_pointer1
18  type :: has_pointer2
19    type(has_pointer1) :: pnested
20    type(has_pointer2), allocatable :: link2
21  end type has_pointer2
22  type, extends(has_pointer2) :: has_pointer3
23    type(has_pointer3), allocatable :: link3
24  end type has_pointer3
25  type :: t1(k)
26    integer, kind :: k
27    real, pointer :: pt1
28    type(t1(k)), allocatable :: link
29  end type t1
30  type :: t2(k)
31    integer, kind :: k
32    type(has_pointer1) :: hp1
33    type(t2(k)), allocatable :: link
34  end type t2
35  type :: t3(k)
36    integer, kind :: k
37    type(has_pointer2) :: hp2
38    type(t3(k)), allocatable :: link
39  end type t3
40  type :: t4(k)
41    integer, kind :: k
42    type(has_pointer3) :: hp3
43    type(t4(k)), allocatable :: link
44  end type t4
45  real, target :: modulevar1 = 0.
46  type(has_pointer1) :: modulevar2 = has_pointer1(modulevar1)
47  type(has_pointer2) :: modulevar3 = has_pointer2(has_pointer1(modulevar1))
48  type(has_pointer3) :: modulevar4 = has_pointer3(has_pointer1(modulevar1))
49
50 contains
51
52  pure subroutine ps1(dummy1, dummy2, dummy3, dummy4)
53    real, target :: local1
54    type(t1(0)) :: x1
55    type(t2(0)) :: x2
56    type(t3(0)) :: x3
57    type(t4(0)) :: x4
58    real, intent(in), target :: dummy1
59    real, intent(inout), target :: dummy2
60    real, pointer :: dummy3
61    real, intent(inout), target :: dummy4[*]
62    real, target :: commonvar1
63    common /cblock/ commonvar1
64    x1 = t1(0)(local1)
65    !ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure
66    x1 = t1(0)(usedfrom1)
67    !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure
68    x1 = t1(0)(modulevar1)
69    !ERROR: Externally visible object 'cblock' may not be associated with pointer component 'pt1' in a pure procedure
70    x1 = t1(0)(commonvar1)
71    !ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure
72    x1 = t1(0)(dummy1)
73    x1 = t1(0)(dummy2)
74    x1 = t1(0)(dummy3)
75! TODO when semantics handles coindexing:
76! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
77! TODO x1 = t1(0)(dummy4[0])
78    x1 = t1(0)(dummy4)
79    !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
80    x2 = t2(0)(has_pointer1(modulevar1))
81    !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
82    x3 = t3(0)(has_pointer2(has_pointer1(modulevar1)))
83    !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
84    x4 = t4(0)(has_pointer3(has_pointer1(modulevar1)))
85    !ERROR: The externally visible object 'modulevar2' may not be used in a pure procedure as the value for component 'hp1' which has the pointer component 'ptop'
86    x2 = t2(0)(modulevar2)
87    !ERROR: The externally visible object 'modulevar3' may not be used in a pure procedure as the value for component 'hp2' which has the pointer component 'ptop'
88    x3 = t3(0)(modulevar3)
89    !ERROR: The externally visible object 'modulevar4' may not be used in a pure procedure as the value for component 'hp3' which has the pointer component 'ptop'
90    x4 = t4(0)(modulevar4)
91   contains
92    pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
93      real, target :: local1a
94      type(t1(0)) :: x1a
95      type(t2(0)) :: x2a
96      type(t3(0)) :: x3a
97      type(t4(0)) :: x4a
98      real, intent(in), target :: dummy1a
99      real, intent(inout), target :: dummy2a
100      real, pointer :: dummy3a
101      real, intent(inout), target :: dummy4a[*]
102      x1a = t1(0)(local1a)
103      !ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure
104      x1a = t1(0)(usedfrom1)
105      !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure
106      x1a = t1(0)(modulevar1)
107      !ERROR: Externally visible object 'commonvar1' may not be associated with pointer component 'pt1' in a pure procedure
108      x1a = t1(0)(commonvar1)
109      !ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure
110      x1a = t1(0)(dummy1)
111      !ERROR: Externally visible object 'dummy1a' may not be associated with pointer component 'pt1' in a pure procedure
112      x1a = t1(0)(dummy1a)
113      x1a = t1(0)(dummy2a)
114      x1a = t1(0)(dummy3)
115      x1a = t1(0)(dummy3a)
116! TODO when semantics handles coindexing:
117! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
118! TODO x1a = t1(0)(dummy4a[0])
119      x1a = t1(0)(dummy4a)
120      !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
121      x2a = t2(0)(has_pointer1(modulevar1))
122      !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
123      x3a = t3(0)(has_pointer2(has_pointer1(modulevar1)))
124      !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
125      x4a = t4(0)(has_pointer3(has_pointer1(modulevar1)))
126      !ERROR: The externally visible object 'modulevar2' may not be used in a pure procedure as the value for component 'hp1' which has the pointer component 'ptop'
127      x2a = t2(0)(modulevar2)
128      !ERROR: The externally visible object 'modulevar3' may not be used in a pure procedure as the value for component 'hp2' which has the pointer component 'ptop'
129      x3a = t3(0)(modulevar3)
130      !ERROR: The externally visible object 'modulevar4' may not be used in a pure procedure as the value for component 'hp3' which has the pointer component 'ptop'
131      x4a = t4(0)(modulevar4)
132    end subroutine subr
133  end subroutine
134
135  pure integer function pf1(dummy3)
136    real, pointer :: dummy3
137    type(t1(0)) :: x1
138    pf1 = 0
139    !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
140    x1 = t1(0)(dummy3)
141   contains
142    pure subroutine subr(dummy3a)
143      real, pointer :: dummy3a
144      type(t1(0)) :: x1a
145      !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
146      x1a = t1(0)(dummy3)
147      x1a = t1(0)(dummy3a)
148    end subroutine
149  end function
150
151  impure real function ipf1(dummy1, dummy2, dummy3, dummy4)
152    real, target :: local1
153    type(t1(0)) :: x1
154    type(t2(0)) :: x2
155    type(t3(0)) :: x3
156    type(t4(0)) :: x4
157    real, intent(in), target :: dummy1
158    real, intent(inout), target :: dummy2
159    real, pointer :: dummy3
160    real, intent(inout), target :: dummy4[*]
161    real, target :: commonvar1
162    common /cblock/ commonvar1
163    ipf1 = 0.
164    x1 = t1(0)(local1)
165    x1 = t1(0)(usedfrom1)
166    x1 = t1(0)(modulevar1)
167    x1 = t1(0)(commonvar1)
168    !WARNING: Pointer target is not a definable variable
169    !BECAUSE: 'dummy1' is an INTENT(IN) dummy argument
170    x1 = t1(0)(dummy1)
171    x1 = t1(0)(dummy2)
172    x1 = t1(0)(dummy3)
173! TODO when semantics handles coindexing:
174! TODO x1 = t1(0)(dummy4[0])
175    x1 = t1(0)(dummy4)
176    x2 = t2(0)(has_pointer1(modulevar1))
177    x3 = t3(0)(has_pointer2(has_pointer1(modulevar1)))
178    x4 = t4(0)(has_pointer3(has_pointer1(modulevar1)))
179    x2 = t2(0)(modulevar2)
180    x3 = t3(0)(modulevar3)
181    x4 = t4(0)(modulevar4)
182  end function ipf1
183end module module1
184