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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c94007a.ada] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C94007A.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
-- OBJECTIVE:
26
--     CHECK THAT A TASK THAT IS DECLARED IN A NON-LIBRARY PACKAGE
27
--     (SPECIFICATION OR BODY) DOES NOT "DEPEND" ON THE PACKAGE,
28
--     BUT ON THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM BODY,
29
--     OR TASK BODY.
30
--     SUBTESTS ARE:
31
--       (A)  A SIMPLE TASK OBJECT, IN A VISIBLE PART, IN A BLOCK.
32
--       (B)  AN ARRAY OF TASK OBJECT, IN A PRIVATE PART, IN A FUNCTION.
33
--       (C)  AN ARRAY OF RECORD OF TASK OBJECT, IN A PACKAGE BODY,
34
--            IN A TASK BODY.
35
 
36
-- HISTORY:
37
--     JRK 10/13/81
38
--     SPS 11/21/82
39
--     DHH 09/07/88 REVISED HEADER, ADDED EXCEPTION HANDLERS ON OUTER
40
--                  BLOCKS, AND ADDED CASE TO INSURE THAT LEAVING A
41
--                  PACKAGE VIA AN EXCEPTION WOULD NOT ABORT TASKS.
42
--     PWN 01/31/95 REMOVED PRAGMA PRIORITY FOR ADA 9X.
43
 
44
with Impdef;
45
WITH REPORT; USE REPORT;
46
WITH SYSTEM; USE SYSTEM;
47
PROCEDURE C94007A IS
48
 
49
     TASK TYPE SYNC IS
50
          ENTRY ID (C : CHARACTER);
51
          ENTRY INNER;
52
          ENTRY OUTER;
53
     END SYNC;
54
 
55
     TASK BODY SYNC IS
56
          ID_C : CHARACTER;
57
     BEGIN
58
          ACCEPT ID (C : CHARACTER) DO
59
               ID_C := C;
60
          END ID;
61
          DELAY 1.0 * Impdef.One_Second;
62
          SELECT
63
               ACCEPT OUTER;
64
          OR
65
               DELAY 120.0 * Impdef.One_Second;
66
               FAILED ("PROBABLY BLOCKED - (" & ID_C & ')');
67
          END SELECT;
68
          ACCEPT INNER;
69
     END SYNC;
70
 
71
 
72
BEGIN
73
     TEST ("C94007A", "CHECK THAT A TASK THAT IS DECLARED IN A " &
74
                      "NON-LIBRARY PACKAGE (SPECIFICATION OR BODY) " &
75
                      "DOES NOT ""DEPEND"" ON THE PACKAGE, BUT ON " &
76
                      "THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM " &
77
                      "BODY, OR TASK BODY");
78
 
79
     --------------------------------------------------
80
 
81
     DECLARE -- (A)
82
 
83
          S : SYNC;
84
 
85
     BEGIN -- (A)
86
 
87
          S.ID ('A');
88
 
89
          DECLARE
90
 
91
               PACKAGE PKG IS
92
                    TASK T IS
93
                         ENTRY E;
94
                    END T;
95
               END PKG;
96
 
97
               PACKAGE BODY PKG IS
98
                    TASK BODY T IS
99
                    BEGIN
100
                         S.INNER;  -- PROBABLE INNER BLOCK POINT.
101
                    END T;
102
               END PKG;            -- PROBABLE OUTER BLOCK POINT.
103
 
104
          BEGIN
105
 
106
               S.OUTER;
107
 
108
          EXCEPTION
109
               WHEN TASKING_ERROR => NULL;
110
          END;
111
 
112
     EXCEPTION
113
          WHEN OTHERS =>
114
               FAILED("UNEXPECTED EXCEPTION RAISED - A");
115
     END; -- (A)
116
 
117
     --------------------------------------------------
118
 
119
     DECLARE -- (B)
120
 
121
          S : SYNC;
122
 
123
          I : INTEGER;
124
 
125
          FUNCTION F RETURN INTEGER IS
126
 
127
               PACKAGE PKG IS
128
               PRIVATE
