gcc/testsuite/ada/acats/tests/cc/cc3017b.ada

   1 -- CC3017B.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 AN INSTANCE OF A GENERIC PROCEDURE MUST DECLARE A
  26 -- PROCEDURE AND THAT AN INSTANCE OF A GENERIC FUNCTION MUST
  27 -- DECLARE A FUNCTION. CHECK THAT CONSTRAINT_ERROR IS NOT RAISED
  28 -- IF THE DEFAULT VALUE FOR A FORMAL PARAMETER DOES NOT SATISFY
  29 -- THE CONSTRAINTS OF THE SUBTYPE_INDICATION WHEN THE
  30 -- DECLARATION IS ELABORATED, ONLY WHEN THE DEFAULT IS USED.
  31
  32 --   SUBTESTS ARE:
  33 --        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
  34 --            INITIALIZED WITH A STATIC AGGREGATE.
  35 --        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
  36 --            INITIALIZED WITH A STATIC VALUE.
  37 --        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
  38 --            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
  39 --        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
  40 --            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
  41 --            WITH A STATIC AGGREGATE.
  42 --        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
  43 --            INITIALIZED WITH A STATIC AGGREGATE.
  44
  45 -- EDWARD V. BERARD, 7 AUGUST 1990
  46
  47 WITH REPORT;
  48
  49 PROCEDURE CC3017B IS
  50
  51 BEGIN
  52
  53      REPORT.TEST ("CC3017B", "CHECK THAT AN INSTANCE OF A GENERIC " &
  54                   "PROCEDURE MUST DECLARE A PROCEDURE AND THAT AN " &
  55                   "INSTANCE OF A GENERIC FUNCTION MUST DECLARE A " &
  56                   "FUNCTION. CHECK THAT CONSTRAINT_ERROR IS NOT " &
  57                   "RAISED IF AN INITIALIZATION VALUE DOES NOT SATISFY " &
  58                   "CONSTRAINTS ON A FORMAL PARAMETER");
  59
  60      --------------------------------------------------
  61
  62      NONSTAT_ARRAY_PARMS:
  63
  64      DECLARE
  65
  66 --        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
  67 --            INITIALIZED WITH A STATIC AGGREGATE.
  68
  69           TYPE NUMBER IS RANGE 1 .. 100 ;
  70
  71           GENERIC
  72
  73             TYPE INTEGER_TYPE IS RANGE <> ;
  74             LOWER : IN INTEGER_TYPE ;
  75             UPPER : IN INTEGER_TYPE ;
  76
  77           PROCEDURE PA (FIRST  : IN INTEGER_TYPE ;
  78                         SECOND : IN INTEGER_TYPE) ;
  79
  80           PROCEDURE PA (FIRST  : IN INTEGER_TYPE ;
  81                         SECOND : IN INTEGER_TYPE) IS
  82
  83                TYPE A1 IS ARRAY (INTEGER_TYPE RANGE LOWER .. FIRST,
  84                                  INTEGER_TYPE RANGE LOWER .. SECOND)
  85                                          OF INTEGER_TYPE;
  86
  87                PROCEDURE PA1 (A : A1 := ((LOWER,UPPER),(UPPER,UPPER)))
  88                     IS
  89                BEGIN
  90                     REPORT.FAILED ("BODY OF PA1 EXECUTED");
  91                EXCEPTION
  92                     WHEN OTHERS =>
  93                          REPORT.FAILED ("EXCEPTION RAISED IN PA1");
  94                END PA1;
  95
  96           BEGIN  -- PA
  97                PA1;
  98           EXCEPTION
  99                WHEN CONSTRAINT_ERROR =>
 100                     NULL;
 101                WHEN OTHERS =>
 102                     REPORT.FAILED ("WRONG EXCEPTION RAISED - PA1");
 103           END PA;
 104
 105           PROCEDURE NEW_PA IS NEW PA (INTEGER_TYPE => NUMBER,
 106                                       LOWER        => 1,
 107                                       UPPER        => 50) ;
 108
 109      BEGIN   -- NONSTAT_ARRAY_PARMS
 110
 111           NEW_PA (FIRST  => NUMBER (25),
 112                   SECOND => NUMBER (75));
 113
 114      EXCEPTION
 115           WHEN OTHERS =>
 116                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PA");
 117
 118      END NONSTAT_ARRAY_PARMS ;
 119
 120      --------------------------------------------------
 121
 122      SCALAR_NON_STATIC:
 123
 124      DECLARE
 125
 126 --        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
 127 --            INITIALIZED WITH A STATIC VALUE.
 128
 129           TYPE NUMBER IS RANGE 1 .. 100 ;
 130
 131           GENERIC
 132
 133             TYPE INTEGER_TYPE IS RANGE <> ;
 134             STATIC_VALUE : IN INTEGER_TYPE ;
 135
 136           PROCEDURE PB (LOWER  : IN INTEGER_TYPE ;
 137                         UPPER  : IN INTEGER_TYPE) ;
 138
 139           PROCEDURE PB (LOWER  : IN INTEGER_TYPE ;
 140                         UPPER  : IN INTEGER_TYPE) IS
 141
 142                SUBTYPE INT IS INTEGER_TYPE RANGE LOWER .. UPPER ;
 143
 144                PROCEDURE PB1 (I : INT := STATIC_VALUE) IS
 145                BEGIN  -- PB1
 146                     REPORT.FAILED ("BODY OF PB1 EXECUTED");
 147                EXCEPTION
 148                     WHEN OTHERS =>
 149                          REPORT.FAILED ("EXCEPTION RAISED IN PB1");
 150                END PB1;
 151
 152           BEGIN  -- PB
 153                PB1;
 154           EXCEPTION
 155                WHEN CONSTRAINT_ERROR =>
 156                     NULL;
 157                WHEN OTHERS =>
 158                     REPORT.FAILED ("WRONG EXCEPTION RAISED - PB1");
 159           END PB;
 160
 161           PROCEDURE NEW_PB IS NEW PB (INTEGER_TYPE => NUMBER,
 162                                       STATIC_VALUE => 20) ;
 163
 164      BEGIN   -- SCALAR_NON_STATIC
 165
 166           NEW_PB (LOWER  => NUMBER (25),
 167                   UPPER  => NUMBER (75));
 168
 169      EXCEPTION
 170           WHEN OTHERS =>
 171                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PB");
 172      END SCALAR_NON_STATIC ;
 173
 174      --------------------------------------------------
 175
 176      REC_NON_STAT_COMPS:
 177
 178      DECLARE
 179
 180 --        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
 181 --            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
 182
 183           TYPE NUMBER IS RANGE 1 .. 100 ;
 184
 185           GENERIC
 186
 187             TYPE INTEGER_TYPE IS RANGE <> ;
 188             F_STATIC_VALUE : IN INTEGER_TYPE ;
 189             S_STATIC_VALUE : IN INTEGER_TYPE ;
 190             T_STATIC_VALUE : IN INTEGER_TYPE ;
 191             L_STATIC_VALUE : IN INTEGER_TYPE ;
 192
 193           PROCEDURE PC (LOWER  : IN INTEGER_TYPE ;
 194                         UPPER  : IN INTEGER_TYPE) ;
 195
 196           PROCEDURE PC (LOWER  : IN INTEGER_TYPE ;
 197                         UPPER  : IN INTEGER_TYPE) IS
 198
 199                SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
 200                        RANGE LOWER .. UPPER ;
 201                TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF
 202                      SUBINTEGER_TYPE ;
 203                TYPE REC IS
 204                     RECORD
 205                          FIRST  : SUBINTEGER_TYPE ;
 206                          SECOND : AR1 ;
 207                     END RECORD;
 208
 209                PROCEDURE PC1 (R : REC := (F_STATIC_VALUE,
 210                                          (S_STATIC_VALUE,
 211                                           T_STATIC_VALUE,
 212                                           L_STATIC_VALUE))) IS
 213                BEGIN  -- PC1
 214                     REPORT.FAILED ("BODY OF PC1 EXECUTED");
 215                EXCEPTION
 216                     WHEN OTHERS =>
 217                          REPORT.FAILED ("EXCEPTION RAISED IN PC1");
 218                END PC1;
 219
 220           BEGIN  -- PC
 221                PC1;
 222           EXCEPTION
 223                WHEN CONSTRAINT_ERROR =>
 224                     NULL;
 225                WHEN OTHERS =>
 226                     REPORT.FAILED ("WRONG EXCEPTION RAISED - PC1");
 227           END PC;
 228
 229           PROCEDURE NEW_PC IS NEW PC (INTEGER_TYPE => NUMBER,
 230                                       F_STATIC_VALUE => 15,
 231                                       S_STATIC_VALUE => 19,
 232                                       T_STATIC_VALUE => 85,
 233                                       L_STATIC_VALUE => 99) ;
 234
 235      BEGIN   -- REC_NON_STAT_COMPS
 236           NEW_PC (LOWER => 20,
 237                   UPPER => 80);
 238      EXCEPTION
 239           WHEN OTHERS =>
 240                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PC");
 241      END REC_NON_STAT_COMPS ;
 242
 243      --------------------------------------------------
 244
 245      FIRST_STATIC_ARRAY:
 246
 247      DECLARE
 248
 249 --        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
 250 --            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
 251 --            WITH A STATIC AGGREGATE.
 252
 253           TYPE NUMBER IS RANGE 1 .. 100 ;
 254
 255           GENERIC
 256
 257             TYPE INTEGER_TYPE IS RANGE <> ;
 258             F_STATIC_VALUE : IN INTEGER_TYPE ;
 259             S_STATIC_VALUE : IN INTEGER_TYPE ;
 260             T_STATIC_VALUE : IN INTEGER_TYPE ;
 261             L_STATIC_VALUE : IN INTEGER_TYPE ;
 262             A_STATIC_VALUE : IN INTEGER_TYPE ;
 263             B_STATIC_VALUE : IN INTEGER_TYPE ;
 264             C_STATIC_VALUE : IN INTEGER_TYPE ;
 265             D_STATIC_VALUE : IN INTEGER_TYPE ;
 266
 267           PROCEDURE P1D (LOWER  : IN INTEGER_TYPE ;
 268                          UPPER  : IN INTEGER_TYPE) ;
 269
 270           PROCEDURE P1D (LOWER  : IN INTEGER_TYPE ;
 271                          UPPER  : IN INTEGER_TYPE) IS
 272
 273                SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
 274                        RANGE LOWER .. UPPER ;
 275
 276                TYPE A1 IS ARRAY (INTEGER_TYPE RANGE
 277                                        F_STATIC_VALUE .. S_STATIC_VALUE,
 278                                  INTEGER_TYPE RANGE
 279                                        T_STATIC_VALUE .. L_STATIC_VALUE)
 280                        OF SUBINTEGER_TYPE ;
 281
 282                PROCEDURE P1D1 (A : A1 :=
 283                            ((A_STATIC_VALUE, B_STATIC_VALUE),
 284                            (C_STATIC_VALUE, D_STATIC_VALUE))) IS
 285                BEGIN  -- P1D1
 286                     REPORT.FAILED ("BODY OF P1D1 EXECUTED");
 287                EXCEPTION
 288                     WHEN OTHERS =>
 289                          REPORT.FAILED ("EXCEPTION RAISED IN P1D1");
 290                END P1D1;
 291
 292           BEGIN  -- P1D
 293                P1D1 ;
 294           EXCEPTION
 295                WHEN CONSTRAINT_ERROR =>
 296                     NULL;
 297                WHEN OTHERS =>
 298                     REPORT.FAILED ("WRONG EXCEPTION RAISED - P1D1");
 299           END P1D;
 300
 301           PROCEDURE NEW_P1D IS NEW P1D (INTEGER_TYPE => NUMBER,
 302                                         F_STATIC_VALUE => 21,
 303                                         S_STATIC_VALUE => 37,
 304                                         T_STATIC_VALUE => 67,
 305                                         L_STATIC_VALUE => 79,
 306                                         A_STATIC_VALUE => 11,
 307                                         B_STATIC_VALUE => 88,
 308                                         C_STATIC_VALUE => 87,
 309                                         D_STATIC_VALUE => 13) ;
 310
 311      BEGIN  -- FIRST_STATIC_ARRAY
 312           NEW_P1D (LOWER => 10,
 313                      UPPER => 90);
 314      EXCEPTION
 315           WHEN OTHERS =>
 316                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P1D");
 317      END FIRST_STATIC_ARRAY ;
 318
 319      --------------------------------------------------
 320
 321      SECOND_STATIC_ARRAY:
 322
 323      DECLARE
 324
 325 --        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
 326 --            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
 327 --            WITH A STATIC AGGREGATE.
 328
 329           TYPE NUMBER IS RANGE 1 .. 100 ;
 330
 331           GENERIC
 332
 333             TYPE INTEGER_TYPE IS RANGE <> ;
 334             F_STATIC_VALUE : IN INTEGER_TYPE ;
 335             S_STATIC_VALUE : IN INTEGER_TYPE ;
 336             T_STATIC_VALUE : IN INTEGER_TYPE ;
 337             L_STATIC_VALUE : IN INTEGER_TYPE ;
 338             A_STATIC_VALUE : IN INTEGER_TYPE ;
 339             B_STATIC_VALUE : IN INTEGER_TYPE ;
 340
 341           PROCEDURE P2D (LOWER  : IN INTEGER_TYPE ;
 342                          UPPER  : IN INTEGER_TYPE) ;
 343
 344           PROCEDURE P2D (LOWER  : IN INTEGER_TYPE ;
 345                          UPPER  : IN INTEGER_TYPE) IS
 346
 347                SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
 348                        RANGE LOWER .. UPPER ;
 349
 350                TYPE A1 IS ARRAY (INTEGER_TYPE RANGE
 351                                        F_STATIC_VALUE .. S_STATIC_VALUE,
 352                                  INTEGER_TYPE RANGE
 353                                        T_STATIC_VALUE .. L_STATIC_VALUE)
 354                        OF SUBINTEGER_TYPE ;
 355
 356                PROCEDURE P2D1 (A : A1 :=
 357                                    (F_STATIC_VALUE .. S_STATIC_VALUE =>
 358                                    (A_STATIC_VALUE, B_STATIC_VALUE))) IS
 359                BEGIN  -- P2D1
 360                     REPORT.FAILED ("BODY OF P2D1 EXECUTED");
 361                EXCEPTION
 362                     WHEN OTHERS =>
 363                          REPORT.FAILED ("EXCEPTION RAISED IN P2D1");
 364                END P2D1;
 365
 366           BEGIN  -- P2D
 367                P2D1;
 368           EXCEPTION
 369                WHEN CONSTRAINT_ERROR =>
 370                     NULL;
 371                WHEN OTHERS =>
 372                     REPORT.FAILED ("WRONG EXCEPTION RAISED - P2D1");
 373           END P2D;
 374
 375           PROCEDURE NEW_P2D IS NEW P2D (INTEGER_TYPE => NUMBER,
 376                                         F_STATIC_VALUE => 21,
 377                                         S_STATIC_VALUE => 37,
 378                                         T_STATIC_VALUE => 67,
 379                                         L_STATIC_VALUE => 79,
 380                                         A_STATIC_VALUE => 7,
 381                                         B_STATIC_VALUE => 93) ;
 382
 383      BEGIN  -- SECOND_STATIC_ARRAY
 384           NEW_P2D (LOWER => 5,
 385                    UPPER => 95);
 386      EXCEPTION
 387           WHEN OTHERS =>
 388                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P2D");
 389      END SECOND_STATIC_ARRAY ;
 390
 391      --------------------------------------------------
 392
 393      REC_NON_STATIC_CONS:
 394
 395      DECLARE
 396
 397 --        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
 398 --            INITIALIZED WITH A STATIC AGGREGATE.
 399
 400           TYPE NUMBER IS RANGE 1 .. 100 ;
 401
 402           GENERIC
 403
 404             TYPE INTEGER_TYPE IS RANGE <> ;
 405             F_STATIC_VALUE : IN INTEGER_TYPE ;
 406             S_STATIC_VALUE : IN INTEGER_TYPE ;
 407             T_STATIC_VALUE : IN INTEGER_TYPE ;
 408             L_STATIC_VALUE : IN INTEGER_TYPE ;
 409             D_STATIC_VALUE : IN INTEGER_TYPE ;
 410
 411           PROCEDURE PE (LOWER  : IN INTEGER_TYPE ;
 412                         UPPER  : IN INTEGER_TYPE) ;
 413
 414           PROCEDURE PE (LOWER  : IN INTEGER_TYPE ;
 415                         UPPER  : IN INTEGER_TYPE) IS
 416
 417                SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE
 418                        RANGE LOWER .. UPPER ;
 419                TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF
 420                      SUBINTEGER_TYPE ;
 421
 422                TYPE REC (DISCRIM : SUBINTEGER_TYPE) IS
 423                     RECORD
 424                          FIRST  : SUBINTEGER_TYPE ;
 425                          SECOND : AR1 ;
 426                     END RECORD ;
 427
 428                SUBTYPE REC4 IS REC (LOWER) ;
 429
 430                PROCEDURE PE1 (R : REC4 := (D_STATIC_VALUE,
 431                                            F_STATIC_VALUE,
 432                                           (S_STATIC_VALUE,
 433                                            T_STATIC_VALUE,
 434                                            L_STATIC_VALUE))) IS
 435                BEGIN  -- PE1
 436                     REPORT.FAILED ("BODY OF PE1 EXECUTED");
 437                EXCEPTION
 438                     WHEN OTHERS =>
 439                          REPORT.FAILED ("EXCEPTION RAISED IN PE1");
 440                END PE1;
 441
 442           BEGIN  -- PE
 443                PE1;
 444           EXCEPTION
 445                WHEN CONSTRAINT_ERROR =>
 446                     NULL;
 447                WHEN OTHERS =>
 448                     REPORT.FAILED ("WRONG EXCEPTION RAISED - PE1");
 449           END PE;
 450
 451           PROCEDURE NEW_PE IS NEW PE (INTEGER_TYPE => NUMBER,
 452                                       F_STATIC_VALUE => 37,
 453                                       S_STATIC_VALUE => 21,
 454                                       T_STATIC_VALUE => 67,
 455                                       L_STATIC_VALUE => 79,
 456                                       D_STATIC_VALUE => 44) ;
 457
 458      BEGIN  -- REC_NON_STATIC_CONS
 459           NEW_PE  (LOWER => 2,
 460                    UPPER => 99);
 461      EXCEPTION
 462           WHEN OTHERS =>
 463                REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PE");
 464      END REC_NON_STATIC_CONS ;
 465
 466      --------------------------------------------------
 467
 468      REPORT.RESULT;
 469
 470 END CC3017B;