Subversion Repositories openrisc_me

-- CC3016B.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 AN INSTANCE OF A GENERIC PACKAGE MUST DECLARE A

--  PACKAGE. CHECK THAT THE DECLARATIVE ITEMS IN AN INSTANTIATION

--  OF A GENERIC PACKAGE SPECIFICATION ARE ELABORATED IN THE ORDER

--  DECLARED.    

-- HISTORY:

--         EDWARD V. BERARD, 8 AUGUST 1990

WITH REPORT ;

PROCEDURE CC3016B IS

    WHEN_ELABORATED : NATURAL := 0 ;

    TYPE REAL IS DIGITS 6 ;

    REAL_VALUE : REAL := 3.14159 ;

    TRUE_VALUE : BOOLEAN := TRUE ;

    CHARACTER_VALUE : CHARACTER := 'Z' ;

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

                        SEP, OCT, NOV, DEC) ;

    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 ;

    TYPE DATE_ACCESS IS ACCESS DATE ;

    THIS_MONTH   : MONTH_TYPE := AUG ;

    THIS_YEAR     : YEAR_TYPE := 1990 ;

    TODAY         : DATE := (MONTH => AUG,

                               DAY   => 8,

                              YEAR  => 1990) ;

    FIRST_DATE   : DATE_ACCESS  := NEW DATE'(DAY   => 6,

                                             MONTH => JUN,

                                             YEAR  => 1967) ;

    TYPE DUE_DATES IS ARRAY (MONTH_TYPE RANGE JAN .. DEC) OF DATE ;

    REPORT_DATES : DUE_DATES := ((JAN, 23, 1990), (FEB, 23, 1990),

                                 (MAR, 23, 1990), (APR, 23, 1990),

                                 (MAY, 23, 1990), (JUN, 22, 1990),

                                 (JUL, 23, 1990), (AUG, 23, 1990),

                                 (SEP, 24, 1990), (OCT, 23, 1990),

                                 (NOV, 23, 1990), (DEC, 20, 1990)) ;

    TYPE LIST_INDEX IS RANGE 1 .. 16 ;

    TYPE LIST IS ARRAY (LIST_INDEX) OF NATURAL ;

    ORDER_LIST : LIST := (OTHERS => 0) ;

    GENERIC

        TYPE RETURN_TYPE IS PRIVATE ;

        RETURN_VALUE : IN OUT RETURN_TYPE ;

        POSITION      : IN       NATURAL ;

        OFFSET        : IN       NATURAL ;

        WHEN_ELAB     : IN OUT NATURAL ;

        TYPE INDEX IS RANGE <> ;

        TYPE LIST IS ARRAY (INDEX) OF NATURAL ;

        ORDER_LIST      : IN OUT LIST ;

    FUNCTION NAME (VALUE : IN NATURAL) RETURN RETURN_TYPE ;

    FUNCTION NAME (VALUE : IN NATURAL) RETURN RETURN_TYPE IS

    BEGIN -- NAME

        IF (VALUE = POSITION) THEN

          WHEN_ELAB := NATURAL'SUCC (WHEN_ELAB) ;

          ORDER_LIST (INDEX (POSITION)) := WHEN_ELAB ;

          RETURN RETURN_VALUE ;

        ELSIF (VALUE = (POSITION + OFFSET)) THEN

          WHEN_ELAB := NATURAL'SUCC (WHEN_ELAB) ;

          ORDER_LIST (INDEX (POSITION + OFFSET)) := WHEN_ELAB ;

          RETURN RETURN_VALUE ;

        END IF ;

    END NAME ;

    GENERIC

        TYPE FIRST_TYPE IS PRIVATE ;

        WITH FUNCTION FIRST (POSITION : IN NATURAL)

                            RETURN FIRST_TYPE ;

        FIRST_VALUE : IN NATURAL ;

        TYPE SECOND_TYPE IS PRIVATE ;

        WITH FUNCTION SECOND (POSITION : IN NATURAL)

                            RETURN SECOND_TYPE ;

        SECOND_VALUE : IN NATURAL ;

        TYPE THIRD_TYPE IS PRIVATE ;

        WITH FUNCTION THIRD (POSITION : IN NATURAL)

                            RETURN THIRD_TYPE ;

        THIRD_VALUE : IN NATURAL ;

        TYPE FOURTH_TYPE IS PRIVATE ;

        WITH FUNCTION FOURTH (POSITION : IN NATURAL)

                            RETURN FOURTH_TYPE ;

        FOURTH_VALUE : IN NATURAL ;

        TYPE FIFTH_TYPE IS PRIVATE ;

        WITH FUNCTION FIFTH (POSITION : IN NATURAL)

                            RETURN FIFTH_TYPE ;

        FIFTH_VALUE : IN NATURAL ;

        TYPE SIXTH_TYPE IS PRIVATE ;

        WITH FUNCTION SIXTH (POSITION : IN NATURAL)

                            RETURN SIXTH_TYPE ;

        SIXTH_VALUE : IN NATURAL ;

        TYPE SEVENTH_TYPE IS PRIVATE ;

        WITH FUNCTION SEVENTH (POSITION : IN NATURAL)

                            RETURN SEVENTH_TYPE ;

        SEVENTH_VALUE : IN NATURAL ;

        TYPE EIGHTH_TYPE IS PRIVATE ;

        WITH FUNCTION EIGHTH (POSITION : IN NATURAL)

                            RETURN EIGHTH_TYPE ;

        EIGHTH_VALUE : IN NATURAL ;

        TYPE NINTH_TYPE IS PRIVATE ;

        WITH FUNCTION NINTH (POSITION : IN NATURAL)

                            RETURN NINTH_TYPE ;

        NINTH_VALUE : IN NATURAL ;

        TYPE TENTH_TYPE IS PRIVATE ;

        WITH FUNCTION TENTH (POSITION : IN NATURAL)

                            RETURN TENTH_TYPE ;

        TENTH_VALUE : IN NATURAL ;

        TYPE ELEVENTH_TYPE IS PRIVATE ;

        WITH FUNCTION ELEVENTH (POSITION : IN NATURAL)

                            RETURN ELEVENTH_TYPE ;

        ELEVENTH_VALUE : IN NATURAL ;

        TYPE TWELFTH_TYPE IS PRIVATE ;

        WITH FUNCTION TWELFTH (POSITION : IN NATURAL)

                            RETURN TWELFTH_TYPE ;

        TWELFTH_VALUE : IN NATURAL ;

        TYPE THIRTEENTH_TYPE IS PRIVATE ;

        WITH FUNCTION THIRTEENTH (POSITION : IN NATURAL)

                            RETURN THIRTEENTH_TYPE ;

        THIRTEENTH_VALUE : IN NATURAL ;

        TYPE FOURTEENTH_TYPE IS PRIVATE ;

        WITH FUNCTION FOURTEENTH (POSITION : IN NATURAL)

                            RETURN FOURTEENTH_TYPE ;

        FOURTEENTH_VALUE : IN NATURAL ;

        TYPE FIFTEENTH_TYPE IS PRIVATE ;

        WITH FUNCTION FIFTEENTH (POSITION : IN NATURAL)

                            RETURN FIFTEENTH_TYPE ;

        FIFTEENTH_VALUE : IN NATURAL ;

        TYPE SIXTEENTH_TYPE IS PRIVATE ;

        WITH FUNCTION SIXTEENTH (POSITION : IN NATURAL)

                            RETURN SIXTEENTH_TYPE ;

        SIXTEENTH_VALUE : IN NATURAL ;

    PACKAGE ORDER_PACKAGE IS

        A : FIRST_TYPE      := FIRST (FIRST_VALUE) ;

        B : SECOND_TYPE     := SECOND (SECOND_VALUE) ;

        C : THIRD_TYPE      := THIRD (THIRD_VALUE) ;

        D : FOURTH_TYPE     := FOURTH (FOURTH_VALUE) ;

        E : FIFTH_TYPE      := FIFTH (FIFTH_VALUE) ;

        F : SIXTH_TYPE      := SIXTH (SIXTH_VALUE) ;

        G : SEVENTH_TYPE    := SEVENTH (SEVENTH_VALUE) ;

        H : EIGHTH_TYPE     := EIGHTH (EIGHTH_VALUE) ;

        I : NINTH_TYPE      := NINTH (NINTH_VALUE) ;

        J : TENTH_TYPE      := TENTH (TENTH_VALUE) ;

        K : ELEVENTH_TYPE   := ELEVENTH (ELEVENTH_VALUE) ;

        L : TWELFTH_TYPE    := TWELFTH (TWELFTH_VALUE) ;

        M : THIRTEENTH_TYPE := THIRTEENTH (THIRTEENTH_VALUE) ;

        N : FOURTEENTH_TYPE := FOURTEENTH (FOURTEENTH_VALUE) ;

        O : FIFTEENTH_TYPE  := FIFTEENTH (FIFTEENTH_VALUE) ;

        P : SIXTEENTH_TYPE  := SIXTEENTH (SIXTEENTH_VALUE) ;

    END ORDER_PACKAGE ;

    FUNCTION BOOL IS NEW NAME (RETURN_TYPE  => BOOLEAN,

                               RETURN_VALUE => TRUE_VALUE,

                               POSITION     => 1,

                               OFFSET       => 8,

                               WHEN_ELAB    => WHEN_ELABORATED,

                               INDEX        => LIST_INDEX,

                               LIST         => LIST,

                               ORDER_LIST   => ORDER_LIST) ;

    FUNCTION INT IS NEW NAME (RETURN_TYPE   => YEAR_TYPE,

                              RETURN_VALUE  => THIS_YEAR,

                              POSITION      => 2,

                              OFFSET        => 8,

                              WHEN_ELAB     => WHEN_ELABORATED,

                              INDEX         => LIST_INDEX,

                              LIST          => LIST,

                              ORDER_LIST    => ORDER_LIST) ;

    FUNCTION FLOAT IS NEW NAME (RETURN_TYPE  => REAL,

                                RETURN_VALUE => REAL_VALUE,

                                POSITION     => 3,

                                OFFSET       => 8,

                                WHEN_ELAB    => WHEN_ELABORATED,

                                INDEX        => LIST_INDEX,

                                LIST         => LIST,

                                ORDER_LIST   => ORDER_LIST) ;

    FUNCTION CHAR IS NEW NAME (RETURN_TYPE  => CHARACTER,

                               RETURN_VALUE => CHARACTER_VALUE,

                               POSITION     => 4,

                               OFFSET       => 8,

                               WHEN_ELAB    => WHEN_ELABORATED,

                               INDEX        => LIST_INDEX,

                               LIST         => LIST,

                               ORDER_LIST   => ORDER_LIST) ;

    FUNCTION ENUM IS NEW NAME (RETURN_TYPE  => MONTH_TYPE,

                               RETURN_VALUE => THIS_MONTH,

                               POSITION     => 5,

                               OFFSET       => 8,

                               WHEN_ELAB    => WHEN_ELABORATED,

                               INDEX        => LIST_INDEX,

                               LIST         => LIST,

                               ORDER_LIST   => ORDER_LIST) ;

    FUNCTION ARRY IS NEW NAME (RETURN_TYPE  => DUE_DATES,

                               RETURN_VALUE => REPORT_DATES,

                               POSITION     => 6,

                               OFFSET       => 8,

                               WHEN_ELAB    => WHEN_ELABORATED,

                               INDEX        => LIST_INDEX,

                               LIST         => LIST,

                               ORDER_LIST   => ORDER_LIST) ;

    FUNCTION RCRD IS NEW NAME (RETURN_TYPE  => DATE,

                               RETURN_VALUE => TODAY,

                               POSITION     => 7,

                               OFFSET       => 8,

                               WHEN_ELAB    => WHEN_ELABORATED,

                               INDEX        => LIST_INDEX,

                               LIST         => LIST,

                               ORDER_LIST   => ORDER_LIST) ;

    FUNCTION ACSS IS NEW NAME (RETURN_TYPE  => DATE_ACCESS,

                               RETURN_VALUE => FIRST_DATE,

                               POSITION     => 8,

                               OFFSET       => 8,

                               WHEN_ELAB    => WHEN_ELABORATED,

                               INDEX        => LIST_INDEX,

                               LIST         => LIST,

                               ORDER_LIST   => ORDER_LIST) ;

    PACKAGE ELABORATION_ORDER IS NEW ORDER_PACKAGE

        (FIRST_TYPE            => BOOLEAN,

         FIRST                 => BOOL,

         FIRST_VALUE           => 1,

         THIRD_TYPE            => REAL,

         THIRD                 => FLOAT,

         THIRD_VALUE           => 3,

         SECOND_TYPE           => YEAR_TYPE,    -- ORDERING OF PARAMETERS

         SECOND                => INT,          -- IS DELIBERATE. 

         SECOND_VALUE          => 2,

         FOURTH_TYPE           => CHARACTER,

         FOURTH                => CHAR,

         FOURTH_VALUE          => 4,

         FIFTH_TYPE            => MONTH_TYPE,

         FIFTH                 => ENUM,

         FIFTH_VALUE           => 5,

         SIXTH_TYPE            => DUE_DATES,

         SIXTH                 => ARRY,

         SIXTH_VALUE           => 6,

         SEVENTH_TYPE          => DATE,

         SEVENTH               => RCRD,

         SEVENTH_VALUE         => 7,

         EIGHTH_TYPE           => DATE_ACCESS,

         EIGHTH                => ACSS,

         EIGHTH_VALUE          => 8,

         NINTH_TYPE            => BOOLEAN,

         NINTH                 => BOOL,

         NINTH_VALUE           => 9,

         TENTH_TYPE            => YEAR_TYPE,

         TENTH                 => INT,

         TENTH_VALUE           => 10,

         ELEVENTH_TYPE         => REAL,

         ELEVENTH              => FLOAT,

         ELEVENTH_VALUE        => 11,

         TWELFTH_TYPE          => CHARACTER,

         TWELFTH               => CHAR,

         TWELFTH_VALUE         => 12,

         THIRTEENTH_TYPE       => MONTH_TYPE,

         THIRTEENTH            => ENUM,

         THIRTEENTH_VALUE      => 13,

         FOURTEENTH_TYPE       => DUE_DATES,

         FOURTEENTH            => ARRY,

         FOURTEENTH_VALUE      => 14,

         FIFTEENTH_TYPE        => DATE,

         FIFTEENTH             => RCRD,

         FIFTEENTH_VALUE       => 15,

         SIXTEENTH_TYPE        => DATE_ACCESS,

         SIXTEENTH             => ACSS,

         SIXTEENTH_VALUE       => 16) ;

