3 -- Grant of Unlimited Rights
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
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.
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.
30 -- CASE 2: TASKS IN DECLARATIVE PART OF A BLOCK AND PACKAGE
31 -- SPECIFICATION. THE TASKS DEPEND ON THE DECLARATIVE PART.
32 -- OTHER TASKS HAVE BEEN QUEUED ON THE TASKS' ENTRIES.
36 -- EG 10/30/85 ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.
37 -- PWN 01/31/95 REMOVED PRAGMA PRIORITY FOR ADA 9X.
38 -- ADDED PROCEDURE TO KEEP PACKAGE BODIES LEGAL.
42 WITH REPORT
; USE REPORT
;
43 WITH SYSTEM
; USE SYSTEM
;
44 PRAGMA ELABORATE
(REPORT
);
45 PACKAGE C93005D_PK1
IS
47 -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.
48 TASK TYPE UNACTIVATED
IS
52 TYPE ACC_UNACTIVATED
IS ACCESS UNACTIVATED
;
54 -- *******************************************
55 -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
56 -- *******************************************
58 -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT
59 -- TERMINATE). WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS
60 -- INCREMENTED AND A TASK IS CREATED. THE TASK WILL DECREMENT THE
61 -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.
62 -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT
63 -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR
66 -- AN MNT TASK. SUCH TASKS MUST NOT BE TERMINATED
67 -- BY ANYONE BUT THEMSELVES.
72 FUNCTION F
RETURN INTEGER;
74 -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK
75 -- AND FORCE CALLING F BEFORE CREATING THE TASK.
76 -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE
88 -- *******************************************
89 -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS
90 -- *******************************************
95 PACKAGE BODY C93005D_PK1
IS
97 -- THIS TASK IS CALLED IF AN UNACTIVATED TASK
98 -- IS EVER INCORRECTLY ACTIVATED. IT REPORTS FAILURE.
104 -- ***********************************************
105 -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
106 -- ***********************************************
108 -- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND
111 MNT_COUNT
: INTEGER := 0;
113 -- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE
120 -- SYNCHRONIZING TASK
122 TASK BODY MNT_COUNTER
IS
127 MNT_COUNT
:= MNT_COUNT
+1;
131 MNT_COUNT
:= MNT_COUNT
-1;
140 -- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED
142 FUNCTION F
RETURN INTEGER IS
148 -- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE
149 -- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK
150 -- ITSELF IS NOT TERMINATED.
154 IF MNT_COUNT
/= 0 OR MNT_COUNTER
'TERMINATED THEN
155 FAILED
("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &
158 -- RESET THE COUNT FOR THE NEXT SUBTEST:
162 -- A MUST NOT BE TERMINATED TASK. DELAY LONG ENOUGH
163 -- TO BE THE LAST TASK OF A SCOPE TO TERMINATE. THEN
164 -- DECREMENT THE COUNTER.
166 TASK BODY MNT_TASK
IS
168 DELAY 5.0 * Impdef
.One_Second
;
172 -- ***********************************************
173 -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS
174 -- ***********************************************
181 FAILED
("SOME TYPE U TASK WAS ACTIVATED");
189 -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.
191 TASK BODY UNACTIVATED
IS
197 WITH C93005D_PK1
; USE C93005D_PK1
;
198 PRAGMA ELABORATE
(C93005D_PK1
);
200 T1
: IN OUT UNACTIVATED
;
201 PACKAGE C93005D_ENQUEUE
IS
202 PROCEDURE REQUIRE_BODY
;
206 WITH REPORT
; USE REPORT
;
207 WITH SYSTEM
; USE SYSTEM
;
208 PRAGMA ELABORATE
(REPORT
);
209 PACKAGE BODY C93005D_ENQUEUE
IS
217 FAILED
("ENQUEUED CALLER DID NOT GET EXCEPTION");
219 WHEN TASKING_ERROR
=> NULL;
220 WHEN OTHERS => FAILED
("WRONG EXCEPTION RAISED");
223 PROCEDURE REQUIRE_BODY
IS
227 BEGIN -- T3 CALLS T1 HERE
228 DELAY 1.0 * Impdef
.One_Second
; -- ENSURE THAT T3 EXECUTES
231 WITH REPORT
, C93005D_PK1
, C93005D_ENQUEUE
;
232 USE REPORT
, C93005D_PK1
;
233 WITH SYSTEM
; USE SYSTEM
;
239 TEST
("C93005D", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &
242 COMMENT
("SUBTEST 2: TASKS IN DECL PART OF A BLOCK AND A PACKAGE " &
244 COMMENT
(" THE TASKS DEPEND ON THE DECLARATIVE PART");
245 COMMENT
(" OTHER TASKS HAVE BEEN ENQUEUED ON THE TASKS' ENTRIES");
251 TYPE ACC_MNT
IS ACCESS MNT
;
253 Y
: ACC_MNT
:= NEW MNT
;
255 PACKAGE HAS_UNACTIVATED
IS
257 Z
: ACC_MNT
:= NEW MNT
;
258 PACKAGE ENQUEUE1
IS NEW C93005D_ENQUEUE
(T1
);
259 PACKAGE ENQUEUE2
IS NEW C93005D_ENQUEUE
(T2
);
260 I
: POSITIVE := IDENT_INT
(0); -- RAISE
261 -- CONSTRAINT_ERROR EXCEPTION.
262 -- TERMINATES T1 AND T2 AND INDIRECTLY THE 2 T3'S
265 BEGIN -- WOULD HAVE BEEN ACTIVATED HERE
267 FAILED
("EXCEPTION NOT RAISED");
271 FAILED
("EXCEPTION RAISED IN WRONG SCOPE");
274 WHEN CONSTRAINT_ERROR
=>
275 COMMENT
("SUBTEST 2 COMPLETED");
277 FAILED
("WRONG EXCEPTION RAISED IN B22");
287 FAILED
("EXCEPTION NOT ABSORBED");