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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C93005E.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 AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE
26
-- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES
27
-- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A
28
-- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.
29
 
30
-- CASE 3: TASKS IN PACKAGE SPECIFICATION.
31
--         THE TASKS DON'T DEPEND ON THE PACKAGE SPECIFICATION.
32
 
33
-- RAC 19-MAR-1985
34
-- JBG 06/03/85
35
-- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
36
-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.
37
 
38
WITH REPORT; USE REPORT;
39
WITH SYSTEM; USE SYSTEM;
40
PRAGMA ELABORATE (REPORT);
41
PACKAGE C93005E_PK1 IS
42
 
43
     -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
44
     TASK TYPE UNACTIVATED IS
45
          ENTRY E;
46
     END UNACTIVATED;
47
 
48
     TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;
49
 
50
     TYPE BAD_REC IS
51
          RECORD
52
               T : UNACTIVATED;
53
               I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
54
          END RECORD;
55
 
56
     TYPE ACC_BAD_REC IS ACCESS BAD_REC;
57
 
58
 
59
     -- *******************************************
60
     -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
61
     -- *******************************************
62
     --
63
     -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
64
     -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
65
     -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE
66
     -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
67
     -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
68
     -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
69
     -- DECREMENT).
70
 
71
     -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED
72
     -- BY ANYONE BUT THEMSELVES.
73
     --
74
     TASK TYPE MNT_TASK IS
75
     END MNT_TASK;
76
 
77
     FUNCTION F RETURN INTEGER;
78
 
79
     -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
80
     -- AND FORCE CALLING F BEFORE CREATING THE TASK.
81
     -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
82
     -- COUNT.
83
     --
84
     TYPE MNT IS
85
          RECORD
86
               DUMMY : INTEGER :=  F;
87
               T     : MNT_TASK;
88
          END RECORD;
89
 
90
     PROCEDURE CHECK;
91
 
92
 
93
     -- *******************************************
94
     -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
95
     -- *******************************************
96
 
97
END C93005E_PK1;
98
 
99
with Impdef;
100
PACKAGE BODY C93005E_PK1 IS
101
 
102
-- THIS TASK IS CALLED IF AN UNACTIVATED TASK
103
-- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.
104
 
105
     TASK T IS
106
          ENTRY E;
107
     END;
108
 
109
     -- ***********************************************
110
     -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
111
     -- ***********************************************
112
 
113
-- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
114
-- ARE STILL ACTIVE.
115
 
116
     MNT_COUNT : INTEGER := 0;
117
 
118
-- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
119
 
120
     TASK MNT_COUNTER IS
121
          ENTRY INCR;
122
          ENTRY DECR;
123
     END MNT_COUNTER;
124
 
125
-- SYNCHRONIZING TASK
126
 
127
     TASK BODY MNT_COUNTER IS
128
     BEGIN
129
          LOOP
130
               SELECT
131
                    ACCEPT INCR DO
132
                         MNT_COUNT := MNT_COUNT +1;
133
                    END INCR;
134
 
135
               OR  ACCEPT DECR DO
136
                         MNT_COUNT := MNT_COUNT -1;
137
                    END DECR;
138
 
139
               OR  TERMINATE;
140
 
141
               END SELECT;
142
          END LOOP;
143
     END MNT_COUNTER;
144
 
145
-- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
146
--
147
     FUNCTION F RETURN INTEGER IS
148
     BEGIN
149
          MNT_COUNTER.INCR;
150
          RETURN 0;
151
     END F;
152
 
153
-- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
154
-- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
155
-- ITSELF IS NOT TERMINATED.
156
--
157
     PROCEDURE CHECK IS
158
     BEGIN
159
          IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN
160
               FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
161
                       "TERMINATED");
162
          END IF;
163
-- RESET THE COUNT FOR THE NEXT SUBTEST:
164
          MNT_COUNT := 0;
165
     END CHECK;
166
 
167
-- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH
168
-- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN
169
-- DECREMENT THE COUNTER.
170
--
171
     TASK BODY MNT_TASK IS
172
     BEGIN
173
          DELAY 5.0 * Impdef.One_Second;
174
          MNT_COUNTER.DECR;
175
     END MNT_TASK;
176
 
177
     -- ***********************************************
178
     -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
179
     -- ***********************************************
180
 
181
     TASK BODY T IS
182
     BEGIN
183
          LOOP
184
               SELECT
185
                    ACCEPT E DO
186
                         FAILED ("SOME TYPE U TASK WAS ACTIVATED");
187
                    END E;
188
 
189
               OR   TERMINATE;
190
               END SELECT;
191
          END LOOP;
192
     END T;
193
 
194
     -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
195
     --
196
     TASK BODY UNACTIVATED IS
197
     BEGIN
198
          T.E;
199
     END UNACTIVATED;
200
END C93005E_PK1;
201
 
202
WITH REPORT, C93005E_PK1;
203
USE  REPORT, C93005E_PK1;
204
WITH SYSTEM; USE SYSTEM;
205
PROCEDURE C93005E IS
206
 
207
 
208
BEGIN
209
 
210
     TEST("C93005E", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
211
                     "TASKS");
212
 
213
     COMMENT("SUBTEST 3: TASK IN DECL PART OF PACKAGE SPEC");
214
     COMMENT("  THE TASKS DON'T DEPEND ON THE DECLARATIVE PART");
215
B31: DECLARE
216
          X : MNT;
217
     BEGIN
218
B32:      BEGIN
219
B33:           DECLARE
220
                    PACKAGE RAISES_EXCEPTION IS
221
                         TYPE ACC_MNT IS ACCESS MNT;
222
                         Y   : ACC_MNT := NEW MNT;
223
                         PTR : ACC_BAD_REC := NEW BAD_REC;
224
                    END RAISES_EXCEPTION;
225
               BEGIN  -- WOULD HAVE BEEN ACTIVATED HERE
226
                    FAILED("EXCEPTION NOT RAISED");
227
               EXCEPTION
228
                    WHEN OTHERS =>
229
                         FAILED ("EXCEPTION RAISED IN WRONG SCOPE");
230
               END B33;
231
          EXCEPTION
232
               WHEN CONSTRAINT_ERROR =>
233
                    COMMENT("SUBTEST 3 COMPLETED");
234
               WHEN OTHERS =>
235
                    FAILED ("WRONG EXCEPTION RAISED IN B32");
236
          END B32;
237
     END B31;
238
 
239
     CHECK;
240
 
241
     RESULT;
242
 
243
EXCEPTION
244
     WHEN OTHERS =>
245
          FAILED ("EXCEPTION NOT ABSORBED");
246
          RESULT;
247
END C93005E;

powered by: WebSVN 2.1.0

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