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

   1 -- C37211C.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 CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT
  26 -- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
  27 -- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE
  28 -- INDICATIONS WHERE THE TYPE MARK DENOTES A PRIVATE OR LIMITED
  29 -- PRIVATE TYPE, THE DISCRIMINANT CONSTRAINT OCCURS BEFORE THE FULL
  30 -- DECLARATION OF THE TYPE, AND THERE ARE NO COMPONENTS OF THE TYPE
  31 -- DEPENDENT ON THE DISCRIMINANT.
  32
  33 -- R.WILLIAMS 8/28/86
  34 -- EDS        7/14/98    AVOID OPTIMIZATION
  35
  36 WITH REPORT; USE REPORT;
  37 PROCEDURE C37211C IS
  38
  39      GLOBAL : BOOLEAN;
  40
  41      SUBTYPE LIES IS BOOLEAN RANGE FALSE .. FALSE;
  42
  43      FUNCTION SWITCH (B : BOOLEAN) RETURN BOOLEAN IS
  44      BEGIN
  45           GLOBAL := B;
  46           RETURN B;
  47      END SWITCH;
  48
  49 BEGIN
  50      TEST ( "C37211C", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
  51                        "A DISCRIMINANT CONSTRAINT IF A VALUE " &
  52                        "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
  53                        "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
  54                        "TYPE MARK DENOTES A PRIVATE OR LIMITED " &
  55                        "PRIVATE TYPE, AND THE DISCRIMINANT " &
  56                        "CONSTRAINT OCCURS BEFORE THE FULL " &
  57                        "DECLARATION OF THE TYPE" );
  58
  59      BEGIN
  60           DECLARE
  61
  62                B1 : BOOLEAN := SWITCH (TRUE);
  63
  64                PACKAGE PP IS
  65                     TYPE PRIV1 (D : LIES) IS PRIVATE;
  66                     SUBTYPE SUBPRIV IS PRIV1 (IDENT_BOOL (TRUE));
  67
  68                     B2 : BOOLEAN := SWITCH (FALSE);
  69
  70                PRIVATE
  71                     TYPE PRIV1 (D : LIES) IS
  72                          RECORD
  73                               NULL;
  74                          END RECORD;
  75                END PP;
  76
  77                USE PP;
  78           BEGIN
  79                DECLARE
  80                     SP : SUBPRIV;
  81                BEGIN
  82                     FAILED ( "NO EXCEPTION RAISED AT THE " &
  83                              "ELABORATION OF SUBTYPE SUBPRIV " & BOOLEAN'IMAGE(SP.D));
  84                END;
  85           EXCEPTION
  86                WHEN OTHERS =>
  87                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
  88                              "OBJECT SP" );
  89           END;
  90
  91      EXCEPTION
  92           WHEN CONSTRAINT_ERROR =>
  93                IF GLOBAL THEN
  94                     NULL;
  95                ELSE
  96                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
  97                              "FULL TYPE PRIV1 NOT SUBTYPE SUBPRIV" );
  98                END IF;
  99           WHEN OTHERS =>
 100                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
 101                         "SUBTYPE SUBPRIV" );
 102      END;
 103
 104      BEGIN
 105           DECLARE
 106
 107                B1 : BOOLEAN := SWITCH (TRUE);
 108
 109                PACKAGE PL IS
 110                     TYPE LIM1 (D : LIES) IS LIMITED PRIVATE;
 111                     SUBTYPE SUBLIM IS LIM1 (IDENT_BOOL (TRUE));
 112
 113                     B2 : BOOLEAN := SWITCH (FALSE);
 114
 115                PRIVATE
 116                     TYPE LIM1 (D : LIES) IS
 117                          RECORD
 118                               NULL;
 119                          END RECORD;
 120                END PL;
 121
 122                USE PL;
 123           BEGIN
 124                DECLARE
 125                     SL : SUBLIM;
 126                BEGIN
 127                     FAILED ( "NO EXCEPTION RAISED AT THE " &
 128                              "ELABORATION OF SUBTYPE SUBLIM " & BOOLEAN'IMAGE(SL.D));
 129                END;
 130           EXCEPTION
 131                WHEN OTHERS =>
 132                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
 133                              "OBJECT SL" );
 134           END;
 135
 136      EXCEPTION
 137           WHEN CONSTRAINT_ERROR =>
 138                IF GLOBAL THEN
 139                     NULL;
 140                ELSE
 141                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
 142                              "FULL TYPE LIM1 NOT SUBTYPE SUBLIM" );
 143                END IF;
 144           WHEN OTHERS =>
 145                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
 146                         "SUBTYPE SUBLIM" );
 147      END;
 148
 149      BEGIN
 150           DECLARE
 151                B1 : BOOLEAN := SWITCH (TRUE);
 152
 153                PACKAGE PP IS
 154                     TYPE PRIV2 (D : LIES) IS PRIVATE;
 155                     TYPE PARR IS ARRAY (1 .. 5) OF
 156                          PRIV2 (IDENT_BOOL (TRUE));
 157
 158                     B2 : BOOLEAN := SWITCH (FALSE);
 159
 160                PRIVATE
 161                     TYPE PRIV2 (D : LIES) IS
 162                          RECORD
 163                               NULL;
 164                          END RECORD;
 165                END PP;
 166
 167                USE PP;
 168           BEGIN
 169                DECLARE
 170                     PAR : PARR;
 171                BEGIN
 172                     FAILED ( "NO EXCEPTION RAISED AT THE " &
 173                              "ELABORATION OF TYPE PARR " & BOOLEAN'IMAGE(PAR(1).D));
 174                END;
 175           EXCEPTION
 176                WHEN OTHERS =>
 177                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
 178                              "OBJECT PAR" );
 179           END;
 180
 181      EXCEPTION
 182           WHEN CONSTRAINT_ERROR =>
 183                IF GLOBAL THEN
 184                     NULL;
 185                ELSE
 186                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
 187                              "FULL TYPE PRIV2 NOT TYPE PARR" );
 188                END IF;
 189           WHEN OTHERS =>
 190                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
 191                         "TYPE PARR" );
 192      END;
 193
 194      BEGIN
 195           DECLARE
 196                B1 : BOOLEAN := SWITCH (TRUE);
 197
 198                PACKAGE PL IS
 199                     TYPE LIM2 (D : LIES) IS LIMITED PRIVATE;
 200                     TYPE LARR IS ARRAY (1 .. 5) OF
 201                          LIM2 (IDENT_BOOL (TRUE));
 202
 203                     B2 : BOOLEAN := SWITCH (FALSE);
 204
 205                PRIVATE
 206                     TYPE LIM2 (D : LIES) IS
 207                          RECORD
 208                               NULL;
 209                          END RECORD;
 210                END PL;
 211
 212                USE PL;
 213           BEGIN
 214                DECLARE
 215                     LAR : LARR;
 216                BEGIN
 217                     FAILED ( "NO EXCEPTION RAISED AT THE " &
 218                              "ELABORATION OF TYPE LARR " & BOOLEAN'IMAGE(LAR(1).D));
 219                END;
 220           EXCEPTION
 221                WHEN OTHERS =>
 222                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
 223                              "OBJECT LAR" );
 224           END;
 225
 226      EXCEPTION
 227           WHEN CONSTRAINT_ERROR =>
 228                IF GLOBAL THEN
 229                     NULL;
 230                ELSE
 231                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
 232                              "FULL TYPE LIM2 NOT TYPE LARR" );
 233                END IF;
 234           WHEN OTHERS =>
 235                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
 236                         "TYPE LARR" );
 237      END;
 238
 239      BEGIN
 240           DECLARE
 241                B1 : BOOLEAN := SWITCH (TRUE);
 242
 243                PACKAGE PP IS
 244                     TYPE PRIV3 (D : LIES) IS PRIVATE;
 245
 246                     TYPE PRIV4 IS
 247                          RECORD
 248                               X : PRIV3 (IDENT_BOOL (TRUE));
 249                          END RECORD;
 250
 251                     B2 : BOOLEAN := SWITCH (FALSE);
 252
 253                PRIVATE
 254                     TYPE PRIV3 (D : LIES) IS
 255                          RECORD
 256                               NULL;
 257                          END RECORD;
 258                END PP;
 259
 260                USE PP;
 261           BEGIN
 262                DECLARE
 263                     P4 : PRIV4;
 264                BEGIN
 265                     FAILED ( "NO EXCEPTION RAISED AT THE " &
 266                              "ELABORATION OF TYPE PRIV4 " & BOOLEAN'IMAGE(P4.X.D));
 267                END;
 268           EXCEPTION
 269                WHEN OTHERS =>
 270                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
 271                              "OBJECT P4" );
 272           END;
 273
 274      EXCEPTION
 275           WHEN CONSTRAINT_ERROR =>
 276                IF GLOBAL THEN
 277                     NULL;
 278                ELSE
 279                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
 280                              "FULL TYPE PRIV3 NOT TYPE PRIV4" );
 281                END IF;
 282           WHEN OTHERS =>
 283                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
 284                         "TYPE PRIV4" );
 285      END;
 286
 287      BEGIN
 288           DECLARE
 289                B1 : BOOLEAN := SWITCH (TRUE);
 290
 291                PACKAGE PL IS
 292                     TYPE LIM3 (D : LIES) IS LIMITED PRIVATE;
 293
 294                     TYPE LIM4 IS
 295                          RECORD
 296                               X : LIM3 (IDENT_BOOL (TRUE));
 297                          END RECORD;
 298
 299                     B2 : BOOLEAN := SWITCH (FALSE);
 300
 301                PRIVATE
 302                     TYPE LIM3 (D : LIES) IS
 303                          RECORD
 304                               NULL;
 305                          END RECORD;
 306                END PL;
 307
 308                USE PL;
 309           BEGIN
 310                DECLARE
 311                     L4 : LIM4;
 312                BEGIN
 313                     FAILED ( "NO EXCEPTION RAISED AT THE " &
 314                              "ELABORATION OF TYPE LIM4 " & BOOLEAN'IMAGE(L4.X.D));
 315                END;
 316           EXCEPTION
 317                WHEN OTHERS =>
 318                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
 319                              "OBJECT L4" );
 320           END;
 321
 322      EXCEPTION
 323           WHEN CONSTRAINT_ERROR =>
 324                IF GLOBAL THEN
 325                     NULL;
 326                ELSE
 327                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
 328                              "FULL TYPE LIM3 NOT TYPE LIM4" );
 329                END IF;
 330           WHEN OTHERS =>
 331                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
 332                         "TYPE LIM4" );
 333      END;
 334
 335      BEGIN
 336           DECLARE
 337                B1 : BOOLEAN := SWITCH (TRUE);
 338
 339                PACKAGE PP IS
 340                     TYPE PRIV5 (D : LIES) IS PRIVATE;
 341                     TYPE ACCPRIV IS ACCESS PRIV5 (IDENT_BOOL (TRUE));
 342
 343                     B2 : BOOLEAN := SWITCH (FALSE);
 344
 345                PRIVATE
 346                     TYPE PRIV5 (D : LIES) IS
 347                          RECORD
 348                               NULL;
 349                          END RECORD;
 350                END PP;
 351
 352                USE PP;
 353
 354           BEGIN
 355                DECLARE
 356                     ACP : ACCPRIV;
 357                BEGIN
 358                     FAILED ( "NO EXCEPTION RAISED AT THE " &
 359                              "ELABORATION OF TYPE ACCPRIV " & BOOLEAN'IMAGE(ACP.D));
 360                END;
 361           EXCEPTION
 362                WHEN OTHERS =>
 363                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
 364                              "OBJECT ACP" );
 365           END;
 366
 367      EXCEPTION
 368           WHEN CONSTRAINT_ERROR =>
 369                IF GLOBAL THEN
 370                     NULL;
 371                ELSE
 372                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
 373                              "FULL TYPE PRIV5 NOT TYPE ACCPRIV" );
 374                END IF;
 375           WHEN OTHERS =>
 376                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
 377                         "TYPE ACCPRIV" );
 378      END;
 379
 380      BEGIN
 381           DECLARE
 382                B1 : BOOLEAN := SWITCH (TRUE);
 383
 384                PACKAGE PL IS
 385                     TYPE LIM5 (D : LIES) IS LIMITED PRIVATE;
 386                     TYPE ACCLIM IS ACCESS LIM5 (IDENT_BOOL (TRUE));
 387
 388                     B2 : BOOLEAN := SWITCH (FALSE);
 389
 390                PRIVATE
 391                     TYPE LIM5 (D : LIES) IS
 392                          RECORD
 393                               NULL;
 394                          END RECORD;
 395                END PL;
 396
 397                USE PL;
 398
 399           BEGIN
 400                DECLARE
 401                     ACL : ACCLIM;
 402                BEGIN
 403                     FAILED ( "NO EXCEPTION RAISED AT THE " &
 404                              "ELABORATION OF TYPE ACCLIM " & BOOLEAN'IMAGE(ACL.D));
 405                END;
 406           EXCEPTION
 407                WHEN OTHERS =>
 408                     FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
 409                              "OBJECT ACL" );
 410           END;
 411
 412      EXCEPTION
 413           WHEN CONSTRAINT_ERROR =>
 414                IF GLOBAL THEN
 415                     NULL;
 416                ELSE
 417                     FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
 418                              "FULL TYPE LIM5 NOT TYPE ACCLIM" );
 419                END IF;
 420           WHEN OTHERS =>
 421                FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
 422                         "TYPE ACCLIM" );
 423      END;
 424
 425      RESULT;
 426 END C37211C;