1procedure T_Directly_Accessed_Globals is
2   package P1 is
3      function Get_Next return Integer;
4   end P1;
5   package body P1 is    -- OK
6      I1 : Integer;
7      Count : Integer := 0;
8      S1 : String (1..10);
9      S2 : String renames S1;
10      S3 : String (1..10);
11
12      procedure Read is
13         I : Integer;
14      begin
15         I := I1;
16         if S1 = "" then
17            null;
18         end if;
19         if S2 = "" then
20            null;
21         end if;
22      end Read;
23
24      procedure Write is
25      begin
26         I1 := 1;
27         S1 (1) := 'a';
28         S1 := (others => ' ');
29         S2 := (others => ' ');
30      end Write;
31
32      procedure Update is
33      begin
34         S3 (1) := 'a';
35         if S3 = "" then
36            null;
37         end if;
38      end Update;
39
40      function Get_Next return Integer is
41      begin
42         Count := Count + 1;
43         return Count;
44      end Get_Next;
45
46      package Pack1 is
47         protected Prot is
48            function  Read return Integer;
49            entry     Write;
50            procedure Read_Write;
51         end Prot;
52      end Pack1;
53
54      package body Pack1 is
55         I1, I2 : Integer;
56
57         protected body Prot is
58            function Read return Integer is
59            begin
60               return I1;
61            end Read;
62
63            entry Write when True is
64            begin
65               I2 := 1;
66            end Write;
67
68            procedure Read_Write is
69            begin
70               I1 := I2;
71            end Read_Write;
72         end Prot;
73      end Pack1;
74
75      package Pack2 is
76         task T is
77            entry Read;
78            entry Write;
79            entry Read_Write;
80         end T;
81      end Pack2;
82
83      package body Pack2 is
84         I1, I2 : Integer;
85
86         task body T is
87            Local : Integer;
88         begin
89            accept Read do
90               Local := I1;
91            end Read;
92
93            accept Write do
94               I2 := 1;
95            end Write;
96
97            accept Read_Write do
98               I1 := I2;
99            end Read_Write;
100         end T;
101      end Pack2;
102   end P1;
103
104   package P2 is
105   end P2;
106   package body P2 is
107      I1 : Integer;
108      Count : Integer := 0;
109      S1    : String (1 .. 10);
110      S2    : Character renames S1 (I1);         -- Not from subprogram I1, OK S1
111
112      type Rec is
113         record
114            I, J : Integer;
115         end record;
116      R : Rec;
117
118      package Pack is
119         G1 : aliased Integer;                -- OK, not package body
120      end Pack;
121
122      package body Pack is
123         G2, G3, G4 : Integer;                -- G2 not read, G3 not written, G4 not read/written
124         procedure P1 is
125         begin
126            G2 := 1;
127         end P1;
128         procedure P2 is
129         begin
130            G1 := G3;
131         end P2;
132      end Pack;
133
134      procedure Read1 is
135         I : Integer;
136      begin
137         I := I1;
138         if S1 = "" then
139            null;
140         end if;
141         if S2 = 'a' then
142            null;
143         end if;
144         if R.I = 1 then
145            null;
146         end if;
147      end Read1;
148
149      procedure Write is
150      begin
151         I1 := 1;
152         S1 (1) := 'a';
153         S1 := (others => ' ');
154         R.J := 0;
155      end Write;
156
157      procedure Update is
158         procedure Inner is
159         begin
160            I1 := 1;                -- Nested subprogram, Written
161         end Inner;
162         Ren1 : Integer renames R.I;
163         Ren2 : Integer renames R.J;
164      begin
165         I1 := 1;                   -- already written
166         S2 := 'a';                 -- already written
167         if S1 = "" then            -- already read
168            null;
169         end if;
170         R.J  := R.I;               -- already written, already read
171         Ren1 := Ren2;              -- already written, already read
172      end Update;
173
174      function Get_Next return Integer is
175      begin
176         Count := Count + 1;
177         return Count;
178      end Get_Next;
179
180      function Get_Current return Integer is
181      begin
182         return Count;                 -- already read
183      end Get_Current;
184
185      generic
186      procedure Gen;
187
188      procedure Gen is
189      begin
190         I1 := 1;                      -- Generic subprogram, already written
191      end Gen;
192   begin
193      S2 := 'a';                       -- Not from subprogram
194   end P2;
195
196   package P3 is
197   end P3;
198   package body P3 is
199      I1 : Integer;
200      I2 : Integer;                    -- Not from same protected object
201      I3 : Integer;
202
203      protected type Prot1 is
204         function  Read return Integer;
205         entry     Write;
206      end Prot1;
207
208      protected body Prot1 is
209         function Read return Integer is
210         begin
211            return I1;             -- From protected type
212         end Read;
213
214         entry Write when True is
215         begin
216            I1 := 1;              -- From protected type
217         end Write;
218      end Prot1;
219
220      protected Prot21 is
221         function  Read return Integer;
222      end Prot21;
223
224      protected body Prot21 is
225         function Read return Integer is
226         begin
227            return I2;
228         end Read;
229      end Prot21;
230
231      protected Prot22 is
232         entry Write;
233      end Prot22;
234
235      protected body Prot22 is
236         entry Write when True is
237         begin
238            I2 := 1;
239         end Write;
240      end Prot22;
241
242      procedure Proc is
243         protected Prot3 is
244            function  Read return Integer;
245            entry     Write;
246         end Prot3;
247
248         protected body Prot3 is
249            function Read return Integer is
250            begin
251               return I3;             -- Nested PO
252            end Read;
253
254            entry Write when True is
255            begin
256               I3 := 3;              -- Nested PO
257            end Write;
258         end Prot3;
259      begin
260         null;
261      end Proc;
262   end P3;
263
264   package P4 is
265   end P4;
266   package body P4 is
267      I1 : Integer;
268      I2 : Integer;                    -- Not from same task object
269      I3 : Integer;
270
271      task type Task1 is
272         entry Read;
273         entry Write;
274      end Task1;
275
276      task body Task1 is
277         Local : Integer;
278      begin
279         accept Read do
280            Local := I1;             -- From task type
281         end Read;
282
283         accept Write do
284            I1 := 1;                 -- From task type
285         end Write;
286      end Task1;
287
288      task Task21 is
289         entry  Read;
290      end Task21;
291
292      task body Task21 is
293         Local : Integer;
294      begin
295         accept Read do
296            Local := I2;
297         end Read;
298      end Task21;
299
300      task Task22 is
301         entry Write;
302      end Task22;
303
304      task body Task22 is
305      begin
306         accept Write do
307            I2 := 1;
308         end Write;
309      end Task22;
310
311      procedure Proc is
312         task Task3 is
313            entry Read;
314            entry Write;
315         end Task3;
316
317         task body Task3 is
318            Local : Integer;
319         begin
320            accept Read do
321               Local := I3;             -- Nested task
322            end Read;
323
324            accept Write do
325               I3 := 3;                 -- Nested task
326            end Write;
327         end Task3;
328      begin
329         null;
330      end Proc;
331   end P4;
332
333begin
334   null;
335end T_Directly_Accessed_Globals;
336