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

   1 -- CC3605A.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 SOME DIFFERENCES BETWEEN THE FORMAL AND THE
  27 --     ACTUAL SUBPROGRAMS DO NOT INVALIDATE A MATCH.
  28 --          1)  CHECK DIFFERENT PARAMETER NAMES.
  29 --          2)  CHECK DIFFERENT PARAMETER CONSTRAINTS.
  30 --          3)  CHECK ONE PARAMETER CONSTRAINED AND THE OTHER
  31 --               UNCONSTRAINED (WITH ARRAY, RECORD, ACCESS, AND
  32 --               PRIVATE TYPES).
  33 --          4)  CHECK PRESENCE OR ABSENCE OF AN EXPLICIT "IN" MODE
  34 --               INDICATOR.
  35 --          5)  DIFFERENT TYPE MARKS USED TO SPECIFY THE TYPE OF
  36 --               PARAMETERS.
  37
  38 -- HISTORY:
  39 --     LDC 10/04/88  CREATED ORIGINAL TEST.
  40
  41 PACKAGE CC3605A_PACK IS
  42
  43      SUBTYPE INT IS INTEGER RANGE -100 .. 100;
  44
  45      TYPE PRI_TYPE (SIZE : INT) IS PRIVATE;
  46
  47      SUBTYPE PRI_CONST IS PRI_TYPE (2);
  48
  49 PRIVATE
  50
  51      TYPE ARR_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
  52
  53      TYPE PRI_TYPE (SIZE : INT) IS
  54           RECORD
  55                SUB_A : ARR_TYPE (1 .. SIZE);
  56           END RECORD;
  57
  58 END CC3605A_PACK;
  59
  60
  61 WITH REPORT;
  62 USE  REPORT;
  63 WITH CC3605A_PACK;
  64 USE  CC3605A_PACK;
  65
  66 PROCEDURE CC3605A IS
  67
  68      SUBTYPE ZERO_TO_TEN IS INTEGER
  69           RANGE IDENT_INT (0) .. IDENT_INT (10);
  70
  71      SUBTYPE ONE_TO_FIVE IS INTEGER
  72           RANGE IDENT_INT (1) .. IDENT_INT (5);
  73
  74      SUBPRG_ACT : BOOLEAN := FALSE;
  75 BEGIN
  76      TEST
  77           ("CC3605A", "CHECK THAT SOME DIFFERENCES BETWEEN THE " &
  78                       "FORMAL AND THE ACTUAL PARAMETERS DO NOT " &
  79                       "INVALIDATE A MATCH");
  80
  81 ----------------------------------------------------------------------
  82 -- DIFFERENT PARAMETER NAMES
  83 ----------------------------------------------------------------------
  84
  85      DECLARE
  86
  87           PROCEDURE ACT_PROC (DIFF_NAME_PARM : ONE_TO_FIVE) IS
  88           BEGIN
  89                SUBPRG_ACT := TRUE;
  90           END ACT_PROC;
  91
  92           GENERIC
  93
  94                WITH PROCEDURE PASSED_PROC (PARM : ONE_TO_FIVE);
  95
  96           PROCEDURE GEN_PROC;
  97
  98           PROCEDURE GEN_PROC IS
  99           BEGIN
 100                PASSED_PROC (ONE_TO_FIVE'FIRST);
 101           END GEN_PROC;
 102
 103           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
 104      BEGIN
 105           INST_PROC;
 106           IF NOT SUBPRG_ACT THEN
 107                FAILED
 108                     ("DIFFERENT PARAMETER NAMES MADE MATCH INVALID");
 109           END IF;
 110      END;
 111
 112 ----------------------------------------------------------------------
 113 -- DIFFERENT PARAMETER CONSTRAINTS
 114 ----------------------------------------------------------------------
 115
 116      DECLARE
 117
 118           PROCEDURE ACT_PROC (PARM : ONE_TO_FIVE) IS
 119           BEGIN
 120                SUBPRG_ACT := TRUE;
 121           END ACT_PROC;
 122
 123           GENERIC
 124
 125                WITH PROCEDURE PASSED_PROC (PARM : ZERO_TO_TEN);
 126
 127           PROCEDURE GEN_PROC;
 128
 129           PROCEDURE GEN_PROC IS
 130           BEGIN
 131                PASSED_PROC (ONE_TO_FIVE'FIRST);
 132           END GEN_PROC;
 133
 134           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
 135      BEGIN
 136           SUBPRG_ACT := FALSE;
 137           INST_PROC;
 138           IF NOT SUBPRG_ACT THEN
 139                FAILED
 140                     ("DIFFERENT PARAMETER CONSTRAINTS MADE MATCH " &
 141                      "INVALID");
 142           END IF;
 143      END;
 144
 145 ----------------------------------------------------------------------
 146 -- ONE PARAMETER CONSTRAINED (ARRAY)
 147 ----------------------------------------------------------------------
 148
 149      DECLARE
 150
 151           TYPE ARR_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
 152
 153           SUBTYPE ARR_CONST IS ARR_TYPE (ONE_TO_FIVE'FIRST ..
 154                ONE_TO_FIVE'LAST);
 155
 156           PASSED_PARM : ARR_CONST := (OTHERS => TRUE);
 157
 158           PROCEDURE ACT_PROC (PARM : ARR_CONST) IS
 159           BEGIN
 160                SUBPRG_ACT := TRUE;
 161           END ACT_PROC;
 162
 163           GENERIC
 164
 165                WITH PROCEDURE PASSED_PROC (PARM : ARR_TYPE);
 166
 167           PROCEDURE GEN_PROC;
 168
 169           PROCEDURE GEN_PROC IS
 170           BEGIN
 171                PASSED_PROC (PASSED_PARM);
 172           END GEN_PROC;
 173
 174           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
 175      BEGIN
 176           SUBPRG_ACT := FALSE;
 177           INST_PROC;
 178           IF NOT SUBPRG_ACT THEN
 179                FAILED
 180                     ("ONE ARRAY PARAMETER CONSTRAINED MADE MATCH " &
 181                      "INVALID");
 182           END IF;
 183      END;
 184
 185 ----------------------------------------------------------------------
 186 -- ONE PARAMETER CONSTRAINED (RECORDS)
 187 ----------------------------------------------------------------------
 188
 189      DECLARE
 190
 191           TYPE REC_TYPE (BOL : BOOLEAN) IS
 192                RECORD
 193                     SUB_A : INTEGER;
 194                     CASE BOL IS
 195                          WHEN TRUE =>
 196                               DSCR_A : INTEGER;
 197
 198                          WHEN FALSE =>
 199                               DSCR_B : BOOLEAN;
 200
 201                     END CASE;
 202                END RECORD;
 203
 204           SUBTYPE REC_CONST IS REC_TYPE (TRUE);
 205
 206           PASSED_PARM : REC_CONST := (TRUE, 1, 2);
 207
 208           PROCEDURE ACT_PROC (PARM : REC_CONST) IS
 209           BEGIN
 210                SUBPRG_ACT := TRUE;
 211           END ACT_PROC;
 212
 213           GENERIC
 214
 215                WITH PROCEDURE PASSED_PROC (PARM : REC_TYPE);
 216
 217           PROCEDURE GEN_PROC;
 218
 219           PROCEDURE GEN_PROC IS
 220           BEGIN
 221                PASSED_PROC (PASSED_PARM);
 222           END GEN_PROC;
 223
 224           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
 225      BEGIN
 226           SUBPRG_ACT := FALSE;
 227           INST_PROC;
 228           IF NOT SUBPRG_ACT THEN
 229                FAILED
 230                     ("ONE RECORD PARAMETER CONSTRAINED MADE MATCH " &
 231                      "INVALID");
 232           END IF;
 233      END;
 234
 235 ----------------------------------------------------------------------
 236 -- ONE PARAMETER CONSTRAINED (ACCESS)
 237 ----------------------------------------------------------------------
 238
 239      DECLARE
 240
 241           TYPE ARR_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
 242
 243           SUBTYPE ARR_CONST     IS ARR_TYPE (ONE_TO_FIVE'FIRST ..
 244                ONE_TO_FIVE'LAST);
 245
 246           TYPE ARR_ACC_TYPE IS ACCESS ARR_TYPE;
 247
 248           SUBTYPE ARR_ACC_CONST IS ARR_ACC_TYPE (1 .. 3);
 249
 250           PASSED_PARM : ARR_ACC_TYPE := NULL;
 251
 252           PROCEDURE ACT_PROC (PARM : ARR_ACC_CONST) IS
 253           BEGIN
 254                SUBPRG_ACT := TRUE;
 255           END ACT_PROC;
 256
 257           GENERIC
 258
 259                WITH PROCEDURE PASSED_PROC (PARM : ARR_ACC_TYPE);
 260
 261           PROCEDURE GEN_PROC;
 262
 263           PROCEDURE GEN_PROC IS
 264           BEGIN
 265                PASSED_PROC (PASSED_PARM);
 266           END GEN_PROC;
 267
 268           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
 269      BEGIN
 270           SUBPRG_ACT := FALSE;
 271           INST_PROC;
 272           IF NOT SUBPRG_ACT THEN
 273                FAILED
 274                     ("ONE ACCESS PARAMETER CONSTRAINED MADE MATCH " &
 275                      "INVALID");
 276           END IF;
 277      END;
 278
 279 ----------------------------------------------------------------------
 280 -- ONE PARAMETER CONSTRAINED (PRIVATE)
 281 ----------------------------------------------------------------------
 282
 283      DECLARE
 284           PASSED_PARM : PRI_CONST;
 285
 286           PROCEDURE ACT_PROC (PARM : PRI_CONST) IS
 287           BEGIN
 288                SUBPRG_ACT := TRUE;
 289           END ACT_PROC;
 290
 291           GENERIC
 292
 293                WITH PROCEDURE PASSED_PROC (PARM : PRI_TYPE);
 294
 295           PROCEDURE GEN_PROC;
 296
 297           PROCEDURE GEN_PROC IS
 298           BEGIN
 299                PASSED_PROC (PASSED_PARM);
 300           END GEN_PROC;
 301
 302           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
 303      BEGIN
 304           SUBPRG_ACT := FALSE;
 305           INST_PROC;
 306           IF NOT SUBPRG_ACT THEN
 307                FAILED
 308                     ("ONE PRIVATE PARAMETER CONSTRAINED MADE MATCH " &
 309                      "INVALID");
 310           END IF;
 311      END;
 312
 313 ----------------------------------------------------------------------
 314 -- PRESENCE (OR ABSENCE) OF AN EXPLICIT "IN" MODE
 315 ----------------------------------------------------------------------
 316
 317      DECLARE
 318
 319           PROCEDURE ACT_PROC (PARM : INTEGER) IS
 320           BEGIN
 321                SUBPRG_ACT := TRUE;
 322           END ACT_PROC;
 323
 324           GENERIC
 325
 326                WITH PROCEDURE PASSED_PROC (PARM : IN INTEGER);
 327
 328           PROCEDURE GEN_PROC;
 329
 330           PROCEDURE GEN_PROC IS
 331           BEGIN
 332                PASSED_PROC (1);
 333           END GEN_PROC;
 334
 335           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
 336      BEGIN
 337           SUBPRG_ACT := FALSE;
 338           INST_PROC;
 339           IF NOT SUBPRG_ACT THEN
 340                FAILED
 341                      ("PRESENCE OF AN EXPLICIT 'IN' MODE MADE MATCH " &
 342                      "INVALID");
 343           END IF;
 344      END;
 345
 346 ----------------------------------------------------------------------
 347 -- DIFFERENT TYPE MARKS
 348 ----------------------------------------------------------------------
 349
 350      DECLARE
 351
 352           SUBTYPE MARK_1_TYPE IS INTEGER;
 353
 354           SUBTYPE MARK_2_TYPE IS INTEGER;
 355
 356           PROCEDURE ACT_PROC (PARM1 : IN MARK_1_TYPE) IS
 357           BEGIN
 358                SUBPRG_ACT := TRUE;
 359           END ACT_PROC;
 360
 361           GENERIC
 362
 363                WITH PROCEDURE PASSED_PROC (PARM2 : MARK_2_TYPE);
 364
 365           PROCEDURE GEN_PROC;
 366
 367           PROCEDURE GEN_PROC IS
 368           BEGIN
 369                PASSED_PROC (1);
 370           END GEN_PROC;
 371
 372           PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC);
 373      BEGIN
 374           SUBPRG_ACT := FALSE;
 375           INST_PROC;
 376           IF NOT SUBPRG_ACT THEN
 377                FAILED ("DIFFERENT TYPE MARKS MADE MATCH INVALID");
 378           END IF;
 379      END;
 380      RESULT;
 381 END CC3605A;