OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c940001.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- 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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.