Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c9/c974010.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 -- C974010.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 to | |
29 -- a task that has already terminated. | |
30 -- | |
31 -- Check that Tasking_Error is properly propagated to the asynchronous | |
32 -- select statement and thus the sequence of statements of the triggering | |
33 -- alternative is not executed after the abortable part is left. | |
34 -- | |
35 -- Check that Tasking_Error is re-raised immediately following the | |
36 -- asynchronous select. | |
37 -- | |
38 -- TEST DESCRIPTION: | |
39 -- | |
40 -- Use a small subset of the base Automated Teller Machine simulation | |
41 -- which is shown in greater detail in other tests of this series. | |
42 -- Declare a main procedure containing an asynchronous select with a task | |
43 -- entry call as triggering statement. Ensure that the task is | |
44 -- terminated before the entry call. Use stripped down versions of | |
45 -- the called procedures to check the correct path in the test. | |
46 -- | |
47 -- | |
48 -- CHANGE HISTORY: | |
49 -- 06 Dec 94 SAIC ACVC 2.0 | |
50 -- | |
51 --! | |
52 | |
53 package C974010_0 is -- Automated teller machine abstraction. | |
54 | |
55 | |
56 Transaction_Canceled : exception; | |
57 | |
58 type Key_Enum is (None, Cancel, Deposit, Withdraw); | |
59 | |
60 type Card_Number_Type is private; | |
61 type Card_PIN_Type is private; | |
62 type ATM_Card_Type is private; | |
63 | |
64 task type ATM_Keyboard_Task is | |
65 entry Cancel_Pressed; | |
66 end ATM_Keyboard_Task; | |
67 | |
68 | |
69 procedure Validate_Card (Card : in ATM_Card_Type); | |
70 | |
71 procedure Perform_Transaction (Card : in ATM_Card_Type); | |
72 | |
73 | |
74 private | |
75 | |
76 type Card_Number_Type is range 1 .. 9999; | |
77 type Card_PIN_Type is range 100 .. 999; | |
78 | |
79 type ATM_Card_Type is record | |
80 Number : Card_Number_Type; | |
81 PIN : Card_PIN_Type; | |
82 end record; | |
83 | |
84 end C974010_0; | |
85 | |
86 | |
87 --==================================================================-- | |
88 | |
89 | |
90 with Report; | |
91 package body C974010_0 is | |
92 | |
93 | |
94 | |
95 -- One of these gets created as "Keyboard" for each transaction | |
96 -- | |
97 task body ATM_Keyboard_Task is | |
98 TC_Suicide : exception; | |
99 Key_Pressed : Key_Enum := None; | |
100 begin | |
101 raise TC_Suicide; -- Simulate early, unexpected termination | |
102 | |
103 accept Cancel_Pressed do -- queued entry call. | |
104 null; --:::: user code for cancel | |
105 | |
106 end Cancel_Pressed; | |
107 | |
108 exception | |
109 when TC_Suicide => | |
110 null; -- This is the expected test behavior | |
111 when others => | |
112 Report.Failed ("Unexpected Exception in ATM_Keyboard_Task"); | |
113 end ATM_Keyboard_Task; | |
114 | |
115 procedure Validate_Card (Card : in ATM_Card_Type) is | |
116 begin | |
117 Report.Failed ("Abortable part was executed"); | |
118 end Validate_Card; | |
119 | |
120 | |
121 procedure Perform_Transaction (Card : in ATM_Card_Type) is | |
122 begin | |
123 Report.Failed ("Exception not re-raised immediately following " & | |
124 "asynchronous select"); | |
125 end Perform_Transaction; | |
126 | |
127 | |
128 end C974010_0; | |
129 | |
130 | |
131 --==================================================================-- | |
132 | |
133 | |
134 with Report; | |
135 with ImpDef; | |
136 | |
137 with C974010_0; -- Automated teller machine abstraction. | |
138 use C974010_0; | |
139 | |
140 procedure C974010 is | |
141 | |
142 Card_Data : ATM_Card_Type; | |
143 TC_Tasking_Error_Handled : Boolean := false; | |
144 | |
145 begin -- Main program. | |
146 | |
147 Report.Test ("C974010", "Asynchronous Select: Trigger is a call to a " & | |
148 "task entry of a task that is already completed"); | |
149 | |
150 | |
151 declare | |
152 -- Create the task for this transaction | |
153 Keyboard : C974010_0.ATM_Keyboard_Task; | |
154 begin | |
155 | |
156 -- Ensure the task is already completed before calling | |
157 -- | |
158 while not Keyboard'terminated loop | |
159 delay ImpDef.Minimum_Task_Switch; | |
160 end loop; | |
161 | |
162 -- -- | |
163 -- Asynchronous select is tested here -- | |
164 -- -- | |
165 | |
166 select | |
167 | |
168 Keyboard.Cancel_Pressed; | |
169 | |
170 raise Transaction_Canceled; -- Should not be executed. | |
171 | |
172 then abort | |
173 | |
174 -- Since the triggering call is not queued the abortable part | |
175 -- should not be executed. | |
176 -- | |
177 Validate_Card (Card_Data); | |
178 | |
179 end select; | |
180 -- | |
181 -- The propagated exception is re-raised here. | |
182 | |
183 Perform_Transaction(Card_Data); -- Should not be reached. | |
184 | |
185 exception | |
186 when Transaction_Canceled => | |
187 Report.Failed ("Triggering alternative sequence of statements " & | |
188 "executed"); | |
189 when Tasking_Error => | |
190 -- This is the expected test path | |
191 TC_Tasking_Error_Handled := true; | |
192 when others => | |
193 Report.Failed ("Wrong exception raised: "); | |
194 end; | |
195 | |
196 | |
197 if not TC_Tasking_Error_Handled then | |
198 Report.Failed ("Tasking_Error not properly propagated"); | |
199 end if; | |
200 | |
201 Report.Result; | |
202 | |
203 exception | |
204 when Tasking_Error => | |
205 Report.Failed ("Tasking_Error propagated to wrong handler"); | |
206 Report.Result; | |
207 | |
208 | |
209 end C974010; |