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 a family of entries
28 -- in a different protected object is queued correctly
29 -- Call with parameters
33 -- One transaction is sent through to check the paths. After processing
34 -- this, the Credit task sets the "overloaded" indicator. Once this
35 -- indicator is set the Distributor (a protected object) queues lower
36 -- priority transactions on a family of queues (Wait_for_Underload) in
37 -- another protected object using a requeue. The Distributor still
38 -- delivers high priority transactions. After two more high priority
39 -- transactions have been processed by the Credit task the artificial
40 -- test code clears the overload condition to the threshold level that
41 -- allows only the items on the Medium priority queue of the family to be
42 -- released. When these have been processed and checked the test code
43 -- then lowers the priority threshold once again, allowing the Low
44 -- priority items from the last queue in the family to be released,
45 -- processed and checked. Note: the High priority queue in the family is
48 -- This series of tests uses a simulation of a transaction driven
49 -- processing system. Line Drivers accept input from an external source
50 -- and build them into transaction records. These records are then
51 -- encapsulated in message tasks which remain extant for the life of the
52 -- transaction in the system. The message tasks put themselves on the
53 -- input queue of a Distributor which, from information in the
54 -- transaction and/or system load conditions forwards them to other
55 -- operating tasks. These in turn might forward the transactions to yet
56 -- other tasks for further action. The routing is, in real life, dynamic
57 -- and unpredictable at the time of message generation. All rerouting in
58 -- this model is done by means of requeues.
62 -- 06 Dec 94 SAIC ACVC 2.0
71 -- Artificial: number of messages required for this test
72 subtype TC_Trans_Range
is integer range 1..8;
74 TC_Credit_Messages_Expected
: constant integer
75 := TC_Trans_Range
'Last - 1;
77 TC_Debit_Message_Complete
: Boolean := false;
80 -- Mechanism for handshaking between tasks
82 procedure Increment_Tasks_Completed_Count
;
83 function Tasks_Completed_Count
return integer;
84 function First_Message_Has_Arrived
return Boolean;
85 procedure Set_First_Message_Has_Arrived
;
87 Number_Complete
: integer := 0;
88 Message_Arrived_Flag
: Boolean := false;
91 protected body TC_PO
is
92 procedure Increment_Tasks_Completed_Count
is
94 Number_Complete
:= Number_Complete
+ 1;
95 end Increment_Tasks_Completed_Count
;
97 function Tasks_Completed_Count
return integer is
99 return Number_Complete
;
100 end Tasks_Completed_Count
;
102 function First_Message_Has_Arrived
return Boolean is
104 return Message_Arrived_Flag
;
105 end First_Message_Has_Arrived
;
107 procedure Set_First_Message_Has_Arrived
is
109 Message_Arrived_Flag
:= true;
110 end Set_First_Message_Has_Arrived
;
116 Report
.Test
("C954023", "Requeue from within a protected object" &
117 " to a family of entries in another protected object");
120 declare -- encapsulate the test
122 -- Arbitrary test values
123 Credit_Return
: constant := 1;
124 Debit_Return
: constant := 2;
126 type Transaction_Code
is (Credit
, Debit
);
127 type App_Priority
is (Low
, Medium
, High
);
128 type Priority_Block
is array (App_Priority
) of Boolean;
130 type Transaction_Record
;
131 type acc_Transaction_Record
is access Transaction_Record
;
132 type Transaction_Record
is
135 Code
: Transaction_Code
:= Debit
;
136 Priority
: App_Priority
:= High
;
137 Account_Number
: integer := 0;
138 Stock_Number
: integer := 0;
139 Quantity
: integer := 0;
140 Return_Value
: integer := 0;
141 TC_Message_Count
: integer := 0;
142 TC_Thru_Distrib
: Boolean := false;
146 task type Message_Task
is
147 entry Accept_Transaction
(In_Transaction
: acc_Transaction_Record
);
149 type acc_Message_Task
is access Message_Task
;
155 protected Distributor
is
156 procedure Set_Credit_Overloaded
;
157 procedure Clear_Overload_to_Medium
;
158 procedure Clear_Overload_to_Low
;
159 entry Input
(Transaction
: acc_Transaction_Record
);
161 Credit_Overloaded
: Boolean := false;
165 procedure Release_Medium
;
166 procedure Release_Low
;
167 -- Family of entry queues indexed by App_Priority
168 entry Wait_for_Underload
(App_Priority
)
169 (Transaction
: acc_Transaction_Record
);
171 Release
: Priority_Block
:= (others => false);
174 task Credit_Computation
is
175 entry Input
(Transaction
: acc_Transaction_Record
);
176 end Credit_Computation
;
178 task Debit_Computation
is
179 entry Input
(Transaction
: acc_Transaction_Record
);
180 end Debit_Computation
;
183 -- Dispose each input Transaction_Record to the appropriate
186 protected body Distributor
is
188 procedure Set_Credit_Overloaded
is
190 Credit_Overloaded
:= true;
191 end Set_Credit_Overloaded
;
193 procedure Clear_Overload_to_Medium
is
195 Credit_Overloaded
:= false;
196 Hold
.Release_Medium
; -- Release all held messages on Medium
198 end Clear_Overload_to_Medium
;
200 procedure Clear_Overload_to_Low
is
202 Credit_Overloaded
:= false;
203 Hold
.Release_Low
; -- Release all held messages on Low
205 end Clear_Overload_to_Low
;
209 entry Input
(Transaction
: acc_Transaction_Record
) when true is
210 -- barrier is always open
212 -- Test Control: Set the indicator in the message to show it has
213 -- passed through the Distributor object
214 Transaction
.TC_thru_Distrib
:= true;
216 -- Pass this transaction on to the appropriate computation
217 -- task but temporarily hold low-priority transactions under
218 -- overload conditions
219 case Transaction
.Code
is
221 if Credit_Overloaded
and Transaction
.Priority
/= High
then
222 -- use the appropriate queue in the family
223 requeue Hold
.Wait_for_Underload
(Transaction
.Priority
)
226 requeue Credit_Computation
.Input
with abort;
229 requeue Debit_Computation
.Input
with abort;
235 -- Low priority Message tasks are held on the Wait_for_Underload queue
236 -- while the Credit computation system is overloaded. Once the Credit
237 -- system reached underload send all queued messages immediately
239 protected body Hold
is
241 -- Once these are executed the barrier conditions for the entries
243 procedure Release_Medium
is
245 Release
(Medium
) := true;
248 procedure Release_Low
is
250 Release
(Low
) := true;
253 -- This is a family of entry queues indexed by App_Priority
254 entry Wait_for_Underload
(for AP
in App_Priority
)
255 (Transaction
: acc_Transaction_Record
)
258 requeue Credit_Computation
.Input
with abort;
259 if Wait_for_Underload
(AP
)'count = 0 then
260 -- Queue is purged. Set up to hold next batch
261 Release
(AP
) := false;
263 end Wait_for_Underload
;
270 -- Assemble messages received from an external source
271 -- Creates a message task for each. The message tasks remain extant
272 -- for the life of the messages in the system.
273 -- The Line Driver task would normally be designed to loop
274 -- creating the messages as input is received. Simulate this
275 -- but limit it to the required number of dummy messages needed for
276 -- this test and allow it to terminate at that point. Artificially
277 -- cycle the generation of High medium and Low priority Credit
278 -- transactions for this test. Send out one final Debit message
280 task body Line_Driver
is
281 Current_ID
: integer := 1;
282 Current_Priority
: App_Priority
:= High
;
284 procedure Build_Credit_Record
285 ( Next_Transaction
: acc_Transaction_Record
) is
286 Dummy_Account
: constant integer := 100;
288 Next_Transaction
.ID
:= Current_ID
;
289 Next_Transaction
.Code
:= Credit
;
290 Next_Transaction
.Priority
:= Current_Priority
;
292 Next_Transaction
.Account_Number
:= Dummy_Account
;
293 Current_ID
:= Current_ID
+ 1;
294 end Build_Credit_Record
;
297 procedure Build_Debit_Record
298 ( Next_Transaction
: acc_Transaction_Record
) is
299 Dummy_Account
: constant integer := 200;
301 Next_Transaction
.ID
:= Current_ID
;
302 Next_Transaction
.Code
:= Debit
;
304 Next_Transaction
.Account_Number
:= Dummy_Account
;
305 Current_ID
:= Current_ID
+ 1;
306 end Build_Debit_Record
;
310 for Transaction_Numb
in TC_Trans_Range
loop -- TC: limit the loop
312 -- Create a task for the next message
313 Next_Message_Task
: acc_Message_Task
:= new Message_Task
;
314 -- Create a record for it
315 Next_Transaction
: acc_Transaction_Record
:=
316 new Transaction_Record
;
318 if Transaction_Numb
= TC_Trans_Range
'first then
319 -- Send the first Credit message
320 Build_Credit_Record
( Next_Transaction
);
321 Next_Message_Task
.Accept_Transaction
( Next_Transaction
);
322 -- TC: Wait until the first message has been received by the
323 -- Credit task and it has set the Overload indicator for the
325 while not TC_PO
.First_Message_Has_Arrived
loop
326 delay ImpDef
.Minimum_Task_Switch
;
328 elsif Transaction_Numb
= TC_Trans_Range
'last then
329 -- For this test send the last transaction to the Debit task
330 -- to improve the mix
331 Build_Debit_Record
( Next_Transaction
);
332 Next_Message_Task
.Accept_Transaction
( Next_Transaction
);
334 -- TC: Cycle generation of high medium and low priority
336 if Current_Priority
= High
then
337 Current_Priority
:= Medium
;
339 Current_Priority
= Medium
then
340 Current_Priority
:= Low
;
342 Current_Priority
:= High
;
344 Build_Credit_Record
( Next_Transaction
);
345 Next_Message_Task
.Accept_Transaction
( Next_Transaction
);
352 Report
.Failed
("Unexpected exception in Line_Driver");
358 task body Message_Task
is
360 TC_Original_Transaction_Code
: Transaction_Code
;
361 This_Transaction
: acc_Transaction_Record
:= new Transaction_Record
;
365 accept Accept_Transaction
(In_Transaction
: acc_Transaction_Record
) do
366 This_Transaction
.all := In_Transaction
.all;
367 end Accept_Transaction
;
369 -- Note the original code to ensure correct return
370 TC_Original_Transaction_Code
:= This_Transaction
.Code
;
372 -- Queue up on Distributor's Input queue
373 Distributor
.Input
( This_Transaction
);
374 -- This task will now wait for the requeued rendezvous
375 -- to complete before proceeding
377 -- After the required computations have been performed
378 -- return the Transaction_Record appropriately (probably to an output
382 -- For the test check that the return values are as expected
383 if TC_Original_Transaction_Code
/= This_Transaction
.Code
then
384 -- Incorrect rendezvous
385 Report
.Failed
("Message Task: Incorrect code returned");
388 if This_Transaction
.Code
= Credit
then
389 if This_Transaction
.Return_Value
/= Credit_Return
or
390 not This_Transaction
.TC_thru_Distrib
then
391 Report
.Failed
("Expected path not traversed - Credit");
393 TC_PO
.Increment_Tasks_Completed_Count
;
395 if This_Transaction
.Return_Value
/= Debit_Return
or
396 This_Transaction
.TC_Message_Count
/= 1 or
397 not This_Transaction
.TC_thru_Distrib
then
398 Report
.Failed
("Expected path not traversed - Debit");
400 TC_Debit_Message_Complete
:= true;
405 Report
.Failed
("Unexpected exception in Message_Task");
412 -- Computation task. After the computation is performed the rendezvous
413 -- in the original message task is completed.
414 task body Credit_Computation
is
416 Message_Count
: integer := 0;
421 accept Input
( Transaction
: acc_Transaction_Record
) do
423 -- Perform the computations required for this transaction
427 -- The following is all Test Control code:
429 if not Transaction
.TC_thru_Distrib
then
431 ("Credit Task: Wrong queue, Distributor bypassed");
434 if Transaction
.code
/= Credit
then
436 ("Credit Task: Requeue delivered to the wrong queue");
439 -- This is checked by the Message_Task:
440 Transaction
.Return_Value
:= Credit_Return
;
442 -- Now take special action depending on which Message.
443 -- Note: The count gives the order in which the messages are
444 -- arriving at this task NOT the order in which they
445 -- were originally generated and sent out.
447 Message_Count
:= Message_Count
+ 1;
449 if Message_Count
< 4 then
450 -- This is one of the first three messages which must
451 -- be High priority because we will set "Overload" after
452 -- the first, which is known to be High. The lower
453 -- priority should be waiting on the queues
454 if Transaction
.Priority
/= High
then
456 ("Credit Task: Lower priority trans. during overload");
458 if Message_Count
= 1 then
459 -- After the first message :
460 Distributor
.Set_Credit_Overloaded
;
461 -- Now flag the Line_Driver that the second and
462 -- subsequent messages may now be sent
463 TC_PO
.Set_First_Message_Has_Arrived
;
465 Message_Count
= 3 then
466 -- The two high priority transactions created
467 -- subsequent to the overload have now been processed,
468 -- release the Medium priority items
469 Distributor
.Clear_Overload_to_Medium
;
471 elsif Message_Count
< 6 then
472 -- This must be one of the Medium priority messages
473 if Transaction
.Priority
/= Medium
then
475 ("Credit Task: Second group not Medium Priority");
477 if Message_Count
= 5 then
478 -- The two medium priority transactions
479 -- have now been processed - release the
480 -- Low priority items
481 Distributor
.Clear_Overload_to_Low
;
483 elsif Message_Count
< TC_Trans_Range
'Last then
484 -- This must be one of the Low priority messages
485 if Transaction
.Priority
/= Low
then
487 ("Credit Task: Third group not Low Priority");
490 -- Too many transactions have arrived. Duplicates?
491 -- the Debit transaction?
493 ("Credit Task: Too many transactions");
502 Report
.Failed
("Unexpected exception in Credit_Computation");
503 end Credit_Computation
;
507 -- Computation task. After the computation is performed the rendezvous
508 -- in the original message task is completed.
510 task body Debit_Computation
is
511 Message_Count
: integer := 0;
515 accept Input
(Transaction
: acc_Transaction_Record
) do
516 -- Perform the computations required for this message
520 if not Transaction
.TC_thru_Distrib
then
522 ("Debit Task: Wrong queue, Distributor bypassed");
524 if Transaction
.code
/= Debit
then
526 ("Debit Task: Requeue delivered to the wrong queue");
529 -- for the test plug a known value and count
530 Transaction
.Return_Value
:= Debit_Return
;
531 -- one, and only one, message should pass through
532 Message_Count
:= Message_Count
+ 1;
533 Transaction
.TC_Message_Count
:= Message_Count
;
541 Report
.Failed
("Unexpected exception in Debit_Computation");
542 end Debit_Computation
;
549 end; -- declare (test encapsulation)
551 if (TC_PO
.Tasks_Completed_Count
/= TC_Credit_Messages_Expected
)
552 and not TC_Debit_Message_Complete
then
553 Report
.Failed
("Incorrect number of Message Tasks completed");