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 within a protected entry to an entry in a
28 -- different protected object is queued correctly.
31 -- One transaction is sent through to check the paths. After processing
32 -- this the Credit task sets the "overloaded" indicator. Once this
33 -- indicator is set the Distributor (a protected object) queues low
34 -- priority transactions on a Wait_for_Underload queue in another
35 -- protected object using a requeue. The Distributor still delivers high
36 -- priority transactions. After two high priority transactions have been
37 -- processed by the Credit task it clears the overload condition. The
38 -- low priority transactions should now be delivered.
40 -- This series of tests uses a simulation of a transaction driven
41 -- processing system. Line Drivers accept input from an external source
42 -- and build them into transaction records. These records are then
43 -- encapsulated in message tasks which remain extant for the life of the
44 -- transaction in the system. The message tasks put themselves on the
45 -- input queue of a Distributor which, from information in the
46 -- transaction and/or system load conditions forwards them to other
47 -- operating tasks. These in turn might forward the transactions to yet
48 -- other tasks for further action. The routing is, in real life, dynamic
49 -- and unpredictable at the time of message generation. All rerouting in
50 -- this model is done by means of requeues.
54 -- 06 Dec 94 SAIC ACVC 2.0
55 -- 26 Nov 95 SAIC Fixed shared global variable for ACVC 2.0.1
64 -- Arbitrary test values
65 Credit_Return
: constant := 1;
66 Debit_Return
: constant := 2;
69 -- Mechanism to count the number of Credit Message tasks completed
70 protected TC_Tasks_Completed
is
72 function Count
return integer;
74 Number_Complete
: integer := 0;
75 end TC_Tasks_Completed
;
78 TC_Credit_Messages_Expected
: constant integer := 5;
80 protected TC_Handshake
is
82 function First_Message_Arrived
return Boolean;
84 Arrived_Flag
: Boolean := false;
87 -- Handshaking mechanism between the Line Driver and the Credit task
89 protected body TC_Handshake
is
96 function First_Message_Arrived
return Boolean is
99 end First_Message_Arrived
;
104 protected type Shared_Boolean
(Initial_Value
: Boolean := False) is
107 function Value
return Boolean;
109 Current_Value
: Boolean := Initial_Value
;
112 protected body Shared_Boolean
is
113 procedure Set_True
is
115 Current_Value
:= True;
118 procedure Set_False
is
120 Current_Value
:= False;
123 function Value
return Boolean is
125 return Current_Value
;
129 TC_Debit_Message_Complete
: Shared_Boolean
(False);
131 type Transaction_Code
is (Credit
, Debit
);
132 type Transaction_Priority
is (High
, Low
);
134 type Transaction_Record
;
135 type acc_Transaction_Record
is access Transaction_Record
;
136 type Transaction_Record
is
139 Code
: Transaction_Code
:= Debit
;
140 Priority
: Transaction_Priority
:= High
;
141 Account_Number
: integer := 0;
142 Stock_Number
: integer := 0;
143 Quantity
: integer := 0;
144 Return_Value
: integer := 0;
145 TC_Message_Count
: integer := 0;
146 TC_Thru_Dist
: Boolean := false;
150 task type Message_Task
is
151 entry Accept_Transaction
(In_Transaction
: acc_Transaction_Record
);
153 type acc_Message_Task
is access Message_Task
;
159 protected Distributor
is
160 procedure Set_Credit_Overloaded
;
161 procedure Clear_Credit_Overloaded
;
162 function Credit_is_Overloaded
return Boolean;
163 entry Input
(Transaction
: acc_Transaction_Record
);
165 Credit_Overloaded
: Boolean := false;
169 procedure Underloaded
;
170 entry Wait_for_Underload
(Transaction
: acc_Transaction_Record
);
172 Release_All
: Boolean := false;
175 task Credit_Computation
is
176 entry Input
(Transaction
: acc_Transaction_Record
);
177 end Credit_Computation
;
179 task Debit_Computation
is
180 entry Input
(Transaction
: acc_Transaction_Record
);
181 end Debit_Computation
;
184 -- Dispose each input Transaction_Record to the appropriate
187 protected body Distributor
is
189 procedure Set_Credit_Overloaded
is
191 Credit_Overloaded
:= true;
192 end Set_Credit_Overloaded
;
194 procedure Clear_Credit_Overloaded
is
196 Credit_Overloaded
:= false;
197 Hold
.Underloaded
; -- Release all held messages
198 end Clear_Credit_Overloaded
;
200 function Credit_is_Overloaded
return Boolean is
202 return Credit_Overloaded
;
203 end Credit_is_Overloaded
;
206 entry Input
(Transaction
: acc_Transaction_Record
) when true is
207 -- barrier is always open
209 -- Test Control: Set the indicator in the message to show it has
210 -- passed through the Distributor object
211 Transaction
.TC_thru_Dist
:= true;
213 -- Pass this transaction on to the appropriate computation
214 -- task but temporarily hold low-priority transactions under
215 -- overload conditions
216 case Transaction
.Code
is
218 if Credit_Overloaded
and Transaction
.Priority
= Low
then
219 requeue Hold
.Wait_for_Underload
with abort;
221 requeue Credit_Computation
.Input
with abort;
224 requeue Debit_Computation
.Input
with abort;
230 -- Low priority Message tasks are held on the Wait_for_Underload queue
231 -- while the Credit computation system is overloaded. Once the Credit
232 -- system reached underload send all queued messages immediately
234 protected body Hold
is
236 -- Once this is executed the barrier condition for the entry is
238 procedure Underloaded
is
243 entry Wait_for_Underload
(Transaction
: acc_Transaction_Record
)
246 requeue Credit_Computation
.Input
with abort;
247 if Wait_for_Underload
'count = 0 then
248 -- Queue is purged. Set up to hold next batch
249 Release_All
:= false;
251 end Wait_for_Underload
;
255 -- Mechanism to count the number of Message tasks completed (Credit)
256 protected body TC_Tasks_Completed
is
257 procedure Increment
is
259 Number_Complete
:= Number_Complete
+ 1;
262 function Count
return integer is
264 return Number_Complete
;
266 end TC_Tasks_Completed
;
269 -- Assemble messages received from an external source
270 -- Creates a message task for each. The message tasks remain extant
271 -- for the life of the messages in the system.
272 -- The Line Driver task would normally be designed to loop continuously
273 -- creating the messages as input is received. Simulate this
274 -- but limit it to the required number of dummy messages needed for
275 -- this test and allow it to terminate at that point. Artificially
276 -- alternate High and Low priority Credit transactions for this test.
278 task body Line_Driver
is
279 Current_ID
: integer := 1;
280 Current_Priority
: Transaction_Priority
:= High
;
282 -- Artificial: number of messages required for this test
283 type TC_Trans_Range
is range 1..6;
285 procedure Build_Credit_Record
286 ( Next_Transaction
: acc_Transaction_Record
) is
287 Dummy_Account
: constant integer := 100;
289 Next_Transaction
.ID
:= Current_ID
;
290 Next_Transaction
.Code
:= Credit
;
291 Next_Transaction
.Priority
:= Current_Priority
;
293 Next_Transaction
.Account_Number
:= Dummy_Account
;
294 Current_ID
:= Current_ID
+ 1;
295 end Build_Credit_Record
;
298 procedure Build_Debit_Record
299 ( Next_Transaction
: acc_Transaction_Record
) is
300 Dummy_Account
: constant integer := 200;
302 Next_Transaction
.ID
:= Current_ID
;
303 Next_Transaction
.Code
:= Debit
;
305 Next_Transaction
.Account_Number
:= Dummy_Account
;
306 Current_ID
:= Current_ID
+ 1;
307 end Build_Debit_Record
;
311 accept Start
; -- Wait for trigger from Main
313 for Transaction_Numb
in TC_Trans_Range
loop -- TC: limit the loop
315 -- Create a task for the next message
316 Next_Message_Task
: acc_Message_Task
:= new Message_Task
;
317 -- Create a record for it
318 Next_Transaction
: acc_Transaction_Record
:=
319 new Transaction_Record
;
321 if Transaction_Numb
= TC_Trans_Range
'first then
322 -- Send the first Credit message
323 Build_Credit_Record
( Next_Transaction
);
324 Next_Message_Task
.Accept_Transaction
( Next_Transaction
);
325 -- TC: Wait until the first message has been received by the
326 -- Credit task and it has set the Overload indicator for the
328 while not TC_Handshake
.First_Message_Arrived
loop
329 delay ImpDef
.Minimum_Task_Switch
;
331 elsif Transaction_Numb
= TC_Trans_Range
'last then
332 -- For this test send the last transaction to the Debit task
333 -- to improve the mix
334 Build_Debit_Record
( Next_Transaction
);
335 Next_Message_Task
.Accept_Transaction
( Next_Transaction
);
337 -- TC: Alternate high and low priority transactions
338 if Current_Priority
= High
then
339 Current_Priority
:= Low
;
341 Current_Priority
:= High
;
343 Build_Credit_Record
( Next_Transaction
);
344 Next_Message_Task
.Accept_Transaction
( Next_Transaction
);
351 Report
.Failed
("Unexpected exception in Line_Driver");
357 task body Message_Task
is
359 TC_Original_Transaction_Code
: Transaction_Code
;
360 This_Transaction
: acc_Transaction_Record
:= new Transaction_Record
;
364 accept Accept_Transaction
(In_Transaction
: acc_Transaction_Record
) do
365 This_Transaction
.all := In_Transaction
.all;
366 end Accept_Transaction
;
368 -- Note the original code to ensure correct return
369 TC_Original_Transaction_Code
:= This_Transaction
.Code
;
371 -- Queue up on Distributor's Input queue
372 Distributor
.Input
( This_Transaction
);
373 -- This task will now wait for the requeued rendezvous
374 -- to complete before proceeding
376 -- After the required computations have been performed
377 -- return the Transaction_Record appropriately (probably to an output
381 -- For the test check that the return values are as expected
382 if TC_Original_Transaction_Code
/= This_Transaction
.Code
then
383 -- Incorrect rendezvous
384 Report
.Failed
("Message Task: Incorrect code returned");
387 if This_Transaction
.Code
= Credit
then
388 if This_Transaction
.Return_Value
/= Credit_Return
or
389 not This_Transaction
.TC_thru_Dist
then
390 Report
.Failed
("Expected path not traversed - Credit");
392 TC_Tasks_Completed
.Increment
;
394 if This_Transaction
.Return_Value
/= Debit_Return
or
395 This_Transaction
.TC_Message_Count
/= 1 or
396 not This_Transaction
.TC_thru_Dist
then
397 Report
.Failed
("Expected path not traversed - Debit");
399 TC_Debit_Message_Complete
.Set_True
;
404 Report
.Failed
("Unexpected exception in Message_Task");
411 -- Computation task. After the computation is performed the rendezvous
412 -- in the original message task is completed.
413 task body Credit_Computation
is
415 Message_Count
: integer := 0;
420 accept Input
( Transaction
: acc_Transaction_Record
) do
421 if Distributor
.Credit_is_Overloaded
422 and Transaction
.Priority
= Low
then
423 -- We should not be getting any Low Priority messages. They
424 -- should be waiting on the Hold.Wait_for_Underload
427 ("Credit Task: Low priority transaction during overload");
429 -- Perform the computations required for this transaction
433 if not Transaction
.TC_thru_Dist
then
435 ("Credit Task: Wrong queue, Distributor bypassed");
437 if Transaction
.code
/= Credit
then
439 ("Credit Task: Requeue delivered to the wrong queue");
442 -- The following is all Test Control code:
443 Transaction
.Return_Value
:= Credit_Return
;
444 Message_Count
:= Message_Count
+ 1;
446 -- Now take special action depending on which Message
447 if Message_Count
= 1 then
448 -- After the first message :
449 Distributor
.Set_Credit_Overloaded
;
450 -- Now flag the Line_Driver that the second and subsequent
451 -- messages may now be sent
454 if Message_Count
= 3 then
455 -- The two high priority transactions created subsequent
456 -- to the overload have now been processed
457 Distributor
.Clear_Credit_Overloaded
;
466 Report
.Failed
("Unexpected exception in Credit_Computation");
467 end Credit_Computation
;
471 -- Computation task. After the computation is performed the rendezvous
472 -- in the original message task is completed.
474 task body Debit_Computation
is
475 Message_Count
: integer := 0;
479 accept Input
(Transaction
: acc_Transaction_Record
) do
480 -- Perform the computations required for this message
484 if not Transaction
.TC_thru_Dist
then
486 ("Debit Task: Wrong queue, Distributor bypassed");
488 if Transaction
.code
/= Debit
then
490 ("Debit Task: Requeue delivered to the wrong queue");
493 -- for the test plug a known value and count
494 Transaction
.Return_Value
:= Debit_Return
;
495 -- one, and only one, message should pass through
496 Message_Count
:= Message_Count
+ 1;
497 Transaction
.TC_Message_Count
:= Message_Count
;
505 Report
.Failed
("Unexpected exception in Debit_Computation");
506 end Debit_Computation
;
510 Report
.Test
("C954021", "Requeue from one entry body to an entry in" &
511 " another protected object");
513 Line_Driver
.Start
; -- Start the test
516 -- Ensure that the message tasks have completed before reporting result
517 while (TC_Tasks_Completed
.Count
< TC_Credit_Messages_Expected
)
518 and not TC_Debit_Message_Complete
.Value
loop
519 delay ImpDef
.Minimum_Task_Switch
;