cb20006.a

来自「linux下编程用 编译软件」· A 代码 · 共 218 行

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