1-- C47002D.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 VALUES BELONGING TO EACH CLASS OF TYPE CAN BE WRITTEN AS
26-- THE OPERANDS OF QUALIFIED EXPRESSIONS.
27-- THIS TEST IS FOR PRIVATE AND LIMITED PRIVATE TYPES.
28
29-- RJW 7/23/86
30
31WITH REPORT; USE REPORT;
32PROCEDURE C47002D IS
33
34BEGIN
35
36     TEST( "C47002D", "CHECK THAT VALUES HAVING PRIVATE AND LIMITED " &
37                      "PRIVATE TYPES CAN BE WRITTEN AS THE OPERANDS " &
38                      "OF QUALIFIED EXPRESSIONS" );
39
40     DECLARE -- PRIVATE TYPES.
41
42          TYPE RESULTS IS (P1, P2, P3, P4, P5);
43
44          PACKAGE PKG1 IS
45               TYPE PINT IS PRIVATE;
46               TYPE PCHAR IS PRIVATE;
47               TYPE PARR IS PRIVATE;
48               TYPE PREC (D : INTEGER) IS PRIVATE;
49               TYPE PACC IS PRIVATE;
50
51               FUNCTION F RETURN PINT;
52               FUNCTION F RETURN PCHAR;
53               FUNCTION F RETURN PARR;
54               FUNCTION F RETURN PREC;
55               FUNCTION F RETURN PACC;
56
57          PRIVATE
58               TYPE PINT IS NEW INTEGER;
59               TYPE PCHAR IS NEW CHARACTER;
60               TYPE PARR IS ARRAY (1 .. 2) OF NATURAL;
61
62               TYPE PREC (D : INTEGER) IS
63                    RECORD
64                         NULL;
65                    END RECORD;
66
67               TYPE PACC IS ACCESS PREC;
68
69          END PKG1;
70
71          PACKAGE BODY PKG1 IS
72               FUNCTION F RETURN PINT IS
73               BEGIN
74                    RETURN 1;
75               END F;
76
77               FUNCTION F RETURN PCHAR IS
78               BEGIN
79                    RETURN 'B';
80               END F;
81
82               FUNCTION F RETURN PARR IS
83               BEGIN
84                    RETURN PARR'(OTHERS => 3);
85               END F;
86
87               FUNCTION F RETURN PREC IS
88               BEGIN
89                    RETURN PREC'(D => 4);
90               END F;
91
92               FUNCTION F RETURN PACC IS
93               BEGIN
94                    RETURN NEW PREC'(F);
95               END F;
96
97          END PKG1;
98
99          PACKAGE PKG2 IS END PKG2;
100
101          PACKAGE BODY PKG2 IS
102               USE PKG1;
103
104               FUNCTION CHECK (P : PINT) RETURN RESULTS IS
105               BEGIN
106                    RETURN  P1;
107               END CHECK;
108
109               FUNCTION CHECK (P : PCHAR) RETURN RESULTS IS
110               BEGIN
111                    RETURN  P2;
112               END CHECK;
113
114               FUNCTION CHECK (P : PARR) RETURN RESULTS IS
115               BEGIN
116                    RETURN  P3;
117               END CHECK;
118
119               FUNCTION CHECK (P : PREC) RETURN RESULTS IS
120               BEGIN
121                    RETURN  P4;
122               END CHECK;
123
124               FUNCTION CHECK (P : PACC) RETURN RESULTS IS
125               BEGIN
126                    RETURN  P5;
127               END CHECK;
128
129          BEGIN
130               IF CHECK (PINT'(F)) /= P1 THEN
131                    FAILED ( "INCORRECT RESULTS FOR TYPE PINT" );
132               END IF;
133
134               IF CHECK (PCHAR'(F)) /= P2 THEN
135                    FAILED ( "INCORRECT RESULTS FOR TYPE PCHAR" );
136               END IF;
137
138               IF CHECK (PARR'(F)) /= P3 THEN
139                    FAILED ( "INCORRECT RESULTS FOR TYPE PARR" );
140               END IF;
141
142               IF CHECK (PREC'(F)) /= P4 THEN
143                    FAILED ( "INCORRECT RESULTS FOR TYPE PREC" );
144               END IF;
145
146               IF CHECK (PACC'(F)) /= P5 THEN
147                    FAILED ( "INCORRECT RESULTS FOR TYPE PACC" );
148               END IF;
149
150          END PKG2;
151
152     BEGIN
153          NULL;
154     END;
155
156     DECLARE -- LIMITED PRIVATE TYPES.
157
158          TYPE RESULTS IS (LP1, LP2, LP3, LP4, LP5);
159
160          PACKAGE PKG1 IS
161               TYPE LPINT IS LIMITED PRIVATE;
162               TYPE LPCHAR IS LIMITED PRIVATE;
163               TYPE LPARR IS LIMITED PRIVATE;
164               TYPE LPREC (D : INTEGER) IS LIMITED PRIVATE;
165               TYPE LPACC IS LIMITED PRIVATE;
166
167               FUNCTION F RETURN LPINT;
168               FUNCTION F RETURN LPCHAR;
169               FUNCTION F RETURN LPARR;
170               FUNCTION F RETURN LPREC;
171               FUNCTION F RETURN LPACC;
172
173          PRIVATE
174               TYPE LPINT IS NEW INTEGER;
175               TYPE LPCHAR IS NEW CHARACTER;
176               TYPE LPARR IS ARRAY (1 .. 2) OF NATURAL;
177
178               TYPE LPREC (D : INTEGER) IS
179                    RECORD
180                         NULL;
181                    END RECORD;
182
183               TYPE LPACC IS ACCESS LPREC;
184
185          END PKG1;
186
187          PACKAGE BODY PKG1 IS
188               FUNCTION F RETURN LPINT IS
189               BEGIN
190                    RETURN 1;
191               END F;
192
193               FUNCTION F RETURN LPCHAR IS
194               BEGIN
195                    RETURN 'B';
196               END F;
197
198               FUNCTION F RETURN LPARR IS
199               BEGIN
200                    RETURN LPARR'(OTHERS => 3);
201               END F;
202
203               FUNCTION F RETURN LPREC IS
204               BEGIN
205                    RETURN LPREC'(D => 4);
206               END F;
207
208               FUNCTION F RETURN LPACC IS
209               BEGIN
210                    RETURN NEW LPREC'(F);
211               END F;
212
213          END PKG1;
214
215          PACKAGE PKG2 IS END PKG2;
216
217          PACKAGE BODY PKG2 IS
218               USE PKG1;
219
220               FUNCTION CHECK (LP : LPINT) RETURN RESULTS IS
221               BEGIN
222                    RETURN  LP1;
223               END CHECK;
224
225               FUNCTION CHECK (LP : LPCHAR) RETURN RESULTS IS
226               BEGIN
227                    RETURN  LP2;
228               END CHECK;
229
230               FUNCTION CHECK (LP : LPARR) RETURN RESULTS IS
231               BEGIN
232                    RETURN  LP3;
233               END CHECK;
234
235               FUNCTION CHECK (LP : LPREC) RETURN RESULTS IS
236               BEGIN
237                    RETURN  LP4;
238               END CHECK;
239
240               FUNCTION CHECK (LP : LPACC) RETURN RESULTS IS
241               BEGIN
242                    RETURN  LP5;
243               END CHECK;
244
245          BEGIN
246               IF CHECK (LPINT'(F)) /= LP1 THEN
247                    FAILED ( "INCORRECT RESULTS FOR TYPE LPINT" );
248               END IF;
249
250               IF CHECK (LPCHAR'(F)) /= LP2 THEN
251                    FAILED ( "INCORRECT RESULTS FOR TYPE LPCHAR" );
252               END IF;
253
254               IF CHECK (LPARR'(F)) /= LP3 THEN
255                    FAILED ( "INCORRECT RESULTS FOR TYPE LPARR" );
256               END IF;
257
258               IF CHECK (LPREC'(F)) /= LP4 THEN
259                    FAILED ( "INCORRECT RESULTS FOR TYPE LPREC" );
260               END IF;
261
262               IF CHECK (LPACC'(F)) /= LP5 THEN
263                    FAILED ( "INCORRECT RESULTS FOR TYPE LPACC" );
264               END IF;
265
266          END PKG2;
267
268     BEGIN
269          NULL;
270     END;
271
272     RESULT;
273END C47002D;
274