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/cc3007b.ada | 397 +++++++++++++++++++++++++++ 1 file changed, 397 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/cc/cc3007b.ada (limited to 'gcc/testsuite/ada/acats/tests/cc/cc3007b.ada') diff --git a/gcc/testsuite/ada/acats/tests/cc/cc3007b.ada b/gcc/testsuite/ada/acats/tests/cc/cc3007b.ada new file mode 100644 index 000000000..22bd4c0a3 --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/cc/cc3007b.ada @@ -0,0 +1,397 @@ +-- CC3007B.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 NAMES IN A GENERIC INSTANTIATION ARE STATICALLY +-- IDENTIFIED (I.E., BOUND) AT THE TEXTUAL POINT OF THE INSTANTIA- +-- TION, AND ARE BOUND BEFORE BEING "SUBSTITUTED" FOR THE COR- +-- RESPONDING GENERIC FORMAL PARAMETERS IN THE SPECIFICATION AND +-- BODY TEMPLATES. +-- +-- SEE AI-00365/05-BI-WJ. + +-- HISTORY: +-- EDWARD V. BERARD, 15 AUGUST 1990 +-- DAS 08 OCT 90 CHANGED INSTANTIATIONS TO USE VARIABLES +-- M1 AND M2 IN THE FIRST_BLOCK INSTANTIA- +-- TION AND TO ASSIGN THIRD_DATE AND +-- FOURTH_DATE VALUES BEFORE AND AFTER THE +-- SECOND_BLOCK INSTANTIATION. + +WITH REPORT; + +PROCEDURE CC3007B IS + + INCREMENTED_VALUE : NATURAL := 0; + + 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; + + TODAY : DATE := (MONTH => AUG, + DAY => 8, + YEAR => 1990); + + CHRISTMAS : DATE := (MONTH => DEC, + DAY => 25, + YEAR => 1948); + + WALL_DATE : DATE := (MONTH => NOV, + DAY => 9, + YEAR => 1989); + + BIRTH_DATE : DATE := (MONTH => OCT, + DAY => 3, + YEAR => 1949); + + FIRST_DUE_DATE : DATE := (MONTH => JAN, + DAY => 23, + YEAR => 1990); + + LAST_DUE_DATE : DATE := (MONTH => DEC, + DAY => 20, + YEAR => 1990); + + THIS_MONTH : MONTH_TYPE := AUG; + + STORED_RECORD : DATE := TODAY; + + STORED_INDEX : MONTH_TYPE := AUG; + + FIRST_DATE : DATE_ACCESS := NEW DATE'(WALL_DATE); + SECOND_DATE : DATE_ACCESS := FIRST_DATE; + + THIRD_DATE : DATE_ACCESS := NEW DATE'(BIRTH_DATE); + FOURTH_DATE : DATE_ACCESS := NEW DATE'(CHRISTMAS); + + 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)); + + GENERIC + + NATURALLY : IN NATURAL; + FIRST_RECORD : IN OUT DATE; + SECOND_RECORD : IN OUT DATE; + TYPE RECORD_POINTER IS ACCESS DATE; + POINTER : IN OUT RECORD_POINTER; + TYPE ARRAY_TYPE IS ARRAY (MONTH_TYPE) OF DATE; + THIS_ARRAY : IN OUT ARRAY_TYPE; + FIRST_ARRAY_ELEMENT : IN OUT DATE; + SECOND_ARRAY_ELEMENT : IN OUT DATE; + INDEX_ELEMENT : IN OUT MONTH_TYPE; + POINTER_TEST : IN OUT DATE; + ANOTHER_POINTER_TEST : IN OUT DATE; + + PACKAGE TEST_ACTUAL_PARAMETERS IS + + PROCEDURE EVALUATE_FUNCTION; + PROCEDURE CHECK_RECORDS; + PROCEDURE CHECK_ACCESS; + PROCEDURE CHECK_ARRAY; + PROCEDURE CHECK_ARRAY_ELEMENTS; + PROCEDURE CHECK_SCALAR; + PROCEDURE CHECK_POINTERS; + + END TEST_ACTUAL_PARAMETERS; + + PACKAGE BODY TEST_ACTUAL_PARAMETERS IS + + PROCEDURE EVALUATE_FUNCTION IS + BEGIN -- EVALUATE_FUNCTION + + IF (INCREMENTED_VALUE = 0) OR + (NATURALLY /= INCREMENTED_VALUE) THEN + REPORT.FAILED ("PROBLEMS EVALUATING FUNCTION " & + "PARAMETER."); + END IF; + + END EVALUATE_FUNCTION; + + PROCEDURE CHECK_RECORDS IS + + STORE : DATE; + + BEGIN -- CHECK_RECORDS + + IF STORED_RECORD /= FIRST_RECORD THEN + REPORT.FAILED ("PROBLEM WITH RECORD TYPES"); + ELSE + STORED_RECORD := SECOND_RECORD; + STORE := FIRST_RECORD; + FIRST_RECORD := SECOND_RECORD; + SECOND_RECORD := STORE; + END IF; + + END CHECK_RECORDS; + + PROCEDURE CHECK_ACCESS IS + BEGIN -- CHECK_ACCESS + + IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE + THEN + IF POINTER.ALL /= DATE'(WALL_DATE) THEN + REPORT.FAILED ("PROBLEM WITH ACCESS TYPES " & + "- 1"); + ELSE + POINTER.ALL := DATE'(BIRTH_DATE); + END IF; + ELSE + IF POINTER.ALL /= DATE'(BIRTH_DATE) THEN + REPORT.FAILED ("PROBLEM WITH ACCESS TYPES " & + "- 2"); + ELSE + POINTER.ALL := DATE'(WALL_DATE); + END IF; + END IF; + + END CHECK_ACCESS; + + PROCEDURE CHECK_ARRAY IS + + STORE : DATE; + + BEGIN -- CHECK_ARRAY + + IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE + THEN + IF THIS_ARRAY (THIS_ARRAY'FIRST) /= FIRST_DUE_DATE + THEN + REPORT.FAILED ("PROBLEM WITH ARRAY TYPES - 1"); + ELSE + THIS_ARRAY (THIS_ARRAY'FIRST) := LAST_DUE_DATE; + THIS_ARRAY (THIS_ARRAY'LAST) := FIRST_DUE_DATE; + END IF; + ELSE + IF THIS_ARRAY (THIS_ARRAY'FIRST) /= LAST_DUE_DATE + THEN + REPORT.FAILED ("PROBLEM WITH ARRAY TYPES - 2"); + ELSE + THIS_ARRAY (THIS_ARRAY'FIRST) := + FIRST_DUE_DATE; + THIS_ARRAY (THIS_ARRAY'LAST) := LAST_DUE_DATE; + END IF; + END IF; + + END CHECK_ARRAY; + + PROCEDURE CHECK_ARRAY_ELEMENTS IS + + STORE : DATE; + + BEGIN -- CHECK_ARRAY_ELEMENTS + + IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE + THEN + IF (FIRST_ARRAY_ELEMENT.MONTH /= MAY) OR + (SECOND_ARRAY_ELEMENT.DAY /= 22) THEN + REPORT.FAILED ("PROBLEM WITH ARRAY ELEMENTS " & + "- 1"); + ELSE + STORE := FIRST_ARRAY_ELEMENT; + FIRST_ARRAY_ELEMENT := SECOND_ARRAY_ELEMENT; + SECOND_ARRAY_ELEMENT := STORE; + END IF; + ELSE + IF (FIRST_ARRAY_ELEMENT.MONTH /= JUN) OR + (SECOND_ARRAY_ELEMENT.DAY /= 23) THEN + REPORT.FAILED ("PROBLEM WITH ARRAY ELEMENTS " & + "- 2"); + ELSE + STORE := FIRST_ARRAY_ELEMENT; + FIRST_ARRAY_ELEMENT := SECOND_ARRAY_ELEMENT; + SECOND_ARRAY_ELEMENT := STORE; + END IF; + END IF; + + END CHECK_ARRAY_ELEMENTS; + + PROCEDURE CHECK_SCALAR IS + BEGIN -- CHECK_SCALAR + + IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE + THEN + IF INDEX_ELEMENT /= STORED_INDEX THEN + REPORT.FAILED ("PROBLEM WITH INDEX TYPES - 1"); + ELSE + INDEX_ELEMENT := + MONTH_TYPE'SUCC(INDEX_ELEMENT); + STORED_INDEX := INDEX_ELEMENT; + END IF; + ELSE + IF INDEX_ELEMENT /= STORED_INDEX THEN + REPORT.FAILED ("PROBLEM WITH INDEX TYPES - 2"); + ELSE + INDEX_ELEMENT := + MONTH_TYPE'PRED (INDEX_ELEMENT); + STORED_INDEX := INDEX_ELEMENT; + END IF; + END IF; + + END CHECK_SCALAR; + + PROCEDURE CHECK_POINTERS IS + + STORE : DATE; + + BEGIN -- CHECK_POINTERS + + IF ((INCREMENTED_VALUE / 2) * 2) /= INCREMENTED_VALUE + THEN + IF (POINTER_TEST /= DATE'(OCT, 3, 1949)) OR + (ANOTHER_POINTER_TEST /= DATE'(DEC, 25, 1948)) + THEN + REPORT.FAILED ("PROBLEM WITH POINTER TEST " & + "- 1"); + ELSE + STORE := POINTER_TEST; + POINTER_TEST := ANOTHER_POINTER_TEST; + ANOTHER_POINTER_TEST := STORE; + END IF; + ELSE + IF (POINTER_TEST /= DATE'(DEC, 25, 1948)) OR + (ANOTHER_POINTER_TEST /= DATE'(OCT, 3, 1949)) + THEN + REPORT.FAILED ("PROBLEM WITH POINTER TEST " & + "- 2"); + ELSE + STORE := POINTER_TEST; + POINTER_TEST := ANOTHER_POINTER_TEST; + ANOTHER_POINTER_TEST := STORE; + END IF; + END IF; + + END CHECK_POINTERS; + + END TEST_ACTUAL_PARAMETERS; + + FUNCTION INC RETURN NATURAL IS + BEGIN -- INC + INCREMENTED_VALUE := NATURAL'SUCC (INCREMENTED_VALUE); + RETURN INCREMENTED_VALUE; + END INC; + +BEGIN -- CC3007B + + REPORT.TEST ("CC3007B", "CHECK THAT THE NAMES IN A GENERIC " & + "INSTANTIATION ARE STAICALLY IDENTIFIED (I.E., " & + "BOUND) AT THE TEXTUAL POINT OF THE INSTANTIATION" & + ", AND ARE BOUND BEFORE BEING SUBSTITUTED FOR " & + "THE CORRESPONDING GENERIC FORMAL PARAMETERS IN " & + "THE SPECIFICATION AND BODY TEMPLATES. " & + "SEE AI-00365/05-BI-WJ."); + + FIRST_BLOCK: + + DECLARE + + M1 : MONTH_TYPE := MAY; + M2 : MONTH_TYPE := JUN; + + PACKAGE NEW_TEST_ACTUAL_PARAMETERS IS + NEW TEST_ACTUAL_PARAMETERS ( + NATURALLY => INC, + FIRST_RECORD => TODAY, + SECOND_RECORD => CHRISTMAS, + RECORD_POINTER => DATE_ACCESS, + POINTER => SECOND_DATE, + ARRAY_TYPE => DUE_DATES, + THIS_ARRAY => REPORT_DATES, + FIRST_ARRAY_ELEMENT => REPORT_DATES (M1), + SECOND_ARRAY_ELEMENT => REPORT_DATES (M2), + INDEX_ELEMENT => THIS_MONTH, + POINTER_TEST => THIRD_DATE.ALL, + ANOTHER_POINTER_TEST => FOURTH_DATE.ALL); + + BEGIN -- FIRST_BLOCK + + REPORT.COMMENT ("ENTERING FIRST BLOCK"); + NEW_TEST_ACTUAL_PARAMETERS.EVALUATE_FUNCTION; + NEW_TEST_ACTUAL_PARAMETERS.CHECK_SCALAR; + M1 := SEP; + M2 := OCT; + -- NEW_TEST_ACTUAL_PARAMETERS SHOULD USE THE PREVIOUS + -- VALUES OF MAY AND JUN. + NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY; + NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY_ELEMENTS; + NEW_TEST_ACTUAL_PARAMETERS.CHECK_ACCESS; + NEW_TEST_ACTUAL_PARAMETERS.CHECK_RECORDS; + NEW_TEST_ACTUAL_PARAMETERS.CHECK_POINTERS; + + END FIRST_BLOCK; + + SECOND_BLOCK: + + DECLARE + + SAVE_THIRD_DATE : DATE_ACCESS := THIRD_DATE; + SAVE_FOURTH_DATE : DATE_ACCESS := FOURTH_DATE; + + PACKAGE NEW_TEST_ACTUAL_PARAMETERS IS + NEW TEST_ACTUAL_PARAMETERS ( + NATURALLY => INC, + FIRST_RECORD => TODAY, + SECOND_RECORD => CHRISTMAS, + RECORD_POINTER => DATE_ACCESS, + POINTER => SECOND_DATE, + ARRAY_TYPE => DUE_DATES, + THIS_ARRAY => REPORT_DATES, + FIRST_ARRAY_ELEMENT => REPORT_DATES (MAY), + SECOND_ARRAY_ELEMENT => REPORT_DATES (JUN), + INDEX_ELEMENT => THIS_MONTH, + POINTER_TEST => THIRD_DATE.ALL, + ANOTHER_POINTER_TEST => FOURTH_DATE.ALL); + + BEGIN -- SECOND_BLOCK + + REPORT.COMMENT ("ENTERING SECOND BLOCK"); + NEW_TEST_ACTUAL_PARAMETERS.EVALUATE_FUNCTION; + NEW_TEST_ACTUAL_PARAMETERS.CHECK_SCALAR; + NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY; + NEW_TEST_ACTUAL_PARAMETERS.CHECK_ARRAY_ELEMENTS; + NEW_TEST_ACTUAL_PARAMETERS.CHECK_ACCESS; + NEW_TEST_ACTUAL_PARAMETERS.CHECK_RECORDS; + + THIRD_DATE := NEW DATE'(JUL, 13, 1951); + FOURTH_DATE := NEW DATE'(JUL, 4, 1976); + NEW_TEST_ACTUAL_PARAMETERS.CHECK_POINTERS; + THIRD_DATE := SAVE_THIRD_DATE; + FOURTH_DATE := SAVE_FOURTH_DATE; + + END SECOND_BLOCK; + + REPORT.RESULT; + +END CC3007B; -- cgit v1.2.3