Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c9/c93005g.ada @ 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 -- C93005G.ADA | |
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 -- CHECK THAT IF AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE | |
26 -- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES | |
27 -- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A | |
28 -- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR. | |
29 | |
30 -- CASE 5: TASKS IN STATEMENT PART OF A BLOCK. THE TASKS DON'T DEPEND | |
31 -- ON THE DECLARATIVE PART. | |
32 | |
33 -- RAC 19-MAR-1985 | |
34 -- JBG 06/03/85 | |
35 -- EG 10/30/85 ELIMINATE THE USE OF NUMERIC_ERROR IN TEST. | |
36 -- PWN 09/11/94 REMOVED PRAGMA PRIORITY FOR ADA 9X. | |
37 | |
38 WITH REPORT; USE REPORT; | |
39 WITH SYSTEM; USE SYSTEM; | |
40 PRAGMA ELABORATE (REPORT); | |
41 PACKAGE C93005G_PK1 IS | |
42 | |
43 -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED. | |
44 TASK TYPE UNACTIVATED IS | |
45 ENTRY E; | |
46 END UNACTIVATED; | |
47 | |
48 TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED; | |
49 | |
50 TYPE BAD_REC IS | |
51 RECORD | |
52 T : UNACTIVATED; | |
53 I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR. | |
54 END RECORD; | |
55 | |
56 TYPE ACC_BAD_REC IS ACCESS BAD_REC; | |
57 | |
58 | |
59 -- ******************************************* | |
60 -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS | |
61 -- ******************************************* | |
62 -- | |
63 -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT | |
64 -- TERMINATE). WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS | |
65 -- INCREMENTED AND A TASK IS CREATED. THE TASK WILL DECREMENT THE | |
66 -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED. | |
67 -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT | |
68 -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR | |
69 -- DECREMENT). | |
70 | |
71 -- AN MNT TASK. SUCH TASKS MUST NOT BE TERMINATED | |
72 -- BY ANYONE BUT THEMSELVES. | |
73 -- | |
74 TASK TYPE MNT_TASK IS | |
75 END MNT_TASK; | |
76 | |
77 FUNCTION F RETURN INTEGER; | |
78 | |
79 -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK | |
80 -- AND FORCE CALLING F BEFORE CREATING THE TASK. | |
81 -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE | |
82 -- COUNT. | |
83 -- | |
84 TYPE MNT IS | |
85 RECORD | |
86 DUMMY : INTEGER := F; | |
87 T : MNT_TASK; | |
88 END RECORD; | |
89 | |
90 PROCEDURE CHECK; | |
91 | |
92 | |
93 -- ******************************************* | |
94 -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS | |
95 -- ******************************************* | |
96 | |
97 END C93005G_PK1; | |
98 | |
99 with Impdef; | |
100 PACKAGE BODY C93005G_PK1 IS | |
101 | |
102 -- THIS TASK IS CALLED IF AN UNACTIVATED TASK | |
103 -- IS EVER INCORRECTLY ACTIVATED. IT REPORTS FAILURE. | |
104 | |
105 TASK T IS | |
106 ENTRY E; | |
107 END; | |
108 | |
109 -- *********************************************** | |
110 -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS | |
111 -- *********************************************** | |
112 | |
113 -- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND | |
114 -- ARE STILL ACTIVE. | |
115 | |
116 MNT_COUNT : INTEGER := 0; | |
117 | |
118 -- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE | |
119 | |
120 TASK MNT_COUNTER IS | |
121 ENTRY INCR; | |
122 ENTRY DECR; | |
123 END MNT_COUNTER; | |
124 | |
125 -- SYNCHRONIZING TASK | |
126 | |
127 TASK BODY MNT_COUNTER IS | |
128 BEGIN | |
129 LOOP | |
130 SELECT | |
131 ACCEPT INCR DO | |
132 MNT_COUNT := MNT_COUNT +1; | |
133 END INCR; | |
134 | |
135 OR ACCEPT DECR DO | |
136 MNT_COUNT := MNT_COUNT -1; | |
137 END DECR; | |
138 | |
139 OR TERMINATE; | |
140 | |
141 END SELECT; | |
142 END LOOP; | |
143 END MNT_COUNTER; | |
144 | |
145 -- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED | |
146 -- | |
147 FUNCTION F RETURN INTEGER IS | |
148 BEGIN | |
149 MNT_COUNTER.INCR; | |
150 RETURN 0; | |
151 END F; | |
152 | |
153 -- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE | |
154 -- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK | |
155 -- ITSELF IS NOT TERMINATED. | |
156 -- | |
157 PROCEDURE CHECK IS | |
158 BEGIN | |
159 IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN | |
160 FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " & | |
161 "TERMINATED"); | |
162 END IF; | |
163 -- RESET THE COUNT FOR THE NEXT SUBTEST: | |
164 MNT_COUNT := 0; | |
165 END CHECK; | |
166 | |
167 -- A MUST NOT BE TERMINATED TASK. DELAY LONG ENOUGH | |
168 -- TO BE THE LAST TASK OF A SCOPE TO TERMINATE. THEN | |
169 -- DECREMENT THE COUNTER. | |
170 -- | |
171 TASK BODY MNT_TASK IS | |
172 BEGIN | |
173 DELAY 5.0 * Impdef.One_Second; | |
174 MNT_COUNTER.DECR; | |
175 END MNT_TASK; | |
176 | |
177 -- *********************************************** | |
178 -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS | |
179 -- *********************************************** | |
180 | |
181 TASK BODY T IS | |
182 BEGIN | |
183 LOOP | |
184 SELECT | |
185 ACCEPT E DO | |
186 FAILED ("SOME TYPE U TASK WAS ACTIVATED"); | |
187 END E; | |
188 | |
189 OR TERMINATE; | |
190 END SELECT; | |
191 END LOOP; | |
192 END T; | |
193 | |
194 -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED. | |
195 -- | |
196 TASK BODY UNACTIVATED IS | |
197 BEGIN | |
198 T.E; | |
199 END UNACTIVATED; | |
200 END C93005G_PK1; | |
201 | |
202 WITH REPORT, C93005G_PK1; | |
203 USE REPORT, C93005G_PK1; | |
204 WITH SYSTEM; USE SYSTEM; | |
205 PROCEDURE C93005G IS | |
206 | |
207 | |
208 BEGIN | |
209 | |
210 TEST("C93005G", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " & | |
211 "TASKS"); | |
212 | |
213 COMMENT("SUBTEST 5: TASK IN STATEMENT PART OF BLOCK"); | |
214 COMMENT(" THE TASKS DON'T DEPEND ON THE DECLARATIVE PART"); | |
215 B51: DECLARE | |
216 X : MNT; | |
217 BEGIN | |
218 B52: DECLARE | |
219 Y : MNT; | |
220 PTR : ACC_BAD_REC; | |
221 BEGIN | |
222 PTR := NEW BAD_REC; | |
223 FAILED ("EXCEPTION NOT RAISED"); | |
224 EXCEPTION | |
225 WHEN CONSTRAINT_ERROR => | |
226 NULL; | |
227 WHEN OTHERS => | |
228 FAILED ("WRONG EXCEPTION IN B52"); | |
229 END B52; | |
230 | |
231 COMMENT ("SUBTEST 5: COMPLETED"); | |
232 EXCEPTION | |
233 WHEN OTHERS => | |
234 FAILED ("EXCEPTION NOT ABSORBED"); | |
235 END B51; | |
236 | |
237 CHECK; | |
238 | |
239 RESULT; | |
240 | |
241 EXCEPTION | |
242 WHEN OTHERS => | |
243 FAILED ("EXCEPTION NOT ABSORBED"); | |
244 RESULT; | |
245 END C93005G; |