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/] [c7/] [c761011.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C761011.A
2
--
3
--                             Grant of Unlimited Rights
4
--
5
--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
6
--     rights in the software and documentation contained herein. Unlimited
7
--     rights are the same as those granted by the U.S. Government for older
8
--     parts of the Ada Conformity Assessment Test Suite, and are defined
9
--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
10
--     intends to confer upon all recipients unlimited rights equal to those
11
--     held by the ACAA. These rights include rights to use, duplicate,
12
--     release or disclose the released technical data and computer software
13
--     in whole or in part, in any manner and for any purpose whatsoever, and
14
--     to have or permit others 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 a Finalize propagates an exception, other Finalizes due
28
--    to be performed are performed.
29
--        Case 1: A Finalize invoked due to the end of execution of
30
--        a master. (Defect Report 8652/0023, as reflected in Technical
31
--        Corrigendum 1).
32
--        Case 2: A Finalize invoked due to finalization of an anonymous
33
--        object. (Defect Report 8652/0023, as reflected in Technical
34
--        Corrigendum 1).
35
--        Case 3: A Finalize invoked due to the transfer of control
36
--        due to an exit statement.
37
--        Case 4: A Finalize invoked due to the transfer of control
38
--        due to a goto statement.
39
--        Case 5: A Finalize invoked due to the transfer of control
40
--        due to a return statement.
41
--        Case 6: A Finalize invoked due to the transfer of control
42
--        due to raises an exception.
43
--
44
--
45
-- CHANGE HISTORY:
46
--    29 JAN 2001   PHL   Initial version
47
--    15 MAR 2001   RLB   Readied for release; added optimization blockers.
48
--                        Added test cases for paragraphs 18 and 19 of the
49
--                        standard (the previous tests were withdrawn).
50
--
51
--!
52
with Ada.Finalization;
53
use Ada.Finalization;
54
package C761011_0 is
55
 
56
    type Ctrl (D : Boolean) is new Ada.Finalization.Controlled with
57
        record
58
            Finalized : Boolean := False;
59
            case D is
60
                when False =>
61
                    C1 : Integer;
62
                when True =>
63
                    C2 : Float;
64
            end case;
65
        end record;
66
 
67
    function Create (Id : Integer) return Ctrl;
68
    procedure Finalize (Obj : in out Ctrl);
69
    function Was_Finalized (Id : Integer) return Boolean;
70
    procedure Use_It (Obj : in Ctrl);
71
       -- Use Obj to prevent optimization.
72
 
73
end C761011_0;
74
 
75
with Report;
76
use Report;
77
package body C761011_0 is
78
 
79
    User_Error : exception;
80
 
81
    Finalize_Called : array (0 .. 50) of Boolean := (others => False);
82
 
83
    function Create (Id : Integer) return Ctrl is
84
        Obj : Ctrl (Boolean'Val (Id mod Ident_Int (2)));
85
    begin
86
        case Obj.D is
87
            when False =>
88
                Obj.C1 := Ident_Int (Id);
89
            when True =>
90
                Obj.C2 := Float (Ident_Int (Id + Ident_Int (Id)));
91
        end case;
92
        return Obj;
93
    end Create;
94
 
95
    procedure Finalize (Obj : in out Ctrl) is
96
    begin
97
        if not Obj.Finalized then
98
            Obj.Finalized := True;
99
            if Obj.D then
100
                if Integer (Obj.C2 / 2.0) mod Ident_Int (10) =
101
                   Ident_Int (3) then
102
                    raise User_Error;
103
                else
104
                    Finalize_Called (Integer (Obj.C2) / 2) := True;
105
                end if;
106
            else
107
                if Obj.C1 mod Ident_Int (10) = Ident_Int (0) then
108
                    raise Tasking_Error;
109
                else
110
                    Finalize_Called (Obj.C1) := True;
111
                end if;
112
            end if;
113
        end if;
114
    end Finalize;
115
 
116
    function Was_Finalized (Id : Integer) return Boolean is
117
    begin
118
        return Finalize_Called (Ident_Int (Id));
119
    end Was_Finalized;
120
 
121
    procedure Use_It (Obj : in Ctrl) is
122
       -- Use Obj to prevent optimization.
123
    begin
124
        case Obj.D is
125
            when True =>
126
                if not Equal (Boolean'Pos(Obj.Finalized),
127
                              Boolean'Pos(Obj.Finalized)) then
128
                    Failed ("Identity check - 1");
129
                end if;
130
            when False =>
131
                if not Equal (Obj.C1, Obj.C1) then
132
                    Failed ("Identity check - 2");
133
                end if;
134
        end case;
135
    end Use_It;
136
 
137
end C761011_0;
138
 
139
with Ada.Exceptions;
140
use Ada.Exceptions;
141
with Ada.Finalization;
142
with C761011_0;
143
use C761011_0;
144
with Report;
145
use Report;
146
procedure C761011 is
147
begin
148
    Test
149
       ("C761011",
150
        " Check that if a finalize propagates an exception, other finalizes " &
151
         "due to be performed are performed");
152
 
153
    Normal: -- Case 1
154
        begin
155
            declare
156
                Obj1 : Ctrl := Create (Ident_Int (1));
157
                Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
158
                                         D => False,
159
                                         Finalized => Ident_Bool (False),
160
                                         C1 => Ident_Int (2));
161
                Obj3 : Ctrl :=
162
                   (Ada.Finalization.Controlled with
163
                    D => True,
164
                    Finalized => Ident_Bool (False),
165
                    C2 => 2.0 * Float (Ident_Int
166
                                          (3))); -- Finalization: User_Error
167
                Obj4 : Ctrl := Create (Ident_Int (4));
168
            begin
169
                Comment ("Finalization of normal object");
170
                Use_It (Obj1); -- Prevent optimization of Objects.
171
                Use_It (Obj2); -- (Critical if AI-147 is adopted.)
172
                Use_It (Obj3);
173
                Use_It (Obj4);
174
            end;
175
            Failed ("No exception raised by finalization of normal object");
176
        exception
177
            when Program_Error =>
178
                if not Was_Finalized (Ident_Int (1)) or
179
                   not Was_Finalized (Ident_Int (2)) or
180
                   not Was_Finalized (Ident_Int (4)) then
181
                    Failed ("Missing finalizations - 1");
182
                end if;
183
            when E: others =>
184
                Failed ("Exception " & Exception_Name (E) &
185
                        " raised - " & Exception_Message (E) & " - 1");
186
        end Normal;
187
 
188
    Anon: -- Case 2
189
        begin
190
            declare
191
                Obj1 : Ctrl := (Ada.Finalization.Controlled with
192
                                D => True,
193
                                Finalized => Ident_Bool (False),
194
                                C2 => 2.0 * Float (Ident_Int (5)));
195
                Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
196
                                         D => False,
197
                                         Finalized => Ident_Bool (False),
198
                                         C1 => Ident_Int (6));
199
                Obj3 : Ctrl := (Ada.Finalization.Controlled with
200
                                D => True,
201
                                Finalized => Ident_Bool (False),
202
                                C2 => 2.0 * Float (Ident_Int (7)));
203
                Obj4 : Ctrl := Create (Ident_Int (8));
204
            begin
205
                Comment ("Finalization of anonymous object");
206
 
207
                -- The finalization of the anonymous object below will raise
208
                -- Tasking_Error.
209
                if Create (Ident_Int (10)).C1 /= Ident_Int (10) then
210
                    Failed ("Incorrect construction of an anonymous object");
211
                end if;
212
                Failed ("Anonymous object not finalized at the end of the " &
213
                        "enclosing statement");
214
                Use_It (Obj1); -- Prevent optimization of Objects.
215
                Use_It (Obj2); -- (Critical if AI-147 is adopted.)
216
                Use_It (Obj3);
217
                Use_It (Obj4);
218
            end;
219
            Failed ("No exception raised by finalization of an anonymous " &
220
                    "object of a function");
221
        exception
222
            when Program_Error =>
223
                if not Was_Finalized (Ident_Int (5)) or
224
                   not Was_Finalized (Ident_Int (6)) or
225
                   not Was_Finalized (Ident_Int (7)) or
226
                   not Was_Finalized (Ident_Int (8)) then
227
                    Failed ("Missing finalizations - 2");
228
                end if;
229
            when E: others =>
230
                Failed ("Exception " & Exception_Name (E) &
231
                        " raised - " & Exception_Message (E) & " - 2");
232
        end Anon;
233
 
234
    An_Exit: -- Case 3
235
        begin
236
            for Counter in 1 .. 4 loop
237
                declare
238
                    Obj1 : Ctrl := Create (Ident_Int (11));
239
                    Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
240
                                             D => False,
241
                                             Finalized => Ident_Bool (False),
242
                                             C1 => Ident_Int (12));
