old-autovect-branch/gcc/testsuite/ada/acats/tests/c9/c940001.a

   1 -- C940001.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
  29 --      shared data.  Check that it can be used to sequence a number of tasks.
  30 --      Use the protected object to control a single token for which three
  31 --      tasks compete.  Check that only one task is running at a time and that
  32 --      all tasks get a chance to run sometime.
  33 --
  34 -- TEST DESCRIPTION:
  35 --      Declare a protected type with two entries.  A task may call the Take
  36 --      entry to get a token which allows it to continue processing.  If it
  37 --      has the token, it may call the Give entry to return it.  The tasks
  38 --      implement a discipline whereby only the task with the token may be
  39 --      active.  The test does not require any specific order for the tasks
  40 --      to run.
  41 --
  42 --
  43 -- CHANGE HISTORY:
  44 --      06 Dec 94   SAIC    ACVC 2.0
  45 --      07 Jul 96   SAIC    Fixed spelling nits.
  46 --
  47 --!
  48
  49 package C940001_0 is
  50
  51   type Token_Type is private;
  52   True_Token : constant Token_Type;   -- Create a deferred constant in order
  53                                       -- to provide a component init for the
  54                                       -- protected object
  55
  56   protected type Token_Mgr_Prot_Unit is
  57     entry Take (T : out Token_Type);
  58     entry Give (T : in out  Token_Type);
  59   private
  60     Token : Token_Type := True_Token;
  61   end Token_Mgr_Prot_Unit;
  62
  63   function Init_Token return Token_Type;   -- call to initialize an
  64                                            -- object of Token_Type
  65   function Token_Value (T : Token_Type) return Boolean;
  66                                            -- call to inspect the value of an
  67                                            -- object of Token_Type
  68 private
  69   type Token_Type is new boolean;
  70   True_Token : constant Token_Type := true;
  71 end C940001_0;
  72
  73 --=================================================================--
  74
  75 package body C940001_0 is
  76   protected body  Token_Mgr_Prot_Unit is
  77     entry Take (T : out Token_Type) when Token = true is
  78       begin                   -- Calling task will Take the token, so
  79         T := Token;           -- check first that token_mgr owns the
  80         Token := false;       -- token to give, then give it to caller
  81       end Take;
  82
  83     entry Give (T : in out Token_Type)  when Token = false is
  84       begin                   -- Calling task will Give the token back,
  85         if T = true then      -- so first check that token_mgr does not
  86           Token := T;         -- own the token, then check that the task has
  87           T := false;         -- the token to give, then take it from the
  88         end if;               -- task
  89                               -- if caller does not own the token, then
  90       end Give;               -- it falls out of the entry body with no
  91   end Token_Mgr_Prot_Unit;    -- action
  92
  93   function Init_Token return Token_Type is
  94     begin
  95       return false;
  96     end Init_Token;
  97
  98   function Token_Value (T : Token_Type) return Boolean is
  99     begin
 100       return Boolean (T);
 101     end Token_Value;
 102
 103 end C940001_0;
 104
 105 --===============================================================--
 106
 107 with Report;
 108 with ImpDef;
 109 with C940001_0;
 110
 111 procedure C940001 is
 112
 113   type TC_Int_Type is range 0..2;
 114               -- range is very narrow so that erroneous execution may
 115               -- raise Constraint_Error
 116
 117   type TC_Artifact_Type is record
 118      TC_Int : TC_Int_Type := 1;
 119      Number_of_Accesses : integer := 0;
 120   end record;
 121
 122   TC_Artifact : TC_Artifact_Type;
 123
 124   Sequence_Mgr : C940001_0.Token_Mgr_Prot_Unit;
 125
 126   procedure Bump (Item : in out TC_Int_Type) is
 127     begin
 128       Item := Item + 1;
 129     exception
 130       when Constraint_Error =>
 131         Report.Failed ("Incremented without corresponding decrement");
 132       when others =>
 133         Report.Failed ("Bump raised Unexpected Exception");
 134    end Bump;
 135
 136   procedure Decrement (Item : in out TC_Int_Type) is
 137     begin
 138       Item := Item - 1;
 139     exception
 140       when Constraint_Error =>
 141         Report.Failed ("Decremented without corresponding increment");
 142       when others =>
 143         Report.Failed ("Decrement raised Unexpected Exception");
 144     end Decrement;
 145
 146     --==============--
 147
 148   task type Network_Node_Type;
 149
 150   task body Network_Node_Type is
 151
 152     Slot_for_Token : C940001_0.Token_Type := C940001_0.Init_Token;
 153
 154     begin
 155
 156       -- Ask for token - if request is not granted, task will be queued
 157       Sequence_Mgr.Take (Slot_for_Token);
 158
 159       -- Task now has token and may perform its work
 160
 161       --==========================--
 162       -- in this case, the work is to ensure that the test results
 163       -- are the expected ones!
 164       --==========================--
 165       Bump (TC_Artifact.TC_Int);   -- increment when request is granted
 166       TC_Artifact.Number_Of_Accesses :=
 167         TC_Artifact.Number_Of_Accesses + 1;
 168       if not C940001_0.Token_Value ( Slot_for_Token) then
 169         Report.Failed ("Incorrect results from entry Take");
 170       end if;
 171
 172       -- give a chance for other tasks to (incorrectly) run
 173       delay ImpDef.Minimum_Task_Switch;
 174
 175       Decrement (TC_Artifact.TC_Int); -- prepare to return token
 176
 177       -- Task has completed its work and will return token
 178
 179       Sequence_Mgr.Give (Slot_for_Token);   -- return token to sequence manager
 180
 181       if c940001_0.Token_Value (Slot_for_Token) then
 182         Report.Failed ("Incorrect results from entry Give");
 183       end if;
 184
 185     exception
 186       when others => Report.Failed ("Unexpected exception raised in task");
 187
 188     end Network_Node_Type;
 189
 190     --==============--
 191
 192 begin
 193
 194   Report.Test ("C940001", "Check that a protected object can control " &
 195                           "tasks by coordinating access to shared data");
 196
 197   declare
 198      Node_1, Node_2, Node_3 : Network_Node_Type;
 199                            -- declare three tasks which will compete for
 200                            -- a single token, managed by Sequence Manager
 201
 202   begin                    -- tasks start
 203     null;
 204   end; -- wait for all tasks to terminate before reporting result
 205
 206   if TC_Artifact.Number_of_Accesses /= 3 then
 207     Report.Failed ("Not all tasks got through");
 208   end if;
 209
 210   Report.Result;
 211
 212 end C940001;