1! RUN: %python %S/test_errors.py %s %flang_fc1
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
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
166end module module1
167