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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log


-- C761011.A
--
--                             Grant of Unlimited Rights
--
--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
--     rights in the software and documentation contained herein. Unlimited
--     rights are the same as those granted by the U.S. Government for older
--     parts of the Ada Conformity Assessment Test Suite, and are defined
--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
--     intends to confer upon all recipients unlimited rights equal to those
--     held by the ACAA. These rights include rights to use, duplicate,
--     release or disclose the released technical data and computer software
--     in whole or in part, in any manner and for any purpose whatsoever, and
--     to have or permit others to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
--    Check that if a Finalize propagates an exception, other Finalizes due
--    to be performed are performed.
--        Case 1: A Finalize invoked due to the end of execution of
--        a master. (Defect Report 8652/0023, as reflected in Technical
--        Corrigendum 1).
--        Case 2: A Finalize invoked due to finalization of an anonymous
--        object. (Defect Report 8652/0023, as reflected in Technical
--        Corrigendum 1).
--        Case 3: A Finalize invoked due to the transfer of control
--        due to an exit statement.
--        Case 4: A Finalize invoked due to the transfer of control
--        due to a goto statement.
--        Case 5: A Finalize invoked due to the transfer of control
--        due to a return statement.
--        Case 6: A Finalize invoked due to the transfer of control
--        due to raises an exception.
--
--
-- CHANGE HISTORY:
--    29 JAN 2001   PHL   Initial version
--    15 MAR 2001   RLB   Readied for release; added optimization blockers.
--                        Added test cases for paragraphs 18 and 19 of the
--                        standard (the previous tests were withdrawn).
--
--!
with Ada.Finalization;
use Ada.Finalization;
package C761011_0 is
 
    type Ctrl (D : Boolean) is new Ada.Finalization.Controlled with
        record
            Finalized : Boolean := False;
            case D is
                when False =>
                    C1 : Integer;
                when True =>
                    C2 : Float;
            end case;
        end record;
 
    function Create (Id : Integer) return Ctrl;
    procedure Finalize (Obj : in out Ctrl);
    function Was_Finalized (Id : Integer) return Boolean;
    procedure Use_It (Obj : in Ctrl);
       -- Use Obj to prevent optimization.
 
end C761011_0;
 
