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