Subversion Repositories openrisc

-- C980002.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.

--*

--

-- OBJECTIVE:

--      Check that aborts are deferred during protected actions.

--

-- TEST DESCRIPTION:

--      This test uses an asynchronous transfer of control to attempt

--      to abort a protected operation.  The protected operation

--      includes several requeues to check that the requeue does not

--      allow the abort to occur.

--

--

-- CHANGE HISTORY:

--      30 OCT 95   SAIC    ACVC 2.1

--

--!

with Report;

procedure C980002 is

  Max_Checkpoints : constant := 7;

  type Checkpoint_ID is range 1..Max_Checkpoints;

  type Points_Array is array (Checkpoint_ID) of Boolean;

begin

  Report.Test ("C980002",

               "Check that aborts are deferred during a protected action" &

               " including requeues");

  declare -- test encapsulation

    protected Checkpoint is

       procedure Got_Here (Id : Checkpoint_ID);

       function Results return Points_Array;

    private

       Reached_Points : Points_Array := (others => False);

    end Checkpoint;

    protected body Checkpoint is

       procedure Got_Here (Id : Checkpoint_ID) is

       begin

          Reached_Points (Id) := True;

       end Got_Here;

       function Results return Points_Array is

       begin

          return Reached_Points;

       end Results;

    end Checkpoint;

    protected Start_Here is

       entry AST_Waits_Here;

       entry Start_PO;

    private

       Open : Boolean := False;

       entry First_Stop;

    end Start_Here;

    protected Middle_PO is

       entry Stop_1;

       entry Stop_2;

    end Middle_PO;

    protected Final_PO is

       entry Final_Stop;

    end Final_PO;

    protected body Start_Here is

       entry AST_Waits_Here when Open is

       begin

          null;

       end AST_Waits_Here;

       entry Start_PO when True is

       begin

          Open := True;

          Checkpoint.Got_Here (1);

          requeue First_Stop;

       end Start_PO;

       -- make sure the AST has been accepted before continuing

       entry First_Stop when AST_Waits_Here'Count = 0 is

       begin

          Checkpoint.Got_Here (2);

          requeue Middle_PO.Stop_1;

       end First_Stop;

    end Start_Here;

    protected body Middle_PO is

       entry Stop_1 when True is

       begin

          Checkpoint.Got_Here (3);

          requeue Stop_2;

       end Stop_1;

       entry Stop_2 when True is

       begin

          Checkpoint.Got_Here (4);

          requeue Final_PO.Final_Stop;

       end Stop_2;

    end Middle_PO;

    protected body Final_PO is

       entry Final_Stop when True is

       begin

          Checkpoint.Got_Here (5);

       end Final_Stop;

    end Final_PO;

  begin   -- test encapsulation

    select

       Start_Here.AST_Waits_Here;

       Checkpoint.Got_Here (6);

    then abort

       Start_Here.Start_PO;

       delay 0.0;  -- abort completion point

       Checkpoint.Got_Here (7);

    end select;

    Check_The_Results: declare

       Chk : constant Points_Array := Checkpoint.Results;

       Expected : constant Points_Array :=  (1..6 => True,

                                             7    => False);

    begin

       for I in Checkpoint_ID loop

          if Chk (I) /= Expected (I) then

             Report.Failed ("checkpoint error" &

                            Checkpoint_ID'Image (I) &

                            " actual is " &

                            Boolean'Image (Chk(I)));

          end if;

       end loop;

    end Check_The_Results;

  exception

    when others =>

       Report.Failed ("unexpected exception");

  end;    -- test encapsulation

  Report.Result;

end C980002;