1-- C974004.A 2-- 3-- 4-- Grant of Unlimited Rights 5-- 6-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, 7-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 8-- unlimited rights in the software and documentation contained herein. 9-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making 10-- this public release, the Government intends to confer upon all 11-- recipients unlimited rights equal to those held by the Government. 12-- These rights include rights to use, duplicate, release or disclose the 13-- released technical data and computer software in whole or in part, in 14-- any manner and for any purpose whatsoever, and to have or permit others 15-- to do so. 16-- 17-- DISCLAIMER 18-- 19-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 20-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 21-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE 22-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 23-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 24-- PARTICULAR PURPOSE OF SAID MATERIAL. 25--* 26-- 27-- OBJECTIVE: 28-- Check that the abortable part of an asynchronous select statement 29-- is aborted if it does not complete before the triggering statement 30-- completes, where the triggering statement is a task entry call, 31-- the entry call is queued, and the entry call completes by propagating 32-- an exception and that the sequence of statements of the triggering 33-- alternative is not executed after the abortable part is left and that 34-- the exception propagated by the entry call is re-raised immediately 35-- following the asynchronous select. 36-- 37-- TEST DESCRIPTION: 38-- Declare a main procedure containing an asynchronous select with a task 39-- entry call as triggering statement. Force the entry call to be 40-- queued by having the task call a procedure, prior to the corresponding 41-- accept statement, which simulates a routine waiting for user input 42-- (with a delay). 43-- 44-- Simulate a time-consuming routine in the abortable part by calling a 45-- procedure containing an infinite loop. Meanwhile, simulate input by 46-- the user (the delay expires), which causes the task to execute the 47-- accept statement corresponding to the triggering entry call. Raise 48-- an exception in the accept statement which is not handled by the task, 49-- and which is thus propagated to the caller. 50-- 51-- 52-- CHANGE HISTORY: 53-- 06 Dec 94 SAIC ACVC 2.0 54-- 55--! 56 57package C974004_0 is -- Automated teller machine abstraction. 58 59 60 -- Flags for testing purposes: 61 62 Count : Integer := 1234; -- Global to defeat 63 -- optimization. 64 Propagated_From_Task : exception; 65 66 67 type Key_Enum is (None, Cancel, Deposit, Withdraw); 68 69 type Card_Number_Type is private; 70 type Card_PIN_Type is private; 71 type ATM_Card_Type is private; 72 73 74 Transaction_Canceled : exception; 75 76 77 task type ATM_Keyboard_Task is 78 entry Cancel_Pressed; 79 end ATM_Keyboard_Task; 80 81 82 procedure Read_Card (Card : in out ATM_Card_Type); 83 84 procedure Validate_Card (Card : in ATM_Card_Type); 85 86 procedure Perform_Transaction (Card : in ATM_Card_Type); 87 88private 89 90 type Card_Number_Type is range 1 .. 9999; 91 type Card_PIN_Type is range 100 .. 999; 92 93 type ATM_Card_Type is record 94 Number : Card_Number_Type; 95 PIN : Card_PIN_Type; 96 end record; 97 98end C974004_0; 99 100 101 --==================================================================-- 102 103 104with Report; 105with ImpDef; 106 107package body C974004_0 is 108 109 110 procedure Listen_For_Input (Key : out Key_Enum) is 111 begin 112 -- Simulate the situation where a user waits a bit for the card to 113 -- be validated, then presses cancel before it completes. 114 115 -- Delay long enough to force queuing of Keyboard.Cancel_Pressed. 116 delay ImpDef.Clear_Ready_Queue; 117 118 if Report.Equal (3, 3) then -- Always true. 119 Key := Cancel; 120 end if; 121 end Listen_For_Input; 122 123 124 -- One of these gets created as "Keyboard" for each transaction 125 -- 126 task body ATM_Keyboard_Task is 127 Key_Pressed : Key_Enum := None; 128 begin 129 loop 130 -- Force entry calls to be 131 Listen_For_Input (Key_Pressed); -- queued, then set guard to 132 -- true. 133 select 134 when (Key_Pressed = Cancel) => -- Guard is now true, so accept 135 accept Cancel_Pressed do -- queued entry call. 136 null; --:::: user code for cancel 137 -- Now simulate an unexpected exception arising in the 138 -- user code 139 raise Propagated_From_Task; -- Propagate an exception. 140 141 end Cancel_Pressed; 142 143 Report.Failed 144 ("Exception not propagated in ATM_Keyboard_Task"); 145 146 -- User has canceled the transaction so we exit the 147 -- loop and allow the task to terminate 148 exit; 149 else 150 Key_Pressed := None; 151 end select; 152 end loop; 153 exception 154 when Propagated_From_Task => 155 null; -- This is the expected test behavior 156 when others => 157 Report.Failed ("Unexpected Exception in ATM_Keyboard_Task"); 158 end ATM_Keyboard_Task; 159 160 161 162 procedure Read_Card (Card : in out ATM_Card_Type) is 163 begin 164 Card.Number := 9999; 165 Card.PIN := 111; 166 end Read_Card; 167 168 169 procedure Validate_Card (Card : in ATM_Card_Type) is 170 begin 171 -- Simulate an exceedingly long validation activity. 172 loop -- Infinite loop. 173 Count := (Count + 1) mod Integer (Card.PIN); 174 -- Synch. point to allow transfer of control to Keyboard 175 -- task during this simulation 176 delay ImpDef.Minimum_Task_Switch; 177 exit when not Report.Equal (Count, Count); -- Always false. 178 end loop; 179 end Validate_Card; 180 181 182 procedure Perform_Transaction (Card : in ATM_Card_Type) is 183 begin 184 Report.Failed ("Exception not re-raised immediately following " & 185 "asynchronous select"); 186 if Count = 1234 then 187 -- Initial value is unchanged 188 Report.Failed ("Abortable part did not execute"); 189 end if; 190 end Perform_Transaction; 191 192 193end C974004_0; 194 195 196 --==================================================================-- 197 198 199with Report; 200 201with C974004_0; -- Automated teller machine abstraction. 202use C974004_0; 203 204procedure C974004 is 205 206 Card_Data : ATM_Card_Type; 207 208begin -- Main program. 209 210 Report.Test ("C974004", "Asynchronous Select: Trigger is queued on a " & 211 "task entry and is completed first by an " & 212 "exception"); 213 214 Read_Card (Card_Data); 215 216 begin 217 218 declare 219 -- Create the task for this transaction 220 Keyboard : C974004_0.ATM_Keyboard_Task; 221 begin 222 223 -- -- 224 -- Asynchronous select is tested here -- 225 -- -- 226 227 select 228 Keyboard.Cancel_Pressed; -- Entry call initially queued, so 229 -- abortable part starts. 230 231 raise Transaction_Canceled; -- Should not be executed. 232 then abort 233 Validate_Card (Card_Data); -- Keyboard.Cancel_Pressed is accepted 234 -- and propagates an exception before 235 -- this call finishes; it is then 236 -- aborted. 237 238 -- Check that the whole of the abortable part is aborted, not 239 -- just the statement in the abortable part that was executing 240 -- at the time 241 Report.Failed ("Abortable part not aborted"); 242 end select; 243 -- The propagated exception is 244 -- re-raised here; control passes to 245 -- the exception handler. 246 247 Perform_Transaction(Card_Data); -- Should not be reached. 248 exception 249 when Transaction_Canceled => 250 Report.Failed ("Triggering alternative sequence of statements " & 251 "executed"); 252 when Propagated_From_Task => 253 -- This is the expected test path 254 if Count = 1234 then 255 -- Initial value is unchanged 256 Report.Failed ("Abortable part did not execute"); 257 end if; 258 when Tasking_Error => 259 Report.Failed ("Tasking_Error raised"); 260 when others => 261 Report.Failed ("Wrong exception raised"); 262 end; 263 264 exception 265 when Propagated_From_Task => 266 Report.Failed ("Correct exception raised at wrong level"); 267 when others => 268 Report.Failed ("Wrong exception raised at wrong level"); 269 end; 270 271 Report.Result; 272 273end C974004; 274