|
111
|
1 -- C83051A.ADA
|
|
|
2
|
|
|
3 -- Grant of Unlimited Rights
|
|
|
4 --
|
|
|
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
|
|
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
|
|
7 -- unlimited rights in the software and documentation contained herein.
|
|
|
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
|
|
9 -- this public release, the Government intends to confer upon all
|
|
|
10 -- recipients unlimited rights equal to those held by the Government.
|
|
|
11 -- These rights include rights to use, duplicate, release or disclose the
|
|
|
12 -- released technical data and computer software in whole or in part, in
|
|
|
13 -- any manner and for any purpose whatsoever, and to have or permit others
|
|
|
14 -- to do so.
|
|
|
15 --
|
|
|
16 -- DISCLAIMER
|
|
|
17 --
|
|
|
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
|
|
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
|
|
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
|
|
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
|
|
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
|
|
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
|
|
|
24 --*
|
|
|
25 -- OBJECTIVE:
|
|
|
26 -- CHECK THAT DECLARATIONS IN THE VISIBLE PART OF A PACKAGE NESTED
|
|
|
27 -- WITHIN THE VISIBLE PART OF A PACKAGE ARE VISIBLE BY SELECTION
|
|
|
28 -- FROM OUTSIDE THE OUTERMOST PACKAGE.
|
|
|
29
|
|
|
30 -- HISTORY:
|
|
|
31 -- GMT 09/07/88 CREATED ORIGINAL TEST.
|
|
|
32
|
|
|
33 WITH REPORT; USE REPORT;
|
|
|
34
|
|
|
35 PROCEDURE C83051A IS
|
|
|
36
|
|
|
37 BEGIN
|
|
|
38 TEST ("C83051A", "CHECK THAT DECLARATIONS IN THE VISIBLE " &
|
|
|
39 "PART OF A PACKAGE NESTED WITHIN THE VISIBLE " &
|
|
|
40 "PART OF A PACKAGE ARE VISIBLE BY SELECTION " &
|
|
|
41 "FROM OUTSIDE THE OUTERMOST PACKAGE");
|
|
|
42 A_BLOCK:
|
|
|
43 DECLARE
|
|
|
44 PACKAGE APACK IS
|
|
|
45 PACKAGE BPACK IS
|
|
|
46 TYPE T1 IS (RED,GREEN);
|
|
|
47 TYPE T2A IS ('A', 'B', 'C', 'D');
|
|
|
48 TYPE T3 IS NEW BOOLEAN;
|
|
|
49 TYPE T4 IS NEW INTEGER RANGE -3 .. 8;
|
|
|
50 TYPE T5 IS DIGITS 5;
|
|
|
51 TYPE T67 IS DELTA 0.5 RANGE -2.0 .. 10.0;
|
|
|
52 TYPE T9A IS ARRAY (INTEGER RANGE <>) OF T3;
|
|
|
53 SUBTYPE T9B IS T9A (1..10);
|
|
|
54 TYPE T9C IS ACCESS T9B;
|
|
|
55 TYPE T10 IS PRIVATE;
|
|
|
56 V1 : T3 := FALSE;
|
|
|
57 ZERO : CONSTANT T4 := 0;
|
|
|
58 A_FLT : T5 := 3.0;
|
|
|
59 A_FIX : T67 := -1.0;
|
|
|
60 ARY : T9A(1..4) := (TRUE,TRUE,TRUE,FALSE);
|
|
|
61 P1 : T9C := NEW T9B'( 1..5 => T3'(TRUE),
|
|
|
62 6..10 => T3'(FALSE) );
|
|
|
63 C1 : CONSTANT T10;
|
|
|
64
|
|
|
65 FUNCTION RET_T1 (X : T1) RETURN T1;
|
|
|
66
|
|
|
67 FUNCTION RET_CHAR (X : CHARACTER) RETURN T10;
|
|
|
68
|
|
|
69 GENERIC
|
|
|
70 PROCEDURE DO_NOTHING (X : IN OUT T3);
|
|
|
71 PRIVATE
|
|
|
72 TYPE T10 IS NEW CHARACTER;
|
|
|
73 C1 : CONSTANT T10 := 'J';
|
|
|
74 END BPACK;
|
|
|
75 END APACK;
|
|
|
76
|
|
|
77 PACKAGE BODY APACK IS
|
|
|
78 PACKAGE BODY BPACK IS
|
|
|
79 FUNCTION RET_T1 (X : T1) RETURN T1 IS
|
|
|
80 BEGIN
|
|
|
81 IF X = RED THEN
|
|
|
82 RETURN GREEN;
|
|
|
83 ELSE
|
|
|
84 RETURN RED;
|
|
|
85 END IF;
|
|
|
86 END RET_T1;
|
|
|
87
|
|
|
88 FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS
|
|
|
89 BEGIN
|
|
|
90 RETURN T10(X);
|
|
|
91 END RET_CHAR;
|
|
|
92
|
|
|
93 PROCEDURE DO_NOTHING (X : IN OUT T3) IS
|
|
|
94 BEGIN
|
|
|
95 IF X = TRUE THEN
|
|
|
96 X := FALSE;
|
|
|
97 ELSE
|
|
|
98 X := TRUE;
|
|
|
99 END IF;
|
|
|
100 END DO_NOTHING;
|
|
|
101 END BPACK;
|
|
|
102 END APACK;
|
|
|
103
|
|
|
104 PROCEDURE NEW_DO_NOTHING IS NEW APACK.BPACK.DO_NOTHING;
|
|
|
105
|
|
|
106 BEGIN
|
|
|
107
|
|
|
108 -- A1: VISIBILITY FOR UNOVERLOADED ENUMERATION LITERALS
|
|
|
109
|
|
|
110 IF APACK.BPACK.">"(APACK.BPACK.RED, APACK.BPACK.GREEN) THEN
|
|
|
111 FAILED ("VISIBILITY FOR UNOVERLOADED ENUMERATION " &
|
|
|
112 "LITERAL BAD - A1");
|
|
|
113 END IF;
|
|
|
114
|
|
|
115
|
|
|
116 -- A2: VISIBILITY FOR OVERLOADED
|
|
|
117 -- ENUMERATION CHARACTER LITERALS
|
|
|
118
|
|
|
119 IF APACK.BPACK."<"(APACK.BPACK.T2A'(APACK.BPACK.'C'),
|
|
|
120 APACK.BPACK.T2A'(APACK.BPACK.'B')) THEN
|
|
|
121 FAILED ("VISIBILITY FOR OVERLOADED ENUMERATION " &
|
|
|
122 "LITERAL BAD - A2");
|
|
|
123 END IF;
|
|
|
124
|
|
|
125
|
|
|
126 -- A3: VISIBILITY FOR A DERIVED BOOLEAN TYPE
|
|
|
127
|
|
|
128 IF APACK.BPACK."<"(APACK.BPACK.T3'(APACK.BPACK.TRUE),
|
|
|
129 APACK.BPACK.FALSE) THEN
|
|
|
130 FAILED ("VISIBILITY FOR DERIVED BOOLEAN BAD - A3");
|
|
|
131 END IF;
|
|
|
132
|
|
|
133
|
|
|
134 -- A4: VISIBILITY FOR AN INTEGER TYPE
|
|
|
135
|
|
|
136 IF APACK.BPACK."/="(APACK.BPACK."MOD"(6,2),APACK.BPACK.ZERO)
|
|
|
137 THEN FAILED ("VISIBILITY FOR INTEGER TYPE BAD - A4");
|
|
|
138 END IF;
|
|
|
139
|
|
|
140
|
|
|
141 -- A5: VISIBILITY FOR A FLOATING POINT TYPE
|
|
|
142
|
|
|
143 IF APACK.BPACK.">"(APACK.BPACK.T5'(2.7),APACK.BPACK.A_FLT)
|
|
|
144 THEN FAILED ("VISIBILITY FOR FLOATING POINT BAD - A5");
|
|
|
145 END IF;
|
|
|
146
|
|
|
147
|
|
|
148 -- A6: VISIBILITY FOR A FIXED POINT INVOLVING UNARY MINUS
|
|
|
149
|
|
|
150 IF APACK.BPACK."<"(APACK.BPACK.A_FIX,APACK.BPACK.T67'
|
|
|
151 (APACK.BPACK."-"(1.5))) THEN
|
|
|
152 FAILED ("VISIBILITY FOR FIXED POINT WITH UNARY MINUS " &
|
|
|
153 "BAD - A6");
|
|
|
154 END IF;
|
|
|
155
|
|
|
156
|
|
|
157 -- A7: VISIBILITY FOR A FIXED POINT DIVIDED BY INTEGER
|
|
|
158
|
|
|
159 IF APACK.BPACK."/="(APACK.BPACK.T67(-0.5),APACK.BPACK."/"
|
|
|
160 (APACK.BPACK.A_FIX,2)) THEN
|
|
|
161 FAILED ("VISIBILITY FOR FIXED POINT DIVIDED BY " &
|
|
|
162 "INTEGER BAD - A7");
|
|
|
163 END IF;
|
|
|
164
|
|
|
165
|
|
|
166 -- A8: VISIBILITY FOR ARRAY EQUALITY
|
|
|
167
|
|
|
168 IF APACK.BPACK."/="(APACK.BPACK.ARY,(APACK.BPACK.T3(TRUE),
|
|
|
169 APACK.BPACK.T3(TRUE),APACK.BPACK.T3(TRUE),
|
|
|
170 APACK.BPACK.T3(FALSE))) THEN
|
|
|
171 FAILED ("VISIBILITY FOR ARRAY EQUALITY BAD - A8");
|
|
|
172 END IF;
|
|
|
173
|
|
|
174
|
|
|
175 -- A9: VISIBILITY FOR ACCESS EQUALITY
|
|
|
176
|
|
|
177 IF APACK.BPACK."/="(APACK.BPACK.P1(3),
|
|
|
178 APACK.BPACK.T3(IDENT_BOOL(TRUE)))
|
|
|
179 THEN FAILED ("VISIBILITY FOR ACCESS EQUALITY BAD - A9");
|
|
|
180 END IF;
|
|
|
181
|
|
|
182
|
|
|
183 -- A10: VISIBILITY FOR PRIVATE TYPE
|
|
|
184
|
|
|
185 IF APACK.BPACK."/="(APACK.BPACK.C1,
|
|
|
186 APACK.BPACK.RET_CHAR('J')) THEN
|
|
|
187 FAILED ("VISIBILITY FOR PRIVATE TYPE BAD - A10");
|
|
|
188 END IF;
|
|
|
189
|
|
|
190
|
|
|
191 -- A11: VISIBILITY FOR DERIVED SUBPROGRAM
|
|
|
192
|
|
|
193 IF APACK.BPACK."/="(APACK.BPACK.RET_T1(APACK.BPACK.RED),
|
|
|
194 APACK.BPACK.GREEN) THEN
|
|
|
195 FAILED ("VISIBILITY FOR DERIVED SUBPROGRAM BAD - A11");
|
|
|
196 END IF;
|
|
|
197
|
|
|
198 -- A12: VISIBILITY FOR GENERIC SUBPROGRAM
|
|
|
199
|
|
|
200 NEW_DO_NOTHING (APACK.BPACK.V1);
|
|
|
201
|
|
|
202 IF APACK.BPACK."/="(APACK.BPACK.V1,APACK.BPACK.T3(TRUE)) THEN
|
|
|
203 FAILED ("VISIBILITY FOR GENERIC SUBPROGRAM BAD - A12");
|
|
|
204 END IF;
|
|
|
205
|
|
|
206 END A_BLOCK;
|
|
|
207
|
|
|
208 B_BLOCK:
|
|
|
209 DECLARE
|
|
|
210 GENERIC
|
|
|
211 TYPE T1 IS (<>);
|
|
|
212 PACKAGE GENPACK IS
|
|
|
213 PACKAGE APACK IS
|
|
|
214 PACKAGE BPACK IS
|
|
|
215 TYPE T1 IS (ORANGE,GREEN);
|
|
|
216 TYPE T2A IS ('E', 'F', 'G');
|
|
|
217 TYPE T3 IS NEW BOOLEAN;
|
|
|
218 TYPE T4 IS NEW INTEGER RANGE -3 .. 8;
|
|
|
219 TYPE T5 IS DIGITS 5;
|
|
|
220 TYPE T67 IS DELTA 0.5 RANGE -3.0 .. 25.0;
|
|
|
221 TYPE T9A IS ARRAY (INTEGER RANGE <>) OF T3;
|
|
|
222 SUBTYPE T9B IS T9A (2 .. 8);
|
|
|
223 TYPE T9C IS ACCESS T9B;
|
|
|
224 TYPE T10 IS PRIVATE;
|
|
|
225 V1 : T3 := TRUE;
|
|
|
226 SIX : T4 := 6;
|
|
|
227 B_FLT : T5 := 4.0;
|
|
|
228 ARY : T9A(1..4) := (TRUE,FALSE,TRUE,FALSE);
|
|
|
229 P1 : T9C := NEW T9B'( 2..4 => T3'(FALSE),
|
|
|
230 5..8 => T3'(TRUE));
|
|
|
231 K1 : CONSTANT T10;
|
|
|
232
|
|
|
233 FUNCTION RET_T1 (X : T1) RETURN T1;
|
|
|
234
|
|
|
235 FUNCTION RET_CHAR (X : CHARACTER) RETURN T10;
|
|
|
236
|
|
|
237 GENERIC
|
|
|
238 PROCEDURE DO_NOTHING (X : IN OUT T3);
|
|
|
239 PRIVATE
|
|
|
240 TYPE T10 IS NEW CHARACTER;
|
|
|
241 K1 : CONSTANT T10 := 'V';
|
|
|
242 END BPACK;
|
|
|
243 END APACK;
|
|
|
244 END GENPACK;
|
|
|
245
|
|
|
246 PACKAGE BODY GENPACK IS
|
|
|
247 PACKAGE BODY APACK IS
|
|
|
248 PACKAGE BODY BPACK IS
|
|
|
249 FUNCTION RET_T1 (X : T1) RETURN T1 IS
|
|
|
250 BEGIN
|
|
|
251 IF X = ORANGE THEN
|
|
|
252 RETURN GREEN;
|
|
|
253 ELSE
|
|
|
254 RETURN ORANGE;
|
|
|
255 END IF;
|
|
|
256 END RET_T1;
|
|
|
257
|
|
|
258 FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS
|
|
|
259 BEGIN
|
|
|
260 RETURN T10(X);
|
|
|
261 END RET_CHAR;
|
|
|
262
|
|
|
263 PROCEDURE DO_NOTHING (X : IN OUT T3) IS
|
|
|
264 BEGIN
|
|
|
265 IF X = TRUE THEN
|
|
|
266 X := FALSE;
|
|
|
267 ELSE
|
|
|
268 X := TRUE;
|
|
|
269 END IF;
|
|
|
270 END DO_NOTHING;
|
|
|
271 END BPACK;
|
|
|
272 END APACK;
|
|
|
273 END GENPACK;
|
|
|
274
|
|
|
275 PACKAGE MYPACK IS NEW GENPACK (T1 => INTEGER);
|
|
|
276
|
|
|
277 PROCEDURE MY_DO_NOTHING IS NEW MYPACK.APACK.BPACK.DO_NOTHING;
|
|
|
278
|
|
|
279 BEGIN
|
|
|
280
|
|
|
281 -- B1: GENERIC INSTANCE OF UNOVERLOADED ENUMERATION LITERAL
|
|
|
282
|
|
|
283 IF MYPACK.APACK.BPACK."<"(MYPACK.APACK.BPACK.GREEN,
|
|
|
284 MYPACK.APACK.BPACK.ORANGE) THEN
|
|
|
285 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF " &
|
|
|
286 "UNOVERLOADED ENUMERATION LITERAL BAD - B1");
|
|
|
287 END IF;
|
|
|
288
|
|
|
289
|
|
|
290 -- B2: GENERIC INSTANCE OF OVERLOADED ENUMERATION LITERAL
|
|
|
291
|
|
|
292 IF MYPACK.APACK.BPACK.">"(MYPACK.APACK.BPACK.T2A'(MYPACK.
|
|
|
293 APACK.BPACK.'F'),MYPACK.APACK.BPACK.T2A'(MYPACK.APACK.
|
|
|
294 BPACK.'G')) THEN
|
|
|
295 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF " &
|
|
|
296 "OVERLOADED ENUMERATION LITERAL BAD - B2");
|
|
|
297 END IF;
|
|
|
298
|
|
|
299
|
|
|
300 -- B3: VISIBILITY FOR GENERIC INSTANCE OF DERIVED BOOLEAN
|
|
|
301
|
|
|
302 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."NOT"(MYPACK.
|
|
|
303 APACK.BPACK.T3'(MYPACK.APACK.BPACK.TRUE)),MYPACK.APACK.
|
|
|
304 BPACK.FALSE) THEN
|
|
|
305 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF DERIVED " &
|
|
|
306 "BOOLEAN BAD - B3");
|
|
|
307 END IF;
|
|
|
308
|
|
|
309
|
|
|
310 -- B4: VISIBILITY FOR GENERIC INSTANCE OF DERIVED INTEGER
|
|
|
311
|
|
|
312 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."MOD"(MYPACK.
|
|
|
313 APACK.BPACK.SIX,2),0) THEN
|
|
|
314 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF INTEGER " &
|
|
|
315 "BAD - B4");
|
|
|
316 END IF;
|
|
|
317
|
|
|
318
|
|
|
319 -- B5: VISIBILITY FOR GENERIC INSTANCE OF FLOATING POINT
|
|
|
320
|
|
|
321 IF MYPACK.APACK.BPACK.">"(MYPACK.APACK.BPACK.T5'(1.9),MYPACK.
|
|
|
322 APACK.BPACK.B_FLT) THEN
|
|
|
323 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FLOATING " &
|
|
|
324 "POINT BAD - B5");
|
|
|
325 END IF;
|
|
|
326
|
|
|
327
|
|
|
328 -- B6: VISIBILITY FOR GENERIC INSTANCE OF
|
|
|
329 -- FIXED POINT UNARY PLUS
|
|
|
330
|
|
|
331 IF MYPACK.APACK.BPACK."<"(2.5,MYPACK.APACK.BPACK.T67'(MYPACK.
|
|
|
332 APACK.BPACK."+"(1.75))) THEN
|
|
|
333 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FIXED " &
|
|
|
334 "POINT UNARY PLUS BAD - B6");
|
|
|
335 END IF;
|
|
|
336
|
|
|
337
|
|
|
338 -- B7: VISIBILITY FOR GENERIC INSTANCE OF
|
|
|
339 -- FIXED POINT DIVIDED BY INTEGER
|
|
|
340
|
|
|
341 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."/"(2.5,4),
|
|
|
342 0.625) THEN
|
|
|
343 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FIXED " &
|
|
|
344 "POINT DIVIDED BY INTEGER BAD - B7");
|
|
|
345 END IF;
|
|
|
346
|
|
|
347
|
|
|
348 -- B8: VISIBILITY FOR GENERIC INSTANCE OF ARRAY EQUALITY
|
|
|
349
|
|
|
350 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.ARY,(MYPACK.
|
|
|
351 APACK.BPACK.T3(TRUE),MYPACK.APACK.BPACK.T3(FALSE),MYPACK.
|
|
|
352 APACK.BPACK.T3(TRUE),MYPACK.APACK.BPACK.T3(FALSE))) THEN
|
|
|
353 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF ARRAY " &
|
|
|
354 "EQUALITY BAD - B8");
|
|
|
355 END IF;
|
|
|
356
|
|
|
357
|
|
|
358 -- B9: VISIBILITY FOR GENERIC INSTANCE OF ACCESS EQUALITY
|
|
|
359
|
|
|
360 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.P1(3),MYPACK.
|
|
|
361 APACK.BPACK.T3(IDENT_BOOL(FALSE))) THEN
|
|
|
362 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF ACCESS " &
|
|
|
363 "EQUALITY BAD - B9");
|
|
|
364 END IF;
|
|
|
365
|
|
|
366
|
|
|
367 -- B10: VISIBILITY FOR GENERIC INSTANCE OF PRIVATE EQUALITY
|
|
|
368
|
|
|
369 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.K1,MYPACK.APACK.
|
|
|
370 BPACK.RET_CHAR('V')) THEN
|
|
|
371 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF PRIVATE " &
|
|
|
372 "EQUALITY BAD - B10");
|
|
|
373 END IF;
|
|
|
374
|
|
|
375
|
|
|
376 -- B11: VISIBILITY FOR GENERIC INSTANCE OF DERIVED SUBPROGRAM
|
|
|
377
|
|
|
378 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.RET_T1(MYPACK.
|
|
|
379 APACK.BPACK.ORANGE),MYPACK.APACK.BPACK.GREEN) THEN
|
|
|
380 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF DERIVED " &
|
|
|
381 "SUBPROGRAM BAD - B11");
|
|
|
382 END IF;
|
|
|
383
|
|
|
384 -- B12: VISIBILITY FOR GENERIC INSTANCE OF GENERIC SUBPROGRAM
|
|
|
385
|
|
|
386 MY_DO_NOTHING (MYPACK.APACK.BPACK.V1);
|
|
|
387
|
|
|
388 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.V1,
|
|
|
389 MYPACK.APACK.BPACK.T3(FALSE)) THEN
|
|
|
390 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF GENERIC " &
|
|
|
391 "SUBPROGRAM BAD - B12");
|
|
|
392 END IF;
|
|
|
393
|
|
|
394 END B_BLOCK;
|
|
|
395
|
|
|
396 RESULT;
|
|
|
397 END C83051A;
|
