c72002a.ada

来自「用于进行gcc测试」· ADA 代码 · 共 230 行

-- C72002A.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 THE DECLARATIVE ITEMS IN A PACKAGE SPECIFICATION ARE
--     ELABORATED IN THE ORDER DECLARED.

-- HISTORY:
--     DHH 03/09/88 CREATED ORIGINAL TEST.

WITH REPORT; USE REPORT;
PROCEDURE C72002A IS

     A : INTEGER := 0;
     TYPE ORDER_ARRAY IS ARRAY(1 .. 14) OF INTEGER;
     OBJECT_ARRAY : ORDER_ARRAY;
     TYPE REAL IS DIGITS 4;
     TYPE ENUM IS (RED,YELLOW,BLUE);

     TYPE ARR IS ARRAY(1 ..2) OF BOOLEAN;
     D : ARR := (TRUE, TRUE);
     E : ARR := (FALSE, FALSE);

     TYPE REC IS
          RECORD
               I : INTEGER;
          END RECORD;
     B : REC := (I => IDENT_INT(1));
     C : REC := (I => IDENT_INT(2));

     FUNCTION GIVEN_ORDER(X : INTEGER) RETURN INTEGER IS
          Y : INTEGER;
     BEGIN
          Y := X + 1;
          RETURN Y;
     END GIVEN_ORDER;

     FUNCTION BOOL(X : INTEGER) RETURN BOOLEAN IS
     BEGIN
          IF X = IDENT_INT(1) THEN
               A := GIVEN_ORDER(A);
               OBJECT_ARRAY(X) := A;
               RETURN TRUE;
          ELSIF X = IDENT_INT(8) THEN
               A := GIVEN_ORDER(A);
               OBJECT_ARRAY(X) := A;
               RETURN FALSE;
          END IF;
     END BOOL;

     FUNCTION INT(X : INTEGER) RETURN INTEGER IS
     BEGIN
          IF X = IDENT_INT(2) THEN
               A := GIVEN_ORDER(A);
               OBJECT_ARRAY(X) := A;
               RETURN IDENT_INT(1);
          ELSIF X = IDENT_INT(9) THEN
               A := GIVEN_ORDER(A);
               OBJECT_ARRAY(X) := A;
               RETURN IDENT_INT(2);
          END IF;
     END INT;

     FUNCTION FLOAT(X : INTEGER) RETURN REAL IS
     BEGIN
          IF X = IDENT_INT(3) THEN
               A := GIVEN_ORDER(A);
               OBJECT_ARRAY(X) := A;
               RETURN 1.0;
          ELSIF X = IDENT_INT(10) THEN
               A := GIVEN_ORDER(A);
               OBJECT_ARRAY(X) := A;
               RETURN 2.0;
          END IF;
     END FLOAT;

     FUNCTION CHAR(X : INTEGER) RETURN CHARACTER IS
     BEGIN
          IF X = IDENT_INT(4) THEN
               A := GIVEN_ORDER(A);
               OBJECT_ARRAY(X) := A;
               RETURN 'A';
          ELSIF X = IDENT_INT(11) THEN
               A := GIVEN_ORDER(A);
               OBJECT_ARRAY(X) := A;
               RETURN 'Z';
          END IF;
     END CHAR;

     FUNCTION ENUMR(X : INTEGER) RETURN ENUM IS
     BEGIN
          IF X = IDENT_INT(5) THEN
               A := GIVEN_ORDER(A);
               OBJECT_ARRAY(X) := A;
               RETURN RED;
          ELSIF X = IDENT_INT(12) THEN
               A := GIVEN_ORDER(A);
               OBJECT_ARRAY(X) := A;
               RETURN YELLOW;
          END IF;
     END ENUMR;

     FUNCTION ARRY(X : INTEGER) RETURN ARR IS
     BEGIN
          IF X = IDENT_INT(6) THEN
               A := GIVEN_ORDER(A);
               OBJECT_ARRAY(X) := A;
               RETURN D;
          ELSIF X = IDENT_INT(13) THEN
               A := GIVEN_ORDER(A);
               OBJECT_ARRAY(X) := A;
               RETURN E;
          END IF;
     END ARRY;

     FUNCTION RECOR(X : INTEGER) RETURN REC IS
     BEGIN
          IF X = IDENT_INT(7) THEN
               A := GIVEN_ORDER(A);
               OBJECT_ARRAY(X) := A;
               RETURN B;
          ELSIF X = IDENT_INT(14) THEN
               A := GIVEN_ORDER(A);
               OBJECT_ARRAY(X) := A;
               RETURN C;
          END IF;
     END RECOR;

     PACKAGE PACK IS
          A : BOOLEAN   := BOOL(1);
          B : INTEGER   := INT(2);
          C : REAL      := FLOAT(3);
          D : CHARACTER := CHAR(4);
          E : ENUM      := ENUMR(5);
          F : ARR       := ARRY(6);
          G : REC       := RECOR(7);
          H : BOOLEAN   := BOOL(8);
          I : INTEGER   := INT(9);
          J : REAL      := FLOAT(10);
          K : CHARACTER := CHAR(11);
          L : ENUM      := ENUMR(12);
          M : ARR       := ARRY(13);
          N : REC       := RECOR(14);
     END PACK;

