1-- C954020.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 a call to a protected entry can be requeued to a task 28-- entry. Check that the requeue is placed on the correct entry; that the 29-- original caller waits for the completion of the requeue and continues 30-- after the requeued rendezvous. Check that the requeue does not block. 31-- Specifically, check a requeue with abort from a protected entry to 32-- an entry in a task. 33-- 34-- TEST DESCRIPTION: 35-- 36-- In the Distributor protected object, requeue two successive calls on 37-- the entries of two separate target tasks. Each task in each of the 38-- paths adds identifying information in the transaction being passed. 39-- This information is checked by the Message tasks on completion 40-- ensuring that the requeues have been placed on the correct queues. 41-- There is an artificial guard on the Credit Task to ensure that the 42-- input is queued; this guard is released by the Debit task which 43-- handles its input immediately. This ensures that we have one of the 44-- requeued items actually queued for later handling and also verifies 45-- that the requeuing process (in the protected object) is not blocked. 46-- 47-- This series of tests uses a simulation of a transaction driven 48-- processing system. Line Drivers accept input from an external source 49-- and build them into transaction records. These records are then 50-- encapsulated in message tasks which remain extant for the life of the 51-- transaction in the system. The message tasks put themselves on the 52-- input queue of a Distributor object which, from information in the 53-- transaction and/or system load conditions forwards them to other 54-- operating tasks. These in turn might forward the transactions to yet 55-- other tasks for further action. The routing is, in real life, 56-- dynamic and unpredictable at the time of message generation. All 57-- rerouting in this model is done by means of requeues. 58-- 59-- 60-- CHANGE HISTORY: 61-- 06 Dec 94 SAIC ACVC 2.0 62-- 06 Nov 95 SAIC Fixed problems for ACVC 2.0.1 63-- 64--! 65 66with Report; 67with ImpDef; 68 69procedure C954020 is 70 Verbose : constant Boolean := False; 71 72 -- Arbitrary test values 73 Credit_Return : constant := 1; 74 Debit_Return : constant := 2; 75 76 protected type Message_Status is 77 procedure Set_Complete; 78 function Complete return Boolean; 79 private 80 Is_Complete : Boolean := False; 81 end Message_Status; 82 83 protected body Message_Status is 84 procedure Set_Complete is 85 begin 86 Is_Complete := True; 87 end Set_Complete; 88 89 function Complete return Boolean is 90 begin 91 return Is_Complete; 92 end Complete; 93 end Message_Status; 94 95 TC_Debit_Message : Message_Status; 96 TC_Credit_Message : Message_Status; 97 98 type Transaction_Code is (Credit, Debit); 99 100 type Transaction_Record; 101 type acc_Transaction_Record is access Transaction_Record; 102 type Transaction_Record is 103 record 104 ID : integer := 0; 105 Code : Transaction_Code := Debit; 106 Account_Number : integer := 0; 107 Stock_Number : integer := 0; 108 Quantity : integer := 0; 109 Return_Value : integer := 0; 110 TC_Message_Count : integer := 0; 111 TC_Thru_Dist : Boolean := false; 112 end record; 113 114 115 task type Message_Task is 116 entry Accept_Transaction (In_Transaction : acc_Transaction_Record); 117 end Message_Task; 118 type acc_Message_Task is access Message_Task; 119 120 task Line_Driver is 121 entry Start; 122 end Line_Driver; 123 124 task Credit_Computation is 125 entry Input(Transaction : acc_Transaction_Record); 126 end Credit_Computation; 127 128 task Debit_Computation is 129 entry Input(Transaction : acc_Transaction_Record); 130 end Debit_Computation; 131 132 protected Time_Lock is 133 procedure Credit_Start; 134 function Credit_Enabled return Boolean; 135 private 136 Credit_OK : Boolean := false; 137 end Time_Lock; 138 139 protected body Time_Lock is 140 procedure Credit_Start is 141 begin 142 Credit_OK := true; 143 end Credit_Start; 144 145 function Credit_Enabled return Boolean is 146 begin 147 return Credit_OK; 148 end Credit_Enabled; 149 end Time_Lock; 150 151 152 153 protected Distributor is 154 entry Input (Transaction : acc_Transaction_Record); 155 end Distributor; 156 -- 157 -- 158 -- Dispose each input Transaction_Record to the appropriate 159 -- computation tasks 160 -- 161 protected body Distributor is 162 entry Input (Transaction : acc_Transaction_Record) when true is 163 -- barrier is always open 164 begin 165 -- Test Control: Set the indicator in the message to show it has 166 -- passed through the Distributor object 167 Transaction.TC_thru_Dist := true; 168 169 -- Pass this transaction on to the appropriate computation 170 -- task 171 case Transaction.Code is 172 when Credit => 173 requeue Credit_Computation.Input with abort; 174 when Debit => 175 requeue Debit_Computation.Input with abort; 176 end case; 177 end Input; 178 end Distributor; 179 180 181 182 183 -- Assemble messages received from an external source 184 -- Creates a message task for each. The message tasks remain extant 185 -- for the life of the messages in the system. 186 -- The Line Driver task would normally be designed to loop continuously 187 -- creating the messages as input is received. Simulate this 188 -- but limit it to two dummy messages for this test and allow it 189 -- to terminate at that point 190 -- 191 task body Line_Driver is 192 Current_ID : integer := 1; 193 TC_Last_was_for_credit : Boolean := false; 194 195 procedure Build_Credit_Record 196 ( Next_Transaction : acc_Transaction_Record ) is 197 Dummy_Account : constant integer := 100; 198 begin 199 Next_Transaction.ID := Current_ID; 200 Next_Transaction.Code := Credit; 201 202 Next_Transaction.Account_Number := Dummy_Account; 203 Current_ID := Current_ID + 1; 204 end Build_Credit_Record; 205 206 207 procedure Build_Debit_Record 208 ( Next_Transaction : acc_Transaction_Record ) is 209 Dummy_Account : constant integer := 200; 210 begin 211 Next_Transaction.ID := Current_ID; 212 Next_Transaction.Code := Debit; 213 214 Next_Transaction.Account_Number := Dummy_Account; 215 Current_ID := Current_ID + 1; 216 end Build_Debit_Record; 217 218 begin 219 220 accept Start; -- Wait for trigger from Main 221 222 for i in 1..2 loop -- arbitrarily limit to two messages for the test 223 declare 224 -- Create a task for the next message 225 Next_Message_Task : acc_Message_Task := new Message_Task; 226 -- Create a record for it 227 Next_Transaction : acc_Transaction_Record 228 := new Transaction_Record; 229 begin 230 if TC_Last_was_for_credit then 231 Build_Debit_Record ( Next_Transaction ); 232 else 233 Build_Credit_Record( Next_Transaction ); 234 TC_Last_was_for_credit := true; 235 end if; 236 Next_Message_Task.Accept_Transaction ( Next_Transaction ); 237 end; -- declare 238 end loop; 239 240 exception 241 when others => 242 Report.Failed ("Unexpected exception in Line_Driver"); 243 end Line_Driver; 244 245 246 247 248 task body Message_Task is 249 250 TC_Original_Transaction_Code : Transaction_Code; 251 This_Transaction : acc_Transaction_Record := new Transaction_Record; 252 253 begin 254 accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do 255 This_Transaction.all := In_Transaction.all; 256 end Accept_Transaction; 257 258 if Verbose then 259 Report.Comment ("message task got " & 260 Transaction_Code'Image (This_Transaction.Code)); 261 end if; 262 263 -- Note the original code to ensure correct return 264 TC_Original_Transaction_Code := This_Transaction.Code; 265 266 -- Queue up on Distributor's Input queue 267 Distributor.Input ( This_Transaction ); 268 -- This task will now wait for the requeued rendezvous 269 -- to complete before proceeding 270 271 -- After the required computations have been performed 272 -- return the Transaction_Record appropriately (probably to an output 273 -- line driver) 274 null; -- stub 275 276 277 -- The following is all Test Control Code 278 279 -- Check that the return values are as expected 280 if TC_Original_Transaction_Code /= This_Transaction.Code then 281 -- Incorrect rendezvous 282 Report.Failed ("Message Task: Incorrect code returned"); 283 end if; 284 285 if This_Transaction.Code = Credit then 286 if This_Transaction.Return_Value /= Credit_Return or 287 This_Transaction.TC_Message_Count /= 1 or 288 not This_Transaction.TC_thru_Dist then 289 Report.Failed ("Expected path not traversed"); 290 end if; 291 TC_Credit_Message.Set_Complete; 292 else 293 if This_Transaction.Return_Value /= Debit_Return or 294 This_Transaction.TC_Message_Count /= 1 or 295 not This_Transaction.TC_thru_Dist then 296 Report.Failed ("Expected path not traversed"); 297 end if; 298 TC_Debit_Message.Set_Complete; 299 end if; 300 301 exception 302 when others => 303 Report.Failed ("Unexpected exception in Message_Task"); 304 305 end Message_Task; 306 307 308 309 -- Computation task. 310 -- Note: After the computation is performed in this task and the 311 -- accept body is completed the rendezvous in the original 312 -- message task is completed. 313 -- 314 task body Credit_Computation is 315 Message_Count : integer := 0; 316 begin 317 loop 318 select 319 when Time_Lock.Credit_enabled => 320 accept Input ( Transaction : acc_Transaction_Record) do 321 -- Perform the computations required for this transaction 322 null; -- stub 323 324 if Verbose then 325 Report.Comment ("Credit_Computation in accept"); 326 end if; 327 328 -- For the test: 329 if not Transaction.TC_thru_Dist then 330 Report.Failed 331 ("Credit Task: Wrong queue, Distributor bypassed"); 332 end if; 333 if Transaction.code /= Credit then 334 Report.Failed 335 ("Credit Task: Requeue delivered to the wrong queue"); 336 end if; 337 338 -- for the test plug a known value and count 339 Transaction.Return_Value := Credit_Return; 340 -- one, and only one message should pass through 341 Message_Count := Message_Count + 1; 342 Transaction.TC_Message_Count := Message_Count; 343 344 end Input; 345 exit; -- only handle 1 transaction 346 else 347 -- poll until we can accept credit transaction 348 delay ImpDef.Clear_Ready_Queue; 349 end select; 350 end loop; 351 exception 352 when others => 353 Report.Failed ("Unexpected exception in Credit_Computation"); 354 end Credit_Computation; 355 356 357 358 -- Computation task. 359 -- Note: After the computation is performed in this task and the 360 -- accept body is completed the rendezvous in the original 361 -- message task is completed. 362 -- 363 task body Debit_Computation is 364 Message_Count : integer := 0; 365 begin 366 loop 367 select 368 accept Input (Transaction : acc_Transaction_Record) do 369 -- Perform the computations required for this message 370 null; -- stub 371 372 if Verbose then 373 Report.Comment ("Debit_Computation in accept"); 374 end if; 375 376 -- For the test: 377 if not Transaction.TC_thru_Dist then 378 Report.Failed 379 ("Debit Task: Wrong queue, Distributor bypassed"); 380 end if; 381 if Transaction.code /= Debit then 382 Report.Failed 383 ("Debit Task: Requeue delivered to the wrong queue"); 384 end if; 385 386 -- for the test plug a known value and count 387 Transaction.Return_Value := Debit_Return; 388 -- one, and only one, message should pass through 389 Message_Count := Message_Count + 1; 390 Transaction.TC_Message_Count := Message_Count; 391 -- for the test: once we have completed the only Debit 392 -- message release the Credit Messages which are queued 393 -- on the Credit Input queue 394 Time_Lock.Credit_Start; 395 end Input; 396 or 397 terminate; 398 end select; 399 end loop; 400 exception 401 when others => 402 Report.Failed ("Unexpected exception in Debit_Computation"); 403 404 405 end Debit_Computation; 406 407 408begin -- C954020 409 410 Report.Test ("C954020", "Requeue, with abort, from protected entry " & 411 "to task entry"); 412 413 Line_Driver.Start; -- Start the test 414 415 -- Ensure that the message tasks complete before reporting the result 416 while not (TC_Credit_Message.Complete and TC_Debit_Message.Complete) loop 417 delay ImpDef.Minimum_Task_Switch; 418 end loop; 419 420 Report.Result; 421 422end C954020; 423