1-- C954021.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 requeue within a protected entry to an entry in a 28-- different protected object is queued correctly. 29-- 30-- TEST DESCRIPTION: 31-- One transaction is sent through to check the paths. After processing 32-- this the Credit task sets the "overloaded" indicator. Once this 33-- indicator is set the Distributor (a protected object) queues low 34-- priority transactions on a Wait_for_Underload queue in another 35-- protected object using a requeue. The Distributor still delivers high 36-- priority transactions. After two high priority transactions have been 37-- processed by the Credit task it clears the overload condition. The 38-- low priority transactions should now be delivered. 39-- 40-- This series of tests uses a simulation of a transaction driven 41-- processing system. Line Drivers accept input from an external source 42-- and build them into transaction records. These records are then 43-- encapsulated in message tasks which remain extant for the life of the 44-- transaction in the system. The message tasks put themselves on the 45-- input queue of a Distributor which, from information in the 46-- transaction and/or system load conditions forwards them to other 47-- operating tasks. These in turn might forward the transactions to yet 48-- other tasks for further action. The routing is, in real life, dynamic 49-- and unpredictable at the time of message generation. All rerouting in 50-- this model is done by means of requeues. 51-- 52-- 53-- CHANGE HISTORY: 54-- 06 Dec 94 SAIC ACVC 2.0 55-- 26 Nov 95 SAIC Fixed shared global variable for ACVC 2.0.1 56-- 57--! 58 59with Report; 60with ImpDef; 61 62procedure C954021 is 63 64 -- Arbitrary test values 65 Credit_Return : constant := 1; 66 Debit_Return : constant := 2; 67 68 69 -- Mechanism to count the number of Credit Message tasks completed 70 protected TC_Tasks_Completed is 71 procedure Increment; 72 function Count return integer; 73 private 74 Number_Complete : integer := 0; 75 end TC_Tasks_Completed; 76 77 78 TC_Credit_Messages_Expected : constant integer := 5; 79 80 protected TC_Handshake is 81 procedure Set; 82 function First_Message_Arrived return Boolean; 83 private 84 Arrived_Flag : Boolean := false; 85 end TC_Handshake; 86 87 -- Handshaking mechanism between the Line Driver and the Credit task 88 -- 89 protected body TC_Handshake is 90 -- 91 procedure Set is 92 begin 93 Arrived_Flag := true; 94 end Set; 95 -- 96 function First_Message_Arrived return Boolean is 97 begin 98 return Arrived_Flag; 99 end First_Message_Arrived; 100 -- 101 end TC_Handshake; 102 103 104 protected type Shared_Boolean (Initial_Value : Boolean := False) is 105 procedure Set_True; 106 procedure Set_False; 107 function Value return Boolean; 108 private 109 Current_Value : Boolean := Initial_Value; 110 end Shared_Boolean; 111 112 protected body Shared_Boolean is 113 procedure Set_True is 114 begin 115 Current_Value := True; 116 end Set_True; 117 118 procedure Set_False is 119 begin 120 Current_Value := False; 121 end Set_False; 122 123 function Value return Boolean is 124 begin 125 return Current_Value; 126 end Value; 127 end Shared_Boolean; 128 129 TC_Debit_Message_Complete : Shared_Boolean (False); 130 131 type Transaction_Code is (Credit, Debit); 132 type Transaction_Priority is (High, Low); 133 134 type Transaction_Record; 135 type acc_Transaction_Record is access Transaction_Record; 136 type Transaction_Record is 137 record 138 ID : integer := 0; 139 Code : Transaction_Code := Debit; 140 Priority : Transaction_Priority := High; 141 Account_Number : integer := 0; 142 Stock_Number : integer := 0; 143 Quantity : integer := 0; 144 Return_Value : integer := 0; 145 TC_Message_Count : integer := 0; 146 TC_Thru_Dist : Boolean := false; 147 end record; 148 149 150 task type Message_Task is 151 entry Accept_Transaction (In_Transaction : acc_Transaction_Record); 152 end Message_Task; 153 type acc_Message_Task is access Message_Task; 154 155 task Line_Driver is 156 entry Start; 157 end Line_Driver; 158 159 protected Distributor is 160 procedure Set_Credit_Overloaded; 161 procedure Clear_Credit_Overloaded; 162 function Credit_is_Overloaded return Boolean; 163 entry Input (Transaction : acc_Transaction_Record); 164 private 165 Credit_Overloaded : Boolean := false; 166 end Distributor; 167 168 protected Hold is 169 procedure Underloaded; 170 entry Wait_for_Underload (Transaction : acc_Transaction_Record); 171 private 172 Release_All : Boolean := false; 173 end Hold; 174 175 task Credit_Computation is 176 entry Input(Transaction : acc_Transaction_Record); 177 end Credit_Computation; 178 179 task Debit_Computation is 180 entry Input(Transaction : acc_Transaction_Record); 181 end Debit_Computation; 182 183 -- 184 -- Dispose each input Transaction_Record to the appropriate 185 -- computation tasks 186 -- 187 protected body Distributor is 188 189 procedure Set_Credit_Overloaded is 190 begin 191 Credit_Overloaded := true; 192 end Set_Credit_Overloaded; 193 194 procedure Clear_Credit_Overloaded is 195 begin 196 Credit_Overloaded := false; 197 Hold.Underloaded; -- Release all held messages 198 end Clear_Credit_Overloaded; 199 200 function Credit_is_Overloaded return Boolean is 201 begin 202 return Credit_Overloaded; 203 end Credit_is_Overloaded; 204 205 206 entry Input (Transaction : acc_Transaction_Record) when true is 207 -- barrier is always open 208 begin 209 -- Test Control: Set the indicator in the message to show it has 210 -- passed through the Distributor object 211 Transaction.TC_thru_Dist := true; 212 213 -- Pass this transaction on to the appropriate computation 214 -- task but temporarily hold low-priority transactions under 215 -- overload conditions 216 case Transaction.Code is 217 when Credit => 218 if Credit_Overloaded and Transaction.Priority = Low then 219 requeue Hold.Wait_for_Underload with abort; 220 else 221 requeue Credit_Computation.Input with abort; 222 end if; 223 when Debit => 224 requeue Debit_Computation.Input with abort; 225 end case; 226 end Input; 227 end Distributor; 228 229 230 -- Low priority Message tasks are held on the Wait_for_Underload queue 231 -- while the Credit computation system is overloaded. Once the Credit 232 -- system reached underload send all queued messages immediately 233 -- 234 protected body Hold is 235 236 -- Once this is executed the barrier condition for the entry is 237 -- evaluated 238 procedure Underloaded is 239 begin 240 Release_All := true; 241 end Underloaded; 242 243 entry Wait_for_Underload (Transaction : acc_Transaction_Record) 244 when Release_All is 245 begin 246 requeue Credit_Computation.Input with abort; 247 if Wait_for_Underload'count = 0 then 248 -- Queue is purged. Set up to hold next batch 249 Release_All := false; 250 end if; 251 end Wait_for_Underload; 252 253 end Hold; 254 255 -- Mechanism to count the number of Message tasks completed (Credit) 256 protected body TC_Tasks_Completed is 257 procedure Increment is 258 begin 259 Number_Complete := Number_Complete + 1; 260 end Increment; 261 262 function Count return integer is 263 begin 264 return Number_Complete; 265 end Count; 266 end TC_Tasks_Completed; 267 268 269 -- Assemble messages received from an external source 270 -- Creates a message task for each. The message tasks remain extant 271 -- for the life of the messages in the system. 272 -- The Line Driver task would normally be designed to loop continuously 273 -- creating the messages as input is received. Simulate this 274 -- but limit it to the required number of dummy messages needed for 275 -- this test and allow it to terminate at that point. Artificially 276 -- alternate High and Low priority Credit transactions for this test. 277 -- 278 task body Line_Driver is 279 Current_ID : integer := 1; 280 Current_Priority : Transaction_Priority := High; 281 282 -- Artificial: number of messages required for this test 283 type TC_Trans_Range is range 1..6; 284 285 procedure Build_Credit_Record 286 ( Next_Transaction : acc_Transaction_Record ) is 287 Dummy_Account : constant integer := 100; 288 begin 289 Next_Transaction.ID := Current_ID; 290 Next_Transaction.Code := Credit; 291 Next_Transaction.Priority := Current_Priority; 292 293 Next_Transaction.Account_Number := Dummy_Account; 294 Current_ID := Current_ID + 1; 295 end Build_Credit_Record; 296 297 298 procedure Build_Debit_Record 299 ( Next_Transaction : acc_Transaction_Record ) is 300 Dummy_Account : constant integer := 200; 301 begin 302 Next_Transaction.ID := Current_ID; 303 Next_Transaction.Code := Debit; 304 305 Next_Transaction.Account_Number := Dummy_Account; 306 Current_ID := Current_ID + 1; 307 end Build_Debit_Record; 308 309 begin 310 311 accept Start; -- Wait for trigger from Main 312 313 for Transaction_Numb in TC_Trans_Range loop -- TC: limit the loop 314 declare 315 -- Create a task for the next message 316 Next_Message_Task : acc_Message_Task := new Message_Task; 317 -- Create a record for it 318 Next_Transaction : acc_Transaction_Record := 319 new Transaction_Record; 320 begin 321 if Transaction_Numb = TC_Trans_Range'first then 322 -- Send the first Credit message 323 Build_Credit_Record ( Next_Transaction ); 324 Next_Message_Task.Accept_Transaction ( Next_Transaction ); 325 -- TC: Wait until the first message has been received by the 326 -- Credit task and it has set the Overload indicator for the 327 -- Distributor 328 while not TC_Handshake.First_Message_Arrived loop 329 delay ImpDef.Minimum_Task_Switch; 330 end loop; 331 elsif Transaction_Numb = TC_Trans_Range'last then 332 -- For this test send the last transaction to the Debit task 333 -- to improve the mix 334 Build_Debit_Record( Next_Transaction ); 335 Next_Message_Task.Accept_Transaction ( Next_Transaction ); 336 else 337 -- TC: Alternate high and low priority transactions 338 if Current_Priority = High then 339 Current_Priority := Low; 340 else 341 Current_Priority := High; 342 end if; 343 Build_Credit_Record( Next_Transaction ); 344 Next_Message_Task.Accept_Transaction ( Next_Transaction ); 345 end if; 346 end; -- declare 347 end loop; 348 349 exception 350 when others => 351 Report.Failed ("Unexpected exception in Line_Driver"); 352 end Line_Driver; 353 354 355 356 357 task body Message_Task is 358 359 TC_Original_Transaction_Code : Transaction_Code; 360 This_Transaction : acc_Transaction_Record := new Transaction_Record; 361 362 begin 363 364 accept Accept_Transaction (In_Transaction : acc_Transaction_Record) do 365 This_Transaction.all := In_Transaction.all; 366 end Accept_Transaction; 367 368 -- Note the original code to ensure correct return 369 TC_Original_Transaction_Code := This_Transaction.Code; 370 371 -- Queue up on Distributor's Input queue 372 Distributor.Input ( This_Transaction ); 373 -- This task will now wait for the requeued rendezvous 374 -- to complete before proceeding 375 376 -- After the required computations have been performed 377 -- return the Transaction_Record appropriately (probably to an output 378 -- line driver) 379 null; -- stub 380 381 -- For the test check that the return values are as expected 382 if TC_Original_Transaction_Code /= This_Transaction.Code then 383 -- Incorrect rendezvous 384 Report.Failed ("Message Task: Incorrect code returned"); 385 end if; 386 387 if This_Transaction.Code = Credit then 388 if This_Transaction.Return_Value /= Credit_Return or 389 not This_Transaction.TC_thru_Dist then 390 Report.Failed ("Expected path not traversed - Credit"); 391 end if; 392 TC_Tasks_Completed.Increment; 393 else 394 if This_Transaction.Return_Value /= Debit_Return or 395 This_Transaction.TC_Message_Count /= 1 or 396 not This_Transaction.TC_thru_Dist then 397 Report.Failed ("Expected path not traversed - Debit"); 398 end if; 399 TC_Debit_Message_Complete.Set_True; 400 end if; 401 402 exception 403 when others => 404 Report.Failed ("Unexpected exception in Message_Task"); 405 end Message_Task; 406 407 408 409 410 411 -- Computation task. After the computation is performed the rendezvous 412 -- in the original message task is completed. 413 task body Credit_Computation is 414 415 Message_Count : integer := 0; 416 417 begin 418 loop 419 select 420 accept Input ( Transaction : acc_Transaction_Record) do 421 if Distributor.Credit_is_Overloaded 422 and Transaction.Priority = Low then 423 -- We should not be getting any Low Priority messages. They 424 -- should be waiting on the Hold.Wait_for_Underload 425 -- queue 426 Report.Failed 427 ("Credit Task: Low priority transaction during overload"); 428 end if; 429 -- Perform the computations required for this transaction 430 null; -- stub 431 432 -- For the test: 433 if not Transaction.TC_thru_Dist then 434 Report.Failed 435 ("Credit Task: Wrong queue, Distributor bypassed"); 436 end if; 437 if Transaction.code /= Credit then 438 Report.Failed 439 ("Credit Task: Requeue delivered to the wrong queue"); 440 end if; 441 442 -- The following is all Test Control code: 443 Transaction.Return_Value := Credit_Return; 444 Message_Count := Message_Count + 1; 445 -- 446 -- Now take special action depending on which Message 447 if Message_Count = 1 then 448 -- After the first message : 449 Distributor.Set_Credit_Overloaded; 450 -- Now flag the Line_Driver that the second and subsequent 451 -- messages may now be sent 452 TC_Handshake.Set; 453 end if; 454 if Message_Count = 3 then 455 -- The two high priority transactions created subsequent 456 -- to the overload have now been processed 457 Distributor.Clear_Credit_Overloaded; 458 end if; 459 end Input; 460 or 461 terminate; 462 end select; 463 end loop; 464 exception 465 when others => 466 Report.Failed ("Unexpected exception in Credit_Computation"); 467 end Credit_Computation; 468 469 470 471 -- Computation task. After the computation is performed the rendezvous 472 -- in the original message task is completed. 473 -- 474 task body Debit_Computation is 475 Message_Count : integer := 0; 476 begin 477 loop 478 select 479 accept Input (Transaction : acc_Transaction_Record) do 480 -- Perform the computations required for this message 481 null; -- stub 482 483 -- For the test: 484 if not Transaction.TC_thru_Dist then 485 Report.Failed 486 ("Debit Task: Wrong queue, Distributor bypassed"); 487 end if; 488 if Transaction.code /= Debit then 489 Report.Failed 490 ("Debit Task: Requeue delivered to the wrong queue"); 491 end if; 492 493 -- for the test plug a known value and count 494 Transaction.Return_Value := Debit_Return; 495 -- one, and only one, message should pass through 496 Message_Count := Message_Count + 1; 497 Transaction.TC_Message_Count := Message_Count; 498 end Input; 499 or 500 terminate; 501 end select; 502 end loop; 503 exception 504 when others => 505 Report.Failed ("Unexpected exception in Debit_Computation"); 506 end Debit_Computation; 507 508 509begin 510 Report.Test ("C954021", "Requeue from one entry body to an entry in" & 511 " another protected object"); 512 513 Line_Driver.Start; -- Start the test 514 515 516 -- Ensure that the message tasks have completed before reporting result 517 while (TC_Tasks_Completed.Count < TC_Credit_Messages_Expected) 518 and not TC_Debit_Message_Complete.Value loop 519 delay ImpDef.Minimum_Task_Switch; 520 end loop; 521 522 Report.Result; 523 524end C954021; 525