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/] [c94008c.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C94008C.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 SELECT WITH TERMINATE ALTERNATIVE WORKS CORRECTLY WITH
26
-- NESTED TASKS.
27
 
28
-- THIS TEST CONTAINS RACE CONDITIONS AND USES A GENERIC INSTANCE THAT
29
-- CONTAINS TASKS.
30
 
31
-- JEAN-PIERRE ROSEN 24 FEBRUARY 1984
32
-- JRK 4/7/86
33
-- JBG 8/29/86 ELIMINATED SHARED VARIABLES; ADDED GENERIC UNIT
34
-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
35
 
36
with Impdef;
37
WITH REPORT; USE REPORT;
38
WITH SYSTEM; USE SYSTEM;
39
PROCEDURE C94008C IS
40
 
41
 
42
-- GENERIC UNIT FOR DOING UPDATES OF SHARED VARIABLES
43
     GENERIC
44
          TYPE HOLDER_TYPE IS PRIVATE;
45
          TYPE VALUE_TYPE IS PRIVATE;
46
          INITIAL_VALUE : HOLDER_TYPE;
47
          WITH PROCEDURE SET (HOLDER : OUT HOLDER_TYPE;
48
                              VALUE  : IN  HOLDER_TYPE) IS <>;
49
          WITH PROCEDURE UPDATE (HOLDER : IN OUT HOLDER_TYPE;
50
                                 VALUE  : IN  VALUE_TYPE) IS <>;
51
     PACKAGE SHARED IS
52
          PROCEDURE SET (VALUE : IN HOLDER_TYPE);
53
          PROCEDURE UPDATE (VALUE : IN VALUE_TYPE);
54
          FUNCTION GET RETURN HOLDER_TYPE;
55
     END SHARED;
56
 
57
     PACKAGE BODY SHARED IS
58
          TASK SHARE IS
59
               ENTRY SET    (VALUE : IN HOLDER_TYPE);
60
               ENTRY UPDATE (VALUE : IN VALUE_TYPE);
61
               ENTRY READ   (VALUE : OUT HOLDER_TYPE);
62
          END SHARE;
63
 
64
          TASK BODY SHARE IS
65
               VARIABLE : HOLDER_TYPE;
66
          BEGIN
67
               LOOP
68
                    SELECT
69
                         ACCEPT SET (VALUE : IN HOLDER_TYPE) DO
70
                              SHARED.SET (VARIABLE, VALUE);
71
                         END SET;
72
                    OR
73
                         ACCEPT UPDATE (VALUE : IN VALUE_TYPE) DO
74
                              SHARED.UPDATE (VARIABLE, VALUE);
75
                         END UPDATE;
76
                    OR
77
                         ACCEPT READ (VALUE : OUT HOLDER_TYPE) DO
78
                              VALUE := VARIABLE;
79
                         END READ;
80
                    OR
81
                         TERMINATE;
82
                    END SELECT;
83
               END LOOP;
84
          END SHARE;
85
 
86
          PROCEDURE SET (VALUE : IN HOLDER_TYPE) IS
87
          BEGIN
88
               SHARE.SET (VALUE);
89
          END SET;
90
 
91
          PROCEDURE UPDATE (VALUE : IN VALUE_TYPE) IS
92
          BEGIN
93
               SHARE.UPDATE (VALUE);
94
          END UPDATE;
95
 
96
          FUNCTION GET RETURN HOLDER_TYPE IS
97
               VALUE : HOLDER_TYPE;
98
          BEGIN
99
               SHARE.READ (VALUE);
100
               RETURN VALUE;
101
          END GET;
102
 
103
     BEGIN
104
          SHARE.SET (INITIAL_VALUE);    -- SET INITIAL VALUE
105
     END SHARED;
106
 
107
     PACKAGE EVENTS IS
108
 
109
          TYPE EVENT_TYPE IS
110
               RECORD
111
                    TRACE  : STRING (1..4) := "....";
112
                    LENGTH : NATURAL := 0;
113
               END RECORD;
114
 
115
          PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER);
116
          PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE);
117
     END EVENTS;
118
 
119
     PACKAGE COUNTER IS
120
          PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER);
121
          PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER);
122
     END COUNTER;
123
 
124
     PACKAGE BODY COUNTER IS
125
          PROCEDURE UPDATE (VAR : IN OUT INTEGER; VAL : INTEGER) IS
126
          BEGIN
127
               VAR := VAR + VAL;
128
          END UPDATE;
129
 
130
          PROCEDURE SET (VAR : OUT INTEGER; VAL : INTEGER) IS
131
          BEGIN
132
               VAR := VAL;
133
          END SET;
134
     END COUNTER;
135
 
136
     PACKAGE BODY EVENTS IS
