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

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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