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

   1 -- CB20005.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 are raised and properly handled locally in
  28 --      protected operations.
  29 --
  30 -- TEST DESCRIPTION:
  31 --      Declare a package with a protected type, including protected operation
  32 --      declarations and private data, simulating a counting semaphore.
  33 --      In the main procedure, perform calls on protected operations
  34 --      of the protected object designed to induce the raising of exceptions.
  35 --
  36 --      Ensure that the exceptions are raised and handled locally in a
  37 --      protected procedures and functions, and that in this case the
  38 --      exceptions will not propagate to the calling unit.  Use specific
  39 --      exception handlers in the protected functions.
  40 --
  41 --
  42 --
  43 -- CHANGE HISTORY:
  44 --      06 Dec 94   SAIC    ACVC 2.0
  45 --
  46 --!
  47
  48 package CB20005_0 is               -- Package Semaphore.
  49
  50    Handled_In_Function,
  51    Handled_In_Procedure : Boolean := False;
  52
  53    Resource_Overflow,
  54    Resource_Underflow   : exception;
  55
  56    protected type Counting_Semaphore (Max_Resources : Integer) is
  57       procedure Secure;
  58       function  Resource_Limit_Exceeded return Boolean;
  59       procedure Release;
  60    private
  61       Count : Integer := Max_Resources;
  62    end Counting_Semaphore;
  63
  64 end CB20005_0;
  65
  66      --=================================================================--
  67
  68 with Report;
  69
  70 package body CB20005_0 is               -- Package Semaphore.
  71
  72    protected body Counting_Semaphore is
  73
  74       procedure Secure is
  75       begin
  76          if (Count = 0) then               -- No resources left to secure.
  77             raise Resource_Underflow;
  78             Report.Failed
  79               ("Program control not transferred by raise in Secure");
  80          else
  81             Count := Count - 1;             -- Avail resources decremented.
  82          end if;
  83       exception
  84          when Resource_Underflow =>         -- Exception handled locally in
  85             Handled_In_Procedure := True;   -- this protected operation.
  86          when others =>
  87             Report.Failed ("Unexpected exception raised in Secure");
  88       end Secure;
  89
  90
  91       function Resource_Limit_Exceeded return Boolean is
  92       begin
  93          if (Count > Max_Resources) then
  94             raise Resource_Overflow;       -- Exception used as control flow
  95                                            -- mechanism.
  96             Report.Failed
  97               ("Program control not transferred by raise in " &
  98                "Resource_Limit_Exceeded");
  99          else
 100             return (False);
 101          end if;
 102       exception
 103          when Resource_Overflow =>         -- Handle its own raised
 104             Handled_In_Function := True;   -- exception.
 105             return (True);
 106          when others =>
 107             Report.Failed
 108               ("Unexpected exception raised in Resource_Limit_Exceeded");
 109       end Resource_Limit_Exceeded;
 110
 111
 112       procedure Release is
 113       begin
 114          Count := Count + 1;               -- Count of resources available
 115                                            -- incremented.
 116          if Resource_Limit_Exceeded then   -- Call to protected operation
 117             Count := Count - 1;            -- function that raises/handles
 118          end if;                           -- an exception.
 119       exception
 120          when Resource_Overflow =>
 121             Handled_In_Function := False;
 122             Report.Failed ("Exception propagated to Function Release");
 123          when others =>
 124             Report.Failed ("Unexpected exception raised in Function Release");
 125       end Release;
 126
 127
 128    end Counting_Semaphore;
 129
 130 end CB20005_0;
 131
 132
 133      --=================================================================--
 134
 135
 136 with CB20005_0;                           -- Package Semaphore.
 137 with Report;
 138
 139 procedure CB20005 is
 140 begin
 141
 142    Report.Test ("CB20005", "Check that exceptions are raised and handled " &
 143                            "correctly in protected operations" );
 144
 145    Test_Block:
 146    declare
 147
 148       package Semaphore renames CB20005_0;
 149
 150       Total_Resources_Available : constant := 1;
 151
 152       Resources : Semaphore.Counting_Semaphore(Total_Resources_Available);
 153                                           -- An object of protected type.
 154
 155    begin
 156
 157       Allocate_Resources:
 158       declare
 159          Loop_Count : Integer := Total_Resources_Available + 1;
 160       begin
 161          for I in 1..Loop_Count loop -- Force exception.
 162             Resources.Secure;
 163          end loop;
 164       exception
 165          when Semaphore.Resource_Underflow =>
 166             Semaphore.Handled_In_Procedure := False; -- Excptn not handled
 167             Report.Failed                            -- in prot. operation.
 168               ("Resource_Underflow exception not handled " &
 169                "in Allocate_Resources");
 170          when others =>
 171             Report.Failed
 172               ("Exception unexpectedly raised during resource allocation");
 173       end Allocate_Resources;
 174
 175
 176       Deallocate_Resources:
 177       declare
 178          Loop_Count : Integer := Total_Resources_Available + 1;
 179       begin
 180          for I in 1..Loop_Count loop -- Force excptn.
 181             Resources.Release;
 182          end loop;
 183       exception
 184          when Semaphore.Resource_Overflow =>
 185             Semaphore.Handled_In_Function := False; -- Exception not handled
 186                Report.Failed                        -- in prot. operation.
 187                  ("Resource overflow not handled by function");
 188             when others =>
 189                Report.Failed
 190                  ("Exception raised during resource deallocation");
 191       end Deallocate_Resources;
 192
 193
 194       if not (Semaphore.Handled_In_Procedure and -- Incorrect excpt. handling
 195               Semaphore.Handled_In_Function)     -- in protected operations.
 196       then
 197          Report.Failed
 198            ("Improper exception handling by protected operations");
 199       end if;
 200
 201
 202    exception
 203       when others =>
 204          Report.Failed ("Exception raised and propagated in test");
 205
 206    end Test_Block;
 207
 208    Report.Result;
 209
 210 end CB20005;