URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cc/] [cc3123a.ada] - Rev 867
Go to most recent revision | Compare with Previous | Blame | View Log
-- CC3123A.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. --* -- CHECK THAT DEFAULT EXPRESSIONS FOR GENERIC IN PARAMETERS ARE ONLY -- EVALUATED IF THERE ARE NO ACTUAL PARAMETERS. -- TBN 12/01/86 WITH REPORT; USE REPORT; PROCEDURE CC3123A IS BEGIN TEST ("CC3123A", "CHECK THAT DEFAULT EXPRESSIONS FOR GENERIC IN " & "PARAMETERS ARE ONLY EVALUATED IF THERE ARE " & "NO ACTUAL PARAMETERS"); DECLARE TYPE ENUM IS (I, II, III); OBJ_INT : INTEGER := 1; OBJ_ENUM : ENUM := I; GENERIC GEN_INT : IN INTEGER := IDENT_INT(2); GEN_BOOL : IN BOOLEAN := IDENT_BOOL(FALSE); GEN_ENUM : IN ENUM := II; PACKAGE P IS PAC_INT : INTEGER := GEN_INT; PAC_BOOL : BOOLEAN := GEN_BOOL; PAC_ENUM : ENUM := GEN_ENUM; END P; PACKAGE P1 IS NEW P; PACKAGE P2 IS NEW P (IDENT_INT(OBJ_INT), GEN_ENUM => OBJ_ENUM); PACKAGE P3 IS NEW P (GEN_BOOL => IDENT_BOOL(TRUE)); BEGIN IF P1.PAC_INT /= 2 OR P1.PAC_BOOL OR P1.PAC_ENUM /= II THEN FAILED ("DEFAULT VALUES WERE NOT EVALUATED"); END IF; IF P2.PAC_INT /= 1 OR P2.PAC_BOOL OR P2.PAC_ENUM /= I THEN FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " & "- 1"); END IF; IF P3.PAC_INT /= 2 OR NOT(P3.PAC_BOOL) OR P3.PAC_ENUM /= II THEN FAILED ("DEFAULT VALUES WERE NOT EVALUATED CORRECTLY " & "- 2"); END IF; END; ------------------------------------------------------------------- DECLARE OBJ_INT1 : INTEGER := 3; FUNCTION FUNC (X : INTEGER) RETURN INTEGER; GENERIC GEN_INT1 : IN INTEGER := FUNC (1); GEN_INT2 : IN INTEGER := FUNC (GEN_INT1 + 1); PROCEDURE PROC; PROCEDURE PROC IS PROC_INT1 : INTEGER := GEN_INT1; PROC_INT2 : INTEGER := GEN_INT2; BEGIN IF PROC_INT1 /= 3 THEN FAILED ("DEFAULT VALUES WERE NOT EVALUATED " & "CORRECTLY - 3"); END IF; IF PROC_INT2 /= 4 THEN FAILED ("DEFAULT VALUES WERE NOT EVALUATED " & "CORRECTLY - 4"); END IF; END PROC; FUNCTION FUNC (X : INTEGER) RETURN INTEGER IS BEGIN IF X /= IDENT_INT(4) THEN FAILED ("DEFAULT VALUES WERE NOT EVALUATED " & "CORRECTLY - 5"); END IF; RETURN IDENT_INT(X); END FUNC; PROCEDURE NEW_PROC IS NEW PROC (GEN_INT1 => OBJ_INT1); BEGIN NEW_PROC; END; ------------------------------------------------------------------- DECLARE TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER; TYPE REC IS RECORD ANS : BOOLEAN; ARA : ARA_TYP; END RECORD; TYPE ARA_REC IS ARRAY (1 .. 5) OF REC; FUNCTION F (X : INTEGER) RETURN INTEGER; OBJ_REC : REC := (FALSE, (3, 4)); OBJ_ARA : ARA_REC := (1 .. 5 => (FALSE, (3, 4))); GENERIC GEN_OBJ1 : IN ARA_TYP := (F(1), 2); GEN_OBJ2 : IN REC := (TRUE, GEN_OBJ1); GEN_OBJ3 : IN ARA_REC := (1 .. F(5) => (TRUE, (1, 2))); FUNCTION FUNC RETURN INTEGER; FUNCTION FUNC RETURN INTEGER IS BEGIN RETURN IDENT_INT(1); END FUNC; FUNCTION F (X : INTEGER) RETURN INTEGER IS BEGIN FAILED ("DEFAULT VALUES WERE EVALUATED - 1"); RETURN IDENT_INT(X); END F; FUNCTION NEW_FUNC IS NEW FUNC ((3, 4), OBJ_REC, OBJ_ARA); BEGIN IF NOT EQUAL (NEW_FUNC, 1) THEN FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 1"); END IF; END; ------------------------------------------------------------------- DECLARE SUBTYPE INT IS INTEGER RANGE 1 .. 5; TYPE ARA_TYP IS ARRAY (1 .. 2) OF INTEGER; TYPE COLOR IS (RED, WHITE); TYPE CON_REC (D : INT) IS RECORD A : COLOR; B : ARA_TYP; END RECORD; TYPE UNCON_OR_CON_REC (D : INT := 2) IS RECORD A : COLOR; B : ARA_TYP; END RECORD; FUNCTION F (X : COLOR) RETURN COLOR; OBJ_CON1 : CON_REC (1) := (1, WHITE, (3, 4)); OBJ_UNCON : UNCON_OR_CON_REC := (2, WHITE, (3, 4)); OBJ_CON2 : UNCON_OR_CON_REC (3) := (3, WHITE, (3, 4)); GENERIC GEN_CON1 : IN CON_REC := (2, F(RED), (1, 2)); GEN_UNCON : IN UNCON_OR_CON_REC := (2, F(RED), (1, 2)); GEN_CON2 : IN UNCON_OR_CON_REC := GEN_UNCON; FUNCTION FUNC RETURN INTEGER; FUNCTION FUNC RETURN INTEGER IS BEGIN RETURN IDENT_INT(1); END FUNC; FUNCTION F (X : COLOR) RETURN COLOR IS BEGIN FAILED ("DEFAULT VALUES WERE EVALUATED - 2"); RETURN WHITE; END F; FUNCTION NEW_FUNC IS NEW FUNC (OBJ_CON1, OBJ_UNCON, OBJ_CON2); BEGIN IF NOT EQUAL (NEW_FUNC, 1) THEN FAILED ("INCORRECT RESULT FROM GENERIC FUNCTION - 2"); END IF; END; RESULT; END CC3123A;
Go to most recent revision | Compare with Previous | Blame | View Log