129
                    TASK TYPE TT IS
130
                         ENTRY E;
131
                    END TT;
132
                    A : ARRAY (1..1) OF TT;
133
               END PKG;
134
 
135
               PACKAGE BODY PKG IS
136
                    TASK BODY TT IS
137
                    BEGIN
138
                         S.INNER;  -- PROBABLE INNER BLOCK POINT.
139
                    END TT;
140
               END PKG;            -- PROBABLE OUTER BLOCK POINT.
141
 
142
          BEGIN -- F
143
 
144
               S.OUTER;
145
               RETURN 0;
146
 
147
          EXCEPTION
148
               WHEN TASKING_ERROR => RETURN 0;
149
          END F;
150
 
151
     BEGIN -- (B)
152
 
153
          S.ID ('B');
154
          I := F;
155
 
156
     EXCEPTION
157
          WHEN OTHERS =>
158
               FAILED("UNEXPECTED EXCEPTION RAISED - B");
159
 
160
     END; -- (B)
161
 
162
     --------------------------------------------------
163
 
164
     DECLARE -- (C)
165
 
166
          S : SYNC;
167
 
168
     BEGIN -- (C)
169
 
170
          S.ID ('C');
171
 
172
          DECLARE
173
 
174
               TASK TSK IS
175
               END TSK;
176
 
177
               TASK BODY TSK IS
178
 
179
                    PACKAGE PKG IS
180
                    END PKG;
181
 
182
                    PACKAGE BODY PKG IS
183
                         TASK TYPE TT IS
184
                              ENTRY E;
185
                         END TT;
186
 
187
                         TYPE RT IS
188
                              RECORD
189
                                   T : TT;
190
                              END RECORD;
191
 
192
                         AR : ARRAY (1..1) OF RT;
193
 
194
                         TASK BODY TT IS
195
                         BEGIN
196
                              S.INNER;  -- PROBABLE INNER BLOCK POINT.
197
                         END TT;
198
                    END PKG;            -- PROBABLE OUTER BLOCK POINT.
199
 
200
               BEGIN -- TSK
201
 
202
                    S.OUTER;
203
 
204
               EXCEPTION
205
                    WHEN TASKING_ERROR => NULL;
206
               END TSK;
207
 
208
          BEGIN
209
               NULL;
210
          END;
211
 
212
     EXCEPTION
213
          WHEN OTHERS =>
214
               FAILED("UNEXPECTED EXCEPTION RAISED - C");
215
     END; -- (C)
216
 
217
     --------------------------------------------------
218
 
219
     DECLARE -- (D)
220
 
221
     GLOBAL : INTEGER := IDENT_INT(5);
222
 
223
     BEGIN -- (D)
224
 
225
          DECLARE
226
 
227
               PACKAGE PKG IS
228
                    TASK T IS
229
                         ENTRY E;
230
                    END T;
231
 
232
                    TASK T1 IS
233
                    END T1;
234
               END PKG;
235
 
236
               PACKAGE BODY PKG IS
237
                    TASK BODY T IS
238
                    BEGIN
239
                         ACCEPT E DO
240
                              RAISE CONSTRAINT_ERROR;
241
                         END E;
242
                    END T;
243
 
244
                    TASK BODY T1 IS
245
                    BEGIN
246
                         DELAY 120.0 * Impdef.One_Second;
247
                         GLOBAL := IDENT_INT(1);
248
                    END T1;
249
 
250
               BEGIN
251
                    T.E;
252
 
253
               END PKG;
254
               USE PKG;
255
          BEGIN
256
               NULL;
257
          END;
258
 
259
     EXCEPTION
260
          WHEN CONSTRAINT_ERROR =>
261
               IF GLOBAL /= IDENT_INT(1) THEN
262
                    FAILED("TASK NOT COMPLETED");
263
               END IF;
264
 
265
          WHEN OTHERS =>
266
               FAILED("UNEXPECTED EXCEPTION RAISED - D");
267
     END; -- (D)
268
 
269
     RESULT;
270
END C94007A;

powered by: WebSVN 2.1.0

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