Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c9/c954001.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 -- C954001.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 statement within an entry_body with parameters | |
28 -- may requeue the entry call to a protected entry with a subtype- | |
29 -- conformant parameter profile. Check that, if the call is queued on the | |
30 -- new entry's queue, the original caller remains blocked after the | |
31 -- requeue, but the entry_body containing the requeue is completed. | |
32 -- | |
33 -- TEST DESCRIPTION: | |
34 -- Declare a protected object which simulates a disk device. Declare an | |
35 -- entry that requeues the caller to a second entry if the disk head is | |
36 -- not in the proper location, but first sets the second entry's barrier | |
37 -- to false. Declare a procedure which sets the second entry's barrier | |
38 -- to true. | |
39 -- | |
40 -- Declare a task which calls the first entry such that the requeue is | |
41 -- called. This task should be queued on the second entry and remain | |
42 -- blocked, and the first entry should be complete. Call the procedure | |
43 -- which releases the second entry's queue. The second entry should | |
44 -- complete, after which the task should complete. | |
45 -- | |
46 -- | |
47 -- CHANGE HISTORY: | |
48 -- 06 Dec 94 SAIC ACVC 2.0 | |
49 -- | |
50 --! | |
51 | |
52 package C954001_0 is -- Disk management abstraction. | |
53 | |
54 | |
55 -- Simulate a read-only disk device with a head that may be moved to | |
56 -- different tracks. If a read request is issued for the current | |
57 -- track, the request can be satisfied immediately. Otherwise, the head | |
58 -- must be moved to the correct track, during which time the calling task | |
59 -- is blocked. When the head reaches the correct track, the disk generates | |
60 -- an interrupt, after which the request can be satisfied, and the | |
61 -- calling task can proceed. | |
62 | |
63 Buffer_Size : constant := 100; | |
64 | |
65 type Disk_Buffer is new String (1 .. Buffer_Size); | |
66 type Disk_Track is new Natural; | |
67 | |
68 type Disk_Address is record | |
69 Track : Disk_Track; | |
70 -- Additional components. | |
71 end record; | |
72 | |
73 Initial_Track : constant Disk_Track := 0; | |
74 New_Track : constant Disk_Track := 5; | |
75 | |
76 --==============================================-- | |
77 | |
78 protected Disk_Device is | |
79 | |
80 entry Read (Where : Disk_Address; -- Read data from disk | |
81 Data : out Disk_Buffer); -- track. | |
82 | |
83 procedure Disk_Interrupt; -- Handle interrupt | |
84 -- from disk. | |
85 | |
86 function TC_Track return Disk_Track; -- Return current track. | |
87 | |
88 function TC_Pending_Queued return Boolean; -- True when there is | |
89 -- an entry in queue | |
90 | |
91 private | |
92 | |
93 entry Pending_Read (Where : Disk_Address; -- Wait for head to | |
94 Data : out Disk_Buffer); -- move then read data. | |
95 | |
96 Current_Track : Disk_Track := Initial_Track; -- Current disk track. | |
97 Operation_Pending : Boolean := False; -- Vis. entry barrier. | |
98 Disk_Interrupted : Boolean := False; -- Priv. entry barrier. | |
99 | |
100 end Disk_Device; | |
101 | |
102 | |
103 end C954001_0; | |
104 | |
105 | |
106 --==================================================================-- | |
107 | |
108 | |
109 package body C954001_0 is -- Disk management abstraction. | |
110 | |
111 | |
112 protected body Disk_Device is | |
113 | |
114 entry Read (Where : Disk_Address; Data : out Disk_Buffer) | |
115 when not Operation_Pending is | |
116 begin | |
117 if (Where.Track = Current_Track) then -- If the head is over the | |
118 -- Read data from disk... -- requested track, read | |
119 null; -- the data. | |
120 | |
121 else -- Otherwise, defer read | |
122 Operation_Pending := True; -- while head is moved to | |
123 -- correct track (signaled | |
124 -- -- -- by a disk interrupt). | |
125 -- Requeue is tested here -- | |
126 -- -- | |
127 | |
128 requeue Pending_Read; | |
129 | |
130 end if; | |
131 end Read; | |
132 | |
133 | |
134 procedure Disk_Interrupt is -- Called when the disk | |
135 begin -- interrupts, indicating | |
136 Disk_Interrupted := True; -- that the head is over | |
137 end Disk_Interrupt; -- the correct track. | |
138 | |
139 | |
140 function TC_Track return Disk_Track is -- Artifice required for | |
141 begin -- testing purposes. | |
142 return (Current_Track); | |
143 end TC_Track; | |
144 | |
145 | |
146 entry Pending_Read (Where : Disk_Address; Data : out Disk_Buffer) | |
147 when Disk_Interrupted is | |
148 begin | |
149 Current_Track := Where.Track; -- Head is now over the | |
150 -- Read data from disk... -- correct track; read | |
151 Operation_Pending := False; -- the data. | |
152 Disk_Interrupted := False; | |
153 end Pending_Read; | |
154 | |
155 function TC_Pending_Queued return Boolean is | |
156 begin | |
157 -- Return true when there is something on the Pending_Read queue | |
158 return (Pending_Read'Count /=0); | |
159 end TC_Pending_Queued; | |
160 | |
161 end Disk_Device; | |
162 | |
163 | |
164 end C954001_0; | |
165 | |
166 | |
167 --==================================================================-- | |
168 | |
169 | |
170 with Report; | |
171 with ImpDef; | |
172 | |
173 with C954001_0; -- Disk management abstraction. | |
174 use C954001_0; | |
175 | |
176 procedure C954001 is | |
177 | |
178 | |
179 task type Read_Task is -- an unusual (but legal) declaration | |
180 end Read_Task; | |
181 -- | |
182 -- | |
183 task body Read_Task is | |
184 Location : constant Disk_Address := (Track => New_Track); | |
185 Data : Disk_Buffer := (others => ' '); | |
186 begin | |
187 Disk_Device.Read (Location, Data); -- Invoke requeue statement. | |
188 exception | |
189 when others => | |
190 Report.Failed ("Exception raised in task"); | |
191 end Read_Task; | |
192 | |
193 --==============================================-- | |
194 | |
195 begin -- Main program. | |
196 | |
197 Report.Test ("C954001", "Requeue from an entry within a P.O. " & | |
198 "to a private entry within the same P.O."); | |
199 | |
200 | |
201 declare | |
202 | |
203 IO_Request : Read_Task; -- Request a read from other | |
204 -- than the current track. | |
205 -- IO_Request will be requeued | |
206 -- from Read to Pending_Read. | |
207 begin | |
208 | |
209 -- To pass this test, the following must be true: | |
210 -- | |
211 -- (A) The Read entry call made by the task IO_Request must be | |
212 -- completed by the requeue. | |
213 -- (B) IO_Request must remain blocked following the requeue. | |
214 -- (C) IO_Request must be queued on the Pending_Read entry queue. | |
215 -- (D) IO_Request must continue execution after the Pending_Read | |
216 -- entry completes. | |
217 -- | |
218 -- First, verify (A): that the Read entry call is complete. | |
219 -- | |
220 -- Call a protected operation (Disk_Device.TC_Track). Since no two | |
221 -- protected actions may proceed concurrently unless both are protected | |
222 -- function calls, a call to a protected operation at this point can | |
223 -- proceed only if the Read entry call is already complete. | |
224 -- | |
225 -- Note that if Read is NOT complete, the test will likely hang here. | |
226 -- | |
227 -- Next, verify (B): that IO_Request remains blocked following the | |
228 -- requeue. Also verify that Pending_Read (the entry to which | |
229 -- IO_Request should have been queued) has not yet executed. | |
230 | |
231 -- Wait until the task had made the call and the requeue has been | |
232 -- effected. | |
233 while not Disk_Device.TC_Pending_Queued loop | |
234 delay ImpDef.Minimum_Task_Switch; | |
235 end loop; | |
236 | |
237 if Disk_Device.TC_Track /= Initial_Track then | |
238 Report.Failed ("Target entry of requeue executed prematurely"); | |
239 elsif IO_Request'Terminated then | |
240 Report.Failed ("Caller did not remain blocked after " & | |
241 "the requeue or was never requeued"); | |
242 else | |
243 | |
244 -- Verify (C): that IO_Request is queued on the | |
245 -- Pending_Read entry queue. | |
246 -- | |
247 -- Set the barrier for Pending_Read to true. Check that the | |
248 -- current track is updated and that IO_Request terminates. | |
249 | |
250 Disk_Device.Disk_Interrupt; -- Simulate a disk interrupt, | |
251 -- signaling that the head is | |
252 -- over the correct track. | |
253 | |
254 -- The Pending_Read entry body will complete before the next | |
255 -- protected action is called (Disk_Device.TC_Track). | |
256 | |
257 if Disk_Device.TC_Track /= New_Track then | |
258 Report.Failed ("Caller was not requeued on target entry"); | |
259 end if; | |
260 | |
261 -- Finally, verify (D): that Read_Task continues after Pending_Read | |
262 -- completes. | |
263 -- | |
264 -- Note that the test will hang here if Read_Task does not continue | |
265 -- executing following the completion of the requeued entry call. | |
266 | |
267 end if; | |
268 | |
269 end; -- We will not exit the declare block until the task completes | |
270 | |
271 Report.Result; | |
272 | |
273 end C954001; |