1. -- 
  2. -- Uwe R. Zimmer, Australia, 2015 
  3. -- 
  4.  
  5. with Ada.Text_IO;           use Ada.Text_IO; 
  6. with Queue_Pack_Exceptions; use Queue_Pack_Exceptions; 
  7.  
  8. procedure Queue_Test_Exceptions is 
  9.  
  10.    Queue : Queue_Type; 
  11.  
  12. begin 
  13.    declare 
  14.       Written_Item : Element := Element'First; 
  15.    begin 
  16.       for i in 1 .. Queue_Size loop 
  17.          Enqueue (Written_Item, Queue); 
  18.          Written_Item := Element'Succ (Written_Item); 
  19.       end loop; 
  20.    end; 
  21.  
  22.    Put_Line ("Correct: Queue accepted 10 elements"); 
  23.  
  24.    begin 
  25.       Enqueue (Element'First, Queue); 
  26.       raise Program_Error with "Queue accepted 11 elements"; 
  27.    exception 
  28.       when Queue_overflow => Put_Line ("Correct: Queue rejected to enqueue an 11th element"); 
  29.    end; 
  30.  
  31.    if Is_Empty (Queue) then 
  32.       raise Program_Error with "Queue should not be empty after adding 10 elements"; 
  33.    elsif not Is_Full (Queue) then 
  34.       raise Program_Error with "Queue should be full after adding 10 elements"; 
  35.    else 
  36.       Put_Line ("Correct: Queue is full after adding 10 elements"); 
  37.    end if; 
  38.  
  39.    declare 
  40.       Written_Item : Element := Element'First; 
  41.       Read_Item    : Element; 
  42.    begin 
  43.  
  44.       for i in 1 .. Queue_Size loop 
  45.          Dequeue (Read_Item, Queue); 
  46.          if Read_Item /= Written_Item then 
  47.             raise Program_Error with "The elements are dequeing incorrectly"; 
  48.          end if; 
  49.          Written_Item := Element'Succ (Written_Item); 
  50.       end loop; 
  51.    end; 
  52.  
  53.    Put_Line ("Correct: Queue re-produced 10 elements in the correct order"); 
  54.  
  55.    declare 
  56.       Read_Item    : Element; 
  57.    begin 
  58.       Dequeue (Read_Item, Queue); 
  59.       raise Program_Error with "Queue dequeued an element from an empty queue"; 
  60.    exception 
  61.       when Queue_underflow => Put_Line ("Correct: Queue rejected to dequeue from an empty queue"); 
  62.    end; 
  63.  
  64.    if not Is_Empty (Queue) then 
  65.       raise Program_Error with "Queue should be empty after adding and removing 10 elements"; 
  66.    elsif Is_Full (Queue) then 
  67.       raise Program_Error with "Queue should not be full after adding and removing 10 elements"; 
  68.    else 
  69.       Put_Line ("Correct: Queue is empty after adding and removing 10 elements"); 
  70.    end if; 
  71.  
  72.    Put_Line ("All cool - all tests passed"); 
  73.  
  74. exception 
  75.    when Queue_underflow => Put ("Queue underflow"); 
  76.    when Queue_overflow  => Put ("Queue overflow"); 
  77.  
  78. --     Queue : Queue_Type; 
  79. --     Item  : Element; 
  80. -- 
  81. --  begin 
  82. --     Enqueue (Turn, Queue); 
  83. -- 
  84. --     Dequeue (Item, Queue); Put (Element'Image (Item)); 
  85. -- 
  86. --     Dequeue (Item, Queue); -- will produce a 'Queue underflow' 
  87. --     Put (Element'Image (Item)); 
  88. -- 
  89. --     Put ("Queue is empty on exit: "); Put (Boolean'Image (Is_Empty (Queue))); 
  90. -- 
  91. --  exception 
  92. --     when Queue_underflow => Put ("Queue underflow"); 
  93. --     when Queue_overflow  => Put ("Queue overflow"); 
  94.  
  95. end Queue_Test_Exceptions;