cb20004.a

来自「用于进行gcc测试」· A 代码 · 共 204 行

-- CB20004.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 propagate correctly from objects of 
--      protected types. Check propagation from protected entry bodies.
--
-- TEST DESCRIPTION:
--      Declare a package with a protected type, including entries and private
--      data, simulating a bounded buffer abstraction.  In the main procedure,
--      perform entry calls on an object of the protected type that raises
--      exceptions.
--      Ensure that the exceptions are: 
--         1) raised and handled locally in the entry body
--         2) raised in the entry body and handled/reraised to be handled 
--            by the caller.
--         3) raised in the entry body and propagated directly to the calling 
--            procedure. 
--
--       
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--
--!

package CB20004_0 is               -- Package Buffer.

   Max_Buffer_Size       : constant := 2;

   Handled_In_Body,
   Propagated_To_Caller,
   Handled_In_Caller     : Boolean := False;

   Data_Over_5,
   Data_Degradation      : exception;

   type Data_Item is range 0 .. 100;

   type Item_Array_Type is array (1 .. Max_Buffer_Size) of Data_Item;

   protected type Bounded_Buffer is
      entry Put (Item : in     Data_Item);
      entry Get (Item :    out Data_Item);
   private
      Item_Array : Item_Array_Type;
      I, J       : Integer range 1 .. Max_Buffer_Size := 1;
      Count      : Integer range 0 .. Max_Buffer_Size := 0;
   end Bounded_Buffer;

end CB20004_0;

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

with Report;

package body CB20004_0 is               -- Package Buffer.

   protected body Bounded_Buffer is

      entry Put (Item : in Data_Item) when Count < Max_Buffer_Size is
      begin
         if Item > 10 then
            Item_Array (I) := Item * 8;  -- Constraint_Error will be raised
         elsif Item > 5 then             -- and handled in entry body.
            raise Data_Over_5;           -- Exception  handled/reraised in
         else                            -- entry body, propagated to caller.
            Item_Array (I) := Item;      -- Store data item in buffer.
            I := (I mod Max_Buffer_Size) + 1;
            Count := Count + 1;
         end if;
      exception
         when Constraint_Error =>
            Handled_In_Body := True;
         when Data_Over_5 =>
            Propagated_To_Caller := True;
            raise;    -- Propagate the exception to the caller.
      end Put;


      entry Get (Item : out Data_Item) when Count > 0 is
      begin
         Item := Item_Array(J);
         J := (J mod Max_Buffer_Size) + 1;
         Count := Count - 1;
         if Count = 0 then
            raise Data_Degradation;   -- Exception to propagate to caller.
         end if;
      end Get;

   end Bounded_Buffer;

end CB20004_0;


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


with CB20004_0;                   -- Package Buffer.
with Report;

procedure CB20004 is

   package Buffer renames CB20004_0;

   Data        : Buffer.Data_Item := Buffer.Data_Item'First;
   Data_Buffer : Buffer.Bounded_Buffer;   -- an object of protected type.

   Handled_In_Caller : Boolean := False;  -- same name as boolean declared 
                                          -- in package Buffer.
begin

   Report.Test ("CB20004", "Check that exceptions propagate correctly " &
                           "from objects of protected types" );

   Initial_Data_Block:
   begin                                    -- Data causes Constraint_Error.
      Data_Buffer.Put (CB20004_0.Data_Item(Report.Ident_Int(51)));

   exception                                  
      when Constraint_Error => 
         Buffer.Handled_In_Body := False;     -- Improper exception handling
                                              -- in entry body.
         Report.Failed ("Exception propagated to caller " &
                        " from Initial_Data_Block");
      when others =>
         Report.Failed ("Exception raised in processing and " &
                        "propagated to caller from Initial_Data_Block");
   end Initial_Data_Block;


   Data_Entry_Block:
   begin
                                              -- Valid data. No exception.
      Data_Buffer.Put (CB20004_0.Data_Item(Report.Ident_Int(3)));  

                                              -- Data will cause exception.
      Data_Buffer.Put (7);                    -- Call protected object entry, 
                                              -- exception to be handled/
                                              -- reraised in entry body.
      Report.Failed ("Data_Over_5 Exception not raised in processing");
   exception
      when Buffer.Data_Over_5 =>
         if Buffer.Propagated_To_Caller then   -- Reraised in entry body?
            Buffer.Handled_In_Caller := True;
         else
            Report.Failed ("Exception not reraised in entry body");
         end if;
      when others =>
         Report.Failed ("Exception raised in processing and propagated " &
                        "to caller from Data_Entry_Block");
   end Data_Entry_Block;


   Data_Retrieval_Block:
   begin

      Data_Buffer.Get (Data);  -- Retrieval of buffer data, buffer now empty.
                               -- Exception will be raised in entry body, with
                               -- propagation to caller.
      Report.Failed ("Data_Degradation Exception not raised in processing");
   exception
      when Buffer.Data_Degradation =>
         Handled_In_Caller := True;   -- Local Boolean used here.
      when others =>
         Report.Failed ("Exception raised in processing and propagated " &
                        "to caller from Data_Retrieval_Block");
   end Data_Retrieval_Block;


   if not (Buffer.Handled_In_Body      and    -- Validate proper exception
           Buffer.Propagated_To_Caller and    -- handling in entry bodies.
           Buffer.Handled_In_Caller    and
           Handled_In_Caller)
   then
      Report.Failed ("Improper exception handling by entry bodies");
   end if;


   Report.Result;

end CB20004;