aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/c9/c940001.a
blob: 2bc1a9ffd03887d063173f28812c5734e3445ef2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
-- C940001.A
--
--
--                             Grant of Unlimited Rights
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
--     unlimited rights in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
--     this public release, the Government intends to confer upon all 
--     recipients unlimited rights  equal to those held by the Government.  
--     These rights include rights to use, duplicate, release or disclose the 
--     released technical data and computer software in whole or in part, in 
--     any manner and for any purpose whatsoever, and to have or permit others 
--     to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
--      Check that a protected object provides coordinated access to
--      shared data.  Check that it can be used to sequence a number of tasks.
--      Use the protected object to control a single token for which three 
--      tasks compete.  Check that only one task is running at a time and that
--      all tasks get a chance to run sometime.
--
-- TEST DESCRIPTION:
--      Declare a protected type with two entries.  A task may call the Take
--      entry to get a token which allows it to continue processing.  If it 
--      has the token, it may call the Give entry to return it.  The tasks 
--      implement a discipline whereby only the task with the token may be 
--      active.  The test does not require any specific order for the tasks 
--      to run.
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--      07 Jul 96   SAIC    Fixed spelling nits.
--
--!

package C940001_0 is

  type Token_Type is private;
  True_Token : constant Token_Type;   -- Create a deferred constant in order 
                                      -- to provide a component init for the
                                      -- protected object

  protected type Token_Mgr_Prot_Unit is
    entry Take (T : out Token_Type);
    entry Give (T : in out  Token_Type);
  private
    Token : Token_Type := True_Token;
  end Token_Mgr_Prot_Unit;

  function Init_Token return Token_Type;   -- call to initialize an 
                                           -- object of Token_Type
  function Token_Value (T : Token_Type) return Boolean;
                                           -- call to inspect the value of an
                                           -- object of Token_Type
private
  type Token_Type is new boolean;
  True_Token : constant Token_Type := true;
end C940001_0;

--=================================================================--

package body C940001_0 is
  protected body  Token_Mgr_Prot_Unit is
    entry Take (T : out Token_Type) when Token = true is
      begin                   -- Calling task will Take the token, so
        T := Token;           -- check first that token_mgr owns the
        Token := false;       -- token to give, then give it to caller
      end Take;

    entry Give (T : in out Token_Type)  when Token = false is
      begin                   -- Calling task will Give the token back,
        if T = true then      -- so first check that token_mgr does not
          Token := T;         -- own the token, then check that the task has
          T := false;         -- the token to give, then take it from the
        end if;               -- task
                              -- if caller does not own the token, then
      end Give;               -- it falls out of the entry body with no
  end Token_Mgr_Prot_Unit;    -- action

  function Init_Token return Token_Type is
    begin
      return false;
    end Init_Token;

  function Token_Value (T : Token_Type) return Boolean is
    begin
      return Boolean (T);
    end Token_Value;

end C940001_0;

--===============================================================--

with Report;
with ImpDef;
with C940001_0;

procedure C940001 is

  type TC_Int_Type is range 0..2;
              -- range is very narrow so that erroneous execution may
              -- raise Constraint_Error

  type TC_Artifact_Type is record
     TC_Int : TC_Int_Type := 1;
     Number_of_Accesses : integer := 0;
  end record;

  TC_Artifact : TC_Artifact_Type;

  Sequence_Mgr : C940001_0.Token_Mgr_Prot_Unit;
    
  procedure Bump (Item : in out TC_Int_Type) is
    begin
      Item := Item + 1;
    exception
      when Constraint_Error =>
        Report.Failed ("Incremented without corresponding decrement");
      when others =>
        Report.Failed ("Bump raised Unexpected Exception");
   end Bump;

  procedure Decrement (Item : in out TC_Int_Type) is
    begin
      Item := Item - 1;
    exception
      when Constraint_Error =>
        Report.Failed ("Decremented without corresponding increment");
      when others =>
        Report.Failed ("Decrement raised Unexpected Exception");
    end Decrement;
    
    --==============--

  task type Network_Node_Type;

  task body Network_Node_Type is

    Slot_for_Token : C940001_0.Token_Type := C940001_0.Init_Token;

    begin
 
      -- Ask for token - if request is not granted, task will be queued
      Sequence_Mgr.Take (Slot_for_Token);        

      -- Task now has token and may perform its work

      --==========================--
      -- in this case, the work is to ensure that the test results
      -- are the expected ones!
      --==========================--
      Bump (TC_Artifact.TC_Int);   -- increment when request is granted
      TC_Artifact.Number_Of_Accesses := 
        TC_Artifact.Number_Of_Accesses + 1;
      if not C940001_0.Token_Value ( Slot_for_Token) then
        Report.Failed ("Incorrect results from entry Take");
      end if;
 
      -- give a chance for other tasks to (incorrectly) run
      delay ImpDef.Minimum_Task_Switch;

      Decrement (TC_Artifact.TC_Int); -- prepare to return token

      -- Task has completed its work and will return token

      Sequence_Mgr.Give (Slot_for_Token);   -- return token to sequence manager

      if c940001_0.Token_Value (Slot_for_Token) then
        Report.Failed ("Incorrect results from entry Give");
      end if;

    exception
      when others => Report.Failed ("Unexpected exception raised in task");

    end Network_Node_Type; 

    --==============--

begin

  Report.Test ("C940001", "Check that a protected object can control " &
                          "tasks by coordinating access to shared data");

  declare
     Node_1, Node_2, Node_3 : Network_Node_Type;
                           -- declare three tasks which will compete for
                           -- a single token, managed by Sequence Manager

  begin                    -- tasks start
    null;
  end; -- wait for all tasks to terminate before reporting result

  if TC_Artifact.Number_of_Accesses /= 3 then
    Report.Failed ("Not all tasks got through");
  end if;

  Report.Result;

end C940001;