BEGIN
     TEST("C72002A", "CHECK THAT THE DECLARATIVE ITEMS IN A PACKAGE " &
                     "SPECIFICATION ARE ELABORATED IN THE ORDER " &
                     "DECLARED");

     IF OBJECT_ARRAY(1) /= IDENT_INT(1) THEN
          FAILED("BOOLEAN 1 ELABORATED OUT OF ORDER");
     END IF;

     IF OBJECT_ARRAY(2) /= IDENT_INT(2) THEN
          FAILED("INTEGER 1 ELABORATED OUT OF ORDER");
     END IF;

     IF OBJECT_ARRAY(3) /= IDENT_INT(3) THEN
          FAILED("REAL 1 ELABORATED OUT OF ORDER");
     END IF;

     IF OBJECT_ARRAY(4) /= IDENT_INT(4) THEN
          FAILED("CHARACTER 1 ELABORATED OUT OF ORDER");
     END IF;

     IF OBJECT_ARRAY(5) /= IDENT_INT(5) THEN
          FAILED("ENUMERATION 1 ELABORATED OUT OF ORDER");
     END IF;

     IF OBJECT_ARRAY(6) /= IDENT_INT(6) THEN
          FAILED("ARRAY 1 ELABORATED OUT OF ORDER");
     END IF;

     IF OBJECT_ARRAY(7) /= IDENT_INT(7) THEN
          FAILED("RECORD 1 ELABORATED OUT OF ORDER");
     END IF;

     IF OBJECT_ARRAY(8) /= IDENT_INT(8) THEN
          FAILED("BOOLEAN 2 ELABORATED OUT OF ORDER");
     END IF;

     IF OBJECT_ARRAY(9) /= IDENT_INT(9) THEN
          FAILED("INTEGER 2 ELABORATED OUT OF ORDER");
     END IF;

     IF OBJECT_ARRAY(10) /= IDENT_INT(10) THEN
          FAILED("REAL 2 ELABORATED OUT OF ORDER");
     END IF;

     IF OBJECT_ARRAY(11) /= IDENT_INT(11) THEN
          FAILED("CHARACTER 2 ELABORATED OUT OF ORDER");
     END IF;

     IF OBJECT_ARRAY(12) /= IDENT_INT(12) THEN
          FAILED("ENUMERATION 2 ELABORATED OUT OF ORDER");
     END IF;

     IF OBJECT_ARRAY(13) /= IDENT_INT(13) THEN
          FAILED("ARRAY 2 ELABORATED OUT OF ORDER");
     END IF;

     IF OBJECT_ARRAY(14) /= IDENT_INT(14) THEN
          FAILED("RECORD 2 ELABORATED OUT OF ORDER");
     END IF;

     RESULT;
END C72002A;