gcc/testsuite/ada/acats/tests/c6/c67002c.ada

   1 -- C67002C.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 ALL OPERATOR SYMBOLS CAN BE USED IN (OVERLOADED)
  26 -- FUNCTION SPECIFICATIONS WITH THE REQUIRED NUMBER OF PARAMETERS.
  27 -- THIS TEST CHECKS FORMAL SUBPROGRAM PARAMETERS.
  28 --   SUBTESTS ARE:
  29 --        (A) THROUGH (P): "=", "AND", "OR", "XOR", "<", "<=",
  30 --             ">", ">=", "&", "*", "/", "MOD", "REM", "**", "+", "-",
  31 --             RESPECTIVELY.  ALL OF THESE HAVE TWO PARAMETERS.
  32 --        (Q), (R), (S), AND (T): "+", "-", "NOT", "ABS", RESPECTIVELY,
  33 --             WITH ONE PARAMETER.
  34
  35 -- CPP 6/26/84
  36
  37 WITH REPORT;  USE REPORT;
  38 PROCEDURE C67002C IS
  39
  40      FUNCTION TWO_PARAMS (I1, I2 : INTEGER) RETURN CHARACTER IS
  41      BEGIN
  42           IF I1 > I2 THEN
  43                RETURN 'G';
  44           ELSE RETURN 'L';
  45           END IF;
  46      END TWO_PARAMS;
  47
  48      FUNCTION ONE_PARAM (I1 : INTEGER) RETURN CHARACTER IS
  49      BEGIN
  50           IF I1 < IDENT_INT(0) THEN
  51                RETURN 'N';
  52           ELSE RETURN 'P';
  53           END IF;
  54      END ONE_PARAM;
  55
  56 BEGIN
  57      TEST ("C67002C", "USE OF OPERATOR SYMBOLS IN " &
  58            "(OVERLOADED) FUNCTION SPECIFICATIONS");
  59
  60      -------------------------------------------------
  61
  62      DECLARE -- (A)
  63
  64           PACKAGE EQU IS
  65                TYPE  LP IS LIMITED PRIVATE;
  66                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
  67           PRIVATE
  68                TYPE LP IS NEW INTEGER;
  69           END EQU;
  70           USE EQU;
  71
  72           LP1, LP2 : LP;
  73
  74           PACKAGE BODY EQU IS
  75                FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN IS
  76                BEGIN
  77                     RETURN LPA > LPB;
  78                END "=";
  79           BEGIN
  80                LP1 := LP (IDENT_INT (7));
  81                LP2 := LP (IDENT_INT (8));
  82           END EQU;
  83
  84           GENERIC
  85                WITH FUNCTION "=" (LPA, LPB : LP) RETURN BOOLEAN;
  86           PACKAGE PKG IS
  87           END PKG;
  88
  89           PACKAGE BODY PKG IS
  90           BEGIN
  91                IF (LP1 = LP2) OR NOT (LP2 = LP1) OR
  92                   (LP1 = LP1) OR (LP2 /= LP1) THEN
  93                     FAILED ("OVERLOADING OF ""="" OPERATOR DEFECTIVE");
  94                END IF;
  95           END PKG;
  96
  97           PACKAGE EQUAL IS NEW PKG ("=" => EQU."=");
  98
  99      BEGIN -- (A)
 100           NULL;
 101      END; -- (A)
 102
 103      -------------------------------------------------
 104
 105      DECLARE -- (B)
 106
 107           GENERIC
 108                WITH FUNCTION "AND" (I1, I2 : INTEGER) RETURN CHARACTER;
 109           PACKAGE PKG IS
 110           END PKG;
 111
 112           PACKAGE BODY PKG IS
 113           BEGIN
 114                IF (IDENT_INT (10) AND 1) /= 'G' OR
 115                   (5 AND 10) /= 'L' THEN
 116                    FAILED ("OVERLOADING OF ""AND"" OPERATOR DEFECTIVE");
 117                END IF;
 118           END PKG;
 119
 120           PACKAGE PACK IS NEW PKG ("AND" => TWO_PARAMS);
 121
 122      BEGIN -- (B)
 123           NULL;
 124      END; -- (B)
 125
 126      -------------------------------------------------
 127
 128      DECLARE -- (C)
 129
 130           GENERIC
 131                WITH FUNCTION "OR" (I1, I2 : INTEGER) RETURN CHARACTER;
 132           PACKAGE PKG IS
 133           END PKG;
 134
 135           PACKAGE BODY PKG IS
 136           BEGIN
 137                IF (IDENT_INT (10) OR 1) /= 'G' OR
 138                   (5 OR 10) /= 'L' THEN
 139                     FAILED ("OVERLOADING OF ""OR"" OPERATOR DEFECTIVE");
 140                END IF;
 141           END PKG;
 142
 143           PACKAGE PACK IS NEW PKG ("OR" => TWO_PARAMS);
 144
 145      BEGIN -- (C)
 146           NULL;
 147      END; -- (C)
 148
 149      -------------------------------------------------
 150
 151      DECLARE -- (D)
 152
 153           GENERIC
 154                WITH FUNCTION "XOR" (I1, I2 : INTEGER) RETURN CHARACTER;
 155           PACKAGE PKG IS
 156           END PKG;
 157
 158           PACKAGE BODY PKG IS
 159           BEGIN
 160                IF (IDENT_INT (10) XOR 1) /= 'G' OR
 161                   (5 XOR 10) /= 'L' THEN
 162                    FAILED ("OVERLOADING OF ""XOR"" OPERATOR DEFECTIVE");
 163                END IF;
 164           END PKG;
 165
 166           PACKAGE PACK IS NEW PKG ("XOR" => TWO_PARAMS);
 167
 168      BEGIN -- (D)
 169           NULL;
 170      END; -- (D)
 171
 172      -------------------------------------------------
 173
 174      DECLARE -- (E)
 175
 176           GENERIC
 177                WITH FUNCTION "<" (I1, I2 : INTEGER) RETURN CHARACTER;
 178           PACKAGE PKG IS
 179           END PKG;
 180
 181           PACKAGE BODY PKG IS
 182           BEGIN
 183                IF (IDENT_INT (10) < 1) /= 'G' OR
 184                   (5 < 10) /= 'L' THEN
 185                     FAILED ("OVERLOADING OF ""<"" OPERATOR DEFECTIVE");
 186                END IF;
 187           END PKG;
 188
 189           PACKAGE PACK IS NEW PKG ("<" => TWO_PARAMS);
 190
 191      BEGIN -- (E)
 192           NULL;
 193      END; -- (E)
 194
 195      -------------------------------------------------
 196
 197      DECLARE -- (F)
 198
 199           GENERIC
 200                WITH FUNCTION "<=" (I1, I2 : INTEGER) RETURN CHARACTER;
 201           PACKAGE PKG IS
 202           END PKG;
 203
 204           PACKAGE BODY PKG IS
 205           BEGIN
 206                IF (IDENT_INT (10) <= 1) /= 'G' OR
 207                   (5 <= 10) /= 'L' THEN
 208                     FAILED ("OVERLOADING OF ""<="" OPERATOR DEFECTIVE");
 209                END IF;
 210           END PKG;
 211
 212           PACKAGE PACK IS NEW PKG ("<=" => TWO_PARAMS);
 213
 214      BEGIN -- (F)
 215           NULL;
 216      END; -- (F)
 217
 218      -------------------------------------------------
 219
 220      DECLARE -- (G)
 221
 222           GENERIC
 223                WITH FUNCTION ">" (I1, I2 : INTEGER) RETURN CHARACTER;
 224           PACKAGE PKG IS
 225           END PKG;
 226
 227           PACKAGE BODY PKG IS
 228           BEGIN
 229                IF (IDENT_INT (10) > 1) /= 'G' OR
 230                   (5 > 10) /= 'L' THEN
 231                     FAILED ("OVERLOADING OF "">"" OPERATOR DEFECTIVE");
 232                END IF;
 233           END PKG;
 234
 235           PACKAGE PACK IS NEW PKG (">" => TWO_PARAMS);
 236
 237      BEGIN -- (G)
 238           NULL;
 239      END; -- (G)
 240
 241      -------------------------------------------------
 242
 243      DECLARE -- (H)
 244
 245           GENERIC
 246                WITH FUNCTION ">=" (I1, I2 : INTEGER) RETURN CHARACTER;
 247           PACKAGE PKG IS
 248           END PKG;
 249
 250           PACKAGE BODY PKG IS
 251           BEGIN
 252                IF (IDENT_INT (10) >= 1) /= 'G' OR
 253                   (5 >= 10) /= 'L' THEN
 254                     FAILED ("OVERLOADING OF "">="" OPERATOR DEFECTIVE");
 255                END IF;
 256           END PKG;
 257
 258           PACKAGE PACK IS NEW PKG (">=" => TWO_PARAMS);
 259
 260      BEGIN -- (H)
 261           NULL;
 262      END; -- (H)
 263
 264      -------------------------------------------------
 265
 266      DECLARE -- (I)
 267
 268           GENERIC
 269                WITH FUNCTION "&" (I1, I2 : INTEGER) RETURN CHARACTER;
 270           PACKAGE PKG IS
 271           END PKG;
 272
 273           PACKAGE BODY PKG IS
 274           BEGIN
 275                IF (IDENT_INT (10) & 1) /= 'G' OR
 276                   (5 & 10) /= 'L' THEN
 277                     FAILED ("OVERLOADING OF ""&"" OPERATOR DEFECTIVE");
 278                END IF;
 279           END PKG;
 280
 281           PACKAGE PACK IS NEW PKG ("&" => TWO_PARAMS);
 282
 283      BEGIN -- (I)
 284           NULL;
 285      END; -- (I)
 286
 287      -------------------------------------------------
 288
 289      DECLARE -- (J)
 290
 291           GENERIC
 292                WITH FUNCTION "*" (I1, I2 : INTEGER) RETURN CHARACTER;
 293           PACKAGE PKG IS
 294           END PKG;
 295
 296           PACKAGE BODY PKG IS
 297           BEGIN
 298                IF (IDENT_INT (10) * 1) /= 'G' OR
 299                   (5 * 10) /= 'L' THEN
 300                     FAILED ("OVERLOADING OF ""*"" OPERATOR DEFECTIVE");
 301                END IF;
 302           END PKG;
 303
 304           PACKAGE PACK IS NEW PKG ("*" => TWO_PARAMS);
 305
 306      BEGIN -- (J)
 307           NULL;
 308      END; -- (J)
 309
 310      -------------------------------------------------
 311
 312      DECLARE -- (K)
 313
 314           GENERIC
 315                WITH FUNCTION "/" (I1, I2 : INTEGER) RETURN CHARACTER;
 316           PACKAGE PKG IS
 317           END PKG;
 318
 319           PACKAGE BODY PKG IS
 320           BEGIN
 321                IF (IDENT_INT (10) / 1) /= 'G' OR
 322                   (5 / 10) /= 'L' THEN
 323                     FAILED ("OVERLOADING OF ""/"" OPERATOR DEFECTIVE");
 324                END IF;
 325           END PKG;
 326
 327           PACKAGE PACK IS NEW PKG ("/" => TWO_PARAMS);
 328
 329      BEGIN -- (K)
 330           NULL;
 331      END; -- (K)
 332
 333      -------------------------------------------------
 334
 335      DECLARE -- (L)
 336
 337           GENERIC
 338                WITH FUNCTION "MOD" (I1, I2 : INTEGER) RETURN CHARACTER;
 339           PACKAGE PKG IS
 340           END PKG;
 341
 342           PACKAGE BODY PKG IS
 343           BEGIN
 344                IF (IDENT_INT (10) MOD 1) /= 'G' OR
 345                   (5 MOD 10) /= 'L' THEN
 346                    FAILED ("OVERLOADING OF ""MOD"" OPERATOR DEFECTIVE");
 347                END IF;
 348           END PKG;
 349
 350           PACKAGE PACK IS NEW PKG ("MOD" => TWO_PARAMS);
 351
 352      BEGIN -- (L)
 353           NULL;
 354      END; -- (L)
 355
 356      -------------------------------------------------
 357
 358      DECLARE -- (M)
 359
 360           GENERIC
 361                WITH FUNCTION "REM" (I1, I2 : INTEGER) RETURN CHARACTER;
 362           PACKAGE PKG IS
 363           END PKG;
 364
 365           PACKAGE BODY PKG IS
 366           BEGIN
 367                IF (IDENT_INT (10) REM 1) /= 'G' OR
 368                   (5 REM 10) /= 'L' THEN
 369                    FAILED ("OVERLOADING OF ""REM"" OPERATOR DEFECTIVE");
 370                END IF;
 371           END PKG;
 372
 373           PACKAGE PACK IS NEW PKG ("REM" => TWO_PARAMS);
 374
 375      BEGIN -- (M)
 376           NULL;
 377      END; -- (M)
 378
 379      -------------------------------------------------
 380
 381      DECLARE -- (N)
 382
 383           GENERIC
 384                WITH FUNCTION "**" (I1, I2 : INTEGER) RETURN CHARACTER;
 385           PACKAGE PKG IS
 386           END PKG;
 387
 388           PACKAGE BODY PKG IS
 389           BEGIN
 390                IF (IDENT_INT (10) ** 1) /= 'G' OR
 391                   (5 ** 10) /= 'L' THEN
 392                     FAILED ("OVERLOADING OF ""**"" OPERATOR DEFECTIVE");
 393                END IF;
 394           END PKG;
 395
 396           PACKAGE PACK IS NEW PKG ("**" => TWO_PARAMS);
 397
 398      BEGIN -- (N)
 399           NULL;
 400      END; -- (N)
 401
 402      -------------------------------------------------
 403
 404      DECLARE -- (O)
 405
 406           GENERIC
 407                WITH FUNCTION "+" (I1, I2 : INTEGER) RETURN CHARACTER;
 408           PACKAGE PKG IS
 409           END PKG;
 410
 411           PACKAGE BODY PKG IS
 412           BEGIN
 413                IF (IDENT_INT (10) + 1) /= 'G' OR
 414                   (5 + 10) /= 'L' THEN
 415                     FAILED ("OVERLOADING OF ""+"" OPERATOR DEFECTIVE");
 416                END IF;
 417           END PKG;
 418
 419           PACKAGE PACK IS NEW PKG ("+" => TWO_PARAMS);
 420
 421      BEGIN -- (O)
 422           NULL;
 423      END; -- (O)
 424
 425      -------------------------------------------------
 426
 427      DECLARE -- (P)
 428
 429           GENERIC
 430                WITH FUNCTION "-" (I1, I2 : INTEGER) RETURN CHARACTER;
 431           PACKAGE PKG IS
 432           END PKG;
 433
 434           PACKAGE BODY PKG IS
 435           BEGIN
 436                IF (IDENT_INT (10) - 1) /= 'G' OR
 437                   (5 - 10) /= 'L' THEN
 438                     FAILED ("OVERLOADING OF ""-"" OPERATOR DEFECTIVE");
 439                END IF;
 440           END PKG;
 441
 442           PACKAGE PACK IS NEW PKG ("-" => TWO_PARAMS);
 443
 444      BEGIN -- (P)
 445           NULL;
 446      END; -- (P)
 447
 448      -------------------------------------------------
 449
 450      DECLARE -- (Q)
 451
 452           GENERIC
 453                WITH FUNCTION "+" (I1 : INTEGER) RETURN CHARACTER;
 454           PACKAGE PKG IS
 455           END PKG;
 456
 457           PACKAGE BODY PKG IS
 458           BEGIN
 459                IF (+ IDENT_INT(25) /= 'P') OR
 460                   (+ (0-25) /= 'N') THEN
 461                     FAILED ("OVERLOADING OF ""+"" " &
 462                             "OPERATOR (ONE OPERAND) DEFECTIVE");
 463                END IF;
 464           END PKG;
 465
 466           PACKAGE PACK IS NEW PKG ("+" => ONE_PARAM);
 467
 468      BEGIN -- (Q)
 469           NULL;
 470      END; -- (Q)
 471
 472      -------------------------------------------------
 473
 474      DECLARE -- (R)
 475
 476           GENERIC
 477                WITH FUNCTION "-" (I1 : INTEGER) RETURN CHARACTER;
 478           PACKAGE PKG IS
 479           END PKG;
 480
 481           PACKAGE BODY PKG IS
 482           BEGIN
 483                IF (- IDENT_INT(25) /= 'P') OR
 484                   (- (0-25) /= 'N') THEN
 485                     FAILED ("OVERLOADING OF ""-"" " &
 486                             "OPERATOR (ONE OPERAND) DEFECTIVE");
 487                END IF;
 488           END PKG;
 489
 490           PACKAGE PACK IS NEW PKG ("-" => ONE_PARAM);
 491
 492      BEGIN -- (R)
 493           NULL;
 494      END; -- (R)
 495
 496      -------------------------------------------------
 497
 498      DECLARE -- (S)
 499
 500           GENERIC
 501                WITH FUNCTION "NOT" (I1 : INTEGER) RETURN CHARACTER;
 502           PACKAGE PKG IS
 503           END PKG;
 504
 505           PACKAGE BODY PKG IS
 506           BEGIN
 507                IF (NOT IDENT_INT(25) /= 'P') OR
 508                   (NOT (0-25) /= 'N') THEN
 509                     FAILED ("OVERLOADING OF ""NOT"" " &
 510                             "OPERATOR (ONE OPERAND) DEFECTIVE");
 511                END IF;
 512           END PKG;
 513
 514           PACKAGE PACK IS NEW PKG ("NOT" => ONE_PARAM);
 515
 516      BEGIN -- (S)
 517           NULL;
 518      END; -- (S)
 519
 520      -------------------------------------------------
 521
 522      DECLARE -- (T)
 523
 524           GENERIC
 525                WITH FUNCTION "ABS" (I1 : INTEGER) RETURN CHARACTER;
 526           PACKAGE PKG IS
 527           END PKG;
 528
 529           PACKAGE BODY PKG IS
 530           BEGIN
 531                IF (ABS IDENT_INT(25) /= 'P') OR
 532                   (ABS (0-25) /= 'N') THEN
 533                     FAILED ("OVERLOADING OF ""ABS"" " &
 534                             "OPERATOR (ONE OPERAND) DEFECTIVE");
 535                END IF;
 536           END PKG;
 537
 538           PACKAGE PACK IS NEW PKG ("ABS" => ONE_PARAM);
 539
 540      BEGIN -- (T)
 541           NULL;
 542      END; -- (T)
 543
 544      -------------------------------------------------
 545
 546      RESULT;
 547 END C67002C;
 548