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 call to a protected entry can be requeued to a task
28 -- entry. Check that the requeue is placed on the correct entry; that the
29 -- original caller waits for the completion of the requeue and continues
30 -- after the requeued rendezvous. Check that the requeue does not block.
31 -- Specifically, check a requeue without abort from a protected entry to
32 -- an entry in a task.
35 -- In the Distributor protected object, requeue two successive calls on
36 -- the entries of two separate target tasks. Each task in each of the
37 -- paths adds identifying information in the transaction being passed.
38 -- This information is checked by the Message tasks on completion
39 -- ensuring that the requeues have been placed on the correct queues.
40 -- There is an artificial guard on the Credit Task to ensure that the
41 -- input is queued; this guard is released by the Debit task which
42 -- handles its input immediately. This ensures that we have one of the
43 -- requeued items actually queued for later handling and also verifies
44 -- that the requeuing process (in the protected object) is not blocked.
46 -- This series of tests uses a simulation of a transaction driven
47 -- processing system. Line Drivers accept input from an external source
48 -- and build them into transaction records. These records are then
49 -- encapsulated in message tasks which remain extant for the life of the
50 -- transaction in the system. The message tasks put themselves on the
51 -- input queue of a Distributor object which, from information in the
52 -- transaction and/or system load conditions forwards them to other
53 -- operating tasks. These in turn might forward the transactions to yet
54 -- other tasks for further action. The routing is, in real life,
55 -- dynamic and unpredictable at the time of message generation. All
56 -- rerouting in this model is done by means of requeues.
60 -- 06 Dec 94 SAIC ACVC 2.0
61 -- 08 Nov 95 SAIC Fixed reported problems for ACVC 2.0.1
72 Report
.Test
("C954024", "Requeue from protected entry to task entry");
74 declare -- encapsulate the test
76 -- Arbitrary test values
77 Credit_Return
: constant := 1;
78 Debit_Return
: constant := 2;
80 type Transaction_Code
is (Credit
, Debit
);
82 type Transaction_Record
;
83 type acc_Transaction_Record
is access Transaction_Record
;
84 type Transaction_Record
is
87 Code
: Transaction_Code
:= Debit
;
88 Account_Number
: integer := 0;
89 Stock_Number
: integer := 0;
90 Quantity
: integer := 0;
91 Return_Value
: integer := 0;
92 TC_Message_Count
: integer := 0;
93 TC_Thru_Dist
: Boolean := false;
97 task type Message_Task
is
98 entry Accept_Transaction
(In_Transaction
: acc_Transaction_Record
);
100 type acc_Message_Task
is access Message_Task
;
106 task Credit_Computation
is
107 entry Input
(Transaction
: acc_Transaction_Record
);
108 end Credit_Computation
;
110 task Debit_Computation
is
111 entry Input
(Transaction
: acc_Transaction_Record
);
112 end Debit_Computation
;
114 protected Time_Lock
is
115 procedure Credit_Start
;
116 function Credit_Enabled
return Boolean;
118 Credit_OK
: Boolean := false;
121 protected body Time_Lock
is
122 procedure Credit_Start
is
127 function Credit_Enabled
return Boolean is
135 protected Distributor
is
136 entry Input
(Transaction
: acc_Transaction_Record
);
140 -- Dispose each input Transaction_Record to the appropriate
143 protected body Distributor
is
144 entry Input
(Transaction
: acc_Transaction_Record
) when true is
145 -- barrier is always open
147 -- Test Control: Set the indicator in the message to show it has
148 -- passed through the Distributor object
149 Transaction
.TC_thru_Dist
:= true;
151 -- Pass this transaction on to the appropriate computation
153 case Transaction
.Code
is
155 requeue Credit_Computation
.Input
;
157 requeue Debit_Computation
.Input
;
165 -- Assemble messages received from an external source
166 -- Creates a message task for each. The message tasks remain extant
167 -- for the life of the messages in the system.
169 -- The Line Driver task would normally be designed to loop continuously
170 -- creating the messages as input is received. Simulate this
171 -- but limit it to two dummy messages for this test and allow it
172 -- to terminate at that point
174 task body Line_Driver
is
175 Current_ID
: integer := 1;
176 TC_Last_was_for_credit
: Boolean := false;
178 procedure Build_Credit_Record
179 ( Next_Transaction
: acc_Transaction_Record
) is
180 Dummy_Account
: constant integer := 100;
182 Next_Transaction
.ID
:= Current_ID
;
183 Next_Transaction
.Code
:= Credit
;
185 Next_Transaction
.Account_Number
:= Dummy_Account
;
186 Current_ID
:= Current_ID
+ 1;
187 end Build_Credit_Record
;
190 procedure Build_Debit_Record
191 ( Next_Transaction
: acc_Transaction_Record
) is
192 Dummy_Account
: constant integer := 200;
194 Next_Transaction
.ID
:= Current_ID
;
195 Next_Transaction
.Code
:= Debit
;
197 Next_Transaction
.Account_Number
:= Dummy_Account
;
198 Current_ID
:= Current_ID
+ 1;
199 end Build_Debit_Record
;
203 accept Start
; -- Wait for trigger from Main
205 for i
in 1..2 loop -- arbitrarily limit to two messages for the test
207 -- Create a task for the next message
208 Next_Message_Task
: acc_Message_Task
:= new Message_Task
;
209 -- Create a record for it
210 Next_Transaction
: acc_Transaction_Record
211 := new Transaction_Record
;
213 if TC_Last_was_for_credit
then
214 Build_Debit_Record
( Next_Transaction
);
216 Build_Credit_Record
( Next_Transaction
);
217 TC_Last_was_for_credit
:= true;
219 Next_Message_Task
.Accept_Transaction
( Next_Transaction
);
225 Report
.Failed
("Unexpected exception in Line_Driver");
231 task body Message_Task
is
233 TC_Original_Transaction_Code
: Transaction_Code
;
234 This_Transaction
: acc_Transaction_Record
:= new Transaction_Record
;
237 accept Accept_Transaction
238 (In_Transaction
: acc_Transaction_Record
) do
239 This_Transaction
.all := In_Transaction
.all;
240 end Accept_Transaction
;
242 -- Note the original code to ensure correct return
243 TC_Original_Transaction_Code
:= This_Transaction
.Code
;
245 -- Queue up on Distributor's Input queue
246 Distributor
.Input
( This_Transaction
);
247 -- This task will now wait for the requeued rendezvous
248 -- to complete before proceeding
250 -- After the required computations have been performed
251 -- return the Transaction_Record appropriately (probably to an output
256 -- The following is all Test Control Code
258 -- Check that the return values are as expected
259 if TC_Original_Transaction_Code
/= This_Transaction
.Code
then
260 -- Incorrect rendezvous
261 Report
.Failed
("Message Task: Incorrect code returned");
264 if This_Transaction
.Code
= Credit
then
265 if This_Transaction
.Return_Value
/= Credit_Return
or
266 This_Transaction
.TC_Message_Count
/= 1 or
267 not This_Transaction
.TC_thru_Dist
then
268 Report
.Failed
("Expected path not traversed");
271 if This_Transaction
.Return_Value
/= Debit_Return
or
272 This_Transaction
.TC_Message_Count
/= 1 or
273 not This_Transaction
.TC_thru_Dist
then
274 Report
.Failed
("Expected path not traversed");
280 Report
.Failed
("Unexpected exception in Message_Task");
287 -- Note: After the computation is performed in this task and the
288 -- accept body is completed the rendezvous in the original
289 -- message task is completed.
291 task body Credit_Computation
is
292 Message_Count
: integer := 0;
296 when Time_Lock
.Credit_enabled
=>
297 accept Input
( Transaction
: acc_Transaction_Record
) do
298 -- Perform the computations required for this transaction
302 if not Transaction
.TC_thru_Dist
then
304 ("Credit Task: Wrong queue, Distributor bypassed");
306 if Transaction
.code
/= Credit
then
308 ("Credit Task: Requeue delivered to the wrong queue");
311 -- for the test plug a known value and count
312 Transaction
.Return_Value
:= Credit_Return
;
313 -- one, and only one message should pass through
314 Message_Count
:= Message_Count
+ 1;
315 Transaction
.TC_Message_Count
:= Message_Count
;
317 exit; -- one message is enough
319 delay ImpDef
.Clear_Ready_Queue
; -- poll
324 Report
.Failed
("Unexpected exception in Credit_Computation");
325 end Credit_Computation
;
330 -- Note: After the computation is performed in this task and the
331 -- accept body is completed the rendezvous in the original
332 -- message task is completed.
334 task body Debit_Computation
is
335 Message_Count
: integer := 0;
339 accept Input
(Transaction
: acc_Transaction_Record
) do
340 -- Perform the computations required for this message
344 if not Transaction
.TC_thru_Dist
then
346 ("Debit Task: Wrong queue, Distributor bypassed");
348 if Transaction
.code
/= Debit
then
350 ("Debit Task: Requeue delivered to the wrong queue");
353 -- for the test plug a known value and count
354 Transaction
.Return_Value
:= Debit_Return
;
355 -- one, and only one, message should pass through
356 Message_Count
:= Message_Count
+ 1;
357 Transaction
.TC_Message_Count
:= Message_Count
;
358 -- for the test: once we have completed the only Debit
359 -- message release the Credit Messages which are queued
360 -- on the Credit Input queue
361 Time_Lock
.Credit_Start
;
370 Report
.Failed
("Unexpected exception in Debit_Computation");
372 end Debit_Computation
;
374 begin -- declare block
376 end; -- test encapsulation