diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c7/c74306a.ada')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c7/c74306a.ada | 279 |
1 files changed, 279 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c7/c74306a.ada b/gcc/testsuite/ada/acats/tests/c7/c74306a.ada new file mode 100644 index 000000000..c6ebad3c8 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/c7/c74306a.ada @@ -0,0 +1,279 @@ +-- 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; |