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
49package 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
68private
69  type Token_Type is new boolean;
70  True_Token : constant Token_Type := true;
71end C940001_0;
72
73--=================================================================--
74
75package 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
103end C940001_0;
104
105--===============================================================--
106
107with Report;
108with ImpDef;
109with C940001_0;
110
111procedure 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
192begin
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
212end C940001;
213