| -- CC3019B2M.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 INSTANTIATIONS OF UNITS WITHIN GENERIC UNITS, E.G., |
| -- TO SUPPORT ITERATORS. THIS TEST SPECIFICALLY CHECKS THAT A |
| -- NESTING LEVEL OF 2 IS SUPPORTED FOR GENERICS. |
| -- |
| -- *** THIS IS THE MAIN PROGRAM. IT MUST BE COMPILED AFTER THE |
| -- *** SOURCE CODE IN FILES CC3019B0.ADA AND CC3019B1.ADA HAVE |
| -- *** BEEN COMPILED. |
| -- |
| -- HISTORY: |
| -- EDWARD V. BERARD, 31 AUGUST 1990 |
| |
| WITH REPORT ; |
| WITH CC3019B1_STACK_CLASS ; |
| |
| PROCEDURE CC3019B2M IS |
| |
| 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 ; |
| |
| STORE_DATE : DATE ; |
| |
| TODAY : DATE := (MONTH => AUG, |
| DAY => 31, |
| YEAR => 1990) ; |
| |
| FIRST_DATE : DATE := (MONTH => JUN, |
| DAY => 4, |
| YEAR => 1967) ; |
| |
| BIRTH_DATE : DATE := (MONTH => OCT, |
| DAY => 3, |
| YEAR => 1949) ; |
| |
| WALL_DATE : DATE := (MONTH => NOV, |
| DAY => 9, |
| YEAR => 1989) ; |
| |
| PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE : IN OUT DATE ; |
| TO_THIS_DATE : IN OUT DATE) ; |
| |
| FUNCTION IS_EQUAL (LEFT : IN DATE ; |
| RIGHT : IN DATE) RETURN BOOLEAN ; |
| |
| PACKAGE DATE_STACK IS |
| NEW CC3019B1_STACK_CLASS (ELEMENT => DATE, |
| ASSIGN => ASSIGN, |
| "=" => IS_EQUAL) ; |
| |
| FIRST_DATE_STACK : DATE_STACK.STACK ; |
| SECOND_DATE_STACK : DATE_STACK.STACK ; |
| THIRD_DATE_STACK : DATE_STACK.STACK ; |
| |
| FUNCTION "=" (LEFT : IN DATE_STACK.STACK ; |
| RIGHT : IN DATE_STACK.STACK) RETURN BOOLEAN |
| RENAMES DATE_STACK."=" ; |
| |
| PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE : IN OUT DATE ; |
| TO_THIS_DATE : IN OUT DATE) IS |
| |
| BEGIN -- ASSIGN |
| |
| TO_THIS_DATE := THE_VALUE_OF_THIS_DATE ; |
| |
| END ASSIGN ; |
| |
| FUNCTION IS_EQUAL (LEFT : IN DATE ; |
| RIGHT : IN DATE) RETURN BOOLEAN IS |
| |
| BEGIN -- IS_EQUAL |
| |
| RETURN (LEFT.MONTH = RIGHT.MONTH) AND |
| (LEFT.DAY = RIGHT.DAY) AND |
| (LEFT.YEAR = RIGHT.YEAR) ; |
| |
| END IS_EQUAL ; |
| |
| BEGIN -- CC3019B2M |
| |
| REPORT.TEST ("CC3019B2M", |
| "CHECK INSTANTIATIONS OF UNITS WITHIN GENERIC " & |
| "UNITS, E.G., TO SUPPORT ITERATORS. THIS TEST " & |
| "SPECIFICALLY CHECKS THAT A NESTING LEVEL OF " & |
| "2 IS SUPPORTED FOR GENERICS.") ; |
| |
| DATE_STACK.CLEAR (THIS_STACK => FIRST_DATE_STACK) ; |
| IF DATE_STACK.NUMBER_OF_ELEMENTS |
| (ON_THIS_STACK => FIRST_DATE_STACK) /= 0 THEN |
| REPORT.FAILED ( |
| "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 1") ; |
| END IF ; |
| |
| DATE_STACK.PUSH (THIS_ELEMENT => TODAY, |
| ON_TO_THIS_STACK => FIRST_DATE_STACK) ; |
| IF DATE_STACK.NUMBER_OF_ELEMENTS |
| (ON_THIS_STACK => FIRST_DATE_STACK) /= 1 THEN |
| REPORT.FAILED ( |
| "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 2") ; |
| END IF ; |
| |
| DATE_STACK.PUSH (THIS_ELEMENT => FIRST_DATE, |
| ON_TO_THIS_STACK => FIRST_DATE_STACK) ; |
| IF DATE_STACK.NUMBER_OF_ELEMENTS |
| (ON_THIS_STACK => FIRST_DATE_STACK) /= 2 THEN |
| REPORT.FAILED ( |
| "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 3") ; |
| END IF ; |
| |
| DATE_STACK.PUSH (THIS_ELEMENT => BIRTH_DATE, |
| ON_TO_THIS_STACK => FIRST_DATE_STACK) ; |
| IF DATE_STACK.NUMBER_OF_ELEMENTS |
| (ON_THIS_STACK => FIRST_DATE_STACK) /= 3 THEN |
| REPORT.FAILED ( |
| "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 4") ; |
| END IF ; |
| |
| DATE_STACK.POP (THIS_ELEMENT => STORE_DATE, |
| OFF_THIS_STACK => FIRST_DATE_STACK) ; |
| IF DATE_STACK.NUMBER_OF_ELEMENTS |
| (ON_THIS_STACK => FIRST_DATE_STACK) /= 2 THEN |
| REPORT.FAILED ( |
| "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 5") ; |
| END IF ; |
| |
| IF STORE_DATE /= BIRTH_DATE THEN |
| REPORT.FAILED ( |
| "IMPROPER VALUE REMOVED FROM STACK - 1") ; |
| END IF ; |
| |
| DATE_STACK.CLEAR (THIS_STACK => SECOND_DATE_STACK) ; |
| IF DATE_STACK.NUMBER_OF_ELEMENTS |
| (ON_THIS_STACK => SECOND_DATE_STACK) /= 0 THEN |
| REPORT.FAILED ( |
| "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 6") ; |
| END IF ; |
| |
| DATE_STACK.COPY (THIS_STACK => FIRST_DATE_STACK, |
| TO_THIS_STACK => SECOND_DATE_STACK) ; |
| |
| IF FIRST_DATE_STACK /= SECOND_DATE_STACK THEN |
| REPORT.FAILED ( |
| "PROBLEMS WITH COPY OR TEST FOR EQUALITY") ; |
| END IF ; |
| |
| DATE_STACK.POP (THIS_ELEMENT => STORE_DATE, |
| OFF_THIS_STACK => SECOND_DATE_STACK) ; |
| DATE_STACK.PUSH (THIS_ELEMENT => WALL_DATE, |
| ON_TO_THIS_STACK => SECOND_DATE_STACK) ; |
| IF FIRST_DATE_STACK = SECOND_DATE_STACK THEN |
| REPORT.FAILED ( |
| "PROBLEMS WITH POP OR TEST FOR EQUALITY") ; |
| END IF ; |
| |
| UNDERFLOW_EXCEPTION_TEST: |
| |
| BEGIN -- UNDERFLOW_EXCEPTION_TEST |
| |
| DATE_STACK.CLEAR (THIS_STACK => THIRD_DATE_STACK) ; |
| DATE_STACK.POP (THIS_ELEMENT => STORE_DATE, |
| OFF_THIS_STACK => THIRD_DATE_STACK) ; |
| REPORT.FAILED ("UNDERFLOW EXCEPTION NOT RAISED") ; |
| |
| EXCEPTION |
| |
| WHEN DATE_STACK.UNDERFLOW => NULL ; -- CORRECT EXCEPTION |
| -- RAISED |
| WHEN OTHERS => |
| REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " & |
| "UNDERFLOW EXCEPTION TEST") ; |
| |
| END UNDERFLOW_EXCEPTION_TEST ; |
| |
| OVERFLOW_EXCEPTION_TEST: |
| |
| BEGIN -- OVERFLOW_EXCEPTION_TEST |
| |
| DATE_STACK.CLEAR (THIS_STACK => THIRD_DATE_STACK) ; |
| FOR INDEX IN 1 .. 10 LOOP |
| DATE_STACK.PUSH ( THIS_ELEMENT => TODAY, |
| ON_TO_THIS_STACK => THIRD_DATE_STACK) ; |
| END LOOP ; |
| |
| DATE_STACK.PUSH (THIS_ELEMENT => TODAY, |
| ON_TO_THIS_STACK => THIRD_DATE_STACK) ; |
| REPORT.FAILED ("OVERFLOW EXCEPTION NOT RAISED") ; |
| |
| EXCEPTION |
| |
| WHEN DATE_STACK.OVERFLOW => NULL ; -- CORRECT EXCEPTION |
| -- RAISED |
| WHEN OTHERS => |
| REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " & |
| "OVERFLOW EXCEPTION TEST") ; |
| |
| END OVERFLOW_EXCEPTION_TEST ; |
| |
| LOCAL_BLOCK: |
| |
| DECLARE |
| |
| TYPE DATE_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF DATE ; |
| |
| FIRST_DATE_TABLE : DATE_TABLE ; |
| |
| TABLE_INDEX : POSITIVE := 1 ; |
| |
| PROCEDURE SHOW_DATES (THIS_DATE : IN DATE ; |
| CONTINUE : OUT BOOLEAN) ; |
| |
| PROCEDURE STORE_DATES (THIS_DATE : IN DATE ; |
| CONTINUE : OUT BOOLEAN) ; |
| |
| PROCEDURE SHOW_DATE_ITERATE IS NEW |
| DATE_STACK.ITERATE (PROCESS => SHOW_DATES) ; |
| |
| PROCEDURE STORE_DATE_ITERATE IS NEW |
| DATE_STACK.ITERATE (PROCESS => STORE_DATES) ; |
| |
| PROCEDURE SHOW_DATES (THIS_DATE : IN DATE ; |
| CONTINUE : OUT BOOLEAN) IS |
| BEGIN -- SHOW_DATES |
| |
| REPORT.COMMENT ("THE MONTH IS " & |
| MONTH_TYPE'IMAGE (THIS_DATE.MONTH)) ; |
| REPORT.COMMENT ("THE DAY IS " & |
| DAY_TYPE'IMAGE (THIS_DATE.DAY)) ; |
| REPORT.COMMENT ("THE YEAR IS " & |
| YEAR_TYPE'IMAGE (THIS_DATE.YEAR)) ; |
| |
| CONTINUE := TRUE ; |
| |
| END SHOW_DATES ; |
| |
| PROCEDURE STORE_DATES (THIS_DATE : IN DATE ; |
| CONTINUE : OUT BOOLEAN) IS |
| BEGIN -- STORE_DATES |
| |
| FIRST_DATE_TABLE (TABLE_INDEX) := THIS_DATE ; |
| TABLE_INDEX := TABLE_INDEX + 1 ; |
| |
| CONTINUE := TRUE ; |
| |
| END STORE_DATES ; |
| |
| BEGIN -- LOCAL_BLOCK |
| |
| REPORT.COMMENT ("CONTENTS OF THE FIRST STACK") ; |
| SHOW_DATE_ITERATE (OVER_THIS_STACK => FIRST_DATE_STACK) ; |
| |
| REPORT.COMMENT ("CONTENTS OF THE SECOND STACK") ; |
| SHOW_DATE_ITERATE (OVER_THIS_STACK => SECOND_DATE_STACK) ; |
| |
| STORE_DATE_ITERATE (OVER_THIS_STACK => FIRST_DATE_STACK) ; |
| IF (FIRST_DATE_TABLE (1) /= TODAY) OR |
| (FIRST_DATE_TABLE (2) /= FIRST_DATE) THEN |
| REPORT.FAILED ("PROBLEMS WITH ITERATION - 1") ; |
| END IF ; |
| |
| TABLE_INDEX := 1 ; |
| STORE_DATE_ITERATE (OVER_THIS_STACK => SECOND_DATE_STACK) ; |
| IF (FIRST_DATE_TABLE (1) /= TODAY) OR |
| (FIRST_DATE_TABLE (2) /= WALL_DATE) THEN |
| REPORT.FAILED ("PROBLEMS WITH ITERATION - 2") ; |
| END IF ; |
| |
| END LOCAL_BLOCK ; |
| |
| REPORT.RESULT ; |
| |
| END CC3019B2M ; |
