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

   1 -- C52102C.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 THE ASSIGNMENT OF OVERLAPPING SOURCE AND TARGET VARIABLES
  26 --    (INCLUDING ARRAYS AND SLICES IN VARIOUS COMBINATIONS) SATISFIES
  27 --    THE SEMANTICS OF "COPY" ASSIGNMENT WHEN INITIAL ASSIGNMENT VALUES
  28 --    REQUIRE RUN-TIME EVALUATION.   (THIS TEST IS IN TWO PARTS,
  29 --    COVERING RESPECTIVELY STATIC AND DYNAMIC BOUNDS.)
  30
  31 -- PART 1:  STATIC BOUNDS
  32
  33
  34 -- RM 02/25/80
  35 -- SPS 2/18/83
  36 -- JBG 8/21/83
  37 -- JBG 5/8/84
  38 -- JBG 6/09/84
  39 -- BHS 6/26/84
  40
  41 WITH REPORT;
  42 PROCEDURE  C52102C  IS
  43
  44      USE  REPORT;
  45
  46      FUNCTION ID_I (X : INTEGER) RETURN INTEGER RENAMES IDENT_INT;
  47      FUNCTION ID_B (X : BOOLEAN) RETURN BOOLEAN RENAMES IDENT_BOOL;
  48
  49 BEGIN
  50
  51
  52      TEST( "C52102C" , "CHECK THAT THE ASSIGNMENT OF OVERLAPPING " &
  53                        "SOURCE AND TARGET VARIABLES (INCLUDING " &
  54                        "ARRAYS AND SLICES IN VARIOUS COMBINATIONS) " &
  55                        "SATISFIES THE SEMANTICS OF ""COPY"" " &
  56                        "ASSIGNMENT WHEN INITIAL ASSIGNMENT VALUES " &
  57                        "ARE DYNAMIC  (PART 1: STATIC BOUNDS)" );
  58
  59
  60      -------------------------------------------------------------------
  61      --------------------  ARRAYS OF INTEGERS  -------------------------
  62
  63      DECLARE
  64           A   :    ARRAY( 1..4 ) OF INTEGER;
  65
  66      BEGIN
  67           A   :=   (  ID_I(11),  ID_I(12),  ID_I(13),  ID_I(14));
  68           A   :=   (  1   , A(1) , A(2) , A(1) );
  69           IF  A /= (  1   ,  11  ,  12  ,  11  )  THEN
  70                FAILED( "WRONG VALUES  -  I1" );
  71           END IF;
  72
  73           A   :=   (  ID_I(11),  ID_I(12),  ID_I(13),  ID_I(14));
  74           A   :=   ( A(4) , A(3) , A(4) ,  1   );
  75           IF  A /= (  14  ,  13  ,  14  ,  1   )  THEN
  76                FAILED( "WRONG VALUES  -  I2" );
  77           END IF;
  78
  79      END;
  80
  81
  82      DECLARE
  83           A   :    ARRAY( INTEGER RANGE -4..4 ) OF INTEGER;
  84
  85      BEGIN
  86           A   :=  ( -ID_I(4), -ID_I(3), -ID_I(2), -ID_I(1),
  87                      ID_I(100), ID_I(1),ID_I(2), ID_I(3), ID_I(4) );
  88           A(-4..0)  :=  A(0..4);
  89           IF    A   /=  ( 100 ,  1 ,  2 ,  3 ,  4  , 1 , 2 , 3 , 4 )
  90           THEN
  91                FAILED( "WRONG VALUES  -  I3" );
  92           END IF;
  93
  94           A   :=  ( -ID_I(4), -ID_I(3), -ID_I(2), -ID_I(1),
  95                ID_I(100),  ID_I(1), ID_I(2),  ID_I(3),  ID_I(4) );
  96           A(0..4)   :=  A(-4..0);
  97           IF    A   /=  ( -4 , -3 , -2 , -1 , -4  , -3 , -2 , -1 , 100 )
  98           THEN
  99                FAILED( "WRONG VALUES  -  I4" );
 100           END IF;
 101
 102      END;
 103
 104
 105      DECLARE
 106           TYPE INT_ARR IS ARRAY (INTEGER RANGE <>) OF INTEGER;
 107           A  :  INT_ARR (1..10);
 108
 109      BEGIN
 110           A   :=  ( ID_I(1), ID_I(2), ID_I(3), ID_I(4), ID_I(5),
 111                      ID_I(6), ID_I(7), ID_I(8), ID_I(9), ID_I(10) );
 112           A   :=  0  &  A(1..2)  &  A(1..2)  &  A(1..5);
 113           IF   A  /=  ( 0 , 1 , 2 , 1 , 2 , 1 , 2 , 3 , 4 , 5  )
 114           THEN
 115                FAILED( "WRONG VALUES  -  I5" );
 116           END IF;
 117
 118           A   :=  ( ID_I(1), ID_I(2), ID_I(3), ID_I(4), ID_I(5),
 119                     ID_I(6), ID_I(7), ID_I(8), ID_I(9), ID_I(10) );
 120           A   :=  A(6..9)  &  A(8..9)  &  A(8..9)  &  0  &  0;
 121           IF   A  /=  ( 6 , 7 , 8 , 9 , 8 , 9 , 8 , 9 , 0 , 0  )
 122           THEN
 123                FAILED( "WRONG VALUES  -  I6" );
 124           END IF;
 125
 126      END;
 127
 128
 129      -------------------------------------------------------------------
 130      --------------------  ARRAYS OF BOOLEANS  -------------------------
 131
 132      DECLARE
 133           A   :    ARRAY( 1..4 ) OF BOOLEAN;
 134
 135      BEGIN
 136           A   :=   (ID_B(FALSE), ID_B(TRUE), ID_B(TRUE), ID_B(FALSE));
 137           A   :=   (  TRUE  , A(1) , A(2) , A(1)  );
 138           IF  A /= (  TRUE  ,FALSE , TRUE , FALSE )
 139           THEN
 140                FAILED( "WRONG VALUES  -  B1" );
 141           END IF;
 142
 143           A   :=   (ID_B(FALSE), ID_B(TRUE), ID_B(TRUE), ID_B(FALSE));
 144           A   :=   (  A(4)  , A(3) , A(4) ,  TRUE );
 145           IF  A /= (  FALSE , TRUE , FALSE,  TRUE )
 146           THEN
 147                FAILED( "WRONG VALUES  -  B2" );
 148           END IF;
 149
 150      END;
 151
 152
 153      DECLARE
 154           A   :    ARRAY( INTEGER RANGE -4..4 ) OF BOOLEAN;
 155
 156      BEGIN
 157           A   := (ID_B(FALSE), ID_B(FALSE), ID_B(FALSE), ID_B(FALSE),
 158                   ID_B(FALSE), ID_B(TRUE), ID_B(TRUE),
 159                   ID_B(TRUE), ID_B(TRUE));
 160           A(-4..0)  :=  A(0..4);
 161           IF A /= (FALSE, TRUE, TRUE, TRUE, TRUE,TRUE, TRUE, TRUE,TRUE)
 162           THEN
 163                FAILED( "WRONG VALUES  -  B3" );
 164           END IF;
 165
 166           A   := (ID_B(FALSE), ID_B(FALSE), ID_B(FALSE), ID_B(FALSE),
 167                   ID_B(TRUE), ID_B(TRUE), ID_B(TRUE),
 168                   ID_B(TRUE), ID_B(TRUE));
 169           A(0..4)   :=  A(-4..0);
 170           IF A /= (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE)
 171           THEN
 172                FAILED( "WRONG VALUES  -  B4" );
 173           END IF;
 174
 175      END;
 176
 177
 178      DECLARE
 179           TYPE B_ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
 180           A  :  B_ARR (1..10);
 181
 182      BEGIN
 183           A := (ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), ID_B(FALSE),
 184                 ID_B(TRUE), ID_B(FALSE), ID_B(TRUE),
 185                 ID_B(FALSE), ID_B(TRUE), ID_B(FALSE));
 186           A :=  FALSE  &  A(1..2)  &  A(1..2)  &  A(1..5);
 187           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
 188           THEN
 189                FAILED( "WRONG VALUES  -  B5" );
 190           END IF;
 191
 192           A := (ID_B(TRUE), ID_B(FALSE), ID_B(TRUE), ID_B(FALSE),
 193                 ID_B(TRUE), ID_B(FALSE), ID_B(TRUE),
 194                 ID_B(FALSE), ID_B(TRUE), ID_B(FALSE));
 195           A :=  A(6..9)  &  A(8..9)  &  A(8..9)  &  FALSE  &  TRUE;
 196           IF A/=(FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE,FALSE,TRUE)
 197           THEN
 198                FAILED( "WRONG VALUES  -  B6" );
 199           END IF;
 200
 201      END;
 202
 203
 204      -------------------------------------------------------------------
 205      --------------------  CHARACTER STRINGS  --------------------------
 206
 207      DECLARE
 208           A   :    STRING( 1..4 );
 209
 210      BEGIN
 211           IF EQUAL (3,3) THEN
 212                A   :=   "ARGH";
 213           END IF;
 214           A   :=   (  'Q' , A(1) , A(2) , A(1) );
 215           IF  A /= "QARA"  THEN
 216                FAILED( "WRONG VALUES  -  C1" );
 217           END IF;
 218
 219           IF EQUAL (3,3) THEN
 220                A   :=   "ARGH";
 221           END IF;
 222           A   :=   ( A(4) , A(3) , A(4) , 'X' );
 223           IF  A /= "HGHX"  THEN
 224                FAILED( "WRONG VALUES  -  C2" );
 225           END IF;
 226
 227      END;
 228
 229
 230      DECLARE
 231           A   :    STRING( 96..104 );
 232
 233      BEGIN
 234           IF EQUAL (3,3) THEN
 235                A      :=  "APHRODITE";
 236           END IF;
 237           A(96..100)  :=  A(100..104);
 238           IF  A  /=  "ODITEDITE"   THEN
 239                FAILED( "WRONG VALUES  -  C3" );
 240           END IF;
 241
 242           IF EQUAL (3,3) THEN
 243                A      :=  "APHRODITE";
 244           END IF;
 245           A(100..104) :=  A(96..100) ;
 246           IF  A  /=  "APHRAPHRO"   THEN
 247                FAILED( "WRONG VALUES  -  C4" );
 248           END IF;
 249
 250      END;
 251
 252
 253      DECLARE
 254           TYPE CH_ARR IS ARRAY (INTEGER RANGE <>) OF CHARACTER;
 255           A  :  CH_ARR (1..9);
 256
 257      BEGIN
 258           IF EQUAL (3,3) THEN
 259                A   :=  "CAMBRIDGE";
 260           END IF;
 261           A   :=  'S'  &  A(1..2)  &  A(1..2)  &  A(1..4);
 262           IF  A  /=  "SCACACAMB"  THEN
 263                FAILED( "WRONG VALUES  -  C5" );
 264           END IF;
 265
 266           IF EQUAL (3,3) THEN
 267                A   :=  "CAMBRIDGE";
 268           END IF;
 269           A   :=  A(8..8)  &  A(6..8)  &  A(6..8)  &  "EA";
 270           IF  A  /=  "GIDGIDGEA"  THEN
 271                FAILED( "WRONG VALUES  -  C6" );
 272           END IF;
 273
 274      END;
 275
 276
 277      RESULT;
 278
 279
 280 END C52102C;