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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c951002.a] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C951002.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
-- OBJECTIVE:
27
--      Check that an entry and a procedure within the same protected object
28
--      will not be executed simultaneously.
29
--
30
-- TEST DESCRIPTION:
31
--      Two tasks are used.  The first calls an entry who's barrier is set
32
--      and is thus queued.  The second calls a procedure in the same
33
--      protected object.  This procedure clears the entry barrier of the
34
--      first then executes a lengthy compute bound procedure.  This is
35
--      intended to allow a multiprocessor, or a time-slicing implementation
36
--      of a uniprocessor, to (erroneously) permit the first task to continue
37
--      while the second is still computing.  Flags in each process in the
38
--      PO are checked to ensure that they do not run out of sequence or in
39
--      parallel.
40
--      In the second part of the test another entry and procedure are used
41
--      but in this case the procedure is started first.  A different task
42
--      calls the entry AFTER the procedure has started.  If the entry
43
--      completes before the procedure the test fails.
44
--
45
--      This test will not be effective on a uniprocessor without time-slicing
46
--      It is designed to increase the chances of failure on a multiprocessor,
47
--      or a uniprocessor with time-slicing, if the entry and procedure in a
48
--      Protected Object are not forced to acquire a single execution
49
--      resource.  It is not guaranteed to fail.
50
--
51
--
52
-- CHANGE HISTORY:
53
--      06 Dec 94   SAIC    ACVC 2.0
54
--
55
--!
56
 
57
with Report;
58
with ImpDef;
59
 
60
procedure C951002 is
61
 
62
   -- These global error flags are used for failure conditions within
63
   -- the protected object.  We cannot call Report.Failed (thus Text_io)
64
   -- which would result in a bounded error.
65
   --
66
   TC_Error_01 : Boolean := false;
67
   TC_Error_02 : Boolean := false;
68
   TC_Error_03 : Boolean := false;
69
   TC_Error_04 : Boolean := false;
70
   TC_Error_05 : Boolean := false;
71
   TC_Error_06 : Boolean := false;
72
 
73
begin
74
 
75
   Report.Test ("C951002", "Check that a procedure and an entry body " &
76
                           "in a protected object will not run concurrently");
77
 
78
   declare -- encapsulate the test
79
 
80
      task Credit_Message is
81
         entry TC_Start;
82
      end Credit_Message;
83
 
84
      task Credit_Task is
85
         entry TC_Start;
86
      end Credit_Task;
87
 
88
      task Debit_Message is
89
         entry TC_Start;
90
      end Debit_Message;
91
 
92
      task Debit_Task is
93
         entry TC_Start;
94
      end Debit_Task;
95
 
96
      --====================================
97
 
98
      protected Hold is
99
 
100
         entry Wait_for_CR_Underload;
101
         procedure Clear_CR_Overload;
102
         entry Wait_for_DB_Underload;
103
         procedure Set_DB_Overload;
104
         procedure Clear_DB_Overload;
105
         --
106
         function TC_Message_is_Queued return Boolean;
107
 
108
      private
109
         Credit_Overloaded     : Boolean := true;  -- Test starts in overload
110
         Debit_Overloaded      : Boolean := false;
111
         --
112
         TC_CR_Proc_Finished   : Boolean := false;
113
         TC_CR_Entry_Finished  : Boolean := false;
114
         TC_DB_Proc_Finished   : Boolean := false;
115
         TC_DB_Entry_Finished  : Boolean := false;
116
      end Hold;
117
      --====================
118
      protected body Hold is
119
 
120
         entry Wait_for_CR_Underload when not Credit_Overloaded is
121
         begin
122
            -- The barrier must only be re-evaluated at the end of the
123
            -- of the execution of the procedure, also while the procedure
124
            -- is executing this entry body must not be executed
125
            if not TC_CR_Proc_Finished then
126
               TC_Error_01 := true;  -- Set error indicator
127
            end if;
128
            TC_CR_Entry_Finished := true;
129
         end Wait_for_CR_Underload ;
130
 
131
         -- This is the procedure which should NOT be able to run in
132
         -- parallel with the entry body
133
         --
134
         procedure Clear_CR_Overload is
135
         begin
136
 
137
            -- The entry body must not be executed until this procedure
138
            -- is completed.
139
            if TC_CR_Entry_Finished then
140
               TC_Error_02 := true;  -- Set error indicator
141
            end if;
142
            Credit_Overloaded := false;   -- clear the entry barrier
143
 
144
            -- Execute an implementation defined compute bound routine which
145
            -- is designed to run long enough to allow a task switch on a
146
            -- time-sliced uniprocessor, or for a multiprocessor to pick up
147
            -- another task.
148
            --
149
            ImpDef.Exceed_Time_Slice;
150
 
151
            -- Again, the entry body must not be executed until the current
152
            -- procedure is completed.
153
            --
154
            if TC_CR_Entry_Finished then
155
               TC_Error_03 := true;  -- Set error indicator
156
            end if;
157
            TC_CR_Proc_Finished := true;
158
 
159
         end Clear_CR_Overload;
160
 
161
         --============
162
         -- The following subprogram and entry body are used in the second
163
         -- part of the test
164
 
165
         entry Wait_for_DB_Underload when not Debit_Overloaded is
166
         begin
167
            -- By the time the task that calls this entry is allowed access to
168
            -- the queue the barrier, which starts off as open, will be closed
169
            -- by the Set_DB_Overload procedure.  It is only reopened
170
            -- at the end of the test
171
            if not TC_DB_Proc_Finished then
172
               TC_Error_04 := true;  -- Set error indicator
