Subversion Repositories openrisc_me

-- 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;