1-- C87B39A.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:
26
27--   A) AN OVERLOADED CALL CAN BE RESOLVED BECAUSE AN ALLOCATOR RETURNS
28--      AN ACCESS TYPE WHOSE DESIGNATED TYPE IS THE TYPE REFERRED TO IN
29--      THE ALLOCATOR.
30--
31--   B) IF THE NAME OF THE DESIGNATED TYPE IN AN ALLOCATOR DOES NOT
32--      UNIQUELY DETERMINE THE ACCESS TYPE OF AN ALLOCATOR, THE CONTEXT
33--      MUST DETERMINE THE TYPE.
34
35-- JBG 1/30/84
36
37WITH REPORT; USE REPORT;
38PROCEDURE C87B39A IS
39
40     TYPE S IS (M, F);
41     TYPE R (D : S) IS
42          RECORD NULL; END RECORD;
43     SUBTYPE M1 IS R(M);
44     SUBTYPE M2 IS R(M);
45
46     TYPE ACC_M1 IS ACCESS M1;
47     TYPE ACC_M2 IS ACCESS M2;
48     TYPE ACC_BOOL IS ACCESS BOOLEAN;
49     TYPE ACC_ACC_M1 IS ACCESS ACC_M1;
50
51     TYPE WHICH IS (IS_M1, IS_M2, IS_BOOL);
52
53     PROCEDURE P (X : ACC_M1; RESOLUTION : WHICH) IS
54     BEGIN
55          IF RESOLUTION /= IS_M1 THEN
56               FAILED ("INCORRECT RESOLUTION -- ACC_M1");
57          END IF;
58     END P;    -- ACC_M1
59
60     PROCEDURE P (X : ACC_M2; RESOLUTION : WHICH) IS
61     BEGIN
62          IF RESOLUTION /= IS_M2 THEN
63               FAILED ("INCORRECT RESOLUTION -- ACC_M2");
64          END IF;
65     END P;    -- ACC_M2
66
67     PROCEDURE P (X : ACC_BOOL; RESOLUTION : WHICH) IS
68     BEGIN
69          IF RESOLUTION /= IS_BOOL THEN
70               FAILED ("INCORRECT RESOLUTION -- ACC_BOOL");
71          END IF;
72     END P;    -- ACC_BOOL
73
74     PROCEDURE P (X : ACC_ACC_M1; RESOLUTION : WHICH) IS
75     BEGIN
76          FAILED ("INCORRECT RESOLUTION -- ACC_ACC_M1");
77     END P;    -- ACC_ACC_M1
78
79     PROCEDURE Q (X : ACC_M1) IS
80     BEGIN
81          NULL;
82     END Q;    -- ACC_M1
83
84     PROCEDURE Q (X : ACC_BOOL) IS
85     BEGIN
86          FAILED ("INCORRECT RESOLUTION -- ACC_BOOL: Q");
87     END Q;    -- ACC_BOOL
88
89BEGIN
90
91     TEST ("C87B39A", "OVERLOADING RESOLUTION FOR ALLOCATORS");
92
93     P (ACC_M1'(NEW R(M)), IS_M1);    -- B
94
95     P (ACC_M2'(NEW M1), IS_M2);      -- B
96
97     P (NEW BOOLEAN'(TRUE), IS_BOOL); -- A
98
99     Q (NEW M2);              -- A
100     Q (NEW M1);              -- A
101     Q (NEW R(M));            -- A
102     Q (NEW R'(D => M));      -- A
103
104     RESULT;
105
106END C87B39A;
107