Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c9/c954011.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 -- C954011.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 placed on the correct entry; that the | |
28 -- original caller waits for the completion of the requeued rendezvous; | |
29 -- that the original caller continues after the rendezvous. | |
30 -- Specifically, this test checks requeue to an entry in a different | |
31 -- task, requeue where the entry has parameters, and requeue with | |
32 -- abort. | |
33 -- | |
34 -- TEST DESCRIPTION: | |
35 -- In the Distributor task, requeue two successive calls on the entries | |
36 -- of two separate target tasks. Each task in each of the paths adds | |
37 -- identifying information in the transaction being passed. This | |
38 -- information is checked by the Message tasks on completion ensuring that | |
39 -- the requeues have been placed on the correct queues. | |
40 -- | |
41 -- This series of tests uses a simulation of a transaction driven | |
42 -- processing system. Line Drivers accept input from an external source | |
43 -- and build them into transaction records. These records are then | |
44 -- encapsulated in message tasks which remain extant for the life of the | |
45 -- transaction in the system. The message tasks put themselves on the | |
46 -- input queue of a Distributor which, from information in the | |
47 -- transaction and/or system load conditions forwards them to other | |
48 -- operating tasks. These in turn might forward the transactions to yet | |
49 -- other tasks for further action. The routing is, in real life, | |
50 -- dynamic and unpredictable at the time of message generation. All | |
51 -- rerouting in this model is done by means of requeues. | |
52 -- | |
53 -- | |
54 -- CHANGE HISTORY: | |
55 -- 06 Dec 94 SAIC ACVC 2.0 | |
56 -- 26 Nov 95 SAIC Fixed problems with shared global variables | |
57 -- for ACVC 2.0.1 | |
58 -- | |
59 --! | |
60 | |
61 with Report; | |
62 with ImpDef; | |
63 | |
64 procedure C954011 is | |
65 | |
66 | |
67 -- Arbitrary test values | |
68 Credit_Return : constant := 1; | |
69 Debit_Return : constant := 2; | |
70 | |
71 type Transaction_Code is (Credit, Debit); | |
72 | |
73 type Transaction_Record; | |
74 type acc_Transaction_Record is access Transaction_Record; | |
75 type Transaction_Record is | |
76 record | |
77 ID : integer := 0; | |
78 Code : Transaction_Code := Debit; | |
79 Account_Number : integer := 0; | |
80 Stock_Number : integer := 0; | |
81 Quantity : integer := 0; | |
82 Return_Value : integer := 0; | |
83 TC_Message_Count : integer := 0; | |
84 TC_Thru_Distrib : Boolean := false; | |
85 end record; | |
86 | |
87 protected type Message_Mgr is | |
88 procedure Mark_Complete; | |
89 function Is_Complete return Boolean; | |
90 private | |
91 Complete : Boolean := False; | |
92 end Message_Mgr; | |
93 | |
94 protected body Message_Mgr is | |
95 procedure Mark_Complete is | |
96 begin | |
97 Complete := True; | |
98 end Mark_Complete; | |
99 | |
100 Function Is_Complete return Boolean is | |
101 begin | |
102 return Complete; | |
103 end Is_Complete; | |
104 end Message_Mgr; | |
105 | |
106 TC_Debit_Message : Message_Mgr; | |
107 TC_Credit_Message : Message_Mgr; | |
108 | |
109 | |
110 task type Message_Task is | |
111 entry Accept_Transaction (In_Transaction : acc_Transaction_Record); | |
112 end Message_Task; | |
113 type acc_Message_Task is access Message_Task; | |
114 | |
115 task Line_Driver is | |
116 entry Start; | |
117 end Line_Driver; | |
118 | |
119 task Distributor is | |
120 entry Input(Transaction : acc_Transaction_Record); | |
121 end Distributor; | |
122 | |
123 task Credit_Computation is | |
124 entry Input(Transaction : acc_Transaction_Record); | |
125 end Credit_Computation; | |
126 | |
127 task Debit_Computation is | |
128 entry Input(Transaction : acc_Transaction_Record); | |
129 end Debit_Computation; | |
130 | |
131 | |
132 | |
133 -- Assemble messages received from an external source | |
134 -- Creates a message task for each. The message tasks remain extant | |
135 -- for the life of the messages in the system. | |
136 -- The Line Driver task would normally be designed to loop continuously | |
137 -- creating the messages as input is received. Simulate this | |
138 -- but limit it to two dummy messages for this test and allow it | |
139 -- to terminate at that point | |
140 -- | |
141 task body Line_Driver is | |
142 Current_ID : integer := 1; | |
143 TC_Last_was_for_credit : Boolean := false; | |
144 | |
145 procedure Build_Credit_Record | |
146 ( Next_Transaction : acc_Transaction_Record ) is | |
147 Dummy_Account : constant integer := 100; | |
148 begin | |
149 Next_Transaction.ID := Current_ID; | |
150 Next_Transaction.Code := Credit; | |
151 | |
152 Next_Transaction.Account_Number := Dummy_Account; | |
153 Current_ID := Current_ID + 1; | |
154 end Build_Credit_Record; | |
155 | |
156 | |
157 procedure Build_Debit_Record | |
158 ( Next_Transaction : acc_Transaction_Record ) is | |
159 Dummy_Account : constant integer := 200; | |
160 begin | |
161 Next_Transaction.ID := Current_ID; | |
162 Next_Transaction.Code := Debit; | |
163 | |
164 Next_Transaction.Account_Number := Dummy_Account; | |
165 Current_ID := Current_ID + 1; | |
166 end Build_Debit_Record; | |
167 | |
168 begin | |
169 | |
170 accept Start; -- Wait for trigger from Main | |
171 | |
172 for i in 1..2 loop -- arbitrarily limit to two messages for the test | |
173 declare | |
174 -- Create a task for the next message | |
175 Next_Message_Task : acc_Message_Task := new Message_Task; | |
176 -- Create a record for it | |
177 Next_Transaction : acc_Transaction_Record | |
178 := new Transaction_Record; | |
179 begin | |
180 if TC_Last_was_for_credit then | |
181 Build_Debit_Record ( Next_Transaction ); | |
182 else | |
183 Build_Credit_Record( Next_Transaction ); | |
184 TC_Last_was_for_credit := true; | |
185 end if; | |
186 Next_Message_Task.Accept_Transaction ( Next_Transaction ); | |
187 end; -- declare | |
188 end loop; | |
189 | |
190 exception | |
191 when others => | |
192 Report.Failed ("Unexpected exception in Line_Driver"); | |
193 end Line_Driver; | |
194 | |
195 | |
196 | |
197 | |
198 task body Message_Task is | |
199 | |
200 TC_Original_Transaction_Code : Transaction_Code; | |
201 This_Transaction : acc_Transaction_Record := new Transaction_Record; | |
202 | |
203 begin | |
204 accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do | |
205 This_Transaction.all := In_Transaction.all; | |
206 end Accept_Transaction; | |
207 | |
208 -- Note the original code to ensure correct return | |
209 TC_Original_Transaction_Code := This_Transaction.Code; | |
210 | |
211 -- Queue up on Distributor's Input queue | |
212 Distributor.Input ( This_Transaction ); | |
213 -- This task will now wait for the requeued rendezvous | |
214 -- to complete before proceeding | |
215 | |
216 -- After the required computations have been performed | |
217 -- return the Transaction_Record appropriately (probably to an output | |
218 -- line driver) | |
219 null; -- stub | |
220 | |
221 | |
222 -- The following is all Test Control Code | |
223 | |
224 -- Check that the return values are as expected | |
225 if TC_Original_Transaction_Code /= This_Transaction.Code then | |
226 -- Incorrect rendezvous | |
227 Report.Failed ("Message Task: Incorrect code returned"); | |
228 end if; | |
229 | |
230 if This_Transaction.Code = Credit then | |
231 if This_Transaction.Return_Value /= Credit_Return or | |
232 This_Transaction.TC_Message_Count /= 1 or not | |
233 This_Transaction.TC_Thru_Distrib then | |
234 Report.Failed ("Expected path not traversed"); | |
235 end if; | |
236 TC_Credit_Message.Mark_Complete; | |
237 else | |
238 if This_Transaction.Return_Value /= Debit_Return or | |
239 This_Transaction.TC_Message_Count /= 1 or not | |
240 This_Transaction.TC_Thru_Distrib then | |
241 Report.Failed ("Expected path not traversed"); | |
242 end if; | |
243 TC_Debit_Message.Mark_Complete; | |
244 end if; | |
245 | |
246 exception | |
247 when others => | |
248 Report.Failed ("Unexpected exception in Message_Task"); | |
249 | |
250 end Message_Task; | |
251 | |
252 | |
253 | |
254 -- Dispose each input Transaction_Record to the appropriate | |
255 -- computation tasks | |
256 -- | |
257 task body Distributor is | |
258 | |
259 begin | |
260 loop | |
261 select | |
262 accept Input (Transaction : acc_Transaction_Record) do | |
263 -- Mark the message as having passed through the distributor | |
264 Transaction.TC_Thru_Distrib := true; | |
265 | |
266 -- Pass this transaction on the appropriate computation | |
267 -- task | |
268 case Transaction.Code is | |
269 when Credit => | |
270 requeue Credit_Computation.Input with abort; | |
271 when Debit => | |
272 requeue Debit_Computation.Input with abort; | |
273 end case; | |
274 end Input; | |
275 or | |
276 terminate; | |
277 end select; | |
278 end loop; | |
279 | |
280 exception | |
281 when others => | |
282 Report.Failed ("Unexpected exception in Distributor"); | |
283 end Distributor; | |
284 | |
285 | |
286 | |
287 -- Computation task. | |
288 -- Note: After the computation is performed in this task and the | |
289 -- accept body is completed the rendezvous in the original | |
290 -- message task is completed. | |
291 -- | |
292 task body Credit_Computation is | |
293 Message_Count : integer := 0; | |
294 begin | |
295 loop | |
296 select | |
297 accept Input ( Transaction : acc_Transaction_Record) do | |
298 -- Perform the computations required for this transaction | |
299 null; -- stub | |
300 | |
301 -- For the test: | |
302 if not Transaction.TC_Thru_Distrib then | |
303 Report.Failed | |
304 ("Credit Task: Wrong queue, Distributor bypassed"); | |
305 end if; | |
306 if Transaction.code /= Credit then | |
307 Report.Failed | |
308 ("Credit Task: Requeue delivered to the wrong queue"); | |
309 end if; | |
310 | |
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; | |
316 end Input; | |
317 or | |
318 terminate; | |
319 end select; | |
320 end loop; | |
321 exception | |
322 when others => | |
323 Report.Failed ("Unexpected exception in Credit_Computation"); | |
324 end Credit_Computation; | |
325 | |
326 | |
327 | |
328 -- Computation task. | |
329 -- Note: After the computation is performed in this task and the | |
330 -- accept body is completed the rendezvous in the original | |
331 -- message task is completed. | |
332 -- | |
333 task body Debit_Computation is | |
334 Message_Count : integer := 0; | |
335 begin | |
336 loop | |
337 select | |
338 accept Input (Transaction : acc_Transaction_Record) do | |
339 -- Perform the computations required for this message | |
340 null; -- stub | |
341 | |
342 -- For the test: | |
343 if not Transaction.TC_Thru_Distrib then | |
344 Report.Failed | |
345 ("Debit Task: Wrong queue, Distributor bypassed"); | |
346 end if; | |
347 if Transaction.code /= Debit then | |
348 Report.Failed | |
349 ("Debit Task: Requeue delivered to the wrong queue"); | |
350 end if; | |
351 | |
352 -- for the test plug a known value and count | |
353 Transaction.Return_Value := Debit_Return; | |
354 -- one, and only one, message should pass through | |
355 Message_Count := Message_Count + 1; | |
356 Transaction.TC_Message_Count := Message_Count; | |
357 end Input; | |
358 or | |
359 terminate; | |
360 end select; | |
361 end loop; | |
362 exception | |
363 when others => | |
364 Report.Failed ("Unexpected exception in Debit_Computation"); | |
365 | |
366 | |
367 end Debit_Computation; | |
368 | |
369 | |
370 begin -- c954011 | |
371 | |
372 Report.Test ("C954011", "Requeue from task body to task entry"); | |
373 | |
374 Line_Driver.Start; -- Start the test | |
375 | |
376 -- Ensure that the message tasks complete before reporting the result | |
377 while not (TC_Credit_Message.Is_Complete and | |
378 TC_Debit_Message.Is_Complete) loop | |
379 delay ImpDef.Minimum_Task_Switch; | |
380 end loop; | |
381 | |
382 Report.Result; | |
383 | |
384 end C954011; |