1-- C940014.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-- TEST OBJECTIVE:
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.
31--
32-- TEST DESCRIPTION:
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.
41--
42--
43-- CHANGE HISTORY:
44--      08 Jan 96   SAIC    Initial Release for 2.1
45--      10 Jul 96   SAIC    Incorporated Reviewer comments to fix race
46--                          condition.
47--
48--!
49
50
51with Ada.Finalization;
52package C940014_0 is
53    Verbose : constant Boolean := False;
54    Finalization_Occurred : Boolean := False;
55
56    type Has_Finalization is new Ada.Finalization.Limited_Controlled with
57          record
58             Placeholder : Integer;
59          end record;
60    procedure Finalize (Object : in out Has_Finalization);
61end C940014_0;
62
63
64with Report;
65with ImpDef;
66package body C940014_0 is
67    procedure Finalize (Object : in out Has_Finalization) is
68    begin
69	delay ImpDef.Clear_Ready_Queue;
70        Finalization_Occurred := True;
71        if Verbose then
72            Report.Comment ("in Finalize");
73        end if;
74    end Finalize;
75end C940014_0;
76
77
78
79with Report;
80with ImpDef;
81with Ada.Finalization;
82with C940014_0;
83
84procedure C940014 is
85   Verbose : constant Boolean := C940014_0.Verbose;
86
87begin
88
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");
93
94   First_Check: declare
95       -- example from ARM 9.4(20a-f);6.0 with minor mods
96       task T is
97           entry E;
98       end T;
99       task body T is
100           protected PO is
101               entry Ee;
102           end PO;
103           protected body PO is
104               entry Ee when Report.Ident_Bool (False) is
105               begin
106                   null;
107               end Ee;
108           end PO;
109       begin
110           accept E do
111                requeue PO.Ee;
112           end E;
113           if Verbose then
114                Report.Comment ("task about to terminate");
115           end if;
116       end T;
117   begin  -- First_Check
118       begin
119           T.E;
120           delay ImpDef.Clear_Ready_Queue;
121           Report.Failed ("exception not raised in First_Check");
122       exception
123           when Program_Error =>
124               if Verbose then
125                   Report.Comment ("ARM Example passed");
126               end if;
127           when others =>
128               Report.Failed ("wrong exception in First_Check");
129       end;
130   end First_Check;
131
132
133   Second_Check : declare
134      -- here we want to check that the raising of Program_Error
135      -- occurs before the other finalization actions.
136       task T is
137           entry E;
138       end T;
139       task body T is
140           protected PO is
141               entry Ee;
142           private
143               Component : C940014_0.Has_Finalization;
144           end PO;
145           protected body PO is
146               entry Ee when Report.Ident_Bool (False) is
147               begin
148                   null;
149               end Ee;
150           end PO;
151       begin
152           accept E do
153                requeue PO.Ee;
154           end E;
155           if Verbose then
156                Report.Comment ("task about to terminate");
157           end if;
158       end T;
159   begin  -- Second_Check
160       T.E;
161       delay ImpDef.Clear_Ready_Queue;
162       Report.Failed ("exception not raised in Second_Check");
163   exception
164       when Program_Error =>
165           if C940014_0.Finalization_Occurred then
166               Report.Failed ("wrong order for finalization");
167           elsif Verbose then
168               Report.Comment ("Second_Check passed");
169           end if;
170       when others =>
171           Report.Failed ("Wrong exception in Second_Check");
172   end Second_Check;
173
174
175   Report.Result;
176
177end C940014;
178