1-- CC3019C2M.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. 27 28-- THIS TEST SPECIFICALLY CHECKS THAT A 29-- NESTING LEVEL OF 3 IS SUPPORTED FOR GENERICS: 30-- INSTANTIATE CC3019C1_NESTED_GENERICS IN THE MAIN 31-- PROCEDURE, THE INSTANTIATION OF CC3019C0_LIST_CLASS 32-- IN GENERIC PACKAGE CC3019C1_NESTED_GENERICS, AND 33-- THE INSTANTIATION OF NEW_LIST_CLASS.ITERATE IN 34-- PROCEDURE ITERATE IN PACKAGE BODY STACK_CLASS. 35-- 36-- *** THIS IS THE MAIN PROGRAM. IT MUST BE COMPILED AFTER THE 37-- *** SOURCE CODE IN FILES CC3019C0.ADA AND CC3019C1.ADA HAVE 38-- *** BEEN COMPILED. 39-- 40-- HISTORY: 41-- EDWARD V. BERARD, 31 AUGUST 1990 42 43WITH REPORT ; 44WITH CC3019C1_NESTED_GENERICS ; 45 46PROCEDURE CC3019C2M IS 47 48 TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, 49 SEP, OCT, NOV, DEC) ; 50 TYPE DAY_TYPE IS RANGE 1 .. 31 ; 51 TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ; 52 TYPE DATE IS RECORD 53 MONTH : MONTH_TYPE ; 54 DAY : DAY_TYPE ; 55 YEAR : YEAR_TYPE ; 56 END RECORD ; 57 58 STORE_DATE : DATE ; 59 60 TODAY : DATE := (MONTH => AUG, 61 DAY => 31, 62 YEAR => 1990) ; 63 64 FIRST_DATE : DATE := (MONTH => JUN, 65 DAY => 4, 66 YEAR => 1967) ; 67 68 BIRTH_DATE : DATE := (MONTH => OCT, 69 DAY => 3, 70 YEAR => 1949) ; 71 72 WALL_DATE : DATE := (MONTH => NOV, 73 DAY => 9, 74 YEAR => 1989) ; 75 76 TYPE SEX IS (MALE, FEMALE) ; 77 78 TYPE PERSON IS RECORD 79 BIRTH_DATE : DATE ; 80 GENDER : SEX ; 81 NAME : STRING (1 .. 10) ; 82 END RECORD ; 83 84 FIRST_PERSON : PERSON ; 85 SECOND_PERSON : PERSON ; 86 87 MYSELF : PERSON := (BIRTH_DATE => BIRTH_DATE, 88 GENDER => MALE, 89 NAME => "ED ") ; 90 91 FRIEND : PERSON := (BIRTH_DATE => DATE'(DEC, 27, 1949), 92 GENDER => MALE, 93 NAME => "DENNIS ") ; 94 95 FATHER : PERSON := (BIRTH_DATE => DATE'(JUL, 5, 1925), 96 GENDER => MALE, 97 NAME => "EDWARD ") ; 98 99 DAUGHTER : PERSON := (BIRTH_DATE => DATE'(DEC, 10, 1980), 100 GENDER => FEMALE, 101 NAME => "CHRISSY ") ; 102 103 PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE : IN OUT DATE ; 104 TO_THIS_DATE : IN OUT DATE) ; 105 106 FUNCTION IS_EQUAL (LEFT : IN DATE ; 107 RIGHT : IN DATE) RETURN BOOLEAN ; 108 109 PROCEDURE ASSIGN (THE_VALUE_OF_THIS_PERSON : IN OUT PERSON ; 110 TO_THIS_PERSON : IN OUT PERSON) ; 111 112 FUNCTION IS_EQUAL (LEFT : IN PERSON ; 113 RIGHT : IN PERSON) RETURN BOOLEAN ; 114 115-- INSTANTIATE OUTER GENERIC PACKAGE 116 117 PACKAGE NEW_NESTED_GENERICS IS NEW 118 CC3019C1_NESTED_GENERICS (ELEMENT => DATE, 119 ASSIGN => ASSIGN, 120 "=" => IS_EQUAL) ; 121 122 FIRST_NNG : NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE ; 123 SECOND_NNG : NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE ; 124 125 FUNCTION "=" (LEFT : IN NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE ; 126 RIGHT : IN NEW_NESTED_GENERICS.NESTED_GENERICS_TYPE) 127 RETURN BOOLEAN RENAMES NEW_NESTED_GENERICS."=" ; 128 129-- INSTANTIATE NESTED TASK PACKAGE 130 131 PACKAGE NEW_GENERIC_TASK IS NEW 132 NEW_NESTED_GENERICS.GENERIC_TASK (ELEMENT => PERSON, 133 ASSIGN => ASSIGN) ; 134 135 FIRST_GENERIC_TASK : NEW_GENERIC_TASK.PROTECTED_AREA ; 136 SECOND_GENERIC_TASK : NEW_GENERIC_TASK.PROTECTED_AREA ; 137 138-- INSTANTIATE NESTED STACK PACKAGE 139 140 PACKAGE PERSON_STACK IS NEW 141 NEW_NESTED_GENERICS.STACK_CLASS (ELEMENT => PERSON, 142 ASSIGN => ASSIGN, 143 "=" => IS_EQUAL) ; 144 145 FIRST_PERSON_STACK : PERSON_STACK.STACK ; 146 SECOND_PERSON_STACK : PERSON_STACK.STACK ; 147 THIRD_PERSON_STACK : PERSON_STACK.STACK ; 148 149 FUNCTION "=" (LEFT : IN PERSON_STACK.STACK ; 150 RIGHT : IN PERSON_STACK.STACK) RETURN BOOLEAN 151 RENAMES PERSON_STACK."=" ; 152 153 PROCEDURE ASSIGN (THE_VALUE_OF_THIS_DATE : IN OUT DATE ; 154 TO_THIS_DATE : IN OUT DATE) IS 155 156 BEGIN -- ASSIGN 157 158 TO_THIS_DATE := THE_VALUE_OF_THIS_DATE ; 159 160 END ASSIGN ; 161 162 FUNCTION IS_EQUAL (LEFT : IN DATE ; 163 RIGHT : IN DATE) RETURN BOOLEAN IS 164 165 BEGIN -- IS_EQUAL 166 167 IF (LEFT.MONTH = RIGHT.MONTH) AND (LEFT.DAY = RIGHT.DAY) 168 AND (LEFT.YEAR = RIGHT.YEAR) THEN 169 RETURN TRUE ; 170 ELSE 171 RETURN FALSE ; 172 END IF ; 173 174 END IS_EQUAL ; 175 176 PROCEDURE ASSIGN (THE_VALUE_OF_THIS_PERSON : IN OUT PERSON ; 177 TO_THIS_PERSON : IN OUT PERSON) IS 178 179 BEGIN -- ASSIGN 180 181 TO_THIS_PERSON := THE_VALUE_OF_THIS_PERSON ; 182 183 END ASSIGN ; 184 185 FUNCTION IS_EQUAL (LEFT : IN PERSON ; 186 RIGHT : IN PERSON) RETURN BOOLEAN IS 187 188 BEGIN -- IS_EQUAL 189 190 IF (LEFT.BIRTH_DATE = RIGHT.BIRTH_DATE) AND 191 (LEFT.GENDER = RIGHT.GENDER) AND 192 (LEFT.NAME = RIGHT.NAME) THEN 193 RETURN TRUE ; 194 ELSE 195 RETURN FALSE ; 196 END IF ; 197 198 END IS_EQUAL ; 199 200BEGIN -- CC3019C2M 201 202 REPORT.TEST ("CC3019C2M", 203 "CHECK INSTANTIATIONS OF UNITS WITHIN GENERIC " & 204 "UNITS, E.G., TO SUPPORT ITERATORS. THIS TEST " & 205 "SPECIFICALLY CHECKS THAT A NESTING LEVEL OF 3 " & 206 "IS SUPPORTED FOR GENERICS.") ; 207 208-- CHECK THE OUTERMOST GENERIC (NEW_NESTED_GENERICS) 209 210 NEW_NESTED_GENERICS.SET_ELEMENT ( 211 FOR_THIS_NGT_OBJECT => FIRST_NNG, 212 TO_THIS_ELEMENT => TODAY) ; 213 NEW_NESTED_GENERICS.SET_NUMBER ( 214 FOR_THIS_NGT_OBJECT => FIRST_NNG, 215 TO_THIS_NUMBER => 1) ; 216 217 NEW_NESTED_GENERICS.SET_ELEMENT ( 218 FOR_THIS_NGT_OBJECT => SECOND_NNG, 219 TO_THIS_ELEMENT => FIRST_DATE) ; 220 NEW_NESTED_GENERICS.SET_NUMBER ( 221 FOR_THIS_NGT_OBJECT => SECOND_NNG, 222 TO_THIS_NUMBER => 2) ; 223 224 IF FIRST_NNG = SECOND_NNG THEN 225 REPORT.FAILED ("PROBLEMS WITH TESTING EQUALITY FOR " & 226 "OUTERMOST GENERIC") ; 227 END IF ; 228 229 IF (NEW_NESTED_GENERICS.ELEMENT_OF (THIS_NGT_OBJECT => FIRST_NNG) 230 /= TODAY) OR 231 (NEW_NESTED_GENERICS.ELEMENT_OF ( 232 THIS_NGT_OBJECT => SECOND_NNG) 233 /= FIRST_DATE) THEN 234 REPORT.FAILED ("PROBLEMS WITH EXTRACTING ELEMENTS IN " & 235 "OUTERMOST GENERIC") ; 236 END IF ; 237 238 IF (NEW_NESTED_GENERICS.NUMBER_OF (THIS_NGT_OBJECT => FIRST_NNG) 239 /= 1) OR 240 (NEW_NESTED_GENERICS.NUMBER_OF (THIS_NGT_OBJECT => SECOND_NNG) 241 /= 2) THEN 242 REPORT.FAILED ("PROBLEMS WITH EXTRACTING NUMBERS IN " & 243 "OUTERMOST GENERIC") ; 244 END IF ; 245 246 NEW_NESTED_GENERICS.COPY (SOURCE => FIRST_NNG, 247 DESTINATION => SECOND_NNG) ; 248 249 IF FIRST_NNG /= SECOND_NNG THEN 250 REPORT.FAILED ("PROBLEMS WITH COPYING OR TESTING EQUALITY " & 251 "IN OUTERMOST GENERIC") ; 252 END IF ; 253 254-- CHECK THE FIRST NESTED GENERIC (GENERIC_TASK) 255 256 FIRST_GENERIC_TASK.STORE (ITEM => MYSELF) ; 257 SECOND_GENERIC_TASK.STORE (ITEM => FRIEND) ; 258 259 FIRST_GENERIC_TASK.GET (ITEM => FIRST_PERSON) ; 260 SECOND_GENERIC_TASK.GET (ITEM => SECOND_PERSON) ; 261 262 IF (FIRST_PERSON /= MYSELF) OR (SECOND_PERSON /= FRIEND) THEN 263 REPORT.FAILED ("PROBLEMS WITH NESTED TASK GENERIC") ; 264 END IF ; 265 266-- CHECK THE SECOND NESTED GENERIC (STACK_CLASS) 267 268 PERSON_STACK.CLEAR (THIS_STACK => FIRST_PERSON_STACK) ; 269 IF PERSON_STACK.NUMBER_OF_ELEMENTS 270 (ON_THIS_STACK => FIRST_PERSON_STACK) /= 0 THEN 271 REPORT.FAILED ( 272 "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 1") ; 273 END IF ; 274 275 PERSON_STACK.PUSH (THIS_ELEMENT => MYSELF, 276 ON_TO_THIS_STACK => FIRST_PERSON_STACK) ; 277 IF PERSON_STACK.NUMBER_OF_ELEMENTS 278 (ON_THIS_STACK => FIRST_PERSON_STACK) /= 1 THEN 279 REPORT.FAILED ( 280 "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 2") ; 281 END IF ; 282 283 PERSON_STACK.PUSH (THIS_ELEMENT => FRIEND, 284 ON_TO_THIS_STACK => FIRST_PERSON_STACK) ; 285 IF PERSON_STACK.NUMBER_OF_ELEMENTS 286 (ON_THIS_STACK => FIRST_PERSON_STACK) /= 2 THEN 287 REPORT.FAILED ( 288 "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 3") ; 289 END IF ; 290 291 PERSON_STACK.PUSH (THIS_ELEMENT => FATHER, 292 ON_TO_THIS_STACK => FIRST_PERSON_STACK) ; 293 IF PERSON_STACK.NUMBER_OF_ELEMENTS 294 (ON_THIS_STACK => FIRST_PERSON_STACK) /= 3 THEN 295 REPORT.FAILED ( 296 "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 4") ; 297 END IF ; 298 299 PERSON_STACK.POP (THIS_ELEMENT => FIRST_PERSON, 300 OFF_THIS_STACK => FIRST_PERSON_STACK) ; 301 IF PERSON_STACK.NUMBER_OF_ELEMENTS 302 (ON_THIS_STACK => FIRST_PERSON_STACK) /= 2 THEN 303 REPORT.FAILED ( 304 "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 5") ; 305 END IF ; 306 307 IF FIRST_PERSON /= FATHER THEN 308 REPORT.FAILED ( 309 "IMPROPER VALUE REMOVED FROM STACK - 1") ; 310 END IF ; 311 312 PERSON_STACK.CLEAR (THIS_STACK => SECOND_PERSON_STACK) ; 313 IF PERSON_STACK.NUMBER_OF_ELEMENTS 314 (ON_THIS_STACK => SECOND_PERSON_STACK) /= 0 THEN 315 REPORT.FAILED ( 316 "IMPROPER VALUE RETURNED FROM NUMBER_OF_ELEMENTS - 6") ; 317 END IF ; 318 319 PERSON_STACK.COPY (THIS_STACK => FIRST_PERSON_STACK, 320 TO_THIS_STACK => SECOND_PERSON_STACK) ; 321 322 IF FIRST_PERSON_STACK /= SECOND_PERSON_STACK THEN 323 REPORT.FAILED ( 324 "PROBLEMS WITH COPY OR TEST FOR EQUALITY (STACK)") ; 325 END IF ; 326 327 PERSON_STACK.POP (THIS_ELEMENT => FIRST_PERSON, 328 OFF_THIS_STACK => SECOND_PERSON_STACK) ; 329 PERSON_STACK.PUSH (THIS_ELEMENT => DAUGHTER, 330 ON_TO_THIS_STACK => SECOND_PERSON_STACK) ; 331 IF FIRST_PERSON_STACK = SECOND_PERSON_STACK THEN 332 REPORT.FAILED ( 333 "PROBLEMS WITH POP OR TEST FOR EQUALITY (STACK)") ; 334 END IF ; 335 336 UNDERFLOW_EXCEPTION_TEST: 337 338 BEGIN -- UNDERFLOW_EXCEPTION_TEST 339 340 PERSON_STACK.CLEAR (THIS_STACK => THIRD_PERSON_STACK) ; 341 PERSON_STACK.POP (THIS_ELEMENT => FIRST_PERSON, 342 OFF_THIS_STACK => THIRD_PERSON_STACK) ; 343 REPORT.FAILED ("UNDERFLOW EXCEPTION NOT RAISED") ; 344 345 EXCEPTION 346 347 WHEN PERSON_STACK.UNDERFLOW => NULL ; -- CORRECT EXCEPTION 348 -- RAISED 349 WHEN OTHERS => 350 REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " & 351 "UNDERFLOW EXCEPTION TEST") ; 352 353 END UNDERFLOW_EXCEPTION_TEST ; 354 355 OVERFLOW_EXCEPTION_TEST: 356 357 BEGIN -- OVERFLOW_EXCEPTION_TEST 358 359 PERSON_STACK.CLEAR (THIS_STACK => THIRD_PERSON_STACK) ; 360 FOR INDEX IN 1 .. 10 LOOP 361 PERSON_STACK.PUSH ( 362 THIS_ELEMENT => MYSELF, 363 ON_TO_THIS_STACK => THIRD_PERSON_STACK) ; 364 END LOOP ; 365 366 PERSON_STACK.PUSH (THIS_ELEMENT => MYSELF, 367 ON_TO_THIS_STACK => THIRD_PERSON_STACK) ; 368 REPORT.FAILED ("OVERFLOW EXCEPTION NOT RAISED") ; 369 370 EXCEPTION 371 372 WHEN PERSON_STACK.OVERFLOW => NULL ; -- CORRECT EXCEPTION 373 -- RAISED 374 WHEN OTHERS => 375 REPORT.FAILED ("INCORRECT EXCEPTION RAISED IN " & 376 "OVERFLOW EXCEPTION TEST") ; 377 378 END OVERFLOW_EXCEPTION_TEST ; 379 380 LOCAL_BLOCK: 381 382 DECLARE 383 384 TYPE PERSON_TABLE IS ARRAY (POSITIVE RANGE 1 .. 10) OF PERSON; 385 386 FIRST_PERSON_TABLE : PERSON_TABLE ; 387 388 TABLE_INDEX : POSITIVE := 1 ; 389 390 PROCEDURE GATHER_PEOPLE (THIS_PERSON : IN PERSON ; 391 CONTINUE : OUT BOOLEAN) ; 392 393 PROCEDURE SHOW_PEOPLE (THIS_PERSON : IN PERSON ; 394 CONTINUE : OUT BOOLEAN) ; 395 396 PROCEDURE GATHER_PERSON_ITERATE IS NEW 397 PERSON_STACK.ITERATE (PROCESS => GATHER_PEOPLE) ; 398 399 PROCEDURE SHOW_PERSON_ITERATE IS NEW 400 PERSON_STACK.ITERATE (PROCESS => SHOW_PEOPLE) ; 401 402 PROCEDURE GATHER_PEOPLE (THIS_PERSON : IN PERSON ; 403 CONTINUE : OUT BOOLEAN) IS 404 BEGIN -- GATHER_PEOPLE 405 406 FIRST_PERSON_TABLE (TABLE_INDEX) := THIS_PERSON ; 407 TABLE_INDEX := TABLE_INDEX + 1 ; 408 409 CONTINUE := TRUE ; 410 411 END GATHER_PEOPLE ; 412 413 PROCEDURE SHOW_PEOPLE (THIS_PERSON : IN PERSON ; 414 CONTINUE : OUT BOOLEAN) IS 415 416 BEGIN -- SHOW_PEOPLE 417 418 REPORT.COMMENT ("THE BIRTH MONTH IS " & 419 MONTH_TYPE'IMAGE (THIS_PERSON.BIRTH_DATE.MONTH)) ; 420 REPORT.COMMENT ("THE BIRTH DAY IS " & 421 DAY_TYPE'IMAGE (THIS_PERSON.BIRTH_DATE.DAY)) ; 422 REPORT.COMMENT ("THE BIRTH YEAR IS " & 423 YEAR_TYPE'IMAGE (THIS_PERSON.BIRTH_DATE.YEAR)) ; 424 REPORT.COMMENT ("THE GENDER IS " & 425 SEX'IMAGE (THIS_PERSON.GENDER)) ; 426 REPORT.COMMENT ("THE NAME IS " & THIS_PERSON.NAME) ; 427 428 CONTINUE := TRUE ; 429 430 END SHOW_PEOPLE ; 431 432 BEGIN -- LOCAL_BLOCK 433 434 REPORT.COMMENT ("CONTENTS OF THE FIRST STACK") ; 435 SHOW_PERSON_ITERATE (OVER_THIS_STACK => FIRST_PERSON_STACK) ; 436 437 REPORT.COMMENT ("CONTENTS OF THE SECOND STACK") ; 438 SHOW_PERSON_ITERATE (OVER_THIS_STACK => SECOND_PERSON_STACK) ; 439 440 GATHER_PERSON_ITERATE (OVER_THIS_STACK => FIRST_PERSON_STACK); 441 IF (FIRST_PERSON_TABLE (1) /= MYSELF) OR 442 (FIRST_PERSON_TABLE (2) /= FRIEND) THEN 443 REPORT.FAILED ("PROBLEMS WITH ITERATION - 1") ; 444 END IF ; 445 446 TABLE_INDEX := 1 ; 447 GATHER_PERSON_ITERATE(OVER_THIS_STACK => SECOND_PERSON_STACK); 448 IF (FIRST_PERSON_TABLE (1) /= MYSELF) OR 449 (FIRST_PERSON_TABLE (2) /= DAUGHTER) THEN 450 REPORT.FAILED ("PROBLEMS WITH ITERATION - 2") ; 451 END IF ; 452 453 END LOCAL_BLOCK ; 454 455 REPORT.RESULT ; 456 457END CC3019C2M ; 458