1-- C34014H.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 SUBPROGRAM IS VISIBLE AND FURTHER DERIVABLE
27--     UNDER APPROPRIATE CIRCUMSTANCES.
28
29--     CHECK WHEN THE DERIVED SUBPROGRAM IS IMPLICITLY DECLARED IN THE
30--     PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT DECLARATION OF A
31--     HOMOGRAPHIC SUBPROGRAM IN THE VISIBLE PART.
32
33-- HISTORY:
34--     JRK 09/16/87  CREATED ORIGINAL TEST.
35
36WITH REPORT; USE REPORT;
37
38PROCEDURE C34014H IS
39
40     PACKAGE P IS
41          TYPE T IS RANGE -100 .. 100;
42          FUNCTION F RETURN T;
43     END P;
44     USE P;
45
46     PACKAGE BODY P IS
47          FUNCTION F RETURN T IS
48          BEGIN
49               RETURN T (IDENT_INT (1));
50          END F;
51     END P;
52
53BEGIN
54     TEST ("C34014H", "CHECK THAT A DERIVED SUBPROGRAM IS VISIBLE " &
55                      "AND FURTHER DERIVABLE UNDER APPROPRIATE " &
56                      "CIRCUMSTANCES.  CHECK WHEN THE DERIVED " &
57                      "SUBPROGRAM IS IMPLICITLY DECLARED IN THE " &
58                      "PRIVATE PART OF A PACKAGE AFTER AN EXPLICIT " &
59                      "DECLARATION OF A HOMOGRAPHIC SUBPROGRAM IN " &
60                      "THE VISIBLE PART");
61
62     -----------------------------------------------------------------
63
64     COMMENT ("NEW SUBPROGRAM DECLARED BY SUBPROGRAM DECLARATION");
65
66     DECLARE
67
68          PACKAGE Q IS
69               TYPE QT IS PRIVATE;
70               C2 : CONSTANT QT;
71               FUNCTION F RETURN QT;
72               TYPE QR1 IS
73                    RECORD
74                         C : QT := F;
75                    END RECORD;
76          PRIVATE
77               TYPE QT IS NEW T;
78               C2 : CONSTANT QT := 2;
79               TYPE QR2 IS
80                    RECORD
81                         C : QT := F;
82                    END RECORD;
83               TYPE QS IS NEW QT;
84          END Q;
85          USE Q;
86
87          PACKAGE BODY Q IS
88               FUNCTION F RETURN QT IS
89               BEGIN
90                    RETURN QT (IDENT_INT (2));
91               END F;
92
93               PACKAGE R IS
94                    X : QR1;
95                    Y : QR2;
96                    Z : QS := F;
97               END R;
98               USE R;
99          BEGIN
100               IF X.C /= 2 THEN
101                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
102                            "DECL - 1");
103               END IF;
104
105               IF Y.C /= 2 THEN
106                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG " &
107                            "DECL - 2");
108               END IF;
109
110               IF Z /= 2 THEN
111                    FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG " &
112                            "DECL - 1");
113               END IF;
114          END Q;
115
116          PACKAGE R IS
117               Y : QT := F;
118               TYPE RT IS NEW QT;
119               Z : RT := F;
120          END R;
121          USE R;
122
123     BEGIN
124          IF Y /= C2 THEN
125               FAILED ("NEW SUBPROGRAM NOT VISIBLE - SUBPROG DECL - 3");
126          END IF;
127
128          IF Z /= RT (C2) THEN
129               FAILED ("NEW SUBPROGRAM NOT DERIVED - SUBPROG DECL - 2");
130          END IF;
131     END;
132
133     -----------------------------------------------------------------
134
135     COMMENT ("NEW SUBPROGRAM DECLARED BY RENAMING");
136
137     DECLARE
138
139          PACKAGE Q IS
140               TYPE QT IS PRIVATE;
141               C2 : CONSTANT QT;
142               FUNCTION G RETURN QT;
143               FUNCTION F RETURN QT RENAMES G;
144               TYPE QR1 IS
145                    RECORD
146                         C : QT := F;
147                    END RECORD;
148          PRIVATE
149               TYPE QT IS NEW T;
150               C2 : CONSTANT QT := 2;
151               TYPE QR2 IS
152                    RECORD
153                         C : QT := F;
154                    END RECORD;
155               TYPE QS IS NEW QT;
156          END Q;
157          USE Q;
158
159          PACKAGE BODY Q IS
160               FUNCTION G RETURN QT IS
161               BEGIN
162                    RETURN QT (IDENT_INT (2));
163               END G;
164
165               PACKAGE R IS
166                    X : QR1;
167                    Y : QR2;
168                    Z : QS := F;
169               END R;
170               USE R;
171          BEGIN
172               IF X.C /= 2 THEN
173                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - " &
174                            "1");
175               END IF;
176
177               IF Y.C /= 2 THEN
178                    FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - " &
179                            "2");
180               END IF;
181
182               IF Z /= 2 THEN
183                    FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - " &
184                            "1");
185               END IF;
186          END Q;
187
188          PACKAGE R IS
189               Y : QT := F;
190               TYPE RT IS NEW QT;
191               Z : RT := F;
192          END R;
193          USE R;
194
195     BEGIN
196          IF Y /= C2 THEN
197               FAILED ("NEW SUBPROGRAM NOT VISIBLE - RENAMING - 3");
198          END IF;
199
200          IF Z /= RT (C2) THEN
201               FAILED ("NEW SUBPROGRAM NOT DERIVED - RENAMING - 2");
202          END IF;
203     END;
204
205     -----------------------------------------------------------------
206
207     RESULT;
208END C34014H;
209