annotate gcc/testsuite/ada/acats/tests/c9/c954010.a @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 -- C954010.A
kono
parents:
diff changeset
2 --
kono
parents:
diff changeset
3 -- Grant of Unlimited Rights
kono
parents:
diff changeset
4 --
kono
parents:
diff changeset
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
kono
parents:
diff changeset
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
kono
parents:
diff changeset
7 -- unlimited rights in the software and documentation contained herein.
kono
parents:
diff changeset
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
kono
parents:
diff changeset
9 -- this public release, the Government intends to confer upon all
kono
parents:
diff changeset
10 -- recipients unlimited rights equal to those held by the Government.
kono
parents:
diff changeset
11 -- These rights include rights to use, duplicate, release or disclose the
kono
parents:
diff changeset
12 -- released technical data and computer software in whole or in part, in
kono
parents:
diff changeset
13 -- any manner and for any purpose whatsoever, and to have or permit others
kono
parents:
diff changeset
14 -- to do so.
kono
parents:
diff changeset
15 --
kono
parents:
diff changeset
16 -- DISCLAIMER
kono
parents:
diff changeset
17 --
kono
parents:
diff changeset
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
kono
parents:
diff changeset
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
kono
parents:
diff changeset
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
kono
parents:
diff changeset
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
kono
parents:
diff changeset
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
kono
parents:
diff changeset
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
kono
parents:
diff changeset
24 --*
kono
parents:
diff changeset
25 --
kono
parents:
diff changeset
26 -- OBJECTIVE:
kono
parents:
diff changeset
27 -- Check that a requeue within an accept statement does not block.
kono
parents:
diff changeset
28 -- This test uses: Requeue to an entry in a different task
kono
parents:
diff changeset
29 -- Parameterless call
kono
parents:
diff changeset
30 -- Requeue with abort
kono
parents:
diff changeset
31 --
kono
parents:
diff changeset
32 -- TEST DESCRIPTION:
kono
parents:
diff changeset
33 -- In the Distributor task, requeue two successive calls on the entries
kono
parents:
diff changeset
34 -- of two separate target tasks. Verify that the target tasks are
kono
parents:
diff changeset
35 -- run in parallel proving that the first requeue does not block
kono
parents:
diff changeset
36 -- while the first target rendezvous takes place.
kono
parents:
diff changeset
37 --
kono
parents:
diff changeset
38 -- This series of tests uses a simulation of a transaction driven
kono
parents:
diff changeset
39 -- processing system. Line Drivers accept input from an external source
kono
parents:
diff changeset
40 -- and build them into transaction records. These records are then
kono
parents:
diff changeset
41 -- encapsulated in message tasks which remain extant for the life of the
kono
parents:
diff changeset
42 -- transaction in the system. The message tasks put themselves on the
kono
parents:
diff changeset
43 -- input queue of a Distributor which, from information in the
kono
parents:
diff changeset
44 -- transaction and/or system load conditions forwards them to other
kono
parents:
diff changeset
45 -- operating tasks. These in turn might forward the transactions to yet
kono
parents:
diff changeset
46 -- other tasks for further action. The routing is, in real life,
kono
parents:
diff changeset
47 -- dynamic and unpredictable at the time of message generation. All
kono
parents:
diff changeset
48 -- rerouting in this model is done by means of requeues.
kono
parents:
diff changeset
49 --
kono
parents:
diff changeset
50 -- This test is directed towards the BLOCKING of the REQUEUE only
kono
parents:
diff changeset
51 -- If the original caller does not block, the outcome of the test will
kono
parents:
diff changeset
52 -- not be affected. If the original caller does not continue after
kono
parents:
diff changeset
53 -- the return, the test will not pass.
kono
parents:
diff changeset
54 -- If the requeue gets placed on the wrong entry a failing test could
kono
parents:
diff changeset
55 -- pass (eg. if the first message is delivered to the second
kono
parents:
diff changeset
56 -- computation task and the second message to the first) - a check for
kono
parents:
diff changeset
57 -- this condition is made in other tests
kono
parents:
diff changeset
58 --
kono
parents:
diff changeset
59 --
kono
parents:
diff changeset
60 -- CHANGE HISTORY:
kono
parents:
diff changeset
61 -- 06 Dec 94 SAIC ACVC 2.0
kono
parents:
diff changeset
62 --
kono
parents:
diff changeset
63 --!
kono
parents:
diff changeset
64
kono
parents:
diff changeset
65 with Report;
kono
parents:
diff changeset
66 with ImpDef;
kono
parents:
diff changeset
67
kono
parents:
diff changeset
68 procedure C954010 is
kono
parents:
diff changeset
69
kono
parents:
diff changeset
70 -- Mechanism to count the number of Message tasks completed
kono
parents:
diff changeset
71 protected TC_Tasks_Completed is
kono
parents:
diff changeset
72 procedure Increment;
kono
parents:
diff changeset
73 function Count return integer;
kono
parents:
diff changeset
74 private
kono
parents:
diff changeset
75 Number_Complete : integer := 0;
kono
parents:
diff changeset
76 end TC_Tasks_Completed;
kono
parents:
diff changeset
77 --
kono
parents:
diff changeset
78 TC_Expected_To_Complete : constant integer := 2;
kono
parents:
diff changeset
79
kono
parents:
diff changeset
80
kono
parents:
diff changeset
81 task type Message_Task;
kono
parents:
diff changeset
82 type acc_Message_Task is access Message_Task;
kono
parents:
diff changeset
83
kono
parents:
diff changeset
84 task Line_Driver is
kono
parents:
diff changeset
85 entry Start;
kono
parents:
diff changeset
86 end Line_Driver;
kono
parents:
diff changeset
87
kono
parents:
diff changeset
88 task Distributor is
kono
parents:
diff changeset
89 entry Input;
kono
parents:
diff changeset
90 end Distributor;
kono
parents:
diff changeset
91
kono
parents:
diff changeset
92 task Credit_Computation is
kono
parents:
diff changeset
93 entry Input;
kono
parents:
diff changeset
94 end Credit_Computation;
kono
parents:
diff changeset
95
kono
parents:
diff changeset
96 task Debit_Computation is
kono
parents:
diff changeset
97 entry Input;
kono
parents:
diff changeset
98 entry TC_Artificial_Rendezvous_1; -- test purposes only
kono
parents:
diff changeset
99 entry TC_Artificial_Rendezvous_2; -- test purposes only
kono
parents:
diff changeset
100 end Debit_Computation;
kono
parents:
diff changeset
101
kono
parents:
diff changeset
102
kono
parents:
diff changeset
103 -- Mechanism to count the number of Message tasks completed
kono
parents:
diff changeset
104 protected body TC_Tasks_Completed is
kono
parents:
diff changeset
105 procedure Increment is
kono
parents:
diff changeset
106 begin
kono
parents:
diff changeset
107 Number_Complete := Number_Complete + 1;
kono
parents:
diff changeset
108 end Increment;
kono
parents:
diff changeset
109
kono
parents:
diff changeset
110 function Count return integer is
kono
parents:
diff changeset
111 begin
kono
parents:
diff changeset
112 return Number_Complete;
kono
parents:
diff changeset
113 end Count;
kono
parents:
diff changeset
114 end TC_Tasks_Completed;
kono
parents:
diff changeset
115
kono
parents:
diff changeset
116
kono
parents:
diff changeset
117
kono
parents:
diff changeset
118 -- Assemble messages received from an external source
kono
parents:
diff changeset
119 -- Creates a message task for each and sends this to a Distributor
kono
parents:
diff changeset
120 -- for appropriate disposal around the network of tasks
kono
parents:
diff changeset
121 -- Such a task would normally be designed to loop continuously
kono
parents:
diff changeset
122 -- creating the messages as input is received. Simulate this
kono
parents:
diff changeset
123 -- but limit it to two dummy messages for this test and allow it
kono
parents:
diff changeset
124 -- to terminate at that point
kono
parents:
diff changeset
125 --
kono
parents:
diff changeset
126 task body Line_Driver is
kono
parents:
diff changeset
127
kono
parents:
diff changeset
128 begin
kono
parents:
diff changeset
129
kono
parents:
diff changeset
130 accept Start; -- Wait for trigger from main
kono
parents:
diff changeset
131
kono
parents:
diff changeset
132 for i in 1..2 loop
kono
parents:
diff changeset
133 declare
kono
parents:
diff changeset
134 -- create a new message task
kono
parents:
diff changeset
135 N : acc_Message_Task := new Message_Task;
kono
parents:
diff changeset
136 begin
kono
parents:
diff changeset
137 -- preparation code
kono
parents:
diff changeset
138 null; -- stub
kono
parents:
diff changeset
139
kono
parents:
diff changeset
140 end; -- declare
kono
parents:
diff changeset
141 end loop;
kono
parents:
diff changeset
142
kono
parents:
diff changeset
143 exception
kono
parents:
diff changeset
144 when others =>
kono
parents:
diff changeset
145 Report.Failed ("Unexpected exception in Line_Driver");
kono
parents:
diff changeset
146 end Line_Driver;
kono
parents:
diff changeset
147
kono
parents:
diff changeset
148
kono
parents:
diff changeset
149 task body Message_Task is
kono
parents:
diff changeset
150 begin
kono
parents:
diff changeset
151 -- Queue up on Distributor's Input queue
kono
parents:
diff changeset
152 Distributor.Input;
kono
parents:
diff changeset
153
kono
parents:
diff changeset
154 -- After the required computations have been performed
kono
parents:
diff changeset
155 -- return the message appropriately (probably to an output
kono
parents:
diff changeset
156 -- line driver
kono
parents:
diff changeset
157 null; -- stub
kono
parents:
diff changeset
158
kono
parents:
diff changeset
159 -- Increment to show completion of this task
kono
parents:
diff changeset
160 TC_Tasks_Completed.Increment;
kono
parents:
diff changeset
161
kono
parents:
diff changeset
162 exception
kono
parents:
diff changeset
163 when others =>
kono
parents:
diff changeset
164 Report.Failed ("Unexpected exception in Message_Task");
kono
parents:
diff changeset
165
kono
parents:
diff changeset
166 end Message_Task;
kono
parents:
diff changeset
167
kono
parents:
diff changeset
168
kono
parents:
diff changeset
169 -- Dispose each input message to the appropriate computation tasks
kono
parents:
diff changeset
170 -- Normally this would be according to some parameters in the entry
kono
parents:
diff changeset
171 -- but this simple test is using parameterless entries.
kono
parents:
diff changeset
172 --
kono
parents:
diff changeset
173 task body Distributor is
kono
parents:
diff changeset
174 Last_was_for_Credit_Computation : Boolean := false; -- switch
kono
parents:
diff changeset
175 begin
kono
parents:
diff changeset
176 loop
kono
parents:
diff changeset
177 select
kono
parents:
diff changeset
178 accept Input do
kono
parents:
diff changeset
179 -- Determine to which task the message should be
kono
parents:
diff changeset
180 -- distributed
kono
parents:
diff changeset
181 -- For this test arbitrarily send the first to
kono
parents:
diff changeset
182 -- Credit_Computation and the second to Debit_Computation
kono
parents:
diff changeset
183 if Last_was_for_Credit_Computation then
kono
parents:
diff changeset
184 requeue Debit_Computation.Input with abort;
kono
parents:
diff changeset
185 else
kono
parents:
diff changeset
186 Last_was_for_Credit_Computation := true;
kono
parents:
diff changeset
187 requeue Credit_Computation.Input with abort;
kono
parents:
diff changeset
188 end if;
kono
parents:
diff changeset
189 end Input;
kono
parents:
diff changeset
190 or
kono
parents:
diff changeset
191 terminate;
kono
parents:
diff changeset
192 end select;
kono
parents:
diff changeset
193 end loop;
kono
parents:
diff changeset
194
kono
parents:
diff changeset
195 exception
kono
parents:
diff changeset
196 when others =>
kono
parents:
diff changeset
197 Report.Failed ("Unexpected exception in Distributor");
kono
parents:
diff changeset
198 end Distributor;
kono
parents:
diff changeset
199
kono
parents:
diff changeset
200
kono
parents:
diff changeset
201 -- Computation task. After the computation is performed the rendezvous
kono
parents:
diff changeset
202 -- in the original message task is completed.
kono
parents:
diff changeset
203 task body Credit_Computation is
kono
parents:
diff changeset
204 begin
kono
parents:
diff changeset
205 loop
kono
parents:
diff changeset
206 select
kono
parents:
diff changeset
207 accept Input do
kono
parents:
diff changeset
208 -- Perform the computations required for this message
kono
parents:
diff changeset
209 --
kono
parents:
diff changeset
210 null; -- stub
kono
parents:
diff changeset
211
kono
parents:
diff changeset
212 -- For the test:
kono
parents:
diff changeset
213 -- Artificially rendezvous with Debit_Computation.
kono
parents:
diff changeset
214 -- If the first requeue in Distributor has blocked
kono
parents:
diff changeset
215 -- waiting for the current rendezvous to complete then the
kono
parents:
diff changeset
216 -- second message will not be sent to Debit_Computation
kono
parents:
diff changeset
217 -- which will still be waiting on its Input accept.
kono
parents:
diff changeset
218 -- This task will HANG
kono
parents:
diff changeset
219 --
kono
parents:
diff changeset
220 Debit_Computation.TC_Artificial_Rendezvous_1;
kono
parents:
diff changeset
221 --
kono
parents:
diff changeset
222 end Input;
kono
parents:
diff changeset
223 or
kono
parents:
diff changeset
224 terminate;
kono
parents:
diff changeset
225 end select;
kono
parents:
diff changeset
226 end loop;
kono
parents:
diff changeset
227 exception
kono
parents:
diff changeset
228 when others =>
kono
parents:
diff changeset
229 Report.Failed ("Unexpected exception in Credit_Computation");
kono
parents:
diff changeset
230 end Credit_Computation;
kono
parents:
diff changeset
231
kono
parents:
diff changeset
232
kono
parents:
diff changeset
233 -- Computation task. After the computation is performed the rendezvous
kono
parents:
diff changeset
234 -- in the original message task is completed.
kono
parents:
diff changeset
235 task body Debit_Computation is
kono
parents:
diff changeset
236 Message_Count : integer := 0;
kono
parents:
diff changeset
237 TC_AR1_is_complete : Boolean := false;
kono
parents:
diff changeset
238 begin
kono
parents:
diff changeset
239 loop
kono
parents:
diff changeset
240 select
kono
parents:
diff changeset
241 accept Input do
kono
parents:
diff changeset
242 -- Perform the computations required for this message
kono
parents:
diff changeset
243 null; -- stub
kono
parents:
diff changeset
244 end Input;
kono
parents:
diff changeset
245 Message_Count := Message_Count + 1;
kono
parents:
diff changeset
246 or
kono
parents:
diff changeset
247 -- Guard until the rendezvous with the message for this task
kono
parents:
diff changeset
248 -- has completed
kono
parents:
diff changeset
249 when Message_Count > 0 =>
kono
parents:
diff changeset
250 accept TC_Artificial_Rendezvous_1; -- see comments in
kono
parents:
diff changeset
251 -- Credit_Computation above
kono
parents:
diff changeset
252 TC_AR1_is_complete := true;
kono
parents:
diff changeset
253 or
kono
parents:
diff changeset
254 -- Completion rendezvous with the main procedure
kono
parents:
diff changeset
255 when TC_AR1_is_complete =>
kono
parents:
diff changeset
256 accept TC_Artificial_Rendezvous_2;
kono
parents:
diff changeset
257 or
kono
parents:
diff changeset
258 terminate;
kono
parents:
diff changeset
259 end select;
kono
parents:
diff changeset
260 end loop;
kono
parents:
diff changeset
261 exception
kono
parents:
diff changeset
262 when others =>
kono
parents:
diff changeset
263 Report.Failed ("Unexpected exception in Debit_Computation");
kono
parents:
diff changeset
264
kono
parents:
diff changeset
265
kono
parents:
diff changeset
266 end Debit_Computation;
kono
parents:
diff changeset
267
kono
parents:
diff changeset
268
kono
parents:
diff changeset
269 begin -- c954010
kono
parents:
diff changeset
270 Report.Test ("C954010", "Requeue in an accept body does not block");
kono
parents:
diff changeset
271
kono
parents:
diff changeset
272 Line_Driver.Start;
kono
parents:
diff changeset
273
kono
parents:
diff changeset
274 -- Ensure that both messages were delivered to the computation tasks
kono
parents:
diff changeset
275 -- This shows that both requeues were effective.
kono
parents:
diff changeset
276 --
kono
parents:
diff changeset
277 Debit_Computation.TC_Artificial_Rendezvous_2;
kono
parents:
diff changeset
278
kono
parents:
diff changeset
279 -- Ensure that the message tasks completed
kono
parents:
diff changeset
280 while (TC_Tasks_Completed.Count < TC_Expected_To_Complete) loop
kono
parents:
diff changeset
281 delay ImpDef.Minimum_Task_Switch;
kono
parents:
diff changeset
282 end loop;
kono
parents:
diff changeset
283
kono
parents:
diff changeset
284 Report.Result;
kono
parents:
diff changeset
285
kono
parents:
diff changeset
286 end C954010;