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

   1 -- C52104P.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  D : NULL LENGTHS NOT DETERMINABLE STATICALLY.
  33
  34
  35 -- RM 07/20/81
  36
  37
  38 WITH REPORT;
  39 PROCEDURE  C52104P  IS
  40
  41      USE  REPORT ;
  42
  43 BEGIN
  44
  45      TEST( "C52104P" , "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
 136
 137      -------------------------------------------------------------------
 138
 139      --    (1 .. 6: NOT APPLICABLE)
 140      --
 141      --
 142
 143      -------------------------------------------------------------------
 144
 145      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
 146      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
 147      --        (TWO-DIMENSIONAL ARRAYS OF INTEGERS.)
 148
 149      DECLARE
 150
 151           TYPE  TABOX0  IS  ARRAY( INTEGER RANGE <> , INTEGER RANGE <>
 152                                  )  OF INTEGER ;
 153
 154           SUBTYPE  TABOX01  IS  TABOX0( IDENT_INT(1)..IDENT_INT(1) ,
 155                                         IDENT_INT(0)..IDENT_INT(7)  );
 156           SUBTYPE  TABOX02  IS  TABOX0 ;
 157
 158           ARRX01  :  TABOX01 ;
 159           ARRX02  :  TABOX02( IDENT_INT(1)..IDENT_INT(0) ,
 160                               IDENT_INT(0)..IDENT_INT(7) );
 161
 162      BEGIN
 163
 164           -- ARRAY ASSIGNMENT:
 165
 166           ARRX02 := ARRX01 ;
 167           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 10" );
 168
 169      EXCEPTION
 170
 171           WHEN  CONSTRAINT_ERROR =>
 172
 173                NULL ;
 174
 175           WHEN  OTHERS  =>
 176
 177                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 10" );
 178
 179      END ;
 180
 181
 182      -------------------------------------------------------------------
 183
 184      --   (11) UNSLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
 185      --        WERE DEFINED USING THE "BOX" SYMBOL
 186      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
 187      --        ((ONE-DIMENSIONAL) ARRAYS OF INTEGERS.)
 188
 189      DECLARE
 190
 191           TYPE  TABOX1  IS  ARRAY( INTEGER RANGE <> )  OF INTEGER ;
 192
 193           SUBTYPE  TABOX11  IS  TABOX1( IDENT_INT(4)..IDENT_INT(5) ) ;
 194
 195           ARRX11  :  TABOX11 ;
 196           ARRX12  :  TABOX1( IDENT_INT(5)..IDENT_INT(4) );
 197
 198      BEGIN
 199
 200           -- ARRAY ASSIGNMENT:
 201
 202           ARRX12 := ARRX11 ;
 203           FAILED( "EXCEPTION NOT RAISED  -  SUBTEST 11" );
 204
 205      EXCEPTION
 206
 207           WHEN  CONSTRAINT_ERROR =>
 208
 209                NULL ;
 210
 211           WHEN  OTHERS  =>
 212
 213                FAILED( "WRONG EXCEPTION RAISED  -  SUBTEST 11" );
 214
 215      END ;
 216
 217
 218      -------------------------------------------------------------------
 219
 220      --   (12) SLICED ONE-DIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS
 221      --        WERE DEFINED USING THE "BOX" SYMBOL
 222      --        AND FOR WHICH THE COMPONENT TYPE IS NOT  'CHARACTER' .
 223      --        ((ONE-DIMENSIONAL) ARRAYS OF BOOLEANS.)
 224
 225      DECLARE
 226
 227           TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> )  OF BOOLEAN ;
 228
 229           SUBTYPE  TABOX51  IS  TABOX5( IDENT_INT(1)..IDENT_INT(5) );
 230
 231           ARRX51  :  TABOX51 ;
 232           ARRX52  :  TABOX5( IDENT_INT(5)..IDENT_INT(9) );
 233
 234      BEGIN
 235
 236           -- INITIALIZATION OF RHS ARRAY:
 237
 238           FOR  I  IN  IDENT_INT(1)..IDENT_INT(5)  LOOP
 239                ARRX51( I )  :=  FALSE  ; -- VALUES WILL BE:  F T F F T
 240           END LOOP;
 241
 242           ARRX51(2) := TRUE ;
 243
 244           ARRX51(5) := TRUE ;            -- RHS VALUES ARE:  F T F F T
 245
 246
 247           -- INITIALIZATION OF LHS ARRAY:
 248
 249           FOR  I  IN  IDENT_INT(5)..IDENT_INT(9)  LOOP
 250                ARRX52( I )  :=  TRUE   ; -- VALUES WILL BE:  T F T T F
 251           END LOOP;
 252
 253           ARRX52(6) := FALSE ;
 254
 255           ARRX52(9) := FALSE ;           -- LHS VALUES ARE:  T F T T F
 256
 257
 258           -- NULL SLICE ASSIGNMENT:
 259
 260           ARRX52( IDENT_INT(6)..IDENT_INT(5) ) :=
 261                ARRX51
 262                 ( IDENT_INT(4)..IDENT_INT(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 C52104P;