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/] [cc3016c.ada] - Rev 867
Go to most recent revision | Compare with Previous | Blame | View Log
-- CC3016C.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 STATEMENTS IN AN INSTANTIATED GENERIC -- PACKAGE BODY ARE EXECUTED AFTER THE ELABORATION OF THE -- DECLARATIONS (IN SPEC AND IN BODY). -- HISTORY: -- EDWARD V. BERARD, 8 AUGUST 1990 WITH REPORT; PROCEDURE CC3016C IS GENERIC TYPE SOME_TYPE IS PRIVATE ; FIRST_INITIAL_VALUE : IN SOME_TYPE ; SECOND_INITIAL_VALUE : IN SOME_TYPE ; WITH PROCEDURE CHANGE (FIRST : IN SOME_TYPE ; RESULT : OUT SOME_TYPE) ; WITH PROCEDURE SECOND_CHANGE (FIRST : IN SOME_TYPE ; RESULT : OUT SOME_TYPE) ; WITH PROCEDURE THIRD_CHANGE (FIRST : IN SOME_TYPE ; RESULT : OUT SOME_TYPE) ; FIRST_EXPECTED_RESULT : IN SOME_TYPE ; SECOND_EXPECTED_RESULT : IN SOME_TYPE ; THIRD_EXPECTED_RESULT : IN SOME_TYPE ; FOURTH_EXPECTED_RESULT : IN SOME_TYPE ; FIFTH_EXPECTED_RESULT : IN SOME_TYPE ; SIXTH_EXPECTED_RESULT : IN SOME_TYPE ; PACKAGE OUTER IS VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ; FUNCTION INNER_VARIABLE RETURN SOME_TYPE ; GENERIC INITIAL_VALUE : IN SOME_TYPE ; WITH PROCEDURE CHANGE (FIRST : IN SOME_TYPE ; RESULT : OUT SOME_TYPE) ; WITH PROCEDURE SECOND_CHANGE (FIRST : IN SOME_TYPE ; RESULT : OUT SOME_TYPE) ; FIRST_EXPECTED_RESULT : IN SOME_TYPE ; SECOND_EXPECTED_RESULT : IN SOME_TYPE ; THIRD_EXPECTED_RESULT : IN SOME_TYPE ; FOURTH_EXPECTED_RESULT : IN SOME_TYPE ; PACKAGE INNER IS VARIABLE : SOME_TYPE := INITIAL_VALUE ; END INNER ; END OUTER ; PACKAGE BODY OUTER IS ANOTHER_VARIABLE : SOME_TYPE := FIRST_INITIAL_VALUE ; PACKAGE BODY INNER IS ANOTHER_VARIABLE : SOME_TYPE := INITIAL_VALUE ; BEGIN -- INNER CHANGE (FIRST => VARIABLE, RESULT => VARIABLE) ; CHANGE (FIRST => ANOTHER_VARIABLE, RESULT => ANOTHER_VARIABLE) ; OUTER.SECOND_CHANGE (FIRST => OUTER.VARIABLE, RESULT => OUTER.VARIABLE) ; OUTER.CHANGE (FIRST => OUTER.ANOTHER_VARIABLE, RESULT => OUTER.ANOTHER_VARIABLE) ; IF (VARIABLE /= FIRST_EXPECTED_RESULT) OR (ANOTHER_VARIABLE /= SECOND_EXPECTED_RESULT) OR (OUTER.VARIABLE /= THIRD_EXPECTED_RESULT) OR (OUTER.ANOTHER_VARIABLE /= FOURTH_EXPECTED_RESULT) THEN REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF INNER") ; END IF; END INNER ; PACKAGE NEW_INNER IS NEW INNER (INITIAL_VALUE => SECOND_INITIAL_VALUE, CHANGE => CHANGE, SECOND_CHANGE => THIRD_CHANGE, FIRST_EXPECTED_RESULT => FIRST_EXPECTED_RESULT, SECOND_EXPECTED_RESULT => SECOND_EXPECTED_RESULT, THIRD_EXPECTED_RESULT => THIRD_EXPECTED_RESULT, FOURTH_EXPECTED_RESULT => FOURTH_EXPECTED_RESULT) ; FUNCTION INNER_VARIABLE RETURN SOME_TYPE IS BEGIN RETURN NEW_INNER.VARIABLE ; END INNER_VARIABLE ; BEGIN -- OUTER SECOND_CHANGE (FIRST => VARIABLE, RESULT => VARIABLE) ; SECOND_CHANGE (FIRST => ANOTHER_VARIABLE, RESULT => ANOTHER_VARIABLE) ; IF (VARIABLE /= FIFTH_EXPECTED_RESULT) OR (ANOTHER_VARIABLE /= SIXTH_EXPECTED_RESULT) OR (NEW_INNER.VARIABLE /= FIRST_EXPECTED_RESULT) THEN REPORT.FAILED("ASSIGNED VALUES INCORRECT - BODY OF OUTER") ; END IF; END OUTER ; PROCEDURE DOUBLE (THIS_VALUE : IN INTEGER; GIVING_THIS_RESULT : OUT INTEGER) IS BEGIN -- DOUBLE GIVING_THIS_RESULT := 2 * THIS_VALUE ; END DOUBLE ; PROCEDURE ADD_20 (TO_THIS_VALUE : IN INTEGER; GIVING_THIS_RESULT : OUT INTEGER) IS BEGIN -- ADD_20 GIVING_THIS_RESULT := TO_THIS_VALUE + 20 ; END ADD_20 ; PROCEDURE TIMES_FIVE (THIS_VALUE : IN INTEGER; GIVING_THIS_RESULT : OUT INTEGER) IS BEGIN -- TIMES_FIVE GIVING_THIS_RESULT := 5 * THIS_VALUE ; END TIMES_FIVE ; BEGIN -- CC3016C REPORT.TEST ("CC3016C" , "CHECK THAT AN INSTANCE OF A GENERIC PACKAGE " & "MUST DECLARE A PACKAGE. CHECK THAT THE STATEMENTS IN AN " & "INSTANTIATED GENERIC PACKAGE BODY ARE EXECUTED AFTER THE " & "ELABORATION OF THE DECLARATIONS (IN SPEC AND IN BODY).") ; LOCAL_BLOCK: DECLARE PACKAGE NEW_OUTER IS NEW OUTER (SOME_TYPE => INTEGER, FIRST_INITIAL_VALUE => 7, SECOND_INITIAL_VALUE => 11, CHANGE => DOUBLE, SECOND_CHANGE => ADD_20, THIRD_CHANGE => TIMES_FIVE, FIRST_EXPECTED_RESULT => 22, SECOND_EXPECTED_RESULT => 22, THIRD_EXPECTED_RESULT => 27, FOURTH_EXPECTED_RESULT => 14, FIFTH_EXPECTED_RESULT => 47, SIXTH_EXPECTED_RESULT => 34) ; BEGIN -- LOCAL_BLOCK IF (NEW_OUTER.VARIABLE /= 47) OR (NEW_OUTER.INNER_VARIABLE /= 22) THEN REPORT.FAILED("ASSIGNED VALUES INCORRECT - " & "BODY OF MAIN PROGRAM") ; END IF; END LOCAL_BLOCK ; REPORT.RESULT; END CC3016C;
Go to most recent revision | Compare with Previous | Blame | View Log