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 33WITH REPORT; USE REPORT; 34 35PROCEDURE C83051A IS 36 37BEGIN 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; 397END C83051A; 398