3 -- Grant of Unlimited Rights
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
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.
27 -- Check that an entry and a procedure within the same protected object
28 -- will not be executed simultaneously.
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
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.
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.
53 -- 06 Dec 94 SAIC ACVC 2.0
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.
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;
75 Report
.Test
("C951002", "Check that a procedure and an entry body " &
76 "in a protected object will not run concurrently");
78 declare -- encapsulate the test
80 task Credit_Message
is
96 --====================================
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
;
106 function TC_Message_is_Queued
return Boolean;
109 Credit_Overloaded
: Boolean := true; -- Test starts in overload
110 Debit_Overloaded
: Boolean := false;
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;
117 --====================
118 protected body Hold
is
120 entry Wait_for_CR_Underload
when not Credit_Overloaded
is
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
128 TC_CR_Entry_Finished
:= true;
129 end Wait_for_CR_Underload
;
131 -- This is the procedure which should NOT be able to run in
132 -- parallel with the entry body
134 procedure Clear_CR_Overload
is
137 -- The entry body must not be executed until this procedure
139 if TC_CR_Entry_Finished
then
140 TC_Error_02
:= true; -- Set error indicator
142 Credit_Overloaded
:= false; -- clear the entry barrier
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
149 ImpDef
.Exceed_Time_Slice
;
151 -- Again, the entry body must not be executed until the current
152 -- procedure is completed.
154 if TC_CR_Entry_Finished
then
155 TC_Error_03
:= true; -- Set error indicator
157 TC_CR_Proc_Finished
:= true;
159 end Clear_CR_Overload
;
162 -- The following subprogram and entry body are used in the second
165 entry Wait_for_DB_Underload
when not Debit_Overloaded
is
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
174 TC_DB_Entry_Finished
:= true;
175 end Wait_for_DB_Underload
;
178 procedure Set_DB_Overload
is
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
184 if TC_DB_Entry_Finished
then
185 TC_Error_05
:= true; -- Set error indicator
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
193 ImpDef
.Exceed_Time_Slice
;
195 Debit_Overloaded
:= true; -- set the entry barrier
197 if TC_DB_Entry_Finished
then
198 TC_Error_06
:= true; -- Set error indicator
200 TC_DB_Proc_Finished
:= true;
204 procedure Clear_DB_Overload
is
206 Debit_Overloaded
:= false; -- open the entry barrier
207 end Clear_DB_Overload
;
209 function TC_Message_is_Queued
return Boolean is
212 -- returns true when one message arrives on the queue
213 return (Wait_for_CR_Underload
'Count = 1);
215 end TC_Message_is_Queued
;
219 --====================================
221 task body Credit_Message
is
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
;
231 Report
.Failed
("Unexpected Exception in Credit_Message Task");
234 task body Credit_Task
is
237 -- Application code here (not shown) determines that the
238 -- underload threshold has been reached
239 Hold
.Clear_CR_Overload
;
242 Report
.Failed
("Unexpected Exception in Credit_Task");
247 -- The following two tasks are used in the second part of the test
249 task body Debit_Message
is
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
257 Hold
.Wait_for_DB_Underload
;
260 Report
.Failed
("Unexpected Exception in Debit_Message Task");
263 task body Debit_Task
is
266 -- Application code here (not shown) determines that the
267 -- underload threshold has been reached
268 Hold
.Set_DB_Overload
;
271 Report
.Failed
("Unexpected Exception in Debit_Task");
276 Credit_Message
.TC_Start
;
278 -- Wait until the message is queued on the entry before starting
280 while not Hold
.TC_Message_is_Queued
loop
281 delay ImpDef
.Minimum_Task_Switch
;
284 Credit_Task
.TC_Start
;
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
.Minimum_Task_Switch
;
291 --======================================================
292 -- Second part of the test
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
301 delay ImpDef
.Switch_To_New_Task
;
303 Debit_Message
.TC_Start
;
305 while not Debit_Task
'terminated loop
306 delay ImpDef
.Minimum_Task_Switch
;
309 Hold
.Clear_DB_Overload
; -- Allow completion
311 end; -- declare (encapsulation)
314 Report
.Failed
("Wait_for_CR_Underload executed out of sequence");
317 Report
.Failed
("Credit: Entry executed before procedure");
320 Report
.Failed
("Credit: Entry executed in parallel");
323 Report
.Failed
("Wait_for_DB_Underload executed out of sequence");
326 Report
.Failed
("Debit: Entry executed before procedure");
329 Report
.Failed
("Debit: Entry executed in parallel");