gcc/testsuite/ada/acats/tests/c5/c52104k.ada

   1 -- C52104K.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
  26 --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
  27 --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
  28 --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
  29 --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
  30 --    ARE TREATED ELSEWHERE.)
  31
  32 --    DIVISION  C :  NON-NULL LENGTHS NOT DETERMINABLE STATICALLY.
  33
  34
  35 -- RM 07/20/81
  36 -- SPS 3/22/83
  37
  38 WITH REPORT;
  39 PROCEDURE  C52104K  IS
  40
  41      USE  REPORT ;
  42
  43 BEGIN
  44
  45      TEST( "C52104K" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
  46                        " ASSIGNMENTS  THE LENGTHS MUST MATCH" );
  47
  48
  49      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
  50      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
  51      --
  52      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
  53      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
  54
  55
  56      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
  57      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
  58      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
  59      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
  60      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
  61      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
  62      --    INTEGER , CHARACTER , BOOLEAN .)
  63
  64
  65      -- CASES DISTINGUISHED:         ( 8 SELECTED CASES ARE IMPLEMENTED)
  66      --
  67      --                              ( THE 8 SELECTIONS ARE THE 5-CASE
  68      --                                SERIES 10-11-12-13-14 FOLLOWED
  69      --                                BY  7 , 8 , 9 (IN THIS ORDER). )
  70      --
  71      --
  72      --                              ( EACH DIVISION COMPRISES 3 FILES,
  73      --                                COVERING RESPECTIVELY THE FIRST
  74      --                                3 , NEXT 2 , AND LAST 3 OF THE 8
  75      --                                SELECTIONS FOR THE DIVISION.)
  76      --
  77      --
  78      --    (1..6) (DO NOT APPLY TO NON-MATCHING OBJECTS, SINCE WE WANT
  79      --        THE OBJECTS TO HAVE THE   S A M E   BASE TYPE.)
  80      --
  81      --
  82      --    (7) UNSLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
  83      --        THEMSELVES).
  84      --
  85      --
  86      --    (8) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING' , WITH
  87      --        STRING LITERALS.
  88      --
  89      --
  90      --    (9) SLICED OBJECTS OF THE PREDEFINED TYPE  'STRING'  (BY
  91      --        THEMSELVES).
  92      --
  93      --
  94      --    (-) CONSTRAINABLE TYPES:  ONLY SUBTESTS   2,  3,  4,  5,  6
  95      --        WILL BE REPLICATED  --  AS SUBTESTS  10, 11, 12, 13, 14 .
  96      --
  97      --
  98      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
  99      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
 100      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
 101      --
 102      --
 103      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
 104      --        WERE DEFINED USING THE "BOX" SYMBOL
 105      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
 106      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
 107      --
 108      --
 109      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
 110      --        WERE DEFINED USING THE "BOX" SYMBOL
 111      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
 112      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
 113      --
 114      --
 115      --   (13) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
 116      --        WERE DEFINED USING THE "BOX" SYMBOL
 117      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
 118      --
 119      --        (STRING LITERALS ARE THE ONLY AGGREGATES WE ARE USING
 120      --        IN THIS TEST.  TO FORCE SLIDING, THE LOWER LIMIT IMPLIED
 121      --        BY THE TYPEMARK WILL NOT BE  1 .)
 122      --
 123      --
 124      --   (14) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
 125      --        WERE DEFINED USING THE "BOX" SYMBOL
 126      --        AND FOR WHICH THE COMPONENT TYPE IS  'CHARACTER' .
 127      --
 128      --
 129      --
 130      --    (-) SPECIAL CASES:  NULL ARRAYS....... TREATED IN DIVISION B.
 131      --                        SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
 132      --                                            ARRAYS ONLY,
 133      --                                            DIVISIONS C AND D .)
 134      --
 135      --
 136      --    (-) THE STATIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
 137      --        VISIONS A (FOR NON-NULL ARRAYS) AND B (FOR NULL ARRAYS).
 138      --
 139      --
 140
 141
 142      -------------------------------------------------------------------
 143
 144      --    (1..6: NOT APPLICABLE)
 145      --
 146      --
 147
 148      -------------------------------------------------------------------
 149
 150      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
 151      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
 152      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
 153
 154      DECLARE
 155
 156           TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
 157                                  )  OF INTEGER ;
 158
 159           SUBTYPE  TABOX01  IS  TABOX0( IDENT_INT(1)..IDENT_INT(5) ,
 160                                         IDENT_INT(0)..IDENT_INT(7) );
 161           SUBTYPE  TABOX02  IS  TABOX0( IDENT_INT(0)..IDENT_INT(5) ,
 162                                         IDENT_INT(2)..IDENT_INT(9) );
 163
 164           ARRX01  :  TABOX01 ;
 165           ARRX02  :  TABOX02 ;
 166
 167      BEGIN
 168
 169           -- INITIALIZATION OF RHS ARRAY:
 170
 171           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
 172
 173                FOR  J  IN  IDENT_INT(0)..IDENT_INT(7)  LOOP
 174                     ARRX01( I , J )  :=   I * I * J  ;
 175                END LOOP;
 176
 177           END LOOP;
 178
 179
 180           -- INITIALIZATION OF LHS ARRAY:
 181
 182           FOR  I  IN  IDENT_INT(0)..IDENT_INT(5)  LOOP
 183
 184                FOR  J  IN  IDENT_INT(2)..IDENT_INT(9)  LOOP
 185                     ARRX02( I , J )  :=   I * I * J * 3  ;
 186                END LOOP;
 187
 188           END LOOP;
 189
 190
 191           -- ARRAY ASSIGNMENT:
 192
 193           ARRX02 := ARRX01 ;
 194           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
 195
 196      EXCEPTION
 197
 198           WHEN  CONSTRAINT_ERROR =>
 199
 200                -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
 201
 202                FOR  I  IN  IDENT_INT(0)..IDENT_INT(5)  LOOP
 203
 204                     FOR  J  IN  IDENT_INT(2)..IDENT_INT(9)  LOOP
 205
 206                          IF  ARRX02( I , J )  /=   I * I * J * 3
 207                          THEN
 208                               FAILED( "ORIG. VALUE ALTERED (10)" );
 209                          END IF;
 210
 211                     END LOOP;
 212
 213                END LOOP;
 214
 215           WHEN  OTHERS  =>
 216                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
 217
 218      END ;
 219
 220
 221      -------------------------------------------------------------------
 222
 223      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
 224      --        WERE DEFINED USING THE "BOX" SYMBOL
 225      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
 226      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
 227
 228      DECLARE
 229
 230           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
 231
 232           SUBTYPE  TABOX11  IS  TABOX1( IDENT_INT(1)..IDENT_INT(5) ) ;
 233
 234           ARRX11  :  TABOX11 ;
 235           ARRX12  :  TABOX1( IDENT_INT(6)..IDENT_INT(9) );
 236
 237      BEGIN
 238
 239           -- INITIALIZATION OF RHS ARRAY:
 240
 241           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
 242
 243                ARRX11( I )  :=   I * I  ;
 244
 245           END LOOP;
 246
 247
 248           -- INITIALIZATION OF LHS ARRAY:
 249
 250           FOR  I  IN  IDENT_INT(6)..IDENT_INT(9)  LOOP
 251                ARRX12( I )  :=   I * I * 3  ;
 252           END LOOP;
 253
 254
 255           -- ARRAY ASSIGNMENT:
 256
 257           ARRX12 := ARRX11 ;
 258           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
 259
 260      EXCEPTION
 261
 262           WHEN  CONSTRAINT_ERROR =>
 263
 264                -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
 265
 266                FOR  I  IN  IDENT_INT(6)..IDENT_INT(9)  LOOP
 267
 268                     IF  ARRX12( I )  /=   I * I * 3
 269                     THEN
 270                          FAILED( "ORIG. VALUE ALTERED (11)" );
 271                     END IF;
 272
 273                END LOOP;
 274
 275           WHEN  OTHERS  =>
 276                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
 277
 278      END ;
 279
 280
 281      -------------------------------------------------------------------
 282
 283      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
 284      --        WERE DEFINED USING THE "BOX" SYMBOL
 285      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
 286      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
 287
 288      DECLARE
 289
 290           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
 291
 292           SUBTYPE  TABOX51  IS  TABOX5( IDENT_INT(1)..IDENT_INT(5) );
 293
 294           ARRX51  :  TABOX51 ;
 295           ARRX52  :  TABOX5( IDENT_INT(5)..IDENT_INT(9) );
 296
 297      BEGIN
 298
 299           -- INITIALIZATION OF LHS ARRAY:
 300
 301           FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
 302                ARRX52( I )  :=  FALSE  ;
 303           END LOOP;
 304
 305
 306           -- INITIALIZATION OF RHS ARRAY:
 307
 308           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
 309                ARRX51( I )  :=  TRUE  ;
 310           END LOOP;
 311
 312
 313           -- SLICE ASSIGNMENT:
 314
 315           ARRX52( IDENT_INT(6)..IDENT_INT(9) ) :=
 316                ARRX51(
 317                   IDENT_INT(3)..IDENT_INT(3) ) ;
 318           FAILED( "EXCEPTION NOT RAISED  (12)" );
 319
 320      EXCEPTION
 321
 322           WHEN CONSTRAINT_ERROR =>
 323
 324                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
 325
 326                FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
 327
 328                     IF  ARRX52( I )  /=  FALSE
 329                     THEN
 330                          FAILED( "LHS ARRAY ALTERED  ( 12 ) " );
 331                     END IF;
 332
 333                END LOOP;
 334
 335           WHEN  OTHERS  =>
 336                FAILED( "EXCEPTION RAISED  -  SUBTEST 12" );
 337
 338      END ;
 339
 340
 341      -------------------------------------------------------------------
 342
 343
 344      RESULT ;
 345
 346
 347 END C52104K;