Natools

natools-constant_indefinite_ordered_map_tests.adb at [1cc98d90f5]
Login

File tests/natools-constant_indefinite_ordered_map_tests.adb artifact b7057b0d58 part of check-in 1cc98d90f5


------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Containers;
with Ada.Strings.Unbounded;
with Natools.Constant_Indefinite_Ordered_Maps;

package body Natools.Constant_Indefinite_Ordered_Map_Tests is

   package Test_Maps is new
     Constant_Indefinite_Ordered_Maps
        (Key_Type     => String,
         Element_Type => Integer);


   function Image (Map : Test_Maps.Unsafe_Maps.Map) return String;

   function Sample_Map return Test_Maps.Unsafe_Maps.Map;

   function Sample_Map return Test_Maps.Updatable_Map
     is (Test_Maps.Create (Sample_Map));


   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   function Image (Map : Test_Maps.Unsafe_Maps.Map) return String is
      use Ada.Strings.Unbounded;
      Result : Unbounded_String;
      First : Boolean := True;

      procedure Process (Cursor : Test_Maps.Unsafe_Maps.Cursor);

      procedure Process (Cursor : Test_Maps.Unsafe_Maps.Cursor) is
      begin
         if First then
            First := False;
         else
            Append (Result, ", ");
         end if;

         Append (Result, Test_Maps.Unsafe_Maps.Key (Cursor));
         Append (Result, " ->");
         Append
           (Result, Integer'Image (Test_Maps.Unsafe_Maps.Element (Cursor)));
      end Process;
   begin
      Append (Result, "(");
      Map.Iterate (Process'Access);
      Append (Result, ")");
      return To_String (Result);
   end Image;


   function Sample_Map return Test_Maps.Unsafe_Maps.Map is
      Result : Test_Maps.Unsafe_Maps.Map;
   begin
      for I in 0 .. 9 loop
         Result.Insert
           ((1 => '1',
             2 => Character'Val (Character'Pos ('0') + I)),
            I + 10);
         Result.Insert
           ((1 => '2',
             2 => Character'Val (Character'Pos ('0') + I)),
            I + 20);
      end loop;

      return Result;
   end Sample_Map;



   -------------------------
   -- Complete Test Suite --
   -------------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Consistency (Report);
      Cursor_Operations (Report);
      Direct_Access (Report);
      Empty_Map (Report);
      Iterations (Report);
      Map_Updates (Report);
      Unsafe_Map_Roundtrip (Report);
   end All_Tests;



   ----------------------
   -- Individual Tests --
   ----------------------

   procedure Consistency (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Consistency checks");
   begin
      if Test_Maps.Has_Element (Test_Maps.No_Element) then
         Test.Fail ("No_Element has an element");
      end if;

      declare
         use type Ada.Containers.Count_Type;
         use type Test_Maps.Cursor;

         Map : constant Test_Maps.Updatable_Map := Sample_Map;
         Cursor : Test_Maps.Cursor;
      begin
         if Map.Length /= 20 then
            Test.Fail ("Unexpected map length:"
              & Ada.Containers.Count_Type'Image (Map.Length));
         end if;

         Cursor := Map.First;

         if Test_Maps.Key (Cursor) /= Map.First_Key then
            Test.Fail ("Key (First) /= First_Key");
         end if;

         if Test_Maps.Element (Cursor) /= Map.First_Element then
            Test.Fail ("Element (First) /= First_Element");
         end if;

         if Test_Maps.Previous (Cursor) /= Test_Maps.No_Element then
            Test.Fail ("Previous (First) has element");
         end if;

         Test_Maps.Next (Cursor);

         if Cursor < Map.First then
            Test.Fail ("Second < First");
         end if;

         if Cursor < Map.First_Key then
            Test.Fail ("Second < First_Key");
         end if;

         if not (Map.First_Key < Cursor) then
            Test.Fail ("Second <= First_Key");
         end if;

         Cursor := Map.Last;

         if Test_Maps.Key (Cursor) /= Map.Last_Key then
            Test.Fail ("Key (Last) /= Last_Key");
         end if;

         if Test_Maps.Element (Cursor) /= Map.Last_Element then
            Test.Fail ("Element (Last) /= Last_Element");
         end if;

         if Test_Maps.Next (Cursor) /= Test_Maps.No_Element then
            Test.Fail ("Next (Last) has element");
         end if;

         Test_Maps.Previous (Cursor);

         if Cursor > Map.Last then
            Test.Fail ("Before_Last > Last");
         end if;

         if Cursor > Map.Last_Key then
            Test.Fail ("Before_Last > Last_Key");
         end if;

         if not (Map.Last_Key > Cursor) then
            Test.Fail ("Before_Last >= Last_Key");
         end if;
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Consistency;


   procedure Cursor_Operations (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Cursor operations");
   begin
      declare
         procedure Check (Cursor : in Test_Maps.Cursor);
         procedure Check (Key : in String; Element : in Integer);

         Expected : String := "??";

         procedure Check (Cursor : in Test_Maps.Cursor) is
         begin
            Test_Maps.Query_Element (Cursor, Check'Access);
         end Check;

         procedure Check (Key : in String; Element : in Integer) is
         begin
            if Key /= Expected or Element /= Integer'Value (Expected) then
               Test.Fail ("Expected """ & Expected
                 & """, got (""" & Key
                 & " ->" & Integer'Image (Element) & ')');
            end if;
         end Check;

         Map : constant Test_Maps.Updatable_Map := Sample_Map;
         Cursor, Alternate : Test_Maps.Cursor;
      begin
         if Test_Maps.Has_Element (Cursor) then
            Test.Fail ("Default cursor is not empty");
            return;
         end if;

         Expected := "17";
         Cursor := Map.Find (Expected);
         if not Test_Maps.Has_Element (Cursor) then
            Test.Fail ("Map.Find (""17"") has no element");
            return;
         end if;
         Check (Cursor);

         Alternate := Test_Maps.Previous (Cursor);
         Expected := "16";
         Check (Alternate);

         Alternate := Test_Maps.Next (Cursor);
         Expected := "18";
         Check (Alternate);

         Test_Maps.Clear (Alternate);
         if Test_Maps.Has_Element (Alternate) then
            Test.Fail ("Clear cursor has element");
            return;
         end if;

         Test_Maps.Next (Alternate);
         if Test_Maps.Has_Element (Alternate) then
            Test.Fail ("Next (Empty_Cursor) has element");
            return;
         end if;

         Test_Maps.Previous (Alternate);
         if Test_Maps.Has_Element (Alternate) then
            Test.Fail ("Previous (Empty_Cursor) has element");
         end if;
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Cursor_Operations;


   procedure Direct_Access (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Direct node access");
   begin
      declare
         use type Test_Maps.Cursor;

         Map : constant Test_Maps.Updatable_Map := Sample_Map;
         Img : String := "??";
         Cursor : Test_Maps.Cursor;
      begin
         for I in 10 .. 29 loop
            Img (1) := Character'Val (Character'Pos ('0') + I / 10);
            Img (2) := Character'Val (Character'Pos ('0') + I mod 10);

            if not Map.Contains (Img) then
               Test.Fail ("Sample_Map should contain key """ & Img & '"');
            elsif Map.Floor (Img) /= Map.Ceiling (Img) then
               Test.Fail ("Floor /= Ceiling for existing key """ & Img & '"');
            elsif Map.Element (Img) /= I then
               Test.Fail ("Unexpected element"
                 & Integer'Image (Map.Element (Img))
                 & " for key """ & Img & '"');
            end if;

            Cursor := Map.Floor ("1");
            if Test_Maps.Has_Element (Cursor) then
               Test.Fail ("Map.Floor (""1"") is not empty ("""
                 & Test_Maps.Key (Cursor) & '"');
            end if;

            Cursor := Map.Find ("2");
            if Test_Maps.Has_Element (Cursor) then
               Test.Fail ("Map.Find (""2"") is not empty ("""
                 & Test_Maps.Key (Cursor) & '"');
            end if;

            Cursor := Map.Ceiling ("3");
            if Test_Maps.Has_Element (Cursor) then
               Test.Fail ("Map.Ceiling (""3"") is not empty ("""
                 & Test_Maps.Key (Cursor) & '"');
            end if;

            Cursor := Map.Floor ("2");
            if not Test_Maps.Has_Element (Cursor) then
               Test.Fail ("Map.Floor (""2"") is empty");
            elsif Test_Maps.Key (Cursor) /= "19" then
               Test.Fail ("Map.Floor (""2"") returns unexpected node """
                 & Test_Maps.Key (Cursor) & '"');
            end if;

            Cursor := Map.Ceiling ("2");
            if not Test_Maps.Has_Element (Cursor) then
               Test.Fail ("Map.Ceiling (""2"") is empty");
            elsif Test_Maps.Key (Cursor) /= "20" then
               Test.Fail ("Map.Ceiling (""2"") returns unexpected node """
                 & Test_Maps.Key (Cursor) & '"');
            end if;
         end loop;
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Direct_Access;


   procedure Empty_Map (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Operations on empty map");
   begin
      declare
         use type Ada.Containers.Count_Type;
         use type Test_Maps.Updatable_Map;

         procedure Fail_Test (Cursor : in Test_Maps.Cursor);

         procedure Fail_Test (Cursor : in Test_Maps.Cursor) is
            pragma Unreferenced (Cursor);
         begin
            Test.Fail ("Unexpected callback use");
         end Fail_Test;

         Cursor : Test_Maps.Cursor;
         Map : Test_Maps.Updatable_Map;
         pragma Unmodified (Map);
      begin
         Map.Iterate (Fail_Test'Access);
         Map.Reverse_Iterate (Fail_Test'Access);

         if Test_Maps.Has_Element (Map.First) then
            Test.Fail ("Empty_Map.First has an element");
         end if;

         if Test_Maps.Has_Element (Map.Last) then
            Test.Fail ("Empty_Map.Last has an element");
         end if;

         if not Map.To_Unsafe_Map.Is_Empty then
            Test.Fail ("Empty_Map.To_Unsafe_Map is not empty");
         end if;

         if Map.Length /= 0 then
            Test.Fail ("Empty_Map.Length is not zero");
         end if;

         if Map.Contains ("foo") then
            Test.Fail ("Empty_Map.Contains (""foo"")");
         end if;

         Cursor := Map.Find ("2");
         if Test_Maps.Has_Element (Cursor) then
            Test.Fail ("Empty_Map.Find (""2"") has element ("""
              & Test_Maps.Key (Cursor) & """ ->"
              & Integer'Image (Test_Maps.Element (Cursor)) & ')');
         end if;

         Cursor := Map.Floor ("2");
         if Test_Maps.Has_Element (Cursor) then
            Test.Fail ("Empty_Map.Floor (""2"") has element ("""
              & Test_Maps.Key (Cursor) & """ ->"
              & Integer'Image (Test_Maps.Element (Cursor)) & ')');
         end if;

         Cursor := Map.Ceiling ("2");
         if Test_Maps.Has_Element (Cursor) then
            Test.Fail ("Empty_Map.Ceiling (""2"") has element ("""
              & Test_Maps.Key (Cursor) & """ ->"
              & Integer'Image (Test_Maps.Element (Cursor)) & ')');
         end if;

         if Map /= Test_Maps.Create (Test_Maps.Unsafe_Maps.Empty_Map) then
            Test.Fail ("Empty_Map /= Create (Unsafe_Empty_Map)");
         end if;
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Empty_Map;


   procedure Iterations (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Iterative visit of the whole container");
   begin
      declare
         Map : constant Test_Maps.Updatable_Map := Sample_Map;

         procedure Check (Key : in String; Element : in Integer);
         procedure Check_Cursor (Cursor : in Test_Maps.Cursor);
         procedure Init_Backward (Id_Char : in Character);
         procedure Init_Forward (Id_Char : in Character);

         Id : String := "??";
         Index : Integer := 0;
         Direction : Integer := 1;

         procedure Check (Key : in String; Element : in Integer) is
            Space_Image : constant String := Integer'Image (Index);
            Image : constant String
              := Space_Image (Space_Image'First + 1 .. Space_Image'Last);
         begin
            if Key /= Image then
               Test.Fail (Id & '.' & Image
                 & ". unexpected key """ & Key & '"');
            end if;

            if Element /= Index then
               Test.Fail (Id & '.' & Image
                  & ". unexpected element" & Integer'Image (Element));
            end if;

            Index := Index + Direction;
         end Check;

         procedure Check_Cursor (Cursor : in Test_Maps.Cursor) is
         begin
            Check (Test_Maps.Key (Cursor), Test_Maps.Element (Cursor));
         end Check_Cursor;

         procedure Init_Backward (Id_Char : in Character) is
         begin
            Id := Id_Char & 'b';
            Index := 29;
            Direction := -1;
         end Init_Backward;

         procedure Init_Forward (Id_Char : in Character) is
         begin
            Id := Id_Char & 'f';
            Index := 10;
            Direction := 1;
         end Init_Forward;
      begin
         begin
            Init_Forward ('1');
            Map.Iterate (Check_Cursor'Access);
         end;

         begin
            Init_Backward ('1');
            Map.Reverse_Iterate (Check_Cursor'Access);
         end;

         declare
            Cursor : Test_Maps.Cursor := Map.First;
         begin
            Init_Forward ('2');
            while Test_Maps.Has_Element (Cursor) loop
               Check_Cursor (Cursor);
               Test_Maps.Next (Cursor);
            end loop;
         end;

         declare
            Cursor : Test_Maps.Cursor := Map.Last;
         begin
            Init_Backward ('2');
            while Test_Maps.Has_Element (Cursor) loop
               Check_Cursor (Cursor);
               Test_Maps.Previous (Cursor);
            end loop;
         end;
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Iterations;


   procedure Map_Updates (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Map updates");
   begin
      declare
         use type Test_Maps.Updatable_Map;

         procedure Update (Key : in String; Element : in out Integer);

         procedure Update (Key : in String; Element : in out Integer) is
            pragma Unreferenced (Key);
         begin
            Element := 7;
         end Update;

         Map_A : Test_Maps.Updatable_Map := Sample_Map;
         Map_B : Test_Maps.Updatable_Map := Sample_Map;
         Cursor : Test_Maps.Cursor;
      begin
         if Map_A = Map_B then
            Test.Fail ("Unrelated maps are equal");
            return;
         end if;

         Cursor := Map_A.Find ("17");
         pragma Assert (Test_Maps.Has_Element (Cursor));

         if Test_Maps.Is_Related (Map_B, Cursor) then
            Test.Fail ("Map_B and Cursor should be unrelated");
            return;
         end if;

         Map_A.Update_Element (Cursor, Update'Access);
         if Test_Maps.Element (Cursor) /= 7 then
            Test.Fail ("Update failure, element is"
              & Integer'Image (Test_Maps.Element (Cursor))
              & ", should be 7");
         end if;

         Test_Maps.Move (Map_B, Map_A);

         if not Map_A.Is_Empty then
            Test.Fail ("Move source is not empty");
         end if;

         if not Test_Maps.Is_Related (Map_B, Cursor) then
            Test.Fail ("Move target is not related to old source");
         else
            Map_B.Update_Element (Cursor, Update'Access);
         end if;

         Map_A.Replace (Map_B.To_Unsafe_Map);

         if Map_A.Is_Empty then
            Test.Fail ("Replaced map is empty");
         end if;

         if Map_A.Element ("17") /= 7 then
            Test.Fail ("Unexpected value"
              & Integer'Image (Map_A.Element ("17"))
              & "for Map_A.Element (""17"")");
         end if;

         Map_B.Clear;

         if not Map_B.Is_Empty then
            Test.Fail ("Cleared map is not empty");
         end if;

         if Test_Maps.Is_Related (Map_B, Cursor) then
            Test.Fail ("Clear map is still related to cursor");
         end if;

         if (not Test_Maps.Has_Element (Cursor))
           or else Test_Maps.Element (Cursor) /= 7
         then
            Test.Fail ("Orphaned cursor has lost its value");
         end if;

         Test_Maps.Next (Cursor);
         if (not Test_Maps.Has_Element (Cursor))
           or else Test_Maps.Element (Cursor) /= 18
         then
            Test.Fail ("Moved orphaned cursor has lost its value");
         end if;
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Map_Updates;


   procedure Unsafe_Map_Roundtrip (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Constant_Map <-> Unsafe_Map roundtrip");
   begin
      declare
         use type Test_Maps.Unsafe_Maps.Map;

         Unsafe : constant Test_Maps.Unsafe_Maps.Map := Sample_Map;
         Safe : constant Test_Maps.Updatable_Map := Test_Maps.Create (Unsafe);
         Roundtrip : constant Test_Maps.Unsafe_Maps.Map := Safe.To_Unsafe_Map;
      begin
         if Unsafe /= Roundtrip then
            Test.Fail;
            Test.Info ("Original: " & Image (Unsafe));
            Test.Info ("Roundtrip: " & Image (Roundtrip));
         end if;
      end;
   exception
      when Error : others => Test.Report_Exception (Error);
   end Unsafe_Map_Roundtrip;

end Natools.Constant_Indefinite_Ordered_Map_Tests;