Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c9/c974008.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 -- C974008.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 abortable part of an asynchronous select statement | |
28 -- is not started if the triggering statement is a task entry call, and | |
29 -- the entry call is not queued. | |
30 -- | |
31 -- Check that the sequence of statements of the triggering alternative | |
32 -- is executed after the abortable part is left. | |
33 -- | |
34 -- TEST DESCRIPTION: | |
35 -- Declare a main procedure containing an asynchronous select with a task | |
36 -- entry call as triggering statement. Ensure that the task is waiting | |
37 -- at the accept statement so the rendezvous is executed immediately (the | |
38 -- entry call is not queued). | |
39 -- | |
40 -- | |
41 -- CHANGE HISTORY: | |
42 -- 06 Dec 94 SAIC ACVC 2.0 | |
43 -- | |
44 --! | |
45 | |
46 package C974008_0 is -- Automated teller machine abstraction. | |
47 | |
48 | |
49 -- Flags for testing purposes: | |
50 | |
51 Triggering_Statement_Completed : Boolean := False; | |
52 Count : Integer := 1234; -- Global to defeat | |
53 -- optimization. | |
54 | |
55 type Key_Enum is (None, Cancel, Deposit, Withdraw); | |
56 | |
57 type Card_Number_Type is private; | |
58 type Card_PIN_Type is private; | |
59 type ATM_Card_Type is private; | |
60 | |
61 | |
62 Transaction_Canceled : exception; | |
63 | |
64 | |
65 task type ATM_Keyboard_Task is | |
66 entry Cancel_Pressed; | |
67 end ATM_Keyboard_Task; | |
68 | |
69 | |
70 procedure Read_Card (Card : in out ATM_Card_Type); | |
71 | |
72 | |
73 procedure Perform_Transaction (Card : in ATM_Card_Type); | |
74 | |
75 private | |
76 | |
77 type Card_Number_Type is range 1 .. 9999; | |
78 type Card_PIN_Type is range 100 .. 999; | |
79 | |
80 type ATM_Card_Type is record | |
81 Number : Card_Number_Type; | |
82 PIN : Card_PIN_Type; | |
83 end record; | |
84 | |
85 end C974008_0; | |
86 | |
87 | |
88 --==================================================================-- | |
89 | |
90 | |
91 with Report; | |
92 package body C974008_0 is | |
93 | |
94 | |
95 procedure Listen_For_Input (Key : out Key_Enum) is | |
96 begin | |
97 -- Simulate the situation where the user presses the cancel key | |
98 -- before the card is validated | |
99 | |
100 -- press the cancel key immediately | |
101 Key := Cancel; | |
102 | |
103 end Listen_For_Input; | |
104 | |
105 | |
106 | |
107 -- One of these gets created as "Keyboard" for each transaction | |
108 -- | |
109 task body ATM_Keyboard_Task is | |
110 Key_Pressed : Key_Enum := None; | |
111 begin | |
112 -- NOTE: Normal usage for this routine would be the loop with | |
113 -- the select statement included. This particular test | |
114 -- requires that the task be waiting at the accept | |
115 -- for the call. To ensure that this is the case the | |
116 -- extraneous commands are commented out (we leave them | |
117 -- in this form to show the reader the surrounds to the | |
118 -- fragment of code remaining) | |
119 | |
120 -- loop | |
121 | |
122 Listen_For_Input (Key_Pressed); | |
123 | |
124 -- select | |
125 -- when (Key_Pressed = Cancel) => -- Guard is now | |
126 accept Cancel_Pressed do -- true, so accept | |
127 Triggering_Statement_Completed := True; -- queued entry | |
128 end Cancel_Pressed; -- call. | |
129 | |
130 -- User has cancelled the transaction so we exit the | |
131 -- loop and allow the task to terminate | |
132 -- exit; | |
133 -- else | |
134 -- Key_Pressed := None; | |
135 -- end select; | |
136 | |
137 -- end loop; | |
138 exception | |
139 when others => | |
140 Report.Failed ("Unexpected Exception in ATM_Keyboard_Task"); | |
141 end ATM_Keyboard_Task; | |
142 | |
143 | |
144 | |
145 procedure Read_Card (Card : in out ATM_Card_Type) is | |
146 begin | |
147 Card.Number := 9999; | |
148 Card.PIN := 111; | |
149 end Read_Card; | |
150 | |
151 | |
152 procedure Perform_Transaction (Card : in ATM_Card_Type) is | |
153 begin | |
154 Report.Failed ("Triggering alternative sequence of statements " & | |
155 "not executed"); | |
156 if not Triggering_Statement_Completed then | |
157 Report.Failed ("Triggering statement did not complete"); | |
158 end if; | |
159 end Perform_Transaction; | |
160 | |
161 | |
162 end C974008_0; | |
163 | |
164 | |
165 --==================================================================-- | |
166 | |
167 | |
168 with Report; | |
169 with ImpDef; | |
170 | |
171 with C974008_0; -- Automated teller machine abstraction. | |
172 use C974008_0; | |
173 | |
174 procedure C974008 is | |
175 | |
176 Card_Data : ATM_Card_Type; | |
177 | |
178 begin -- Main program. | |
179 | |
180 Report.Test ("C974008", "Asynchronous Select: Trigger is a call to a " & | |
181 "waiting task entry and completes immediately"); | |
182 | |
183 Read_Card (Card_Data); | |
184 | |
185 declare | |
186 -- Create the task for this transaction | |
187 Keyboard : C974008_0.ATM_Keyboard_Task; | |
188 begin | |
189 | |
190 -- Ensure task is waiting at the accept | |
191 -- This is the time required to activate another task and allow it | |
192 -- to run to its first accept statement. | |
193 -- | |
194 delay ImpDef.Switch_To_New_Task; | |
195 | |
196 -- -- | |
197 -- Asynchronous select is tested here -- | |
198 -- -- | |
199 | |
200 select | |
201 Keyboard.Cancel_Pressed; -- Entry call is executed immediately | |
202 | |
203 raise Transaction_Canceled; -- This is executed after Validate_Card | |
204 -- is aborted. | |
205 then abort | |
206 | |
207 -- In other similar tests Validate_Card is called here. In this | |
208 -- test we just check to see if the abortable part is called at | |
209 -- all. Since the triggering call is not queued the abortable | |
210 -- part should not be started | |
211 -- | |
212 Report.Failed ("Abortable part started"); | |
213 | |
214 end select; | |
215 | |
216 Perform_Transaction (Card_Data); -- Should not be reached. | |
217 exception | |
218 when Transaction_Canceled => | |
219 | |
220 if not Triggering_Statement_Completed then | |
221 Report.Failed ("Triggering alternative sequence of statements " & | |
222 "executed but triggering statement not complete"); | |
223 end if; | |
224 | |
225 end; | |
226 | |
227 Report.Result; | |
228 | |
229 end C974008; |