[flang] Infrastructure improvements in utility routines
[lldb.git] / flang / test / Semantics / structconst03.f90
1 ! RUN: %S/test_errors.sh %s %t %f18
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
7 module usefrom
8   real, target :: usedfrom1
9 end module usefrom
10
11 module 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
46   type(has_pointer1) :: modulevar2
47   type(has_pointer2) :: modulevar3
48   type(has_pointer3) :: modulevar4
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 'modulevar2' may not be associated with pointer component 'ptop' in a pure procedure
80     x2 = t2(0)(modulevar2)
81     !ERROR: Externally visible object 'modulevar3' may not be associated with pointer component 'ptop' in a pure procedure
82     x3 = t3(0)(modulevar3)
83     !ERROR: Externally visible object 'modulevar4' may not be associated with pointer component 'ptop' in a pure procedure
84     x4 = t4(0)(modulevar4)
85    contains
86     pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
87       real, target :: local1a
88       type(t1(0)) :: x1a
89       type(t2(0)) :: x2a
90       type(t3(0)) :: x3a
91       type(t4(0)) :: x4a
92       real, intent(in), target :: dummy1a
93       real, intent(inout), target :: dummy2a
94       real, pointer :: dummy3a
95       real, intent(inout), target :: dummy4a[*]
96       x1a = t1(0)(local1a)
97       !ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure
98       x1a = t1(0)(usedfrom1)
99       !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure
100       x1a = t1(0)(modulevar1)
101       !ERROR: Externally visible object 'commonvar1' may not be associated with pointer component 'pt1' in a pure procedure
102       x1a = t1(0)(commonvar1)
103       !ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure
104       x1a = t1(0)(dummy1)
105       !ERROR: Externally visible object 'dummy1a' may not be associated with pointer component 'pt1' in a pure procedure
106       x1a = t1(0)(dummy1a)
107       x1a = t1(0)(dummy2a)
108       x1a = t1(0)(dummy3)
109       x1a = t1(0)(dummy3a)
110 ! TODO when semantics handles coindexing:
111 ! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
112 ! TODO x1a = t1(0)(dummy4a[0])
113       x1a = t1(0)(dummy4a)
114       !ERROR: Externally visible object 'modulevar2' may not be associated with pointer component 'ptop' in a pure procedure
115       x2a = t2(0)(modulevar2)
116       !ERROR: Externally visible object 'modulevar3' may not be associated with pointer component 'ptop' in a pure procedure
117       x3a = t3(0)(modulevar3)
118       !ERROR: Externally visible object 'modulevar4' may not be associated with pointer component 'ptop' in a pure procedure
119       x4a = t4(0)(modulevar4)
120     end subroutine subr
121   end subroutine
122
123   pure integer function pf1(dummy3)
124     real, pointer :: dummy3
125     type(t1(0)) :: x1
126     pf1 = 0
127     !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
128     x1 = t1(0)(dummy3)
129    contains
130     pure subroutine subr(dummy3a)
131       real, pointer :: dummy3a
132       type(t1(0)) :: x1a
133       !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
134       x1a = t1(0)(dummy3)
135       x1a = t1(0)(dummy3a)
136     end subroutine
137   end function
138
139   impure real function ipf1(dummy1, dummy2, dummy3, dummy4)
140     real, target :: local1
141     type(t1(0)) :: x1
142     type(t2(0)) :: x2
143     type(t3(0)) :: x3
144     type(t4(0)) :: x4
145     real, intent(in), target :: dummy1
146     real, intent(inout), target :: dummy2
147     real, pointer :: dummy3
148     real, intent(inout), target :: dummy4[*]
149     real, target :: commonvar1
150     common /cblock/ commonvar1
151     ipf1 = 0.
152     x1 = t1(0)(local1)
153     x1 = t1(0)(usedfrom1)
154     x1 = t1(0)(modulevar1)
155     x1 = t1(0)(commonvar1)
156     x1 = t1(0)(dummy1)
157     x1 = t1(0)(dummy2)
158     x1 = t1(0)(dummy3)
159 ! TODO when semantics handles coindexing:
160 ! TODO x1 = t1(0)(dummy4[0])
161     x1 = t1(0)(dummy4)
162     x2 = t2(0)(modulevar2)
163     x3 = t3(0)(modulevar3)
164     x4 = t4(0)(modulevar4)
165   end function ipf1
166 end module module1