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/] [cc3007b.ada] - Rev 816
Compare with Previous | Blame | View Log
-- 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;