gomp-20050608-branch/gcc/testsuite/ada/acats/tests/c3/c37215h.ada

   1 -- C37215H.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 -- OBJECTIVE:
  26 --      CHECK THAT IF AN INDEX CONSTRAINT DEPENDS ON A DISCRIMINANT,
  27 --      THE DISCRIMINANT VALUE IS CHECKED FOR COMPATIBILITY WHEN THE
  28 --      RECORD TYPE IS:
  29 --
  30 --           CASE D: CONSTRAINED BY DEFAULT AND THE COMPONENT IS
  31 --                   PRESENT IN THE SUBTYPE.
  32
  33 -- HISTORY:
  34 --      JBG 10/17/86  CREATED ORIGINAL TEST.
  35 --      RJW 10/13/87  CORRECTED VARIOUS CONSTRAINT ERRORS IN 'CASE D1'.
  36 --      VCL 03/30/88  CORRECTED VARIOUS CONSTRAINT ERRORS WITH TYPE
  37 --                    DECLARATIONS THROUGHOUT THE TEST.  ADDED SEQUENCE
  38 --                    NUMBERS.
  39
  40 WITH REPORT; USE REPORT;
  41 PROCEDURE C37215H IS
  42
  43      SUBTYPE SM IS INTEGER RANGE 1..10;
  44      TYPE MY_ARR IS ARRAY (SM RANGE <>) OF INTEGER;
  45
  46      SEQUENCE_NUMBER : INTEGER;
  47 BEGIN
  48      TEST ("C37215H", "THE DISCRIMINANT VALUES OF AN INDEX " &
  49                       "CONSTRAINT ARE PROPERLY CHECK FOR " &
  50                       "COMPATIBILITY WHEN THE DISCRIMINANT IS " &
  51                       "DEFINED BY DEFAULT AND THE COMPONENT IS AND " &
  52                       "IS NOT PRESENT IN THE SUBTYPE");
  53
  54 -- CASE D1: COMPONENT IS PRESENT
  55
  56      SEQUENCE_NUMBER := 1;
  57      DECLARE
  58           TYPE CONS (D3 : INTEGER := IDENT_INT(0)) IS
  59                RECORD
  60                     CASE D3 IS
  61                          WHEN -5..10 =>
  62                               C1 : MY_ARR(D3..1);
  63                          WHEN OTHERS =>
  64                               C2 : INTEGER := IDENT_INT(0);
  65                     END CASE;
  66                END RECORD;
  67      BEGIN
  68           BEGIN
  69                DECLARE
  70                     X : CONS;
  71                BEGIN
  72                     FAILED ("INDEX CHECK NOT PERFORMED - 1");
  73                     IF X /= (1, (1, 1)) THEN
  74                          COMMENT ("SHOULDN'T GET HERE");
  75                     END IF;
  76                END;
  77           EXCEPTION
  78                WHEN CONSTRAINT_ERROR =>
  79                     NULL;
  80                WHEN OTHERS =>
  81                     FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
  82           END;
  83
  84           BEGIN
  85                DECLARE
  86                     SUBTYPE SCONS IS CONS;
  87                BEGIN
  88                     DECLARE
  89                          X : SCONS;
  90                     BEGIN
  91                          FAILED ("INDEX CHECK NOT PERFORMED - 2");
  92                          IF X /= (1, (1, 1)) THEN
  93                               COMMENT ("IRRELEVANT");
  94                          END IF;
  95                     END;
  96                EXCEPTION
  97                     WHEN CONSTRAINT_ERROR =>
  98                          NULL;
  99                     WHEN OTHERS =>
 100                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2A");
 101                END;
 102           EXCEPTION
 103                WHEN OTHERS =>
 104                     FAILED ("UNEXPECTED EXCEPTION RAISED - 2B");
 105           END;
 106
 107           BEGIN
 108                DECLARE
 109                     TYPE ARR IS ARRAY (1..5) OF CONS;
 110                BEGIN
 111                     DECLARE
 112                          X : ARR;
 113                     BEGIN
 114                          FAILED ("INDEX CHECK NOT PERFORMED - 3");
 115                          IF X /= (1..5 => (1, (1, 1))) THEN
 116                               COMMENT ("IRRELEVANT");
 117                          END IF;
 118                     END;
 119                EXCEPTION
 120                     WHEN CONSTRAINT_ERROR =>
 121                          NULL;
 122                     WHEN OTHERS =>
 123                          FAILED ("UNEXPECTED EXCEPTION RAISED - 3A");
 124                END;
 125           EXCEPTION
 126                WHEN OTHERS =>
 127                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3B");
 128           END;
 129
 130           BEGIN
 131                DECLARE
 132                     TYPE NREC IS
 133                          RECORD
 134                               C1 : CONS;
 135                          END RECORD;
 136                BEGIN
 137                     DECLARE
 138                          X : NREC;
 139                     BEGIN
 140                          FAILED ("INDEX CHECK NOT PERFORMED - 4");
 141                          IF X /= (C1 => (1, (1, 1))) THEN
 142                               COMMENT ("IRRELEVANT");
 143                          END IF;
 144                     END;
 145                EXCEPTION
 146                     WHEN CONSTRAINT_ERROR =>
 147                          NULL;
 148                     WHEN OTHERS =>
 149                          FAILED ("UNEXPECTED EXCEPTION RAISED - 4A");
 150                END;
 151           EXCEPTION
 152                WHEN OTHERS =>
 153                     FAILED ("UNEXPECTED EXCEPTION RAISED - 4B");
 154           END;
 155
 156           BEGIN
 157                DECLARE
 158                     TYPE NREC IS NEW CONS;
 159                BEGIN
 160                     DECLARE
 161                          X : NREC;
 162                     BEGIN
 163                          FAILED ("INDEX CHECK NOT PERFORMED - 5");
 164                          IF X /= (1, (1, 1)) THEN
 165                               COMMENT ("IRRELEVANT");
 166                          END IF;
 167                     END;
 168                EXCEPTION
 169                     WHEN CONSTRAINT_ERROR =>
 170                          NULL;
 171                     WHEN OTHERS =>
 172                          FAILED ("UNEXPECTED EXCEPTION RAISED - 5A");
 173                END;
 174           EXCEPTION
 175                WHEN OTHERS =>
 176                     FAILED ("UNEXPECTED EXCEPTION RAISED - 5B");
 177           END;
 178
 179           BEGIN
 180                DECLARE
 181                     TYPE ACC_CONS IS ACCESS CONS;
 182                BEGIN
 183                     DECLARE
 184                          X : ACC_CONS;
 185                     BEGIN
 186                          X := NEW CONS;
 187                          FAILED ("INDEX CHECK NOT PERFORMED - 6");
 188                          IF X.ALL /= (1, (1, 1)) THEN
 189                               COMMENT ("WRONG VALUE FOR X - 6");
 190                          END IF;
 191                     EXCEPTION
 192                          WHEN CONSTRAINT_ERROR =>
 193                               NULL;
 194                          WHEN OTHERS =>
 195                               FAILED ("UNEXPECTED EXCEPTION RAISED " &
 196                                       "- 6A");
 197                     END;
 198                EXCEPTION
 199                     WHEN OTHERS =>
 200                          FAILED ("UNEXPECTED EXCEPTION RAISED - 6B");
 201                END;
 202           EXCEPTION
 203                WHEN OTHERS =>
 204                     FAILED ("UNEXPECTED EXCEPTION RAISED - 6C");
 205           END;
 206      END;
 207
 208 -- CASE D2: COMPONENT IS ABSENT
 209
 210      SEQUENCE_NUMBER := 2;
 211      DECLARE
 212           TYPE CONS (D3 : INTEGER := IDENT_INT(11)) IS
 213                RECORD
 214                     CASE D3 IS
 215                          WHEN -5..10 =>
 216                               C1 : MY_ARR(IDENT_INT(2)..D3);
 217                          WHEN OTHERS =>
 218                               C2 : INTEGER := IDENT_INT(5);
 219                     END CASE;
 220                END RECORD;
 221      BEGIN
 222           BEGIN
 223                DECLARE
 224                     X : CONS;
 225                BEGIN
 226                     IF X /= (11, 5) THEN
 227                          COMMENT ("X VALUE IS INCORRECT - 11");
 228                     END IF;
 229                END;
 230           EXCEPTION
 231                WHEN CONSTRAINT_ERROR =>
 232                     NULL;
 233                WHEN OTHERS =>
 234                     FAILED ("UNEXPECTED EXCEPTION RAISED - 11");
 235           END;
 236
 237           BEGIN
 238                DECLARE
 239                     SUBTYPE SCONS IS CONS;
 240                BEGIN
 241                     DECLARE
 242                          X : SCONS;
 243                     BEGIN
 244                          IF X /= (11, 5) THEN
 245                               FAILED ("X VALUE INCORRECT - 12");
 246                          END IF;
 247                     END;
 248                EXCEPTION
 249                     WHEN OTHERS =>
 250                          FAILED ("UNEXPECTED EXCEPTION RAISED - 12A");
 251                END;
 252           EXCEPTION
 253                WHEN OTHERS =>
 254                     FAILED ("UNEXPECTED EXCEPTION RAISED - 12B");
 255           END;
 256
 257           BEGIN
 258                DECLARE
 259                     TYPE ARR IS ARRAY (1..5) OF CONS;
 260                BEGIN
 261                     DECLARE
 262                          X : ARR;
 263                     BEGIN
 264                          IF X /= (1..5 => (11, 5)) THEN
 265                               FAILED ("X VALUE INCORRECT - 13");
 266                          END IF;
 267                     END;
 268                EXCEPTION
 269                     WHEN OTHERS =>
 270                          FAILED ("UNEXPECTED EXCEPTION RAISED - 13A");
 271                END;
 272           EXCEPTION
 273                WHEN OTHERS =>
 274                     FAILED ("UNEXPECTED EXCEPTION RAISED - 13B");
 275           END;
 276
 277           BEGIN
 278                DECLARE
 279                     TYPE NREC IS
 280                          RECORD
 281                               C1 : CONS;
 282                          END RECORD;
 283                BEGIN
 284                     DECLARE
 285                          X : NREC;
 286                     BEGIN
 287                          IF X /= (C1 => (11, 5)) THEN
 288                               FAILED ("X VALUE INCORRECT - 14");
 289                          END IF;
 290                     END;
 291                EXCEPTION
 292                     WHEN OTHERS =>
 293                          FAILED ("UNEXPECTED EXCEPTION RAISED - 14A");
 294                END;
 295           EXCEPTION
 296                WHEN OTHERS =>
 297                     FAILED ("UNEXPECTED EXCEPTION RAISED - 14B");
 298           END;
 299
 300           BEGIN
 301                DECLARE
 302                     TYPE NREC IS NEW CONS;
 303                BEGIN
 304                     DECLARE
 305                          X : NREC;
 306                     BEGIN
 307                          IF X /= (11, 5) THEN
 308                               FAILED ("X VALUE INCORRECT - 15");
 309                          END IF;
 310                     END;
 311                EXCEPTION
 312                     WHEN OTHERS =>
 313                          FAILED ("UNEXPECTED EXCEPTION RAISED - 15A");
 314                END;
 315           EXCEPTION
 316                WHEN OTHERS =>
 317                     FAILED ("UNEXPECTED EXCEPTION RAISED - 15B");
 318           END;
 319
 320           BEGIN
 321                DECLARE
 322                     TYPE ACC_CONS IS ACCESS CONS;
 323                     X : ACC_CONS;
 324                BEGIN
 325                     X := NEW CONS;
 326                     IF X.ALL /= (11, 5) THEN
 327                          FAILED ("X VALUE INCORRECT - 17");
 328                     END IF;
 329                EXCEPTION
 330                     WHEN OTHERS =>
 331                          FAILED ("UNEXPECTED EXCEPTION RAISED - 17A");
 332                END;
 333           EXCEPTION
 334                WHEN OTHERS =>
 335                     FAILED ("UNEXPECTED EXCEPTION RAISED - 17B");
 336           END;
 337      END;
 338
 339      RESULT;
 340 EXCEPTION
 341      WHEN OTHERS =>
 342           FAILED ("INDEX VALUES CHECKED TOO SOON - " &
 343                   INTEGER'IMAGE(SEQUENCE_NUMBER));
 344           RESULT;
 345 END C37215H;