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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- C94010A.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 IF A GENERIC UNIT HAS A FORMAL LIMITED PRIVATE TYPE AND
26
-- DECLARES AN OBJECT OF THAT TYPE (OR HAS A SUBCOMPONENT OF THAT TYPE),
27
-- AND IF THE UNIT IS INSTANTIATED WITH A TASK TYPE OR AN OBJECT HAVING
28
-- A SUBCOMPONENT OF A TASK TYPE, THEN THE USUAL RULES APPLY TO THE
29
-- INSTANTIATED UNIT, NAMELY:
30
--     A) IF THE GENERIC UNIT IS A SUBPROGRAM, CONTROL CANNOT LEAVE THE
31
--        SUBPROGRAM UNTIL THE TASK CREATED BY THE OBJECT DECLARATION IS
32
--        TERMINATED.
33
 
34
-- THIS TEST CONTAINS RACE CONDITIONS AND SHARED VARIABLES.
35
 
36
-- TBN  9/22/86
37
-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
38
 
39
with Impdef;
40
WITH REPORT; USE REPORT;
41
WITH SYSTEM; USE SYSTEM;
42
PROCEDURE C94010A IS
43
 
44
     GLOBAL_INT : INTEGER := 0;
45
     MY_EXCEPTION : EXCEPTION;
46
 
47
     PACKAGE P IS
48
          TYPE LIM_PRI_TASK IS LIMITED PRIVATE;
49
     PRIVATE
50
          TASK TYPE LIM_PRI_TASK IS
51
          END LIM_PRI_TASK;
52
     END P;
53
 
54
     USE P;
55
 
56
     TASK TYPE TT IS
57
     END TT;
58
 
59
     TYPE REC IS
60
          RECORD
61
               A : INTEGER := 1;
62
               B : TT;
63
          END RECORD;
64
 
65
     TYPE LIM_REC IS
66
          RECORD
67
               A : INTEGER := 1;
68
               B : LIM_PRI_TASK;
69
          END RECORD;
70
 
71
     PACKAGE BODY P IS
72
          TASK BODY LIM_PRI_TASK IS
73
          BEGIN
74
               DELAY 30.0 * Impdef.One_Second;
75
               GLOBAL_INT := IDENT_INT (2);
76
          END LIM_PRI_TASK;
77
     END P;
78
 
79
     TASK BODY TT IS
80
     BEGIN
81
          DELAY 30.0 * Impdef.One_Second;
82
          GLOBAL_INT := IDENT_INT (1);
83
     END TT;
84
 
85
     GENERIC
86
          TYPE T IS LIMITED PRIVATE;
87
     PROCEDURE PROC (A : INTEGER);
88
 
89
     PROCEDURE PROC (A : INTEGER) IS
90
          OBJ_T : T;
91
     BEGIN
92
          IF A = IDENT_INT (1) THEN
93
               RAISE MY_EXCEPTION;
94
          END IF;
95
     END PROC;
96
 
97
     GENERIC
98
          TYPE T IS LIMITED PRIVATE;
99
     FUNCTION FUNC (A : INTEGER) RETURN INTEGER;
100
 
101
     FUNCTION FUNC (A : INTEGER) RETURN INTEGER IS
102
          OBJ_T : T;
103
     BEGIN
104
          IF A = IDENT_INT (1) THEN
105
               RAISE MY_EXCEPTION;
106
          END IF;
107
          RETURN 1;
108
     END FUNC;
109
 
110
 
111
BEGIN
112
     TEST ("C94010A", "CHECK TERMINATION RULES FOR INSTANTIATIONS OF " &
113
                      "GENERIC SUBPROGRAM UNITS WHICH CREATE TASKS");
114
 
115
     -------------------------------------------------------------------
116
     DECLARE
117
          PROCEDURE PROC1 IS NEW PROC (TT);
118
     BEGIN
119
          PROC1 (0);
120
          IF GLOBAL_INT = IDENT_INT (0) THEN
121
               FAILED ("TASK NOT DEPENDENT ON MASTER - 1");
122
               DELAY 35.0;
123
          END IF;
124
     END;
125
 
126
     -------------------------------------------------------------------
127
     GLOBAL_INT := IDENT_INT (0);
128
 
129
     DECLARE
130
          PROCEDURE PROC2 IS NEW PROC (REC);
131
     BEGIN
132
          PROC2 (1);
133
          FAILED ("EXCEPTION WAS NOT RAISED - 2");
134
     EXCEPTION
