[flang] Infrastructure improvements in utility routines
[lldb.git] / flang / test / Semantics / structconst04.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 ! This test is structconst03.f90 with the type parameters removed.
5
6 module usefrom
7   real, target :: usedfrom1
8 end module usefrom
9
10 module module1
11   use usefrom
12   implicit none
13   type :: has_pointer1
14     real, pointer :: ptop
15     type(has_pointer1), allocatable :: link1 ! don't loop during analysis
16   end type has_pointer1
17   type :: has_pointer2
18     type(has_pointer1) :: pnested
19     type(has_pointer2), allocatable :: link2
20   end type has_pointer2
21   type, extends(has_pointer2) :: has_pointer3
22     type(has_pointer3), allocatable :: link3
23   end type has_pointer3
24   type :: t1
25     real, pointer :: pt1
26     type(t1), allocatable :: link
27   end type t1
28   type :: t2
29     type(has_pointer1) :: hp1
30     type(t2), allocatable :: link
31   end type t2
32   type :: t3
33     type(has_pointer2) :: hp2
34     type(t3), allocatable :: link
35   end type t3
36   type :: t4
37     type(has_pointer3) :: hp3
38     type(t4), allocatable :: link
39   end type t4
40   real, target :: modulevar1
41   type(has_pointer1) :: modulevar2
42   type(has_pointer2) :: modulevar3
43   type(has_pointer3) :: modulevar4
44
45  contains
46
47   pure subroutine ps1(dummy1, dummy2, dummy3, dummy4)
48     real, target :: local1
49     type(t1) :: x1
50     type(t2) :: x2
51     type(t3) :: x3
52     type(t4) :: x4
53     real, intent(in), target :: dummy1
54     real, intent(inout), target :: dummy2
55     real, pointer :: dummy3
56     real, intent(inout), target :: dummy4[*]
57     real, target :: commonvar1
58     common /cblock/ commonvar1
59     x1 = t1(local1)
60     !ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure
61     x1 = t1(usedfrom1)
62     !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure
63     x1 = t1(modulevar1)
64     !ERROR: Externally visible object 'cblock' may not be associated with pointer component 'pt1' in a pure procedure
65     x1 = t1(commonvar1)
66     !ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure
67     x1 = t1(dummy1)
68     x1 = t1(dummy2)
69     x1 = t1(dummy3)
70 ! TODO when semantics handles coindexing:
71 ! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
72 ! TODO x1 = t1(dummy4[0])
73     x1 = t1(dummy4)
74     !ERROR: Externally visible object 'modulevar2' may not be associated with pointer component 'ptop' in a pure procedure
75     x2 = t2(modulevar2)
76     !ERROR: Externally visible object 'modulevar3' may not be associated with pointer component 'ptop' in a pure procedure
77     x3 = t3(modulevar3)
78     !ERROR: Externally visible object 'modulevar4' may not be associated with pointer component 'ptop' in a pure procedure
79     x4 = t4(modulevar4)
80    contains
81     pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
82       real, target :: local1a
83       type(t1) :: x1a
84       type(t2) :: x2a
85       type(t3) :: x3a
86       type(t4) :: x4a
87       real, intent(in), target :: dummy1a
88       real, intent(inout), target :: dummy2a
89       real, pointer :: dummy3a
90       real, intent(inout), target :: dummy4a[*]
91       x1a = t1(local1a)
92       !ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure
93       x1a = t1(usedfrom1)
94       !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure
95       x1a = t1(modulevar1)
96       !ERROR: Externally visible object 'commonvar1' may not be associated with pointer component 'pt1' in a pure procedure
97       x1a = t1(commonvar1)
98       !ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure
99       x1a = t1(dummy1)
100       !ERROR: Externally visible object 'dummy1a' may not be associated with pointer component 'pt1' in a pure procedure
101       x1a = t1(dummy1a)
102       x1a = t1(dummy2a)
103       x1a = t1(dummy3)
104       x1a = t1(dummy3a)
105 ! TODO when semantics handles coindexing:
106 ! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
107 ! TODO x1a = t1(dummy4a[0])
108       x1a = t1(dummy4a)
109       !ERROR: Externally visible object 'modulevar2' may not be associated with pointer component 'ptop' in a pure procedure
110       x2a = t2(modulevar2)
111       !ERROR: Externally visible object 'modulevar3' may not be associated with pointer component 'ptop' in a pure procedure
112       x3a = t3(modulevar3)
113       !ERROR: Externally visible object 'modulevar4' may not be associated with pointer component 'ptop' in a pure procedure
114       x4a = t4(modulevar4)
115     end subroutine subr
116   end subroutine
117
118   pure integer function pf1(dummy3)
119     real, pointer :: dummy3
120     type(t1) :: x1
121     !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
122     x1 = t1(dummy3)
123    contains
124     pure subroutine subr(dummy3a)
125       real, pointer :: dummy3a
126       type(t1) :: x1a
127       !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
128       x1a = t1(dummy3)
129       x1a = t1(dummy3a)
130     end subroutine
131   end function
132
133   impure real function ipf1(dummy1, dummy2, dummy3, dummy4)
134     real, target :: local1
135     type(t1) :: x1
136     type(t2) :: x2
137     type(t3) :: x3
138     type(t4) :: x4
139     real, intent(in), target :: dummy1
140     real, intent(inout), target :: dummy2
141     real, pointer :: dummy3
142     real, intent(inout), target :: dummy4[*]
143     real, target :: commonvar1
144     common /cblock/ commonvar1
145     ipf1 = 0.
146     x1 = t1(local1)
147     x1 = t1(usedfrom1)
148     x1 = t1(modulevar1)
149     x1 = t1(commonvar1)
150     x1 = t1(dummy1)
151     x1 = t1(dummy2)
152     x1 = t1(dummy3)
153 ! TODO when semantics handles coindexing:
154 ! TODO x1 = t1(dummy4[0])
155     x1 = t1(dummy4)
156     x2 = t2(modulevar2)
157     x3 = t3(modulevar3)
158     x4 = t4(modulevar4)
159   end function ipf1
160 end module module1