Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c9/c953002.a @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 -- C953002.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 the servicing of entry queues of a protected object
28 -- continues until there are no open entries with queued calls
29 -- and that this takes place as part of a single protected
30 -- operation.
31 --
32 -- TEST DESCRIPTION:
33 -- This test enqueues a bunch of tasks on the entries of the
34 -- protected object Main_PO. At the same time another bunch of
35 -- of tasks are queued on the single entry of protected object
36 -- Holding_Pen.
37 -- Once all the tasks have had time to block, the main procedure
38 -- opens all the entries for Main_PO by calling the
39 -- Start_Protected_Operation protected procedure. This should
40 -- process all the pending callers as part of a single protected
41 -- operation.
42 -- During this protected operation, the entries of Main_PO release
43 -- the tasks blocked on Holding_Pen by calling the protected
44 -- procedure Release.
45 -- Once released from Holding_Pen, the task immediately calls
46 -- an entry in Main_PO.
47 -- These new calls should not gain access to Main_PO until
48 -- the initial protected operation on that object completes.
49 -- The order in which the entry calls on Main_PO are taken is
50 -- recorded in a global array and checked after all the tasks
51 -- have terminated.
52 --
53 --
54 -- CHANGE HISTORY:
55 -- 25 OCT 95 SAIC ACVC 2.1
56 -- 15 JAN 95 SAIC Fixed deadlock problem.
57 --
58 --!
59
60 with Report;
61 procedure C953002 is
62 Verbose : constant Boolean := False;
63
64 Half_Tasks : constant := 15; -- how many tasks of each group
65 Max_Tasks : constant := Half_Tasks * 2; -- total number of tasks
66
67 Note_Order : array (1..Max_Tasks) of Integer := (1..Max_Tasks => 0);
68 Note_Cnt : Integer := 0;
69 begin
70 Report.Test ("C953002",
71 "Check that the servicing of entry queues handles all" &
72 " open entries as part of a single protected operation");
73 declare
74 task type Assault_PO is
75 entry Take_ID (Id : Integer);
76 end Assault_PO;
77
78 First_Wave : array (1 .. Half_Tasks) of Assault_PO;
79 Second_Wave : array (1 .. Half_Tasks) of Assault_PO;
80
81 protected Main_PO is
82 entry E0 (Who : Integer);
83 entry E1 (Who : Integer);
84 entry E2 (Who : Integer);
85 entry E3 (Who : Integer);
86 entry All_Present;
87 procedure Start_Protected_Operation;
88 private
89 Open : Boolean := False;
90 end Main_PO;
91
92 protected Holding_Pen is
93 -- Note that Release is called by tasks executing in
94 -- the protected object Main_PO.
95 entry Wait (Who : Integer);
96 entry All_Present;
97 procedure Release;
98 private
99 Open : Boolean := False;
100 end Holding_Pen;
101
102
103 protected body Main_PO is
104 procedure Start_Protected_Operation is
105 begin
106 Open := True;
107 -- at this point all the First_Wave tasks are
108 -- waiting at the entries and all of them should
109 -- be processed as part of the protected operation.
110 end Start_Protected_Operation;
111
112 entry All_Present when E0'Count + E1'Count + E2'Count + E3'Count =
113 Max_Tasks / 2 is
114 begin
115 null; -- all tasks are waiting
116 end All_Present;
117
118 entry E0 (Who : Integer) when Open is
119 begin
120 Holding_Pen.Release;
121 -- note the order in which entry calls are handled.
122 Note_Cnt := Note_Cnt + 1;
123 Note_Order (Note_Cnt) := Who;
124 end E0;
125
126 entry E1 (Who : Integer) when Open is
127 begin
128 Holding_Pen.Release;
129 Note_Cnt := Note_Cnt + 1;
130 Note_Order (Note_Cnt) := Who;
131 end E1;
132
133 entry E2 (Who : Integer) when Open is
134 begin
135 Holding_Pen.Release;
136 Note_Cnt := Note_Cnt + 1;
137 Note_Order (Note_Cnt) := Who;
138 end E2;
139
140 entry E3 (Who : Integer) when Open is
141 begin
142 Holding_Pen.Release;
143 Note_Cnt := Note_Cnt + 1;
144 Note_Order (Note_Cnt) := Who;
145 end E3;
146 end Main_PO;
147
148
149 protected body Holding_Pen is
150 procedure Release is
151 begin
152 Open := True;
153 end Release;
154
155 entry All_Present when Wait'Count = Max_Tasks / 2 is
156 begin
157 null; -- all tasks waiting
158 end All_Present;
159
160 entry Wait (Who : Integer) when Open is
161 begin
162 null; -- unblock the task
163 end Wait;
164 end Holding_Pen;
165
166 task body Assault_PO is
167 Me : Integer;
168 begin
169 accept Take_Id (Id : Integer) do
170 Me := Id;
171 end Take_Id;
172 if Me >= 200 then
173 Holding_Pen.Wait (Me);
174 end if;
175 case Me mod 4 is
176 when 0 => Main_PO.E0 (Me);
177 when 1 => Main_PO.E1 (Me);
178 when 2 => Main_PO.E2 (Me);
179 when 3 => Main_PO.E3 (Me);
180 when others => null; -- cant happen
181 end case;
182 if Verbose then
183 Report.Comment ("task" & Integer'Image (Me) &
184 " done");
185 end if;
186 exception
187 when others =>
188 Report.Failed ("exception in task");
189 end Assault_PO;
190
191 begin -- test encapsulation
192 for I in First_Wave'Range loop
193 First_Wave (I).Take_ID (100 + I);
194 end loop;
195 for I in Second_Wave'Range loop
196 Second_Wave (I).Take_ID (200 + I);
197 end loop;
198
199 -- let all the tasks get blocked
200 Main_PO.All_Present;
201 Holding_Pen.All_Present;
202
203 -- let the games begin
204 if Verbose then
205 Report.Comment ("starting protected operation");
206 end if;
207 Main_PO.Start_Protected_Operation;
208
209 -- wait for all the tasks to complete
210 if Verbose then
211 Report.Comment ("waiting for tasks to complete");
212 end if;
213 end;
214
215 -- make sure all tasks registered their order
216 if Note_Cnt /= Max_Tasks then
217 Report.Failed ("task registration count wrong. " &
218 Integer'Image (Note_Cnt));
219 end if;
220
221 -- check the order in which entries were handled.
222 -- all the 100 level items should be handled as part of the
223 -- first protected operation and thus should be completed
224 -- before any 200 level item.
225
226 if Verbose then
227 for I in 1..Max_Tasks loop
228 Report.Comment ("order" & Integer'Image (I) & " is" &
229 Integer'Image (Note_Order (I)));
230 end loop;
231 end if;
232 for I in 2 .. Max_Tasks loop
233 if Note_Order (I) < 200 and
234 Note_Order (I-1) >= 200 then
235 Report.Failed ("protected operation failure" &
236 Integer'Image (Note_Order (I-1)) &
237 Integer'Image (Note_Order (I)));
238 end if;
239 end loop;
240
241 Report.Result;
242 end C953002;