OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c9a007a.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C9A007A.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 TASK MAY ABORT A TASK IT DEPENDS ON.
26
 
27
 
28
-- RM 5/26/82
29
-- RM 7/02/82
30
-- SPS 11/21/82
31
-- JBG 2/27/84
32
-- JBG 3/8/84
33
-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
34
-- EDS 08/04/98 ENSURE THAT ABORTED TASKS HAVE TIME TO EFFECT THEIR ABORTIONS.
35
 
36
WITH IMPDEF;
37
WITH REPORT; USE REPORT;
38
WITH SYSTEM; USE SYSTEM;
39
PROCEDURE  C9A007A  IS
40
 
41
      TASK_NOT_ABORTED : BOOLEAN := FALSE;
42
      TEST_VALID       : BOOLEAN := TRUE ;
43
 
44
BEGIN
45
 
46
 
47
     -------------------------------------------------------------------
48
 
49
 
50
     TEST ( "C9A007A" , "CHECK THAT A TASK MAY ABORT A TASK" &
51
                        " IT DEPENDS ON"                     );
52
 
53
 
54
     DECLARE
55
 
56
 
57
          TASK  REGISTER  IS
58
 
59
 
60
               ENTRY  BIRTHS_AND_DEATHS;
61
 
62
               ENTRY  SYNC1;
63
               ENTRY  SYNC2;
64
 
65
 
66
          END  REGISTER;
67
 
68
 
69
          TASK BODY  REGISTER  IS
70
 
71
 
72
               TASK TYPE  SECONDARY  IS
73
 
74
 
75
                    ENTRY  WAIT_INDEFINITELY;
76
 
77
               END  SECONDARY;
78
 
79
 
80
               TASK TYPE  T_TYPE1  IS
81
 
82
 
83
                    ENTRY  E;
84
 
85
               END  T_TYPE1;
86
 
87
 
88
               TASK TYPE  T_TYPE2  IS
89
 
90
 
91
                    ENTRY  E;
92
 
93
               END  T_TYPE2;
94
 
95
 
96
               T_OBJECT1 : T_TYPE1;
97
               T_OBJECT2 : T_TYPE2;
98
 
99
 
100
               TASK BODY  SECONDARY  IS
101
               BEGIN
102
                    SYNC1;
103
                    ABORT  T_OBJECT1;
104
                    DELAY 0.0;
105
                    TASK_NOT_ABORTED  :=  TRUE;
106
               END  SECONDARY;
107
 
108
 
109
               TASK BODY  T_TYPE1  IS
110
 
111
                    TYPE  ACCESS_TO_TASK  IS  ACCESS SECONDARY;
112
 
113
               BEGIN
114
 
115
 
116
                    DECLARE
117
                         DEPENDENT_BY_ACCESS   :  ACCESS_TO_TASK  :=
118
                                                  NEW  SECONDARY ;
119
                    BEGIN
120
                         NULL;
121
                    END;
122
 
123
 
124
                    BIRTHS_AND_DEATHS;
125
                                     -- DURING THIS SUSPENSION
126
                                     --     MOST OF THE TASKS