135
          WHEN MY_EXCEPTION =>
136
               IF GLOBAL_INT = IDENT_INT (0) THEN
137
                    FAILED ("TASK NOT DEPENDENT ON MASTER - 2");
138
                    DELAY 35.0 * Impdef.One_Second;
139
               END IF;
140
          WHEN OTHERS =>
141
               FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
142
     END;
143
 
144
     -------------------------------------------------------------------
145
     GLOBAL_INT := IDENT_INT (0);
146
 
147
     DECLARE
148
          PROCEDURE PROC3 IS NEW PROC (LIM_PRI_TASK);
149
     BEGIN
150
          PROC3 (1);
151
          FAILED ("EXCEPTION WAS NOT RAISED - 3");
152
     EXCEPTION
153
          WHEN MY_EXCEPTION =>
154
               IF GLOBAL_INT = IDENT_INT (0) THEN
155
                    FAILED ("TASK NOT DEPENDENT ON MASTER - 3");
156
                    DELAY 35.0 * Impdef.One_Second;
157
               END IF;
158
          WHEN OTHERS =>
159
               FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
160
     END;
161
 
162
     -------------------------------------------------------------------
163
     GLOBAL_INT := IDENT_INT (0);
164
 
165
     DECLARE
166
          PROCEDURE PROC4 IS NEW PROC (LIM_REC);
167
     BEGIN
168
          PROC4 (0);
169
          IF GLOBAL_INT = IDENT_INT (0) THEN
170
               FAILED ("TASK NOT DEPENDENT ON MASTER - 4");
171
               DELAY 35.0 * Impdef.One_Second;
172
          END IF;
173
     END;
174
 
175
     -------------------------------------------------------------------
176
     GLOBAL_INT := IDENT_INT (0);
177
 
178
     DECLARE
179
          A : INTEGER;
180
          FUNCTION FUNC1 IS NEW FUNC (TT);
181
     BEGIN
182
          A := FUNC1 (1);
183
          FAILED ("EXCEPTION NOT RAISED - 5");
184
     EXCEPTION
185
          WHEN MY_EXCEPTION =>
186
               IF GLOBAL_INT = IDENT_INT (0) THEN
187
                    FAILED ("TASK NOT DEPENDENT ON MASTER - 5");
188
                    DELAY 35.0 * Impdef.One_Second;
189
               END IF;
190
          WHEN OTHERS =>
191
               FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
192
     END;
193
 
194
     -------------------------------------------------------------------
195
     GLOBAL_INT := IDENT_INT (0);
196
 
197
     DECLARE
198
          A : INTEGER;
199
          FUNCTION FUNC2 IS NEW FUNC (REC);
200
     BEGIN
201
          A := FUNC2 (0);
202
          IF GLOBAL_INT = IDENT_INT (0) THEN
203
               FAILED ("TASK NOT DEPENDENT ON MASTER - 6");
204
               DELAY 35.0 * Impdef.One_Second;
205
          END IF;
206
     END;
207
 
208
     -------------------------------------------------------------------
209
     GLOBAL_INT := IDENT_INT (0);
210
 
211
     DECLARE
212
          A : INTEGER;
213
          FUNCTION FUNC3 IS NEW FUNC (LIM_PRI_TASK);
214
     BEGIN
215
          A := FUNC3 (0);
216
          IF GLOBAL_INT = IDENT_INT (0) THEN
217
               FAILED ("TASK NOT DEPENDENT ON MASTER - 7");
218
               DELAY 35.0 * Impdef.One_Second;
219
          END IF;
220
     END;
221
 
222
     -------------------------------------------------------------------
223
     GLOBAL_INT := IDENT_INT (0);
224
 
225
     DECLARE
226
          A : INTEGER;
227
          FUNCTION FUNC4 IS NEW FUNC (LIM_REC);
228
     BEGIN
229
          A := FUNC4 (1);
230
          FAILED ("EXCEPTION NOT RAISED - 8");
231
     EXCEPTION
232
          WHEN MY_EXCEPTION =>
233
               IF GLOBAL_INT = IDENT_INT (0) THEN
234
                    FAILED ("TASK NOT DEPENDENT ON MASTER - 8");
235
               END IF;
236
          WHEN OTHERS =>
237
               FAILED ("UNEXPECTED EXCEPTION RAISED - 8");
238
     END;
239
 
240
     -------------------------------------------------------------------
241
 
242
     RESULT;
243
END C94010A;

powered by: WebSVN 2.1.0

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