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
TO_THIS_DATE := THE_VALUE_OF_THIS_DATE ;
END ASSIGN ;
FUNCTION IS_EQUAL (LEFT : IN DATE ;
RIGHT : IN DATE) RETURN BOOLEAN IS
BEGIN
RETURN (LEFT.MONTH = RIGHT.MONTH) AND
(LEFT.DAY = RIGHT.DAY) AND
(LEFT.YEAR = RIGHT.YEAR) ;
END IS_EQUAL ;
BEGIN
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
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 ; WHEN OTHERS =>
REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " &
"UNDERFLOW EXCEPTION TEST") ;
END UNDERFLOW_EXCEPTION_TEST ;
OVERFLOW_EXCEPTION_TEST:
BEGIN
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 ; 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
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
FIRST_DATE_TABLE (TABLE_INDEX) := THIS_DATE ;
TABLE_INDEX := TABLE_INDEX + 1 ;
CONTINUE := TRUE ;
END STORE_DATES ;
BEGIN
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 ;