127
                                     --     ARE ABORTED   (FIRST
128
                                     --     TASK #1    -- T_OBJECT1 --
129
                                     --     THEN  #2 ).
130
 
131
 
132
                    TASK_NOT_ABORTED := TRUE;
133
 
134
 
135
               END  T_TYPE1;
136
 
137
 
138
               TASK BODY  T_TYPE2  IS
139
 
140
                    TASK  INNER_TASK  IS
141
 
142
 
143
                         ENTRY  WAIT_INDEFINITELY;
144
 
145
                    END  INNER_TASK;
146
 
147
                    TASK BODY  INNER_TASK  IS
148
                    BEGIN
149
                         SYNC2;
150
                         ABORT  T_OBJECT2;
151
                         DELAY 0.0;
152
                         TASK_NOT_ABORTED  :=  TRUE;
153
                    END  INNER_TASK;
154
 
155
               BEGIN
156
 
157
 
158
                    BIRTHS_AND_DEATHS;
159
                                     -- DURING THIS SUSPENSION
160
                                     --     MOST OF THE TASKS
161
                                     --     ARE ABORTED   (FIRST
162
                                     --     TASK #1     -- T_OBJECT1 --
163
                                     --     THEN  #2 ).
164
 
165
 
166
                    TASK_NOT_ABORTED := TRUE;
167
 
168
 
169
               END  T_TYPE2;
170
 
171
 
172
          BEGIN
173
 
174
               DECLARE
175
                    OLD_COUNT : INTEGER := 0;
176
               BEGIN
177
 
178
 
179
                    FOR  I  IN  1..5  LOOP
180
                         EXIT WHEN  BIRTHS_AND_DEATHS'COUNT = 2;
181
                         DELAY 10.0 * Impdef.One_Second;
182
                    END LOOP;
183
 
184
                    OLD_COUNT := BIRTHS_AND_DEATHS'COUNT;
185
 
186
                    IF  OLD_COUNT = 2  THEN
187
 
188
                         ACCEPT  SYNC1;   -- ALLOWING  ABORT#1
189
 
190
                         DELAY IMPDEF.CLEAR_READY_QUEUE;
191
 
192
                         -- CHECK THAT  #1  WAS ABORTED  -  3 WAYS:
193
 
194
                         BEGIN
195
                              T_OBJECT1.E;
196
                              FAILED( "T_OBJECT1.E  DID NOT RAISE" &
197
                                                   "  TASKING_ERROR" );
198
                         EXCEPTION
199
 
200
                              WHEN TASKING_ERROR  =>
201
                                   NULL;
202
 
203
                              WHEN OTHERS  =>
204
                                   FAILED("OTHER EXCEPTION RAISED - 1");
205
 
206
                         END;
207
 
208
                         IF T_OBJECT1'CALLABLE  THEN
209
                              FAILED( "T_OBJECT1'CALLABLE = TRUE" );
210
                         END IF;
211
 
212
                         IF  OLD_COUNT - BIRTHS_AND_DEATHS'COUNT /= 1
213
                         THEN
214
                              FAILED( "TASK#1 NOT REMOVED FROM QUEUE" );
215
                         END IF;
216
 
217
 
218
                         OLD_COUNT := BIRTHS_AND_DEATHS'COUNT;
219
 
220
 
221
                         ACCEPT  SYNC2;   -- ALLOWING  ABORT#2
222
 
223
                         DELAY IMPDEF.CLEAR_READY_QUEUE;
224
 
225
                         -- CHECK THAT  #2  WAS ABORTED  -  3 WAYS:
226
 
227
                         BEGIN
228
                              T_OBJECT2.E;
229
                              FAILED( "T_OBJECT2.E  DID NOT RAISE" &
230
                                                   "  TASKING_ERROR" );
231
                         EXCEPTION
232
 
233
                              WHEN TASKING_ERROR  =>
234
                                   NULL;
235
 
236
                              WHEN OTHERS  =>
237
                                   FAILED("OTHER EXCEPTION RAISED - 2");
238
 
239
                         END;
240
 
241
                         IF T_OBJECT2'CALLABLE  THEN
242
                              FAILED( "T_OBJECT2'CALLABLE = TRUE" );
243
                         END IF;
244
 
245
                         IF  OLD_COUNT - BIRTHS_AND_DEATHS'COUNT /= 1
246
                         THEN
247
                              FAILED( "TASK#2 NOT REMOVED FROM QUEUE" );
248
                         END IF;
249
 
250
 
251
                         IF  BIRTHS_AND_DEATHS'COUNT /= 0  THEN
252
                              FAILED( "SOME TASKS STILL QUEUED" );
253
                         END IF;
254
 
255
 
256
                    ELSE
257
 
258
                         COMMENT( "LINEUP NOT COMPLETE (AFTER 50 S.)" );
259
                         TEST_VALID  :=  FALSE;
260
 
261
                    END IF;
262
 
263
 
264
               END;
265
 
266
 
267
               WHILE  BIRTHS_AND_DEATHS'COUNT > 0  LOOP
268
                    ACCEPT  BIRTHS_AND_DEATHS;
269
               END LOOP;
270
 
271
 
272
          END  REGISTER;
273
 
274
 
275
     BEGIN
276
 
277
          NULL;
278
 
279
     END;
280
 
281
 
282
     -------------------------------------------------------------------
283
 
284
 
285
     IF  TEST_VALID  AND  TASK_NOT_ABORTED  THEN
286
          FAILED( "SOME TASKS NOT ABORTED" );
287
     END IF;
288
 
289
 
290
     RESULT;
291
 
292
 
293
END  C9A007A;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.