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