1-- C980003.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 aborts are deferred during the execution of an
28--      Initialize procedure (as the last step of the default
29--      initialization of a controlled object), during the execution
30--      of a Finalize procedure (as part of the finalization of a
31--      controlled object), and during an assignment operation to an
32--      object with a controlled part.
33--
34-- TEST DESCRIPTION:
35--      A controlled type is created with Initialize, Adjust, and
36--      Finalize operations.  These operations note in a protected
37--      object when the operation starts and completes.  This change
38--      in state of the protected object will open the barrier for
39--      the entry in the protected object.
40--      The test contains declarations of objects of the controlled
41--      type.  An asynchronous select is used to attempt to abort
42--      the operations on the controlled type.  The asynchronous select
43--      makes use of the state change to the protected object to
44--      trigger the abort.
45--
46--
47-- CHANGE HISTORY:
48--      11 Jan 96   SAIC    Initial Release for 2.1
49--       5 May 96   SAIC    Incorporated Reviewer comments.
50--      10 Oct 96   SAIC    Addressed issue where assignment statement
51--                          can be 2 assignment operations.
52--
53--!
54
55with Ada.Finalization;
56package C980003_0 is
57    Verbose : constant Boolean := False;
58
59    -- the following flag is set true whenever the
60    -- Initialize operation is called.
61    Init_Occurred : Boolean;
62
63    type Is_Controlled is new Ada.Finalization.Controlled with
64         record
65             Id : Integer;
66         end record;
67
68     procedure Initialize (Object : in out Is_Controlled);
69     procedure Finalize   (Object : in out Is_Controlled);
70     procedure Adjust     (Object : in out Is_Controlled);
71
72     type States is (Unknown,
73                     Start_Init,   Finished_Init,
74                     Start_Adjust, Finished_Adjust,
75                     Start_Final,  Finished_Final);
76
77     protected State_Manager is
78        procedure Reset;
79        procedure Set (New_State : States);
80        function Current return States;
81        entry Wait_For_Change;
82     private
83        Current_State : States := Unknown;
84        Changed : Boolean := False;
85     end State_Manager;
86
87end C980003_0;
88
89
90with Report;
91with ImpDef;
92package body C980003_0 is
93     protected body State_Manager is
94         procedure Reset is
95         begin
96             Current_State := Unknown;
97             Changed := False;
98         end Reset;
99
100         procedure Set (New_State : States) is
101         begin
102             Changed := True;
103             Current_State := New_State;
104         end Set;
105
106         function Current return States is
107         begin
108             return Current_State;
109         end Current;
110
111         entry Wait_For_Change when Changed is
112         begin
113             Changed := False;
114         end Wait_For_Change;
115     end State_Manager;
116
117     procedure Initialize (Object : in out Is_Controlled) is
118     begin
119        if Verbose then
120            Report.Comment ("starting initialize");
121        end if;
122        State_Manager.Set (Start_Init);
123        if Verbose then
124            Report.Comment ("in initialize");
125        end if;
126        delay ImpDef.Switch_To_New_Task;  -- tempting place for abort
127        State_Manager.Set (Finished_Init);
128        if Verbose then
129            Report.Comment ("finished initialize");
130        end if;
131        Init_Occurred := True;
132     end Initialize;
133
134     procedure Finalize   (Object : in out Is_Controlled) is
135     begin
136        if Verbose then
137            Report.Comment ("starting finalize");
138        end if;
139        State_Manager.Set (Start_Final);
140        if Verbose then
141            Report.Comment ("in finalize");
142        end if;
143        delay ImpDef.Switch_To_New_Task; -- tempting place for abort
144        State_Manager.Set (Finished_Final);
145        if Verbose then
146            Report.Comment ("finished finalize");
147        end if;
148     end Finalize;
149
150     procedure Adjust     (Object : in out Is_Controlled) is
151     begin
152        if Verbose then
153            Report.Comment ("starting adjust");
154        end if;
155        State_Manager.Set (Start_Adjust);
156        if Verbose then
157            Report.Comment ("in adjust");
158        end if;
159        delay ImpDef.Switch_To_New_Task; -- tempting place for abort
160        State_Manager.Set (Finished_Adjust);
161        if Verbose then
162            Report.Comment ("finished adjust");
163        end if;
164     end Adjust;
165end C980003_0;
166
167
168with Report;
169with ImpDef;
170with C980003_0;  use C980003_0;
171with Ada.Unchecked_Deallocation;
172procedure C980003 is
173
174    procedure Check_State (Should_Be : States;
175                           Msg       : String) is
176        Cur : States := State_Manager.Current;
177    begin
178        if Cur /= Should_Be then
179            Report.Failed (Msg);
180            Report.Comment ("expected: " & States'Image (Should_Be) &
181                            "  found: " & States'Image (Cur));
182        elsif Verbose then
183            Report.Comment ("passed: " & Msg);
184        end if;
185    end Check_State;
186
187begin
188
189    Report.Test ("C980003", "Check that aborts are deferred during" &
190                            " initialization, finalization, and assignment" &
191                            " operations on controlled objects");
192
193    Check_State (Unknown, "initial condition");
194
195    -- check that initialization and finalization take place
196    Init_Occurred := False;
197    select
198        State_Manager.Wait_For_Change;
199    then abort
200        declare
201            My_Controlled_Obj : Is_Controlled;
202        begin
203            delay 0.0;   -- abort completion point
204            Report.Failed ("state change did not occur");
205        end;
206    end select;
207    if not Init_Occurred then
208        Report.Failed ("Initialize did not complete");
209    end if;
210    Check_State (Finished_Final, "init/final for declared item");
211
212    -- check adjust
213    State_Manager.Reset;
214    declare
215        Source, Dest : Is_Controlled;
216    begin
217        Check_State (Finished_Init, "adjust initial state");
218        Source.Id := 3;
219        Dest.Id := 4;
220        State_Manager.Reset;  -- so we will wait for change
221        select
222            State_Manager.Wait_For_Change;
223        then abort
224            Dest := Source;
225        end select;
226
227        -- there are two implementation methods for the
228        -- assignment statement:
229        --   1.  no temporary was used in the assignment statement
230        --        thus the entire
231        --        assignment statement is abort deferred.
232        --   2.  a temporary was used in the assignment statement so
233        --        there are two assignment operations.  An abort may
234        --        occur between the assignment operations
235        -- Various optimizations are allowed by 7.6 that can affect
236        -- how many times Adjust and Finalize are called.
237        -- Depending upon the implementation, the state can be either
238        -- Finished_Adjust or Finished_Finalize.   If it is any other
239        -- state then the abort took place at the wrong time.
240
241        case State_Manager.Current is
242        when Finished_Adjust =>
243            if Verbose then
244                Report.Comment ("assignment aborted after adjust");
245            end if;
246        when Finished_Final =>
247            if Verbose then
248                Report.Comment ("assignment aborted after finalize");
249            end if;
250        when Start_Adjust =>
251            Report.Failed ("assignment aborted in adjust");
252        when Start_Final =>
253            Report.Failed ("assignment aborted in finalize");
254        when Start_Init =>
255            Report.Failed ("assignment aborted in initialize");
256        when Finished_Init =>
257            Report.Failed ("assignment aborted after initialize");
258        when Unknown =>
259            Report.Failed ("assignment aborted in unknown state");
260        end case;
261
262
263        if Dest.Id /= 3 then
264            if Verbose then
265                Report.Comment ("assignment not performed");
266            end if;
267        end if;
268    end;
269
270
271     -- check dynamically allocated objects
272    State_Manager.Reset;
273    declare
274        type Pointer_Type is access Is_Controlled;
275        procedure Free is new Ada.Unchecked_Deallocation (
276              Is_Controlled, Pointer_Type);
277        Ptr : Pointer_Type;
278    begin
279      -- make sure initialize is done when object is allocated
280      Ptr := new Is_Controlled;
281      Check_State (Finished_Init, "init when item allocated");
282      -- now try aborting the finalize
283      State_Manager.Reset;
284      select
285             State_Manager.Wait_For_Change;
286      then abort
287             Free (Ptr);
288      end select;
289      Check_State (Finished_Final, "finalization in dealloc");
290    end;
291
292    Report.Result;
293
294end C980003;
295