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

   1 -- C52104F.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 ELSWEWHERE.)
  31
  32 --    DIVISION  B : STATICALLY-DETERMINABLE NULL LENGTHS.
  33
  34
  35 -- RM 07/20/81
  36 -- SPS 10/27/82
  37
  38 WITH REPORT;
  39 PROCEDURE  C52104F  IS
  40
  41      USE  REPORT ;
  42
  43 BEGIN
  44
  45      TEST( "C52104F" , "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:  SUPERLONG ARRAYS.. (TREATED FOR DYNAMIC
 131      --                                            ARRAYS ONLY,
 132      --                                            DIVISIONS C AND D .)
 133      --
 134      --
 135      --    (-) THE DYNAMIC-ARRAY COUNTERPARTS OF THESE TESTS ARE IN DI-
 136      --        VISIONS C (FOR NON-NULL ARRAYS) AND D (FOR NULL ARRAYS).
 137      --
 138      --
 139
 140
 141      -------------------------------------------------------------------
 142
 143      --    (1 .. 6: NOT APPLICABLE)
 144      --
 145      --
 146
 147      -------------------------------------------------------------------
 148
 149      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
 150      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
 151      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
 152
 153      DECLARE
 154
 155           TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
 156                                  )  OF INTEGER ;
 157
 158           SUBTYPE  TABOX01  IS  TABOX0( 1..1 ,  0..7  );
 159           SUBTYPE  TABOX02  IS  TABOX0 ;
 160
 161           ARRX01  :  TABOX01 ;
 162           ARRX02  :  TABOX02( 1..0 , 0..7 );
 163
 164      BEGIN
 165
 166           -- ARRAY ASSIGNMENT:
 167
 168           ARRX02 := ARRX01 ;
 169           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
 170
 171      EXCEPTION
 172
 173           WHEN  CONSTRAINT_ERROR =>
 174
 175                NULL ;
 176
 177           WHEN  OTHERS  =>
 178
 179                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
 180
 181      END ;
 182
 183
 184      -------------------------------------------------------------------
 185
 186      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
 187      --        WERE DEFINED USING THE "BOX" SYMBOL
 188      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
 189      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
 190
 191      DECLARE
 192
 193           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
 194
 195           SUBTYPE  TABOX11  IS  TABOX1( 4..5 ) ;
 196
 197           ARRX11  :  TABOX11 ;
 198           ARRX12  :  TABOX1( 5..4 );
 199
 200      BEGIN
 201
 202           -- ARRAY ASSIGNMENT:
 203
 204           ARRX12 := ARRX11 ;
 205           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
 206
 207      EXCEPTION
 208
 209           WHEN  CONSTRAINT_ERROR =>
 210
 211                NULL ;
 212
 213           WHEN  OTHERS  =>
 214
 215                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
 216
 217      END ;
 218
 219
 220      -------------------------------------------------------------------
 221
 222      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
 223      --        WERE DEFINED USING THE "BOX" SYMBOL
 224      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
 225      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
 226
 227      DECLARE
 228
 229           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
 230
 231           SUBTYPE  TABOX51  IS  TABOX5( 1..5 );
 232
 233           ARRX51  :  TABOX51 ;
 234           ARRX52  :  TABOX5( 5..9 );
 235
 236      BEGIN
 237
 238           -- INITIALIZATION OF RHS ARRAY:
 239
 240           FOR  I  IN  1..5  LOOP
 241                ARRX51( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
 242           END LOOP;
 243
 244           ARRX51(2) := TRUE ;
 245
 246           ARRX51(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
 247
 248
 249           -- INITIALIZATION OF LHS ARRAY:
 250
 251           FOR  I  IN  5..9  LOOP
 252                ARRX52( I )  :=  TRUE   ; -- VALUES WILL BE:  T F T T F
 253           END LOOP;
 254
 255           ARRX52(6) := FALSE ;
 256
 257           ARRX52(9) := FALSE ;           -- LHS VALUES ARE:  T F T T F
 258
 259
 260           -- NULL SLICE ASSIGNMENT:
 261
 262           ARRX52( 6..5 ) := ARRX51( 4..4 ) ;
 263           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 12" );
 264
 265      EXCEPTION
 266
 267           WHEN  CONSTRAINT_ERROR =>
 268
 269                -- CHECKING THE VALUES AFTER THE SLICE ASSIGNMENT:
 270                IF  ARRX52( 5 )  /=  TRUE   OR
 271                    ARRX52( 6 )  /=  FALSE  OR
 272                    ARRX52( 7 )  /=  TRUE   OR
 273                    ARRX52( 8 )  /=  TRUE   OR
 274                    ARRX52( 9 )  /=  FALSE
 275                THEN
 276                     FAILED( "LHS ARRAY ALTERED  (12)" );
 277                END IF;
 278
 279           WHEN  OTHERS =>
 280
 281                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 12" );
 282
 283      END ;
 284
 285
 286      -------------------------------------------------------------------
 287
 288
 289      RESULT ;
 290
 291
 292 END C52104F;