gcc/testsuite/ada/acats/tests/c7/c74210a.ada

   1 -- C74210A.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 OPERATOR SYMBOLS OVERLOADED IN A PACKAGE ARE
  26 --   USED AND DERIVED IN PREFERENCE TO THOSE OF THE PARENT OF A DERIVED
  27 --   PRIVATE TYPE.
  28
  29 -- CHECK THAT OPERATOR DEFINITIONS FOR A PRIVATE TYPE MAY BE
  30 --   OVERLOADED OUTSIDE THE PACKAGE.
  31
  32 -- CHECK THAT EQUALITY CAN BE DEFINED FOR LIMITED TYPES AND COMPOSITE
  33 --   TYPES WITH LIMITED COMPONENTS.
  34
  35 -- DAT 5/11/81
  36
  37 WITH REPORT; USE REPORT;
  38
  39 PROCEDURE C74210A IS
  40 BEGIN
  41      TEST ("C74210A", "OVERLOADED OPERATORS FOR PRIVATE TYPES");
  42
  43      DECLARE
  44           PACKAGE P IS
  45                TYPE T IS PRIVATE;
  46                FUNCTION "+" (X, Y : T) RETURN T;
  47                ONE, TWO : CONSTANT T;
  48
  49                TYPE L IS LIMITED PRIVATE;
  50                TYPE A IS ARRAY (0 .. 0) OF L;
  51                TYPE R IS RECORD
  52                     C : L;
  53                END RECORD;
  54                FUNCTION "=" (X, Y : L) RETURN BOOLEAN;
  55           PRIVATE
  56                TYPE T IS NEW INTEGER;
  57                ONE : CONSTANT T := T(IDENT_INT(1));
  58                TWO : CONSTANT T := T(IDENT_INT(2));
  59                TYPE L IS (ENUM);
  60           END P;
  61           USE P;
  62
  63           VR : R;
  64           VA : A;
  65
  66           PACKAGE BODY P IS
  67                FUNCTION "+" (X, Y : T) RETURN T IS
  68                BEGIN
  69                     RETURN 1;
  70                END "+";
  71
  72                FUNCTION "=" (X, Y : L) RETURN BOOLEAN IS
  73                BEGIN
  74                     RETURN IDENT_BOOL(FALSE);
  75                END "=";
  76           BEGIN
  77                VR := (C => ENUM);
  78                VA := (0 => VR.C);
  79           END P;
  80      BEGIN
  81           IF ONE + TWO /= ONE THEN
  82                FAILED ("WRONG ""+"" OPERATOR");
  83           END IF;
  84
  85           DECLARE
  86                TYPE NEW_T IS NEW T;
  87
  88                FUNCTION "=" (X, Y : A) RETURN BOOLEAN;
  89                FUNCTION "=" (X, Y : R) RETURN BOOLEAN;
  90
  91                FUNCTION "+" (X, Y : T) RETURN T IS
  92                BEGIN
  93                     RETURN TWO;
  94                END "+";
  95
  96                FUNCTION "=" (X, Y : A) RETURN BOOLEAN IS
  97                BEGIN
  98                     RETURN X(0) = Y(0);
  99                END "=";
 100
 101                FUNCTION "=" (X, Y : R) RETURN BOOLEAN IS
 102                BEGIN
 103                     RETURN X.C = Y.C;
 104                END "=";
 105           BEGIN
 106                IF ONE + TWO /= TWO THEN
 107                     FAILED ("WRONG DERIVED ""+"" OPERATOR");
 108                END IF;
 109
 110                IF VR = VR OR VA = VA THEN
 111                     FAILED ("CANNOT OVERLOAD ""="" CORRECTLY");
 112                END IF;
 113           END;
 114      END;
 115
 116      RESULT;
 117 END C74210A;