137
          PROCEDURE UPDATE (VAR : IN OUT EVENT_TYPE; VAL : CHARACTER) IS
138
          BEGIN
139
               VAR.LENGTH := VAR.LENGTH + 1;
140
               VAR.TRACE(VAR.LENGTH) := VAL;
141
          END UPDATE;
142
 
143
          PROCEDURE SET (VAR : OUT EVENT_TYPE; VAL : EVENT_TYPE) IS
144
          BEGIN
145
               VAR := VAL;
146
          END SET;
147
 
148
     END EVENTS;
149
 
150
     USE EVENTS, COUNTER;
151
 
152
     PACKAGE TRACE IS NEW SHARED (EVENT_TYPE, CHARACTER, ("....", 0));
153
     PACKAGE TERMINATE_COUNT IS NEW SHARED (INTEGER, INTEGER, 0);
154
 
155
     FUNCTION ENTER_TERMINATE RETURN BOOLEAN IS
156
     BEGIN
157
          TERMINATE_COUNT.UPDATE (1);
158
          RETURN TRUE;
159
     END ENTER_TERMINATE;
160
 
161
BEGIN -- C94008C
162
 
163
     TEST ("C94008C", "CHECK CORRECT OPERATION OF SELECT WITH " &
164
                      "TERMINATE ALTERNATIVE");
165
 
166
     DECLARE
167
 
168
          PROCEDURE EVENT (VAR : CHARACTER) RENAMES TRACE.UPDATE;
169
 
170
          TASK T1 IS
171
               ENTRY E1;
172
          END T1;
173
 
174
          TASK BODY T1 IS
175
 
176
               TASK T2 IS
177
                    ENTRY E2;
178
               END T2;
179
 
180
               TASK BODY T2 IS
181
 
182
                    TASK T3 IS
183
                         ENTRY E3;
184
                    END T3;
185
 
186
                    TASK BODY T3 IS
187
                    BEGIN
188
                         SELECT
189
                              ACCEPT E3;
190
                         OR WHEN ENTER_TERMINATE => TERMINATE;
191
                         END SELECT;
192
                         EVENT ('D');
193
                    END T3;
194
 
195
               BEGIN -- T2
196
 
197
                    SELECT
198
                         ACCEPT E2;
199
                    OR WHEN ENTER_TERMINATE => TERMINATE;
200
                    END SELECT;
201
 
202
                    DELAY 10.0 * Impdef.One_Second;
203
 
204
                    IF TERMINATE_COUNT.GET /= 1 THEN
205
                         DELAY 20.0 * Impdef.One_Second;
206
                    END IF;
207
 
208
                    IF TERMINATE_COUNT.GET /= 1 THEN
209
                         FAILED ("30 SECOND DELAY NOT ENOUGH - 1 ");
210
                    END IF;
211
 
212
                    EVENT ('C');
213
                    T1.E1;
214
                    T3.E3;
215
               END T2;
216
 
217
          BEGIN -- T1;
218
 
219
               SELECT
220
                    ACCEPT E1;
221
               OR WHEN ENTER_TERMINATE => TERMINATE;
222
               END SELECT;
223
 
224
               EVENT ('B');
225
               TERMINATE_COUNT.SET (0);
226
               T2.E2;
227
 
228
               SELECT
229
                    ACCEPT E1;
230
               OR WHEN ENTER_TERMINATE => TERMINATE;
231
               END SELECT;
232
 
233
               SELECT
234
                    ACCEPT E1;
235
               OR TERMINATE;  -- ONLY THIS ONE EVER CHOSEN.
236
               END SELECT;
237
 
238
               FAILED ("TERMINATE NOT SELECTED IN T1");
239
          END T1;
240
 
241
     BEGIN
242
 
243
          DELAY 10.0 * Impdef.One_Second; -- WAIT FOR T1, T2, AND T3 TO GET TO SELECT STMTS.
244
 
245
           IF TERMINATE_COUNT.GET /= 3 THEN
246
                DELAY 20.0 * Impdef.One_Second;
247
           END IF;
248
 
249
           IF TERMINATE_COUNT.GET /= 3 THEN
250
                FAILED ("30 SECOND DELAY NOT ENOUGH - 2");
251
           END IF;
252
 
253
          EVENT ('A');
254
          T1.E1;
255
 
256
     EXCEPTION
257
          WHEN OTHERS => FAILED ("EXCEPTION IN MAIN BLOCK");
258
     END;
259
 
260
     IF TRACE.GET.TRACE /= "ABCD" THEN
261
          FAILED ("INCORRECT ORDER OF EVENTS: " & TRACE.GET.TRACE);
262
     END IF;
263
 
264
     RESULT;
265
END C94008C;

powered by: WebSVN 2.1.0

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