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