diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c9/c980003.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c9/c980003.a | 294 |
1 files changed, 0 insertions, 294 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c9/c980003.a b/gcc/testsuite/ada/acats/tests/c9/c980003.a deleted file mode 100644 index dd69fc7ee68..00000000000 --- a/gcc/testsuite/ada/acats/tests/c9/c980003.a +++ /dev/null @@ -1,294 +0,0 @@ --- 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; |