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

   1 -- C940A03.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 a protected object provides coordinated access to
  28 --      shared data.  Check that it can implement a semaphore-like construct
  29 --      controlling access to shared data through procedure parameters to
  30 --      allow a specific maximum number of tasks to run and exclude all
  31 --      others.
  32 --
  33 -- TEST DESCRIPTION:
  34 --      Declare a resource descriptor tagged type.  Extend the type and
  35 --      use the extended type in a protected data structure.
  36 --      Implement a counting semaphore type that can be initialized to a
  37 --      specific number of available resources.  Declare an entry for
  38 --      requesting a specific resource and an procedure for releasing the
  39 --      same resource it.  Declare an object of this (protected) type,
  40 --      initialized to two resources.  Declare and start three tasks each
  41 --      of which asks for a resource.  Verify that only two resources are
  42 --      granted and that the last task in is queued.
  43 --
  44 --      This test models a multi-user operating system that allows a limited
  45 --      number of logins.  Users requesting login are modeled by tasks.
  46 --
  47 --
  48 -- TEST FILES:
  49 --      This test depends on the following foundation code:
  50 --
  51 --         F940A00
  52 --
  53 --
  54 -- CHANGE HISTORY:
  55 --      06 Dec 94   SAIC    ACVC 2.0
  56 --      13 Nov 95   SAIC    Fixed bugs for ACVC 2.0.1
  57 --
  58 --!
  59
  60 package C940A03_0 is
  61       --Resource_Pkg
  62
  63   -- General type declarations that will be extended to model available
  64   -- logins
  65
  66   type Resource_ID_Type is range 0..10;
  67   type Resource_Type is tagged record
  68     Id : Resource_ID_Type := 0;
  69   end record;
  70
  71 end C940A03_0;
  72   --Resource_Pkg
  73
  74 --======================================--
  75 -- no body for C940A3_0
  76 --======================================--
  77
  78 with F940A00;     -- Interlock_Foundation
  79 with C940A03_0;   -- Resource_Pkg;
  80
  81 package C940A03_1 is
  82      -- Semaphores
  83
  84   -- Models a counting semaphore that will allow up to a specific
  85   -- number of logins
  86   -- Users (tasks) request a login slot by calling the Request_Login
  87   -- entry and logout by calling the Release_Login procedure
  88
  89   Max_Logins : constant Integer := 2;
  90
  91
  92   type Key_Type is range 0..100;
  93                                       -- When a user requests a login, an
  94                                       -- identifying key will be returned
  95   Init_Key : constant Key_Type := 0;
  96
  97   type Login_Record_Type is new C940A03_0.Resource_Type with record
  98     Key  : Key_Type := Init_Key;
  99   end record;
 100
 101
 102   protected type Login_Semaphore_Type (Resources_Available : Integer :=1) is
 103
 104     entry     Request_Login   (Resource_Key : in out Login_Record_Type);
 105     procedure Release_Login;
 106     function  Available return Integer;  -- how many logins are available?
 107   private
 108     Logins_Avail : Integer  := Resources_Available;
 109     Next_Key     : Key_Type := Init_Key;
 110
 111   end Login_Semaphore_Type;
 112
 113   Login_Semaphore      : Login_Semaphore_Type (Max_Logins);
 114
 115   --====== machinery for the test, not the model =====--
 116   TC_Control_Message : F940A00.Interlock_Type;
 117   function TC_Key_Val (Login_Rec : Login_Record_Type) return Integer;
 118
 119
 120 end C940A03_1;
 121  -- Semaphores;
 122
 123 --=========================================================--
 124
 125 package body C940A03_1 is
 126           -- Semaphores is
 127
 128   protected body Login_Semaphore_Type is
 129
 130     entry Request_Login (Resource_Key : in out Login_Record_Type)
 131                                              when Logins_Avail > 0 is
 132     begin
 133       Next_Key := Next_Key + 1;        -- login process returns a key
 134       Resource_Key.Key := Next_Key;     -- to the requesting user
 135       Logins_Avail := Logins_Avail - 1;
 136     end Request_Login;
 137
 138     procedure Release_Login is
 139     begin
 140       Logins_Avail := Logins_Avail + 1;
 141     end Release_Login;
 142
 143     function Available return Integer is
 144       begin
 145         return Logins_Avail;
 146       end Available;
 147
 148   end Login_Semaphore_Type;
 149
 150   function TC_Key_Val (Login_Rec : Login_Record_Type) return Integer is
 151     begin
 152       return Integer (Login_Rec.Key);
 153     end TC_Key_Val;
 154
 155 end C940A03_1;
 156  -- Semaphores;
 157
 158 --=========================================================--
 159
 160 with C940A03_0;    -- Resource_Pkg,
 161 with C940A03_1;    -- Semaphores;
 162
 163 package C940A03_2 is
 164      -- Task_Pkg
 165
 166   package Semaphores renames C940A03_1;
 167
 168   task type User_Task_Type is
 169
 170      entry Login  (user_id : C940A03_0.Resource_Id_Type);
 171                       -- instructs the task to ask for a login
 172      entry Logout;    -- instructs the task to release the login
 173      --=======================--
 174      -- this entry is used to get information to verify test operation
 175      entry Get_Status (User_Record : out Semaphores.Login_Record_Type);
 176
 177   end User_Task_Type;
 178
 179 end C940A03_2;
 180  -- Task_Pkg
 181
 182 --=========================================================--
 183
 184 with Report;
 185 with C940A03_0;   -- Resource_Pkg,
 186 with C940A03_1;   -- Semaphores,
 187 with F940A00;     -- Interlock_Foundation;
 188
 189 package body C940A03_2 is
 190           -- Task_Pkg
 191
 192   -- This task models a user requesting a login from the system
 193   -- For control of this test, we can ask the task to login, logout, or
 194   -- give us the current user record (containing login information)
 195
 196   task body User_Task_Type is
 197     Rec  : Semaphores.Login_Record_Type;
 198   begin
 199     loop
 200       select
 201         accept Login (user_id : C940A03_0.Resource_Id_Type) do
 202           Rec.Id := user_id;
 203         end Login;
 204
 205         Semaphores.Login_Semaphore.Request_Login (Rec);
 206                       -- request a resource; if resource is not available,
 207                       -- task will be queued to wait
 208
 209         --== following is test control machinery ==--
 210         F940A00.Counter.Increment;
 211         Semaphores.TC_Control_Message.Post;
 212                -- after resource is obtained, post message
 213
 214       or
 215         accept Logout do
 216           Semaphores.Login_Semaphore.Release_Login;
 217                       -- release the resource
 218           --== test control machinery ==--
 219           F940A00.Counter.Decrement;
 220         end Logout;
 221         exit;
 222
 223       or
 224         accept Get_Status (User_Record : out Semaphores.Login_Record_Type) do
 225           User_Record := Rec;
 226         end Get_Status;
 227
 228       end select;
 229     end loop;
 230
 231   exception
 232     when others => Report.Failed ("Exception raised in model user task");
 233   end User_Task_Type;
 234
 235 end C940A03_2;
 236  -- Task_Pkg
 237
 238 --=========================================================--
 239
 240 with Report;
 241 with ImpDef;
 242 with C940A03_1;   -- Semaphores,
 243 with C940A03_2;   -- Task_Pkg,
 244 with F940A00;     -- Interlock_Foundation;
 245
 246 procedure C940A03 is
 247
 248   package Semaphores renames C940A03_1;
 249   package Users      renames C940A03_2;
 250
 251   Task1, Task2, Task3 : Users.User_Task_Type;
 252   User_Rec            : Semaphores.Login_Record_Type;
 253
 254 begin      -- Tasks start here
 255
 256   Report.Test ("C940A03", "Check that a protected object can coordinate " &
 257                           "shared data access using procedure parameters");
 258
 259   if F940A00.Counter.Number /=0 then
 260     Report.Failed ("Wrong initial conditions");
 261   end if;
 262
 263   Task1.Login (1);               -- request resource; request should be granted
 264   Semaphores.TC_Control_Message.Consume;
 265                                  -- ensure that task obtains resource by
 266                                  -- waiting for task to post message
 267
 268                                  -- Task 1 waiting for call to Logout
 269                                  -- Others still available
 270   Task1.Get_Status (User_Rec);
 271   if (F940A00.Counter.Number /= 1)
 272   or (Semaphores.Login_Semaphore.Available /=1)
 273   or (Semaphores.TC_Key_Val (User_Rec) /= 1) then
 274     Report.Failed ("Resource not assigned to task 1");
 275   end if;
 276
 277   Task2.Login (2);               -- Request for resource should be granted
 278   Semaphores.TC_Control_Message.Consume;
 279                                  -- ensure that task obtains resource by
 280                                  -- waiting for task to post message
 281
 282   Task2.Get_Status (User_Rec);
 283   if (F940A00.Counter.Number /= 2)
 284   or (Semaphores.Login_Semaphore.Available /=0)
 285   or (Semaphores.TC_Key_Val (User_Rec) /= 2) then
 286     Report.Failed ("Resource not assigned to task 2");
 287   end if;
 288
 289
 290   Task3.Login (3);               -- request for resource should be denied
 291                                  -- and task queued
 292
 293
 294                                  -- Tasks 1 and 2 holds resources
 295                                  -- and are waiting for a call to Logout
 296                                  -- Task 3 is queued
 297
 298   if (F940A00.Counter.Number /= 2)
 299   or (Semaphores.Login_Semaphore.Available /=0) then
 300     Report.Failed ("Resource incorrectly assigned to task 3");
 301   end if;
 302
 303   Task1.Logout;                  -- released resource should be given to
 304                                  -- queued task
 305   Semaphores.TC_Control_Message.Consume;
 306                                  -- wait for confirming message from task
 307
 308                                  -- Task 1 holds no resources
 309                                  --   and is terminated (or will soon)
 310                                  -- Tasks 2 and 3 hold resources
 311                                  --   and are waiting for a call to Logout
 312
 313   Task3.Get_Status (User_Rec);
 314   if (F940A00.Counter.Number /= 2)
 315                       or (Semaphores.Login_Semaphore.Available /=0)
 316                       or (Semaphores.TC_Key_Val (User_Rec) /= 3) then
 317     Report.Failed ("Resource not properly released/assigned to task 3");
 318   end if;
 319
 320   Task2.Logout;                  -- no outstanding request for released
 321                                  -- resource
 322                                  -- Tasks 1 and 2 hold no resources
 323                                  -- Task 3 holds a resource
 324                                  --   and is waiting for a call to Logout
 325
 326   if (F940A00.Counter.Number /= 1)
 327                         or (Semaphores.Login_Semaphore.Available /=1) then
 328     Report.Failed ("Resource not properly released from task 2");
 329   end if;
 330
 331   Task3.Logout;
 332
 333                                  -- all resources have been returned
 334                                  -- all tasks have terminated or will soon
 335
 336   if (F940A00.Counter.Number /=0)
 337                           or (Semaphores.Login_Semaphore.Available /=2) then
 338     Report.Failed ("Resource not properly released from task 3");
 339   end if;
 340
 341   -- Ensure all tasks have terminated before calling Result
 342   while not (Task1'terminated and
 343              Task2'terminated and
 344              Task3'terminated)     loop
 345     delay ImpDef.Minimum_Task_Switch;
 346   end loop;
 347
 348   Report.Result;
 349
 350 end C940A03;