Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c9/c974004.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 -- C974004.A | |
2 -- | |
3 -- | |
4 -- Grant of Unlimited Rights | |
5 -- | |
6 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, | |
7 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained | |
8 -- unlimited rights in the software and documentation contained herein. | |
9 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making | |
10 -- this public release, the Government intends to confer upon all | |
11 -- recipients unlimited rights equal to those held by the Government. | |
12 -- These rights include rights to use, duplicate, release or disclose the | |
13 -- released technical data and computer software in whole or in part, in | |
14 -- any manner and for any purpose whatsoever, and to have or permit others | |
15 -- to do so. | |
16 -- | |
17 -- DISCLAIMER | |
18 -- | |
19 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR | |
20 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED | |
21 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE | |
22 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE | |
23 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A | |
24 -- PARTICULAR PURPOSE OF SAID MATERIAL. | |
25 --* | |
26 -- | |
27 -- OBJECTIVE: | |
28 -- Check that the abortable part of an asynchronous select statement | |
29 -- is aborted if it does not complete before the triggering statement | |
30 -- completes, where the triggering statement is a task entry call, | |
31 -- the entry call is queued, and the entry call completes by propagating | |
32 -- an exception and that the sequence of statements of the triggering | |
33 -- alternative is not executed after the abortable part is left and that | |
34 -- the exception propagated by the entry call is re-raised immediately | |
35 -- following the asynchronous select. | |
36 -- | |
37 -- TEST DESCRIPTION: | |
38 -- Declare a main procedure containing an asynchronous select with a task | |
39 -- entry call as triggering statement. Force the entry call to be | |
40 -- queued by having the task call a procedure, prior to the corresponding | |
41 -- accept statement, which simulates a routine waiting for user input | |
42 -- (with a delay). | |
43 -- | |
44 -- Simulate a time-consuming routine in the abortable part by calling a | |
45 -- procedure containing an infinite loop. Meanwhile, simulate input by | |
46 -- the user (the delay expires), which causes the task to execute the | |
47 -- accept statement corresponding to the triggering entry call. Raise | |
48 -- an exception in the accept statement which is not handled by the task, | |
49 -- and which is thus propagated to the caller. | |
50 -- | |
51 -- | |
52 -- CHANGE HISTORY: | |
53 -- 06 Dec 94 SAIC ACVC 2.0 | |
54 -- | |
55 --! | |
56 | |
57 package C974004_0 is -- Automated teller machine abstraction. | |
58 | |
59 | |
60 -- Flags for testing purposes: | |
61 | |
62 Count : Integer := 1234; -- Global to defeat | |
63 -- optimization. | |
64 Propagated_From_Task : exception; | |
65 | |
66 | |
67 type Key_Enum is (None, Cancel, Deposit, Withdraw); | |
68 | |
69 type Card_Number_Type is private; | |
70 type Card_PIN_Type is private; | |
71 type ATM_Card_Type is private; | |
72 | |
73 | |
74 Transaction_Canceled : exception; | |
75 | |
76 | |
77 task type ATM_Keyboard_Task is | |
78 entry Cancel_Pressed; | |
79 end ATM_Keyboard_Task; | |
80 | |
81 | |
82 procedure Read_Card (Card : in out ATM_Card_Type); | |
83 | |
84 procedure Validate_Card (Card : in ATM_Card_Type); | |
85 | |
86 procedure Perform_Transaction (Card : in ATM_Card_Type); | |
87 | |
88 private | |
89 | |
90 type Card_Number_Type is range 1 .. 9999; | |
91 type Card_PIN_Type is range 100 .. 999; | |
92 | |
93 type ATM_Card_Type is record | |
94 Number : Card_Number_Type; | |
95 PIN : Card_PIN_Type; | |
96 end record; | |
97 | |
98 end C974004_0; | |
99 | |
100 | |
101 --==================================================================-- | |
102 | |
103 | |
104 with Report; | |
105 with ImpDef; | |
106 | |
107 package body C974004_0 is | |
108 | |
109 | |
110 procedure Listen_For_Input (Key : out Key_Enum) is | |
111 begin | |
112 -- Simulate the situation where a user waits a bit for the card to | |
113 -- be validated, then presses cancel before it completes. | |
114 | |
115 -- Delay long enough to force queuing of Keyboard.Cancel_Pressed. | |
116 delay ImpDef.Clear_Ready_Queue; | |
117 | |
118 if Report.Equal (3, 3) then -- Always true. | |
119 Key := Cancel; | |
120 end if; | |
121 end Listen_For_Input; | |
122 | |
123 | |
124 -- One of these gets created as "Keyboard" for each transaction | |
125 -- | |
126 task body ATM_Keyboard_Task is | |
127 Key_Pressed : Key_Enum := None; | |
128 begin | |
129 loop | |
130 -- Force entry calls to be | |
131 Listen_For_Input (Key_Pressed); -- queued, then set guard to | |
132 -- true. | |
133 select | |
134 when (Key_Pressed = Cancel) => -- Guard is now true, so accept | |
135 accept Cancel_Pressed do -- queued entry call. | |
136 null; --:::: user code for cancel | |
137 -- Now simulate an unexpected exception arising in the | |
138 -- user code | |
139 raise Propagated_From_Task; -- Propagate an exception. | |
140 | |
141 end Cancel_Pressed; | |
142 | |
143 Report.Failed | |
144 ("Exception not propagated in ATM_Keyboard_Task"); | |
145 | |
146 -- User has canceled the transaction so we exit the | |
147 -- loop and allow the task to terminate | |
148 exit; | |
149 else | |
150 Key_Pressed := None; | |
151 end select; | |
152 end loop; | |
153 exception | |
154 when Propagated_From_Task => | |
155 null; -- This is the expected test behavior | |
156 when others => | |
157 Report.Failed ("Unexpected Exception in ATM_Keyboard_Task"); | |
158 end ATM_Keyboard_Task; | |
159 | |
160 | |
161 | |
162 procedure Read_Card (Card : in out ATM_Card_Type) is | |
163 begin | |
164 Card.Number := 9999; | |
165 Card.PIN := 111; | |
166 end Read_Card; | |
167 | |
168 | |
169 procedure Validate_Card (Card : in ATM_Card_Type) is | |
170 begin | |
171 -- Simulate an exceedingly long validation activity. | |
172 loop -- Infinite loop. | |
173 Count := (Count + 1) mod Integer (Card.PIN); | |
174 -- Synch. point to allow transfer of control to Keyboard | |
175 -- task during this simulation | |
176 delay ImpDef.Minimum_Task_Switch; | |
177 exit when not Report.Equal (Count, Count); -- Always false. | |
178 end loop; | |
179 end Validate_Card; | |
180 | |
181 | |
182 procedure Perform_Transaction (Card : in ATM_Card_Type) is | |
183 begin | |
184 Report.Failed ("Exception not re-raised immediately following " & | |
185 "asynchronous select"); | |
186 if Count = 1234 then | |
187 -- Initial value is unchanged | |
188 Report.Failed ("Abortable part did not execute"); | |
189 end if; | |
190 end Perform_Transaction; | |
191 | |
192 | |
193 end C974004_0; | |
194 | |
195 | |
196 --==================================================================-- | |
197 | |
198 | |
199 with Report; | |
200 | |
201 with C974004_0; -- Automated teller machine abstraction. | |
202 use C974004_0; | |
203 | |
204 procedure C974004 is | |
205 | |
206 Card_Data : ATM_Card_Type; | |
207 | |
208 begin -- Main program. | |
209 | |
210 Report.Test ("C974004", "Asynchronous Select: Trigger is queued on a " & | |
211 "task entry and is completed first by an " & | |
212 "exception"); | |
213 | |
214 Read_Card (Card_Data); | |
215 | |
216 begin | |
217 | |
218 declare | |
219 -- Create the task for this transaction | |
220 Keyboard : C974004_0.ATM_Keyboard_Task; | |
221 begin | |
222 | |
223 -- -- | |
224 -- Asynchronous select is tested here -- | |
225 -- -- | |
226 | |
227 select | |
228 Keyboard.Cancel_Pressed; -- Entry call initially queued, so | |
229 -- abortable part starts. | |
230 | |
231 raise Transaction_Canceled; -- Should not be executed. | |
232 then abort | |
233 Validate_Card (Card_Data); -- Keyboard.Cancel_Pressed is accepted | |
234 -- and propagates an exception before | |
235 -- this call finishes; it is then | |
236 -- aborted. | |
237 | |
238 -- Check that the whole of the abortable part is aborted, not | |
239 -- just the statement in the abortable part that was executing | |
240 -- at the time | |
241 Report.Failed ("Abortable part not aborted"); | |
242 end select; | |
243 -- The propagated exception is | |
244 -- re-raised here; control passes to | |
245 -- the exception handler. | |
246 | |
247 Perform_Transaction(Card_Data); -- Should not be reached. | |
248 exception | |
249 when Transaction_Canceled => | |
250 Report.Failed ("Triggering alternative sequence of statements " & | |
251 "executed"); | |
252 when Propagated_From_Task => | |
253 -- This is the expected test path | |
254 if Count = 1234 then | |
255 -- Initial value is unchanged | |
256 Report.Failed ("Abortable part did not execute"); | |
257 end if; | |
258 when Tasking_Error => | |
259 Report.Failed ("Tasking_Error raised"); | |
260 when others => | |
261 Report.Failed ("Wrong exception raised"); | |
262 end; | |
263 | |
264 exception | |
265 when Propagated_From_Task => | |
266 Report.Failed ("Correct exception raised at wrong level"); | |
267 when others => | |
268 Report.Failed ("Wrong exception raised at wrong level"); | |
269 end; | |
270 | |
271 Report.Result; | |
272 | |
273 end C974004; |