xref: /llvm-project/flang/test/Semantics/structconst04.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! This test is structconst03.f90 with the type parameters removed.
5
6module usefrom
7  real, target :: usedfrom1
8end module usefrom
9
10module 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 = 0.
41  type(has_pointer1) :: modulevar2 = has_pointer1(modulevar1)
42  type(has_pointer2) :: modulevar3 = has_pointer2(has_pointer1(modulevar1))
43  type(has_pointer3) :: modulevar4 = has_pointer3(has_pointer1(modulevar1))
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 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
75    x2 = t2(has_pointer1(modulevar1))
76    !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
77    x3 = t3(has_pointer2(has_pointer1(modulevar1)))
78    !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
79    x4 = t4(has_pointer3(has_pointer1(modulevar1)))
80    !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'
81    x2 = t2(modulevar2)
82    !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'
83    x3 = t3(modulevar3)
84    !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'
85    x4 = t4(modulevar4)
86   contains
87    pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
88      real, target :: local1a
89      type(t1) :: x1a
90      type(t2) :: x2a
91      type(t3) :: x3a
92      type(t4) :: x4a
93      real, intent(in), target :: dummy1a
94      real, intent(inout), target :: dummy2a
95      real, pointer :: dummy3a
96      real, intent(inout), target :: dummy4a[*]
97      x1a = t1(local1a)
98      !ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure
99      x1a = t1(usedfrom1)
100      !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure
101      x1a = t1(modulevar1)
102      !ERROR: Externally visible object 'commonvar1' may not be associated with pointer component 'pt1' in a pure procedure
103      x1a = t1(commonvar1)
104      !ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure
105      x1a = t1(dummy1)
106      !ERROR: Externally visible object 'dummy1a' may not be associated with pointer component 'pt1' in a pure procedure
107      x1a = t1(dummy1a)
108      x1a = t1(dummy2a)
109      x1a = t1(dummy3)
110      x1a = t1(dummy3a)
111! TODO when semantics handles coindexing:
112! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
113! TODO x1a = t1(dummy4a[0])
114      x1a = t1(dummy4a)
115      !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
116      x2a = t2(has_pointer1(modulevar1))
117      !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
118      x3a = t3(has_pointer2(has_pointer1(modulevar1)))
119      !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
120      x4a = t4(has_pointer3(has_pointer1(modulevar1)))
121      !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'
122      x2a = t2(modulevar2)
123      !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'
124      x3a = t3(modulevar3)
125      !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'
126      x4a = t4(modulevar4)
127    end subroutine subr
128  end subroutine
129
130  pure integer function pf1(dummy3)
131    real, pointer :: dummy3
132    type(t1) :: x1
133    !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
134    x1 = t1(dummy3)
135   contains
136    pure subroutine subr(dummy3a)
137      real, pointer :: dummy3a
138      type(t1) :: x1a
139      !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
140      x1a = t1(dummy3)
141      x1a = t1(dummy3a)
142    end subroutine
143  end function
144
145  impure real function ipf1(dummy1, dummy2, dummy3, dummy4)
146    real, target :: local1
147    type(t1) :: x1
148    type(t2) :: x2
149    type(t3) :: x3
150    type(t4) :: x4
151    real, intent(in), target :: dummy1
152    real, intent(inout), target :: dummy2
153    real, pointer :: dummy3
154    real, intent(inout), target :: dummy4[*]
155    real, target :: commonvar1
156    common /cblock/ commonvar1
157    ipf1 = 0.
158    x1 = t1(local1)
159    x1 = t1(usedfrom1)
160    x1 = t1(modulevar1)
161    x1 = t1(commonvar1)
162    !WARNING: Pointer target is not a definable variable
163    !BECAUSE: 'dummy1' is an INTENT(IN) dummy argument
164    x1 = t1(dummy1)
165    x1 = t1(dummy2)
166    x1 = t1(dummy3)
167! TODO when semantics handles coindexing:
168! TODO x1 = t1(dummy4[0])
169    x1 = t1(dummy4)
170    x2 = t2(has_pointer1(modulevar1))
171    x3 = t3(has_pointer2(has_pointer1(modulevar1)))
172    x4 = t4(has_pointer3(has_pointer1(modulevar1)))
173    x2 = t2(modulevar2)
174    x3 = t3(modulevar3)
175    x4 = t4(modulevar4)
176  end function ipf1
177end module module1
178