URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cc/] [cc3016b.ada] - Rev 816
Compare with Previous | Blame | View Log
-- 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;