| -- C83051A.ADA |
| |
| -- Grant of Unlimited Rights |
| -- |
| -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, |
| -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained |
| -- unlimited rights in the software and documentation contained herein. |
| -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making |
| -- this public release, the Government intends to confer upon all |
| -- recipients unlimited rights equal to those held by the Government. |
| -- These rights include rights to use, duplicate, release or disclose the |
| -- released technical data and computer software in whole or in part, in |
| -- any manner and for any purpose whatsoever, and to have or permit others |
| -- to do so. |
| -- |
| -- DISCLAIMER |
| -- |
| -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR |
| -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED |
| -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE |
| -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE |
| -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A |
| -- PARTICULAR PURPOSE OF SAID MATERIAL. |
| --* |
| -- OBJECTIVE: |
| -- CHECK THAT DECLARATIONS IN THE VISIBLE PART OF A PACKAGE NESTED |
| -- WITHIN THE VISIBLE PART OF A PACKAGE ARE VISIBLE BY SELECTION |
| -- FROM OUTSIDE THE OUTERMOST PACKAGE. |
| |
| -- HISTORY: |
| -- GMT 09/07/88 CREATED ORIGINAL TEST. |
| |
| WITH REPORT; USE REPORT; |
| |
| PROCEDURE C83051A IS |
| |
| BEGIN |
| TEST ("C83051A", "CHECK THAT DECLARATIONS IN THE VISIBLE " & |
| "PART OF A PACKAGE NESTED WITHIN THE VISIBLE " & |
| "PART OF A PACKAGE ARE VISIBLE BY SELECTION " & |
| "FROM OUTSIDE THE OUTERMOST PACKAGE"); |
| A_BLOCK: |
| DECLARE |
| PACKAGE APACK IS |
| PACKAGE BPACK IS |
| TYPE T1 IS (RED,GREEN); |
| TYPE T2A IS ('A', 'B', 'C', 'D'); |
| TYPE T3 IS NEW BOOLEAN; |
| TYPE T4 IS NEW INTEGER RANGE -3 .. 8; |
| TYPE T5 IS DIGITS 5; |
| TYPE T67 IS DELTA 0.5 RANGE -2.0 .. 10.0; |
| TYPE T9A IS ARRAY (INTEGER RANGE <>) OF T3; |
| SUBTYPE T9B IS T9A (1..10); |
| TYPE T9C IS ACCESS T9B; |
| TYPE T10 IS PRIVATE; |
| V1 : T3 := FALSE; |
| ZERO : CONSTANT T4 := 0; |
| A_FLT : T5 := 3.0; |
| A_FIX : T67 := -1.0; |
| ARY : T9A(1..4) := (TRUE,TRUE,TRUE,FALSE); |
| P1 : T9C := NEW T9B'( 1..5 => T3'(TRUE), |
| 6..10 => T3'(FALSE) ); |
| C1 : CONSTANT T10; |
| |
| FUNCTION RET_T1 (X : T1) RETURN T1; |
| |
| FUNCTION RET_CHAR (X : CHARACTER) RETURN T10; |
| |
| GENERIC |
| PROCEDURE DO_NOTHING (X : IN OUT T3); |
| PRIVATE |
| TYPE T10 IS NEW CHARACTER; |
| C1 : CONSTANT T10 := 'J'; |
| END BPACK; |
| END APACK; |
| |
| PACKAGE BODY APACK IS |
| PACKAGE BODY BPACK IS |
| FUNCTION RET_T1 (X : T1) RETURN T1 IS |
| BEGIN |
| IF X = RED THEN |
| RETURN GREEN; |
| ELSE |
| RETURN RED; |
| END IF; |
| END RET_T1; |
| |
| FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS |
| BEGIN |
| RETURN T10(X); |
| END RET_CHAR; |
| |
| PROCEDURE DO_NOTHING (X : IN OUT T3) IS |
| BEGIN |
| IF X = TRUE THEN |
| X := FALSE; |
| ELSE |
| X := TRUE; |
| END IF; |
| END DO_NOTHING; |
| END BPACK; |
| END APACK; |
| |
| PROCEDURE NEW_DO_NOTHING IS NEW APACK.BPACK.DO_NOTHING; |
| |
| BEGIN |
| |
| -- A1: VISIBILITY FOR UNOVERLOADED ENUMERATION LITERALS |
| |
| IF APACK.BPACK.">"(APACK.BPACK.RED, APACK.BPACK.GREEN) THEN |
| FAILED ("VISIBILITY FOR UNOVERLOADED ENUMERATION " & |
| "LITERAL BAD - A1"); |
| END IF; |
| |
| |
| -- A2: VISIBILITY FOR OVERLOADED |
| -- ENUMERATION CHARACTER LITERALS |
| |
| IF APACK.BPACK."<"(APACK.BPACK.T2A'(APACK.BPACK.'C'), |
| APACK.BPACK.T2A'(APACK.BPACK.'B')) THEN |
| FAILED ("VISIBILITY FOR OVERLOADED ENUMERATION " & |
| "LITERAL BAD - A2"); |
| END IF; |
| |
| |
| -- A3: VISIBILITY FOR A DERIVED BOOLEAN TYPE |
| |
| IF APACK.BPACK."<"(APACK.BPACK.T3'(APACK.BPACK.TRUE), |
| APACK.BPACK.FALSE) THEN |
| FAILED ("VISIBILITY FOR DERIVED BOOLEAN BAD - A3"); |
| END IF; |
| |
| |
| -- A4: VISIBILITY FOR AN INTEGER TYPE |
| |
| IF APACK.BPACK."/="(APACK.BPACK."MOD"(6,2),APACK.BPACK.ZERO) |
| THEN FAILED ("VISIBILITY FOR INTEGER TYPE BAD - A4"); |
| END IF; |
| |
| |
| -- A5: VISIBILITY FOR A FLOATING POINT TYPE |
| |
| IF APACK.BPACK.">"(APACK.BPACK.T5'(2.7),APACK.BPACK.A_FLT) |
| THEN FAILED ("VISIBILITY FOR FLOATING POINT BAD - A5"); |
| END IF; |
| |
| |
| -- A6: VISIBILITY FOR A FIXED POINT INVOLVING UNARY MINUS |
| |
| IF APACK.BPACK."<"(APACK.BPACK.A_FIX,APACK.BPACK.T67' |
| (APACK.BPACK."-"(1.5))) THEN |
| FAILED ("VISIBILITY FOR FIXED POINT WITH UNARY MINUS " & |
| "BAD - A6"); |
| END IF; |
| |
| |
| -- A7: VISIBILITY FOR A FIXED POINT DIVIDED BY INTEGER |
| |
| IF APACK.BPACK."/="(APACK.BPACK.T67(-0.5),APACK.BPACK."/" |
| (APACK.BPACK.A_FIX,2)) THEN |
| FAILED ("VISIBILITY FOR FIXED POINT DIVIDED BY " & |
| "INTEGER BAD - A7"); |
| END IF; |
| |
| |
| -- A8: VISIBILITY FOR ARRAY EQUALITY |
| |
| IF APACK.BPACK."/="(APACK.BPACK.ARY,(APACK.BPACK.T3(TRUE), |
| APACK.BPACK.T3(TRUE),APACK.BPACK.T3(TRUE), |
| APACK.BPACK.T3(FALSE))) THEN |
| FAILED ("VISIBILITY FOR ARRAY EQUALITY BAD - A8"); |
| END IF; |
| |
| |
| -- A9: VISIBILITY FOR ACCESS EQUALITY |
| |
| IF APACK.BPACK."/="(APACK.BPACK.P1(3), |
| APACK.BPACK.T3(IDENT_BOOL(TRUE))) |
| THEN FAILED ("VISIBILITY FOR ACCESS EQUALITY BAD - A9"); |
| END IF; |
| |
| |
| -- A10: VISIBILITY FOR PRIVATE TYPE |
| |
| IF APACK.BPACK."/="(APACK.BPACK.C1, |
| APACK.BPACK.RET_CHAR('J')) THEN |
| FAILED ("VISIBILITY FOR PRIVATE TYPE BAD - A10"); |
| END IF; |
| |
| |
| -- A11: VISIBILITY FOR DERIVED SUBPROGRAM |
| |
| IF APACK.BPACK."/="(APACK.BPACK.RET_T1(APACK.BPACK.RED), |
| APACK.BPACK.GREEN) THEN |
| FAILED ("VISIBILITY FOR DERIVED SUBPROGRAM BAD - A11"); |
| END IF; |
| |
| -- A12: VISIBILITY FOR GENERIC SUBPROGRAM |
| |
| NEW_DO_NOTHING (APACK.BPACK.V1); |
| |
| IF APACK.BPACK."/="(APACK.BPACK.V1,APACK.BPACK.T3(TRUE)) THEN |
| FAILED ("VISIBILITY FOR GENERIC SUBPROGRAM BAD - A12"); |
| END IF; |
| |
| END A_BLOCK; |
| |
| B_BLOCK: |
| DECLARE |
| GENERIC |
| TYPE T1 IS (<>); |
| PACKAGE GENPACK IS |
| PACKAGE APACK IS |
| PACKAGE BPACK IS |
| TYPE T1 IS (ORANGE,GREEN); |
| TYPE T2A IS ('E', 'F', 'G'); |
| TYPE T3 IS NEW BOOLEAN; |
| TYPE T4 IS NEW INTEGER RANGE -3 .. 8; |
| TYPE T5 IS DIGITS 5; |
| TYPE T67 IS DELTA 0.5 RANGE -3.0 .. 25.0; |
| TYPE T9A IS ARRAY (INTEGER RANGE <>) OF T3; |
| SUBTYPE T9B IS T9A (2 .. 8); |
| TYPE T9C IS ACCESS T9B; |
| TYPE T10 IS PRIVATE; |
| V1 : T3 := TRUE; |
| SIX : T4 := 6; |
| B_FLT : T5 := 4.0; |
| ARY : T9A(1..4) := (TRUE,FALSE,TRUE,FALSE); |
| P1 : T9C := NEW T9B'( 2..4 => T3'(FALSE), |
| 5..8 => T3'(TRUE)); |
| K1 : CONSTANT T10; |
| |
| FUNCTION RET_T1 (X : T1) RETURN T1; |
| |
| FUNCTION RET_CHAR (X : CHARACTER) RETURN T10; |
| |
| GENERIC |
| PROCEDURE DO_NOTHING (X : IN OUT T3); |
| PRIVATE |
| TYPE T10 IS NEW CHARACTER; |
| K1 : CONSTANT T10 := 'V'; |
| END BPACK; |
| END APACK; |
| END GENPACK; |
| |
| PACKAGE BODY GENPACK IS |
| PACKAGE BODY APACK IS |
| PACKAGE BODY BPACK IS |
| FUNCTION RET_T1 (X : T1) RETURN T1 IS |
| BEGIN |
| IF X = ORANGE THEN |
| RETURN GREEN; |
| ELSE |
| RETURN ORANGE; |
| END IF; |
| END RET_T1; |
| |
| FUNCTION RET_CHAR (X : CHARACTER) RETURN T10 IS |
| BEGIN |
| RETURN T10(X); |
| END RET_CHAR; |
| |
| PROCEDURE DO_NOTHING (X : IN OUT T3) IS |
| BEGIN |
| IF X = TRUE THEN |
| X := FALSE; |
| ELSE |
| X := TRUE; |
| END IF; |
| END DO_NOTHING; |
| END BPACK; |
| END APACK; |
| END GENPACK; |
| |
| PACKAGE MYPACK IS NEW GENPACK (T1 => INTEGER); |
| |
| PROCEDURE MY_DO_NOTHING IS NEW MYPACK.APACK.BPACK.DO_NOTHING; |
| |
| BEGIN |
| |
| -- B1: GENERIC INSTANCE OF UNOVERLOADED ENUMERATION LITERAL |
| |
| IF MYPACK.APACK.BPACK."<"(MYPACK.APACK.BPACK.GREEN, |
| MYPACK.APACK.BPACK.ORANGE) THEN |
| FAILED ("VISIBILITY FOR GENERIC INSTANCE OF " & |
| "UNOVERLOADED ENUMERATION LITERAL BAD - B1"); |
| END IF; |
| |
| |
| -- B2: GENERIC INSTANCE OF OVERLOADED ENUMERATION LITERAL |
| |
| IF MYPACK.APACK.BPACK.">"(MYPACK.APACK.BPACK.T2A'(MYPACK. |
| APACK.BPACK.'F'),MYPACK.APACK.BPACK.T2A'(MYPACK.APACK. |
| BPACK.'G')) THEN |
| FAILED ("VISIBILITY FOR GENERIC INSTANCE OF " & |
| "OVERLOADED ENUMERATION LITERAL BAD - B2"); |
| END IF; |
| |
| |
| -- B3: VISIBILITY FOR GENERIC INSTANCE OF DERIVED BOOLEAN |
| |
| IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."NOT"(MYPACK. |
| APACK.BPACK.T3'(MYPACK.APACK.BPACK.TRUE)),MYPACK.APACK. |
| BPACK.FALSE) THEN |
| FAILED ("VISIBILITY FOR GENERIC INSTANCE OF DERIVED " & |
| "BOOLEAN BAD - B3"); |
| END IF; |
| |
| |
| -- B4: VISIBILITY FOR GENERIC INSTANCE OF DERIVED INTEGER |
| |
| IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."MOD"(MYPACK. |
| APACK.BPACK.SIX,2),0) THEN |
| FAILED ("VISIBILITY FOR GENERIC INSTANCE OF INTEGER " & |
| "BAD - B4"); |
| END IF; |
| |
| |
| -- B5: VISIBILITY FOR GENERIC INSTANCE OF FLOATING POINT |
| |
| IF MYPACK.APACK.BPACK.">"(MYPACK.APACK.BPACK.T5'(1.9),MYPACK. |
| APACK.BPACK.B_FLT) THEN |
| FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FLOATING " & |
| "POINT BAD - B5"); |
| END IF; |
| |
| |
| -- B6: VISIBILITY FOR GENERIC INSTANCE OF |
| -- FIXED POINT UNARY PLUS |
| |
| IF MYPACK.APACK.BPACK."<"(2.5,MYPACK.APACK.BPACK.T67'(MYPACK. |
| APACK.BPACK."+"(1.75))) THEN |
| FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FIXED " & |
| "POINT UNARY PLUS BAD - B6"); |
| END IF; |
| |
| |
| -- B7: VISIBILITY FOR GENERIC INSTANCE OF |
| -- FIXED POINT DIVIDED BY INTEGER |
| |
| IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK."/"(2.5,4), |
| 0.625) THEN |
| FAILED ("VISIBILITY FOR GENERIC INSTANCE OF FIXED " & |
| "POINT DIVIDED BY INTEGER BAD - B7"); |
| END IF; |
| |
| |
| -- B8: VISIBILITY FOR GENERIC INSTANCE OF ARRAY EQUALITY |
| |
| IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.ARY,(MYPACK. |
| APACK.BPACK.T3(TRUE),MYPACK.APACK.BPACK.T3(FALSE),MYPACK. |
| APACK.BPACK.T3(TRUE),MYPACK.APACK.BPACK.T3(FALSE))) THEN |
| FAILED ("VISIBILITY FOR GENERIC INSTANCE OF ARRAY " & |
| "EQUALITY BAD - B8"); |
| END IF; |
| |
| |
| -- B9: VISIBILITY FOR GENERIC INSTANCE OF ACCESS EQUALITY |
| |
| IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.P1(3),MYPACK. |
| APACK.BPACK.T3(IDENT_BOOL(FALSE))) THEN |
| FAILED ("VISIBILITY FOR GENERIC INSTANCE OF ACCESS " & |
| "EQUALITY BAD - B9"); |
| END IF; |
| |
| |
| -- B10: VISIBILITY FOR GENERIC INSTANCE OF PRIVATE EQUALITY |
| |
| IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.K1,MYPACK.APACK. |
| BPACK.RET_CHAR('V')) THEN |
| FAILED ("VISIBILITY FOR GENERIC INSTANCE OF PRIVATE " & |
| "EQUALITY BAD - B10"); |
| END IF; |
| |
| |
| -- B11: VISIBILITY FOR GENERIC INSTANCE OF DERIVED SUBPROGRAM |
| |
| IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.RET_T1(MYPACK. |
| APACK.BPACK.ORANGE),MYPACK.APACK.BPACK.GREEN) THEN |
| FAILED ("VISIBILITY FOR GENERIC INSTANCE OF DERIVED " & |
| "SUBPROGRAM BAD - B11"); |
| END IF; |
| |
| -- B12: VISIBILITY FOR GENERIC INSTANCE OF GENERIC SUBPROGRAM |
| |
| MY_DO_NOTHING (MYPACK.APACK.BPACK.V1); |
| |
| IF MYPACK.APACK.BPACK."/="(MYPACK.APACK.BPACK.V1, |
| MYPACK.APACK.BPACK.T3(FALSE)) THEN |
| FAILED ("VISIBILITY FOR GENERIC INSTANCE OF GENERIC " & |
| "SUBPROGRAM BAD - B12"); |
| END IF; |
| |
| END B_BLOCK; |
| |
| RESULT; |
| END C83051A; |
