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