173
            end if;
174
            TC_DB_Entry_Finished := true;
175
         end Wait_for_DB_Underload ;
176
 
177
 
178
         procedure Set_DB_Overload is
179
         begin
180
            -- The task timing is such that this procedure should be started
181
            -- before the entry is called.  Thus the entry should be blocked
182
            -- until the end of this procedure which then sets the barrier
183
            --
184
            if TC_DB_Entry_Finished then
185
               TC_Error_05 := true;  -- Set error indicator
186
            end if;
187
 
188
            -- Execute an implementation defined compute bound routine which
189
            -- is designed to run long enough to allow a task switch on a
190
            -- time-sliced uniprocessor, or for a multiprocessor to pick up
191
            -- another task
192
            --
193
            ImpDef.Exceed_Time_Slice;
194
 
195
            Debit_Overloaded := true;   -- set the entry barrier
196
 
197
            if TC_DB_Entry_Finished then
198
               TC_Error_06 := true;  -- Set error indicator
199
            end if;
200
            TC_DB_Proc_Finished := true;
201
 
202
         end Set_DB_Overload;
203
 
204
         procedure Clear_DB_Overload is
205
         begin
206
            Debit_Overloaded := false;  -- open the entry barrier
207
         end Clear_DB_Overload;
208
 
209
         function TC_Message_is_Queued return Boolean is
210
         begin
211
 
212
            -- returns true when one message arrives on the queue
213
            return (Wait_for_CR_Underload'Count = 1);
214
 
215
         end TC_Message_is_Queued ;
216
 
217
      end Hold;
218
 
219
      --====================================
220
 
221
      task body Credit_Message is
222
      begin
223
         accept TC_Start;
224
         --::  some application processing.  Part of the process finds that
225
         --    the Overload threshold has been exceeded for the Credit
226
         --    application.  This message task queues itself on a queue
227
         --    waiting till the overload in no longer in effect
228
         Hold.Wait_for_CR_Underload;
229
      exception
230
         when others =>
231
            Report.Failed ("Unexpected Exception in Credit_Message Task");
232
      end Credit_Message;
233
 
234
      task body Credit_Task is
235
      begin
236
         accept TC_Start;
237
         --  Application code here (not shown) determines that the
238
         --  underload threshold has been reached
239
         Hold.Clear_CR_Overload;
240
      exception
241
         when others =>
242
            Report.Failed ("Unexpected Exception in Credit_Task");
243
      end Credit_Task;
244
 
245
      --==============
246
 
247
      -- The following two tasks are used in the second part of the test
248
 
249
      task body Debit_Message is
250
      begin
251
         accept TC_Start;
252
         --::  some application processing.  Part of the process finds that
253
         --    the Overload threshold has been exceeded for the Debit
254
         --    application.  This message task queues itself on a queue
255
         --    waiting till the overload is no longer in effect
256
         --
257
         Hold.Wait_for_DB_Underload;
258
      exception
259
         when others =>
260
            Report.Failed ("Unexpected Exception in Debit_Message Task");
261
      end Debit_Message;
262
 
263
      task body Debit_Task is
264
      begin
265
         accept TC_Start;
266
         --  Application code here (not shown) determines that the
267
         --  underload threshold has been reached
268
         Hold.Set_DB_Overload;
269
      exception
270
         when others =>
271
            Report.Failed ("Unexpected Exception in Debit_Task");
272
      end Debit_Task;
273
 
274
   begin -- declare
275
 
276
      Credit_Message.TC_Start;
277
 
278
      -- Wait until the message is queued on the entry before starting
279
      -- the Credit_Task
280
      while not Hold.TC_Message_is_Queued loop
281
         delay ImpDef.Long_Minimum_Task_Switch;
282
      end loop;
283
      --
284
      Credit_Task.TC_Start;
285
 
286
      -- Ensure the first part of the test is complete before continuing
287
      while not (Credit_Message'terminated and Credit_Task'terminated) loop
288
         delay ImpDef.Long_Minimum_Task_Switch;
289
      end loop;
290
 
291
      --======================================================
292
      -- Second part of the test
293
 
294
 
295
      Debit_Task.TC_Start;
296
 
297
      -- Delay long enough to allow a task switch to the Debit_Task and
298
      -- for it to reach the accept statement and call Hold.Set_DB_Overload
299
      -- before starting Debit_Message
300
      --
301
      delay ImpDef.Long_Switch_To_New_Task;
302
 
303
      Debit_Message.TC_Start;
304
 
305
      while not Debit_Task'terminated loop
306
         delay ImpDef.Long_Minimum_Task_Switch;
307
      end loop;
308
 
309
      Hold.Clear_DB_Overload;  -- Allow completion
310
 
311
   end; -- declare (encapsulation)
312
 
313
   if TC_Error_01 then
314
      Report.Failed ("Wait_for_CR_Underload executed out of sequence");
315
   end if;
316
   if TC_Error_02 then
317
      Report.Failed ("Credit: Entry executed before procedure");
318
   end if;
319
   if TC_Error_03 then
320
      Report.Failed ("Credit: Entry executed in parallel");
321
   end if;
322
   if TC_Error_04 then
323
      Report.Failed ("Wait_for_DB_Underload executed out of sequence");
324
   end if;
325
   if TC_Error_05 then
326
      Report.Failed ("Debit: Entry executed before procedure");
327
   end if;
328
   if TC_Error_06 then
329
      Report.Failed ("Debit: Entry executed in parallel");
330
   end if;
331
 
332
   Report.Result;
333
 
334
end C951002;

powered by: WebSVN 2.1.0

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