243
                    Obj3 : Ctrl :=
244
                        (Ada.Finalization.Controlled with
245
                         D => True,
246
                         Finalized => Ident_Bool (False),
247
                         C2 => 2.0 * Float (
248
                               Ident_Int(13))); -- Finalization: User_Error
249
                    Obj4 : Ctrl := Create (Ident_Int (14));
250
                begin
251
                    Comment ("Finalization because of exit of loop");
252
 
253
                    Use_It (Obj1); -- Prevent optimization of Objects.
254
                    Use_It (Obj2); -- (Critical if AI-147 is adopted.)
255
                    Use_It (Obj3);
256
                    Use_It (Obj4);
257
 
258
                    exit when not Ident_Bool (Obj2.D);
259
 
260
                    Failed ("Exit not taken");
261
                end;
262
            end loop;
263
            Failed ("No exception raised by finalization on exit");
264
        exception
265
            when Program_Error =>
266
                if not Was_Finalized (Ident_Int (11)) or
267
                   not Was_Finalized (Ident_Int (12)) or
268
                   not Was_Finalized (Ident_Int (14)) then
269
                    Failed ("Missing finalizations - 3");
270
                end if;
271
            when E: others =>
272
                Failed ("Exception " & Exception_Name (E) &
273
                        " raised - " & Exception_Message (E) & " - 3");