BEGIN

     REPORT.TEST("CC3016B", "CHECK THAT AN INSTANCE OF A GENERIC " &

                 "PACKAGE MUST DECLARE A PACKAGE. CHECK THAT THE " &

                 "DECLARATIVE ITEMS IN AN INSTANTIATION OF A GENERIC " &

                 "PACKAGE SPECIFICATION ARE ELABORATED IN THE ORDER " &

                 "DECLARED.");

     IF ORDER_LIST(1) /= REPORT.IDENT_INT(1) THEN

          REPORT.FAILED("BOOLEAN 1 ELABORATED OUT OF ORDER");

     END IF;

     IF ORDER_LIST(2) /= REPORT.IDENT_INT(2) THEN

          REPORT.FAILED("INTEGER TYPE 1 ELABORATED OUT OF ORDER");

     END IF;

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

          REPORT.FAILED("REAL 1 ELABORATED OUT OF ORDER");

     END IF;

     IF ORDER_LIST(4) /= REPORT.IDENT_INT(4) THEN

          REPORT.FAILED("CHARACTER 1 ELABORATED OUT OF ORDER");

     END IF;

     IF ORDER_LIST(5) /= REPORT.IDENT_INT(5) THEN

          REPORT.FAILED("ENUMERATION 1 ELABORATED OUT OF ORDER");

     END IF;

     IF ORDER_LIST(6) /= REPORT.IDENT_INT(6) THEN

          REPORT.FAILED("ARRAY 1 ELABORATED OUT OF ORDER");

     END IF;

     IF ORDER_LIST(7) /= REPORT.IDENT_INT(7) THEN

          REPORT.FAILED("RECORD 1 ELABORATED OUT OF ORDER");

     END IF;

     IF ORDER_LIST(8) /= REPORT.IDENT_INT(8) THEN

          REPORT.FAILED("ACCESS 1 ELABORATED OUT OF ORDER");

     END IF;

     IF ORDER_LIST(9) /= REPORT.IDENT_INT(9) THEN

          REPORT.FAILED("BOOLEAN 2 ELABORATED OUT OF ORDER");

     END IF;

     IF ORDER_LIST(10) /= REPORT.IDENT_INT(10) THEN

          REPORT.FAILED("INTEGER TYPE 2 ELABORATED OUT OF ORDER");

     END IF;

     IF ORDER_LIST(11) /= REPORT.IDENT_INT(11) THEN

          REPORT.FAILED("REAL 2 ELABORATED OUT OF ORDER");

     END IF;

     IF ORDER_LIST(12) /= REPORT.IDENT_INT(12) THEN

          REPORT.FAILED("CHARACTER 2 ELABORATED OUT OF ORDER");

     END IF;

     IF ORDER_LIST(13) /= REPORT.IDENT_INT(13) THEN

          REPORT.FAILED("ENUMERATION 2 ELABORATED OUT OF ORDER");

     END IF;

     IF ORDER_LIST(14) /= REPORT.IDENT_INT(14) THEN

          REPORT.FAILED("ARRAY 2 ELABORATED OUT OF ORDER");

     END IF;

     IF ORDER_LIST(15) /= REPORT.IDENT_INT(15) THEN

          REPORT.FAILED("RECORD 2 ELABORATED OUT OF ORDER");

     END IF;

     IF ORDER_LIST(16) /= REPORT.IDENT_INT(16) THEN

          REPORT.FAILED("ACCESS 2 ELABORATED OUT OF ORDER");

     END IF;

     REPORT.RESULT ;

END CC3016B;