URL
https://opencores.org/ocsvn/scarts/scarts/trunk
Subversion Repositories scarts
[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c7/] [c74306a.ada] - Rev 12
Compare with Previous | Blame | View Log
-- 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;