old-autovect-branch/gcc/testsuite/ada/acats/tests/c3/c32113a.ada

   1 -- C32113A.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 WHEN A VARIABLE OR CONSTANT HAVING A CONSTRAINED TYPE
  27 --     WITH DISCRIMINANTS IS DECLARED WITH AN INITIAL VALUE,
  28 --     CONSTRAINT_ERROR IS RAISED IF THE CORRESPONDING DISCRIMINANTS OF
  29 --     THE INITIAL VALUE AND THE SUBTYPE DO NOT HAVE THE SAME VALUE.
  30
  31 -- HISTORY:
  32 --     RJW 07/20/86
  33 --     DWC 06/22/87  ADDED SUBTYPE PRIVAS.  ADDED CODE TO PREVENT DEAD
  34 --                   VARIABLE OPTIMIZATION.
  35
  36 WITH REPORT; USE REPORT;
  37
  38 PROCEDURE C32113A IS
  39
  40      PACKAGE PKG IS
  41           TYPE PRIVA (D : INTEGER := 0) IS PRIVATE;
  42           SUBTYPE PRIVAS IS PRIVA (IDENT_INT (1));
  43           PRA1 : CONSTANT PRIVAS;
  44
  45           TYPE PRIVB (D1, D2 : INTEGER) IS PRIVATE;
  46           PRB12 : CONSTANT PRIVB;
  47
  48      PRIVATE
  49           TYPE PRIVA (D : INTEGER := 0) IS
  50                RECORD
  51                     NULL;
  52                END RECORD;
  53
  54           TYPE PRIVB (D1, D2 : INTEGER) IS
  55                RECORD
  56                      NULL;
  57                END RECORD;
  58
  59           PRA1  : CONSTANT PRIVAS := (D => (IDENT_INT (1)));
  60           PRB12 : CONSTANT PRIVB := (IDENT_INT (1), IDENT_INT (2));
  61      END PKG;
  62
  63      USE PKG;
  64
  65      TYPE RECA (D : INTEGER := 0) IS
  66           RECORD
  67                NULL;
  68           END RECORD;
  69
  70      TYPE RECB (D1, D2 : INTEGER) IS
  71           RECORD
  72                NULL;
  73           END RECORD;
  74
  75      RA1 : CONSTANT RECA (IDENT_INT (1)) := (D => (IDENT_INT (1)));
  76
  77      RB12 : CONSTANT RECB := (IDENT_INT (1), IDENT_INT (2));
  78
  79 BEGIN
  80      TEST ("C32113A", "CHECK THAT WHEN A VARIABLE OR CONSTANT " &
  81                       "HAVING A CONSTRAINED TYPE IS DECLARED WITH " &
  82                       "AN INITIAL VALUE, CONSTRAINT_ERROR IS " &
  83                       "RAISED IF THE CORRESPONDING DISCRIMINANTS " &
  84                       "OF THE INITIAL VALUE AND THE SUBTYPE DO " &
  85                       "NOT HAVE THE SAME VALUE" );
  86
  87      BEGIN
  88           DECLARE
  89                PR1 : CONSTANT PRIVA (IDENT_INT (0)) := PRA1;
  90           BEGIN
  91                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
  92                         "OF CONSTANT 'PR1'" );
  93                IF PR1 = PRA1 THEN
  94                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
  95                END IF;
  96           END;
  97      EXCEPTION
  98           WHEN CONSTRAINT_ERROR =>
  99                NULL;
 100           WHEN OTHERS =>
 101                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 102                         "OF CONSTANT 'PR1'" );
 103      END;
 104
 105      BEGIN
 106           DECLARE
 107                PR2 : CONSTANT PRIVA (IDENT_INT (2)) := PRA1;
 108           BEGIN
 109                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 110                         "OF CONSTANT 'PR2'" );
 111                IF PR2 = PRA1 THEN
 112                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 113                END IF;
 114           END;
 115      EXCEPTION
 116           WHEN CONSTRAINT_ERROR =>
 117                NULL;
 118           WHEN OTHERS =>
 119                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 120                         "OF CONSTANT 'PR2'" );
 121      END;
 122
 123      BEGIN
 124           DECLARE
 125                PR3 : PRIVA (IDENT_INT (0)) := PRA1;
 126           BEGIN
 127                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 128                         "OF VARIABLE 'PR3'" );
 129                IF PR3 = PRA1 THEN
 130                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 131                END IF;
 132           END;
 133      EXCEPTION
 134           WHEN CONSTRAINT_ERROR =>
 135                NULL;
 136           WHEN OTHERS =>
 137                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 138                         "OF VARIABLE 'PR3'" );
 139      END;
 140
 141      BEGIN
 142           DECLARE
 143                PR4 : PRIVA (IDENT_INT (2)) := PRA1;
 144           BEGIN
 145                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 146                         "OF VARIABLE 'PR4'" );
 147                IF PR4 = PRA1 THEN
 148                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 149                END IF;
 150           END;
 151      EXCEPTION
 152           WHEN CONSTRAINT_ERROR =>
 153                NULL;
 154           WHEN OTHERS =>
 155                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 156                         "OF VARIABLE 'PR4'" );
 157      END;
 158
 159      BEGIN
 160           DECLARE
 161                SUBTYPE SPRIVA IS PRIVA (IDENT_INT (-1));
 162                PR5 : CONSTANT SPRIVA := PRA1;
 163           BEGIN
 164                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 165                         "OF CONSTANT 'PR5'" );
 166                IF PR5 = PRA1 THEN
 167                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 168                END IF;
 169           END;
 170      EXCEPTION
 171           WHEN CONSTRAINT_ERROR =>
 172                NULL;
 173           WHEN OTHERS =>
 174                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 175                         "OF CONSTANT 'PR5'" );
 176      END;
 177
 178      BEGIN
 179           DECLARE
 180                SUBTYPE SPRIVA IS PRIVA (IDENT_INT (3));
 181                PR6 : SPRIVA := PRA1;
 182           BEGIN
 183                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 184                         "OF VARIABLE 'PR6'" );
 185                IF PR6 = PRA1 THEN
 186                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 187                END IF;
 188           END;
 189      EXCEPTION
 190           WHEN CONSTRAINT_ERROR =>
 191                NULL;
 192           WHEN OTHERS =>
 193                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 194                         "OF VARIABLE 'PR6'" );
 195      END;
 196
 197      BEGIN
 198           DECLARE
 199                PR7 : CONSTANT PRIVB (IDENT_INT (1), IDENT_INT (1)) :=
 200                      PRB12;
 201           BEGIN
 202                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 203                         "OF CONSTANT 'PR7'" );
 204                IF PR7 = PRB12 THEN
 205                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 206                END IF;
 207           END;
 208      EXCEPTION
 209           WHEN CONSTRAINT_ERROR =>
 210                NULL;
 211           WHEN OTHERS =>
 212                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 213                         "OF CONSTANT 'PR7'" );
 214      END;
 215
 216      BEGIN
 217           DECLARE
 218                PR8 : CONSTANT PRIVB (IDENT_INT (2), IDENT_INT (2)) :=
 219                      PRB12;
 220           BEGIN
 221                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 222                         "OF CONSTANT 'PR8'" );
 223                IF PR8 = PRB12 THEN
 224                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 225                END IF;
 226           END;
 227      EXCEPTION
 228           WHEN CONSTRAINT_ERROR =>
 229                NULL;
 230           WHEN OTHERS =>
 231                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 232                         "OF CONSTANT 'PR8'" );
 233      END;
 234
 235      BEGIN
 236           DECLARE
 237                PR9 : PRIVB (IDENT_INT (1), IDENT_INT (1)) := PRB12;
 238           BEGIN
 239                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 240                         "OF VARIABLE 'PR9'" );
 241                IF PR9 = PRB12 THEN
 242                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 243                END IF;
 244           END;
 245      EXCEPTION
 246           WHEN CONSTRAINT_ERROR =>
 247                NULL;
 248           WHEN OTHERS =>
 249                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 250                         "OF VARIABLE 'PR9'" );
 251      END;
 252
 253      BEGIN
 254           DECLARE
 255                PR10 : PRIVB (IDENT_INT (2), IDENT_INT (2)) := PRB12;
 256           BEGIN
 257                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 258                         "OF VARIABLE 'PR10'" );
 259                IF PR10 = PRB12 THEN
 260                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 261                END IF;
 262           END;
 263      EXCEPTION
 264           WHEN CONSTRAINT_ERROR =>
 265                NULL;
 266           WHEN OTHERS =>
 267                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 268                         "OF VARIABLE 'PR10'" );
 269      END;
 270
 271      BEGIN
 272           DECLARE
 273                SUBTYPE SPRIVB IS
 274                        PRIVB (IDENT_INT (-1), IDENT_INT (-2));
 275                PR11 : CONSTANT SPRIVB := PRB12;
 276           BEGIN
 277                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 278                         "OF CONSTANT 'PR11'" );
 279                IF PR11 = PRB12 THEN
 280                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 281                END IF;
 282           END;
 283      EXCEPTION
 284           WHEN CONSTRAINT_ERROR =>
 285                NULL;
 286           WHEN OTHERS =>
 287                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 288                         "OF CONSTANT 'PR11'" );
 289      END;
 290
 291      BEGIN
 292           DECLARE
 293                SUBTYPE SPRIVB IS PRIVB (IDENT_INT (2), IDENT_INT (1));
 294                PR12 : SPRIVB := PRB12;
 295           BEGIN
 296                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 297                         "OF VARIABLE 'PR12'" );
 298                IF PR12 = PRB12 THEN
 299                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 300                END IF;
 301           END;
 302      EXCEPTION
 303           WHEN CONSTRAINT_ERROR =>
 304                NULL;
 305           WHEN OTHERS =>
 306                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 307                         "OF VARIABLE 'PR12'" );
 308      END;
 309
 310      BEGIN
 311           DECLARE
 312                R1 : CONSTANT RECA (IDENT_INT (0)) := RA1;
 313           BEGIN
 314                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 315                         "OF CONSTANT 'R1'" );
 316                IF R1 = RA1 THEN
 317                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 318                END IF;
 319           END;
 320      EXCEPTION
 321           WHEN CONSTRAINT_ERROR =>
 322                NULL;
 323           WHEN OTHERS =>
 324                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 325                         "OF CONSTANT 'R1'" );
 326      END;
 327
 328      BEGIN
 329           DECLARE
 330                R2 : CONSTANT RECA (IDENT_INT (2)) := RA1;
 331           BEGIN
 332                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 333                         "OF CONSTANT 'R2'" );
 334                IF R2 = RA1 THEN
 335                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 336                END IF;
 337           END;
 338      EXCEPTION
 339           WHEN CONSTRAINT_ERROR =>
 340                NULL;
 341           WHEN OTHERS =>
 342                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 343                         "OF CONSTANT 'R2'" );
 344      END;
 345
 346      BEGIN
 347           DECLARE
 348                R3 : RECA (IDENT_INT (0)) := RA1;
 349           BEGIN
 350                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 351                         "OF VARIABLE 'R3'" );
 352                IF R3 = RA1 THEN
 353                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 354                END IF;
 355           END;
 356      EXCEPTION
 357           WHEN CONSTRAINT_ERROR =>
 358                NULL;
 359           WHEN OTHERS =>
 360                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 361                         "OF VARIABLE 'R3'" );
 362      END;
 363
 364      BEGIN
 365           DECLARE
 366                R4 : RECA (IDENT_INT (2)) := RA1;
 367           BEGIN
 368                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 369                         "OF VARIABLE 'R4'" );
 370                IF R4 = RA1 THEN
 371                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 372                END IF;
 373           END;
 374      EXCEPTION
 375           WHEN CONSTRAINT_ERROR =>
 376                NULL;
 377           WHEN OTHERS =>
 378                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 379                         "OF VARIABLE 'R4'" );
 380      END;
 381
 382      BEGIN
 383           DECLARE
 384                SUBTYPE SRECA IS RECA (IDENT_INT (-1));
 385                R5 : CONSTANT SRECA := RA1;
 386           BEGIN
 387                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 388                         "OF CONSTANT 'R5'" );
 389                IF R5 = RA1 THEN
 390                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 391                END IF;
 392           END;
 393      EXCEPTION
 394           WHEN CONSTRAINT_ERROR =>
 395                NULL;
 396           WHEN OTHERS =>
 397                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 398                         "OF CONSTANT 'R5'" );
 399      END;
 400
 401      BEGIN
 402           DECLARE
 403                SUBTYPE SRECA IS RECA (IDENT_INT (3));
 404                R6 : SRECA := RA1;
 405           BEGIN
 406                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 407                         "OF VARIABLE 'R6'" );
 408                IF R6 = RA1 THEN
 409                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 410                END IF;
 411           END;
 412      EXCEPTION
 413           WHEN CONSTRAINT_ERROR =>
 414                NULL;
 415           WHEN OTHERS =>
 416                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 417                         "OF VARIABLE 'R6'" );
 418      END;
 419
 420      BEGIN
 421           DECLARE
 422                R7 : CONSTANT RECB (IDENT_INT (1), IDENT_INT (1)) :=
 423                      RB12;
 424           BEGIN
 425                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 426                         "OF CONSTANT 'R7'" );
 427                IF R7 = RB12 THEN
 428                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 429                END IF;
 430           END;
 431      EXCEPTION
 432           WHEN CONSTRAINT_ERROR =>
 433                NULL;
 434           WHEN OTHERS =>
 435                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 436                         "OF CONSTANT 'R7'" );
 437      END;
 438
 439      BEGIN
 440           DECLARE
 441                R8 : CONSTANT RECB (IDENT_INT (2), IDENT_INT (2)) :=
 442                      RB12;
 443           BEGIN
 444                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 445                         "OF CONSTANT 'R8'" );
 446                IF R8 = RB12 THEN
 447                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 448                END IF;
 449           END;
 450      EXCEPTION
 451           WHEN CONSTRAINT_ERROR =>
 452                NULL;
 453           WHEN OTHERS =>
 454                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 455                         "OF CONSTANT 'R8'" );
 456      END;
 457
 458      BEGIN
 459           DECLARE
 460                R9 : RECB (IDENT_INT (1), IDENT_INT (1)) := RB12;
 461           BEGIN
 462                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 463                         "OF VARIABLE 'R9'" );
 464                IF R9 = RB12 THEN
 465                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 466                END IF;
 467           END;
 468      EXCEPTION
 469           WHEN CONSTRAINT_ERROR =>
 470                NULL;
 471           WHEN OTHERS =>
 472                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 473                         "OF VARIABLE 'R9'" );
 474      END;
 475
 476      BEGIN
 477           DECLARE
 478                R10 : RECB (IDENT_INT (2), IDENT_INT (2)) := RB12;
 479           BEGIN
 480                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 481                         "OF VARIABLE 'R10'" );
 482                IF R10 = RB12 THEN
 483                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 484                END IF;
 485           END;
 486      EXCEPTION
 487           WHEN CONSTRAINT_ERROR =>
 488                NULL;
 489           WHEN OTHERS =>
 490                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 491                         "OF VARIABLE 'R10'" );
 492      END;
 493
 494      BEGIN
 495           DECLARE
 496                SUBTYPE SRECB IS
 497                        RECB (IDENT_INT (-1), IDENT_INT (-2));
 498                R11 : CONSTANT SRECB := RB12;
 499           BEGIN
 500                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 501                         "OF CONSTANT 'R11'" );
 502                IF R11 = RB12 THEN
 503                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 504                END IF;
 505           END;
 506      EXCEPTION
 507           WHEN CONSTRAINT_ERROR =>
 508                NULL;
 509           WHEN OTHERS =>
 510                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 511                         "OF CONSTANT 'R11'" );
 512      END;
 513
 514      BEGIN
 515           DECLARE
 516                SUBTYPE SRECB IS RECB (IDENT_INT (2), IDENT_INT (1));
 517                R12 : SRECB := RB12;
 518           BEGIN
 519                FAILED ( "NO EXCEPTION RAISED FOR INITIALIZATION " &
 520                         "OF VARIABLE 'R12'" );
 521                IF R12 = RB12 THEN
 522                     COMMENT ("PREVENTING DEAD VARIABLE OPTIMIZATION");
 523                END IF;
 524           END;
 525      EXCEPTION
 526           WHEN CONSTRAINT_ERROR =>
 527                NULL;
 528           WHEN OTHERS =>
 529                FAILED ( "WRONG EXCEPTION RAISED FOR INITIALIZATION " &
 530                         "OF VARIABLE 'R12'" );
 531      END;
 532
 533      RESULT;
 534 END C32113A;