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
37WITH REPORT; USE REPORT;
38
39PROCEDURE C74210A IS
40BEGIN
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;
117END C74210A;
118