Subversion Repositories openrisc

-- CC3224A.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 A FORMAL ARRAY TYPE DENOTES ITS ACTUAL

--     PARAMETER, AND THAT OPERATIONS OF THE FORMAL TYPE ARE THOSE

--     IDENTIFIED WITH THE CORRESPONDING OPERATIONS OF THE ACTUAL TYPE.

-- HISTORY:

--     DHH 09/19/88  CREATED ORIGINAL TEST.

--     EDWARD V. BERARD, 14 AUGUST 1990  ADDED CHECKS FOR MULTI-

--                                       DIMENSIONAL ARRAYS

--     PWN 11/30/94 REMOVED 'BASE USE ILLEGAL IN ADA 9X.

WITH REPORT ;

PROCEDURE CC3224A IS

    SUBTYPE INT IS INTEGER RANGE 1 .. 3;

    TYPE ARR IS ARRAY(1 .. 3) OF INTEGER;

    TYPE B_ARR IS ARRAY(1 .. 3) OF BOOLEAN;

    Q : ARR;

    R : B_ARR;

    GENERIC

        TYPE T IS ARRAY(INT) OF INTEGER;

    PACKAGE P IS

        SUBTYPE SUB_T IS T;

        X : SUB_T := (1, 2, 3);

    END P;

    GENERIC

        TYPE T IS ARRAY(INT) OF BOOLEAN;

    PACKAGE BOOL IS

        SUBTYPE SUB_T IS T;

    END BOOL;

    SHORT_START : CONSTANT := -100 ;

    SHORT_END   : CONSTANT := 100 ;

    TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;

    SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ;

    TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,

                        SEP, OCT, NOV, DEC) ;

    SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ;

    TYPE DAY_TYPE IS RANGE 1 .. 31 ;

    TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;

    TYPE DATE IS RECORD

      MONTH : MONTH_TYPE ;

      DAY   : DAY_TYPE ;

      YEAR  : YEAR_TYPE ;

    END RECORD ;

    TODAY         : DATE := (MONTH => AUG,

                             DAY   => 8,

                             YEAR  => 1990) ;

    FIRST_DATE    : DATE := (DAY   => 6,

                             MONTH => JUN,

                             YEAR  => 1967) ;

    WALL_DATE     : DATE := (MONTH => NOV,

                             DAY   => 9,

                             YEAR  => 1989) ;

    SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ;

    TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT,

                                     FIRST_HALF,

                                     FIRST_FIVE) OF DATE ;

    TD_ARRAY        : THREE_DIMENSIONAL ;

    SECOND_TD_ARRAY : THREE_DIMENSIONAL ;

    GENERIC

        TYPE CUBE IS ARRAY (REALLY_SHORT,

                            FIRST_HALF,

                            FIRST_FIVE) OF DATE ;

    PACKAGE TD_ARRAY_PACKAGE IS

        SUBTYPE SUB_CUBE IS CUBE ;

        TEST_3D_ARRAY : SUB_CUBE := (THREE_DIMENSIONAL'RANGE =>

                                    (THREE_DIMENSIONAL'RANGE (2) =>

                                    (THREE_DIMENSIONAL'RANGE (3) =>

                                     TODAY))) ;

    END TD_ARRAY_PACKAGE ;

