3 -- Grant of Unlimited Rights
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.
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.
27 -- Check that an anonymous object is finalized with its enclosing master if
28 -- a transfer of control or exception occurs prior to performing its normal
29 -- finalization. (Defect Report 8652/0023, as reflected in
30 -- Technical Corrigendum 1, RM95 7.6.1(13.1/1)).
33 -- 29 JAN 2001 PHL Initial version.
34 -- 5 DEC 2001 RLB Reformatted for ACATS.
37 with Ada
.Finalization
;
41 type Ctrl
(D
: Boolean) is new Controlled
with
51 function Create
return Ctrl
;
52 procedure Finalize
(Obj
: in out Ctrl
);
53 function Finalize_Was_Called
return Boolean;
59 package body C761012_0
is
61 Finalization_Flag
: Boolean := False;
63 function Create
return Ctrl
is
64 Obj
: Ctrl
(Ident_Bool
(True));
70 procedure Finalize
(Obj
: in out Ctrl
) is
72 Finalization_Flag
:= True;
75 function Finalize_Was_Called
return Boolean is
77 if Finalization_Flag
then
78 Finalization_Flag
:= False;
83 end Finalize_Was_Called
;
96 "Check that an anonymous object is finalized with its enclosing " &
97 "master if a transfer of control or exception occurs prior to " &
98 "performing its normal finalization");
104 I
: Integer := Create
.C1
; -- Raises Constraint_Error
107 ("Improper component selection did not raise Constraint_Error, I =" &
110 when Constraint_Error
=>
111 Failed
("Constraint_Error caught by the wrong handler");
114 Failed
("Transfer of control did not happen correctly");
117 when Constraint_Error
=>
118 if not Finalize_Was_Called
then
119 Failed
("Finalize wasn't called when the master was left " &
120 "- Constraint_Error");
123 Failed
("Exception " & Exception_Name
(E
) &
124 " raised - " & Exception_Information
(E
));
129 Finalize_Was_Called_Before_Leaving_Exit
: Boolean;
134 exit when Create
.C2
= 3.0;
136 Finalize_Was_Called_Before_Leaving_Exit
:= Finalize_Was_Called
;
137 if Finalize_Was_Called_Before_Leaving_Exit
then
138 Comment
("Finalize called before the transfer of control");
142 if not Finalize_Was_Called
and then
143 not Finalize_Was_Called_Before_Leaving_Exit
then
144 Failed
("Finalize wasn't called when the master was left " &
145 "- transfer of control");