gcc/testsuite/ada/acats/tests/c3/c36204d.ada

   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
  32 WITH REPORT ;
  33 WITH SYSTEM ;
  34
  35 PROCEDURE 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
 523 BEGIN -- 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
 598 END C36204D ;