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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C3A2A01.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, for X'Access of a general access type A, Program_Error is
28
--      raised if the accessibility level of X is deeper than that of A.
29
--      Check for cases where X'Access occurs in an instance body, and A
30
--      is passed as an actual during instantiation.
31
--
32
-- TEST DESCRIPTION:
33
--      In order to satisfy accessibility requirements, the designated
34
--      object X must be at the same or a less deep nesting level than the
35
--      general access type A -- X must "live" as long as A. Nesting
36
--      levels are the run-time nestings of masters: block statements;
37
--      subprogram, task, and entry bodies; and accept statements. Packages
38
--      are invisible to accessibility rules.
39
--
40
--      This test declares three generic units, each of which has a formal
41
--      general access type:
42
--
43
--         (1) A generic package, in which X is declared in the specification,
44
--             and X'Access occurs within the declarative part of the body.
45
--
46
--         (2) A generic package, in which X is a formal in out object of a
47
--             tagged formal derived type, and X'Access occurs in the sequence
48
--             of statements of a nested subprogram.
49
--
50
--         (3) A generic procedure, in which X is a dereference of an access
51
--             parameter, and X'Access occurs in the sequence of statements.
52
--
53
--      The test verifies the following:
54
--
55
--         For (1), Program_Error is raised upon instantiation if the generic
56
--         package is instantiated at a deeper level than that of the general
57
--         access type passed as an actual. The exception is propagated to the
58
--         innermost enclosing master.
59
--
60
--         For (2), Program_Error is raised when the nested subprogram is
61
--         called if the object passed as an actual during instantiation of
62
--         the generic package has an accessibility level deeper than that of
63
--         the general access type passed as an actual. The exception is
64
--         handled within the nested subprogram. Also, check that
65
--         Program_Error is not raised if the level of the actual access type
66
--         is deeper than that of the actual object.
67
--
68
--         For (3), Program_Error is raised when the instance subprogram is
69
--         called if the object pointed to by the actual corresponding to
70
--         the access parameter has an accessibility level deeper than that of
71
--         the general access type passed as an actual during instantiation.
72
--         The exception is handled within the instance subprogram. Also,
73
--         check that Program_Error is not raised if the level of the actual
74
--         access type is deeper than that of the actual corresponding to the
75
--         access parameter.
76
--
77
-- TEST FILES:
78
--      The following files comprise this test:
79
--
80
--         F3A2A00.A
81
--      -> C3A2A01.A
82
--
83
--
84
-- CHANGE HISTORY:
85
--      12 May 95   SAIC    Initial prerelease version.
86
--      10 Jul 95   SAIC    Modified code to avoid dead variable optimization.
87
--
88
--!
89
 
90
with F3A2A00;
91
generic
92
   type FD  is new F3A2A00.Array_Type;
93
   type FAF is access all FD;
94
package C3A2A01_0 is
95
   X : aliased FD;
96
 
97
   procedure Dummy;  -- Needed to allow package body.
98
end C3A2A01_0;
99
 
100
 
101
     --==================================================================--
102
 
103
 
104
with Report;
105
package body C3A2A01_0 is
106
   Ptr   : FAF     := X'Access;
107
   Index : Integer := F3A2A00.Array_Type'First;
108
 
109
   procedure Dummy is
110
   begin
111
      null;
112
   end Dummy;
113
begin
114
   -- Avoid optimization (dead variable removal of Ptr):
115
 
116
   if not Report.Equal (Ptr(Index).C, Ptr(Index).C) then   -- Always false.
117
      Report.Failed ("Unexpected error in C3A2A01_0 instance");
118
   end if;
119
end C3A2A01_0;
120
 
121
 
122
     --==================================================================--
123
 
124
 
125
with F3A2A00;
126
generic
127
   type FD  is new F3A2A00.Tagged_Type with private;
128
   type FAF is access all FD;
129
   FObj : in out FD;
130
package C3A2A01_1 is
131
   procedure Handle (R: out F3A2A00.TC_Result_Kind);
132
end C3A2A01_1;
133
 
134
 
135
     --==================================================================--
136
 
137
 
138
with Report;
139
package body C3A2A01_1 is
140
 
141
   procedure Handle (R: out F3A2A00.TC_Result_Kind) is
142
      Ptr : FAF;
143
   begin
144
      Ptr := FObj'Access;
145
      R   := F3A2A00.OK;
146
 
