Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c9/c954013.a @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 -- C954013.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. | |
15 -- | |
16 -- DISCLAIMER | |
17 -- | |
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 --* | |
25 -- | |
26 -- OBJECTIVE: | |
27 -- Check that a requeue is cancelled and that the requeuing task is | |
28 -- unaffected when the calling task is aborted. | |
29 -- Specifically, check requeue to an entry in a different task, | |
30 -- requeue where the entry has parameters, and requeue with abort. | |
31 -- | |
32 -- TEST DESCRIPTION: | |
33 -- Abort a task that has a call requeued to the entry queue of another | |
34 -- task. We do this by sending two messages to the Distributor which | |
35 -- requeues them to the Credit task. In the accept body of the Credit | |
36 -- task we wait for the second message to arrive then check that an | |
37 -- abort of the second message task does result in the requeue being | |
38 -- removed. The Line Driver task which generates the messages and the | |
39 -- Credit task communicate artificially in this test to arrange for the | |
40 -- proper timing of the messages and the abort. One extra message is | |
41 -- sent to the Debit task to ensure that the Distributor is still viable | |
42 -- and has been unaffected by the abort. | |
43 -- | |
44 -- This series of tests uses a simulation of a transaction driven | |
45 -- processing system. Line Drivers accept input from an external source | |
46 -- and build them into transaction records. These records are then | |
47 -- encapsulated in message tasks which remain extant for the life of the | |
48 -- transaction in the system. The message tasks put themselves on the | |
49 -- input queue of a Distributor which, from information in the | |
50 -- transaction and/or system load conditions forwards them to other | |
51 -- operating tasks. These in turn might forward the transactions to yet | |
52 -- other tasks for further action. The routing is, in real life, dynamic | |
53 -- and unpredictable at the time of message generation. All rerouting in | |
54 -- this model is done by means of requeues. | |
55 -- | |
56 -- | |
57 -- CHANGE HISTORY: | |
58 -- 06 Dec 94 SAIC ACVC 2.0 | |
59 -- 25 Nov 95 SAIC Fixed shared global variable problems for | |
60 -- ACVC 2.0.1 | |
61 -- | |
62 --! | |
63 | |
64 with Report; | |
65 with ImpDef; | |
66 | |
67 procedure C954013 is | |
68 | |
69 | |
70 -- Arbitrary test values | |
71 Credit_Return : constant := 1; | |
72 Debit_Return : constant := 2; | |
73 | |
74 | |
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; | |
82 | |
83 protected body Shared_Boolean is | |
84 procedure Set_True is | |
85 begin | |
86 Current_Value := True; | |
87 end Set_True; | |
88 | |
89 procedure Set_False is | |
90 begin | |
91 Current_Value := False; | |
92 end Set_False; | |
93 | |
94 function Value return Boolean is | |
95 begin | |
96 return Current_Value; | |
97 end Value; | |
98 end Shared_Boolean; | |
99 | |
100 | |
101 TC_Debit_Message_Complete : Shared_Boolean (False); | |
102 TC_Credit_Message_Complete : Shared_Boolean (False); | |
103 | |
104 | |
105 type Transaction_Code is (Credit, Debit); | |
106 | |
107 type Transaction_Record; | |
108 type acc_Transaction_Record is access Transaction_Record; | |
109 type Transaction_Record is | |
110 record | |
111 ID : integer := 0; | |
112 Code : Transaction_Code := Debit; | |
113 Account_Number : integer := 0; | |
114 Stock_Number : integer := 0; | |
115 Quantity : integer := 0; | |
116 Return_Value : integer := 0; | |
117 TC_Message_Count : integer := 0; | |
118 TC_Thru_Dist : Boolean := false; | |
119 end record; | |
120 | |
121 | |
122 task type Message_Task is | |
123 entry Accept_Transaction (In_Transaction : acc_Transaction_Record); | |
124 end Message_Task; | |
125 type acc_Message_Task is access Message_Task; | |
126 | |
127 task Line_Driver is | |
128 entry Start; | |
129 end Line_Driver; | |
130 | |
131 task Distributor is | |
132 entry Input(Transaction : acc_Transaction_Record); | |
133 end Distributor; | |
134 | |
135 task Credit_Computation is | |
136 entry Input(Transaction : acc_Transaction_Record); | |
137 end Credit_Computation; | |
138 | |
139 task Debit_Computation is | |
140 entry Input(Transaction : acc_Transaction_Record); | |
141 end Debit_Computation; | |
142 | |
143 -- This protected object is here for Test Control purposes only | |
144 protected TC_Prt is | |
145 procedure Set_First_Has_Arrived; | |
146 procedure Set_Second_Has_Arrived; | |
147 procedure Set_Abort_Has_Completed; | |
148 function First_Has_Arrived return Boolean; | |
149 function Second_Has_Arrived return Boolean; | |
150 function Abort_Has_Completed return Boolean; | |
151 private | |
152 First_Flag, Second_Flag, Abort_Flag : Boolean := false; | |
153 end TC_Prt; | |
154 | |
155 protected body TC_Prt is | |
156 | |
157 Procedure Set_First_Has_Arrived is | |
158 begin | |
159 First_Flag := true; | |
160 end Set_First_Has_Arrived; | |
161 | |
162 Procedure Set_Second_Has_Arrived is | |
163 begin | |
164 Second_Flag := true; | |
165 end Set_Second_Has_Arrived; | |
166 | |
167 Procedure Set_Abort_Has_Completed is | |
168 begin | |
169 Abort_Flag := true; | |
170 end Set_Abort_Has_Completed; | |
171 | |
172 Function First_Has_Arrived return boolean is | |
173 begin | |
174 return First_Flag; | |
175 end First_Has_Arrived; | |
176 | |
177 Function Second_Has_Arrived return boolean is | |
178 begin | |
179 return Second_Flag; | |
180 end Second_has_Arrived; | |
181 | |
182 Function Abort_Has_Completed return boolean is | |
183 begin | |
184 return Abort_Flag; | |
185 end Abort_Has_Completed; | |
186 | |
187 end TC_PRT; | |
188 | |
189 -- Assemble messages received from an external source | |
190 -- Creates a message task for each. The message tasks remain extant | |
191 -- for the life of the messages in the system. | |
192 -- TC: The Line Driver task would normally be designed to loop | |
193 -- continuously creating the messages as input is received. Simulate | |
194 -- this but limit it to three dummy messages for this test and use | |
195 -- special artificial checks to pace the messages out under controlled | |
196 -- conditions for the test; allow it to terminate at the end | |
197 -- | |
198 task body Line_Driver is | |
199 Current_ID : integer := 1; | |
200 TC_First_message_sent: Boolean := false; | |
201 | |
202 procedure Build_Credit_Record | |
203 ( Next_Transaction : acc_Transaction_Record ) is | |
204 Dummy_Account : constant integer := 100; | |
205 begin | |
206 Next_Transaction.ID := Current_ID; | |
207 Next_Transaction.Code := Credit; | |
208 | |
209 Next_Transaction.Account_Number := Dummy_Account; | |
210 Current_ID := Current_ID + 1; | |
211 end Build_Credit_Record; | |
212 | |
213 | |
214 procedure Build_Debit_Record | |
215 ( Next_Transaction : acc_Transaction_Record ) is | |
216 Dummy_Account : constant integer := 200; | |
217 begin | |
218 Next_Transaction.ID := Current_ID; | |
219 Next_Transaction.Code := Debit; | |
220 | |
221 Next_Transaction.Account_Number := Dummy_Account; | |
222 Current_ID := Current_ID + 1; | |
223 end Build_Debit_Record; | |
224 | |
225 begin | |
226 | |
227 accept Start; -- Wait for trigger from main | |
228 | |
229 for i in 1..3 loop -- TC: arbitrarily limit to two credit messages | |
230 -- and one debit, then complete | |
231 declare | |
232 -- Create a task for the next message | |
233 Next_Message_Task : acc_Message_Task := new Message_Task; | |
234 -- Create a record for it | |
235 Next_Transaction : acc_Transaction_Record := | |
236 new Transaction_Record; | |
237 begin | |
238 if not TC_First_Message_Sent then | |
239 -- send out the first message to start up the Credit task | |
240 Build_Credit_Record ( Next_Transaction ); | |
241 Next_Message_Task.Accept_Transaction ( Next_Transaction ); | |
242 TC_First_Message_Sent := true; | |
243 elsif not TC_Prt.Abort_Has_Completed then | |
244 -- We have not yet processed the second message | |
245 -- Wait to send the second message until we know the first | |
246 -- has arrived at the Credit task and that task is in the | |
247 -- accept body | |
248 while not TC_Prt.First_Has_Arrived loop | |
249 delay ImpDef.Minimum_Task_Switch; | |
250 end loop; | |
251 | |
252 -- We can now send the second message | |
253 Build_Credit_Record( Next_Transaction ); | |
254 Next_Message_Task.Accept_Transaction ( Next_Transaction ); | |
255 | |
256 -- Now wait for the second to arrive on the Credit input queue | |
257 while not TC_Prt.Second_Has_Arrived loop | |
258 delay ImpDef.Minimum_Task_Switch; | |
259 end loop; | |
260 | |
261 -- At this point: The Credit task is in the accept block | |
262 -- dealing with the first message and the second message is | |
263 -- is on the input queue | |
264 abort Next_Message_Task.all; -- Note: we are still in the | |
265 -- declare block for the | |
266 -- second message task | |
267 | |
268 -- Make absolutely certain that all the actions | |
269 -- associated with the abort have been completed, that the | |
270 -- task has gone from Abnormal right through to | |
271 -- Termination. All requeues that are to going to be | |
272 -- cancelled will have been by the point of Termination. | |
273 while not Next_Message_Task.all'terminated loop | |
274 delay ImpDef.Minimum_Task_Switch; | |
275 end loop; | |
276 | |
277 | |
278 -- We now signal the Credit task that the abort has taken place | |
279 -- so that it can check that the entry queue is empty as the | |
280 -- requeue should have been cancelled | |
281 TC_Prt.Set_Abort_Has_Completed; | |
282 else | |
283 -- The main part of the test is complete. Send one Debit message | |
284 -- as further exercise of the Distributor to ensure it has not | |
285 -- been affected by the cancellation of the requeue. | |
286 Build_Debit_Record ( Next_Transaction ); | |
287 Next_Message_Task.Accept_Transaction ( Next_Transaction ); | |
288 end if; | |
289 end; -- declare | |
290 end loop; | |
291 | |
292 exception | |
293 when others => | |
294 Report.Failed ("Unexpected exception in Line_Driver"); | |
295 end Line_Driver; | |
296 | |
297 | |
298 | |
299 | |
300 task body Message_Task is | |
301 | |
302 TC_Original_Transaction_Code : Transaction_Code; | |
303 This_Transaction : acc_Transaction_Record := new Transaction_Record; | |
304 | |
305 begin | |
306 | |
307 accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do | |
308 This_Transaction.all := In_Transaction.all; | |
309 end Accept_Transaction; | |
310 | |
311 -- Note the original code to ensure correct return | |
312 TC_Original_Transaction_Code := This_Transaction.Code; | |
313 | |
314 -- Queue up on Distributor's Input queue | |
315 Distributor.Input ( This_Transaction ); | |
316 -- This task will now wait for the requeued rendezvous | |
317 -- to complete before proceeding | |
318 | |
319 -- After the required computations have been performed | |
320 -- return the Transaction_Record appropriately (probably to an output | |
321 -- line driver) | |
322 null; -- stub | |
323 | |
324 -- For the test check that the return values are as expected | |
325 if TC_Original_Transaction_Code /= This_Transaction.Code then | |
326 -- Incorrect rendezvous | |
327 Report.Failed ("Message Task: Incorrect code returned"); | |
328 end if; | |
329 | |
330 if This_Transaction.Code = Credit then | |
331 if This_Transaction.Return_Value /= Credit_Return or | |
332 This_Transaction.TC_Message_Count /= 1 or not | |
333 This_Transaction.TC_Thru_Dist then | |
334 Report.Failed ("Expected path not traversed"); | |
335 end if; | |
336 TC_Credit_Message_Complete.Set_True; | |
337 else | |
338 if This_Transaction.Return_Value /= Debit_Return or | |
339 This_Transaction.TC_Message_Count /= 1 or not | |
340 This_Transaction.TC_Thru_Dist then | |
341 Report.Failed ("Expected path not traversed"); | |
342 end if; | |
343 TC_Debit_Message_Complete.Set_True; | |
344 end if; | |
345 | |
346 exception | |
347 when others => | |
348 Report.Failed ("Unexpected exception in Message_Task"); | |
349 | |
350 end Message_Task; | |
351 | |
352 | |
353 | |
354 -- Dispose each input Transaction_Record to the appropriate | |
355 -- computation tasks | |
356 -- | |
357 task body Distributor is | |
358 | |
359 begin | |
360 loop | |
361 select | |
362 accept Input (Transaction : acc_Transaction_Record) do | |
363 -- Show that this message did pass through the Distributor Task | |
364 Transaction.TC_Thru_Dist := true; | |
365 | |
366 -- Pass this transaction on the appropriate computation | |
367 -- task | |
368 case Transaction.Code is | |
369 when Credit => | |
370 requeue Credit_Computation.Input with abort; | |
371 when Debit => | |
372 requeue Debit_Computation.Input with abort; | |
373 end case; | |
374 end Input; | |
375 or | |
376 terminate; | |
377 end select; | |
378 end loop; | |
379 | |
380 exception | |
381 when others => | |
382 Report.Failed ("Unexpected exception in Distributor"); | |
383 end Distributor; | |
384 | |
385 | |
386 | |
387 -- Computation task. | |
388 -- Note: After the computation is performed in this task and the | |
389 -- accept body is completed the rendezvous in the original | |
390 -- message task is completed. | |
391 task body Credit_Computation is | |
392 Message_Count : integer := 0; | |
393 begin | |
394 loop | |
395 select | |
396 accept Input ( Transaction : acc_Transaction_Record) do | |
397 -- Perform the computations required for this transaction | |
398 -- | |
399 null; -- stub | |
400 | |
401 -- The rest of this code is for Test Control | |
402 -- | |
403 if not Transaction.TC_Thru_Dist then | |
404 Report.Failed | |
405 ("Credit Task: Wrong queue, Distributor bypassed"); | |
406 end if; | |
407 if Transaction.code /= Credit then | |
408 Report.Failed | |
409 ("Credit Task: Requeue delivered to the wrong queue"); | |
410 end if; | |
411 | |
412 -- for the test plug a known value and count | |
413 Transaction.Return_Value := Credit_Return; | |
414 -- one, and only one message should pass through | |
415 if Message_Count /= 0 then | |
416 Report.Failed ("Aborted Requeue was not cancelled -1"); | |
417 end if; | |
418 Message_Count := Message_Count + 1; | |
419 Transaction.TC_Message_Count := Message_Count; | |
420 | |
421 | |
422 -- Having done the basic housekeeping we now need to signal | |
423 -- that we are in the accept body of the credit task. The | |
424 -- first message has arrived and the Line Driver may now send | |
425 -- the second one | |
426 TC_Prt.Set_First_Has_Arrived; | |
427 | |
428 -- Now wait for the second to arrive | |
429 | |
430 while Input'Count = 0 loop | |
431 delay ImpDef.Minimum_Task_Switch; | |
432 end loop; | |
433 -- Second message has been requeued - the Line driver may | |
434 -- now abort the calling task | |
435 TC_Prt.Set_Second_Has_Arrived; | |
436 | |
437 -- Now wait for the Line Driver to signal that the abort of | |
438 -- the first task is complete - the requeue should be cancelled | |
439 -- at this time | |
440 while not TC_Prt.Abort_Has_Completed loop | |
441 delay ImpDef.Minimum_Task_Switch; | |
442 end loop; | |
443 | |
444 if Input'Count /=0 then | |
445 Report.Failed ("Aborted Requeue was not cancelled -2"); | |
446 end if; | |
447 -- We can now complete the rendezvous with the first caller | |
448 end Input; | |
449 or | |
450 terminate; | |
451 end select; | |
452 end loop; | |
453 exception | |
454 when others => | |
455 Report.Failed ("Unexpected exception in Credit_Computation"); | |
456 end Credit_Computation; | |
457 | |
458 | |
459 | |
460 -- Computation task. | |
461 -- Note: After the computation is performed in this task and the | |
462 -- accept body is completed the rendezvous in the original | |
463 -- message task is completed. | |
464 task body Debit_Computation is | |
465 Message_Count : integer := 0; | |
466 begin | |
467 loop | |
468 select | |
469 accept Input (Transaction : acc_Transaction_Record) do | |
470 -- Perform the computations required for this message | |
471 -- | |
472 null; -- stub | |
473 | |
474 -- The rest of this code is for Test Control | |
475 -- | |
476 if not Transaction.TC_Thru_Dist then | |
477 Report.Failed | |
478 ("Debit Task: Wrong queue, Distributor bypassed"); | |
479 end if; | |
480 if Transaction.code /= Debit then | |
481 Report.Failed | |
482 ("Debit Task: Requeue delivered to the wrong queue"); | |
483 end if; | |
484 | |
485 -- for the test plug a known value and count | |
486 Transaction.Return_Value := Debit_Return; | |
487 -- one, and only one, message should pass through | |
488 Message_Count := Message_Count + 1; | |
489 Transaction.TC_Message_Count := Message_Count; | |
490 end Input; | |
491 or | |
492 terminate; | |
493 end select; | |
494 end loop; | |
495 exception | |
496 when others => | |
497 Report.Failed ("Unexpected exception in Debit_Computation"); | |
498 | |
499 | |
500 end Debit_Computation; | |
501 | |
502 | |
503 begin -- c954013 | |
504 | |
505 Report.Test ("C954013", "Abort a task that has a call requeued"); | |
506 | |
507 Line_Driver.Start; -- start the test | |
508 | |
509 -- Wait for the message tasks to complete before calling Report.Result. | |
510 -- Although two Credit tasks are generated one is aborted so only | |
511 -- one completes, thus a single flag is sufficient | |
512 -- Note: the test will hang here if there is a problem with the | |
513 -- completion of the tasks | |
514 while not (TC_Credit_Message_Complete.Value and | |
515 TC_Debit_Message_Complete.Value) loop | |
516 delay ImpDef.Minimum_Task_Switch; | |
517 end loop; | |
518 | |
519 Report.Result; | |
520 | |
521 end C954013; |