274
        end An_Exit;
275
 
276
    A_Goto: -- Case 4
277
        begin
278
            declare
279
                Obj1 : Ctrl := Create (Ident_Int (15));
280
                Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
281
                                         D => False,
282
                                         Finalized => Ident_Bool (False),
283
                                         C1 => Ident_Int (0));
284
                             -- Finalization: Tasking_Error
285
                Obj3 : Ctrl := Create (Ident_Int (16));
286
                Obj4 : Ctrl := (Ada.Finalization.Controlled with
287
                                D => True,
288
                                Finalized => Ident_Bool (False),
289
                                C2 => 2.0 * Float (Ident_Int (17)));
290
            begin
291
                Comment ("Finalization because of goto statement");
292
 
293
                Use_It (Obj1); -- Prevent optimization of Objects.
294
                Use_It (Obj2); -- (Critical if AI-147 is adopted.)
295
                Use_It (Obj3);
296
                Use_It (Obj4);
297
 
298
                if Ident_Bool (Obj4.D) then
299
                   goto Continue;
300
                end if;
301
 
302
                Failed ("Goto not taken");
303
            end;
304
         <>
305
            Failed ("No exception raised by finalization on goto");
306
        exception
307
            when Program_Error =>
308
                if not Was_Finalized (Ident_Int (15)) or
309
                   not Was_Finalized (Ident_Int (16)) or
310
                   not Was_Finalized (Ident_Int (17)) then
311
                    Failed ("Missing finalizations - 4");
