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 a task that is called by a requeue is aborted, the
28 -- original caller receives Tasking_Error and the requeuing task is
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 the Main aborts it. Check that Tasking_Error is raised in
35 -- the Original_Caller, that the Receiver does, indeed, get aborted and
36 -- the Intermediate task is undisturbed.
37 -- There are several delay loops in this test any one of which could
38 -- cause it to hang which would constitute failure.
42 -- 06 Dec 94 SAIC ACVC 2.0
43 -- 25 Nov 95 SAIC Replaced shared global variable with protected
44 -- object for ACVC 2.0.1
53 TC_Original_Caller_Complete
: Boolean := false;
54 TC_Intermediate_Complete
: Boolean := false;
57 protected type Shared_Boolean
(Initial_Value
: Boolean := False) is
60 function Value
return Boolean;
62 Current_Value
: Boolean := Initial_Value
;
65 protected body Shared_Boolean
is
68 Current_Value
:= True;
71 procedure Set_False
is
73 Current_Value
:= False;
76 function Value
return Boolean is
82 TC_Receiver_in_Accept
: Shared_Boolean
(False);
85 task Original_Caller
is
91 entry TC_Abort_Process_Complete
;
96 entry TC_Never_Called
;
100 task body Original_Caller
is
102 accept Start
; -- wait for the trigger from Main
105 Report
.Failed
("Tasking_Error not raised in Original_Caller task");
108 when tasking_error
=>
109 TC_Original_Caller_Complete
:= true; -- expected behavior
111 Report
.Failed
("Unexpected Exception in Original_Caller task");
115 task body Intermediate
is
118 -- Within this accept call another task
119 requeue Receiver
.Input
with abort;
122 -- Wait for Main to ensure that the abort housekeeping is finished
123 accept TC_Abort_Process_Complete
;
125 TC_Intermediate_Complete
:= true;
129 Report
.Failed
("Unexpected exception in Intermediate task");
133 task body Receiver
is
136 TC_Receiver_in_Accept
.Set_True
;
137 -- Hang within the accept body to allow Main to abort this task
138 accept TC_Never_Called
;
142 Report
.Failed
("Unexpected Exception in Receiver Task");
148 Report
.Test
("C954016", "Requeue: abort the called task");
150 Original_Caller
.Start
;
152 -- Wait till the rendezvous with Receiver is started
153 while not TC_Receiver_in_Accept
.Value
loop
154 delay ImpDef
.Minimum_Task_Switch
;
157 -- At this point the Receiver is guaranteed to be in its accept
161 -- Wait for the whole of the abort 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 Intermediate
.TC_Abort_Process_Complete
;
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 TC_Intermediate_Complete
) then
177 Report
.Failed
("Proper paths not traversed");