| -- C980003.A |
| -- |
| -- Grant of Unlimited Rights |
| -- |
| -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, |
| -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained |
| -- unlimited rights in the software and documentation contained herein. |
| -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making |
| -- this public release, the Government intends to confer upon all |
| -- recipients unlimited rights equal to those held by the Government. |
| -- 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. |
| --* |
| -- |
| -- TEST OBJECTIVE: |
| -- Check that aborts are deferred during the execution of an |
| -- Initialize procedure (as the last step of the default |
| -- initialization of a controlled object), during the execution |
| -- of a Finalize procedure (as part of the finalization of a |
| -- controlled object), and during an assignment operation to an |
| -- object with a controlled part. |
| -- |
| -- TEST DESCRIPTION: |
| -- A controlled type is created with Initialize, Adjust, and |
| -- Finalize operations. These operations note in a protected |
| -- object when the operation starts and completes. This change |
| -- in state of the protected object will open the barrier for |
| -- the entry in the protected object. |
| -- The test contains declarations of objects of the controlled |
| -- type. An asynchronous select is used to attempt to abort |
| -- the operations on the controlled type. The asynchronous select |
| -- makes use of the state change to the protected object to |
| -- trigger the abort. |
| -- |
| -- |
| -- CHANGE HISTORY: |
| -- 11 Jan 96 SAIC Initial Release for 2.1 |
| -- 5 May 96 SAIC Incorporated Reviewer comments. |
| -- 10 Oct 96 SAIC Addressed issue where assignment statement |
| -- can be 2 assignment operations. |
| -- |
| --! |
| |
| with Ada.Finalization; |
| package C980003_0 is |
| Verbose : constant Boolean := False; |
| |
| -- the following flag is set true whenever the |
| -- Initialize operation is called. |
| Init_Occurred : Boolean; |
| |
| type Is_Controlled is new Ada.Finalization.Controlled with |
| record |
| Id : Integer; |
| end record; |
| |
| procedure Initialize (Object : in out Is_Controlled); |
| procedure Finalize (Object : in out Is_Controlled); |
| procedure Adjust (Object : in out Is_Controlled); |
| |
| type States is (Unknown, |
| Start_Init, Finished_Init, |
| Start_Adjust, Finished_Adjust, |
| Start_Final, Finished_Final); |
| |
| protected State_Manager is |
| procedure Reset; |
| procedure Set (New_State : States); |
| function Current return States; |
| entry Wait_For_Change; |
| private |
| Current_State : States := Unknown; |
| Changed : Boolean := False; |
| end State_Manager; |
| |
| end C980003_0; |
| |
| |
| with Report; |
| with ImpDef; |
| package body C980003_0 is |
| protected body State_Manager is |
| procedure Reset is |
| begin |
| Current_State := Unknown; |
| Changed := False; |
| end Reset; |
| |
| procedure Set (New_State : States) is |
| begin |
| Changed := True; |
| Current_State := New_State; |
| end Set; |
| |
| function Current return States is |
| begin |
| return Current_State; |
| end Current; |
| |
| entry Wait_For_Change when Changed is |
| begin |
| Changed := False; |
| end Wait_For_Change; |
| end State_Manager; |
| |
| procedure Initialize (Object : in out Is_Controlled) is |
| begin |
| if Verbose then |
| Report.Comment ("starting initialize"); |
| end if; |
| State_Manager.Set (Start_Init); |
| if Verbose then |
| Report.Comment ("in initialize"); |
| end if; |
| delay ImpDef.Switch_To_New_Task; -- tempting place for abort |
| State_Manager.Set (Finished_Init); |
| if Verbose then |
| Report.Comment ("finished initialize"); |
| end if; |
| Init_Occurred := True; |
| end Initialize; |
| |
| procedure Finalize (Object : in out Is_Controlled) is |
| begin |
| if Verbose then |
| Report.Comment ("starting finalize"); |
| end if; |
| State_Manager.Set (Start_Final); |
| if Verbose then |
| Report.Comment ("in finalize"); |
| end if; |
| delay ImpDef.Switch_To_New_Task; -- tempting place for abort |
| State_Manager.Set (Finished_Final); |
| if Verbose then |
| Report.Comment ("finished finalize"); |
| end if; |
| end Finalize; |
| |
| procedure Adjust (Object : in out Is_Controlled) is |
| begin |
| if Verbose then |
| Report.Comment ("starting adjust"); |
| end if; |
| State_Manager.Set (Start_Adjust); |
| if Verbose then |
| Report.Comment ("in adjust"); |
| end if; |
| delay ImpDef.Switch_To_New_Task; -- tempting place for abort |
| State_Manager.Set (Finished_Adjust); |
| if Verbose then |
| Report.Comment ("finished adjust"); |
| end if; |
| end Adjust; |
| end C980003_0; |
| |
| |
| with Report; |
| with ImpDef; |
| with C980003_0; use C980003_0; |
| with Ada.Unchecked_Deallocation; |
| procedure C980003 is |
| |
| procedure Check_State (Should_Be : States; |
| Msg : String) is |
| Cur : States := State_Manager.Current; |
| begin |
| if Cur /= Should_Be then |
| Report.Failed (Msg); |
| Report.Comment ("expected: " & States'Image (Should_Be) & |
| " found: " & States'Image (Cur)); |
| elsif Verbose then |
| Report.Comment ("passed: " & Msg); |
| end if; |
| end Check_State; |
| |
| begin |
| |
| Report.Test ("C980003", "Check that aborts are deferred during" & |
| " initialization, finalization, and assignment" & |
| " operations on controlled objects"); |
| |
| Check_State (Unknown, "initial condition"); |
| |
| -- check that initialization and finalization take place |
| Init_Occurred := False; |
| select |
| State_Manager.Wait_For_Change; |
| then abort |
| declare |
| My_Controlled_Obj : Is_Controlled; |
| begin |
| delay 0.0; -- abort completion point |
| Report.Failed ("state change did not occur"); |
| end; |
| end select; |
| if not Init_Occurred then |
| Report.Failed ("Initialize did not complete"); |
| end if; |
| Check_State (Finished_Final, "init/final for declared item"); |
| |
| -- check adjust |
| State_Manager.Reset; |
| declare |
| Source, Dest : Is_Controlled; |
| begin |
| Check_State (Finished_Init, "adjust initial state"); |
| Source.Id := 3; |
| Dest.Id := 4; |
| State_Manager.Reset; -- so we will wait for change |
| select |
| State_Manager.Wait_For_Change; |
| then abort |
| Dest := Source; |
| end select; |
| |
| -- there are two implementation methods for the |
| -- assignment statement: |
| -- 1. no temporary was used in the assignment statement |
| -- thus the entire |
| -- assignment statement is abort deferred. |
| -- 2. a temporary was used in the assignment statement so |
| -- there are two assignment operations. An abort may |
| -- occur between the assignment operations |
| -- Various optimizations are allowed by 7.6 that can affect |
| -- how many times Adjust and Finalize are called. |
| -- Depending upon the implementation, the state can be either |
| -- Finished_Adjust or Finished_Finalize. If it is any other |
| -- state then the abort took place at the wrong time. |
| |
| case State_Manager.Current is |
| when Finished_Adjust => |
| if Verbose then |
| Report.Comment ("assignment aborted after adjust"); |
| end if; |
| when Finished_Final => |
| if Verbose then |
| Report.Comment ("assignment aborted after finalize"); |
| end if; |
| when Start_Adjust => |
| Report.Failed ("assignment aborted in adjust"); |
| when Start_Final => |
| Report.Failed ("assignment aborted in finalize"); |
| when Start_Init => |
| Report.Failed ("assignment aborted in initialize"); |
| when Finished_Init => |
| Report.Failed ("assignment aborted after initialize"); |
| when Unknown => |
| Report.Failed ("assignment aborted in unknown state"); |
| end case; |
| |
| |
| if Dest.Id /= 3 then |
| if Verbose then |
| Report.Comment ("assignment not performed"); |
| end if; |
| end if; |
| end; |
| |
| |
| -- check dynamically allocated objects |
| State_Manager.Reset; |
| declare |
| type Pointer_Type is access Is_Controlled; |
| procedure Free is new Ada.Unchecked_Deallocation ( |
| Is_Controlled, Pointer_Type); |
| Ptr : Pointer_Type; |
| begin |
| -- make sure initialize is done when object is allocated |
| Ptr := new Is_Controlled; |
| Check_State (Finished_Init, "init when item allocated"); |
| -- now try aborting the finalize |
| State_Manager.Reset; |
| select |
| State_Manager.Wait_For_Change; |
| then abort |
| Free (Ptr); |
| end select; |
| Check_State (Finished_Final, "finalization in dealloc"); |
| end; |
| |
| Report.Result; |
| |
| end C980003; |
