Subversion Repositories openrisc

-- C953001.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 if the evaluation of an entry_barrier condition

--      propagates an exception, the exception Program_Error

--      is propagated to all current callers of all entries of the

--      protected object.

--

-- TEST DESCRIPTION:

--      This test declares a protected object (PO) with two entries and

--      a 5 element entry family.

--      All the entries are always closed.  However, one of the entries

--      (Oh_No) will get a constraint_error in its barrier_evaluation

--      whenever the global variable Blow_Up is true.

--      An array of tasks is created where the tasks wait on the various

--      entries of the protected object.  Once all the tasks are waiting

--      the main procedure calls the entry Oh_No and causes an exception

--      to be propagated to all the tasks.  The tasks record the fact

--      that they got the correct exception in global variables that

--      can be checked after the tasks complete.

--

--

-- CHANGE HISTORY:

--      19 OCT 95   SAIC    ACVC 2.1

--

--!

with Report;

with ImpDef;

procedure C953001 is

    Verbose : constant Boolean := False;

    Max_Tasks : constant := 12;

      -- note status and error conditions

    Blocked_Entry_Taken : Boolean := False;

    In_Oh_No            : Boolean := False;

    Task_Passed : array (1..Max_Tasks) of Boolean := (1..Max_Tasks => False);

begin

  Report.Test ("C953001",

               "Check that an exception in an entry_barrier condition" &

               " causes Program_Error to be propagated to all current" &

               " callers of all entries of the protected object");

  declare -- test encapsulation

    -- miscellaneous values

    Cows : Integer := Report.Ident_Int (1);

    Came_Home : Integer := Report.Ident_Int (2);

    -- make the Barrier_Condition fail only when we want it to

    Blow_Up : Boolean := False;

    function Barrier_Condition return Boolean is

    begin

      if Blow_Up then

         return 5 mod Report.Ident_Int(0) = 1;

      else

         return False;

      end if;

    end Barrier_Condition;

    subtype Family_Index is Integer range 1..5;

    protected PO is

      entry Block1;

      entry Oh_No;

      entry Family (Family_Index);

    end PO;

    protected body PO is

      entry Block1 when Report.Ident_Int(0) = Report.Ident_Int(1) is

      begin

        Blocked_Entry_Taken := True;

      end Block1;

      -- barrier will get a Constraint_Error (divide by 0)

      entry Oh_No when Barrier_Condition is

      begin

        In_Oh_No := True;

      end Oh_No;

      entry Family (for Member in Family_Index) when Cows = Came_Home is

      begin

        Blocked_Entry_Taken := True;

      end Family;

    end PO;

    task type Waiter is

      entry Take_Id (Id : Integer);

    end Waiter;

    Bunch_of_Waiters : array (1..Max_Tasks) of Waiter;

    task body Waiter is

      Me : Integer;

      Action : Integer;

    begin

      accept Take_Id (Id : Integer) do

         Me := Id;

      end Take_Id;

      Action := Me mod (Family_Index'Last + 1);

      begin

        if Action = 0 then

          PO.Block1;

        else

          PO.Family (Action);

        end if;

        Report.Failed ("no exception for task" & Integer'Image (Me));

      exception

         when Program_Error =>

           Task_Passed (Me) := True;

           if Verbose then

             Report.Comment ("pass for task" & Integer'Image (Me));

           end if;

         when others =>

           Report.Failed ("wrong exception raised in task" &

                          Integer'Image (Me));

      end;

    end Waiter;

  begin   -- test encapsulation

    for I in 1..Max_Tasks loop

      Bunch_Of_Waiters(I).Take_Id (I);

    end loop;

    -- give all the Waiters time to get queued

    delay 2*ImpDef.Clear_Ready_Queue;

    -- cause the protected object to fail

    begin

      Blow_Up := True;

      PO.Oh_No;

      Report.Failed ("no exception in call to PO.Oh_No");

    exception

      when Constraint_Error =>

         Report.Failed ("Constraint_Error instead of Program_Error");

      when Program_Error =>

         if Verbose then

           Report.Comment ("main exception passed");

         end if;

      when others =>

         Report.Failed ("wrong exception in main");

    end;

  end;    -- test encapsulation

  -- all the tasks have now completed.

  -- check the flags for pass/fail info

  if Blocked_Entry_Taken then

     Report.Failed ("blocked entry taken");

  end if;

  if In_Oh_No then

     Report.Failed ("entry taken with exception in barrier");

  end if;

  for I in 1..Max_Tasks loop

    if not Task_Passed (I) then

      Report.Failed ("task" & Integer'Image (I) & " did not pass");

    end if;

  end loop;

  Report.Result;

end C953001;