Subversion Repositories openrisc_2011-10-31

-- CC3106B.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 THE FORMAL PARAMETER DENOTES THE ACTUAL

--     IN AN INSTANTIATION.

-- HISTORY:

--     LDC 06/20/88  CREATED ORIGINAL TEST

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

--                                       DIMENSIONAL ARRAYS

WITH REPORT ;

PROCEDURE CC3106B IS

BEGIN  -- CC3106B

    REPORT.TEST("CC3106B","CHECK THAT THE FORMAL PARAMETER DENOTES " &

                "THE ACTUAL IN AN INSTANTIATION");

    LOCAL_BLOCK:

    DECLARE

        SUBTYPE SM_INT IS INTEGER RANGE 0..15 ;

        TYPE PCK_BOL IS ARRAY (5..18) OF BOOLEAN ;

        PRAGMA PACK(PCK_BOL) ;

        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 := (THREE_DIMENSIONAL'RANGE =>

                                        (THREE_DIMENSIONAL'RANGE (2) =>

                                        (THREE_DIMENSIONAL'RANGE (3) =>

                                          TODAY))) ;

        TASK TYPE TSK IS

            ENTRY ENT_1;

            ENTRY ENT_2;

            ENTRY ENT_3;

        END TSK;

        GENERIC

            TYPE GEN_TYPE IS (<>);

            GEN_BOLARR         : IN OUT PCK_BOL;

            GEN_TYP            : IN OUT GEN_TYPE;

            GEN_TSK            : IN OUT TSK;

            TEST_VALUE         : IN DATE ;

            TEST_CUBE          : IN OUT THREE_DIMENSIONAL ;

        PACKAGE P IS

               PROCEDURE GEN_PROC1 ;

               PROCEDURE GEN_PROC2 ;

               PROCEDURE GEN_PROC3 ;

               PROCEDURE ARRAY_TEST ;

        END P;

        ACT_BOLARR : PCK_BOL := (OTHERS => FALSE);

        SI         : SM_INT := 0 ;

        T          : TSK;

        PACKAGE BODY P IS

            PROCEDURE GEN_PROC1 IS

            BEGIN  -- GEN_PROC1

                GEN_BOLARR(14) := REPORT.IDENT_BOOL(TRUE);

                GEN_TYP := GEN_TYPE'VAL(4);

                IF ACT_BOLARR(14) /= TRUE OR SI /= REPORT.IDENT_INT(4)

                   THEN

                    REPORT.FAILED("VALUES ARE DIFFERENT THAN " &

                                  "INSTANTIATED VALUES");

                END IF;

            END GEN_PROC1;

            PROCEDURE GEN_PROC2 IS

            BEGIN  -- GEN_PROC2

                IF GEN_BOLARR(9) /= REPORT.IDENT_BOOL(TRUE) OR

                      GEN_TYPE'POS(GEN_TYP) /= REPORT.IDENT_INT(2) THEN

                    REPORT.FAILED("VALUES ARE DIFFERENT THAN " &

                                  "VALUES ASSIGNED IN THE MAIN " &

                                  "PROCEDURE");

                END IF;

                GEN_BOLARR(18) := TRUE;

                GEN_TYP := GEN_TYPE'VAL(9);

            END GEN_PROC2;

            PROCEDURE GEN_PROC3 IS

            BEGIN  -- GEN_PROC3

                GEN_TSK.ENT_2;

            END GEN_PROC3 ;

            PROCEDURE ARRAY_TEST IS

            BEGIN  -- ARRAY_TEST

                TEST_CUBE (0, JUN, 'C') := TEST_VALUE ;

                IF (TD_ARRAY (0, JUN, 'C')  /= TEST_VALUE) OR

                      (TEST_CUBE (-5, MAR, 'A') /= WALL_DATE) THEN

                    REPORT.FAILED ("MULTI-DIMENSIONAL ARRAY VALUES ARE " &

                                   "DIFFERENT THAN THE VALUES ASSIGNED " &

                                   "IN THE MAIN AND ARRAY_TEST PROCEDURES.") ;

                END IF ;

            END ARRAY_TEST ;

        END P ;

        TASK BODY TSK IS

        BEGIN  -- TSK

            ACCEPT ENT_1 DO

                REPORT.COMMENT("TASK ENTRY 1 WAS CALLED");

            END;

            ACCEPT ENT_2 DO

                REPORT.COMMENT("TASK ENTRY 2 WAS CALLED");

            END;

            ACCEPT ENT_3 DO

                REPORT.COMMENT("TASK ENTRY 3 WAS CALLED");

            END;

        END TSK;

        PACKAGE INSTA1 IS NEW P (GEN_TYPE       => SM_INT,

                                 GEN_BOLARR     => ACT_BOLARR,

                                 GEN_TYP        => SI,

                                 GEN_TSK        => T,

                                 TEST_VALUE     => FIRST_DATE,

                                 TEST_CUBE      => TD_ARRAY) ;

    BEGIN  -- LOCAL_BLOCK

        INSTA1.GEN_PROC1;

        ACT_BOLARR(9) := TRUE;

        SI := 2;

        INSTA1.GEN_PROC2;

        IF ACT_BOLARR(18) /= REPORT.IDENT_BOOL(TRUE) OR

              SI /= REPORT.IDENT_INT(9) THEN

            REPORT.FAILED("VALUES ARE DIFFERENT THAN VALUES " &

                          "ASSIGNED IN THE GENERIC PROCEDURE");

        END IF;

        T.ENT_1;

        INSTA1.GEN_PROC3;

        T.ENT_3;

        TD_ARRAY (-5, MAR, 'A') := WALL_DATE ;

        INSTA1.ARRAY_TEST ;

     END LOCAL_BLOCK;

     REPORT.RESULT;

END CC3106B ;