old-autovect-branch/gcc/testsuite/ada/acats/support/f940a00.a

   1 -- F940A00.A
   2 --
   3 --
   4 --                             Grant of Unlimited Rights
   5 --
   6 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   7 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   8 --     unlimited rights in the software and documentation contained herein.
   9 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
  10 --     this public release, the Government intends to confer upon all
  11 --     recipients unlimited rights  equal to those held by the Government.
  12 --     These rights include rights to use, duplicate, release or disclose the
  13 --     released technical data and computer software in whole or in part, in
  14 --     any manner and for any purpose whatsoever, and to have or permit others
  15 --     to do so.
  16 --
  17 --                                    DISCLAIMER
  18 --
  19 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  20 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  21 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  22 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  23 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  24 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  25 --*
  26 --
  27 -- FOUNDATION DESCRIPTION:
  28 --      This foundation contains test control code for tests covering
  29 --      the protected record.
  30 --
  31 -- CHANGE HISTORY:
  32 --      06 Dec 94   SAIC    ACVC 2.0
  33 --
  34 --!
  35
  36 package F940A00 is
  37      -- Interlock_Foundation
  38
  39   protected type Interlock_Type is
  40     entry Post;
  41     entry Consume;
  42   private
  43     Int_Count : Integer := 0;
  44   end Interlock_Type;
  45
  46   protected Counter is                 -- used to count the number of
  47     procedure Increment;               -- resources that have been granted
  48     procedure Decrement;               -- to tasks
  49     function Number return integer;
  50   private
  51     Count : Integer := 0;
  52   end Counter;
  53
  54 end F940A00;
  55  -- Interlock_Foundation
  56
  57 --===================================--
  58
  59 package body F940A00 is
  60           -- Interlock_Foundation
  61
  62   protected body Interlock_Type is
  63
  64     entry Post when true is
  65     begin
  66       Int_Count := Int_Count + 1;
  67     end Post;
  68
  69     entry Consume when Int_Count > 0 is
  70     begin
  71       Int_Count := Int_Count - 1;
  72     end Consume;
  73
  74   end Interlock_Type;
  75
  76
  77   protected body Counter is
  78
  79     procedure Increment is
  80       begin
  81         Count := Count + 1;
  82       end Increment;
  83
  84     procedure Decrement is
  85       begin
  86         Count := Count - 1;
  87       end Decrement;
  88
  89     function Number return Integer is
  90       begin
  91         return Count;
  92       end Number;
  93
  94   end Counter;
  95
  96 end F940A00;
  97  -- Interlock_Foundation