1. -- 
  2. -- Uwe R. Zimmer, Australia, 2013 
  3. -- 
  4.  
  5. with Queue_Pack_Abstract; 
  6. with Queue_Pack_Concrete; 
  7.  
  8. procedure Queue_Test_Dispatching is 
  9.  
  10.    package Queue_Pack_Abstract_Character is new Queue_Pack_Abstract (Character); 
  11.    use Queue_Pack_Abstract_Character; 
  12.  
  13.    package Queue_Pack_Character is new Queue_Pack_Concrete (Queue_Pack_Abstract_Character, 10); 
  14.    use Queue_Pack_Character; 
  15.  
  16.    type Queue_Class is access all Queue_Type'class; 
  17.  
  18.    task Queue_Holder is -- could be on an individual partition / separate computer 
  19.       entry Queue_Filled; -- rendezvous entry (synchronous message passing) 
  20.    end Queue_Holder; 
  21.  
  22.    task Queue_User is   -- could be on an individual partition / separate computer 
  23.       entry Send_Queue (Remote_Queue : Queue_Class); -- rendezvous entry (synchronous message passing) 
  24.    end Queue_User; 
  25.  
  26.    task body Queue_Holder is 
  27.  
  28.       Local_Queue : constant Queue_Class := new Real_Queue; -- could be a different implementation! 
  29.       Item        : Character; 
  30.  
  31.    begin 
  32.       Queue_User.Send_Queue (Local_Queue); 
  33.       accept Queue_Filled do 
  34.          Dequeue (Item, Local_Queue.all); -- Item will be 'r' 
  35.       end Queue_Filled; 
  36.    end Queue_Holder; 
  37.  
  38.    task body Queue_User is 
  39.  
  40.       Local_Queue : constant Queue_Class := new Real_Queue; -- could be a different implementation!; 
  41.       Item        : Character; 
  42.  
  43.    begin 
  44.       accept Send_Queue (Remote_Queue : Queue_Class) do 
  45.          Enqueue ('r', Remote_Queue.all); -- potentially a remote procedure call! 
  46.          Enqueue ('l', Local_Queue.all); 
  47.       end Send_Queue; 
  48.       Queue_Holder.Queue_Filled; 
  49.       Dequeue (Item, Local_Queue.all); -- Item will be 'l' 
  50.    end Queue_User; 
  51.  
  52. begin 
  53.    null; 
  54. end Queue_Test_Dispatching;