| -- C74306A.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: |
| -- AFTER THE FULL DECLARATION OF A DEFERRED CONSTANT, THE VALUE OF |
| -- THE CONSTANT MAY BE USED IN ANY EXPRESSION, PARTICULARLY |
| -- EXPRESSIONS IN WHICH THE USE WOULD BE ILLEGAL BEFORE THE FULL |
| -- DECLARATION. |
| |
| -- HISTORY: |
| -- BCB 03/14/88 CREATED ORIGINAL TEST. |
| |
| WITH REPORT; USE REPORT; |
| |
| PROCEDURE C74306A IS |
| |
| GENERIC |
| TYPE GENERAL_PURPOSE IS LIMITED PRIVATE; |
| Y : IN OUT GENERAL_PURPOSE; |
| FUNCTION IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE; |
| |
| FUNCTION IDENT (X : GENERAL_PURPOSE) RETURN GENERAL_PURPOSE IS |
| BEGIN |
| IF EQUAL(3,3) THEN |
| RETURN X; |
| END IF; |
| RETURN Y; |
| END IDENT; |
| |
| PACKAGE P IS |
| TYPE T IS PRIVATE; |
| C : CONSTANT T; |
| PRIVATE |
| TYPE T IS RANGE 1 .. 100; |
| |
| TYPE A IS ARRAY(1..2) OF T; |
| |
| TYPE B IS ARRAY(INTEGER RANGE <>) OF T; |
| |
| TYPE D (DISC : T) IS RECORD |
| NULL; |
| END RECORD; |
| |
| C : CONSTANT T := 50; |
| |
| PARAM : T := 99; |
| |
| FUNCTION IDENT_T IS NEW IDENT (T, PARAM); |
| |
| FUNCTION F (X : T := C) RETURN T; |
| |
| SUBTYPE RAN IS T RANGE 1 .. C; |
| |
| SUBTYPE IND IS B(1..INTEGER(C)); |
| |
| SUBTYPE DIS IS D (DISC => C); |
| |
| OBJ : T := C; |
| |
| CON : CONSTANT T := C; |
| |
| ARR : A := (5, C); |
| |
| PAR : T := IDENT_T (C); |
| |
| RANOBJ : T RANGE 1 .. C := C; |
| |
| INDOBJ : B(1..INTEGER(C)); |
| |
| DIS_VAL : DIS; |
| |
| REN : T RENAMES C; |
| |
| GENERIC |
| FOR_PAR : T := C; |
| PACKAGE GENPACK IS |
| VAL : T; |
| END GENPACK; |
| |
| GENERIC |
| IN_PAR : IN T; |
| PACKAGE NEWPACK IS |
| IN_VAL : T; |
| END NEWPACK; |
| END P; |
| |
| USE P; |
| |
| PACKAGE BODY P IS |
| TYPE A1 IS ARRAY(1..2) OF T; |
| |
| TYPE B1 IS ARRAY(INTEGER RANGE <>) OF T; |
| |
| TYPE D1 (DISC1 : T) IS RECORD |
| NULL; |
| END RECORD; |
| |
| SUBTYPE RAN1 IS T RANGE 1 .. C; |
| |
| SUBTYPE IND1 IS B1(1..INTEGER(C)); |
| |
| SUBTYPE DIS1 IS D1 (DISC1 => C); |
| |
| OBJ1 : T := C; |
| |
| FUNCVAR : T; |
| |
| CON1 : CONSTANT T := C; |
| |
| ARR1 : A1 := (5, C); |
| |
| PAR1 : T := IDENT_T (C); |
| |
| RANOBJ1 : T RANGE 1 .. C := C; |
| |
| INDOBJ1 : B1(1..INTEGER(C)); |
| |
| DIS_VAL1 : DIS1; |
| |
| REN1 : T RENAMES C; |
| |
| FUNCTION F (X : T := C) RETURN T IS |
| BEGIN |
| RETURN C; |
| END F; |
| |
| PACKAGE BODY GENPACK IS |
| BEGIN |
| VAL := FOR_PAR; |
| END GENPACK; |
| |
| PACKAGE BODY NEWPACK IS |
| BEGIN |
| IN_VAL := IN_PAR; |
| END NEWPACK; |
| |
| PACKAGE PACK IS NEW GENPACK (FOR_PAR => C); |
| |
| PACKAGE NPACK IS NEW NEWPACK (IN_PAR => C); |
| BEGIN |
| TEST ("C74306A", "AFTER THE FULL DECLARATION OF A DEFERRED " & |
| "CONSTANT, THE VALUE OF THE CONSTANT MAY " & |
| "BE USED IN ANY EXPRESSION, PARTICULARLY " & |
| "EXPRESSIONS IN WHICH THE USE WOULD BE " & |
| "ILLEGAL BEFORE THE FULL DECLARATION"); |
| |
| IF OBJ /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR OBJ"); |
| END IF; |
| |
| IF CON /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR CON"); |
| END IF; |
| |
| IF ARR /= (IDENT_T(5), IDENT_T(50)) THEN |
| FAILED ("IMPROPER VALUES FOR ARR"); |
| END IF; |
| |
| IF PAR /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR PAR"); |
| END IF; |
| |
| IF OBJ1 /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR OBJ1"); |
| END IF; |
| |
| IF CON1 /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR CON1"); |
| END IF; |
| |
| IF ARR1 /= (IDENT_T(5), IDENT_T(50)) THEN |
| FAILED ("IMPROPER VALUES FOR ARR1"); |
| END IF; |
| |
| IF PAR1 /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR PAR1"); |
| END IF; |
| |
| IF PACK.VAL /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR PACK.VAL"); |
| END IF; |
| |
| IF NPACK.IN_VAL /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR NPACK.IN_VAL"); |
| END IF; |
| |
| IF RAN'LAST /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR RAN'LAST"); |
| END IF; |
| |
| IF RANOBJ /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR RANOBJ"); |
| END IF; |
| |
| IF IND'LAST /= IDENT_INT(50) THEN |
| FAILED ("IMPROPER VALUE FOR IND'LAST"); |
| END IF; |
| |
| IF INDOBJ'LAST /= IDENT_INT(50) THEN |
| FAILED ("IMPROPER VALUE FOR INDOBJ'LAST"); |
| END IF; |
| |
| IF DIS_VAL.DISC /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR DIS_VAL.DISC"); |
| END IF; |
| |
| IF REN /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR REN"); |
| END IF; |
| |
| IF RAN1'LAST /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR RAN1'LAST"); |
| END IF; |
| |
| IF RANOBJ1 /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR RANOBJ1"); |
| END IF; |
| |
| IF IND1'LAST /= IDENT_INT(50) THEN |
| FAILED ("IMPROPER VALUE FOR IND1'LAST"); |
| END IF; |
| |
| IF INDOBJ1'LAST /= IDENT_INT(50) THEN |
| FAILED ("IMPROPER VALUE FOR INDOBJ1'LAST"); |
| END IF; |
| |
| IF DIS_VAL1.DISC1 /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR DIS_VAL1.DISC1"); |
| END IF; |
| |
| IF REN1 /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR REN1"); |
| END IF; |
| |
| FUNCVAR := F(C); |
| |
| IF FUNCVAR /= IDENT_T(50) THEN |
| FAILED ("IMPROPER VALUE FOR FUNCVAR"); |
| END IF; |
| |
| RESULT; |
| END P; |
| |
| BEGIN |
| DECLARE |
| TYPE ARR IS ARRAY(1..2) OF T; |
| |
| VAL1 : T := C; |
| |
| VAL2 : ARR := (C, C); |
| |
| VAL3 : T RENAMES C; |
| BEGIN |
| NULL; |
| END; |
| |
| NULL; |
| END C74306A; |