312
                end if;
313
            when E: others =>
314
                Failed ("Exception " & Exception_Name (E) &
315
                        " raised - " & Exception_Message (E) & " - 4");
316
        end A_Goto;
317
 
318
    A_Return: -- Case 5
319
        declare
320
            procedure Do_Something is
321
                Obj1 : Ctrl := Create (Ident_Int (18));
322
                Obj2 : Ctrl := (Ada.Finalization.Controlled with
323
                                D => True,
324
                                Finalized => Ident_Bool (False),
325
                                C2 => 2.0 * Float (Ident_Int (19)));
326
                Obj3 : constant Ctrl := (Ada.Finalization.Controlled with
327
                                         D => False,
328
                                         Finalized => Ident_Bool (False),
329
                                         C1 => Ident_Int (20));
330
                             -- Finalization: Tasking_Error
331
            begin
332
                Comment ("Finalization because of return statement");
333
 
334
                Use_It (Obj1); -- Prevent optimization of Objects.
335
                Use_It (Obj2); -- (Critical if AI-147 is adopted.)
336
                Use_It (Obj3);
337
 
338
                if not Ident_Bool (Obj3.D) then
339
                   return;
340
                end if;
341
 
342
                Failed ("Return not taken");
343
            end Do_Something;
344
        begin
345
            Do_Something;
346
            Failed ("No exception raised by finalization on return statement");
347
        exception
348
            when Program_Error =>
349
                if not Was_Finalized (Ident_Int (18)) or
350
                   not Was_Finalized (Ident_Int (19)) then
351
                    Failed ("Missing finalizations - 5");
352
                end if;
353
            when E: others =>
354
                Failed ("Exception " & Exception_Name (E) &
355
                        " raised - " & Exception_Message (E) & " - 5");
356
        end A_Return;
357
 
358
    Except: -- Case 6
359
        declare
360
            Funky_Error : exception;
361
 
362
            procedure Do_Something is
363
                Obj1 : Ctrl :=
364
                    (Ada.Finalization.Controlled with
365
                     D => True,
366
                     Finalized => Ident_Bool (False),
367
                     C2 => 2.0 * Float (
368
                           Ident_Int(23))); -- Finalization: User_Error
369
                Obj2 : Ctrl := Create (Ident_Int (24));
370
                Obj3 : Ctrl := Create (Ident_Int (25));
371
                Obj4 : constant Ctrl := (Ada.Finalization.Controlled with
372
                                         D => False,
373
                                         Finalized => Ident_Bool (False),
374
                                         C1 => Ident_Int (26));
375
            begin
376
                Comment ("Finalization because of exception propagation");
377
 
378
                Use_It (Obj1); -- Prevent optimization of Objects.
379
                Use_It (Obj2); -- (Critical if AI-147 is adopted.)
380
                Use_It (Obj3);
381
                Use_It (Obj4);
382
 
383
                if not Ident_Bool (Obj4.D) then
384
                   raise Funky_Error;
385
                end if;
386
 
387
                Failed ("Exception not raised");
388
            end Do_Something;
389
        begin
390
            Do_Something;
391
            Failed ("No exception raised by finalization on exception " &
392
                    "propagation");
393
        exception
394
            when Program_Error =>
395
                if not Was_Finalized (Ident_Int (24)) or
396
                   not Was_Finalized (Ident_Int (25)) or
397
                   not Was_Finalized (Ident_Int (26)) then
398
                    Failed ("Missing finalizations - 6");
399
                end if;
400
            when Funky_Error =>
401
                Failed ("Wrong exception propagated");
402
                    -- Should be Program_Error (7.6.1(19)).
403
            when E: others =>
404
                Failed ("Exception " & Exception_Name (E) &
405
                        " raised - " & Exception_Message (E) & " - 6");
406
        end Except;
407
 
408
    Result;
409
end C761011;
410
 

powered by: WebSVN 2.1.0

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