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

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c93005f.ada] - Blame information for rev 12

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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