ADDED tests/natools-constant_indefinite_ordered_map_tests.adb Index: tests/natools-constant_indefinite_ordered_map_tests.adb ================================================================== --- tests/natools-constant_indefinite_ordered_map_tests.adb +++ tests/natools-constant_indefinite_ordered_map_tests.adb @@ -0,0 +1,591 @@ +------------------------------------------------------------------------------ +-- 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; ADDED tests/natools-constant_indefinite_ordered_map_tests.ads Index: tests/natools-constant_indefinite_ordered_map_tests.ads ================================================================== --- tests/natools-constant_indefinite_ordered_map_tests.ads +++ tests/natools-constant_indefinite_ordered_map_tests.ads @@ -0,0 +1,34 @@ +------------------------------------------------------------------------------ +-- 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 Natools.Tests; + +package Natools.Constant_Indefinite_Ordered_Map_Tests is + pragma Preelaborate; + + package NT renames Natools.Tests; + + procedure All_Tests (Report : in out NT.Reporter'Class); + + procedure Consistency (Report : in out NT.Reporter'Class); + procedure Cursor_Operations (Report : in out NT.Reporter'Class); + procedure Direct_Access (Report : in out NT.Reporter'Class); + procedure Empty_Map (Report : in out NT.Reporter'Class); + procedure Iterations (Report : in out NT.Reporter'Class); + procedure Map_Updates (Report : in out NT.Reporter'Class); + procedure Unsafe_Map_Roundtrip (Report : in out NT.Reporter'Class); + +end Natools.Constant_Indefinite_Ordered_Map_Tests; Index: tests/test_all.adb ================================================================== --- tests/test_all.adb +++ tests/test_all.adb @@ -19,10 +19,11 @@ ----------------------------------------------------------------------- with Ada.Command_Line; with Ada.Text_IO; with Natools.Chunked_Strings.Tests; +with Natools.Constant_Indefinite_Ordered_Map_Tests; with Natools.Cron.Tests; with Natools.Getopt_Long_Tests; with Natools.HMAC_Tests; with Natools.Reference_Tests; with Natools.Reference_Tests.Pools; @@ -75,10 +76,14 @@ Report.End_Section; Report.Section ("Chunked_String with single allocation unit"); Single_Chunked_Strings_Tests.All_Tests (Report); Report.End_Section; + + Report.Section ("Constant_Indefinite_Ordered_Maps"); + Natools.Constant_Indefinite_Ordered_Map_Tests.All_Tests (Report); + Report.End_Section; Report.Section ("Cron"); Natools.Cron.Tests.All_Tests (Report); Report.End_Section;