3 -- Grant of Unlimited Rights
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
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 as part of the finalization of a protected object
28 -- each call remaining on an entry queue of the objet is removed
29 -- from its queue and Program_Error is raised at the place of
30 -- the corresponding entry_call_statement.
33 -- The example in 9.4(20a-20f);6.0 demonstrates how to cause a
34 -- protected object to finalize while tasks are still waiting
35 -- on its entry queues. The first part of this test mirrors
36 -- that example. The second part of the test expands upon
37 -- the example code to add an object with finalization code
38 -- to the protected object. The finalization code should be
39 -- executed after Program_Error is raised in the callers left
40 -- on the entry queues.
44 -- 08 Jan 96 SAIC Initial Release for 2.1
45 -- 10 Jul 96 SAIC Incorporated Reviewer comments to fix race
51 with Ada
.Finalization
;
53 Verbose
: constant Boolean := False;
54 Finalization_Occurred
: Boolean := False;
56 type Has_Finalization
is new Ada
.Finalization
.Limited_Controlled
with
58 Placeholder
: Integer;
60 procedure Finalize
(Object
: in out Has_Finalization
);
66 package body C940014_0
is
67 procedure Finalize
(Object
: in out Has_Finalization
) is
69 delay ImpDef
.Clear_Ready_Queue
;
70 Finalization_Occurred
:= True;
72 Report
.Comment
("in Finalize");
81 with Ada
.Finalization
;
85 Verbose
: constant Boolean := C940014_0
.Verbose
;
89 Report
.Test
("C940014", "Check that the finalization of a protected" &
90 " object results in program_error being raised" &
91 " at the point of the entry call statement for" &
92 " any tasks remaining on any entry queue");
95 -- example from ARM 9.4(20a-f);6.0 with minor mods
104 entry Ee
when Report
.Ident_Bool
(False) is
114 Report
.Comment
("task about to terminate");
120 delay ImpDef
.Clear_Ready_Queue
;
121 Report
.Failed
("exception not raised in First_Check");
123 when Program_Error
=>
125 Report
.Comment
("ARM Example passed");
128 Report
.Failed
("wrong exception in First_Check");
133 Second_Check
: declare
134 -- here we want to check that the raising of Program_Error
135 -- occurs before the other finalization actions.
143 Component
: C940014_0
.Has_Finalization
;
146 entry Ee
when Report
.Ident_Bool
(False) is
156 Report
.Comment
("task about to terminate");
159 begin -- Second_Check
161 delay ImpDef
.Clear_Ready_Queue
;
162 Report
.Failed
("exception not raised in Second_Check");
164 when Program_Error
=>
165 if C940014_0
.Finalization_Occurred
then
166 Report
.Failed
("wrong order for finalization");
168 Report
.Comment
("Second_Check passed");
171 Report
.Failed
("Wrong exception in Second_Check");