with Report;
use Report;
package body C761011_0 is
 
    User_Error : exception;
 
    Finalize_Called : array (0 .. 50) of Boolean := (others => False);
 
    function Create (Id : Integer) return Ctrl is
        Obj : Ctrl (Boolean'Val (Id mod Ident_Int (2)));
    begin
        case Obj.D is
            when False =>
                Obj.C1 := Ident_Int (Id);
            when True =>
                Obj.C2 := Float (Ident_Int (Id + Ident_Int (Id)));
        end case;
        return Obj;
    end Create;
 
    procedure Finalize (Obj : in out Ctrl) is
    begin
        if not Obj.Finalized then
            Obj.Finalized := True;
            if Obj.D then
                if Integer (Obj.C2 / 2.0) mod Ident_Int (10) =
                   Ident_Int (3) then
                    raise User_Error;
                else
                    Finalize_Called (Integer (Obj.C2) / 2) := True;
                end if;
            else
                if Obj.C1 mod Ident_Int (10) = Ident_Int (0) then
                    raise Tasking_Error;
                else
                    Finalize_Called (Obj.C1) := True;
                end if;
            end if;
        end if;
    end Finalize;
 
    function Was_Finalized (Id : Integer) return Boolean is
    begin
        return Finalize_Called (Ident_Int (Id));
    end Was_Finalized;
 
    procedure Use_It (Obj : in Ctrl) is
       -- Use Obj to prevent optimization.
    begin
        case Obj.D is
            when True =>
                if not Equal (Boolean'Pos(Obj.Finalized),
                              Boolean'Pos(Obj.Finalized)) then
                    Failed ("Identity check - 1");
                end if;
            when False =>
                if not Equal (Obj.C1, Obj.C1) then
                    Failed ("Identity check - 2");
                end if;
        end case;
    end Use_It;
 
end C761011_0;
 
with Ada.Exceptions;
use Ada.Exceptions;
with Ada.Finalization;
with C761011_0;
use C761011_0;
with Report;
use Report;
procedure C761011 is
begin
    Test
       ("C761011",
        " Check that if a finalize propagates an exception, other finalizes " &
         "due to be performed are performed");
 
    Normal: -- Case 1
        begin
            declare
                Obj1 : Ctrl := Create (Ident_Int (1));
                Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
                                         D => False,
                                         Finalized => Ident_Bool (False),
                                         C1 => Ident_Int (2));
                Obj3 : Ctrl :=
                   (Ada.Finalization.Controlled with
                    D => True,
                    Finalized => Ident_Bool (False),
                    C2 => 2.0 * Float (Ident_Int
                                          (3))); -- Finalization: User_Error
                Obj4 : Ctrl := Create (Ident_Int (4));
            begin
                Comment ("Finalization of normal object");
                Use_It (Obj1); -- Prevent optimization of Objects.
                Use_It (Obj2); -- (Critical if AI-147 is adopted.)
                Use_It (Obj3);
                Use_It (Obj4);
            end;
            Failed ("No exception raised by finalization of normal object");
        exception
            when Program_Error =>
                if not Was_Finalized (Ident_Int (1)) or
                   not Was_Finalized (Ident_Int (2)) or
                   not Was_Finalized (Ident_Int (4)) then
                    Failed ("Missing finalizations - 1");
                end if;
            when E: others =>
                Failed ("Exception " & Exception_Name (E) &
                        " raised - " & Exception_Message (E) & " - 1");
        end Normal;
 
    Anon: -- Case 2
        begin
            declare
                Obj1 : Ctrl := (Ada.Finalization.Controlled with
                                D => True,
                                Finalized => Ident_Bool (False),
                                C2 => 2.0 * Float (Ident_Int (5)));
                Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
                                         D => False,
                                         Finalized => Ident_Bool (False),
                                         C1 => Ident_Int (6));
                Obj3 : Ctrl := (Ada.Finalization.Controlled with
                                D => True,
                                Finalized => Ident_Bool (False),
                                C2 => 2.0 * Float (Ident_Int (7)));
                Obj4 : Ctrl := Create (Ident_Int (8));
            begin
                Comment ("Finalization of anonymous object");
 
                -- The finalization of the anonymous object below will raise
                -- Tasking_Error.
                if Create (Ident_Int (10)).C1 /= Ident_Int (10) then
                    Failed ("Incorrect construction of an anonymous object");
                end if;
                Failed ("Anonymous object not finalized at the end of the " &
                        "enclosing statement");
                Use_It (Obj1); -- Prevent optimization of Objects.
                Use_It (Obj2); -- (Critical if AI-147 is adopted.)
                Use_It (Obj3);
                Use_It (Obj4);
            end;
            Failed ("No exception raised by finalization of an anonymous " &
                    "object of a function");
        exception
            when Program_Error =>
                if not Was_Finalized (Ident_Int (5)) or
                   not Was_Finalized (Ident_Int (6)) or
                   not Was_Finalized (Ident_Int (7)) or
                   not Was_Finalized (Ident_Int (8)) then
                    Failed ("Missing finalizations - 2");
                end if;
            when E: others =>
                Failed ("Exception " & Exception_Name (E) &
                        " raised - " & Exception_Message (E) & " - 2");
        end Anon;
 
    An_Exit: -- Case 3
        begin
            for Counter in 1 .. 4 loop
                declare
                    Obj1 : Ctrl := Create (Ident_Int (11));
                    Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
                                             D => False,
                                             Finalized => Ident_Bool (False),
                                             C1 => Ident_Int (12));
                    Obj3 : Ctrl :=
                        (Ada.Finalization.Controlled with
                         D => True,
                         Finalized => Ident_Bool (False),
                         C2 => 2.0 * Float (
                               Ident_Int(13))); -- Finalization: User_Error
                    Obj4 : Ctrl := Create (Ident_Int (14));
                begin
                    Comment ("Finalization because of exit of loop");
 
                    Use_It (Obj1); -- Prevent optimization of Objects.
                    Use_It (Obj2); -- (Critical if AI-147 is adopted.)
                    Use_It (Obj3);
                    Use_It (Obj4);
 
                    exit when not Ident_Bool (Obj2.D);
 
                    Failed ("Exit not taken");
                end;
            end loop;
            Failed ("No exception raised by finalization on exit");
        exception
            when Program_Error =>
                if not Was_Finalized (Ident_Int (11)) or
                   not Was_Finalized (Ident_Int (12)) or
                   not Was_Finalized (Ident_Int (14)) then
                    Failed ("Missing finalizations - 3");
                end if;
            when E: others =>
                Failed ("Exception " & Exception_Name (E) &
                        " raised - " & Exception_Message (E) & " - 3");
        end An_Exit;
 
    A_Goto: -- Case 4
        begin
            declare
                Obj1 : Ctrl := Create (Ident_Int (15));
                Obj2 : constant Ctrl := (Ada.Finalization.Controlled with
                                         D => False,
                                         Finalized => Ident_Bool (False),
                                         C1 => Ident_Int (0));
                             -- Finalization: Tasking_Error
                Obj3 : Ctrl := Create (Ident_Int (16));
                Obj4 : Ctrl := (Ada.Finalization.Controlled with
                                D => True,
                                Finalized => Ident_Bool (False),
                                C2 => 2.0 * Float (Ident_Int (17)));
            begin
                Comment ("Finalization because of goto statement");
 
                Use_It (Obj1); -- Prevent optimization of Objects.
                Use_It (Obj2); -- (Critical if AI-147 is adopted.)
                Use_It (Obj3);
                Use_It (Obj4);
 
                if Ident_Bool (Obj4.D) then
                   goto Continue;
                end if;
 
                Failed ("Goto not taken");
            end;
         <>
            Failed ("No exception raised by finalization on goto");
        exception
            when Program_Error =>
                if not Was_Finalized (Ident_Int (15)) or
                   not Was_Finalized (Ident_Int (16)) or
                   not Was_Finalized (Ident_Int (17)) then
                    Failed ("Missing finalizations - 4");
                end if;
            when E: others =>
                Failed ("Exception " & Exception_Name (E) &
                        " raised - " & Exception_Message (E) & " - 4");
        end A_Goto;
 
    A_Return: -- Case 5
        declare
            procedure Do_Something is
                Obj1 : Ctrl := Create (Ident_Int (18));
                Obj2 : Ctrl := (Ada.Finalization.Controlled with
                                D => True,
                                Finalized => Ident_Bool (False),
                                C2 => 2.0 * Float (Ident_Int (19)));
                Obj3 : constant Ctrl := (Ada.Finalization.Controlled with
                                         D => False,
                                         Finalized => Ident_Bool (False),
                                         C1 => Ident_Int (20));
                             -- Finalization: Tasking_Error
            begin
                Comment ("Finalization because of return statement");
 
                Use_It (Obj1); -- Prevent optimization of Objects.
                Use_It (Obj2); -- (Critical if AI-147 is adopted.)
                Use_It (Obj3);
 
                if not Ident_Bool (Obj3.D) then
                   return;
                end if;
 
                Failed ("Return not taken");
            end Do_Something;
        begin
            Do_Something;
            Failed ("No exception raised by finalization on return statement");
        exception
            when Program_Error =>
                if not Was_Finalized (Ident_Int (18)) or
                   not Was_Finalized (Ident_Int (19)) then
                    Failed ("Missing finalizations - 5");
                end if;
            when E: others =>
                Failed ("Exception " & Exception_Name (E) &
                        " raised - " & Exception_Message (E) & " - 5");
        end A_Return;
 
    Except: -- Case 6
        declare
            Funky_Error : exception;
 
            procedure Do_Something is
                Obj1 : Ctrl :=
                    (Ada.Finalization.Controlled with
                     D => True,
                     Finalized => Ident_Bool (False),
                     C2 => 2.0 * Float (
                           Ident_Int(23))); -- Finalization: User_Error
                Obj2 : Ctrl := Create (Ident_Int (24));
                Obj3 : Ctrl := Create (Ident_Int (25));
                Obj4 : constant Ctrl := (Ada.Finalization.Controlled with
                                         D => False,
                                         Finalized => Ident_Bool (False),
                                         C1 => Ident_Int (26));
            begin
                Comment ("Finalization because of exception propagation");
 
                Use_It (Obj1); -- Prevent optimization of Objects.
                Use_It (Obj2); -- (Critical if AI-147 is adopted.)
                Use_It (Obj3);
                Use_It (Obj4);
 
                if not Ident_Bool (Obj4.D) then
                   raise Funky_Error;
                end if;
 
                Failed ("Exception not raised");
            end Do_Something;
        begin
            Do_Something;
            Failed ("No exception raised by finalization on exception " &
                    "propagation");
        exception
            when Program_Error =>
                if not Was_Finalized (Ident_Int (24)) or
                   not Was_Finalized (Ident_Int (25)) or
                   not Was_Finalized (Ident_Int (26)) then
                    Failed ("Missing finalizations - 6");
                end if;
            when Funky_Error =>
                Failed ("Wrong exception propagated");
                    -- Should be Program_Error (7.6.1(19)).
            when E: others =>
                Failed ("Exception " & Exception_Name (E) &
                        " raised - " & Exception_Message (E) & " - 6");
        end Except;
 
    Result;
end C761011;
 

Browse

Tools

Subversion Repositories openrisc

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

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