gomp-20050608-branch/gcc/testsuite/ada/acats/tests/cb/cb20004.a

   1 -- CB20004.A
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 --
  26 -- OBJECTIVE:
  27 --      Check that exceptions propagate correctly from objects of
  28 --      protected types. Check propagation from protected entry bodies.
  29 --
  30 -- TEST DESCRIPTION:
  31 --      Declare a package with a protected type, including entries and private
  32 --      data, simulating a bounded buffer abstraction.  In the main procedure,
  33 --      perform entry calls on an object of the protected type that raises
  34 --      exceptions.
  35 --      Ensure that the exceptions are:
  36 --         1) raised and handled locally in the entry body
  37 --         2) raised in the entry body and handled/reraised to be handled
  38 --            by the caller.
  39 --         3) raised in the entry body and propagated directly to the calling
  40 --            procedure.
  41 --
  42 --
  43 -- CHANGE HISTORY:
  44 --      06 Dec 94   SAIC    ACVC 2.0
  45 --
  46 --!
  47
  48 package CB20004_0 is               -- Package Buffer.
  49
  50    Max_Buffer_Size       : constant := 2;
  51
  52    Handled_In_Body,
  53    Propagated_To_Caller,
  54    Handled_In_Caller     : Boolean := False;
  55
  56    Data_Over_5,
  57    Data_Degradation      : exception;
  58
  59    type Data_Item is range 0 .. 100;
  60
  61    type Item_Array_Type is array (1 .. Max_Buffer_Size) of Data_Item;
  62
  63    protected type Bounded_Buffer is
  64       entry Put (Item : in     Data_Item);
  65       entry Get (Item :    out Data_Item);
  66    private
  67       Item_Array : Item_Array_Type;
  68       I, J       : Integer range 1 .. Max_Buffer_Size := 1;
  69       Count      : Integer range 0 .. Max_Buffer_Size := 0;
  70    end Bounded_Buffer;
  71
  72 end CB20004_0;
  73
  74      --=================================================================--
  75
  76 with Report;
  77
  78 package body CB20004_0 is               -- Package Buffer.
  79
  80    protected body Bounded_Buffer is
  81
  82       entry Put (Item : in Data_Item) when Count < Max_Buffer_Size is
  83       begin
  84          if Item > 10 then
  85             Item_Array (I) := Item * 8;  -- Constraint_Error will be raised
  86          elsif Item > 5 then             -- and handled in entry body.
  87             raise Data_Over_5;           -- Exception  handled/reraised in
  88          else                            -- entry body, propagated to caller.
  89             Item_Array (I) := Item;      -- Store data item in buffer.
  90             I := (I mod Max_Buffer_Size) + 1;
  91             Count := Count + 1;
  92          end if;
  93       exception
  94          when Constraint_Error =>
  95             Handled_In_Body := True;
  96          when Data_Over_5 =>
  97             Propagated_To_Caller := True;
  98             raise;    -- Propagate the exception to the caller.
  99       end Put;
 100
 101
 102       entry Get (Item : out Data_Item) when Count > 0 is
 103       begin
 104          Item := Item_Array(J);
 105          J := (J mod Max_Buffer_Size) + 1;
 106          Count := Count - 1;
 107          if Count = 0 then
 108             raise Data_Degradation;   -- Exception to propagate to caller.
 109          end if;
 110       end Get;
 111
 112    end Bounded_Buffer;
 113
 114 end CB20004_0;
 115
 116
 117      --=================================================================--
 118
 119
 120 with CB20004_0;                   -- Package Buffer.
 121 with Report;
 122
 123 procedure CB20004 is
 124
 125    package Buffer renames CB20004_0;
 126
 127    Data        : Buffer.Data_Item := Buffer.Data_Item'First;
 128    Data_Buffer : Buffer.Bounded_Buffer;   -- an object of protected type.
 129
 130    Handled_In_Caller : Boolean := False;  -- same name as boolean declared
 131                                           -- in package Buffer.
 132 begin
 133
 134    Report.Test ("CB20004", "Check that exceptions propagate correctly " &
 135                            "from objects of protected types" );
 136
 137    Initial_Data_Block:
 138    begin                                    -- Data causes Constraint_Error.
 139       Data_Buffer.Put (CB20004_0.Data_Item(Report.Ident_Int(51)));
 140
 141    exception
 142       when Constraint_Error =>
 143          Buffer.Handled_In_Body := False;     -- Improper exception handling
 144                                               -- in entry body.
 145          Report.Failed ("Exception propagated to caller " &
 146                         " from Initial_Data_Block");
 147       when others =>
 148          Report.Failed ("Exception raised in processing and " &
 149                         "propagated to caller from Initial_Data_Block");
 150    end Initial_Data_Block;
 151
 152
 153    Data_Entry_Block:
 154    begin
 155                                               -- Valid data. No exception.
 156       Data_Buffer.Put (CB20004_0.Data_Item(Report.Ident_Int(3)));
 157
 158                                               -- Data will cause exception.
 159       Data_Buffer.Put (7);                    -- Call protected object entry,
 160                                               -- exception to be handled/
 161                                               -- reraised in entry body.
 162       Report.Failed ("Data_Over_5 Exception not raised in processing");
 163    exception
 164       when Buffer.Data_Over_5 =>
 165          if Buffer.Propagated_To_Caller then   -- Reraised in entry body?
 166             Buffer.Handled_In_Caller := True;
 167          else
 168             Report.Failed ("Exception not reraised in entry body");
 169          end if;
 170       when others =>
 171          Report.Failed ("Exception raised in processing and propagated " &
 172                         "to caller from Data_Entry_Block");
 173    end Data_Entry_Block;
 174
 175
 176    Data_Retrieval_Block:
 177    begin
 178
 179       Data_Buffer.Get (Data);  -- Retrieval of buffer data, buffer now empty.
 180                                -- Exception will be raised in entry body, with
 181                                -- propagation to caller.
 182       Report.Failed ("Data_Degradation Exception not raised in processing");
 183    exception
 184       when Buffer.Data_Degradation =>
 185          Handled_In_Caller := True;   -- Local Boolean used here.
 186       when others =>
 187          Report.Failed ("Exception raised in processing and propagated " &
 188                         "to caller from Data_Retrieval_Block");
 189    end Data_Retrieval_Block;
 190
 191
 192    if not (Buffer.Handled_In_Body      and    -- Validate proper exception
 193            Buffer.Propagated_To_Caller and    -- handling in entry bodies.
 194            Buffer.Handled_In_Caller    and
 195            Handled_In_Caller)
 196    then
 197       Report.Failed ("Improper exception handling by entry bodies");
 198    end if;
 199
 200
 201    Report.Result;
 202
 203 end CB20004;