OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c460a02.a] - Blame information for rev 294

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.