1. with Ada.Numerics.Discrete_Random; 
  2. with Ada.Long_Integer_Text_IO;     use Ada.Long_Integer_Text_IO; 
  3. with Ada.Real_Time;                use Ada.Real_Time; 
  4. with Ada.Text_IO;                  use Ada.Text_IO; 
  5. with Concurrent_Mergesort; 
  6. with Sorting_Tests; 
  7.  
  8. procedure Test_Concurrent_Mergesort is 
  9.  
  10.    Field_Size : constant Positive := 50_000; 
  11.    subtype Field_Range is Positive range 1 .. Field_Size; 
  12.  
  13.    subtype Element_Type is Natural; 
  14.    type Field_Type is array (Field_Range range <>) of Element_Type; 
  15.  
  16.    Null_Field : Field_Type (0 .. -1); 
  17.  
  18.    package RandomElements is new Ada.Numerics.Discrete_Random (Element_Type); 
  19.    use RandomElements; 
  20.  
  21.    procedure Merge_Sort_Concurrent is new Concurrent_Mergesort (Element_Type, Field_Range, Field_Type); 
  22.  
  23.    package Element_Sorting_Tests is new Sorting_Tests (Element       => Element_Type, 
  24.                                                        Index         => Field_Range, 
  25.                                                        Element_Array => Field_Type); 
  26.    use Element_Sorting_Tests; 
  27.  
  28.    procedure Check_Field (Sort_Field     : Field_Type; 
  29.                           Original_Field : Field_Type := Null_Field) is 
  30.  
  31.    begin 
  32.       New_Line; 
  33.       Put_Line ((if Is_Sorted (Sort_Field) 
  34.                 then "----- Field is sorted " 
  35.                 else "----- Field is NOT sorted ") & 
  36.                 (if Original_Field = Null_Field 
  37.                    then "-----" 
  38.                    elsif Is_Permutation (Sort_Field, Original_Field) 
  39.                    then "and a permutation of input -----" 
  40.                    else "and NOT a permutation of input -----")); 
  41.       New_Line; 
  42.    end Check_Field; 
  43.  
  44.    procedure Print_Time_Taken (Taken : Time_Span) is 
  45.  
  46.    begin 
  47.       Put ("Time taken: "); 
  48.       Put (Long_Integer (Long_Float'Floor (Long_Float               (To_Duration (Taken)))),          4); Put (" s "); 
  49.       Put (Long_Integer (Long_Float'Floor (Long_Float     (1_000.0 * To_Duration (Taken)))) mod 1000, 4); Put (" ms "); 
  50.       Put (Long_Integer (Long_Float'Floor (Long_Float (1_000_000.0 * To_Duration (Taken)))) mod 1000, 4); Put (" micro-s "); 
  51.    end Print_Time_Taken; 
  52.  
  53.    Random_Field      : Field_Type (Field_Range); 
  54.    Element_Generator : Generator; 
  55.  
  56. begin 
  57.    Reset (Element_Generator); 
  58.    for ix in Random_Field'Range loop 
  59.       Random_Field (ix) := Random (Element_Generator); 
  60.    end loop; 
  61.  
  62.    Check_Field (Random_Field); 
  63.  
  64.    declare 
  65.       Sort_Field : Field_Type := Random_Field; 
  66.       Sort_Start, 
  67.       Sort_End   : Time; 
  68.  
  69.    begin 
  70.       Put_Line ("Concurrent mergesort algorithm at work ..."); 
  71.  
  72.       Sort_Start := Clock; 
  73.       Merge_Sort_Concurrent (Sort_Field); 
  74.       Sort_End  := Clock; 
  75.  
  76.       Print_Time_Taken (Sort_End - Sort_Start); Put_Line (" for" & Field_Range'Image (Field_Size) & " Elements"); 
  77.  
  78.       Check_Field (Sort_Field, Random_Field); 
  79.  
  80.       if not Is_Sorted (Sort_Field) or else not Is_Permutation (Sort_Field, Random_Field) then 
  81.          raise Program_Error with "Tests failed"; 
  82.       end if; 
  83.    end; 
  84. end Test_Concurrent_Mergesort;