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.
27 -- Check that when an exception is raised in the rendezvous of a task
28 -- that was called by a requeue the exception is propagated to the
29 -- original caller and that the requeuing task is unaffected.
32 -- The Intermediate task requeues a call from the Original_Caller to the
33 -- Receiver. While the Receiver is in the accept body for this
34 -- rendezvous a Constraint_Error exception is raised. Check that the
35 -- exception is propagated to the Original_Caller, that the Receiver's
36 -- normal exception logic is employed and that the Intermediate task
38 -- There are several delay loops in this test any one of which could
39 -- cause it to hang (and thus fail).
43 -- 06 Dec 94 SAIC ACVC 2.0
44 -- 25 Nov 95 SAIC Fixed shared global variable problem for
55 TC_Original_Caller_Complete
: Boolean := false;
56 TC_Intermediate_Complete
: Boolean := false;
57 TC_Receiver_Complete
: Boolean := false;
58 TC_Exception
: Exception;
61 protected type Shared_Boolean
(Initial_Value
: Boolean := False) is
64 function Value
return Boolean;
66 Current_Value
: Boolean := Initial_Value
;
69 protected body Shared_Boolean
is
72 Current_Value
:= True;
75 procedure Set_False
is
77 Current_Value
:= False;
80 function Value
return Boolean is
86 TC_Exception_Process_Complete
: Shared_Boolean
(False);
88 task Original_Caller
is
101 task body Original_Caller
is
103 accept Start
; -- wait for the trigger from Main
106 Report
.Failed
("Exception not propagated to Original_Caller");
110 TC_Original_Caller_Complete
:= true; -- Expected behavior
112 Report
.Failed
("Unexpected Exception in Original_Caller task");
116 task body Intermediate
is
119 -- Within this accept call another task
120 requeue Receiver
.Input
with abort;
123 -- Wait for Main to ensure that the exception housekeeping is finished
124 while not TC_Exception_Process_Complete
.Value
loop
125 delay ImpDef
.Minimum_Task_Switch
;
128 TC_Intermediate_Complete
:= true;
132 Report
.Failed
("Unexpected exception in Intermediate task");
136 task body Receiver
is
140 null; -- the user code for the rendezvous is stubbed out
142 -- Test Control: Raise an exception in the destination task which
143 -- should then be propagated
149 TC_Receiver_Complete
:= true; -- expected behavior
151 Report
.Failed
("Unexpected Exception in Receiver Task");
157 Report
.Test
("C954017", "Requeue: exception processing");
159 Original_Caller
.Start
; -- Start the test after the Report.Test
161 -- Wait for the whole of the exception process to complete
162 while not ( Original_Caller
'terminated and Receiver
'terminated ) loop
163 delay ImpDef
.Minimum_Task_Switch
;
166 -- Inform the Intermediate task that the process is complete to allow
167 -- it to continue to completion itself
168 TC_Exception_Process_Complete
.Set_True
;
170 -- Wait for everything to settle before reporting the result
171 while not ( Intermediate
'terminated ) loop
172 delay ImpDef
.Minimum_Task_Switch
;
176 if not ( TC_Original_Caller_Complete
and
177 TC_Intermediate_Complete
and
178 TC_Receiver_Complete
) then
179 Report
.Failed
("Proper paths not traversed");