1-- A83009B.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 A DERIVED TYPE DECLARATION IN A GENERIC
27--     UNIT MAY DERIVE TWO OR MORE SUBPROGRAM HOMOGRAPHS.
28--     CHECK THE CASES WHERE:
29--          1) THE DERIVED SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF THE
30--             SUBSTITUTION OF THE DERIVED TYPE FOR THE PARENT TYPE IN
31--             THE IMPLICIT SUBPROGRAM SPECIFICATIONS.
32--          2) THE PARENT TYPE IS DECLARED IN A GENERIC INSTANCE AND
33--             THE INSTANCE INCLUDES TWO OR MORE DERIVABLE SUBPROGRAMS
34--             THAT ARE HOMOGRAPHS AS A RESULT OF THE ARGUMENTS GIVEN
35--             FOR THE GENERIC FORMAL-TYPE PARAMETERS.
36--     TEST CASES WHERE THE DERIVED TYPE DECLARATIONS ARE GIVEN IN:
37--          . THE VISIBLE PART OF A GENERIC PACKAGE SPECIFICATION,
38--          . THE PRIVATE PART OF A GENERIC PACKAGE SPECIFICATION,
39--          . A GENERIC PACKAGE BODY,
40--          . A GENERIC SUBPROGRAM BODY.
41--
42-- HISTORY:
43--     DHH 09/20/88 CREATED ORIGINAL TEST.
44
45WITH REPORT; USE REPORT;
46PROCEDURE A83009B IS
47     TYPE ENUM IS (E1, E2, E3);
48
49     GENERIC
50          TYPE T1 IS (<>);
51          TYPE T2 IS (<>);
52     PACKAGE G_PACK IS
53          TYPE PARENT IS (E1, E2, E3);
54
55          PROCEDURE HP (P1 : PARENT; P2 : T1);
56          PROCEDURE HP (P3 : PARENT; P4 : T2);
57
58          FUNCTION HF (P1 : T1) RETURN PARENT;
59          FUNCTION HF (P2 : T2) RETURN PARENT;
60     END G_PACK;
61
62     PACKAGE BODY G_PACK IS
63          PROCEDURE HP (P1 : PARENT; P2 : T1) IS
64          BEGIN
65               NULL;
66          END HP;
67
68          PROCEDURE HP (P3 : PARENT; P4 : T2) IS
69          BEGIN
70               NULL;
71          END HP;
72
73          FUNCTION HF (P1 : T1) RETURN PARENT IS
74          BEGIN
75               RETURN E1;
76          END HF;
77
78          FUNCTION HF (P2 : T2) RETURN PARENT IS
79          BEGIN
80               RETURN E2;
81          END HF;
82     END G_PACK;
83BEGIN
84     TEST ("A83009B", "A DERIVED TYPE DECLARATION IN A GENERIC " &
85                      "UNIT MAY DERIVE TWO OR MORE SUBPROGRAM " &
86                      "HOMOGRAPHS");
87
88     DECLARE
89     -- SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF SUBSTITUTION.
90
91          GENERIC
92          PACKAGE PACK2 IS
93               TYPE CHILD1 IS PRIVATE;
94
95               PACKAGE IN_PACK2 IS
96                    TYPE PARENT IS (E1, E2, E3);
97                    PROCEDURE HP (P1 : PARENT; P2 : CHILD1);
98                    PROCEDURE HP (P3 : CHILD1; P4 : PARENT);
99
100                    FUNCTION HF (P1 : CHILD1; P2 : PARENT)
101                                RETURN PARENT;
102                    FUNCTION HF (P3 : PARENT; P4 : CHILD1)
103                                RETURN PARENT;
104               END IN_PACK2;
105
106               USE IN_PACK2;
107          PRIVATE
108               TYPE CHILD1 IS NEW IN_PACK2.PARENT;  -- PRIVATE PART
109          END PACK2;                                -- OF SPEC.
110
111          PACKAGE BODY PACK2 IS
112               TYPE CHILD2 IS NEW CHILD1;  -- VISIBLE PART OF BODY.
113
114               GENERIC
115               PACKAGE IN_BODY IS
116                    TYPE CHILD3 IS NEW CHILD1; -- VISIBLE PART OF SPEC.
117               END IN_BODY;
118
119               GENERIC
120               PROCEDURE P;
121               PROCEDURE P IS
122                    TYPE CHILD4 IS NEW CHILD1;  -- SUBPROGRAM BODY.
123               BEGIN
124                    NULL;
125               END;
126
127               PACKAGE BODY IN_PACK2 IS
128                    PROCEDURE HP (P1 : PARENT; P2 : CHILD1) IS
129                    BEGIN
130                         NULL;
131                    END HP;
132
133                    PROCEDURE HP (P3 : CHILD1; P4 : PARENT) IS
134                    BEGIN
135                         NULL;
136                    END HP;
137
138                    FUNCTION HF (P1 : CHILD1; P2 : PARENT)
139                                RETURN PARENT IS
140                    BEGIN
141                         RETURN E1;
142                    END HF;
143
144                    FUNCTION HF (P3 : PARENT; P4 : CHILD1)
145                                RETURN PARENT IS
146                    BEGIN
147                         RETURN E2;
148                    END HF;
149               END IN_PACK2;
150          BEGIN
151               NULL;
152          END PACK2;
153     BEGIN
154          NULL;
155     END;
156
157     DECLARE
158     -- PARENT TYPE IN GENERIC INSTANCE HAS DERIVABLE HOMOGRAPHS.
159
160          GENERIC
161          PACKAGE PACK1 IS
162               PACKAGE INSTANCE2 IS
163                  NEW G_PACK (CHARACTER, CHARACTER);
164
165               TYPE CHILD2 IS NEW INSTANCE2.PARENT;
166               TYPE CHILD3 IS PRIVATE;
167          PRIVATE
168               PACKAGE INSTANCE3 IS
169                    NEW G_PACK (ENUM, ENUM);
170
171               TYPE CHILD3 IS NEW INSTANCE3.PARENT;
172          END PACK1;
173
174          GENERIC
175          PROCEDURE P1;
176          PROCEDURE P1 IS
177               PACKAGE INSTANCE4 IS
178                    NEW G_PACK (BOOLEAN, BOOLEAN);
179
180               TYPE CHILD4 IS NEW INSTANCE4.PARENT;
181          BEGIN
182               NULL;
183          END P1;
184
185          PACKAGE BODY PACK1 IS
186               PACKAGE INSTANCE5 IS
187                    NEW G_PACK (ENUM, ENUM);
188
189               TYPE CHILD5 IS NEW INSTANCE5.PARENT;
190          END PACK1;
191     BEGIN
192          NULL;
193     END;
194
195     RESULT;
196END A83009B;
197