|
111
|
1 -- C460A01.A
|
|
|
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 --
|
|
|
26 -- OBJECTIVE:
|
|
|
27 -- Check that if the target type of a type conversion is a general
|
|
|
28 -- access type, Program_Error is raised if the accessibility level of
|
|
|
29 -- the operand type is deeper than that of the target type. Check for
|
|
|
30 -- cases where the type conversion occurs in an instance body, and
|
|
|
31 -- the operand type is passed as an actual during instantiation.
|
|
|
32 --
|
|
|
33 -- TEST DESCRIPTION:
|
|
|
34 -- In order to satisfy accessibility requirements, the operand type must
|
|
|
35 -- be at the same or a less deep nesting level than the target type -- the
|
|
|
36 -- operand type must "live" as long as the target type. Nesting levels
|
|
|
37 -- are the run-time nestings of masters: block statements; subprogram,
|
|
|
38 -- task, and entry bodies; and accept statements. Packages are invisible
|
|
|
39 -- to accessibility rules.
|
|
|
40 --
|
|
|
41 -- This test checks for cases where the operand is a subprogram formal
|
|
|
42 -- parameter.
|
|
|
43 --
|
|
|
44 -- The test declares three generic packages, each containing an access
|
|
|
45 -- type conversion in which the operand type is a formal type:
|
|
|
46 --
|
|
|
47 -- (1) One in which the target type is declared within the
|
|
|
48 -- specification, and the conversion occurs within a nested
|
|
|
49 -- function.
|
|
|
50 --
|
|
|
51 -- (2) One in which the target type is also a formal type, and
|
|
|
52 -- the conversion occurs within a nested function.
|
|
|
53 --
|
|
|
54 -- (3) One in which the target type is declared outside the
|
|
|
55 -- generic, and the conversion occurs within a nested
|
|
|
56 -- procedure.
|
|
|
57 --
|
|
|
58 -- The test verifies the following:
|
|
|
59 --
|
|
|
60 -- For (1), Program_Error is not raised when the nested function is
|
|
|
61 -- called. Since the actual corresponding to the formal operand type
|
|
|
62 -- must always have the same or a less deep level than the target
|
|
|
63 -- type declared within the instance, the access type conversion is
|
|
|
64 -- always safe.
|
|
|
65 --
|
|
|
66 -- For (2), Program_Error is raised when the nested function is
|
|
|
67 -- called if the operand type passed as an actual during instantiation
|
|
|
68 -- has an accessibility level deeper than that of the target type
|
|
|
69 -- passed as an actual, and that no exception is raised otherwise.
|
|
|
70 -- The exception is propagated to the innermost enclosing master.
|
|
|
71 --
|
|
|
72 -- For (3), Program_Error is raised when the nested procedure is
|
|
|
73 -- called if the operand type passed as an actual during instantiation
|
|
|
74 -- has an accessibility level deeper than that of the target type.
|
|
|
75 -- The exception is handled within the nested procedure.
|
|
|
76 --
|
|
|
77 -- TEST FILES:
|
|
|
78 -- The following files comprise this test:
|
|
|
79 --
|
|
|
80 -- F460A00.A
|
|
|
81 -- => C460A01.A
|
|
|
82 --
|
|
|
83 --
|
|
|
84 -- CHANGE HISTORY:
|
|
|
85 -- 09 May 95 SAIC Initial prerelease version.
|
|
|
86 -- 24 Apr 96 SAIC Added code to avoid dead variable optimization.
|
|
|
87 -- 13 Feb 97 PWB.CTA Removed 'Class from qual expression at line 342.
|
|
|
88 --!
|
|
|
89
|
|
|
90 generic
|
|
|
91 type Designated_Type is tagged private;
|
|
|
92 type Operand_Type is access Designated_Type;
|
|
|
93 package C460A01_0 is
|
|
|
94 type Target_Type is access all Designated_Type;
|
|
|
95 function Convert (P : Operand_Type) return Target_Type;
|
|
|
96 end C460A01_0;
|
|
|
97
|
|
|
98
|
|
|
99 --==================================================================--
|
|
|
100
|
|
|
101
|
|
|
102 package body C460A01_0 is
|
|
|
103 function Convert (P : Operand_Type) return Target_Type is
|
|
|
104 begin
|
|
|
105 return Target_Type(P); -- Never fails.
|
|
|
106 end Convert;
|
|
|
107 end C460A01_0;
|
|
|
108
|
|
|
109
|
|
|
110 --==================================================================--
|
|
|
111
|
|
|
112
|
|
|
113 generic
|
|
|
114 type Designated_Type is tagged private;
|
|
|
115 type Operand_Type is access all Designated_Type;
|
|
|
116 type Target_Type is access all Designated_Type;
|
|
|
117 package C460A01_1 is
|
|
|
118 function Convert (P : Operand_Type) return Target_Type;
|
|
|
119 end C460A01_1;
|
|
|
120
|
|
|
121
|
|
|
122 --==================================================================--
|
|
|
123
|
|
|
124
|
|
|
125 package body C460A01_1 is
|
|
|
126 function Convert (P : Operand_Type) return Target_Type is
|
|
|
127 begin
|
|
|
128 return Target_Type(P);
|
|
|
129 end Convert;
|
|
|
130 end C460A01_1;
|
|
|
131
|
|
|
132
|
|
|
133 --==================================================================--
|
|
|
134
|
|
|
135
|
|
|
136 with F460A00;
|
|
|
137 generic
|
|
|
138 type Designated_Type (<>) is new F460A00.Tagged_Type with private;
|
|
|
139 type Operand_Type is access Designated_Type;
|
|
|
140 package C460A01_2 is
|
|
|
141 procedure Proc (P : Operand_Type;
|
|
|
142 Res : out F460A00.TC_Result_Kind);
|
|
|
143 end C460A01_2;
|
|
|
144
|
|
|
145
|
|
|
146 --==================================================================--
|
|
|
147
|
|
|
148 with Report;
|
|
|
149 package body C460A01_2 is
|
|
|
150 procedure Proc (P : Operand_Type;
|
|
|
151 Res : out F460A00.TC_Result_Kind) is
|
|
|
152 Ptr : F460A00.AccTag_L0;
|
|
|
153 begin
|
|
|
154 Ptr := F460A00.AccTag_L0(P);
|
|
|
155
|
|
|
156 -- Avoid optimization (dead variable removal of Ptr):
|
|
|
157 if not Report.Equal (Ptr.C, Ptr.C) then -- Always false.
|
|
|
158 Report.Failed ("Unexpected error in C460A01_2 instance");
|
|
|
159 end if;
|
|
|
160
|
|
|
161 Res := F460A00.OK;
|
|
|
162 exception
|
|
|
163 when Program_Error => Res := F460A00.PE_Exception;
|
|
|
164 when others => Res := F460A00.Others_Exception;
|
|
|
165 end Proc;
|
|
|
166 end C460A01_2;
|
|
|
167
|
|
|
168
|
|
|
169 --==================================================================--
|
|
|
170
|
|
|
171
|
|
|
172 with F460A00;
|
|
|
173 with C460A01_0;
|
|
|
174 with C460A01_1;
|
|
|
175 with C460A01_2;
|
|
|
176
|
|
|
177 with Report;
|
|
|
178 procedure C460A01 is
|
|
|
179 begin -- C460A01. -- [ Level = 1 ]
|
|
|
180
|
|
|
181 Report.Test ("C460A01", "Run-time accessibility checks: instance " &
|
|
|
182 "bodies. Operand type of access type conversion is " &
|
|
|
183 "passed as actual to instance");
|
|
|
184
|
|
|
185
|
|
|
186 SUBTEST1:
|
|
|
187 declare -- [ Level = 2 ]
|
|
|
188 type AccTag_L2 is access all F460A00.Tagged_Type;
|
|
|
189 Operand: AccTag_L2 := new F460A00.Tagged_Type;
|
|
|
190
|
|
|
191 Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
|
|
192 begin -- SUBTEST1.
|
|
|
193
|
|
|
194 declare -- [ Level = 3 ]
|
|
|
195 -- The instantiation of C460A01_0 should NOT result in any
|
|
|
196 -- exceptions.
|
|
|
197
|
|
|
198 package Pack_OK is new C460A01_0 (F460A00.Tagged_Type, AccTag_L2);
|
|
|
199 Target : Pack_OK.Target_Type;
|
|
|
200 begin
|
|
|
201 -- The accessibility level of Pack_OK.Target_Type will always be at
|
|
|
202 -- least as deep as the operand type passed as an actual. Thus,
|
|
|
203 -- a call to Pack_OK.Convert does not propagate an exception:
|
|
|
204
|
|
|
205 Target := Pack_OK.Convert(Operand);
|
|
|
206
|
|
|
207 -- Avoid optimization (dead variable removal of Target):
|
|
|
208 if not Report.Equal (Target.C, Target.C) then -- Always false.
|
|
|
209 Report.Failed ("Unexpected error in SUBTEST #1");
|
|
|
210 end if;
|
|
|
211
|
|
|
212 Result := F460A00.OK; -- Expected result.
|
|
|
213 exception
|
|
|
214 when Program_Error => Result := F460A00.PE_Exception;
|
|
|
215 when others => Result := F460A00.Others_Exception;
|
|
|
216 end;
|
|
|
217
|
|
|
218 F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #1");
|
|
|
219
|
|
|
220 exception
|
|
|
221 when Program_Error =>
|
|
|
222 Report.Failed ("SUBTEST #1: Program_Error incorrectly raised");
|
|
|
223 when others =>
|
|
|
224 Report.Failed ("SUBTEST #1: Unexpected exception raised");
|
|
|
225 end SUBTEST1;
|
|
|
226
|
|
|
227
|
|
|
228
|
|
|
229 SUBTEST2:
|
|
|
230 declare -- [ Level = 2 ]
|
|
|
231 type AccTag_L2 is access all F460A00.Tagged_Type;
|
|
|
232 Operand : AccTag_L2 := new F460A00.Tagged_Type;
|
|
|
233
|
|
|
234 Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
|
|
235 begin -- SUBTEST2.
|
|
|
236
|
|
|
237 declare -- [ Level = 3 ]
|
|
|
238
|
|
|
239 type AccTag_L3 is access all F460A00.Tagged_Type;
|
|
|
240 Target : AccTag_L3;
|
|
|
241
|
|
|
242 -- The instantiation of C460A01_1 should NOT result in any
|
|
|
243 -- exceptions.
|
|
|
244
|
|
|
245 package Pack_OK is new C460A01_1
|
|
|
246 (Designated_Type => F460A00.Tagged_Type,
|
|
|
247 Operand_Type => AccTag_L2,
|
|
|
248 Target_Type => AccTag_L3);
|
|
|
249 begin
|
|
|
250 -- The accessibility level of the actual passed as the operand type
|
|
|
251 -- in Pack_OK is 2. The accessibility level of the actual passed as
|
|
|
252 -- the target type is 3. Therefore, the access type conversion in
|
|
|
253 -- Pack_OK.Convert does not raise an exception when the subprogram is
|
|
|
254 -- called. If an exception is (incorrectly) raised, it is propagated
|
|
|
255 -- to the innermost enclosing master:
|
|
|
256
|
|
|
257 Target := Pack_OK.Convert(Operand);
|
|
|
258
|
|
|
259 -- Avoid optimization (dead variable removal of Target):
|
|
|
260 if not Report.Equal (Target.C, Target.C) then -- Always false.
|
|
|
261 Report.Failed ("Unexpected error in SUBTEST #2");
|
|
|
262 end if;
|
|
|
263
|
|
|
264 Result := F460A00.OK; -- Expected result.
|
|
|
265 exception
|
|
|
266 when Program_Error => Result := F460A00.PE_Exception;
|
|
|
267 when others => Result := F460A00.Others_Exception;
|
|
|
268 end;
|
|
|
269
|
|
|
270 F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #2");
|
|
|
271
|
|
|
272 exception
|
|
|
273 when Program_Error =>
|
|
|
274 Report.Failed ("SUBTEST #2: Program_Error incorrectly raised");
|
|
|
275 when others =>
|
|
|
276 Report.Failed ("SUBTEST #2: Unexpected exception raised");
|
|
|
277 end SUBTEST2;
|
|
|
278
|
|
|
279
|
|
|
280
|
|
|
281 SUBTEST3:
|
|
|
282 declare -- [ Level = 2 ]
|
|
|
283 type AccTag_L2 is access all F460A00.Tagged_Type;
|
|
|
284 Target : AccTag_L2;
|
|
|
285
|
|
|
286 Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
|
|
287 begin -- SUBTEST3.
|
|
|
288
|
|
|
289 declare -- [ Level = 3 ]
|
|
|
290
|
|
|
291 type AccTag_L3 is access all F460A00.Tagged_Type;
|
|
|
292 Operand : AccTag_L3 := new F460A00.Tagged_Type;
|
|
|
293
|
|
|
294 -- The instantiation of C460A01_1 should NOT result in any
|
|
|
295 -- exceptions.
|
|
|
296
|
|
|
297 package Pack_PE is new C460A01_1
|
|
|
298 (Designated_Type => F460A00.Tagged_Type,
|
|
|
299 Operand_Type => AccTag_L3,
|
|
|
300 Target_Type => AccTag_L2);
|
|
|
301 begin
|
|
|
302 -- The accessibility level of the actual passed as the operand type
|
|
|
303 -- in Pack_PE is 3. The accessibility level of the actual passed as
|
|
|
304 -- the target type is 2. Therefore, the access type conversion in
|
|
|
305 -- Pack_PE.Convert raises Program_Error when the subprogram is
|
|
|
306 -- called. The exception is propagated to the innermost enclosing
|
|
|
307 -- master:
|
|
|
308
|
|
|
309 Target := Pack_PE.Convert(Operand);
|
|
|
310
|
|
|
311 -- Avoid optimization (dead variable removal of Target):
|
|
|
312 if not Report.Equal (Target.C, Target.C) then -- Always false.
|
|
|
313 Report.Failed ("Unexpected error in SUBTEST #3");
|
|
|
314 end if;
|
|
|
315
|
|
|
316 Result := F460A00.OK;
|
|
|
317 exception
|
|
|
318 when Program_Error => Result := F460A00.PE_Exception;
|
|
|
319 -- Expected result.
|
|
|
320 when others => Result := F460A00.Others_Exception;
|
|
|
321 end;
|
|
|
322
|
|
|
323 F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #3");
|
|
|
324
|
|
|
325 exception
|
|
|
326 when Program_Error =>
|
|
|
327 Report.Failed ("SUBTEST #3: Program_Error incorrectly raised");
|
|
|
328 when others =>
|
|
|
329 Report.Failed ("SUBTEST #3: Unexpected exception raised");
|
|
|
330 end SUBTEST3;
|
|
|
331
|
|
|
332
|
|
|
333
|
|
|
334 SUBTEST4:
|
|
|
335 declare -- [ Level = 2 ]
|
|
|
336 Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
|
|
337 begin -- SUBTEST4.
|
|
|
338
|
|
|
339 declare -- [ Level = 3 ]
|
|
|
340
|
|
|
341 TType : F460A00.Tagged_Type;
|
|
|
342 Operand : F460A00.AccTagClass_L0
|
|
|
343 := new F460A00.Tagged_Type'(TType);
|
|
|
344
|
|
|
345 -- The instantiation of C460A01_2 should NOT result in any
|
|
|
346 -- exceptions.
|
|
|
347
|
|
|
348 package Pack_OK is new C460A01_2 (F460A00.Tagged_Type'Class,
|
|
|
349 F460A00.AccTagClass_L0);
|
|
|
350 begin
|
|
|
351 -- The accessibility level of the actual passed as the operand type
|
|
|
352 -- in Pack_OK is 0. The accessibility level of the target type
|
|
|
353 -- (F460A00.AccTag_L0) is also 0. Therefore, the access type
|
|
|
354 -- conversion in Pack_OK.Proc does not raise an exception when the
|
|
|
355 -- subprogram is called. If an exception is (incorrectly) raised,
|
|
|
356 -- it is handled within the subprogram:
|
|
|
357
|
|
|
358 Pack_OK.Proc(Operand, Result);
|
|
|
359 end;
|
|
|
360
|
|
|
361 F460A00.TC_Check_Results (Result, F460A00.OK, "SUBTEST #4");
|
|
|
362
|
|
|
363 exception
|
|
|
364 when Program_Error =>
|
|
|
365 Report.Failed ("SUBTEST #4: Program_Error incorrectly raised");
|
|
|
366 when others =>
|
|
|
367 Report.Failed ("SUBTEST #4: Unexpected exception raised");
|
|
|
368 end SUBTEST4;
|
|
|
369
|
|
|
370
|
|
|
371
|
|
|
372 SUBTEST5:
|
|
|
373 declare -- [ Level = 2 ]
|
|
|
374 Result : F460A00.TC_Result_Kind := F460A00.UN_Init;
|
|
|
375 begin -- SUBTEST5.
|
|
|
376
|
|
|
377 declare -- [ Level = 3 ]
|
|
|
378
|
|
|
379 type AccDerTag_L3 is access all F460A00.Derived_Tagged_Type;
|
|
|
380 Operand : AccDerTag_L3 := new F460A00.Derived_Tagged_Type;
|
|
|
381
|
|
|
382 -- The instantiation of C460A01_2 should NOT result in any
|
|
|
383 -- exceptions.
|
|
|
384
|
|
|
385 package Pack_PE is new C460A01_2 (F460A00.Derived_Tagged_Type,
|
|
|
386 AccDerTag_L3);
|
|
|
387 begin
|
|
|
388 -- The accessibility level of the actual passed as the operand type
|
|
|
389 -- in Pack_PE is 3. The accessibility level of the target type
|
|
|
390 -- (F460A00.AccTag_L0) is 0. Therefore, the access type conversion
|
|
|
391 -- in Pack_PE.Proc raises Program_Error when the subprogram is
|
|
|
392 -- called. The exception is handled within the subprogram:
|
|
|
393
|
|
|
394 Pack_PE.Proc(Operand, Result);
|
|
|
395 end;
|
|
|
396
|
|
|
397 F460A00.TC_Check_Results (Result, F460A00.PE_Exception, "SUBTEST #5");
|
|
|
398
|
|
|
399 exception
|
|
|
400 when Program_Error =>
|
|
|
401 Report.Failed ("SUBTEST #5: Program_Error incorrectly raised");
|
|
|
402 when others =>
|
|
|
403 Report.Failed ("SUBTEST #5: Unexpected exception raised");
|
|
|
404 end SUBTEST5;
|
|
|
405
|
|
|
406 Report.Result;
|
|
|
407
|
|
|
408 end C460A01;
|
