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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 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.