1! RUN: %B/test/Semantics/test_errors.sh %s %flang %t
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    !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
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      !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
105      x1a = t1(dummy3)
106      !ERROR: Externally visible object 'dummy3a' may not be associated with pointer component 'pt1' in a pure procedure
107      x1a = t1(dummy3a)
108! TODO when semantics handles coindexing:
109! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
110! TODO x1a = t1(dummy4a[0])
111      x1a = t1(dummy4a)
112      !ERROR: Externally visible object 'modulevar2' may not be associated with pointer component 'ptop' in a pure procedure
113      x2a = t2(modulevar2)
114      !ERROR: Externally visible object 'modulevar3' may not be associated with pointer component 'ptop' in a pure procedure
115      x3a = t3(modulevar3)
116      !ERROR: Externally visible object 'modulevar4' may not be associated with pointer component 'ptop' in a pure procedure
117      x4a = t4(modulevar4)
118    end subroutine subr
119  end subroutine
120
121  impure real function ipf1(dummy1, dummy2, dummy3, dummy4)
122    real, target :: local1
123    type(t1) :: x1
124    type(t2) :: x2
125    type(t3) :: x3
126    type(t4) :: x4
127    real, intent(in), target :: dummy1
128    real, intent(inout), target :: dummy2
129    real, pointer :: dummy3
130    real, intent(inout), target :: dummy4[*]
131    real, target :: commonvar1
132    common /cblock/ commonvar1
133    ipf1 = 0.
134    x1 = t1(local1)
135    x1 = t1(usedfrom1)
136    x1 = t1(modulevar1)
137    x1 = t1(commonvar1)
138    x1 = t1(dummy1)
139    x1 = t1(dummy2)
140    x1 = t1(dummy3)
141! TODO when semantics handles coindexing:
142! TODO x1 = t1(dummy4[0])
143    x1 = t1(dummy4)
144    x2 = t2(modulevar2)
145    x3 = t3(modulevar3)
146    x4 = t4(modulevar4)
147  end function ipf1
148end module module1
149