gcc/testsuite/ada/acats/tests/c9/c940002.a

   1 -- C940002.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 -- OBJECTIVE:
  28 --      Check that a protected object provides coordinated access to shared
  29 --      data.  Check that it can implement a semaphore-like construct using a
  30 --      parameterless procedure which allows a specific maximum number of tasks
  31 --      to run and excludes all others
  32 --
  33 -- TEST DESCRIPTION:
  34 --      Implement a counting semaphore type that can be initialized to a
  35 --      specific number of available resources.  Declare an entry for
  36 --      requesting a resource and a procedure for releasing it.  Declare an
  37 --      object of this type, initialized to two resources.  Declare and start
  38 --      three tasks each of which asks for a resource.  Verify that only two
  39 --      resources are granted and that the last task in is queued.
  40 --
  41 --
  42 -- CHANGE HISTORY:
  43 --      06 Dec 94   SAIC    ACVC 2.0
  44 --
  45 --!
  46
  47
  48 package C940002_0 is
  49      -- Semaphores
  50
  51   protected type Semaphore_Type (Resources_Available : Integer :=1) is
  52     entry Request;
  53     procedure Release;
  54     function Available return Integer;
  55   private
  56     Currently_Available : Integer := Resources_Available;
  57   end Semaphore_Type;
  58
  59   Max_Resources : constant Integer := 2;
  60   Resource      : Semaphore_Type (Max_Resources);
  61
  62 end C940002_0;
  63  -- Semaphores;
  64
  65
  66           --========================================================--
  67
  68
  69 package body C940002_0 is
  70           -- Semaphores
  71
  72   protected body Semaphore_Type is
  73
  74     entry Request when Currently_Available >0 is  -- when granted, secures
  75     begin                                         -- a resource
  76       Currently_Available := Currently_Available - 1;
  77     end Request;
  78
  79     procedure Release is                          -- when called, releases
  80     begin                                         -- a resource
  81       Currently_Available := Currently_Available + 1;
  82     end Release;
  83
  84     function Available return Integer is          -- returns number of
  85     begin                                         -- available resources
  86       return Currently_Available;
  87     end Available;
  88
  89   end Semaphore_Type;
  90
  91 end C940002_0;
  92  -- Semaphores;
  93
  94
  95           --========================================================--
  96
  97
  98 package C940002_1 is
  99      -- Task_Pkg
 100
 101   task type Requesting_Task is
 102      entry Done;                        -- call on Done instructs the task
 103   end Requesting_Task;                  -- to release resource
 104
 105   type Task_Ptr is access Requesting_Task;
 106
 107   protected Counter is
 108     procedure Increment;
 109     procedure Decrement;
 110     function Number return integer;
 111   private
 112     Count : Integer := 0;
 113   end Counter;
 114
 115   protected Hold_Lock is
 116     procedure Lock;
 117     procedure Unlock;
 118     function  Locked return Boolean;
 119   private
 120     Lock_State  : Boolean := true;        -- starts out locked
 121   end Hold_Lock;
 122
 123
 124 end C940002_1;
 125  -- Task_Pkg
 126
 127
 128           --========================================================--
 129
 130
 131 with Report;
 132 with C940002_0;
 133   -- Semaphores;
 134
 135 package body C940002_1 is
 136           -- Task_Pkg is
 137
 138   protected body Counter is
 139
 140     procedure Increment is
 141       begin
 142         Count := Count + 1;
 143       end Increment;
 144
 145     procedure Decrement is
 146       begin
 147         Count := Count - 1;
 148       end Decrement;
 149
 150     function Number return Integer is
 151       begin
 152         return Count;
 153       end Number;
 154
 155   end Counter;
 156
 157
 158   protected body Hold_Lock is
 159
 160     procedure Lock is
 161     begin
 162       Lock_State := true;
 163     end Lock;
 164
 165     procedure Unlock is
 166     begin
 167       Lock_State := false;
 168     end Unlock;
 169
 170     function  Locked return Boolean is
 171     begin
 172       return Lock_State;
 173     end Locked;
 174
 175   end Hold_Lock;
 176
 177
 178   task body Requesting_Task is
 179   begin
 180     C940002_0.Resource.Request;        -- request a resource
 181                                        -- if resource is not available,
 182                                        -- task will be queued to wait
 183     Counter.Increment;                 -- add to count of resources obtained
 184     Hold_Lock.Unlock;                  -- and unlock Lock - system is stable;
 185                                        -- status may now be queried
 186
 187     accept Done do                     -- hold resource until Done is called
 188       C940002_0.Resource.Release;      -- release the resource and
 189       Counter.Decrement;               -- note release
 190     end Done;
 191
 192   exception
 193     when others => Report.Failed ("Unexpected Exception in Requesting_Task");
 194   end Requesting_Task;
 195
 196 end C940002_1;
 197  -- Task_Pkg;
 198
 199
 200           --========================================================--
 201
 202
 203 with Report;
 204 with ImpDef;
 205 with C940002_0,
 206   -- Semaphores,
 207      C940002_1;
 208   -- Task_Pkg;
 209
 210 procedure C940002 is
 211
 212   package Semaphores renames C940002_0;
 213   package Task_Pkg renames C940002_1;
 214
 215   Ptr1,
 216   Ptr2,
 217   Ptr3 : Task_Pkg.Task_Ptr;
 218   Num  : Integer;
 219
 220   procedure Spinlock is
 221     begin
 222       -- loop until unlocked
 223       while Task_Pkg.Hold_Lock.Locked loop
 224         delay ImpDef.Minimum_Task_Switch;
 225       end loop;
 226       Task_Pkg.Hold_Lock.Lock;
 227     end Spinlock;
 228
 229 begin
 230
 231   Report.Test ("C940002", "Check that a protected record can be used to " &
 232                           "control access to resources");
 233
 234   if (Task_Pkg.Counter.Number /=0)
 235   or (Semaphores.Resource.Available /= 2) then
 236     Report.Failed ("Wrong initial conditions");
 237   end if;
 238
 239   Ptr1 := new Task_Pkg.Requesting_Task;   -- newly allocated task requests
 240                                    -- resource; request for resource should
 241                                    -- be granted
 242   Spinlock;                        -- ensure that task obtains resource
 243
 244                                    -- Task 1 waiting for call to Done
 245                                    -- One resource assigned to task 1
 246                                    -- One resource still available
 247   if (Task_Pkg.Counter.Number /= 1)
 248   or (Semaphores.Resource.Available /= 1) then
 249     Report.Failed ("Resource not assigned to task 1");
 250   end if;
 251
 252   Ptr2 := new Task_Pkg.Requesting_Task;   -- newly allocated task requests
 253                                    -- resource; request for resource should
 254                                    -- be granted
 255   Spinlock;                        -- ensure that task obtains resource
 256
 257                                    -- Task 1 waiting for call to Done
 258                                    -- Task 2 waiting for call to Done
 259                                    -- Resources held by tasks 1 and 2
 260                                    -- No resources available
 261   if (Task_Pkg.Counter.Number /= 2)
 262   or (Semaphores.Resource.Available /= 0) then
 263     Report.Failed ("Resource not assigned to task 2");
 264   end if;
 265
 266   Ptr3 := new Task_Pkg.Requesting_Task;   -- newly allocated task requests
 267                                    -- resource; request for resource should
 268                                    -- be denied and task queued to wait for
 269                                    -- next available resource
 270
 271
 272   Ptr1.all.Done;                   -- Task 1 releases resource and lock
 273                                    -- Resource should be given to queued task
 274   Spinlock;                        -- ensure that resource is released
 275
 276
 277                                    -- Task 1 holds no resource
 278                                    -- One resource still assigned to task 2
 279                                    -- One resource assigned to task 3
 280                                    -- No resources available
 281   if (Task_Pkg.Counter.Number /= 2)
 282   or (Semaphores.Resource.Available /= 0) then
 283     Report.Failed ("Resource not properly released/assigned to task 3");
 284   end if;
 285
 286   Ptr2.all.Done;                   -- Task 2 releases resource and lock
 287                                    -- No outstanding request for resource
 288
 289                                    -- Tasks 1 and 2 hold no resources
 290                                    -- One resource assigned to task 3
 291                                    -- One resource available
 292   if (Task_Pkg.Counter.Number /= 1)
 293   or (Semaphores.Resource.Available /= 1) then
 294     Report.Failed ("Resource not properly released from task 2");
 295   end if;
 296
 297   Ptr3.all.Done;                   -- Task 3 releases resource and lock
 298
 299                                    -- All resources released
 300                                    -- All tasks terminated (or close)
 301                                    -- Two resources available
 302   if (Task_Pkg.Counter.Number /=0)
 303   or (Semaphores.Resource.Available /= 2) then
 304     Report.Failed ("Resource not properly released from task 3");
 305   end if;
 306
 307   Report.Result;
 308
 309 end C940002;