Subversion Repositories openrisc

-- CB20006.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 exceptions are raised and properly handled (including

--      propagation by reraise) in protected operations.

--

-- TEST DESCRIPTION:

--      Declare a package with a protected type, including protected operation

--      declarations and private data, simulating a counting semaphore.

--      In the main procedure, perform calls on protected operations

--      of the protected object designed to induce the raising of exceptions.

--

--      The exceptions raised are to be initially handled in the protected

--      operations, but this handling involves the reraise of the exception

--      and the propagation of the exception to the caller.

--

--      Ensure that the exceptions are raised, handled / reraised successfully

--      in protected procedures and functions.  Use "others" handlers in the

--      protected operations.

--

--

-- CHANGE HISTORY:

--      06 Dec 94   SAIC    ACVC 2.0

--

--!

package CB20006_0 is               -- Package Semaphore.

   Reraised_In_Function,

   Reraised_In_Procedure,

   Handled_In_Function_Caller,

   Handled_In_Procedure_Caller   : Boolean := False;

   Resource_Overflow,

   Resource_Underflow            : exception;

   protected type Counting_Semaphore (Max_Resources : Integer) is

      procedure Secure;

      function  Resource_Limit_Exceeded return Boolean;

      procedure Release;

   private

      Count : Integer := Max_Resources;

   end Counting_Semaphore;

end CB20006_0;

     --=================================================================--

with Report;

package body CB20006_0 is                 -- Package Semaphore.

   protected body Counting_Semaphore is

      procedure Secure is

      begin

         if (Count = 0) then              -- No resources left to secure.

            raise Resource_Underflow;

            Report.Failed

              ("Program control not transferred by raise in Procedure Secure");

         else

            Count := Count - 1;           -- Available resources decremented.

         end if;

      exception

         when Resource_Underflow =>

            Reraised_In_Procedure := True;

            raise;                        -- Exception propagated to caller.

            Report.Failed ("Exception not propagated to caller from Secure");

         when others =>

            Report.Failed ("Unexpected exception raised in Secure");

      end Secure;

      function Resource_Limit_Exceeded return Boolean is

      begin

         if (Count > Max_Resources) then

            raise Resource_Overflow;      -- Exception used as control flow

                                          -- mechanism.

            Report.Failed

              ("Specific raise did not alter program control" &

               " from Resource_Limit_Exceeded");

         else

            return (False);

         end if;

      exception

         when others =>

            Reraised_In_Function := True;

            raise;                         -- Exception propagated to caller.

            Report.Failed ("Exception not propagated to caller" &

                           " from Resource_Limit_Exceeded");

      end Resource_Limit_Exceeded;

      procedure Release is

      begin

         Count := Count + 1;               -- Count of resources available

                                           -- incremented.

         if Resource_Limit_Exceeded then   -- Call to protected operation

            Count := Count - 1;            -- function that raises/reraises

                                           -- an exception.

            Report.Failed("Resource limit exceeded");

         end if;

      exception

         when others =>

            raise;                         -- Reraised and propagated again.

             Report.Failed ("Exception not reraised by procedure Release");

      end Release;

   end Counting_Semaphore;

end CB20006_0;

     --=================================================================--

with CB20006_0;                           -- Package Semaphore.

with Report;

procedure CB20006 is

begin

   Report.Test ("CB20006", "Check that exceptions are raised and " &

                           "handled / reraised and propagated "    &

                           "correctly by protected operations" );

   Test_Block:

   declare

      package Semaphore renames CB20006_0;

      Total_Resources_Available : constant := 1;

      Resources : Semaphore.Counting_Semaphore (Total_Resources_Available);

                                             -- An object of protected type.

   begin

      Allocate_Resources:

      declare

         Loop_Count : Integer := Total_Resources_Available + 1;

      begin

         for I in 1..Loop_Count loop -- Force exception

            Resources.Secure;

         end loop;

         Report.Failed

           ("Exception not propagated from protected operation Secure");

      exception

         when Semaphore.Resource_Underflow =>        -- Exception propagated

           Semaphore.Handled_In_Procedure_Caller := True;  -- from protected

         when others =>                                    -- procedure.

           Semaphore.Handled_In_Procedure_Caller := False;

      end Allocate_Resources;

      Deallocate_Resources:

      declare

         Loop_Count : Integer := Total_Resources_Available + 1;

      begin

         for I in 1..Loop_Count loop -- Force exception

            Resources.Release;

         end loop;

         Report.Failed

           ("Exception not propagated from protected operation Release");

      exception

         when Semaphore.Resource_Overflow =>        -- Exception propagated

            Semaphore.Handled_In_Function_Caller := True; -- from protected

         when others =>                                   -- function.

            Semaphore.Handled_In_Function_Caller := False;

      end Deallocate_Resources;

      if not (Semaphore.Reraised_In_Procedure and

              Semaphore.Reraised_In_Function  and

              Semaphore.Handled_In_Procedure_Caller and

              Semaphore.Handled_In_Function_Caller)

      then                                       -- Incorrect excpt. handling

         Report.Failed                           -- in protected operations.

           ("Improper exception handling/reraising by protected operations");

      end if;

   exception

      when others =>

         Report.Failed ("Unexpected exception " &

                        " raised and propagated in test");

   end Test_Block;

   Report.Result;

end CB20006;