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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c460a01.a] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- 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;

powered by: WebSVN 2.1.0

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