Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c9/c954012.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 -- C954012.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 a requeue within an accept body to another entry in the same task | |
28 -- Specifically, check a call with parameters and a requeue with abort. | |
29 -- | |
30 -- TEST DESCRIPTION: | |
31 -- One transaction is sent through to check the paths. After | |
32 -- processing this the Credit task sets the "overloaded" indicator. Once | |
33 -- this indicator is set the Distributor queues low priority transactions | |
34 -- on a Wait_for_Underload queue in the same task using a requeue. The | |
35 -- Distributor still delivers high priority transactions. After two high | |
36 -- priority transactions have been processed by the Credit task it clears | |
37 -- the overload condition. The low priority transactions should now be | |
38 -- delivered. | |
39 -- | |
40 -- This series of tests uses a simulation of a transaction driven | |
41 -- processing system. Line Drivers accept input from an external source | |
42 -- and build them into transaction records. These records are then | |
43 -- encapsulated in message tasks which remain extant for the life of the | |
44 -- transaction in the system. The message tasks put themselves on the | |
45 -- input queue of a Distributor which, from information in the | |
46 -- transaction and/or system load conditions forwards them to other | |
47 -- operating tasks. These in turn might forward the transactions to yet | |
48 -- other tasks for further action. The routing is, in real life, dynamic | |
49 -- and unpredictable at the time of message generation. All rerouting in | |
50 -- this model is done by means of requeues. | |
51 -- | |
52 -- | |
53 -- CHANGE HISTORY: | |
54 -- 06 Dec 94 SAIC ACVC 2.0 | |
55 -- 25 Nov 95 SAIC Fixed shared global variable problem for | |
56 -- ACVC 2.0.1 | |
57 -- 14 Mar 03 RLB Fixed a race condition and an incorrect termination | |
58 -- condition in the test. | |
59 --! | |
60 | |
61 with Report; | |
62 with ImpDef; | |
63 with Ada.Calendar; | |
64 | |
65 procedure C954012 is | |
66 | |
67 function "=" (X,Y: Ada.Calendar.Time) return Boolean | |
68 renames Ada.Calendar."="; | |
69 | |
70 -- Arbitrary test values | |
71 Credit_Return : constant := 1; | |
72 Debit_Return : constant := 2; | |
73 | |
74 | |
75 -- This is used as an "initializing" time for the messages as they are | |
76 -- created. As they pass through the Distributor they get a time_stamp | |
77 -- of the current time. An arbitrary base time is chosen. | |
78 -- TC: this fact is used, incidentally, to check that the messages have, | |
79 -- indeed, passed through the Distributor as expected. | |
80 -- | |
81 Base_Time : Ada.Calendar.Time := Ada.Calendar.Time_of(1959,3,9); | |
82 | |
83 | |
84 -- Mechanism to count the number of Credit Message tasks completed | |
85 protected TC_Tasks_Completed is | |
86 procedure Increment; | |
87 function Count return integer; | |
88 private | |
89 Number_Complete : integer := 0; | |
90 end TC_Tasks_Completed; | |
91 | |
92 protected type Shared_Boolean (Initial_Value : Boolean := False) is | |
93 procedure Set_True; | |
94 procedure Set_False; | |
95 function Value return Boolean; | |
96 private | |
97 Current_Value : Boolean := Initial_Value; | |
98 end Shared_Boolean; | |
99 | |
100 protected body Shared_Boolean is | |
101 procedure Set_True is | |
102 begin | |
103 Current_Value := True; | |
104 end Set_True; | |
105 | |
106 procedure Set_False is | |
107 begin | |
108 Current_Value := False; | |
109 end Set_False; | |
110 | |
111 function Value return Boolean is | |
112 begin | |
113 return Current_Value; | |
114 end Value; | |
115 end Shared_Boolean; | |
116 | |
117 TC_Debit_Message_Complete : Shared_Boolean (False); | |
118 -- Handshaking mechanism between the Line Driver and the Credit task | |
119 TC_First_Message_Has_Arrived : Shared_Boolean (False); | |
120 Credit_Overloaded : Shared_Boolean (False); | |
121 | |
122 TC_Credit_Messages_Expected : constant integer := 5; | |
123 | |
124 type Transaction_Code is (Credit, Debit); | |
125 type Transaction_Priority is (High, Low); | |
126 | |
127 type Transaction_Record; | |
128 type acc_Transaction_Record is access Transaction_Record; | |
129 type Transaction_Record is | |
130 record | |
131 ID : integer := 0; | |
132 Code : Transaction_Code := Debit; | |
133 Priority : Transaction_Priority := High; | |
134 Account_Number : integer := 0; | |
135 Stock_Number : integer := 0; | |
136 Quantity : integer := 0; | |
137 Return_Value : integer := 0; | |
138 Message_Count : integer := 0; -- for test | |
139 Time_Stamp : Ada.Calendar.Time := Base_Time; | |
140 end record; | |
141 | |
142 | |
143 task type Message_Task is | |
144 entry Accept_Transaction (In_Transaction : acc_Transaction_Record); | |
145 end Message_Task; | |
146 type acc_Message_Task is access Message_Task; | |
147 | |
148 task Line_Driver is | |
149 entry Start; | |
150 end Line_Driver; | |
151 | |
152 task Distributor is | |
153 entry Input (Transaction : acc_Transaction_Record); | |
154 entry Wait_for_Underload (Transaction : acc_Transaction_Record); | |
155 entry TC_Credit_OK; | |
156 end Distributor; | |
157 | |
158 task Credit_Computation is | |
159 entry Input(Transaction : acc_Transaction_Record); | |
160 end Credit_Computation; | |
161 | |
162 task Debit_Computation is | |
163 entry Input(Transaction : acc_Transaction_Record); | |
164 end Debit_Computation; | |
165 | |
166 | |
167 -- Mechanism to count the number of Message tasks completed (Credit) | |
168 protected body TC_Tasks_Completed is | |
169 procedure Increment is | |
170 begin | |
171 Number_Complete := Number_Complete + 1; | |
172 end Increment; | |
173 | |
174 function Count return integer is | |
175 begin | |
176 return Number_Complete; | |
177 end Count; | |
178 end TC_Tasks_Completed; | |
179 | |
180 | |
181 -- Assemble messages received from an external source | |
182 -- Creates a message task for each. The message tasks remain extant | |
183 -- for the life of the messages in the system. | |
184 -- The Line Driver task would normally be designed to loop continuously | |
185 -- creating the messages as input is received. Simulate this | |
186 -- but limit it to the required number of dummy messages needed for | |
187 -- this test and allow it to terminate at that point. Artificially | |
188 -- alternate High and Low priority Credit transactions for this test. | |
189 -- | |
190 task body Line_Driver is | |
191 Current_ID : integer := 1; | |
192 Current_Priority : Transaction_Priority := High; | |
193 | |
194 -- Artificial: number of messages required for this test | |
195 type TC_Trans_Range is range 1..6; | |
196 | |
197 procedure Build_Credit_Record | |
198 ( Next_Transaction : acc_Transaction_Record ) is | |
199 Dummy_Account : constant integer := 100; | |
200 begin | |
201 Next_Transaction.ID := Current_ID; | |
202 Next_Transaction.Code := Credit; | |
203 Next_Transaction.Priority := Current_Priority; | |
204 | |
205 Next_Transaction.Account_Number := Dummy_Account; | |
206 Current_ID := Current_ID + 1; | |
207 end Build_Credit_Record; | |
208 | |
209 | |
210 procedure Build_Debit_Record | |
211 ( Next_Transaction : acc_Transaction_Record ) is | |
212 Dummy_Account : constant integer := 200; | |
213 begin | |
214 Next_Transaction.ID := Current_ID; | |
215 Next_Transaction.Code := Debit; | |
216 | |
217 Next_Transaction.Account_Number := Dummy_Account; | |
218 Current_ID := Current_ID + 1; | |
219 end Build_Debit_Record; | |
220 | |
221 begin | |
222 | |
223 accept Start; -- Wait for trigger from Main | |
224 | |
225 for Transaction_Numb in TC_Trans_Range loop -- TC: limit the loop | |
226 declare | |
227 -- Create a task for the next message | |
228 Next_Message_Task : acc_Message_Task := new Message_Task; | |
229 -- Create a record for it | |
230 Next_Transaction : acc_Transaction_Record | |
231 := new Transaction_Record; | |
232 begin | |
233 if Transaction_Numb = TC_Trans_Range'first then | |
234 -- Send the first Credit message | |
235 Build_Credit_Record ( Next_Transaction ); | |
236 Next_Message_Task.Accept_Transaction ( Next_Transaction ); | |
237 -- TC: Wait until the first message has been received by the | |
238 -- Credit task and it has set the Overload indicator for the | |
239 -- Distributor | |
240 while not TC_First_Message_Has_Arrived.Value loop | |
241 delay ImpDef.Minimum_Task_Switch; | |
242 end loop; | |
243 elsif Transaction_Numb = TC_Trans_Range'last then | |
244 -- For this test send the last transaction to the Debit task | |
245 -- to improve the mix | |
246 Build_Debit_Record( Next_Transaction ); | |
247 Next_Message_Task.Accept_Transaction ( Next_Transaction ); | |
248 else | |
249 -- TC: Alternate high and low priority transactions | |
250 if Current_Priority = High then | |
251 Current_Priority := Low; | |
252 else | |
253 Current_Priority := High; | |
254 end if; | |
255 Build_Credit_Record( Next_Transaction ); | |
256 Next_Message_Task.Accept_Transaction ( Next_Transaction ); | |
257 end if; | |
258 end; -- declare | |
259 end loop; | |
260 | |
261 -- TC: Wait for Credit_Overloaded to be cleared, then insure that the | |
262 -- Distributor has evalated all tasks. Otherwise, some tasks may never | |
263 -- be evaluated. | |
264 while Credit_Overloaded.Value loop | |
265 delay ImpDef.Minimum_Task_Switch; | |
266 end loop; | |
267 Distributor.TC_Credit_OK; | |
268 | |
269 exception | |
270 when others => | |
271 Report.Failed ("Unexpected exception in Line_Driver"); | |
272 end Line_Driver; | |
273 | |
274 | |
275 | |
276 | |
277 task body Message_Task is | |
278 | |
279 TC_Original_Transaction_Code : Transaction_Code; | |
280 This_Transaction : acc_Transaction_Record := new Transaction_Record; | |
281 | |
282 begin | |
283 | |
284 accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do | |
285 This_Transaction.all := In_Transaction.all; | |
286 end Accept_Transaction; | |
287 | |
288 -- Note the original code to ensure correct return | |
289 TC_Original_Transaction_Code := This_Transaction.Code; | |
290 | |
291 -- Queue up on Distributor's Input queue | |
292 Distributor.Input ( This_Transaction ); | |
293 -- This task will now wait for the requeued rendezvous | |
294 -- to complete before proceeding | |
295 | |
296 -- After the required computations have been performed | |
297 -- return the Transaction_Record appropriately (probably to an output | |
298 -- line driver) | |
299 null; -- stub | |
300 | |
301 -- For the test check that the return values are as expected | |
302 if TC_Original_Transaction_Code /= This_Transaction.Code then | |
303 -- Incorrect rendezvous | |
304 Report.Failed ("Message Task: Incorrect code returned"); | |
305 end if; | |
306 | |
307 if This_Transaction.Code = Credit then | |
308 if This_Transaction.Return_Value /= Credit_Return or | |
309 This_Transaction.Time_Stamp = Base_Time then | |
310 Report.Failed ("Expected path not traversed"); | |
311 end if; | |
312 TC_Tasks_Completed.Increment; | |
313 else | |
314 if This_Transaction.Return_Value /= Debit_Return or | |
315 This_Transaction.Message_Count /= 1 or | |
316 This_Transaction.Time_Stamp = Base_Time then | |
317 Report.Failed ("Expected path not traversed"); | |
318 end if; | |
319 TC_Debit_Message_Complete.Set_True; | |
320 end if; | |
321 | |
322 exception | |
323 when others => | |
324 Report.Failed ("Unexpected exception in Message_Task"); | |
325 | |
326 end Message_Task; | |
327 | |
328 | |
329 | |
330 | |
331 -- Dispose each input Transaction_Record to the appropriate | |
332 -- computation tasks | |
333 -- | |
334 task body Distributor is | |
335 begin | |
336 loop | |
337 select | |
338 accept Input (Transaction : acc_Transaction_Record) do | |
339 -- Time_Stamp the messages with the current time | |
340 -- TC: Used, incidentally, by the test to check that the | |
341 -- message did pass through the Distributor Task | |
342 Transaction.Time_Stamp := Ada.Calendar.Clock; | |
343 | |
344 -- Pass this transaction on to the appropriate computation | |
345 -- task but temporarily hold low-priority transactions under | |
346 -- overload conditions | |
347 case Transaction.Code is | |
348 when Credit => | |
349 if Credit_Overloaded.Value and | |
350 Transaction.Priority = Low then | |
351 requeue Wait_for_Underload with abort; | |
352 else | |
353 requeue Credit_Computation.Input with abort; | |
354 end if; | |
355 when Debit => | |
356 requeue Debit_Computation.Input with abort; | |
357 end case; | |
358 end Input; | |
359 or | |
360 when not Credit_Overloaded.Value => | |
361 accept Wait_for_Underload (Transaction : acc_Transaction_Record) do | |
362 requeue Credit_Computation.Input with abort; | |
363 end Wait_for_Underload; | |
364 or | |
365 accept TC_Credit_OK; | |
366 -- We need this to insure that we evaluate the guards at least | |
367 -- once when Credit_Overloaded is False. Otherwise, tasks | |
368 -- could stay queued on Wait_for_Underload forever (starvation). | |
369 or | |
370 terminate; | |
371 end select; | |
372 end loop; | |
373 | |
374 exception | |
375 when others => | |
376 Report.Failed ("Unexpected exception in Distributor"); | |
377 end Distributor; | |
378 | |
379 | |
380 | |
381 -- Computation task. After the computation is performed the rendezvous | |
382 -- in the original message task is completed. | |
383 -- | |
384 task body Credit_Computation is | |
385 | |
386 Message_Count : integer := 0; | |
387 | |
388 begin | |
389 loop | |
390 select | |
391 accept Input ( Transaction : acc_Transaction_Record) do | |
392 if Credit_Overloaded.Value and | |
393 Transaction.Priority = Low then | |
394 -- We should not be getting any Low Priority messages. They | |
395 -- should be waiting on the Distributor's Wait_for_Underload | |
396 -- queue | |
397 Report.Failed | |
398 ("Credit Task: Low priority transaction during overload"); | |
399 end if; | |
400 -- Perform the computations required for this transaction | |
401 null; -- stub | |
402 | |
403 -- For the test: | |
404 if Transaction.Time_Stamp = Base_Time then | |
405 Report.Failed | |
406 ("Credit Task: Wrong queue, Distributor bypassed"); | |
407 end if; | |
408 if Transaction.code /= Credit then | |
409 Report.Failed | |
410 ("Credit Task: Requeue delivered to the wrong queue"); | |
411 end if; | |
412 | |
413 -- The following is all Test Control code: | |
414 Transaction.Return_Value := Credit_Return; | |
415 Message_Count := Message_Count + 1; | |
416 -- | |
417 -- Now take special action depending on which Message | |
418 if Message_Count = 1 then | |
419 -- After the first message : | |
420 Credit_Overloaded.Set_True; | |
421 -- Now flag the Line_Driver that the second and subsequent | |
422 -- messages may now be sent | |
423 TC_First_Message_Has_Arrived.Set_True; | |
424 end if; | |
425 if Message_Count = 3 then | |
426 -- The two high priority transactions created subsequent | |
427 -- to the overload have now been processed | |
428 Credit_Overloaded.Set_False; | |
429 end if; | |
430 end Input; | |
431 or | |
432 terminate; | |
433 end select; | |
434 end loop; | |
435 exception | |
436 when others => | |
437 Report.Failed ("Unexpected exception in Credit_Computation"); | |
438 end Credit_Computation; | |
439 | |
440 | |
441 | |
442 -- Computation task. After the computation is performed the rendezvous | |
443 -- in the original message task is completed. | |
444 -- | |
445 task body Debit_Computation is | |
446 Message_Count : integer := 0; | |
447 begin | |
448 loop | |
449 select | |
450 accept Input (Transaction : acc_Transaction_Record) do | |
451 -- Perform the computations required for this message | |
452 null; -- stub | |
453 | |
454 -- For the test: | |
455 if Transaction.Time_Stamp = Base_Time then | |
456 Report.Failed | |
457 ("Debit Task: Wrong queue, Distributor bypassed"); | |
458 end if; | |
459 if Transaction.code /= Debit then | |
460 Report.Failed | |
461 ("Debit Task: Requeue delivered to the wrong queue"); | |
462 end if; | |
463 | |
464 -- for the test plug a known value and count | |
465 Transaction.Return_Value := Debit_Return; | |
466 -- one, and only one, message should pass through | |
467 Message_Count := Message_Count + 1; | |
468 Transaction.Message_Count := Message_Count; | |
469 end Input; | |
470 or | |
471 terminate; | |
472 end select; | |
473 end loop; | |
474 exception | |
475 when others => | |
476 Report.Failed ("Unexpected exception in Debit_Computation"); | |
477 | |
478 | |
479 end Debit_Computation; | |
480 | |
481 | |
482 begin -- c954012 | |
483 Report.Test ("C954012", "Requeue within an accept body" & | |
484 " to another entry in the same task"); | |
485 | |
486 Line_Driver.Start; -- Start the test | |
487 | |
488 -- Ensure that the message tasks complete before reporting the result | |
489 while (TC_Tasks_Completed.Count < TC_Credit_Messages_Expected) | |
490 or (not TC_Debit_Message_Complete.Value) loop | |
491 delay ImpDef.Minimum_Task_Switch; | |
492 end loop; | |
493 | |
494 Report.Result; | |
495 | |
496 end C954012; |