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

   1 -- C940004.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 -- TEST OBJECTIVE:
  27 --      Check that a protected record can be used to control access to
  28 --      resources (data internal to the protected record).
  29 --
  30 -- TEST DESCRIPTION:
  31 --      Declare a resource descriptor tagged type.  Extend the type and
  32 --      use the extended type in a protected data structure.
  33 --      Implement a binary semaphore type.  Declare an entry for
  34 --      requesting a specific resource and an procedure for releasing the
  35 --      same resource.  Declare an object of this (protected) type.
  36 --      Declare and start three tasks each of which asks for a resource
  37 --      when directed to.  Verify that resources are properly allocated
  38 --      and deallocated.
  39 --
  40 --
  41 -- CHANGE HISTORY:
  42 --
  43 --      12 DEC 93   SAIC    Initial PreRelease version
  44 --      23 JUL 95   SAIC    Second PreRelease version
  45 --      16 OCT 95   SAIC    ACVC 2.1
  46 --      13 MAR 03   RLB     Fixed race condition in test.
  47 --
  48 --!
  49
  50 package C940004_0 is
  51 -- Resource_Pkg
  52
  53    type ID_Type is new Integer range 0..10;
  54    type User_Descriptor_Type is tagged record
  55       Id : ID_Type := 0;
  56    end record;
  57
  58 end C940004_0; -- Resource_Pkg
  59
  60 --============================--
  61 -- no body for C940004_0
  62 --=============================--
  63
  64 with C940004_0; -- Resource_Pkg
  65
  66 -- This generic package implements a semaphore to control a single resource
  67
  68 generic
  69
  70   type Generic_Record_Type is new C940004_0.User_Descriptor_Type
  71                                                          with private;
  72
  73 package C940004_1 is
  74 -- Generic_Semaphore_Pkg
  75                 -- generic package extends the tagged formal generic
  76                 -- type with some implementation relevant details, and
  77                 -- it provides a semaphore with operations that work
  78                 -- on that type
  79    type User_Rec_Type is new Generic_Record_Type with private;
  80
  81    protected type Semaphore_Type is
  82       function  TC_Count return Integer;
  83       entry     Request (R : in out User_Rec_Type);
  84       procedure Release (R : in out User_Rec_Type);
  85    private
  86       In_Use : Boolean := false;
  87    end Semaphore_Type;
  88
  89    function Has_Access (R : User_Rec_Type) return Boolean;
  90
  91 private
  92
  93    type User_Rec_Type is new Generic_Record_Type with record
  94       Access_To_Resource : boolean := false;
  95    end record;
  96
  97 end C940004_1;        -- Generic_Semaphore_Pkg
  98
  99 --===================================================--
 100
 101 package body C940004_1 is
 102 -- Generic_Semaphore_Pkg
 103
 104    protected body Semaphore_Type is
 105
 106       function TC_Count return Integer is
 107       begin
 108          return Request'Count;
 109       end TC_Count;
 110
 111       entry Request (R : in out User_Rec_Type)
 112                                                when not In_Use is
 113       begin
 114          In_Use := true;
 115          R.Access_To_Resource := true;
 116       end Request;
 117
 118       procedure Release (R : in out User_Rec_Type) is
 119       begin
 120          In_Use := false;
 121          R.Access_To_Resource := false;
 122       end Release;
 123
 124    end Semaphore_Type;
 125
 126    function Has_Access (R : User_Rec_Type) return Boolean is
 127    begin
 128       return R.Access_To_Resource;
 129    end Has_Access;
 130
 131 end C940004_1;       -- Generic_Semaphore_Pkg
 132
 133 --=============================================--
 134
 135 with Report;
 136 with C940004_0; -- Resource_Pkg,
 137 with C940004_1; -- Generic_Semaphore_Pkg;
 138
 139 package C940004_2 is
 140 -- Printer_Mgr_Pkg
 141
 142    -- Instantiate the generic to get code to manage a single printer;
 143    -- User processes contend for the printer, asking for it by a call
 144    -- to Request, and relinquishing it by a call to Release
 145
 146    -- This package extends a tagged type to customize it for the printer
 147    -- in question, then it uses the type to instantiate the generic and
 148    -- declare a semaphore specific to the particular resource
 149
 150    package Resource_Pkg          renames C940004_0;
 151
 152    type User_Desc_Type is new Resource_Pkg.User_Descriptor_Type with record
 153        New_Details : Integer := 0;    -- for example
 154    end record;
 155
 156    package Instantiation is new C940004_1   -- Generic_Semaphore_Pkg
 157                                    (Generic_Record_Type => User_Desc_Type);
 158
 159    Printer_Access_Mgr : Instantiation.Semaphore_Type;
 160
 161
 162 end C940004_2; -- Printer_Mgr_Pkg
 163
 164 --============================--
 165 -- no body for C940004_2
 166 --============================--
 167
 168 with C940004_0; -- Resource_Pkg,
 169 with C940004_2; -- Printer_Mgr_Pkg;
 170
 171 package C940004_3 is
 172 -- User_Task_Pkg
 173
 174 -- This package models user tasks  that will request and release
 175 -- the printer
 176    package Resource_Pkg    renames C940004_0;
 177    package Printer_Mgr_Pkg renames C940004_2;
 178
 179    task type User_Task_Type (ID : Resource_Pkg.ID_Type) is
 180       entry Get_Printer;   -- instructs task to request resource
 181
 182       entry Release_Printer    -- instructs task to release printer
 183           (Descriptor : in out Printer_Mgr_pkg.Instantiation.User_Rec_Type);
 184
 185       --==================--
 186       -- Test management machinery
 187       --==================--
 188       entry TC_Get_Descriptor       -- returns descriptor
 189             (Descriptor :  out Printer_Mgr_Pkg.Instantiation.User_Rec_Type);
 190
 191    end User_Task_Type;
 192
 193    --==================--
 194    -- Test management machinery
 195    --==================--
 196    TC_Times_Obtained : Integer := 0;
 197    TC_Times_Released : Integer := 0;
 198
 199 end C940004_3; -- User_Task_Pkg;
 200
 201 --==============================================--
 202
 203 with Report;
 204 with C940004_0; -- Resource_Pkg,
 205 with C940004_2; -- Printer_Mgr_Pkg,
 206
 207 package body C940004_3 is
 208 -- User_Task_Pkg
 209
 210    task body User_Task_Type is
 211       D : Printer_Mgr_Pkg.Instantiation.User_Rec_Type;
 212    begin
 213       D.Id := ID;
 214             -----------------------------------
 215       Main:
 216       loop
 217          select
 218             accept Get_Printer;
 219             Printer_Mgr_Pkg.Printer_Access_Mgr.Request (D);
 220                       -- request resource; if resource is not available,
 221                       -- task will be queued to wait
 222             --===================--
 223             -- Test management machinery
 224             --===================--
 225             TC_Times_Obtained := TC_Times_Obtained + 1;
 226                       -- when request granted, note it and post a message
 227
 228          or
 229            accept Release_Printer  (Descriptor : in out
 230                              Printer_Mgr_Pkg.Instantiation.User_Rec_Type) do
 231
 232               Printer_Mgr_Pkg.Printer_Access_Mgr.Release (D);
 233                           -- release the resource, note its release
 234               TC_Times_Released := TC_Times_Released + 1;
 235               Descriptor := D;
 236            end Release_Printer;
 237            exit Main;
 238
 239          or
 240            accept TC_Get_Descriptor  (Descriptor : out
 241                             Printer_Mgr_Pkg.Instantiation.User_Rec_Type) do
 242
 243               Descriptor := D;
 244            end TC_Get_Descriptor;
 245
 246          end select;
 247       end loop main;
 248
 249    exception
 250       when others => Report.Failed ("exception raised in User_Task");
 251    end User_Task_Type;
 252
 253 end C940004_3;   -- User_Task_Pkg;
 254
 255 --==========================================================--
 256
 257 with Report;
 258 with ImpDef;
 259
 260 with C940004_0; -- Resource_Pkg,
 261 with C940004_2; -- Printer_Mgr_Pkg,
 262 with C940004_3; -- User_Task_Pkg;
 263
 264 procedure C940004 is
 265    Verbose : constant Boolean := False;
 266    package Resource_Pkg    renames C940004_0;
 267    package Printer_Mgr_Pkg renames C940004_2;
 268    package User_Task_Pkg   renames C940004_3;
 269
 270    Task1 : User_Task_Pkg.User_Task_Type (1);
 271    Task2 : User_Task_Pkg.User_Task_Type (2);
 272    Task3 : User_Task_Pkg.User_Task_Type (3);
 273
 274    User_Rec_1,
 275    User_Rec_2,
 276    User_Rec_3 : Printer_Mgr_Pkg.Instantiation.User_Rec_Type;
 277
 278 begin
 279
 280    Report.Test ("C940004", "Check that a protected record can be used to " &
 281                            "control access to resources");
 282
 283    if    (User_Task_Pkg.TC_Times_Obtained /= 0)
 284       or (User_Task_Pkg.TC_Times_Released /= 0)
 285       or  Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_1)
 286       or  Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_2)
 287       or  Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_3) then
 288          Report.Failed ("Wrong initial conditions");
 289    end if;
 290
 291    Task1.Get_Printer;           -- ask for resource
 292                                 -- request for resource should be granted
 293    Task1.TC_Get_Descriptor (User_Rec_1);-- wait here 'til task gets resource
 294
 295    if        (User_Task_Pkg.TC_Times_Obtained /= 1)
 296       or     (User_Task_Pkg.TC_Times_Released /= 0)
 297       or not Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_1) then
 298          Report.Failed ("Resource not assigned to task 1");
 299    end if;
 300
 301    Task2.Get_Printer;              -- ask for resource
 302                                    -- request for resource should be denied
 303                                    -- and task queued to wait
 304
 305    -- Task 1 still waiting to accept Release_Printer, still holds resource
 306    -- Task 2 queued on Semaphore.Request
 307
 308    -- Ensure that Task2 is queued before continuing to make checks and queue
 309    -- Task3. We use a for loop here to avoid hangs in broken implementations.
 310    for TC_Cnt in 1 .. 20 loop
 311       exit when Printer_Mgr_Pkg.Printer_Access_Mgr.TC_Count >= 1;
 312       delay Impdef.Minimum_Task_Switch;
 313    end loop;
 314
 315    if    (User_Task_Pkg.TC_Times_Obtained /= 1)
 316       or (User_Task_Pkg.TC_Times_Released /= 0) then
 317         Report.Failed ("Resource assigned to task 2");
 318    end if;
 319
 320    Task3.Get_Printer;        -- ask for resource
 321                              -- request for resource should be denied
 322                              -- and task 3 queued on Semaphore.Request
 323
 324    Task1.Release_Printer (User_Rec_1);-- task 1 releases resource
 325                                       -- released resource should be given to
 326                                       -- queued task 2.
 327
 328    Task2.TC_Get_Descriptor (User_Rec_2);-- wait here for task 2
 329
 330    -- Task 1 has released resource and completed
 331    -- Task 2 has seized the resource
 332    -- Task 3 is queued on Semaphore.Request
 333
 334    if        (User_Task_Pkg.TC_Times_Obtained /= 2)
 335       or     (User_Task_Pkg.TC_Times_Released /= 1)
 336       or     Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_1)
 337       or not Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_2) then
 338           Report.Failed ("Resource not properly released/assigned" &
 339                          " to task 2");
 340           if Verbose then
 341              Report.Comment ("TC_Times_Obtained: " &
 342                  Integer'Image (User_Task_Pkg.TC_Times_Obtained));
 343              Report.Comment ("TC_Times_Released: " &
 344                  Integer'Image (User_Task_Pkg.TC_Times_Released));
 345              Report.Comment ("User 1 Has_Access:" &
 346                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
 347                                Has_Access (User_Rec_1)));
 348              Report.Comment ("User 2 Has_Access:" &
 349                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
 350                                Has_Access (User_Rec_2)));
 351           end if;
 352    end if;
 353
 354    Task2.Release_Printer (User_Rec_2);-- task 2 releases resource
 355
 356    -- task 3 is released from queue, and is given resource
 357
 358    Task3.TC_Get_Descriptor (User_Rec_3);-- wait for task 3
 359
 360    if        (User_Task_Pkg.TC_Times_Obtained /= 3)
 361       or     (User_Task_Pkg.TC_Times_Released /= 2)
 362       or     Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_2)
 363       or not Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_3) then
 364         Report.Failed ("Resource not properly released/assigned " &
 365                        "to task 3");
 366           if Verbose then
 367              Report.Comment ("TC_Times_Obtained: " &
 368                 Integer'Image (User_Task_Pkg.TC_Times_Obtained));
 369              Report.Comment ("TC_Times_Released: " &
 370                 Integer'Image (User_Task_Pkg.TC_Times_Released));
 371              Report.Comment ("User 1 Has_Access:" &
 372                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
 373                                Has_Access (User_Rec_1)));
 374              Report.Comment ("User 2 Has_Access:" &
 375                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
 376                                Has_Access (User_Rec_2)));
 377              Report.Comment ("User 3 Has_Access:" &
 378                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
 379                                Has_Access (User_Rec_3)));
 380           end if;
 381    end if;
 382
 383    Task3.Release_Printer (User_Rec_3);-- task 3 releases resource
 384
 385    if    (User_Task_Pkg.TC_Times_Obtained /=3)
 386       or (User_Task_Pkg.TC_Times_Released /=3)
 387       or Printer_Mgr_Pkg.Instantiation.Has_Access (User_Rec_3) then
 388          Report.Failed ("Resource not properly released by task 3");
 389          if Verbose then
 390              Report.Comment ("TC_Times_Obtained: " &
 391                 Integer'Image (User_Task_Pkg.TC_Times_Obtained));
 392              Report.Comment ("TC_Times_Released: " &
 393                 Integer'Image (User_Task_Pkg.TC_Times_Released));
 394              Report.Comment ("User 1 Has_Access:" &
 395                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
 396                                Has_Access (User_Rec_1)));
 397              Report.Comment ("User 2 Has_Access:" &
 398                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
 399                                Has_Access (User_Rec_2)));
 400              Report.Comment ("User 3 Has_Access:" &
 401                 Boolean'Image (Printer_Mgr_Pkg.Instantiation.
 402                                Has_Access (User_Rec_3)));
 403          end if;
 404
 405    end if;
 406
 407    -- Ensure that all tasks have terminated before reporting the result
 408    while not (Task1'terminated
 409               and Task2'terminated
 410               and Task3'terminated) loop
 411       delay ImpDef.Minimum_Task_Switch;
 412    end loop;
 413
 414    Report.Result;
 415
 416 end C940004;