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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c94001c.ada] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- 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;

powered by: WebSVN 2.1.0

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