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