gcc/testsuite/ada/acats/tests/c8/c83032a.ada

   1 -- C83032A.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 AN IMPLICIT DECLARATION OF A PREDEFINED OPERATOR OR
  27 --     AN ENUMERATION LITERAL IS HIDDEN BY A DERIVED SUBPROGRAM
  28 --     HOMOGRAPH.
  29
  30 -- HISTORY:
  31 --     VCL  08/10/88  CREATED ORIGINAL TEST.
  32
  33 WITH REPORT; USE REPORT;
  34 PROCEDURE C83032A IS
  35 BEGIN
  36      TEST ("C83032A", "AN IMPLICIT DECLARATION OF A PREDEFINED " &
  37                       "OPERATOR OR AN ENUMERATION LITERAL IS HIDDEN " &
  38                       "BY A DERIVED SUBPROGRAM HOMOGRAPH");
  39
  40      DECLARE             -- CHECK PREDEFINED OPERATOR.
  41           PACKAGE P IS
  42                TYPE INT IS RANGE -20 .. 20;
  43                FUNCTION "ABS" (X : INT) RETURN INT;
  44           END P;
  45           USE P;
  46
  47           TYPE NINT IS NEW INT;
  48
  49           I2 : NINT := -5;
  50
  51           PACKAGE BODY P IS
  52                I1 : NINT := 5;
  53
  54                FUNCTION "ABS" (X : INT) RETURN INT IS
  55                BEGIN
  56                     RETURN INT (- (ABS (INTEGER (X))));
  57                END "ABS";
  58
  59           BEGIN
  60                IF "ABS"(I1) /= -5 THEN
  61                     FAILED ("INCORRECT VALUE FOR 'I1' AFTER CALL " &
  62                             "TO DERIVED ""ABS"" - 1");
  63                END IF;
  64
  65                I1 := ABS (-10);
  66                IF ABS I1 /= NINT(IDENT_INT (-10)) THEN
  67                     FAILED ("INCORRECT VALUE FOR 'I1' AFTER CALL " &
  68                             "TO DERIVED ""ABS"" - 2");
  69                END IF;
  70           END P;
  71      BEGIN
  72           IF "ABS"(I2) /= -5 THEN
  73                FAILED ("INCORRECT VALUE FOR 'I2' AFTER CALL " &
  74                     "TO DERIVED ""ABS"" - 1");
  75           END IF;
  76
  77           I2 := ABS (10);
  78           IF ABS I2 /= NINT (IDENT_INT (-10)) THEN
  79                FAILED ("INCORRECT VALUE FOR 'I1' AFTER CALL " &
  80                         "TO DERIVED ""ABS"" - 2");
  81           END IF;
  82      END;
  83
  84      DECLARE   -- CHECK ENUMERATION LITERALS.
  85
  86           PACKAGE P1 IS
  87                TYPE ENUM1 IS (E11, E12, E13);
  88                TYPE PRIV1 IS PRIVATE;
  89                FUNCTION E11 RETURN PRIV1;
  90           PRIVATE
  91                TYPE PRIV1 IS NEW ENUM1;
  92                TYPE NPRIV1 IS NEW PRIV1;
  93           END P1;
  94           USE P1;
  95
  96           PACKAGE BODY P1 IS
  97                FUNCTION E11 RETURN PRIV1 IS
  98                BEGIN
  99                     RETURN E13;
 100                END E11;
 101           BEGIN
 102                IF NPRIV1'(E11) /= E13 THEN
 103                     FAILED ("INCORRECT VALUE FOR E11");
 104                END IF;
 105           END P1;
 106
 107      BEGIN
 108           NULL;
 109      END;
 110      RESULT;
 111 END C83032A;