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 a requeue is cancelled and that the requeuing task is
28 -- unaffected when the calling task is aborted.
29 -- Specifically, check requeue to an entry in a different task,
30 -- requeue where the entry has parameters, and requeue with abort.
33 -- Abort a task that has a call requeued to the entry queue of another
34 -- task. We do this by sending two messages to the Distributor which
35 -- requeues them to the Credit task. In the accept body of the Credit
36 -- task we wait for the second message to arrive then check that an
37 -- abort of the second message task does result in the requeue being
38 -- removed. The Line Driver task which generates the messages and the
39 -- Credit task communicate artificially in this test to arrange for the
40 -- proper timing of the messages and the abort. One extra message is
41 -- sent to the Debit task to ensure that the Distributor is still viable
42 -- and has been unaffected by the abort.
44 -- This series of tests uses a simulation of a transaction driven
45 -- processing system. Line Drivers accept input from an external source
46 -- and build them into transaction records. These records are then
47 -- encapsulated in message tasks which remain extant for the life of the
48 -- transaction in the system. The message tasks put themselves on the
49 -- input queue of a Distributor which, from information in the
50 -- transaction and/or system load conditions forwards them to other
51 -- operating tasks. These in turn might forward the transactions to yet
52 -- other tasks for further action. The routing is, in real life, dynamic
53 -- and unpredictable at the time of message generation. All rerouting in
54 -- this model is done by means of requeues.
58 -- 06 Dec 94 SAIC ACVC 2.0
59 -- 25 Nov 95 SAIC Fixed shared global variable problems for
70 -- Arbitrary test values
71 Credit_Return
: constant := 1;
72 Debit_Return
: constant := 2;
75 protected type Shared_Boolean
(Initial_Value
: Boolean := False) is
78 function Value
return Boolean;
80 Current_Value
: Boolean := Initial_Value
;
83 protected body Shared_Boolean
is
86 Current_Value
:= True;
89 procedure Set_False
is
91 Current_Value
:= False;
94 function Value
return Boolean is
101 TC_Debit_Message_Complete
: Shared_Boolean
(False);
102 TC_Credit_Message_Complete
: Shared_Boolean
(False);
105 type Transaction_Code
is (Credit
, Debit
);
107 type Transaction_Record
;
108 type acc_Transaction_Record
is access Transaction_Record
;
109 type Transaction_Record
is
112 Code
: Transaction_Code
:= Debit
;
113 Account_Number
: integer := 0;
114 Stock_Number
: integer := 0;
115 Quantity
: integer := 0;
116 Return_Value
: integer := 0;
117 TC_Message_Count
: integer := 0;
118 TC_Thru_Dist
: Boolean := false;
122 task type Message_Task
is
123 entry Accept_Transaction
(In_Transaction
: acc_Transaction_Record
);
125 type acc_Message_Task
is access Message_Task
;
132 entry Input
(Transaction
: acc_Transaction_Record
);
135 task Credit_Computation
is
136 entry Input
(Transaction
: acc_Transaction_Record
);
137 end Credit_Computation
;
139 task Debit_Computation
is
140 entry Input
(Transaction
: acc_Transaction_Record
);
141 end Debit_Computation
;
143 -- This protected object is here for Test Control purposes only
145 procedure Set_First_Has_Arrived
;
146 procedure Set_Second_Has_Arrived
;
147 procedure Set_Abort_Has_Completed
;
148 function First_Has_Arrived
return Boolean;
149 function Second_Has_Arrived
return Boolean;
150 function Abort_Has_Completed
return Boolean;
152 First_Flag
, Second_Flag
, Abort_Flag
: Boolean := false;
155 protected body TC_Prt
is
157 Procedure Set_First_Has_Arrived
is
160 end Set_First_Has_Arrived
;
162 Procedure Set_Second_Has_Arrived
is
165 end Set_Second_Has_Arrived
;
167 Procedure Set_Abort_Has_Completed
is
170 end Set_Abort_Has_Completed
;
172 Function First_Has_Arrived
return boolean is
175 end First_Has_Arrived
;
177 Function Second_Has_Arrived
return boolean is
180 end Second_has_Arrived
;
182 Function Abort_Has_Completed
return boolean is
185 end Abort_Has_Completed
;
189 -- Assemble messages received from an external source
190 -- Creates a message task for each. The message tasks remain extant
191 -- for the life of the messages in the system.
192 -- TC: The Line Driver task would normally be designed to loop
193 -- continuously creating the messages as input is received. Simulate
194 -- this but limit it to three dummy messages for this test and use
195 -- special artificial checks to pace the messages out under controlled
196 -- conditions for the test; allow it to terminate at the end
198 task body Line_Driver
is
199 Current_ID
: integer := 1;
200 TC_First_message_sent
: Boolean := false;
202 procedure Build_Credit_Record
203 ( Next_Transaction
: acc_Transaction_Record
) is
204 Dummy_Account
: constant integer := 100;
206 Next_Transaction
.ID
:= Current_ID
;
207 Next_Transaction
.Code
:= Credit
;
209 Next_Transaction
.Account_Number
:= Dummy_Account
;
210 Current_ID
:= Current_ID
+ 1;
211 end Build_Credit_Record
;
214 procedure Build_Debit_Record
215 ( Next_Transaction
: acc_Transaction_Record
) is
216 Dummy_Account
: constant integer := 200;
218 Next_Transaction
.ID
:= Current_ID
;
219 Next_Transaction
.Code
:= Debit
;
221 Next_Transaction
.Account_Number
:= Dummy_Account
;
222 Current_ID
:= Current_ID
+ 1;
223 end Build_Debit_Record
;
227 accept Start
; -- Wait for trigger from main
229 for i
in 1..3 loop -- TC: arbitrarily limit to two credit messages
230 -- and one debit, then complete
232 -- Create a task for the next message
233 Next_Message_Task
: acc_Message_Task
:= new Message_Task
;
234 -- Create a record for it
235 Next_Transaction
: acc_Transaction_Record
:=
236 new Transaction_Record
;
238 if not TC_First_Message_Sent
then
239 -- send out the first message to start up the Credit task
240 Build_Credit_Record
( Next_Transaction
);
241 Next_Message_Task
.Accept_Transaction
( Next_Transaction
);
242 TC_First_Message_Sent
:= true;
243 elsif not TC_Prt
.Abort_Has_Completed
then
244 -- We have not yet processed the second message
245 -- Wait to send the second message until we know the first
246 -- has arrived at the Credit task and that task is in the
248 while not TC_Prt
.First_Has_Arrived
loop
249 delay ImpDef
.Minimum_Task_Switch
;
252 -- We can now send the second message
253 Build_Credit_Record
( Next_Transaction
);
254 Next_Message_Task
.Accept_Transaction
( Next_Transaction
);
256 -- Now wait for the second to arrive on the Credit input queue
257 while not TC_Prt
.Second_Has_Arrived
loop
258 delay ImpDef
.Minimum_Task_Switch
;
261 -- At this point: The Credit task is in the accept block
262 -- dealing with the first message and the second message is
263 -- is on the input queue
264 abort Next_Message_Task
.all; -- Note: we are still in the
265 -- declare block for the
266 -- second message task
268 -- Make absolutely certain that all the actions
269 -- associated with the abort have been completed, that the
270 -- task has gone from Abnormal right through to
271 -- Termination. All requeues that are to going to be
272 -- cancelled will have been by the point of Termination.
273 while not Next_Message_Task
.all'terminated loop
274 delay ImpDef
.Minimum_Task_Switch
;
278 -- We now signal the Credit task that the abort has taken place
279 -- so that it can check that the entry queue is empty as the
280 -- requeue should have been cancelled
281 TC_Prt
.Set_Abort_Has_Completed
;
283 -- The main part of the test is complete. Send one Debit message
284 -- as further exercise of the Distributor to ensure it has not
285 -- been affected by the cancellation of the requeue.
286 Build_Debit_Record
( Next_Transaction
);
287 Next_Message_Task
.Accept_Transaction
( Next_Transaction
);
294 Report
.Failed
("Unexpected exception in Line_Driver");
300 task body Message_Task
is
302 TC_Original_Transaction_Code
: Transaction_Code
;
303 This_Transaction
: acc_Transaction_Record
:= new Transaction_Record
;
307 accept Accept_Transaction
(In_Transaction
: acc_Transaction_Record
) do
308 This_Transaction
.all := In_Transaction
.all;
309 end Accept_Transaction
;
311 -- Note the original code to ensure correct return
312 TC_Original_Transaction_Code
:= This_Transaction
.Code
;
314 -- Queue up on Distributor's Input queue
315 Distributor
.Input
( This_Transaction
);
316 -- This task will now wait for the requeued rendezvous
317 -- to complete before proceeding
319 -- After the required computations have been performed
320 -- return the Transaction_Record appropriately (probably to an output
324 -- For the test check that the return values are as expected
325 if TC_Original_Transaction_Code
/= This_Transaction
.Code
then
326 -- Incorrect rendezvous
327 Report
.Failed
("Message Task: Incorrect code returned");
330 if This_Transaction
.Code
= Credit
then
331 if This_Transaction
.Return_Value
/= Credit_Return
or
332 This_Transaction
.TC_Message_Count
/= 1 or not
333 This_Transaction
.TC_Thru_Dist
then
334 Report
.Failed
("Expected path not traversed");
336 TC_Credit_Message_Complete
.Set_True
;
338 if This_Transaction
.Return_Value
/= Debit_Return
or
339 This_Transaction
.TC_Message_Count
/= 1 or not
340 This_Transaction
.TC_Thru_Dist
then
341 Report
.Failed
("Expected path not traversed");
343 TC_Debit_Message_Complete
.Set_True
;
348 Report
.Failed
("Unexpected exception in Message_Task");
354 -- Dispose each input Transaction_Record to the appropriate
357 task body Distributor
is
362 accept Input
(Transaction
: acc_Transaction_Record
) do
363 -- Show that this message did pass through the Distributor Task
364 Transaction
.TC_Thru_Dist
:= true;
366 -- Pass this transaction on the the appropriate computation
368 case Transaction
.Code
is
370 requeue Credit_Computation
.Input
with abort;
372 requeue Debit_Computation
.Input
with abort;
382 Report
.Failed
("Unexpected exception in Distributor");
388 -- Note: After the computation is performed in this task and the
389 -- accept body is completed the rendezvous in the original
390 -- message task is completed.
391 task body Credit_Computation
is
392 Message_Count
: integer := 0;
396 accept Input
( Transaction
: acc_Transaction_Record
) do
397 -- Perform the computations required for this transaction
401 -- The rest of this code is for Test Control
403 if not Transaction
.TC_Thru_Dist
then
405 ("Credit Task: Wrong queue, Distributor bypassed");
407 if Transaction
.code
/= Credit
then
409 ("Credit Task: Requeue delivered to the wrong queue");
412 -- for the test plug a known value and count
413 Transaction
.Return_Value
:= Credit_Return
;
414 -- one, and only one message should pass through
415 if Message_Count
/= 0 then
416 Report
.Failed
("Aborted Requeue was not cancelled -1");
418 Message_Count
:= Message_Count
+ 1;
419 Transaction
.TC_Message_Count
:= Message_Count
;
422 -- Having done the basic housekeeping we now need to signal
423 -- that we are in the accept body of the credit task. The
424 -- first message has arrived and the Line Driver may now send
426 TC_Prt
.Set_First_Has_Arrived
;
428 -- Now wait for the second to arrive
430 while Input
'Count = 0 loop
431 delay ImpDef
.Minimum_Task_Switch
;
433 -- Second message has been requeued - the Line driver may
434 -- now abort the calling task
435 TC_Prt
.Set_Second_Has_Arrived
;
437 -- Now wait for the Line Driver to signal that the abort of
438 -- the first task is complete - the requeue should be cancelled
440 while not TC_Prt
.Abort_Has_Completed
loop
441 delay ImpDef
.Minimum_Task_Switch
;
444 if Input
'Count /=0 then
445 Report
.Failed
("Aborted Requeue was not cancelled -2");
447 -- We can now complete the rendezvous with the first caller
455 Report
.Failed
("Unexpected exception in Credit_Computation");
456 end Credit_Computation
;
461 -- Note: After the computation is performed in this task and the
462 -- accept body is completed the rendezvous in the original
463 -- message task is completed.
464 task body Debit_Computation
is
465 Message_Count
: integer := 0;
469 accept Input
(Transaction
: acc_Transaction_Record
) do
470 -- Perform the computations required for this message
474 -- The rest of this code is for Test Control
476 if not Transaction
.TC_Thru_Dist
then
478 ("Debit Task: Wrong queue, Distributor bypassed");
480 if Transaction
.code
/= Debit
then
482 ("Debit Task: Requeue delivered to the wrong queue");
485 -- for the test plug a known value and count
486 Transaction
.Return_Value
:= Debit_Return
;
487 -- one, and only one, message should pass through
488 Message_Count
:= Message_Count
+ 1;
489 Transaction
.TC_Message_Count
:= Message_Count
;
497 Report
.Failed
("Unexpected exception in Debit_Computation");
500 end Debit_Computation
;
505 Report
.Test
("C954013", "Abort a task that has a call requeued");
507 Line_Driver
.Start
; -- start the test
509 -- Wait for the message tasks to complete before calling Report.Result.
510 -- Although two Credit tasks are generated one is aborted so only
511 -- one completes, thus a single flag is sufficient
512 -- Note: the test will hang here if there is a problem with the
513 -- completion of the tasks
514 while not (TC_Credit_Message_Complete
.Value
and
515 TC_Debit_Message_Complete
.Value
) loop
516 delay ImpDef
.Minimum_Task_Switch
;