147
      -- Avoid optimization (dead variable removal of Ptr):
148
 
149
      if not Report.Equal (Ptr.C, Ptr.C) then              -- Always false.
150
         Report.Failed ("Unexpected error in Handle");
151
      end if;
152
   exception
153
      when Program_Error => R := F3A2A00.P_E;
154
      when others        => R := F3A2A00.O_E;
155
   end Handle;
156
 
157
end C3A2A01_1;
158
 
159
 
160
     --==================================================================--
161
 
162
 
163
with F3A2A00;
164
generic
165
   type FD  is new F3A2A00.Array_Type;
166
   type FAF is access all FD;
167
procedure C3A2A01_2 (P: access FD; R: out F3A2A00.TC_Result_Kind);
168
 
169
 
170
     --==================================================================--
171
 
172
 
173
with Report;
174
procedure C3A2A01_2 (P: access FD; R: out F3A2A00.TC_Result_Kind) is
175
   Ptr   : FAF;
176
   Index : Integer := F3A2A00.Array_Type'First;
177
begin
178
   Ptr := P.all'Access;
179
   R   := F3A2A00.OK;
180
 
181
   -- Avoid optimization (dead variable removal of Ptr):
182
 
183
   if not Report.Equal (Ptr(Index).C, Ptr(Index).C) then   -- Always false.
184
      Report.Failed ("Unexpected error in C3A2A01_2 instance");
185
   end if;
186
exception
187
   when Program_Error => R := F3A2A00.P_E;
188
   when others        => R := F3A2A00.O_E;
189
end C3A2A01_2;
190
 
191
 
192
     --==================================================================--
193
 
194
 
195
with F3A2A00;
196
with C3A2A01_0;
197
with C3A2A01_1;
198
with C3A2A01_2;
199
 
200
with Report;
201
procedure C3A2A01 is
202
begin -- C3A2A01.                                              -- [ Level = 1 ]
203
 
204
   Report.Test ("C3A2A01", "Run-time accessibility checks: instance " &
205
                "bodies. Type of X'Access is passed as actual to instance");
206
 
207
 
208
   SUBTEST1:
209
   declare                                                     -- [ Level = 2 ]
210
      Result : F3A2A00.TC_Result_Kind;
211
   begin -- SUBTEST1.
212
 
213
      declare                                                  -- [ Level = 3 ]
214
         type AccArr_L3 is access all F3A2A00.Array_Type;
215
      begin
216
         declare                                               -- [ Level = 4 ]
217
            -- The accessibility level of Pack.X is that of the instantiation
218
            -- (4). The accessibility level of the actual access type used to
219
            -- instantiate Pack is 3. Therefore, the X'Access in Pack
220
            -- propagates Program_Error when the instance body is elaborated:
221
 
222
            package Pack is new C3A2A01_0 (F3A2A00.Array_Type, AccArr_L3);
223
         begin
224
            Result := F3A2A00.OK;
225
         end;
226
      exception
227
         when Program_Error => Result := F3A2A00.P_E;       -- Expected result.
228
         when others        => Result := F3A2A00.O_E;
229
      end;
230
 
231
      F3A2A00.TC_Display_Results (Result, F3A2A00.P_E, "SUBTEST #1");
232
 
233
   end SUBTEST1;
234
 
235
 
236
 
237
   SUBTEST2:
238
   declare                                                     -- [ Level = 2 ]
239
      Result : F3A2A00.TC_Result_Kind;
240
   begin -- SUBTEST2.
241
 
242
      declare                                                  -- [ Level = 3 ]
243
         -- The instantiation of C3A2A01_1 should NOT result in any
244
         -- exceptions.
245
 
246
         type AccTag_L3 is access all F3A2A00.Tagged_Type;
247
 
248
         package Pack_OK is new C3A2A01_1 (F3A2A00.Tagged_Type,
249
                                           AccTag_L3,
250
                                           F3A2A00.X_L0);
251
      begin
252
         -- The accessibility level of the actual object used to instantiate
253
         -- Pack_OK is 0. The accessibility level of the actual access type
254
         -- used to instantiate Pack_OK is 3. Therefore, the FObj'Access in
255
         -- Pack_OK.Handle does not raise an exception when the subprogram is
256
         -- called. If an exception is (incorrectly) raised, however, it is
257
         -- handled within the subprogram:
258
 
259
         Pack_OK.Handle (Result);
260
      end;
261
 
