From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/ada/acats/tests/cc/cc3016b.ada | 396 +++++++++++++++++++++++++++ 1 file changed, 396 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/cc/cc3016b.ada (limited to 'gcc/testsuite/ada/acats/tests/cc/cc3016b.ada') diff --git a/gcc/testsuite/ada/acats/tests/cc/cc3016b.ada b/gcc/testsuite/ada/acats/tests/cc/cc3016b.ada new file mode 100644 index 000000000..2fbc09062 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cc/cc3016b.ada @@ -0,0 +1,396 @@ +-- 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; -- cgit v1.2.3