1-- C36204D.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 THAT EACH ARRAY ATTRIBUTE YIELDS THE CORRECT VALUES. 26-- BOTH ARRAY OBJECTS AND TYPES ARE CHECKED. THIS TEST CHECKS 27-- THE ABOVE FOR ARRAYS WITHIN GENERIC PROGRAM UNITS. 28 29-- HISTROY 30-- EDWARD V. BERARD, 9 AUGUST 1990 31 32WITH REPORT ; 33WITH SYSTEM ; 34 35PROCEDURE C36204D IS 36 37 SHORT_START : CONSTANT := -10 ; 38 SHORT_END : CONSTANT := 10 ; 39 TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ; 40 SHORT_LENGTH : CONSTANT NATURAL := (SHORT_END - SHORT_START + 1) ; 41 42 TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, 43 SEP, OCT, NOV, DEC) ; 44 SUBTYPE MID_YEAR IS MONTH_TYPE RANGE MAY .. AUG ; 45 TYPE DAY_TYPE IS RANGE 1 .. 31 ; 46 TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ; 47 TYPE DATE IS RECORD 48 MONTH : MONTH_TYPE ; 49 DAY : DAY_TYPE ; 50 YEAR : YEAR_TYPE ; 51 END RECORD ; 52 53 TODAY : DATE := (MONTH => AUG, 54 DAY => 10, 55 YEAR => 1990) ; 56 57 FIRST_DATE : DATE := (DAY => 6, 58 MONTH => JUN, 59 YEAR => 1967) ; 60 61 FUNCTION "=" (LEFT : IN SYSTEM.ADDRESS ; 62 RIGHT : IN SYSTEM.ADDRESS ) RETURN BOOLEAN 63 RENAMES SYSTEM."=" ; 64 65 GENERIC 66 67 TYPE FIRST_INDEX IS (<>) ; 68 FIRST_INDEX_LENGTH : IN NATURAL ; 69 FIRST_TEST_VALUE : IN FIRST_INDEX ; 70 TYPE SECOND_INDEX IS (<>) ; 71 SECOND_INDEX_LENGTH : IN NATURAL ; 72 SECOND_TEST_VALUE : IN SECOND_INDEX ; 73 TYPE THIRD_INDEX IS (<>) ; 74 THIRD_INDEX_LENGTH : IN NATURAL ; 75 THIRD_TEST_VALUE : IN THIRD_INDEX ; 76 TYPE FIRST_COMPONENT_TYPE IS PRIVATE ; 77 FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ; 78 SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ; 79 TYPE SECOND_COMPONENT_TYPE IS PRIVATE ; 80 THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ; 81 FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ; 82 83 PACKAGE ARRAY_ATTRIBUTE_TEST IS 84 85 TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX) 86 OF FIRST_COMPONENT_TYPE ; 87 88 TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX) 89 OF SECOND_COMPONENT_TYPE ; 90 91 END ARRAY_ATTRIBUTE_TEST ; 92 93 PACKAGE BODY ARRAY_ATTRIBUTE_TEST IS 94 95 FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => 96 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => 97 FIRST_DEFAULT_VALUE)) ; 98 99 SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => 100 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => 101 (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST => 102 THIRD_DEFAULT_VALUE))) ; 103 104 THIRD_ARRAY : CONSTANT MATRIX 105 := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => 106 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => 107 SECOND_DEFAULT_VALUE)) ; 108 109 FOURTH_ARRAY : CONSTANT CUBE 110 := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => 111 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => 112 (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST => 113 FOURTH_DEFAULT_VALUE))) ; 114 115 FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ; 116 FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ; 117 FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ; 118 FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ; 119 120 SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ; 121 SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ; 122 SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ; 123 SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ; 124 SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ; 125 SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ; 126 127 FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ; 128 FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ; 129 130 SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ; 131 SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ; 132 SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ; 133 134 MATRIX_SIZE : NATURAL := MATRIX'SIZE ; 135 CUBE_SIZE : NATURAL := CUBE'SIZE ; 136 137 FAA : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ; 138 SAA : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ; 139 TAA : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ; 140 FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ; 141 142 BEGIN -- ARRAY_ATTRIBUTE_TEST 143 144 IF (FA1 /= FIRST_INDEX'FIRST) OR 145 (FA3 /= SECOND_INDEX'FIRST) OR 146 (SA1 /= FIRST_INDEX'FIRST) OR 147 (SA3 /= SECOND_INDEX'FIRST) OR 148 (SA5 /= THIRD_INDEX'FIRST) THEN 149 REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST - PACKAGE") ; 150 END IF ; 151 152 IF (FA2 /= FIRST_INDEX'LAST) OR 153 (FA4 /= SECOND_INDEX'LAST) OR 154 (SA2 /= FIRST_INDEX'LAST) OR 155 (SA4 /= SECOND_INDEX'LAST) OR 156 (SA6 /= THIRD_INDEX'LAST) THEN 157 REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST - PACKAGE") ; 158 END IF ; 159 160 IF (FAL1 /= FIRST_INDEX_LENGTH) OR 161 (FAL2 /= SECOND_INDEX_LENGTH) OR 162 (SAL1 /= FIRST_INDEX_LENGTH) OR 163 (SAL2 /= SECOND_INDEX_LENGTH) OR 164 (SAL3 /= THIRD_INDEX_LENGTH) THEN 165 REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH - PACKAGE") ; 166 END IF ; 167 168 FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP 169 FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP 170 FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) := 171 SECOND_DEFAULT_VALUE ; 172 END LOOP ; 173 END LOOP ; 174 175 IF FIRST_ARRAY /= THIRD_ARRAY THEN 176 REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & 177 "FOR 2-DIMENSIONAL ARRAY. - PACKAGE") ; 178 END IF ; 179 180 FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP 181 FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP 182 FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP 183 SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX) 184 := FOURTH_DEFAULT_VALUE ; 185 END LOOP ; 186 END LOOP ; 187 END LOOP ; 188 189 IF SECOND_ARRAY /= FOURTH_ARRAY THEN 190 REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & 191 "FOR 3-DIMENSIONAL ARRAY. - PACKAGE") ; 192 END IF ; 193 194 IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR 195 (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR 196 (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR 197 (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR 198 (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN 199 REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & 200 "- PACKAGE") ; 201 END IF ; 202 203 IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN 204 REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " & 205 "- PACKAGE") ; 206 END IF ; 207 208 IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA) 209 OR (SAA = TAA) OR (TAA = FRAA) THEN 210 REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " & 211 "- PACKAGE") ; 212 END IF ; 213 214 END ARRAY_ATTRIBUTE_TEST ; 215 216 GENERIC 217 218 TYPE FIRST_INDEX IS (<>) ; 219 FIRST_INDEX_LENGTH : IN NATURAL ; 220 FIRST_TEST_VALUE : IN FIRST_INDEX ; 221 TYPE SECOND_INDEX IS (<>) ; 222 SECOND_INDEX_LENGTH : IN NATURAL ; 223 SECOND_TEST_VALUE : IN SECOND_INDEX ; 224 TYPE THIRD_INDEX IS (<>) ; 225 THIRD_INDEX_LENGTH : IN NATURAL ; 226 THIRD_TEST_VALUE : IN THIRD_INDEX ; 227 TYPE FIRST_COMPONENT_TYPE IS PRIVATE ; 228 FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ; 229 SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ; 230 TYPE SECOND_COMPONENT_TYPE IS PRIVATE ; 231 THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ; 232 FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ; 233 234 PROCEDURE PROC_ARRAY_ATT_TEST ; 235 236 PROCEDURE PROC_ARRAY_ATT_TEST IS 237 238 TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX) 239 OF FIRST_COMPONENT_TYPE ; 240 241 TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX) 242 OF SECOND_COMPONENT_TYPE ; 243 244 FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => 245 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => 246 FIRST_DEFAULT_VALUE)) ; 247 248 SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => 249 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => 250 (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST => 251 THIRD_DEFAULT_VALUE))) ; 252 253 THIRD_ARRAY : CONSTANT MATRIX 254 := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => 255 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => 256 SECOND_DEFAULT_VALUE)) ; 257 258 FOURTH_ARRAY : CONSTANT CUBE 259 := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => 260 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => 261 (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST => 262 FOURTH_DEFAULT_VALUE))) ; 263 264 FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ; 265 FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ; 266 FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ; 267 FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ; 268 269 SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ; 270 SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ; 271 SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ; 272 SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ; 273 SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ; 274 SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ; 275 276 FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ; 277 FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ; 278 279 SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ; 280 SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ; 281 SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ; 282 283 MATRIX_SIZE : NATURAL := MATRIX'SIZE ; 284 CUBE_SIZE : NATURAL := CUBE'SIZE ; 285 286 FAA : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ; 287 SAA : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ; 288 TAA : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ; 289 FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ; 290 291 BEGIN -- PROC_ARRAY_ATT_TEST 292 293 IF (FA1 /= FIRST_INDEX'FIRST) OR 294 (FA3 /= SECOND_INDEX'FIRST) OR 295 (SA1 /= FIRST_INDEX'FIRST) OR 296 (SA3 /= SECOND_INDEX'FIRST) OR 297 (SA5 /= THIRD_INDEX'FIRST) THEN 298 REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST " & 299 "- PROCEDURE") ; 300 END IF ; 301 302 IF (FA2 /= FIRST_INDEX'LAST) OR 303 (FA4 /= SECOND_INDEX'LAST) OR 304 (SA2 /= FIRST_INDEX'LAST) OR 305 (SA4 /= SECOND_INDEX'LAST) OR 306 (SA6 /= THIRD_INDEX'LAST) THEN 307 REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST " & 308 "- PROCEDURE") ; 309 END IF ; 310 311 IF (FAL1 /= FIRST_INDEX_LENGTH) OR 312 (FAL2 /= SECOND_INDEX_LENGTH) OR 313 (SAL1 /= FIRST_INDEX_LENGTH) OR 314 (SAL2 /= SECOND_INDEX_LENGTH) OR 315 (SAL3 /= THIRD_INDEX_LENGTH) THEN 316 REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH " & 317 "- PROCEDURE") ; 318 END IF ; 319 320 FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP 321 FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP 322 FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) := 323 SECOND_DEFAULT_VALUE ; 324 END LOOP ; 325 END LOOP ; 326 327 IF FIRST_ARRAY /= THIRD_ARRAY THEN 328 REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & 329 "FOR 2-DIMENSIONAL ARRAY. - PROCEDURE") ; 330 END IF ; 331 332 FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP 333 FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP 334 FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP 335 SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX) 336 := FOURTH_DEFAULT_VALUE ; 337 END LOOP ; 338 END LOOP ; 339 END LOOP ; 340 341 IF SECOND_ARRAY /= FOURTH_ARRAY THEN 342 REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & 343 "FOR 3-DIMENSIONAL ARRAY. - PROCEDURE") ; 344 END IF ; 345 346 IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR 347 (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR 348 (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR 349 (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR 350 (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN 351 REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & 352 "- PROCEDURE") ; 353 END IF ; 354 355 IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN 356 REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " & 357 "- PROCEDURE") ; 358 END IF ; 359 360 IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA) 361 OR (SAA = TAA) OR (TAA = FRAA) THEN 362 REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " & 363 "- PROCEDURE") ; 364 END IF ; 365 366 END PROC_ARRAY_ATT_TEST ; 367 368 GENERIC 369 370 TYPE FIRST_INDEX IS (<>) ; 371 FIRST_INDEX_LENGTH : IN NATURAL ; 372 FIRST_TEST_VALUE : IN FIRST_INDEX ; 373 TYPE SECOND_INDEX IS (<>) ; 374 SECOND_INDEX_LENGTH : IN NATURAL ; 375 SECOND_TEST_VALUE : IN SECOND_INDEX ; 376 TYPE THIRD_INDEX IS (<>) ; 377 THIRD_INDEX_LENGTH : IN NATURAL ; 378 THIRD_TEST_VALUE : IN THIRD_INDEX ; 379 TYPE FIRST_COMPONENT_TYPE IS PRIVATE ; 380 FIRST_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ; 381 SECOND_DEFAULT_VALUE : IN FIRST_COMPONENT_TYPE ; 382 TYPE SECOND_COMPONENT_TYPE IS PRIVATE ; 383 THIRD_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ; 384 FOURTH_DEFAULT_VALUE : IN SECOND_COMPONENT_TYPE ; 385 386 FUNCTION FUNC_ARRAY_ATT_TEST RETURN BOOLEAN ; 387 388 FUNCTION FUNC_ARRAY_ATT_TEST RETURN BOOLEAN IS 389 390 TYPE MATRIX IS ARRAY (FIRST_INDEX, SECOND_INDEX) 391 OF FIRST_COMPONENT_TYPE ; 392 393 TYPE CUBE IS ARRAY (FIRST_INDEX, SECOND_INDEX, THIRD_INDEX) 394 OF SECOND_COMPONENT_TYPE ; 395 396 FIRST_ARRAY : MATRIX := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => 397 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => 398 FIRST_DEFAULT_VALUE)) ; 399 400 SECOND_ARRAY : CUBE := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => 401 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => 402 (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST => 403 THIRD_DEFAULT_VALUE))) ; 404 405 THIRD_ARRAY : CONSTANT MATRIX 406 := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => 407 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => 408 SECOND_DEFAULT_VALUE)) ; 409 410 FOURTH_ARRAY : CONSTANT CUBE 411 := (FIRST_INDEX'FIRST .. FIRST_INDEX'LAST => 412 (SECOND_INDEX'FIRST .. SECOND_INDEX'LAST => 413 (THIRD_INDEX'FIRST .. THIRD_INDEX'LAST => 414 FOURTH_DEFAULT_VALUE))) ; 415 416 FA1 : FIRST_INDEX := FIRST_ARRAY'FIRST (1) ; 417 FA2 : FIRST_INDEX := FIRST_ARRAY'LAST (1) ; 418 FA3 : SECOND_INDEX := FIRST_ARRAY'FIRST (2) ; 419 FA4 : SECOND_INDEX := FIRST_ARRAY'LAST (2) ; 420 421 SA1 : FIRST_INDEX := SECOND_ARRAY'FIRST (1) ; 422 SA2 : FIRST_INDEX := SECOND_ARRAY'LAST (1) ; 423 SA3 : SECOND_INDEX := SECOND_ARRAY'FIRST (2) ; 424 SA4 : SECOND_INDEX := SECOND_ARRAY'LAST (2) ; 425 SA5 : THIRD_INDEX := SECOND_ARRAY'FIRST (3) ; 426 SA6 : THIRD_INDEX := SECOND_ARRAY'LAST (3) ; 427 428 FAL1 : NATURAL := FIRST_ARRAY'LENGTH (1) ; 429 FAL2 : NATURAL := FIRST_ARRAY'LENGTH (2) ; 430 431 SAL1 : NATURAL := SECOND_ARRAY'LENGTH (1) ; 432 SAL2 : NATURAL := SECOND_ARRAY'LENGTH (2) ; 433 SAL3 : NATURAL := SECOND_ARRAY'LENGTH (3) ; 434 435 MATRIX_SIZE : NATURAL := MATRIX'SIZE ; 436 CUBE_SIZE : NATURAL := CUBE'SIZE ; 437 438 FAA : SYSTEM.ADDRESS := FIRST_ARRAY'ADDRESS ; 439 SAA : SYSTEM.ADDRESS := SECOND_ARRAY'ADDRESS ; 440 TAA : SYSTEM.ADDRESS := THIRD_ARRAY'ADDRESS ; 441 FRAA : SYSTEM.ADDRESS := FOURTH_ARRAY'ADDRESS ; 442 443 BEGIN -- FUNC_ARRAY_ATT_TEST 444 445 IF (FA1 /= FIRST_INDEX'FIRST) OR 446 (FA3 /= SECOND_INDEX'FIRST) OR 447 (SA1 /= FIRST_INDEX'FIRST) OR 448 (SA3 /= SECOND_INDEX'FIRST) OR 449 (SA5 /= THIRD_INDEX'FIRST) THEN 450 REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'FIRST " & 451 "- FUNCTION") ; 452 END IF ; 453 454 IF (FA2 /= FIRST_INDEX'LAST) OR 455 (FA4 /= SECOND_INDEX'LAST) OR 456 (SA2 /= FIRST_INDEX'LAST) OR 457 (SA4 /= SECOND_INDEX'LAST) OR 458 (SA6 /= THIRD_INDEX'LAST) THEN 459 REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LAST " & 460 "- FUNCTION") ; 461 END IF ; 462 463 IF (FAL1 /= FIRST_INDEX_LENGTH) OR 464 (FAL2 /= SECOND_INDEX_LENGTH) OR 465 (SAL1 /= FIRST_INDEX_LENGTH) OR 466 (SAL2 /= SECOND_INDEX_LENGTH) OR 467 (SAL3 /= THIRD_INDEX_LENGTH) THEN 468 REPORT.FAILED ("INCORRECT VALUE RETURNED FOR 'LENGTH " & 469 "- FUNCTION") ; 470 END IF ; 471 472 FOR OUTER_INDEX IN FIRST_ARRAY'RANGE (1) LOOP 473 FOR INNER_INDEX IN FIRST_ARRAY'RANGE (2) LOOP 474 FIRST_ARRAY (OUTER_INDEX, INNER_INDEX) := 475 SECOND_DEFAULT_VALUE ; 476 END LOOP ; 477 END LOOP ; 478 479 IF FIRST_ARRAY /= THIRD_ARRAY THEN 480 REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & 481 "FOR 2-DIMENSIONAL ARRAY. - FUNCTION") ; 482 END IF ; 483 484 FOR OUTER_INDEX IN SECOND_ARRAY'RANGE (1) LOOP 485 FOR MIDDLE_INDEX IN SECOND_ARRAY'RANGE (2) LOOP 486 FOR INNER_INDEX IN SECOND_ARRAY'RANGE (3) LOOP 487 SECOND_ARRAY (OUTER_INDEX, MIDDLE_INDEX, INNER_INDEX) 488 := FOURTH_DEFAULT_VALUE ; 489 END LOOP ; 490 END LOOP ; 491 END LOOP ; 492 493 IF SECOND_ARRAY /= FOURTH_ARRAY THEN 494 REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & 495 "FOR 3-DIMENSIONAL ARRAY. - FUNCTION") ; 496 END IF ; 497 498 IF (FIRST_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (1)) OR 499 (FIRST_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (1)) OR 500 (SECOND_TEST_VALUE NOT IN FIRST_ARRAY'RANGE (2)) OR 501 (SECOND_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (2)) OR 502 (THIRD_TEST_VALUE NOT IN SECOND_ARRAY'RANGE (3)) THEN 503 REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE ATTRIBUTE " & 504 "- FUNCTION") ; 505 END IF ; 506 507 IF (MATRIX_SIZE = 0) OR (CUBE_SIZE = 0) THEN 508 REPORT.FAILED ("INCORRECT HANDLING OF THE 'SIZE ATTRIBUTE. " & 509 "- FUNCTION") ; 510 END IF ; 511 512 IF (FAA = TAA) OR (SAA = FRAA) OR (FAA = SAA) OR (FAA = FRAA) 513 OR (SAA = TAA) OR (TAA = FRAA) THEN 514 REPORT.FAILED ("INCORRECT HANDLING OF THE 'ADDRESS ATTRIBUTE. " & 515 "- FUNCTION") ; 516 END IF ; 517 518 RETURN TRUE ; 519 520 END FUNC_ARRAY_ATT_TEST ; 521 522 523BEGIN -- C36204D 524 525 REPORT.TEST ("C36204D", "ARRAY ATTRIBUTES RETURN CORRECT " & 526 "VALUES WITHIN GENERIC PROGRAM UNITS.") ; 527 528 LOCAL_BLOCK: 529 530 DECLARE 531 532 DUMMY : BOOLEAN := FALSE ; 533 534 PACKAGE NEW_ARRAY_ATTRIBUTE_TEST IS NEW ARRAY_ATTRIBUTE_TEST ( 535 FIRST_INDEX => SHORT_RANGE, 536 FIRST_INDEX_LENGTH => SHORT_LENGTH, 537 FIRST_TEST_VALUE => -7, 538 SECOND_INDEX => MONTH_TYPE, 539 SECOND_INDEX_LENGTH => 12, 540 SECOND_TEST_VALUE => AUG, 541 THIRD_INDEX => BOOLEAN, 542 THIRD_INDEX_LENGTH => 2, 543 THIRD_TEST_VALUE => FALSE, 544 FIRST_COMPONENT_TYPE => MONTH_TYPE, 545 FIRST_DEFAULT_VALUE => JAN, 546 SECOND_DEFAULT_VALUE => DEC, 547 SECOND_COMPONENT_TYPE => DATE, 548 THIRD_DEFAULT_VALUE => TODAY, 549 FOURTH_DEFAULT_VALUE => FIRST_DATE) ; 550 551 PROCEDURE NEW_PROC_ARRAY_ATT_TEST IS NEW PROC_ARRAY_ATT_TEST ( 552 FIRST_INDEX => MONTH_TYPE, 553 FIRST_INDEX_LENGTH => 12, 554 FIRST_TEST_VALUE => AUG, 555 SECOND_INDEX => SHORT_RANGE, 556 SECOND_INDEX_LENGTH => SHORT_LENGTH, 557 SECOND_TEST_VALUE => -7, 558 THIRD_INDEX => BOOLEAN, 559 THIRD_INDEX_LENGTH => 2, 560 THIRD_TEST_VALUE => FALSE, 561 FIRST_COMPONENT_TYPE => DATE, 562 FIRST_DEFAULT_VALUE => TODAY, 563 SECOND_DEFAULT_VALUE => FIRST_DATE, 564 SECOND_COMPONENT_TYPE => MONTH_TYPE, 565 THIRD_DEFAULT_VALUE => JAN, 566 FOURTH_DEFAULT_VALUE => DEC) ; 567 568 FUNCTION NEW_FUNC_ARRAY_ATT_TEST IS NEW FUNC_ARRAY_ATT_TEST ( 569 FIRST_INDEX => DAY_TYPE, 570 FIRST_INDEX_LENGTH => 31, 571 FIRST_TEST_VALUE => 25, 572 SECOND_INDEX => SHORT_RANGE, 573 SECOND_INDEX_LENGTH => SHORT_LENGTH, 574 SECOND_TEST_VALUE => -7, 575 THIRD_INDEX => MID_YEAR, 576 THIRD_INDEX_LENGTH => 4, 577 THIRD_TEST_VALUE => JUL, 578 FIRST_COMPONENT_TYPE => DATE, 579 FIRST_DEFAULT_VALUE => TODAY, 580 SECOND_DEFAULT_VALUE => FIRST_DATE, 581 SECOND_COMPONENT_TYPE => MONTH_TYPE, 582 THIRD_DEFAULT_VALUE => JAN, 583 FOURTH_DEFAULT_VALUE => DEC) ; 584 585 BEGIN -- LOCAL_BLOCK 586 587 NEW_PROC_ARRAY_ATT_TEST ; 588 589 DUMMY := NEW_FUNC_ARRAY_ATT_TEST ; 590 IF NOT DUMMY THEN 591 REPORT.FAILED ("WRONG VALUE RETURNED BY FUNCTION.") ; 592 END IF ; 593 594 END LOCAL_BLOCK ; 595 596 REPORT.RESULT ; 597 598END C36204D ; 599