ADDED tests/natools-accumulators-tests.adb Index: tests/natools-accumulators-tests.adb ================================================================== --- tests/natools-accumulators-tests.adb +++ tests/natools-accumulators-tests.adb @@ -0,0 +1,199 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2013, 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. -- +------------------------------------------------------------------------------ + +package body Natools.Accumulators.Tests is + package NT renames Natools.Tests; + + procedure Check_Emptiness + (Report : in out NT.Reporter'Class; + Accumulator : in out String_Accumulator'Class; + Test_Name : in String); + -- Add an item to Report, success being emptiness of Accumulator + + procedure Check_Contents + (Report : in out NT.Reporter'Class; + Accumulator : in out String_Accumulator'Class; + Test_Name : in String; + Reference : in String); + -- Add an item to Report, success being Accumulator matching Reference + + + + procedure Check_Contents + (Report : in out NT.Reporter'Class; + Accumulator : in out String_Accumulator'Class; + Test_Name : in String; + Reference : in String) + is + S : constant String := Accumulator.To_String; + L : constant Natural := Accumulator.Length; + begin + if S'Length /= L then + NT.Item (Report, Test_Name, NT.Fail); + NT.Info + (Report, + "Inconsistent length" & Natural'Image (L) + & " for string """ & S & '"'); + elsif S /= Reference then + NT.Item (Report, Test_Name, NT.Fail); + NT.Info (Report, "Accumulated """ & S & '"'); + NT.Info (Report, "Reference """ & Reference & '"'); + else + NT.Item (Report, Test_Name, NT.Success); + end if; + end Check_Contents; + + + procedure Check_Emptiness + (Report : in out NT.Reporter'Class; + Accumulator : in out String_Accumulator'Class; + Test_Name : in String) + is + L : constant Natural := Accumulator.Length; + S : constant String := Accumulator.To_String; + begin + if L /= 0 or S /= "" then + NT.Item (Report, Test_Name, NT.Fail); + NT.Info (Report, "Accumulator.Length is" & Natural'Image (L)); + NT.Info (Report, "Accumulator.To_String is """ & S & '"'); + else + NT.Item (Report, Test_Name, NT.Success); + end if; + end Check_Emptiness; + + + procedure Test + (Report : in out Natools.Tests.Reporter'Class; + Accumulator : in out String_Accumulator'Class) + is + Part_1 : constant String + := "The quick brown fox jumps over the lazy dog."; + Part_2 : constant String + := "Lorem ipsum dolor sit amet, consectetur adipisicing elit."; + L_1 : constant Natural := 10; + L_2 : constant Natural := 7; + begin + declare + Name : constant String := "Soft_Reset"; + begin + Accumulator.Soft_Reset; + Check_Emptiness (Report, Accumulator, Name); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "String append"; + begin + Accumulator.Append (Part_1); + Check_Contents (Report, Accumulator, Name, Part_1); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Character accumulation"; + begin + for I in Part_2'Range loop + Accumulator.Append (String'(1 => Part_2 (I))); + end loop; + + Check_Contents (Report, Accumulator, Name, Part_1 & Part_2); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Tail extraction"; + OK : Boolean := True; + begin + declare + T : constant String := Accumulator.Tail (L_1); + begin + if T'Length /= L_1 then + NT.Item (Report, Name, NT.Fail); + NT.Info (Report, + "Wrong tail length" & Natural'Image (T'Length) + & ", expected" & Natural'Image (L_1)); + OK := False; + elsif T /= Part_2 (Part_2'Last - L_1 + 1 .. Part_2'Last) then + NT.Item (Report, Name, NT.Fail); + NT.Info (Report, "Incorrect tail """ & T & '"'); + NT.Info (Report, "Expected """ + & Part_2 (Part_2'Last - L_1 + 1 .. Part_2'Last) & '"'); + OK := False; + end if; + end; + + if OK then + Check_Contents (Report, Accumulator, Name, Part_1 & Part_2); + end if; + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Unappend"; + begin + Accumulator.Unappend (Part_2 (Part_2'Last - L_2 + 1 .. Part_2'Last)); + Check_Contents (Report, Accumulator, Name, + Part_1 & Part_2 (Part_2'First .. Part_2'Last - L_2)); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "No-op Unappend"; + begin + Accumulator.Unappend (Part_1); + Check_Contents (Report, Accumulator, Name, + Part_1 & Part_2 (Part_2'First .. Part_2'Last - L_2)); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "In-place To_String"; + Target : String (1 .. Part_1'Length + Part_2'Length) + := (others => '*'); + begin + Accumulator.To_String (Target); + Target (Part_1'Length + Part_2'Length - L_2 + 1 .. Target'Last) + := Part_2 (Part_2'Last - L_2 + 1 .. Part_2'Last); + + if Target /= Part_1 & Part_2 then + NT.Item (Report, Name, NT.Fail); + NT.Info (Report, "Found """ & Target & '"'); + NT.Info (Report, "Expected """ & Target & '"'); + else + Check_Contents (Report, Accumulator, Name, + Part_1 & Part_2 (Part_2'First .. Part_2'Last - L_2)); + end if; + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + + declare + Name : constant String := "Hard_Reset"; + begin + Accumulator.Hard_Reset; + Check_Emptiness (Report, Accumulator, Name); + exception + when Error : others => NT.Report_Exception (Report, Name, Error); + end; + end Test; + +end Natools.Accumulators.Tests; ADDED tests/natools-accumulators-tests.ads Index: tests/natools-accumulators-tests.ads ================================================================== --- tests/natools-accumulators-tests.ads +++ tests/natools-accumulators-tests.ads @@ -0,0 +1,33 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2013, 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. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.Accumulators.Tests is a test suite for any object implementing -- +-- the accumulator interface. -- +------------------------------------------------------------------------------ + +with Natools.Tests; + +package Natools.Accumulators.Tests is + pragma Preelaborate (Tests); + + procedure Test + (Report : in out Natools.Tests.Reporter'Class; + Accumulator : in out String_Accumulator'Class); + -- Run a sequence of tests on Accumulator. + -- This append a sequence of items to Report in the current section. + +end Natools.Accumulators.Tests;