1. -- 
  2. -- Uwe R. Zimmer, Australia, 2015 
  3. -- 
  4.  
  5. with Ada.Task_Identification;      use Ada.Task_Identification; 
  6. with Ada.Text_IO;                  use Ada.Text_IO; 
  7. with Queue_Pack_Protected_Generic; 
  8.  
  9. procedure Queue_Test_Protected_Generic is 
  10.  
  11.    type Queue_Size is mod 3; 
  12.  
  13.    package Queue_Pack_Protected_Character is 
  14.       new Queue_Pack_Protected_Generic (Element => Character, Index => Queue_Size); 
  15.    use Queue_Pack_Protected_Character; 
  16.  
  17.    subtype Some_Characters is Character range 'a' .. 'f'; 
  18.  
  19.    Queue : Protected_Queue; 
  20.  
  21.    type Task_Index is range 1 .. 3; 
  22.  
  23.    task type Producer; 
  24.    task type Consumer; 
  25.  
  26.    Producers : array (Task_Index) of Producer; pragma Unreferenced (Producers); 
  27.    Consumers : array (Task_Index) of Consumer; pragma Unreferenced (Consumers); 
  28.  
  29.    task body Producer is 
  30.  
  31.    begin 
  32.       for Ch in Some_Characters loop 
  33.          Put_Line ("Task " & Image (Current_Task) & " finds the queue to be " & 
  34.                    (if Queue.Is_Empty then "EMPTY" else "not empty") & 
  35.                      " and " & 
  36.                    (if Queue.Is_Full  then "FULL" else "not full") & 
  37.                      " and prepares to add: " & Character'Image (Ch) & 
  38.                      " to the queue."); 
  39.          Queue.Enqueue (Ch); -- task might be blocked here! 
  40.       end loop; 
  41.       Put_Line ("<---- Task " & Image (Current_Task) & " terminates."); 
  42.    end Producer; 
  43.  
  44.    task body Consumer is 
  45.  
  46.       Item    : Character; 
  47.       Counter : Natural := 0; 
  48.  
  49.    begin 
  50.       loop 
  51.          Queue.Dequeue (Item); -- task might be blocked here! 
  52.          Counter := Natural'Succ (Counter); 
  53.          Put_Line ("Task " & Image (Current_Task) & 
  54.                      " received: " & Character'Image (Item) & 
  55.                      " and the queue appears to be " & 
  56.                    (if Queue.Is_Empty then "EMPTY" else "not empty") & 
  57.                      " and " & 
  58.                    (if Queue.Is_Full  then "FULL" else "not full") & 
  59.                      " afterwards."); 
  60.          exit when Item = Some_Characters'Last; 
  61.       end loop; 
  62.       Put_Line ("<---- Task " & Image (Current_Task) & 
  63.                   " terminates and received" & Natural'Image (Counter) & " items."); 
  64.    end Consumer; 
  65.  
  66. begin 
  67.    null; 
  68. end Queue_Test_Protected_Generic;