BEGIN  -- CC3224A

    REPORT.TEST ("CC3224A", "CHECK THAT A FORMAL ARRAY TYPE DENOTES " &

                 "ITS ACTUAL PARAMETER, AND THAT OPERATIONS OF " &

                 "THE FORMAL TYPE ARE THOSE IDENTIFIED WITH THE " &

                 "CORRESPONDING OPERATIONS OF THE ACTUAL TYPE");

    ONE_DIMENSIONAL:

    DECLARE

        PACKAGE P1 IS NEW P (ARR);

        TYPE NEW_T IS NEW P1.SUB_T;

        OBJ_NEWT : NEW_T;

    BEGIN  -- ONE_DIMENSIONAL

        IF NEW_T'FIRST /= ARR'FIRST THEN

            REPORT.FAILED("'FIRST ATTRIBUTE REPORT.FAILED");

        END IF;

        IF NEW_T'LAST /= ARR'LAST THEN

            REPORT.FAILED("'LAST ATTRIBUTE REPORT.FAILED");

        END IF;

        IF NEW_T'FIRST(1) /= ARR'FIRST(1) THEN

            REPORT.FAILED("'FIRST(N) ATTRIBUTE REPORT.FAILED");

        END IF;

        IF NOT (NEW_T'LAST(1) = ARR'LAST(1)) THEN

            REPORT.FAILED("'LAST(N) ATTRIBUTE REPORT.FAILED");

        END IF;

        IF 2 NOT IN NEW_T'RANGE THEN

            REPORT.FAILED("'RANGE ATTRIBUTE REPORT.FAILED");

        END IF;

        IF 3 NOT IN NEW_T'RANGE(1) THEN

            REPORT.FAILED("'RANGE(N) ATTRIBUTE REPORT.FAILED");

        END IF;

        IF NEW_T'LENGTH /= ARR'LENGTH THEN

            REPORT.FAILED("'LENGTH ATTRIBUTE REPORT.FAILED");

        END IF;

        IF NEW_T'LENGTH(1) /= ARR'LENGTH(1) THEN

            REPORT.FAILED("'LENGTH(N) ATTRIBUTE REPORT.FAILED");

         END IF;

        OBJ_NEWT := (1, 2, 3);

        IF REPORT.IDENT_INT(3) /= OBJ_NEWT(3) THEN

            REPORT.FAILED("ASSIGNMENT REPORT.FAILED");

        END IF;

        IF NEW_T'(1, 2, 3) NOT IN NEW_T THEN

            REPORT.FAILED("QUALIFIED EXPRESSION REPORT.FAILED");

        END IF;

        Q := (1, 2, 3);

        IF NEW_T(Q) /= OBJ_NEWT THEN

            REPORT.FAILED("EXPLICIT CONVERSION REPORT.FAILED");

        END IF;

        IF Q(1) /= OBJ_NEWT(1) THEN

            REPORT.FAILED("INDEXING REPORT.FAILED");

        END IF;

        IF (1, 2) /= OBJ_NEWT(1 .. 2) THEN

            REPORT.FAILED("SLICE REPORT.FAILED");

        END IF;

        IF (1, 2) & OBJ_NEWT(3) /= NEW_T(Q)THEN

            REPORT.FAILED("CATENATION REPORT.FAILED");

        END IF;

        IF NOT (P1.X IN ARR) THEN

            REPORT.FAILED ("FORMAL DOES NOT DENOTE ACTUAL");

        END IF;

    END ONE_DIMENSIONAL ;

    BOOLEAN_ONE_DIMENSIONAL:

    DECLARE

        PACKAGE B1 IS NEW BOOL (B_ARR);

        TYPE NEW_T IS NEW B1.SUB_T;

        OBJ_NEWT : NEW_T;

    BEGIN  -- BOOLEAN_ONE_DIMENSIONAL

        OBJ_NEWT := (TRUE, TRUE, TRUE);

        R := (TRUE, TRUE, TRUE);

        IF (NEW_T'((TRUE, TRUE, TRUE)) XOR OBJ_NEWT) /=

           NEW_T'((FALSE, FALSE, FALSE)) THEN

            REPORT.FAILED("XOR REPORT.FAILED - BOOLEAN") ;

        END IF;

        IF (NEW_T'((FALSE, FALSE, TRUE)) AND OBJ_NEWT) /=

           NEW_T'((FALSE, FALSE, TRUE)) THEN

            REPORT.FAILED("AND REPORT.FAILED - BOOLEAN") ;

        END IF;

        IF (NEW_T'((FALSE, FALSE, FALSE)) OR OBJ_NEWT) /=

           NEW_T'((TRUE, TRUE, TRUE)) THEN

            REPORT.FAILED("OR REPORT.FAILED - BOOLEAN") ;

        END IF ;

    END BOOLEAN_ONE_DIMENSIONAL ;

    THREE_DIMENSIONAL_TEST:

    DECLARE

         PACKAGE TD IS NEW TD_ARRAY_PACKAGE (CUBE => THREE_DIMENSIONAL) ;

        TYPE NEW_CUBE IS NEW TD.SUB_CUBE ;

        NEW_CUBE_OBJECT : NEW_CUBE ;

    BEGIN  -- THREE_DIMENSIONAL_TEST

        IF (NEW_CUBE'FIRST /= THREE_DIMENSIONAL'FIRST) OR

           (NEW_CUBE'FIRST (1) /= THREE_DIMENSIONAL'FIRST) OR

           (NEW_CUBE'FIRST (2) /= THREE_DIMENSIONAL'FIRST (2)) OR

           (NEW_CUBE'FIRST (3) /= THREE_DIMENSIONAL'FIRST (3)) THEN

            REPORT.FAILED ("PROBLEMS WITH 'FIRST FOR MULTI-" &

                           "DIMENSIONAL ARRAYS.") ;

        END IF ;

        IF (NEW_CUBE'LAST /= THREE_DIMENSIONAL'LAST) OR

           (NEW_CUBE'LAST (1) /= THREE_DIMENSIONAL'LAST) OR

           (NEW_CUBE'LAST (2) /= THREE_DIMENSIONAL'LAST (2)) OR

           (NEW_CUBE'LAST (3) /= THREE_DIMENSIONAL'LAST (3)) THEN

            REPORT.FAILED ("PROBLEMS WITH 'LAST FOR MULTI-" &

                           "DIMENSIONAL ARRAYS.") ;

        END IF ;

        IF (-5 NOT IN NEW_CUBE'RANGE) OR

           (-3 NOT IN NEW_CUBE'RANGE (1)) OR

           (FEB NOT IN NEW_CUBE'RANGE (2)) OR

           ('C' NOT IN NEW_CUBE'RANGE (3)) THEN

            REPORT.FAILED ("PROBLEMS WITH 'RANGE FOR MULTI-" &

                           "DIMENSIONAL ARRAYS.") ;

        END IF ;

        IF (NEW_CUBE'LENGTH /= THREE_DIMENSIONAL'LENGTH) OR

           (NEW_CUBE'LENGTH (1) /= THREE_DIMENSIONAL'LENGTH) OR

           (NEW_CUBE'LENGTH (2) /= THREE_DIMENSIONAL'LENGTH (2)) OR

           (NEW_CUBE'LENGTH (3) /= THREE_DIMENSIONAL'LENGTH (3)) THEN

            REPORT.FAILED ("PROBLEMS WITH 'LENGTH FOR MULTI-" &

                           "DIMENSIONAL ARRAYS.") ;

        END IF ;

        NEW_CUBE_OBJECT := (NEW_CUBE'RANGE =>

                           (NEW_CUBE'RANGE (2) =>

                           (NEW_CUBE'RANGE (3) =>

                            FIRST_DATE))) ;

        IF FIRST_DATE /= NEW_CUBE_OBJECT (-3, MAR, 'D') THEN

            REPORT.FAILED ("ASSIGNMENT FOR MULTI-DIMENSIONAL " &

                           "ARRAYS FAILED.") ;

        END IF ;

        IF NEW_CUBE'(NEW_CUBE'RANGE =>

                    (NEW_CUBE'RANGE (2) =>

                    (NEW_CUBE'RANGE (3) =>

                     WALL_DATE))) NOT IN NEW_CUBE THEN

            REPORT.FAILED ("QUALIFIED EXPRESSION FOR MULTI-" &

                           "DIMENSIONAL ARRAYS FAILED.") ;

        END IF ;

        SECOND_TD_ARRAY := (NEW_CUBE'RANGE =>

                           (NEW_CUBE'RANGE (2) =>

                           (NEW_CUBE'RANGE (3) =>

                            FIRST_DATE))) ;

        IF NEW_CUBE (SECOND_TD_ARRAY) /= NEW_CUBE_OBJECT THEN

            REPORT.FAILED ("EXPLICIT CONVERSION FOR MULTI-" &

                           "DIMENSIONAL ARRAYS FAILED.") ;

        END IF ;

        IF SECOND_TD_ARRAY (-2, FEB, 'B')

            /= NEW_CUBE_OBJECT (-2, FEB, 'B') THEN

            REPORT.FAILED ("INDEXING FOR MULTI-" &

                           "DIMENSIONAL ARRAYS FAILED.") ;

        END IF ;

        IF NOT (TD.TEST_3D_ARRAY IN THREE_DIMENSIONAL) THEN

            REPORT.FAILED ("FORMAL MULTI-DIMENSIONAL ARRAY " &

                           "DOES NOT DENOTE ACTUAL.") ;

        END IF ;

    END THREE_DIMENSIONAL_TEST ;

    REPORT.RESULT ;

END CC3224A ;