3 -- Grant of Unlimited Rights
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
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.
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.
31 -- GMT 09/07/88 CREATED ORIGINAL TEST.
33 WITH REPORT
; USE REPORT
;
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");
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;
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
;
57 ZERO
: CONSTANT T4
:= 0;
60 ARY
: T9A
(1..4) := (TRUE,TRUE,TRUE,FALSE);
61 P1
: T9C
:= NEW T9B
'( 1..5 => T3'(TRUE),
62 6..10 => T3
'(FALSE) );
65 FUNCTION RET_T1 (X : T1) RETURN T1;
67 FUNCTION RET_CHAR (X : CHARACTER) RETURN T10;
70 PROCEDURE DO_NOTHING (X : IN OUT T3);
72 TYPE T10 IS NEW CHARACTER;
73 C1 : CONSTANT T10 := 'J
';
79 FUNCTION RET_T1 (X : T1) RETURN T1 IS
88 FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS
93 PROCEDURE DO_NOTHING (X : IN OUT T3) IS
104 PROCEDURE NEW_DO_NOTHING IS NEW APACK.BPACK.DO_NOTHING;
108 -- A1: VISIBILITY FOR UNOVERLOADED ENUMERATION LITERALS
110 IF APACK.BPACK.">"(APACK.BPACK.RED, APACK.BPACK.GREEN) THEN
111 FAILED ("VISIBILITY FOR UNOVERLOADED ENUMERATION " &
116 -- A2: VISIBILITY FOR OVERLOADED
117 -- ENUMERATION CHARACTER LITERALS
119 IF APACK.BPACK."<"(APACK.BPACK.T2A'(APACK
.BPACK
.'C'),
120 APACK
.BPACK
.T2A
'(APACK.BPACK.'B
')) THEN
121 FAILED ("VISIBILITY FOR OVERLOADED ENUMERATION " &
126 -- A3: VISIBILITY FOR A DERIVED BOOLEAN TYPE
128 IF APACK.BPACK."<"(APACK.BPACK.T3'(APACK
.BPACK
.TRUE),
129 APACK
.BPACK
.FALSE) THEN
130 FAILED
("VISIBILITY FOR DERIVED BOOLEAN BAD - A3");
134 -- A4: VISIBILITY FOR AN INTEGER TYPE
136 IF APACK
.BPACK
."/="(APACK
.BPACK
."MOD"(6,2),APACK
.BPACK
.ZERO
)
137 THEN FAILED
("VISIBILITY FOR INTEGER TYPE BAD - A4");
141 -- A5: VISIBILITY FOR A FLOATING POINT TYPE
143 IF APACK
.BPACK
.">"(APACK
.BPACK
.T5
'(2.7),APACK.BPACK.A_FLT)
144 THEN FAILED ("VISIBILITY FOR FLOATING POINT BAD - A5");
148 -- A6: VISIBILITY FOR A FIXED POINT INVOLVING UNARY MINUS
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 " &
157 -- A7: VISIBILITY FOR A FIXED POINT DIVIDED BY INTEGER
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 " &
166 -- A8: VISIBILITY FOR ARRAY EQUALITY
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");
175 -- A9: VISIBILITY FOR ACCESS EQUALITY
177 IF APACK
.BPACK
."/="(APACK
.BPACK
.P1
(3),
178 APACK
.BPACK
.T3
(IDENT_BOOL
(TRUE)))
179 THEN FAILED
("VISIBILITY FOR ACCESS EQUALITY BAD - A9");
183 -- A10: VISIBILITY FOR PRIVATE TYPE
185 IF APACK
.BPACK
."/="(APACK
.BPACK
.C1
,
186 APACK
.BPACK
.RET_CHAR
('J')) THEN
187 FAILED
("VISIBILITY FOR PRIVATE TYPE BAD - A10");
191 -- A11: VISIBILITY FOR DERIVED SUBPROGRAM
193 IF APACK
.BPACK
."/="(APACK
.BPACK
.RET_T1
(APACK
.BPACK
.RED
),
194 APACK
.BPACK
.GREEN
) THEN
195 FAILED
("VISIBILITY FOR DERIVED SUBPROGRAM BAD - A11");
198 -- A12: VISIBILITY FOR GENERIC SUBPROGRAM
200 NEW_DO_NOTHING
(APACK
.BPACK
.V1
);
202 IF APACK
.BPACK
."/="(APACK
.BPACK
.V1
,APACK
.BPACK
.T3
(TRUE)) THEN
203 FAILED
("VISIBILITY FOR GENERIC SUBPROGRAM BAD - A12");
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;
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
;
228 ARY
: T9A
(1..4) := (TRUE,FALSE,TRUE,FALSE);
229 P1
: T9C
:= NEW T9B
'( 2..4 => T3'(FALSE),
233 FUNCTION RET_T1 (X : T1) RETURN T1;
235 FUNCTION RET_CHAR (X : CHARACTER) RETURN T10;
238 PROCEDURE DO_NOTHING (X : IN OUT T3);
240 TYPE T10 IS NEW CHARACTER;
241 K1 : CONSTANT T10 := 'V
';
246 PACKAGE BODY GENPACK IS
247 PACKAGE BODY APACK IS
248 PACKAGE BODY BPACK IS
249 FUNCTION RET_T1 (X : T1) RETURN T1 IS
258 FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS
263 PROCEDURE DO_NOTHING (X : IN OUT T3) IS
275 PACKAGE MYPACK IS NEW GENPACK (T1 => INTEGER);
277 PROCEDURE MY_DO_NOTHING IS NEW MYPACK.APACK.BPACK.DO_NOTHING;
281 -- B1: GENERIC INSTANCE OF UNOVERLOADED ENUMERATION LITERAL
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");
290 -- B2: GENERIC INSTANCE OF OVERLOADED ENUMERATION LITERAL
292 IF MYPACK.APACK.BPACK.">"(MYPACK.APACK.BPACK.T2A'(MYPACK
.
293 APACK
.BPACK
.'F'),MYPACK
.APACK
.BPACK
.T2A
'(MYPACK.APACK.
295 FAILED ("VISIBILITY FOR GENERIC INSTANCE OF " &
296 "OVERLOADED ENUMERATION LITERAL BAD - B2");
300 -- B3: VISIBILITY FOR GENERIC INSTANCE OF DERIVED BOOLEAN
302 IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."NOT"(MYPACK.
303 APACK.BPACK.T3'(MYPACK
.APACK
.BPACK
.TRUE)),MYPACK
.APACK
.
305 FAILED
("VISIBILITY FOR GENERIC INSTANCE OF DERIVED " &
310 -- B4: VISIBILITY FOR GENERIC INSTANCE OF DERIVED INTEGER
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 " &
319 -- B5: VISIBILITY FOR GENERIC INSTANCE OF FLOATING POINT
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 " &
328 -- B6: VISIBILITY FOR GENERIC INSTANCE OF
329 -- FIXED POINT UNARY PLUS
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");
338 -- B7: VISIBILITY FOR GENERIC INSTANCE OF
339 -- FIXED POINT DIVIDED BY INTEGER
341 IF MYPACK
.APACK
.BPACK
."/="(MYPACK
.APACK
.BPACK
."/"(2.5,4),
343 FAILED
("VISIBILITY FOR GENERIC INSTANCE OF FIXED " &
344 "POINT DIVIDED BY INTEGER BAD - B7");
348 -- B8: VISIBILITY FOR GENERIC INSTANCE OF ARRAY EQUALITY
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");
358 -- B9: VISIBILITY FOR GENERIC INSTANCE OF ACCESS EQUALITY
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");
367 -- B10: VISIBILITY FOR GENERIC INSTANCE OF PRIVATE EQUALITY
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");
376 -- B11: VISIBILITY FOR GENERIC INSTANCE OF DERIVED SUBPROGRAM
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");
384 -- B12: VISIBILITY FOR GENERIC INSTANCE OF GENERIC SUBPROGRAM
386 MY_DO_NOTHING
(MYPACK
.APACK
.BPACK
.V1
);
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");