Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c9/c94001c.ada @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 -- C94001C.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 A UNIT WITH INDIRECT DEPENDENT TASKS CREATED BY OBJECT
26 -- DECLARATIONS IS NOT TERMINATED UNTIL ALL INDIRECT DEPENDENT TASKS
27 -- BECOME TERMINATED.
28 -- SUBTESTS ARE:
29 -- (A, B) A BLOCK CONTAINING A SIMPLE TASK OBJECT, IN A BLOCK.
30 -- (C, D) A FUNCTION CONTAINING AN ARRAY OF TASK OBJECT, IN A
31 -- FUNCTION.
32 -- (E, F) A TASK CONTAINING AN ARRAY OF RECORD OF TASK OBJECT,
33 -- IN A TASK BODY.
34 -- CASES (B, D, F) EXIT BY RAISING AN EXCEPTION.
35
36 -- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
37
38 -- TBN 8/25/86
39 -- PWN 01/31/95 REMOVED PRAGMA PRIORITY FOR ADA 9X.
40
41 with Impdef;
42 WITH REPORT; USE REPORT;
43 WITH SYSTEM; USE SYSTEM;
44 PROCEDURE C94001C IS
45
46 MY_EXCEPTION : EXCEPTION;
47 GLOBAL : INTEGER;
48
49 TASK TYPE TT IS
50 ENTRY E (I : INTEGER);
51 END TT;
52
53 TASK BODY TT IS
54 LOCAL : INTEGER;
55 BEGIN
56 ACCEPT E (I : INTEGER) DO
57 LOCAL := I;
58 END E;
59 DELAY 30.0 * Impdef.One_Second; -- SINCE THE PARENT UNIT HAS HIGHER PRIORITY
60 -- AT THIS POINT, IT WILL RECEIVE CONTROL AND
61 -- TERMINATE IF THE ERROR IS PRESENT.
62 GLOBAL := LOCAL;
63 END TT;
64
65
66 BEGIN
67 TEST ("C94001C", "CHECK THAT A UNIT WITH INDIRECT DEPENDENT " &
68 "TASKS CREATED BY OBJECT DECLARATIONS IS NOT " &
69 "TERMINATED UNTIL ALL INDIRECT DEPENDENT TASKS " &
70 "BECOME TERMINATED");
71
72 --------------------------------------------------
73 GLOBAL := IDENT_INT (0);
74
75 BEGIN -- (A)
76
77 DECLARE
78 T : TT;
79 BEGIN
80 T.E (IDENT_INT(1));
81 END;
82
83 END; -- (A)
84
85 IF GLOBAL /= 1 THEN
86 FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
87 "BLOCK EXIT - 1");
88 END IF;
89
90 --------------------------------------------------
91
92 BEGIN -- (B)
93 GLOBAL := IDENT_INT (0);
94
95 BEGIN
96 DECLARE
97 T : TT;
98 BEGIN
99 T.E (IDENT_INT(2));
100 RAISE MY_EXCEPTION;
101 END;
102 END;
103
104 FAILED ("MY_EXCEPTION WAS NOT RAISED - 2");
105 EXCEPTION
106 WHEN MY_EXCEPTION =>
107 IF GLOBAL /= 2 THEN
108 FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
109 "BLOCK EXIT - 2");
110 END IF;
111 WHEN OTHERS =>
112 FAILED ("UNEXPECTED EXCEPTION - 2");
113 END; -- (B)
114
115 --------------------------------------------------
116
117 GLOBAL := IDENT_INT (0);
118
119 DECLARE -- (C)
120
121 OBJ_INT : INTEGER;
122
123 FUNCTION F1 RETURN INTEGER IS
124 I : INTEGER;
125
126 FUNCTION F2 RETURN INTEGER IS
127 A : ARRAY (1..1) OF TT;
128 BEGIN
129 A(1).E (IDENT_INT(3));
130 RETURN 0;
131 END F2;
132 BEGIN
133 I := F2;
134 RETURN (0);
135 END F1;
136
137 BEGIN -- (C)
138 OBJ_INT := F1;
139 IF GLOBAL /= 3 THEN
140 FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
141 "FUNCTION EXIT - 3");
142 END IF;
143 END; -- (C)
144
145 --------------------------------------------------
146
147 DECLARE -- (D)
148
149 OBJ_INT : INTEGER;
150
151 FUNCTION F1 RETURN INTEGER IS
152 I : INTEGER;
153
154 FUNCTION F2 RETURN INTEGER IS
155 A : ARRAY (1..1) OF TT;
156 BEGIN
157 A(1).E (IDENT_INT(4));
158 IF EQUAL (3, 3) THEN
159 RAISE MY_EXCEPTION;
160 END IF;
161 RETURN 0;
162 END F2;
163 BEGIN
164 I := F2;
165 RETURN (0);
166 END F1;
167
168 BEGIN -- (D)
169 GLOBAL := IDENT_INT (0);
170 OBJ_INT := F1;
171 FAILED ("MY_EXCEPTION WAS NOT RAISED - 4");
172 EXCEPTION
173 WHEN MY_EXCEPTION =>
174 IF GLOBAL /= 4 THEN
175 FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
176 "FUNCTION EXIT - 4");
177 END IF;
178 WHEN OTHERS =>
179 FAILED ("UNEXPECTED EXCEPTION - 4");
180 END; -- (D)
181
182 --------------------------------------------------
183
184 GLOBAL := IDENT_INT (0);
185
186 DECLARE -- (E)
187 DELAY_COUNT : INTEGER := 0;
188 TASK OUT_TSK;
189
190 TASK BODY OUT_TSK IS
191
192 TASK TSK IS
193 ENTRY ENT;
194 END TSK;
195
196 TASK BODY TSK IS
197 TYPE RT IS
198 RECORD
199 T : TT;
200 END RECORD;
201 AR : ARRAY (1..1) OF RT;
202 BEGIN
203 AR(1).T.E (IDENT_INT(5));
204 END TSK;
205
206 BEGIN
207 NULL;
208 END OUT_TSK;
209
210 BEGIN -- (E)
211 WHILE NOT(OUT_TSK'TERMINATED) AND DELAY_COUNT < 60 LOOP
212 DELAY 1.0 * Impdef.One_Long_Second;
213 DELAY_COUNT := DELAY_COUNT + 1;
214 END LOOP;
215 IF DELAY_COUNT = 60 THEN
216 FAILED ("OUT_TSK HAS NOT TERMINATED - 5");
217 ELSIF GLOBAL /= 5 THEN
218 FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
219 "BLOCK EXIT - 5");
220 END IF;
221 END; -- (E)
222
223 --------------------------------------------------
224
225 GLOBAL := IDENT_INT (0);
226
227 DECLARE
228 DELAY_COUNT : INTEGER := 0;
229
230 TASK OUT_TSK;
231
232 TASK BODY OUT_TSK IS
233
234 TASK TSK IS
235 ENTRY ENT;
236 END TSK;
237
238 TASK BODY TSK IS
239 TYPE RT IS
240 RECORD
241 T : TT;
242 END RECORD;
243 AR : ARRAY (1..1) OF RT;
244 BEGIN
245 AR(1).T.E (IDENT_INT(6));
246 RAISE MY_EXCEPTION;
247 END TSK;
248
249 BEGIN
250 RAISE MY_EXCEPTION;
251 END OUT_TSK;
252
253 BEGIN
254 WHILE NOT(OUT_TSK'TERMINATED) AND DELAY_COUNT < 60 LOOP
255 DELAY 1.0 * Impdef.One_Long_Second;
256 DELAY_COUNT := DELAY_COUNT + 1;
257 END LOOP;
258 IF DELAY_COUNT = 60 THEN
259 FAILED ("OUT_TSK HAS NOT TERMINATED - 6");
260 ELSIF GLOBAL /= 6 THEN
261 FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
262 "BLOCK EXIT - 6");
263 END IF;
264 END;
265
266 RESULT;
267 END C94001C;