1-- C954018.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 if a task is aborted while a requeued call is queued 28-- on one of its entries the original caller receives Tasking_Error 29-- and the requeuing task is unaffected. 30-- This test uses: Requeue to an entry in a different task 31-- Parameterless call 32-- Requeue with abort 33-- 34-- TEST DESCRIPTION: 35-- The Intermediate task requeues a call from the Original_Caller to the 36-- Receiver on an entry with a guard that is always false. While the 37-- Original_Caller is still queued the Receiver is aborted. 38-- Check that Tasking_Error is raised in the Original_Caller, that the 39-- Receiver does, indeed, get aborted and the Intermediate task 40-- is undisturbed. 41-- There are several delay loops in this test any one of which could 42-- cause it to hang and thus indicate failure. 43-- 44-- 45-- CHANGE HISTORY: 46-- 06 Dec 94 SAIC ACVC 2.0 47-- 48--! 49 50 51with Report; 52with ImpDef; 53 54 55procedure C954018 is 56 57 58 -- Protected object to control the shared test variables 59 -- 60 protected TC_State is 61 function On_Entry_Queue return Boolean; 62 procedure Set_On_Entry_Queue; 63 function Original_Caller_Complete return Boolean; 64 procedure Set_Original_Caller_Complete; 65 function Intermediate_Complete return Boolean; 66 procedure Set_Intermediate_Complete; 67 private 68 On_Entry_Queue_Flag : Boolean := false; 69 Original_Caller_Complete_Flag : Boolean := false; 70 Intermediate_Complete_Flag : Boolean := false; 71 end TC_State; 72 -- 73 -- 74 protected body TC_State is 75 function On_Entry_Queue return Boolean is 76 begin 77 return On_Entry_Queue_Flag; 78 end On_Entry_Queue; 79 80 procedure Set_On_Entry_Queue is 81 begin 82 On_Entry_Queue_Flag := true; 83 end Set_On_Entry_Queue; 84 85 function Original_Caller_Complete return Boolean is 86 begin 87 return Original_Caller_Complete_Flag; 88 end Original_Caller_Complete; 89 90 procedure Set_Original_Caller_Complete is 91 begin 92 Original_Caller_Complete_Flag := true; 93 end Set_Original_Caller_Complete; 94 95 function Intermediate_Complete return Boolean is 96 begin 97 return Intermediate_Complete_Flag; 98 end Intermediate_Complete; 99 100 procedure Set_Intermediate_Complete is 101 begin 102 Intermediate_Complete_Flag := true; 103 end Set_Intermediate_Complete; 104 105 end TC_State; 106 107 --================================ 108 109 task Original_Caller is 110 entry Start; 111 end Original_Caller; 112 113 task Intermediate is 114 entry Input; 115 entry TC_Abort_Process_Complete; 116 end Intermediate; 117 118 task Receiver is 119 entry Input; 120 end Receiver; 121 122 123 task body Original_Caller is 124 begin 125 accept Start; -- wait for the trigger from Main 126 127 Intermediate.Input; 128 Report.Failed ("Tasking_Error not raised in Original_Caller task"); 129 130 exception 131 when tasking_error => 132 TC_State.Set_Original_Caller_Complete; -- expected behavior 133 when others => 134 Report.Failed ("Unexpected Exception in Original_Caller task"); 135 end Original_Caller; 136 137 138 task body Intermediate is 139 begin 140 accept Input do 141 -- Within this accept call another task 142 TC_State.Set_On_Entry_Queue; 143 requeue Receiver.Input with abort; 144 Report.Failed ("Requeue did not complete the Accept"); 145 end Input; 146 147 -- Wait for Main to ensure that the abort housekeeping is finished 148 accept TC_Abort_Process_Complete; 149 150 TC_State.Set_Intermediate_Complete; 151 152 exception 153 when others => 154 Report.Failed ("Unexpected exception in Intermediate task"); 155 end Intermediate; 156 157 158 task body Receiver is 159 begin 160 loop 161 select 162 -- A call to Input will be placed on the queue and never serviced 163 when Report.Equal (1,2) => -- Always false 164 accept Input do 165 Report.Failed ("Receiver in Accept"); 166 end Input; 167 or 168 delay ImpDef.Minimum_Task_Switch; 169 end select; 170 end loop; 171 exception 172 when others => 173 Report.Failed ("Unexpected Exception in Receiver Task"); 174 175 end Receiver; 176 177 178begin 179 180 Report.Test ("C954018", "Requeue: abort the called task" & 181 " while Caller is still queued"); 182 183 Original_Caller.Start; 184 185 186 -- This is the main part of the test 187 188 -- Wait for the requeue 189 while not TC_State.On_Entry_Queue loop 190 delay ImpDef.Minimum_Task_Switch; 191 end loop; 192 193 -- Delay long enough to ensure that the requeue has "arrived" on 194 -- the entry queue. Note: TC_State.Set_On_Entry_Queue is called the 195 -- statement before the requeue 196 -- 197 delay ImpDef.Switch_To_New_Task; 198 199 -- At this point the Receiver is guaranteed to have the requeue on 200 -- the entry queue 201 -- 202 abort Receiver; 203 204 -- Wait for the whole of the abort process to complete 205 while not ( Original_Caller'terminated and Receiver'terminated ) loop 206 delay ImpDef.Minimum_Task_Switch; 207 end loop; 208 209 210 -- Inform the Intermediate task that the process is complete to allow 211 -- it to continue to completion itself 212 Intermediate.TC_Abort_Process_Complete; 213 214 -- Wait for everything to settle before reporting the result 215 while not ( Intermediate'terminated ) loop 216 delay ImpDef.Minimum_Task_Switch; 217 end loop; 218 219 220 if not ( TC_State.Original_Caller_Complete and 221 TC_State.Intermediate_Complete ) then 222 Report.Failed ("Proper paths not traversed"); 223 end if; 224 225 Report.Result; 226 227end C954018; 228