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! 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
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
160end module module1
161