Dead
[official-gcc.git] / gomp-20050608-branch / gcc / testsuite / ada / acats / tests / c9 / c954015.a
blobc86e1078e798b46267da161a95ec76d641866cb1
1 -- C954015.A
2 --
3 -- Grant of Unlimited Rights
4 --
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
14 -- to do so.
16 -- DISCLAIMER
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.
24 --*
26 -- OBJECTIVE:
27 -- Check that requeued calls to task entries may, in turn, be requeued.
28 -- Check that the intermediate requeues are not blocked and that the
29 -- original caller remains blocked until the last requeue is complete.
30 -- This test uses:
31 -- Call with parameters
32 -- Requeue with abort
33 --
34 -- TEST DESCRIPTION
35 -- A call is placed on the input queue of the Distributor. The
36 -- Distributor requeues to the Credit task; the Credit task requeues to a
37 -- secondary task which, in turn requeues to yet another task. This
38 -- continues down the chain. At the furthest point of the chain the
39 -- rendezvous is completed. To verify the action, the furthest task
40 -- waits in the accept statement for a second message to arrive before
41 -- completing. This second message can only arrive if none of the earlier
42 -- tasks in the chain are blocked waiting for completion. Apart from
43 -- the two Credit messages which are used to check the requeue chain one
44 -- Debit message is sent to validate the mix.
46 --
47 -- This series of tests uses a simulation of a transaction driven
48 -- processing system. Line Drivers accept input from an external source
49 -- and build them into transaction records. These records are then
50 -- encapsulated in message tasks which remain extant for the life of the
51 -- transaction in the system. The message tasks put themselves on the
52 -- input queue of a Distributor which, from information in the
53 -- transaction and/or system load conditions forwards them to other
54 -- operating tasks. These in turn might forward the transactions to yet
55 -- other tasks for further action. The routing is, in real life, dynamic
56 -- and unpredictable at the time of message generation. All rerouting in
57 -- this model is done by means of requeues.
60 -- CHANGE HISTORY:
61 -- 06 Dec 94 SAIC ACVC 2.0
63 --!
66 with Report;
67 with ImpDef;
69 procedure C954015 is
71 -- Arbitrary test values
72 Credit_Return : constant := 1;
73 Debit_Return : constant := 2;
75 -- Mechanism to count the number of Credit Message tasks completed
76 protected TC_Tasks_Completed is
77 procedure Increment;
78 function Count return integer;
79 private
80 Number_Complete : integer := 0;
81 end TC_Tasks_Completed;
83 TC_Expected_To_Complete : constant integer := 3;
86 -- Values added to the Return_Value indicating passage through the
87 -- particular task
88 TC_Credit_Value : constant integer := 1;
89 TC_Sub_1_Value : constant integer := 2;
90 TC_Sub_2_Value : constant integer := 3;
91 TC_Sub_3_Value : constant integer := 4;
92 TC_Sub_4_Value : constant integer := 5;
94 TC_Full_Value : integer := TC_Credit_Value + TC_Sub_1_Value +
95 TC_Sub_2_Value + TC_Sub_3_Value +
96 TC_Sub_4_Value;
98 type Transaction_Code is (Credit, Debit);
100 type Transaction_Record;
101 type acc_Transaction_Record is access Transaction_Record;
102 type Transaction_Record is
103 record
104 ID : integer := 0;
105 Code : Transaction_Code := Debit;
106 Account_Number : integer := 0;
107 Stock_Number : integer := 0;
108 Quantity : integer := 0;
109 Return_Value : integer := 0;
110 TC_Message_Count : integer := 0;
111 TC_Thru_Distrib : Boolean := false;
112 end record;
115 task type Message_Task is
116 entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
117 end Message_Task;
118 type acc_Message_Task is access Message_Task;
120 task Line_Driver is
121 entry Start;
122 end Line_Driver;
124 task Distributor is
125 entry Input(Transaction : acc_Transaction_Record);
126 end Distributor;
128 task Credit_Computation is
129 entry Input(Transaction : acc_Transaction_Record);
130 end Credit_Computation;
132 task Debit_Computation is
133 entry Input(Transaction : acc_Transaction_Record);
134 end Debit_Computation;
136 -- The following are almost identical for the purpose of the test
137 task Credit_Sub_1 is
138 entry Input(Transaction : acc_Transaction_Record);
139 end Credit_Sub_1;
141 task Credit_Sub_2 is
142 entry Input(Transaction : acc_Transaction_Record);
143 end Credit_Sub_2;
145 task Credit_Sub_3 is
146 entry Input(Transaction : acc_Transaction_Record);
147 end Credit_Sub_3;
149 -- This is the last in the chain
150 task Credit_Sub_4 is
151 entry Input(Transaction : acc_Transaction_Record);
152 end Credit_Sub_4;
155 -- Mechanism to count the number of Message tasks completed (Credit)
156 protected body TC_Tasks_Completed is
157 procedure Increment is
158 begin
159 Number_Complete := Number_Complete + 1;
160 end Increment;
162 function Count return integer is
163 begin
164 return Number_Complete;
165 end Count;
166 end TC_Tasks_Completed;
170 -- Assemble messages received from an external source
171 -- Creates a message task for each. The message tasks remain extant
172 -- for the life of the messages in the system.
173 -- The Line Driver task would normally be designed to loop continuously
174 -- creating the messages as input is received. Simulate this
175 -- but limit it to the number of dummy messages needed for this
176 -- test and allow it to terminate at that point.
178 task body Line_Driver is
179 Current_ID : integer := 1;
180 TC_Last_was_for_credit : Boolean := false;
182 -- Arbitrary limit for the number of messages sent for this test
183 type TC_Trans_Range is range 1..3;
185 procedure Build_Credit_Record
186 ( Next_Transaction : acc_Transaction_Record ) is
187 Dummy_Account : constant integer := 100;
188 begin
189 Next_Transaction.ID := Current_ID;
190 Next_Transaction.Code := Credit;
191 Next_Transaction.Account_Number := Dummy_Account;
192 Current_ID := Current_ID + 1;
193 end Build_Credit_Record;
195 procedure Build_Debit_Record
196 ( Next_Transaction : acc_Transaction_Record ) is
197 Dummy_Account : constant integer := 200;
198 begin
199 Next_Transaction.ID := Current_ID;
200 Next_Transaction.Code := Debit;
201 Next_Transaction.Account_Number := Dummy_Account;
202 Current_ID := Current_ID + 1;
203 end Build_Debit_Record;
206 begin
208 accept Start; -- wait for trigger from Main
210 -- Arbitrarily limit the loop to the number needed for this test only
211 for Transaction_Numb in TC_Trans_Range loop
212 declare
213 -- Create a task for the next message
214 Next_Message_Task : acc_Message_Task := new Message_Task;
215 -- Create a record for it
216 Next_Transaction : acc_Transaction_Record :=
217 new Transaction_Record;
218 begin
219 -- Artificially send out in the order required
220 case Transaction_Numb is
221 when 1 =>
222 Build_Credit_Record( Next_Transaction );
223 when 2 =>
224 Build_Credit_Record( Next_Transaction );
225 when 3 =>
226 Build_Debit_Record ( Next_Transaction );
227 end case;
229 -- Present the record to the message task
230 Next_Message_Task.Accept_Transaction ( Next_Transaction );
231 end; -- declare
232 end loop;
234 exception
235 when others =>
236 Report.Failed ("Unexpected exception in Line_Driver");
237 end Line_Driver;
241 task body Message_Task is
243 TC_Original_Transaction_Code : Transaction_Code;
244 This_Transaction : acc_Transaction_Record := new Transaction_Record;
246 begin
248 accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
249 This_Transaction.all := In_Transaction.all;
250 end Accept_Transaction;
252 -- Note the original code to ensure correct return
253 TC_Original_Transaction_Code := This_Transaction.Code;
255 -- Queue up on Distributor's Input queue
256 Distributor.Input ( This_Transaction );
257 -- This task will now wait for the requeued rendezvous
258 -- to complete before proceeding
260 -- After the required computations have been performed
261 -- return the Transaction_Record appropriately (probably to an output
262 -- line driver)
263 null; -- stub
266 -- The following is all Test Control Code
268 -- Check that the return values are as expected
269 if TC_Original_Transaction_Code /= This_Transaction.Code then
270 -- Incorrect rendezvous
271 Report.Failed ("Message Task: Incorrect code returned");
272 end if;
274 if This_Transaction.Code = Credit then
275 if This_Transaction.Return_Value /= TC_Full_Value or not
276 This_Transaction.TC_Thru_Distrib then
277 Report.Failed ("Expected path not traversed - CR");
278 end if;
280 This_Transaction.TC_Message_Count not in 1..2 then
281 Report.Failed ("Incorrect Message Count");
282 end if;
283 else
284 if This_Transaction.Return_Value /= Debit_Return or
285 This_Transaction.TC_Message_Count /= 1 or not
286 This_Transaction.TC_Thru_Distrib then
287 Report.Failed ("Expected path not traversed - DB");
288 end if;
289 end if;
290 TC_Tasks_Completed.Increment;
291 exception
292 when others =>
293 Report.Failed ("Unexpected exception in Message_Task");
295 end Message_Task;
299 -- Dispose each input Transaction_Record to the appropriate
300 -- computation tasks
302 task body Distributor is
304 begin
305 loop
306 select
307 accept Input (Transaction : acc_Transaction_Record) do
308 -- Show that the message did pass through the Distributor Task
309 Transaction.TC_Thru_Distrib := true;
311 -- Pass this transaction on to the appropriate computation
312 -- task
313 case Transaction.Code is
314 when Credit =>
315 requeue Credit_Computation.Input with abort;
316 when Debit =>
317 requeue Debit_Computation.Input with abort;
318 end case;
319 end Input;
321 terminate;
322 end select;
323 end loop;
325 exception
326 when others =>
327 Report.Failed ("Unexpected exception in Distributor");
328 end Distributor;
333 -- Computation task.
334 -- Note: After the computation is performed in this task the message is
335 -- passed on for further processing to some subsidiary task. The choice
336 -- of subsidiary task is made according to criteria not specified in
337 -- this test.
339 task body Credit_Computation is
340 Message_Count : integer := 0;
341 begin
342 loop
343 select
344 accept Input ( Transaction : acc_Transaction_Record) do
345 -- Perform the computations required for this transaction
346 null; -- stub
348 -- For the test:
349 if not Transaction.TC_Thru_Distrib then
350 Report.Failed
351 ("Credit Task: Wrong queue, Distributor bypassed");
352 end if;
353 if Transaction.code /= Credit then
354 Report.Failed
355 ("Credit Task: Requeue delivered to the wrong queue");
356 end if;
358 -- for the test, plug a known value and count
359 Transaction.Return_Value := TC_Credit_Value;
360 Message_Count := Message_Count + 1;
361 Transaction.TC_Message_Count := Message_Count;
363 -- Depending on transaction content send it on to the
364 -- some other task for further processing
365 -- TC: Arbitrarily send the message on to Credit_Sub_1
366 requeue Credit_Sub_1.Input with abort;
367 end Input;
369 terminate;
370 end select;
371 end loop;
372 exception
373 when others =>
374 Report.Failed ("Unexpected exception in Credit_Computation");
375 end Credit_Computation;
379 task body Credit_Sub_1 is
380 begin
381 loop
382 select
383 accept Input(Transaction : acc_Transaction_Record) do
384 -- Process this transaction
385 null; -- stub
387 -- Add the value showing passage through this task
388 Transaction.Return_Value :=
389 Transaction.Return_Value + TC_Sub_1_Value;
390 -- Depending on transaction content send it on to the
391 -- some other task for further processing
392 -- Arbitrarily send the message on to Credit_Sub_2
393 requeue Credit_Sub_2.Input with abort;
394 end Input;
396 terminate;
397 end select;
398 end loop;
399 exception
400 when others =>
401 Report.Failed ("Unexpected exception in Credit_Sub_1");
403 end Credit_Sub_1;
405 task body Credit_Sub_2 is
406 begin
407 loop
408 select
409 accept Input(Transaction : acc_Transaction_Record) do
410 -- Process this transaction
411 null; -- stub
413 -- Add the value showing passage through this task
414 Transaction.Return_Value :=
415 Transaction.Return_Value + TC_Sub_2_Value;
416 -- Depending on transaction content send it on to the
417 -- some other task for further processing
418 -- Arbitrarily send the message on to Credit_Sub_3
419 requeue Credit_Sub_3.Input with abort;
420 end Input;
422 terminate;
423 end select;
424 end loop;
425 exception
426 when others =>
427 Report.Failed ("Unexpected exception in Credit_Sub_2");
428 end Credit_Sub_2;
430 task body Credit_Sub_3 is
431 begin
432 loop
433 select
434 accept Input(Transaction : acc_Transaction_Record) do
435 -- Process this transaction
436 null; -- stub
438 -- Add the value showing passage through this task
439 Transaction.Return_Value :=
440 Transaction.Return_Value + TC_Sub_3_Value;
441 -- Depending on transaction content send it on to the
442 -- some other task for further processing
443 -- Arbitrarily send the message on to Credit_Sub_4
444 requeue Credit_Sub_4.Input with abort;
445 end Input;
447 terminate;
448 end select;
449 end loop;
450 exception
451 when others =>
452 Report.Failed ("Unexpected exception in Credit_Sub_3");
453 end Credit_Sub_3;
455 -- This is the last in the chain of tasks to which transactions will
456 -- be requeued
458 task body Credit_Sub_4 is
460 TC_First_Message : Boolean := true;
462 begin
463 loop
464 select
465 accept Input(Transaction : acc_Transaction_Record) do
466 -- Process this transaction
467 null; -- stub
469 -- Add the value showing passage through this task
470 Transaction.Return_Value :=
471 Transaction.Return_Value + TC_Sub_4_Value;
472 -- TC: stay in the accept body dealing with the first message
473 -- until the second arrives. If any of the requeues are
474 -- blocked the test will hang here indicating failure
475 if TC_First_Message then
476 while Input'count = 0 loop
477 delay ImpDef.Minimum_Task_Switch;
478 end loop;
479 TC_First_Message := false;
480 end if;
481 -- for the second message, just complete the rendezvous
482 end Input;
484 terminate;
485 end select;
486 end loop;
487 exception
488 when others =>
489 Report.Failed ("Unexpected exception in Credit_Sub_4");
490 end Credit_Sub_4;
494 -- Computation task.
495 -- Note: After the computation is performed in this task and the
496 -- accept body is completed the rendezvous in the original
497 -- message task is completed.
499 task body Debit_Computation is
500 Message_Count : integer := 0;
501 begin
502 loop
503 select
504 accept Input (Transaction : acc_Transaction_Record) do
505 -- Perform the computations required for this message
506 null; -- stub
508 -- For the test:
509 if not Transaction.TC_Thru_Distrib then
510 Report.Failed
511 ("Debit Task: Wrong queue, Distributor bypassed");
512 end if;
513 if Transaction.code /= Debit then
514 Report.Failed
515 ("Debit Task: Requeue delivered to the wrong queue");
516 end if;
518 -- for the test plug a known value and count
519 Transaction.Return_Value := Debit_Return;
520 -- one, and only one, message should pass through
521 Message_Count := Message_Count + 1;
522 Transaction.TC_Message_Count := Message_Count;
523 end Input;
525 terminate;
526 end select;
527 end loop;
528 exception
529 when others =>
530 Report.Failed ("Unexpected exception in Debit_Computation");
533 end Debit_Computation;
536 begin
538 Report.Test ("C954015", "Test multiple levels of requeue to task entry");
540 Line_Driver.Start; -- Start the test
542 -- Ensure that the message tasks completed before calling Result
543 while (TC_Tasks_Completed.Count < TC_Expected_To_Complete) loop
544 delay ImpDef.Minimum_Task_Switch;
545 end loop;
547 Report.Result;
549 end C954015;