old-autovect-branch/gcc/testsuite/ada/acats/tests/c5/c52104a.ada

   1 -- C52104A.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  A : STATICALLY-DETERMINABLE NON-NULL LENGTHS.
  33
  34
  35 -- RM 07/20/81
  36 -- SPS 3/22/83
  37
  38 WITH REPORT;
  39 PROCEDURE  C52104A  IS
  40
  41      USE  REPORT ;
  42
  43 BEGIN
  44
  45      TEST( "C52104A" , "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 DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
 137      --        VISIONS C (FOR NON-NULL ARRAYS) AND D (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( 1..5 ,  0..7  );
 160           SUBTYPE  TABOX02  IS  TABOX0( 0..5 ,  2..9  );
 161
 162           ARRX01  :  TABOX01 ;
 163           ARRX02  :  TABOX02 ;
 164
 165      BEGIN
 166
 167           -- INITIALIZATION OF RHS ARRAY:
 168
 169           FOR  I  IN  1..5  LOOP
 170
 171                FOR  J  IN  0..7  LOOP
 172                     ARRX01( I , J )  :=   I * I * J  ;
 173                END LOOP;
 174
 175           END LOOP;
 176
 177
 178           -- INITIALIZATION OF LHS ARRAY:
 179
 180           FOR  I  IN  0..5  LOOP
 181
 182                FOR  J  IN  2..9  LOOP
 183                     ARRX02( I , J )  :=   I * I * J * 3  ;
 184                END LOOP;
 185
 186           END LOOP;
 187
 188
 189           -- ARRAY ASSIGNMENT:
 190
 191           ARRX02 := ARRX01 ;
 192           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
 193
 194      EXCEPTION
 195
 196           WHEN  CONSTRAINT_ERROR =>
 197
 198                -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
 199
 200                FOR  I  IN  0..5  LOOP
 201
 202                     FOR  J  IN  2..9  LOOP
 203
 204                          IF  ARRX02( I , J )  /=   I * I * J * 3
 205                          THEN
 206                               FAILED( "ORIG. VALUE ALTERED (10)" );
 207                          END IF;
 208
 209                     END LOOP;
 210
 211                END LOOP;
 212
 213           WHEN  OTHERS  =>
 214                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
 215
 216      END ;
 217
 218
 219      -------------------------------------------------------------------
 220
 221      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
 222      --        WERE DEFINED USING THE "BOX" SYMBOL
 223      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
 224      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
 225
 226      DECLARE
 227
 228           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
 229
 230           SUBTYPE  TABOX11  IS  TABOX1( 1..5 ) ;
 231
 232           ARRX11  :  TABOX11 ;
 233           ARRX12  :  TABOX1( 6..9 );
 234
 235      BEGIN
 236
 237           -- INITIALIZATION OF RHS ARRAY:
 238
 239           FOR  I  IN  1..5  LOOP
 240
 241                ARRX11( I )  :=   I * I  ;
 242
 243           END LOOP;
 244
 245
 246           -- INITIALIZATION OF LHS ARRAY:
 247
 248           FOR  I  IN  6..9  LOOP
 249                ARRX12( I )  :=   I * I * 3  ;
 250           END LOOP;
 251
 252
 253           -- ARRAY ASSIGNMENT:
 254
 255           ARRX12 := ARRX11 ;
 256           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
 257
 258      EXCEPTION
 259
 260           WHEN  CONSTRAINT_ERROR =>
 261
 262                -- CHECKING THE VALUES AFTER THE ARRAY ASSIGNMENT:
 263
 264                FOR  I  IN  6..9  LOOP
 265
 266                     IF  ARRX12( I )  /=   I * I * 3
 267                     THEN
 268                          FAILED( "ORIG. VALUE ALTERED (11)" );
 269                     END IF;
 270
 271                END LOOP;
 272
 273           WHEN  OTHERS  =>
 274                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
 275
 276      END ;
 277
 278
 279      -------------------------------------------------------------------
 280
 281      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
 282      --        WERE DEFINED USING THE "BOX" SYMBOL
 283      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
 284      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
 285
 286      DECLARE
 287
 288           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
 289
 290           SUBTYPE  TABOX51  IS  TABOX5( 1..5 );
 291
 292           ARRX51  :  TABOX51 ;
 293           ARRX52  :  TABOX5( 5..9 );
 294
 295      BEGIN
 296
 297           -- INITIALIZATION OF LHS ARRAY:
 298
 299           FOR  I  IN  5..9  LOOP
 300                ARRX52( I )  :=  FALSE  ;
 301           END LOOP;
 302
 303
 304           -- INITIALIZATION OF RHS ARRAY:
 305
 306           FOR  I  IN  1..5  LOOP
 307                ARRX51( I )  :=  TRUE  ;
 308           END LOOP;
 309
 310
 311           -- SLICE ASSIGNMENT:
 312
 313           ARRX52(6..9) := ARRX51(3..3) ;
 314           FAILED( "EXCEPTION NOT RAISED  (12)" );
 315
 316      EXCEPTION
 317
 318           WHEN CONSTRAINT_ERROR =>
 319
 320                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
 321
 322                FOR  I  IN  5..9  LOOP
 323
 324                     IF  ARRX52( I )  /=  FALSE
 325                     THEN
 326                          FAILED( "LHS ARRAY ALTERED  ( 12 ) " );
 327                     END IF;
 328
 329                END LOOP;
 330
 331           WHEN  OTHERS  =>
 332                FAILED( "EXCEPTION RAISED  -  SUBTEST 12" );
 333
 334      END ;
 335
 336
 337      -------------------------------------------------------------------
 338
 339
 340      RESULT ;
 341
 342
 343 END C52104A;