262
      F3A2A00.TC_Display_Results (Result, F3A2A00.OK, "SUBTEST #2");
263
 
264
   exception
265
      when Program_Error =>
266
         Report.Failed ("SUBTEST #2: Program_Error incorrectly raised " &
267
                        "during instantiation of generic");
268
      when others        =>
269
         Report.Failed ("SUBTEST #2: Unexpected exception raised " &
270
                        "during instantiation of generic");
271
   end SUBTEST2;
272
 
273
 
274
 
275
   SUBTEST3:
276
   declare                                                     -- [ Level = 2 ]
277
      Result : F3A2A00.TC_Result_Kind;
278
   begin -- SUBTEST3.
279
 
280
      declare                                                  -- [ Level = 3 ]
281
         -- The instantiation of C3A2A01_1 should NOT result in any
282
         -- exceptions.
283
 
284
         X_L3: F3A2A00.Tagged_Type;
285
 
286
         package Pack_PE is new C3A2A01_1 (F3A2A00.Tagged_Type,
287
                                           F3A2A00.AccTag_L0,
288
                                           X_L3);
289
      begin
290
         -- The accessibility level of the actual object used to instantiate
291
         -- Pack_PE is 3. The accessibility level of the actual access type
292
         -- used to instantiate Pack_PE is 0. Therefore, the FObj'Access in
293
         -- Pack_OK.Handle raises Program_Error when the subprogram is
294
         -- called. The exception is handled within the subprogram:
295
 
296
         Pack_PE.Handle (Result);
297
      end;
298
 
299
      F3A2A00.TC_Display_Results (Result, F3A2A00.P_E, "SUBTEST #3");
300
 
301
   exception
302
      when Program_Error =>
303
         Report.Failed ("SUBTEST #3: Program_Error incorrectly raised " &
304
                        "during instantiation of generic");
305
      when others        =>
306
         Report.Failed ("SUBTEST #3: Unexpected exception raised " &
307
                        "during instantiation of generic");
308
   end SUBTEST3;
309
 
310
 
311
 
312
   SUBTEST4:
313
   declare                                                     -- [ Level = 2 ]
314
      Result1 : F3A2A00.TC_Result_Kind;
315
      Result2 : F3A2A00.TC_Result_Kind;
316
   begin -- SUBTEST4.
317
 
318
      declare                                                  -- [ Level = 3 ]
319
         -- The instantiation of C3A2A01_2 should NOT result in any
320
         -- exceptions.
321
 
322
         X_L3: aliased F3A2A00.Array_Type;
323
         type AccArr_L3 is access all F3A2A00.Array_Type;
324
 
325
         procedure Proc is new C3A2A01_2 (F3A2A00.Array_Type, AccArr_L3);
326
      begin
327
         -- The accessibility level of Proc.P.all is that of the corresponding
328
         -- actual during the call (in this case 3). The accessibility level of
329
         -- the access type used to instantiate Proc is also 3. Therefore, the
330
         -- P.all'Access in Proc does not raise an exception when the
331
         -- subprogram is called. If an exception is (incorrectly) raised,
332
         -- however, it is handled within the subprogram:
333
 
334
         Proc (X_L3'Access, Result1);
335
 
336
         F3A2A00.TC_Display_Results (Result1, F3A2A00.OK,
337
                                     "SUBTEST #4: same levels");
338
 
339
         declare                                               -- [ Level = 4 ]
340
            X_L4: aliased F3A2A00.Array_Type;
341
         begin
342
            -- Within this block, the accessibility level of the actual
343
            -- corresponding to Proc.P.all is 4. Therefore, the P.all'Access
344
            -- in Proc raises Program_Error when the subprogram is called. The
345
            -- exception is handled within the subprogram:
346
 
347
            Proc (X_L4'Access, Result2);
348
 
349
            F3A2A00.TC_Display_Results (Result2, F3A2A00.P_E,
350
                                        "SUBTEST #4: object at deeper level");
351
         end;
352
 
353
      end;
354
 
355
   exception
356
      when Program_Error =>
357
         Report.Failed ("SUBTEST #4: Program_Error incorrectly raised " &
358
                        "during instantiation of generic");
359
      when others        =>
360
         Report.Failed ("SUBTEST #4: Unexpected exception raised " &
361
                        "during instantiation of generic");
362
   end SUBTEST4;
363
 
364
 
365
   Report.Result;
366
 
367
end C3A2A01;

powered by: WebSVN 2.1.0

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