|
111
|
1 -- C46051A.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 ENUMERATION, RECORD, ACCESS, PRIVATE, AND TASK VALUES CAN
|
|
|
26 -- BE CONVERTED IF THE OPERAND AND TARGET TYPES ARE RELATED BY
|
|
|
27 -- DERIVATION.
|
|
|
28
|
|
|
29 -- R.WILLIAMS 9/8/86
|
|
|
30
|
|
|
31 WITH REPORT; USE REPORT;
|
|
|
32 PROCEDURE C46051A IS
|
|
|
33
|
|
|
34 BEGIN
|
|
|
35 TEST ( "C46051A", "CHECK THAT ENUMERATION, RECORD, ACCESS, " &
|
|
|
36 "PRIVATE, AND TASK VALUES CAN BE CONVERTED " &
|
|
|
37 "IF THE OPERAND AND TARGET TYPES ARE " &
|
|
|
38 "RELATED BY DERIVATION" );
|
|
|
39
|
|
|
40 DECLARE
|
|
|
41 TYPE ENUM IS (A, AB, ABC, ABCD);
|
|
|
42 E : ENUM := ABC;
|
|
|
43
|
|
|
44 TYPE ENUM1 IS NEW ENUM;
|
|
|
45 E1 : ENUM1 := ENUM1'VAL (IDENT_INT (2));
|
|
|
46
|
|
|
47 TYPE ENUM2 IS NEW ENUM;
|
|
|
48 E2 : ENUM2 := ABC;
|
|
|
49
|
|
|
50 TYPE NENUM1 IS NEW ENUM1;
|
|
|
51 NE : NENUM1 := NENUM1'VAL (IDENT_INT (2));
|
|
|
52 BEGIN
|
|
|
53 IF ENUM (E) /= E THEN
|
|
|
54 FAILED ( "INCORRECT CONVERSION OF 'ENUM (E)'" );
|
|
|
55 END IF;
|
|
|
56
|
|
|
57 IF ENUM (E1) /= E THEN
|
|
|
58 FAILED ( "INCORRECT CONVERSION OF 'ENUM (E1)'" );
|
|
|
59 END IF;
|
|
|
60
|
|
|
61 IF ENUM1 (E2) /= E1 THEN
|
|
|
62 FAILED ( "INCORRECT CONVERSION OF 'ENUM1 (E2)'" );
|
|
|
63 END IF;
|
|
|
64
|
|
|
65 IF ENUM2 (NE) /= E2 THEN
|
|
|
66 FAILED ( "INCORRECT CONVERSION OF 'ENUM2 (NE)'" );
|
|
|
67 END IF;
|
|
|
68
|
|
|
69 IF NENUM1 (E) /= NE THEN
|
|
|
70 FAILED ( "INCORRECT CONVERSION OF 'NENUM (E)'" );
|
|
|
71 END IF;
|
|
|
72 EXCEPTION
|
|
|
73 WHEN OTHERS =>
|
|
|
74 FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
|
|
|
75 "ENUMERATION TYPES" );
|
|
|
76 END;
|
|
|
77
|
|
|
78 DECLARE
|
|
|
79 TYPE REC IS
|
|
|
80 RECORD
|
|
|
81 NULL;
|
|
|
82 END RECORD;
|
|
|
83
|
|
|
84 R : REC;
|
|
|
85
|
|
|
86 TYPE REC1 IS NEW REC;
|
|
|
87 R1 : REC1;
|
|
|
88
|
|
|
89 TYPE REC2 IS NEW REC;
|
|
|
90 R2 : REC2;
|
|
|
91
|
|
|
92 TYPE NREC1 IS NEW REC1;
|
|
|
93 NR : NREC1;
|
|
|
94 BEGIN
|
|
|
95 IF REC (R) /= R THEN
|
|
|
96 FAILED ( "INCORRECT CONVERSION OF 'REC (R)'" );
|
|
|
97 END IF;
|
|
|
98
|
|
|
99 IF REC (R1) /= R THEN
|
|
|
100 FAILED ( "INCORRECT CONVERSION OF 'REC (R1)'" );
|
|
|
101 END IF;
|
|
|
102
|
|
|
103 IF REC1 (R2) /= R1 THEN
|
|
|
104 FAILED ( "INCORRECT CONVERSION OF 'REC1 (R2)'" );
|
|
|
105 END IF;
|
|
|
106
|
|
|
107 IF REC2 (NR) /= R2 THEN
|
|
|
108 FAILED ( "INCORRECT CONVERSION OF 'REC2 (NR)'" );
|
|
|
109 END IF;
|
|
|
110
|
|
|
111 IF NREC1 (R) /= NR THEN
|
|
|
112 FAILED ( "INCORRECT CONVERSION OF 'NREC (R)'" );
|
|
|
113 END IF;
|
|
|
114 EXCEPTION
|
|
|
115 WHEN OTHERS =>
|
|
|
116 FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
|
|
|
117 "RECORD TYPES" );
|
|
|
118 END;
|
|
|
119
|
|
|
120 DECLARE
|
|
|
121 TYPE REC (D : INTEGER) IS
|
|
|
122 RECORD
|
|
|
123 NULL;
|
|
|
124 END RECORD;
|
|
|
125
|
|
|
126 SUBTYPE CREC IS REC (3);
|
|
|
127 R : CREC;
|
|
|
128
|
|
|
129 TYPE CREC1 IS NEW REC (3);
|
|
|
130 R1 : CREC1;
|
|
|
131
|
|
|
132 TYPE CREC2 IS NEW REC (3);
|
|
|
133 R2 : CREC2;
|
|
|
134
|
|
|
135 TYPE NCREC1 IS NEW CREC1;
|
|
|
136 NR : NCREC1;
|
|
|
137 BEGIN
|
|
|
138 IF CREC (R) /= R THEN
|
|
|
139 FAILED ( "INCORRECT CONVERSION OF 'CREC (R)'" );
|
|
|
140 END IF;
|
|
|
141
|
|
|
142 IF CREC (R1) /= R THEN
|
|
|
143 FAILED ( "INCORRECT CONVERSION OF 'CREC (R1)'" );
|
|
|
144 END IF;
|
|
|
145
|
|
|
146 IF CREC1 (R2) /= R1 THEN
|
|
|
147 FAILED ( "INCORRECT CONVERSION OF 'CREC1 (R2)'" );
|
|
|
148 END IF;
|
|
|
149
|
|
|
150 IF CREC2 (NR) /= R2 THEN
|
|
|
151 FAILED ( "INCORRECT CONVERSION OF 'CREC2 (NR)'" );
|
|
|
152 END IF;
|
|
|
153
|
|
|
154 IF NCREC1 (R) /= NR THEN
|
|
|
155 FAILED ( "INCORRECT CONVERSION OF 'NCREC (R)'" );
|
|
|
156 END IF;
|
|
|
157 EXCEPTION
|
|
|
158 WHEN OTHERS =>
|
|
|
159 FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
|
|
|
160 "RECORD TYPES WITH DISCRIMINANTS" );
|
|
|
161 END;
|
|
|
162
|
|
|
163 DECLARE
|
|
|
164 TYPE REC IS
|
|
|
165 RECORD
|
|
|
166 NULL;
|
|
|
167 END RECORD;
|
|
|
168
|
|
|
169 TYPE ACCREC IS ACCESS REC;
|
|
|
170 AR : ACCREC;
|
|
|
171
|
|
|
172 TYPE ACCREC1 IS NEW ACCREC;
|
|
|
173 AR1 : ACCREC1;
|
|
|
174
|
|
|
175 TYPE ACCREC2 IS NEW ACCREC;
|
|
|
176 AR2 : ACCREC2;
|
|
|
177
|
|
|
178 TYPE NACCREC1 IS NEW ACCREC1;
|
|
|
179 NAR : NACCREC1;
|
|
|
180
|
|
|
181 FUNCTION F (A : ACCREC) RETURN INTEGER IS
|
|
|
182 BEGIN
|
|
|
183 RETURN IDENT_INT (0);
|
|
|
184 END F;
|
|
|
185
|
|
|
186 FUNCTION F (A : ACCREC1) RETURN INTEGER IS
|
|
|
187 BEGIN
|
|
|
188 RETURN IDENT_INT (1);
|
|
|
189 END F;
|
|
|
190
|
|
|
191 FUNCTION F (A : ACCREC2) RETURN INTEGER IS
|
|
|
192 BEGIN
|
|
|
193 RETURN IDENT_INT (2);
|
|
|
194 END F;
|
|
|
195
|
|
|
196 FUNCTION F (A : NACCREC1) RETURN INTEGER IS
|
|
|
197 BEGIN
|
|
|
198 RETURN IDENT_INT (3);
|
|
|
199 END F;
|
|
|
200
|
|
|
201 BEGIN
|
|
|
202 IF F (ACCREC (AR)) /= 0 THEN
|
|
|
203 FAILED ( "INCORRECT CONVERSION OF 'ACCREC (AR)'" );
|
|
|
204 END IF;
|
|
|
205
|
|
|
206 IF F (ACCREC (AR1)) /= 0 THEN
|
|
|
207 FAILED ( "INCORRECT CONVERSION OF 'ACCREC (AR1)'" );
|
|
|
208 END IF;
|
|
|
209
|
|
|
210 IF F (ACCREC1 (AR2)) /= 1 THEN
|
|
|
211 FAILED ( "INCORRECT CONVERSION OF 'ACCREC1 (AR2)'" );
|
|
|
212 END IF;
|
|
|
213
|
|
|
214 IF F (ACCREC2 (NAR)) /= 2 THEN
|
|
|
215 FAILED ( "INCORRECT CONVERSION OF 'ACCREC2 (NAR)'" );
|
|
|
216 END IF;
|
|
|
217
|
|
|
218 IF F (NACCREC1 (AR)) /= 3 THEN
|
|
|
219 FAILED ( "INCORRECT CONVERSION OF 'NACCREC (AR)'" );
|
|
|
220 END IF;
|
|
|
221 EXCEPTION
|
|
|
222 WHEN OTHERS =>
|
|
|
223 FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
|
|
|
224 "ACCESS TYPES" );
|
|
|
225 END;
|
|
|
226
|
|
|
227 DECLARE
|
|
|
228 TYPE REC (D : INTEGER) IS
|
|
|
229 RECORD
|
|
|
230 NULL;
|
|
|
231 END RECORD;
|
|
|
232
|
|
|
233 TYPE ACCR IS ACCESS REC;
|
|
|
234
|
|
|
235 SUBTYPE CACCR IS ACCR (3);
|
|
|
236 AR : CACCR;
|
|
|
237
|
|
|
238 TYPE CACCR1 IS NEW ACCR (3);
|
|
|
239 AR1 : CACCR1;
|
|
|
240
|
|
|
241 TYPE CACCR2 IS NEW ACCR (3);
|
|
|
242 AR2 : CACCR2;
|
|
|
243
|
|
|
244 TYPE NCACCR1 IS NEW CACCR1;
|
|
|
245 NAR : NCACCR1;
|
|
|
246
|
|
|
247 FUNCTION F (A : CACCR) RETURN INTEGER IS
|
|
|
248 BEGIN
|
|
|
249 RETURN IDENT_INT (0);
|
|
|
250 END F;
|
|
|
251
|
|
|
252 FUNCTION F (A : CACCR1) RETURN INTEGER IS
|
|
|
253 BEGIN
|
|
|
254 RETURN IDENT_INT (1);
|
|
|
255 END F;
|
|
|
256
|
|
|
257 FUNCTION F (A : CACCR2) RETURN INTEGER IS
|
|
|
258 BEGIN
|
|
|
259 RETURN IDENT_INT (2);
|
|
|
260 END F;
|
|
|
261
|
|
|
262 FUNCTION F (A : NCACCR1) RETURN INTEGER IS
|
|
|
263 BEGIN
|
|
|
264 RETURN IDENT_INT (3);
|
|
|
265 END F;
|
|
|
266
|
|
|
267 BEGIN
|
|
|
268 IF F (CACCR (AR)) /= 0 THEN
|
|
|
269 FAILED ( "INCORRECT CONVERSION OF 'CACCR (AR)'" );
|
|
|
270 END IF;
|
|
|
271
|
|
|
272 IF F (CACCR (AR1)) /= 0 THEN
|
|
|
273 FAILED ( "INCORRECT CONVERSION OF 'CACCR (AR1)'" );
|
|
|
274 END IF;
|
|
|
275
|
|
|
276 IF F (CACCR1 (AR2)) /= 1 THEN
|
|
|
277 FAILED ( "INCORRECT CONVERSION OF 'CACCR1 (AR2)'" );
|
|
|
278 END IF;
|
|
|
279
|
|
|
280 IF F (CACCR2 (NAR)) /= 2 THEN
|
|
|
281 FAILED ( "INCORRECT CONVERSION OF 'CACCR2 (NAR)'" );
|
|
|
282 END IF;
|
|
|
283
|
|
|
284 IF F (NCACCR1 (AR)) /= 3 THEN
|
|
|
285 FAILED ( "INCORRECT CONVERSION OF 'NCACCR (AR)'" );
|
|
|
286 END IF;
|
|
|
287 EXCEPTION
|
|
|
288 WHEN OTHERS =>
|
|
|
289 FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
|
|
|
290 "CONSTRAINED ACCESS TYPES" );
|
|
|
291 END;
|
|
|
292
|
|
|
293 DECLARE
|
|
|
294 PACKAGE PKG1 IS
|
|
|
295 TYPE PRIV IS PRIVATE;
|
|
|
296 PRIVATE
|
|
|
297 TYPE PRIV IS
|
|
|
298 RECORD
|
|
|
299 NULL;
|
|
|
300 END RECORD;
|
|
|
301 END PKG1;
|
|
|
302
|
|
|
303 USE PKG1;
|
|
|
304
|
|
|
305 PACKAGE PKG2 IS
|
|
|
306 R : PRIV;
|
|
|
307
|
|
|
308 TYPE PRIV1 IS NEW PRIV;
|
|
|
309 R1 : PRIV1;
|
|
|
310
|
|
|
311 TYPE PRIV2 IS NEW PRIV;
|
|
|
312 R2 : PRIV2;
|
|
|
313 END PKG2;
|
|
|
314
|
|
|
315 USE PKG2;
|
|
|
316
|
|
|
317 PACKAGE PKG3 IS
|
|
|
318 TYPE NPRIV1 IS NEW PRIV1;
|
|
|
319 NR : NPRIV1;
|
|
|
320 END PKG3;
|
|
|
321
|
|
|
322 USE PKG3;
|
|
|
323 BEGIN
|
|
|
324 IF PRIV (R) /= R THEN
|
|
|
325 FAILED ( "INCORRECT CONVERSION OF 'PRIV (R)'" );
|
|
|
326 END IF;
|
|
|
327
|
|
|
328 IF PRIV (R1) /= R THEN
|
|
|
329 FAILED ( "INCORRECT CONVERSION OF 'PRIV (R1)'" );
|
|
|
330 END IF;
|
|
|
331
|
|
|
332 IF PRIV1 (R2) /= R1 THEN
|
|
|
333 FAILED ( "INCORRECT CONVERSION OF 'PRIV1 (R2)'" );
|
|
|
334 END IF;
|
|
|
335
|
|
|
336 IF PRIV2 (NR) /= R2 THEN
|
|
|
337 FAILED ( "INCORRECT CONVERSION OF 'PRIV2 (NR)'" );
|
|
|
338 END IF;
|
|
|
339
|
|
|
340 IF NPRIV1 (R) /= NR THEN
|
|
|
341 FAILED ( "INCORRECT CONVERSION OF 'NPRIV (R)'" );
|
|
|
342 END IF;
|
|
|
343 EXCEPTION
|
|
|
344 WHEN OTHERS =>
|
|
|
345 FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
|
|
|
346 "PRIVATE TYPES" );
|
|
|
347 END;
|
|
|
348
|
|
|
349 DECLARE
|
|
|
350 TASK TYPE TK;
|
|
|
351 T : TK;
|
|
|
352
|
|
|
353 TYPE TK1 IS NEW TK;
|
|
|
354 T1 : TK1;
|
|
|
355
|
|
|
356 TYPE TK2 IS NEW TK;
|
|
|
357 T2 : TK2;
|
|
|
358
|
|
|
359 TYPE NTK1 IS NEW TK1;
|
|
|
360 NT : NTK1;
|
|
|
361
|
|
|
362 TASK BODY TK IS
|
|
|
363 BEGIN
|
|
|
364 NULL;
|
|
|
365 END;
|
|
|
366
|
|
|
367 FUNCTION F (T : TK) RETURN INTEGER IS
|
|
|
368 BEGIN
|
|
|
369 RETURN IDENT_INT (0);
|
|
|
370 END F;
|
|
|
371
|
|
|
372 FUNCTION F (T : TK1) RETURN INTEGER IS
|
|
|
373 BEGIN
|
|
|
374 RETURN IDENT_INT (1);
|
|
|
375 END F;
|
|
|
376
|
|
|
377 FUNCTION F (T : TK2) RETURN INTEGER IS
|
|
|
378 BEGIN
|
|
|
379 RETURN IDENT_INT (2);
|
|
|
380 END F;
|
|
|
381
|
|
|
382 FUNCTION F (T : NTK1) RETURN INTEGER IS
|
|
|
383 BEGIN
|
|
|
384 RETURN IDENT_INT (3);
|
|
|
385 END F;
|
|
|
386
|
|
|
387 BEGIN
|
|
|
388 IF F (TK (T)) /= 0 THEN
|
|
|
389 FAILED ( "INCORRECT CONVERSION OF 'TK (T))'" );
|
|
|
390 END IF;
|
|
|
391
|
|
|
392 IF F (TK (T1)) /= 0 THEN
|
|
|
393 FAILED ( "INCORRECT CONVERSION OF 'TK (T1))'" );
|
|
|
394 END IF;
|
|
|
395
|
|
|
396 IF F (TK1 (T2)) /= 1 THEN
|
|
|
397 FAILED ( "INCORRECT CONVERSION OF 'TK1 (T2))'" );
|
|
|
398 END IF;
|
|
|
399
|
|
|
400 IF F (TK2 (NT)) /= 2 THEN
|
|
|
401 FAILED ( "INCORRECT CONVERSION OF 'TK2 (NT))'" );
|
|
|
402 END IF;
|
|
|
403
|
|
|
404 IF F (NTK1 (T)) /= 3 THEN
|
|
|
405 FAILED ( "INCORRECT CONVERSION OF 'NTK (T))'" );
|
|
|
406 END IF;
|
|
|
407 EXCEPTION
|
|
|
408 WHEN OTHERS =>
|
|
|
409 FAILED ( "EXCEPTION RAISED DURING CONVERSION OF " &
|
|
|
410 "TASK TYPES" );
|
|
|
411 END;
|
|
|
412
|
|
|
413 RESULT;
|
|
|
414 END C46051A;
|
