1-- C954016.A
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--
26-- OBJECTIVE:
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
29--      unaffected.
30--
31-- TEST DESCRIPTION:
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.
39--
40--
41-- CHANGE HISTORY:
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
45--
46--!
47
48with Report;
49with ImpDef;
50
51procedure C954016 is
52
53   TC_Original_Caller_Complete  : Boolean := false;
54   TC_Intermediate_Complete     : Boolean := false;
55
56
57   protected type Shared_Boolean (Initial_Value : Boolean := False) is
58      procedure Set_True;
59      procedure Set_False;
60      function  Value return Boolean;
61   private
62      Current_Value : Boolean := Initial_Value;
63   end Shared_Boolean;
64
65   protected body Shared_Boolean is
66      procedure Set_True is
67      begin
68         Current_Value := True;
69      end Set_True;
70
71      procedure Set_False is
72      begin
73         Current_Value := False;
74      end Set_False;
75
76      function Value return Boolean is
77      begin
78         return Current_Value;
79      end Value;
80   end Shared_Boolean;
81
82   TC_Receiver_in_Accept        : Shared_Boolean (False);
83
84
85   task Original_Caller is
86      entry Start;
87   end Original_Caller;
88
89   task Intermediate is
90      entry Input;
91      entry TC_Abort_Process_Complete;
92   end Intermediate;
93
94   task Receiver is
95      entry Input;
96      entry TC_Never_Called;
97   end Receiver;
98
99
100   task body Original_Caller is
101   begin
102      accept Start;    -- wait for the trigger from Main
103
104      Intermediate.Input;
105      Report.Failed ("Tasking_Error not raised in Original_Caller task");
106
107   exception
108      when tasking_error =>
109               TC_Original_Caller_Complete := true;     -- expected behavior
110      when others        =>
111               Report.Failed ("Unexpected Exception in Original_Caller task");
112   end Original_Caller;
113
114
115   task body Intermediate is
116   begin
117      accept Input do
118         -- Within this accept call another task
119         requeue Receiver.Input with abort;
120      end Input;
121
122      -- Wait for Main to ensure that the abort housekeeping is finished
123      accept TC_Abort_Process_Complete;
124
125      TC_Intermediate_Complete := true;
126
127   exception
128      when others =>
129                Report.Failed ("Unexpected exception in Intermediate task");
130   end Intermediate;
131
132
133   task body Receiver is
134   begin
135      accept Input do
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;
139      end Input;
140   exception
141      when others  =>
142            Report.Failed ("Unexpected Exception in Receiver Task");
143
144   end Receiver;
145
146
147begin
148   Report.Test ("C954016", "Requeue: abort the called task");
149
150   Original_Caller.Start;
151
152   -- Wait till the rendezvous with Receiver is started
153   while not TC_Receiver_in_Accept.Value loop
154      delay ImpDef.Minimum_Task_Switch;
155   end loop;
156
157   -- At this point the Receiver is guaranteed to be in its accept
158   --
159   abort Receiver;
160
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;
164   end loop;
165
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;
169
170   -- Wait for everything to settle before reporting the result
171   while not ( Intermediate'terminated ) loop
172      delay ImpDef.Minimum_Task_Switch;
173   end loop;
174
175
176   if not ( TC_Original_Caller_Complete and TC_Intermediate_Complete ) then
177      Report.Failed ("Proper paths not traversed");
178   end if;
179
180   Report.Result;
181
182end C954016;
183