/gcc-4.6-pre/gcc/testsuite/ada/acats/tests/c7/c74302b.ada
Ada | 308 lines | 222 code | 54 blank | 32 comment | 0 complexity | ed96f028ca11af40b3ba2093a404f55c MD5 | raw file
- -- C74302B.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 WHEN THE FULL DECLARATION OF A DEFERRED CONSTANT IS
- -- GIVEN AS A MULTIPLE DECLARATION, THE INITIALIZATION EXPRESSION
- -- IS EVALUATED ONCE FOR EACH DEFERRED CONSTANT. (USE ENUMERATION,
- -- INTEGER, FIXED POINT, FLOATING POINT, ARRAY, RECORD (INCLUDING
- -- USE OF DEFAULT EXPRESSIONS FOR COMPONENTS), ACCESS, AND PRIVATE
- -- TYPES AS FULL DECLARATION OF PRIVATE TYPE)
- -- HISTORY:
- -- BCB 07/25/88 CREATED ORIGINAL TEST.
- WITH REPORT; USE REPORT;
- PROCEDURE C74302B IS
- TYPE ARR_RAN IS RANGE 1..2;
- BUMP : INTEGER := IDENT_INT(0);
- GENERIC
- TYPE DT IS (<>);
- FUNCTION F1 RETURN DT;
- GENERIC
- TYPE FE IS DELTA <>;
- FUNCTION F2 RETURN FE;
- GENERIC
- TYPE FLE IS DIGITS <>;
- FUNCTION F3 RETURN FLE;
- GENERIC
- TYPE CA IS ARRAY(ARR_RAN) OF INTEGER;
- FUNCTION F4 RETURN CA;
- GENERIC
- TYPE GP IS LIMITED PRIVATE;
- FUNCTION F5 (V : GP) RETURN GP;
- GENERIC
- TYPE GP1 IS LIMITED PRIVATE;
- FUNCTION F6 (V1 : GP1) RETURN GP1;
- GENERIC
- TYPE AC IS ACCESS INTEGER;
- FUNCTION F7 RETURN AC;
- GENERIC
- TYPE PP IS PRIVATE;
- FUNCTION F8 (P1 : PP) RETURN PP;
- FUNCTION F1 RETURN DT IS
- BEGIN
- BUMP := BUMP + 1;
- RETURN DT'VAL(BUMP);
- END F1;
- FUNCTION F2 RETURN FE IS
- BEGIN
- BUMP := BUMP + 1;
- RETURN FE(BUMP);
- END F2;
- FUNCTION F3 RETURN FLE IS
- BEGIN
- BUMP := BUMP + 1;
- RETURN FLE(BUMP);
- END F3;
- FUNCTION F4 RETURN CA IS
- BEGIN
- BUMP := BUMP + 1;
- RETURN ((BUMP,BUMP-1));
- END F4;
- FUNCTION F5 (V : GP) RETURN GP IS
- BEGIN
- BUMP := BUMP + 1;
- RETURN V;
- END F5;
- FUNCTION F6 (V1 : GP1) RETURN GP1 IS
- BEGIN
- BUMP := BUMP + 1;
- RETURN V1;
- END F6;
- FUNCTION F7 RETURN AC IS
- VAR : AC;
- BEGIN
- BUMP := BUMP + 1;
- VAR := NEW INTEGER'(BUMP);
- RETURN VAR;
- END F7;
- FUNCTION F8 (P1 : PP) RETURN PP IS
- BEGIN
- BUMP := BUMP + 1;
- RETURN P1;
- END F8;
- PACKAGE PACK IS
- TYPE SP IS PRIVATE;
- CONS : CONSTANT SP;
- PRIVATE
- TYPE SP IS RANGE 1 .. 100;
- CONS : CONSTANT SP := 50;
- END PACK;
- USE PACK;
- PACKAGE P IS
- TYPE INT IS PRIVATE;
- TYPE ENUM IS PRIVATE;
- TYPE FIX IS PRIVATE;
- TYPE FLT IS PRIVATE;
- TYPE CON_ARR IS PRIVATE;
- TYPE REC IS PRIVATE;
- TYPE REC1 IS PRIVATE;
- TYPE ACC IS PRIVATE;
- TYPE PRIV IS PRIVATE;
- GENERIC
- TYPE LP IS PRIVATE;
- FUNCTION GEN_EQUAL (Z1, Z2 : LP) RETURN BOOLEAN;
- I1, I2, I3, I4 : CONSTANT INT;
- E1, E2, E3, E4 : CONSTANT ENUM;
- FI1, FI2, FI3, FI4 : CONSTANT FIX;
- FL1, FL2, FL3, FL4 : CONSTANT FLT;
- CA1, CA2, CA3, CA4 : CONSTANT CON_ARR;
- R1, R2, R3, R4 : CONSTANT REC;
- R1A, R2A, R3A, R4A : CONSTANT REC1;
- A1, A2, A3, A4 : CONSTANT ACC;
- PR1, PR2, PR3, PR4 : CONSTANT PRIV;
- PRIVATE
- TYPE INT IS RANGE 1 .. 100;
- TYPE ENUM IS (ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE);
- TYPE FIX IS DELTA 2.0**(-1) RANGE -100.0 .. 100.0;
- TYPE FLT IS DIGITS 5 RANGE -100.0 .. 100.0;
- TYPE CON_ARR IS ARRAY(ARR_RAN) OF INTEGER;
- TYPE REC IS RECORD
- COMP1 : INTEGER;
- COMP2 : INTEGER;
- COMP3 : BOOLEAN;
- END RECORD;
- TYPE REC1 IS RECORD
- COMP1 : INTEGER := 10;
- COMP2 : INTEGER := 20;
- COMP3 : BOOLEAN := FALSE;
- END RECORD;
- TYPE ACC IS ACCESS INTEGER;
- TYPE PRIV IS NEW SP;
- FUNCTION DDT IS NEW F1 (INT);
- FUNCTION EDT IS NEW F1 (ENUM);
- FUNCTION FDT IS NEW F2 (FIX);
- FUNCTION FLDT IS NEW F3 (FLT);
- FUNCTION CADT IS NEW F4 (CON_ARR);
- FUNCTION RDT IS NEW F5 (REC);
- FUNCTION R1DT IS NEW F6 (REC1);
- FUNCTION ADT IS NEW F7 (ACC);
- FUNCTION PDT IS NEW F8 (PRIV);
- REC_OBJ : REC := (1,2,TRUE);
- REC1_OBJ : REC1 := (3,4,FALSE);
- I1, I2, I3, I4 : CONSTANT INT := DDT;
- E1, E2, E3, E4 : CONSTANT ENUM := EDT;
- FI1, FI2, FI3, FI4 : CONSTANT FIX := FDT;
- FL1, FL2, FL3, FL4 : CONSTANT FLT := FLDT;
- CA1, CA2, CA3, CA4 : CONSTANT CON_ARR := CADT;
- R1, R2, R3, R4 : CONSTANT REC := RDT(REC_OBJ);
- R1A, R2A, R3A, R4A : CONSTANT REC1 := R1DT(REC1_OBJ);
- A1, A2, A3, A4 : CONSTANT ACC := ADT;
- PR1, PR2, PR3, PR4 : CONSTANT PRIV := PDT(PRIV(CONS));
- END P;
- PACKAGE BODY P IS
- AVAR1 : ACC := NEW INTEGER'(29);
- AVAR2 : ACC := NEW INTEGER'(30);
- AVAR3 : ACC := NEW INTEGER'(31);
- AVAR4 : ACC := NEW INTEGER'(32);
- FUNCTION GEN_EQUAL (Z1, Z2 : LP) RETURN BOOLEAN IS
- BEGIN
- RETURN Z1 = Z2;
- END GEN_EQUAL;
- FUNCTION INT_EQUAL IS NEW GEN_EQUAL (INT);
- FUNCTION ENUM_EQUAL IS NEW GEN_EQUAL (ENUM);
- FUNCTION FIX_EQUAL IS NEW GEN_EQUAL (FIX);
- FUNCTION FLT_EQUAL IS NEW GEN_EQUAL (FLT);
- FUNCTION ARR_EQUAL IS NEW GEN_EQUAL (CON_ARR);
- FUNCTION REC_EQUAL IS NEW GEN_EQUAL (REC);
- FUNCTION REC1_EQUAL IS NEW GEN_EQUAL (REC1);
- FUNCTION ACC_EQUAL IS NEW GEN_EQUAL (INTEGER);
- FUNCTION PRIV_EQUAL IS NEW GEN_EQUAL (PRIV);
- BEGIN
- TEST ("C74302B", "CHECK THAT WHEN THE FULL DECLARATION OF " &
- "A DEFERRED CONSTANT IS GIVEN AS A " &
- "MULTIPLE DECLARATION, THE INITIALIZATION " &
- "EXPRESSION IS EVALUATED ONCE FOR EACH " &
- "DEFERRED CONSTANT");
- IF NOT EQUAL(BUMP,36) THEN
- FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
- "DEFERRED CONSTANTS IN A MULIPLE DECLARATION");
- END IF;
- IF NOT INT_EQUAL(I1,1) OR NOT INT_EQUAL(I2,2) OR
- NOT INT_EQUAL(I3,3) OR NOT INT_EQUAL(I4,4) THEN
- FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
- "DEFERRED INTEGER CONSTANTS");
- END IF;
- IF NOT ENUM_EQUAL(E1,SIX) OR NOT ENUM_EQUAL(E2,SEVEN) OR
- NOT ENUM_EQUAL(E3,EIGHT) OR NOT ENUM_EQUAL(E4,NINE) THEN
- FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
- "DEFERRED ENUMERATION CONSTANTS");
- END IF;
- IF NOT FIX_EQUAL(FI1,9.0) OR NOT FIX_EQUAL(FI2,10.0) OR
- NOT FIX_EQUAL(FI3,11.0) OR NOT FIX_EQUAL(FI4,12.0) THEN
- FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
- "DEFERRED FIXED POINT CONSTANTS");
- END IF;
- IF NOT FLT_EQUAL(FL1,13.0) OR NOT FLT_EQUAL(FL2,14.0) OR
- NOT FLT_EQUAL(FL3,15.0) OR NOT FLT_EQUAL(FL4,16.0) THEN
- FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
- "DEFERRED FLOATING POINT CONSTANTS");
- END IF;
- IF NOT ARR_EQUAL(CA1,(17,16)) OR NOT ARR_EQUAL(CA2,(18,17))
- OR NOT ARR_EQUAL(CA3,(19,18)) OR NOT ARR_EQUAL(CA4,(20,19))
- THEN FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
- "DEFERRED ARRAY CONSTANTS");
- END IF;
- IF NOT REC_EQUAL(R1,REC_OBJ) OR NOT REC_EQUAL(R2,REC_OBJ)
- OR NOT REC_EQUAL(R3,REC_OBJ) OR NOT REC_EQUAL(R4,REC_OBJ)
- THEN FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
- "DEFERRED RECORD CONSTANTS");
- END IF;
- IF NOT REC1_EQUAL(R1A,REC1_OBJ) OR NOT REC1_EQUAL(R2A,
- REC1_OBJ) OR NOT REC1_EQUAL(R3A,REC1_OBJ) OR NOT
- REC1_EQUAL(R4A,REC1_OBJ) THEN
- FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
- "DEFERRED RECORD CONSTANTS WITH DEFAULT " &
- "EXPRESSIONS");
- END IF;
- IF NOT ACC_EQUAL(A1.ALL,AVAR1.ALL) OR NOT ACC_EQUAL(A2.ALL,
- AVAR2.ALL) OR NOT ACC_EQUAL(A3.ALL,AVAR3.ALL) OR NOT
- ACC_EQUAL(A4.ALL,AVAR4.ALL) THEN
- FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
- "DEFERRED ACCESS CONSTANTS");
- END IF;
- IF NOT PRIV_EQUAL(PR1,PRIV(CONS)) OR NOT PRIV_EQUAL(PR2,
- PRIV(CONS)) OR NOT PRIV_EQUAL(PR3,PRIV(CONS)) OR NOT
- PRIV_EQUAL(PR4,PRIV(CONS)) THEN
- FAILED ("IMPROPER RESULTS FROM INITIALIZATION OF " &
- "DEFERRED PRIVATE CONSTANTS");
- END IF;
- RESULT;
- END P;
- USE P;
- BEGIN
- NULL;
- END C74302B;