1-- CC3019B2M.ADA 2 3-- Grant of Unlimited Rights 4-- 5-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, 6-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 7-- unlimited rights in the software and documentation contained herein. 8-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making 9-- this public release, the Government intends to confer upon all 10-- recipients unlimited rights equal to those held by the Government. 11-- These rights include rights to use, duplicate, release or disclose the 12-- released technical data and computer software in whole or in part, in 13-- any manner and for any purpose whatsoever, and to have or permit others 14-- to do so. 15-- 16-- DISCLAIMER 17-- 18-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 19-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 20-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE 21-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 22-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 23-- PARTICULAR PURPOSE OF SAID MATERIAL. 24--* 25-- CHECK INSTANTIATIONS OF UNITS WITHIN GENERIC UNITS, E.G., 26-- TO SUPPORT ITERATORS. THIS TEST SPECIFICALLY CHECKS THAT A 27-- NESTING LEVEL OF 2 IS SUPPORTED FOR GENERICS. 28-- 29-- *** THIS IS THE MAIN PROGRAM. IT MUST BE COMPILED AFTER THE 30-- *** SOURCE CODE IN FILES CC3019B0.ADA AND CC3019B1.ADA HAVE 31-- *** BEEN COMPILED. 32-- 33-- HISTORY: 34-- EDWARD V. BERARD, 31 AUGUST 1990 35 36WITH REPORT ; 37WITH CC3019B1_STACK_CLASS ; 38 39PROCEDURE CC3019B2M IS 40 41 TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, 42 SEP, OCT, NOV, DEC) ; 43 TYPE DAY_TYPE IS RANGE 1 .. 31 ; 44 TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ; 45 TYPE DATE IS RECORD 46 MONTH : MONTH_TYPE ; 47 DAY : DAY_TYPE ; 48 YEAR : YEAR_TYPE ; 49 END RECORD ; 50 51 STORE_DATE : DATE ; 52 53 TODAY : DATE := (MONTH => AUG, 54 DAY => 31, 55 YEAR => 1990) ; 56 57 FIRST_DATE : DATE := (MONTH => JUN, 58 DAY => 4, 59 YEAR => 1967) ; 60 61 BIRTH_DATE : DATE := (MONTH => OCT, 62 DAY => 3, 63 YEAR => 1949) ; 64 65 WALL_DATE : DATE := (MONTH => NOV, 66 DAY => 9, 67 YEAR => 1989) ; 68 69 PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE : IN OUT DATE ; 70 TO_THIS_DATE : IN OUT DATE) ; 71 72 FUNCTION IS_EQUAL (LEFT : IN DATE ; 73 RIGHT : IN DATE) RETURN BOOLEAN ; 74 75 PACKAGE DATE_STACK IS 76 NEW CC3019B1_STACK_CLASS (ELEMENT => DATE, 77 ASSIGN => ASSIGN, 78 "=" => IS_EQUAL) ; 79 80 FIRST_DATE_STACK : DATE_STACK.STACK ; 81 SECOND_DATE_STACK : DATE_STACK.STACK ; 82 THIRD_DATE_STACK : DATE_STACK.STACK ; 83 84 FUNCTION "=" (LEFT : IN DATE_STACK.STACK ; 85 RIGHT : IN DATE_STACK.STACK) RETURN BOOLEAN 86 RENAMES DATE_STACK."=" ; 87 88 PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE : IN OUT DATE ; 89 TO_THIS_DATE : IN OUT DATE) IS 90 91 BEGIN -- ASSIGN 92 93 TO_THIS_DATE := THE_VALUE_OF_THIS_DATE ; 94 95 END ASSIGN ; 96 97 FUNCTION IS_EQUAL (LEFT : IN DATE ; 98 RIGHT : IN DATE) RETURN BOOLEAN IS 99 100 BEGIN -- IS_EQUAL 101 102 RETURN (LEFT.MONTH = RIGHT.MONTH) AND 103 (LEFT.DAY = RIGHT.DAY) AND 104 (LEFT.YEAR = RIGHT.YEAR) ; 105 106 END IS_EQUAL ; 107 108BEGIN -- CC3019B2M 109 110 REPORT.TEST ("CC3019B2M", 111 "CHECK INSTANTIATIONS OF UNITS WITHIN GENERIC " & 112 "UNITS, E.G., TO SUPPORT ITERATORS. THIS TEST " & 113 "SPECIFICALLY CHECKS THAT A NESTING LEVEL OF " & 114 "2 IS SUPPORTED FOR GENERICS.") ; 115 116 DATE_STACK.CLEAR (THIS_STACK => FIRST_DATE_STACK) ; 117 IF DATE_STACK.NUMBER_OF_ELEMENTS 118 (ON_THIS_STACK => FIRST_DATE_STACK) /= 0 THEN 119 REPORT.FAILED ( 120 "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 1") ; 121 END IF ; 122 123 DATE_STACK.PUSH (THIS_ELEMENT => TODAY, 124 ON_TO_THIS_STACK => FIRST_DATE_STACK) ; 125 IF DATE_STACK.NUMBER_OF_ELEMENTS 126 (ON_THIS_STACK => FIRST_DATE_STACK) /= 1 THEN 127 REPORT.FAILED ( 128 "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 2") ; 129 END IF ; 130 131 DATE_STACK.PUSH (THIS_ELEMENT => FIRST_DATE, 132 ON_TO_THIS_STACK => FIRST_DATE_STACK) ; 133 IF DATE_STACK.NUMBER_OF_ELEMENTS 134 (ON_THIS_STACK => FIRST_DATE_STACK) /= 2 THEN 135 REPORT.FAILED ( 136 "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 3") ; 137 END IF ; 138 139 DATE_STACK.PUSH (THIS_ELEMENT => BIRTH_DATE, 140 ON_TO_THIS_STACK => FIRST_DATE_STACK) ; 141 IF DATE_STACK.NUMBER_OF_ELEMENTS 142 (ON_THIS_STACK => FIRST_DATE_STACK) /= 3 THEN 143 REPORT.FAILED ( 144 "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 4") ; 145 END IF ; 146 147 DATE_STACK.POP (THIS_ELEMENT => STORE_DATE, 148 OFF_THIS_STACK => FIRST_DATE_STACK) ; 149 IF DATE_STACK.NUMBER_OF_ELEMENTS 150 (ON_THIS_STACK => FIRST_DATE_STACK) /= 2 THEN 151 REPORT.FAILED ( 152 "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 5") ; 153 END IF ; 154 155 IF STORE_DATE /= BIRTH_DATE THEN 156 REPORT.FAILED ( 157 "IMPROPER VALUE REMOVED FROM STACK - 1") ; 158 END IF ; 159 160 DATE_STACK.CLEAR (THIS_STACK => SECOND_DATE_STACK) ; 161 IF DATE_STACK.NUMBER_OF_ELEMENTS 162 (ON_THIS_STACK => SECOND_DATE_STACK) /= 0 THEN 163 REPORT.FAILED ( 164 "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 6") ; 165 END IF ; 166 167 DATE_STACK.COPY (THIS_STACK => FIRST_DATE_STACK, 168 TO_THIS_STACK => SECOND_DATE_STACK) ; 169 170 IF FIRST_DATE_STACK /= SECOND_DATE_STACK THEN 171 REPORT.FAILED ( 172 "PROBLEMS WITH COPY OR TEST FOR EQUALITY") ; 173 END IF ; 174 175 DATE_STACK.POP (THIS_ELEMENT => STORE_DATE, 176 OFF_THIS_STACK => SECOND_DATE_STACK) ; 177 DATE_STACK.PUSH (THIS_ELEMENT => WALL_DATE, 178 ON_TO_THIS_STACK => SECOND_DATE_STACK) ; 179 IF FIRST_DATE_STACK = SECOND_DATE_STACK THEN 180 REPORT.FAILED ( 181 "PROBLEMS WITH POP OR TEST FOR EQUALITY") ; 182 END IF ; 183 184 UNDERFLOW_EXCEPTION_TEST: 185 186 BEGIN -- UNDERFLOW_EXCEPTION_TEST 187 188 DATE_STACK.CLEAR (THIS_STACK => THIRD_DATE_STACK) ; 189 DATE_STACK.POP (THIS_ELEMENT => STORE_DATE, 190 OFF_THIS_STACK => THIRD_DATE_STACK) ; 191 REPORT.FAILED ("UNDERFLOW EXCEPTION NOT RAISED") ; 192 193 EXCEPTION 194 195 WHEN DATE_STACK.UNDERFLOW => NULL ; -- CORRECT EXCEPTION 196 -- RAISED 197 WHEN OTHERS => 198 REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " & 199 "UNDERFLOW EXCEPTION TEST") ; 200 201 END UNDERFLOW_EXCEPTION_TEST ; 202 203 OVERFLOW_EXCEPTION_TEST: 204 205 BEGIN -- OVERFLOW_EXCEPTION_TEST 206 207 DATE_STACK.CLEAR (THIS_STACK => THIRD_DATE_STACK) ; 208 FOR INDEX IN 1 .. 10 LOOP 209 DATE_STACK.PUSH ( THIS_ELEMENT => TODAY, 210 ON_TO_THIS_STACK => THIRD_DATE_STACK) ; 211 END LOOP ; 212 213 DATE_STACK.PUSH (THIS_ELEMENT => TODAY, 214 ON_TO_THIS_STACK => THIRD_DATE_STACK) ; 215 REPORT.FAILED ("OVERFLOW EXCEPTION NOT RAISED") ; 216 217 EXCEPTION 218 219 WHEN DATE_STACK.OVERFLOW => NULL ; -- CORRECT EXCEPTION 220 -- RAISED 221 WHEN OTHERS => 222 REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " & 223 "OVERFLOW EXCEPTION TEST") ; 224 225 END OVERFLOW_EXCEPTION_TEST ; 226 227 LOCAL_BLOCK: 228 229 DECLARE 230 231 TYPE DATE_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF DATE ; 232 233 FIRST_DATE_TABLE : DATE_TABLE ; 234 235 TABLE_INDEX : POSITIVE := 1 ; 236 237 PROCEDURE SHOW_DATES (THIS_DATE : IN DATE ; 238 CONTINUE : OUT BOOLEAN) ; 239 240 PROCEDURE STORE_DATES (THIS_DATE : IN DATE ; 241 CONTINUE : OUT BOOLEAN) ; 242 243 PROCEDURE SHOW_DATE_ITERATE IS NEW 244 DATE_STACK.ITERATE (PROCESS => SHOW_DATES) ; 245 246 PROCEDURE STORE_DATE_ITERATE IS NEW 247 DATE_STACK.ITERATE (PROCESS => STORE_DATES) ; 248 249 PROCEDURE SHOW_DATES (THIS_DATE : IN DATE ; 250 CONTINUE : OUT BOOLEAN) IS 251 BEGIN -- SHOW_DATES 252 253 REPORT.COMMENT ("THE MONTH IS " & 254 MONTH_TYPE'IMAGE (THIS_DATE.MONTH)) ; 255 REPORT.COMMENT ("THE DAY IS " & 256 DAY_TYPE'IMAGE (THIS_DATE.DAY)) ; 257 REPORT.COMMENT ("THE YEAR IS " & 258 YEAR_TYPE'IMAGE (THIS_DATE.YEAR)) ; 259 260 CONTINUE := TRUE ; 261 262 END SHOW_DATES ; 263 264 PROCEDURE STORE_DATES (THIS_DATE : IN DATE ; 265 CONTINUE : OUT BOOLEAN) IS 266 BEGIN -- STORE_DATES 267 268 FIRST_DATE_TABLE (TABLE_INDEX) := THIS_DATE ; 269 TABLE_INDEX := TABLE_INDEX + 1 ; 270 271 CONTINUE := TRUE ; 272 273 END STORE_DATES ; 274 275 BEGIN -- LOCAL_BLOCK 276 277 REPORT.COMMENT ("CONTENTS OF THE FIRST STACK") ; 278 SHOW_DATE_ITERATE (OVER_THIS_STACK => FIRST_DATE_STACK) ; 279 280 REPORT.COMMENT ("CONTENTS OF THE SECOND STACK") ; 281 SHOW_DATE_ITERATE (OVER_THIS_STACK => SECOND_DATE_STACK) ; 282 283 STORE_DATE_ITERATE (OVER_THIS_STACK => FIRST_DATE_STACK) ; 284 IF (FIRST_DATE_TABLE (1) /= TODAY) OR 285 (FIRST_DATE_TABLE (2) /= FIRST_DATE) THEN 286 REPORT.FAILED ("PROBLEMS WITH ITERATION - 1") ; 287 END IF ; 288 289 TABLE_INDEX := 1 ; 290 STORE_DATE_ITERATE (OVER_THIS_STACK => SECOND_DATE_STACK) ; 291 IF (FIRST_DATE_TABLE (1) /= TODAY) OR 292 (FIRST_DATE_TABLE (2) /= WALL_DATE) THEN 293 REPORT.FAILED ("PROBLEMS WITH ITERATION - 2") ; 294 END IF ; 295 296 END LOCAL_BLOCK ; 297 298 REPORT.RESULT ; 299 300END CC3019B2M ; 301