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;