2003-12-26 Guilhem Lavaux <guilhem@kaffe.org>
[official-gcc.git] / gcc / testsuite / ada / acats / tests / c9 / c954014.a
blob53e45a090dd059721226162fc42678de775f5ddf
1 -- C954014.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 a requeue is not canceled and that the requeueing
28 -- task is unaffected when a calling task is aborted. Check that the
29 -- abort is deferred until the entry call is complete.
30 -- Specifically, check requeue to an entry in a different task,
31 -- requeue where the entry call has parameters, and requeue
32 -- without the abort option.
34 -- TEST DESCRIPTION
35 -- In the Driver create a task that places a call on the
36 -- Distributor. In the Distributor requeue this call on the Credit task.
37 -- Abort the calling task when it is known to be in rendezvous with the
38 -- Credit task. (We arrange this by using artificial synchronization
39 -- points in the Driver and the accept body of the Credit task) Ensure
40 -- that the abort is deferred (the task is not terminated) until the
41 -- accept body completes. Afterwards, send one extra message through
42 -- the Distributor to check that the requeueing task has not been
43 -- disrupted.
45 -- This series of tests uses a simulation of a transaction driven
46 -- processing system. Line Drivers accept input from an external source
47 -- and build them into transaction records. These records are then
48 -- encapsulated in message tasks which remain extant for the life of the
49 -- transaction in the system. The message tasks put themselves on the
50 -- input queue of a Distributor which, from information in the
51 -- transaction and/or system load conditions forwards them to other
52 -- operating tasks. These in turn might forward the transactions to yet
53 -- other tasks for further action. The routing is, in real life, dynamic
54 -- and unpredictable at the time of message generation. All rerouting in
55 -- this model is done by means of requeues.
58 -- CHANGE HISTORY:
59 -- 06 Dec 94 SAIC ACVC 2.0
60 -- 25 Nov 95 SAIC Replaced global variables with protected objects
61 -- for ACVC 2.0.1.
63 --!
65 with Report;
66 with ImpDef;
68 procedure C954014 is
70 -- Arbitrary test values
71 Credit_Return : constant := 1;
72 Debit_Return : constant := 2;
75 protected type Shared_Boolean (Initial_Value : Boolean := False) is
76 procedure Set_True;
77 procedure Set_False;
78 function Value return Boolean;
79 private
80 Current_Value : Boolean := Initial_Value;
81 end Shared_Boolean;
83 protected body Shared_Boolean is
84 procedure Set_True is
85 begin
86 Current_Value := True;
87 end Set_True;
89 procedure Set_False is
90 begin
91 Current_Value := False;
92 end Set_False;
94 function Value return Boolean is
95 begin
96 return Current_Value;
97 end Value;
98 end Shared_Boolean;
101 TC_Debit_Message_Complete : Shared_Boolean (False);
103 -- Synchronization flags for handshaking between the Line_Driver
104 -- and the Accept body in the Credit Task
105 TC_Handshake_A : Shared_Boolean (False);
106 TC_Handshake_B : Shared_Boolean (False);
107 TC_Handshake_C : Shared_Boolean (False);
108 TC_Handshake_D : Shared_Boolean (False);
109 TC_Handshake_E : Shared_Boolean (False);
110 TC_Handshake_F : Shared_Boolean (False);
113 type Transaction_Code is (Credit, Debit);
115 type Transaction_Record;
116 type acc_Transaction_Record is access Transaction_Record;
117 type Transaction_Record is
118 record
119 ID : integer := 0;
120 Code : Transaction_Code := Debit;
121 Account_Number : integer := 0;
122 Stock_Number : integer := 0;
123 Quantity : integer := 0;
124 Return_Value : integer := 0;
125 TC_Message_Count : integer := 0;
126 TC_Thru_Distrib : Boolean;
127 end record;
130 task type Message_Task is
131 entry Accept_Transaction (In_Transaction : acc_Transaction_Record);
132 end Message_Task;
133 type acc_Message_Task is access Message_Task;
135 task Line_Driver is
136 entry start;
137 end Line_Driver;
139 task Distributor is
140 entry Input(Transaction : acc_Transaction_Record);
141 end Distributor;
143 task Credit_Computation is
144 entry Input(Transaction : acc_Transaction_Record);
145 end Credit_Computation;
147 task Debit_Computation is
148 entry Input(Transaction : acc_Transaction_Record);
149 end Debit_Computation;
152 -- Assemble messages received from an external source
153 -- Creates a message task for each. The message tasks remain extant
154 -- for the life of the messages in the system.
155 -- TC: The Line Driver task would normally be designed to loop
156 -- continuously creating the messages as input is received. Simulate
157 -- this but limit it to two dummy messages for this test and use
158 -- special artificial handshaking checks with the Credit accept body
159 -- to control the test. Allow it to terminate at the end
161 task body Line_Driver is
162 Current_ID : integer := 1;
163 TC_First_message_sent: Boolean := false;
165 procedure Build_Credit_Record
166 ( Next_Transaction : acc_Transaction_Record ) is
167 Dummy_Account : constant integer := 100;
168 begin
169 Next_Transaction.ID := Current_ID;
170 Next_Transaction.Code := Credit;
172 Next_Transaction.Account_Number := Dummy_Account;
173 Current_ID := Current_ID + 1;
174 end Build_Credit_Record;
177 procedure Build_Debit_Record
178 ( Next_Transaction : acc_Transaction_Record ) is
179 Dummy_Account : constant integer := 200;
180 begin
181 Next_Transaction.ID := Current_ID;
182 Next_Transaction.Code := Debit;
184 Next_Transaction.Account_Number := Dummy_Account;
185 Current_ID := Current_ID + 1;
186 end Build_Debit_Record;
188 begin
190 accept Start; -- Wait for trigger from main
192 for i in 1..2 loop -- TC: arbitrarily limit to one credit message
193 -- and one debit, then complete
194 declare
195 -- Create a task for the next message
196 Next_Message_Task : acc_Message_Task := new Message_Task;
197 -- Create a record for it
198 Next_Transaction : acc_Transaction_Record :=
199 new Transaction_Record;
200 begin
201 if not TC_First_Message_Sent then
202 -- send out the first message which will be aborted
203 Build_Credit_Record ( Next_Transaction );
204 Next_Message_Task.Accept_Transaction ( Next_Transaction );
205 TC_First_Message_Sent := true;
207 -- Wait for Credit task to get into the accept body
208 -- The call from the Message Task has been requeued by
209 -- the distributor
210 while not TC_Handshake_A.Value loop
211 delay ImpDef.Minimum_Task_Switch;
212 end loop;
214 -- Abort the calling task; the Credit task is guaranteed to
215 -- be in the accept body
216 abort Next_Message_Task.all; -- We are still in this declare
217 -- block
219 -- Inform the Credit task that the abort has been initiated
220 TC_Handshake_B.Set_True;
222 -- Now wait for the "acknowledgment" from the Credit task
223 -- this ensures a complete task switch (at least)
224 while not TC_Handshake_C.Value loop
225 delay ImpDef.Minimum_Task_Switch;
226 end loop;
228 -- The aborted task must not terminate till the accept body
229 -- has completed
230 if Next_Message_Task'terminated then
231 Report.Failed ("The abort was not deferred");
232 end if;
234 -- Inform the Credit task that the termination has been checked
235 TC_Handshake_D.Set_True;
237 -- Now wait for the completion of the accept body in the
238 -- Credit task
239 while not TC_Handshake_E.Value loop
240 delay ImpDef.Minimum_Task_Switch;
241 end loop;
243 while not ( Next_Message_Task'terminated ) loop
244 delay ImpDef.Minimum_Task_Switch;
245 end loop;
247 -- Indicate to the Main program that this section is complete
248 TC_Handshake_F.Set_True;
250 else
251 -- The main part of the test is complete. Send one Debit message
252 -- as further exercise of the Distributor to ensure it has not
253 -- been affected by the abort of the requeue;
254 Build_Debit_Record ( Next_Transaction );
255 Next_Message_Task.Accept_Transaction ( Next_Transaction );
256 end if;
257 end; -- declare
258 end loop;
260 exception
261 when others =>
262 Report.Failed ("Unexpected exception in Line_Driver");
263 end Line_Driver;
267 task body Message_Task is
269 TC_Original_Transaction_Code : Transaction_Code;
270 This_Transaction : acc_Transaction_Record := new Transaction_Record;
272 begin
274 accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do
275 This_Transaction.all := In_Transaction.all;
276 end Accept_Transaction;
278 -- Note the original code to ensure correct return
279 TC_Original_Transaction_Code := This_Transaction.Code;
281 -- Queue up on Distributor's Input queue
282 Distributor.Input ( This_Transaction );
283 -- This task will now wait for the requeued rendezvous
284 -- to complete before proceeding
286 -- After the required computations have been performed
287 -- return the Transaction_Record appropriately (probably to an output
288 -- line driver)
289 null; -- stub
291 -- For the test check that the return values are as expected
292 if TC_Original_Transaction_Code /= This_Transaction.Code then
293 -- Incorrect rendezvous
294 Report.Failed ("Message Task: Incorrect code returned");
295 end if;
297 if This_Transaction.Code = Credit then
298 -- The only Credit message was the one that should have been aborted
299 Report.Failed ("Abort was not effective");
300 else
301 if This_Transaction.Return_Value /= Debit_Return or
302 This_Transaction.TC_Message_Count /= 1 or not
303 This_Transaction.TC_Thru_Distrib then
304 Report.Failed ("Expected path not traversed");
305 end if;
306 TC_Debit_Message_Complete.Set_True;
307 end if;
309 exception
310 when others =>
311 Report.Failed ("Unexpected exception in Message_Task");
313 end Message_Task;
317 -- Dispose each input Transaction_Record to the appropriate
318 -- computation tasks
320 task body Distributor is
322 begin
323 loop
324 select
325 accept Input (Transaction : acc_Transaction_Record) do
327 -- Indicate that the message did pass through the
328 -- Distributor Task
329 Transaction.TC_Thru_Distrib := true;
331 -- Pass this transaction on the appropriate computation
332 -- task
333 case Transaction.Code is
334 when Credit =>
335 requeue Credit_Computation.Input; -- without abort
336 when Debit =>
337 requeue Debit_Computation.Input; -- without abort
338 end case;
339 end Input;
341 terminate;
342 end select;
343 end loop;
345 exception
346 when others =>
347 Report.Failed ("Unexpected exception in Distributor");
348 end Distributor;
352 -- Computation task.
353 -- Note: After the computation is performed in this task and the
354 -- accept body is completed the rendezvous in the original
355 -- message task is completed.
356 task body Credit_Computation is
357 Message_Count : integer := 0;
358 begin
359 loop
360 select
361 accept Input ( Transaction : acc_Transaction_Record) do
362 -- Perform the computations required for this transaction
364 null; -- stub
366 -- The rest of this code is for Test Control
368 if not Transaction.TC_Thru_Distrib then
369 Report.Failed
370 ("Credit Task: Wrong queue, Distributor bypassed");
371 end if;
372 if Transaction.code /= Credit then
373 Report.Failed
374 ("Credit Task: Requeue delivered to the wrong queue");
375 end if;
377 -- for the test plug a known value and count
378 Transaction.Return_Value := Credit_Return;
379 -- one, and only one message should pass through
380 if Message_Count /= 0 then
381 Report.Failed ("Aborted Requeue was not canceled -1");
382 end if;
383 Message_Count := Message_Count + 1;
384 Transaction.TC_Message_Count := Message_Count;
386 -- Having done the basic housekeeping we now need to signal
387 -- that we are in the accept body of the credit task. The
388 -- message has arrived and the Line Driver may now abort the
389 -- calling task
390 TC_Handshake_A.Set_True;
392 -- Now wait for the Line Driver to inform us the calling
393 -- task has been aborted
394 while not TC_Handshake_B.Value loop
395 delay ImpDef.Minimum_Task_Switch;
396 end loop;
398 -- The abort has taken place
399 -- Inform the Line Driver that we are still running in the
400 -- accept body
401 TC_Handshake_C.Set_True;
403 -- Now wait for the Line Driver to digest this information
404 while not TC_Handshake_D.Value loop
405 delay ImpDef.Minimum_Task_Switch;
406 end loop;
408 -- The Line driver has checked that the caller is not terminated
409 -- We can now complete the accept
411 end Input;
412 -- We are out of the accept
413 TC_Handshake_E.Set_True;
416 terminate;
417 end select;
418 end loop;
419 exception
420 when others =>
421 Report.Failed ("Unexpected exception in Credit_Computation");
422 end Credit_Computation;
426 -- Computation task.
427 -- Note: After the computation is performed in this task and the
428 -- accept body is completed the rendezvous in the original
429 -- message task is completed.
430 task body Debit_Computation is
431 Message_Count : integer := 0;
432 begin
433 loop
434 select
435 accept Input (Transaction : acc_Transaction_Record) do
436 -- Perform the computations required for this message
438 null; -- stub
440 -- The rest of this code is for Test Control
442 if not Transaction.TC_Thru_Distrib then
443 Report.Failed
444 ("Debit Task: Wrong queue, Distributor bypassed");
445 end if;
446 if Transaction.code /= Debit then
447 Report.Failed
448 ("Debit Task: Requeue delivered to the wrong queue");
449 end if;
451 -- for the test plug a known value and count
452 Transaction.Return_Value := Debit_Return;
453 -- one, and only one, message should pass through
454 Message_Count := Message_Count + 1;
455 Transaction.TC_Message_Count := Message_Count;
456 end Input;
458 terminate;
459 end select;
460 end loop;
461 exception
462 when others =>
463 Report.Failed ("Unexpected exception in Debit_Computation");
466 end Debit_Computation;
469 begin -- c954014
470 Report.Test ("C954014", "Abort a task that has a call" &
471 " requeued_without_abort");
473 Line_Driver.Start; -- Start the test
475 -- Wait for the message tasks to complete before reporting the result
477 while not (TC_Handshake_F.Value -- abort not effective?
478 and TC_Debit_Message_Complete.Value -- Distributor affected?
479 and TC_Handshake_E.Value ) loop -- accept not completed?
480 delay ImpDef.Minimum_Task_Switch;
481 end loop;
483 Report.Result;
485 end C954014;