Natools

------------------------------------------------------------------------------
-- 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.           --
------------------------------------------------------------------------------

procedure Natools.Chunked_Strings.Tests.Memory
  (Report : in out Natools.Tests.Reporter'Class)
is
   function Allocated_Size (Source : in Chunked_String) return Natural;
      --  Return the number of allocated characters in Source


   function Allocated_Size (Source : in Chunked_String) return Natural is
   begin
      if Source.Data = null or else Source.Data'Last < 1 then
         return 0;
      end if;

      return (Source.Data'Last - 1) * Source.Chunk_Size
        + Source.Data (Source.Data'Last)'Last;
   end Allocated_Size;

   package NT renames Natools.Tests;
begin
   NT.Section (Report, "Extra tests for memory usage");

   declare
      Name : constant String := "Procedure Preallocate";
      CS : Chunked_String;
      Memory_Ref : Natural;
      Repeats : constant Positive := 50;
   begin
      Preallocate (CS, Repeats * Name'Length);
      Memory_Ref := Allocated_Size (CS);

      for I in 1 .. Repeats loop
         Append (CS, Name);
      end loop;

      if Memory_Ref /= Allocated_Size (CS) then
         NT.Item (Report, Name, NT.Fail);
         NT.Info (Report, "Memory after preallocation:"
           & Natural'Image (Memory_Ref));
         NT.Info (Report, "Memory after insertions:"
           & Natural'Image (Allocated_Size (CS)));
      else
         NT.Item (Report, Name, NT.Success);
      end if;
   exception
      when Error : others => NT.Report_Exception (Report, Name, Error);
   end;

   declare
      Name : constant String := "Procedure Free_Extra_Memory";
      CS : Chunked_String;
      Memory_Ref : Natural;
      Repeats : constant Positive := 50;
   begin
      Preallocate (CS, Repeats * Name'Length);
      Memory_Ref := Allocated_Size (CS);
      Free_Extra_Memory (CS);

      if Memory_Ref <= Allocated_Size (CS) then
         NT.Item (Report, Name, NT.Fail);
         NT.Info (Report, "Memory before:"
           & Natural'Image (Memory_Ref));
         NT.Info (Report, "Memory after:"
           &  Natural'Image (Allocated_Size (CS)));
      else
         NT.Item (Report, Name, NT.Success);
      end if;
   exception
      when Error : others => NT.Report_Exception (Report, Name, Error);
   end;

   Natools.Tests.End_Section (Report);
end Natools.Chunked_Strings.Tests.Memory;

------------------------------------------------------------------------------
-- 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.Chunked_Strings.Tests.Memory contains extra test cases to ensure --
-- memory usage works as expected.                                          --
------------------------------------------------------------------------------

with Natools.Tests;

generic procedure Natools.Chunked_Strings.Tests.Memory
  (Report : in out Natools.Tests.Reporter'Class);
pragma Preelaborate (Memory);

with Natools.Chunked_Strings.Tests.Coverage;
with Natools.Chunked_Strings.Tests.CXA4010;
with Natools.Chunked_Strings.Tests.CXA4011;
with Natools.Chunked_Strings.Tests.CXA4030;
with Natools.Chunked_Strings.Tests.CXA4031;
with Natools.Chunked_Strings.Tests.CXA4032;
with Natools.Chunked_Strings.Tests.Memory;
with Natools.Accumulators.Tests;

package body Natools.Chunked_Strings.Tests is
   package NT renames Natools.Tests;

   procedure All_Blackbox_Tests (Report : in out Natools.Tests.Reporter'Class)
   is

      procedure Test_Coverage is new Coverage;
   begin
      NT.Section (Report, "Greybox tests for Chunked_Strings");
      Test_Coverage (Report);
      NT.End_Section (Report);
   end All_Greybox_Tests;


   procedure All_Whitebox_Tests (Report : in out Natools.Tests.Reporter'Class)
   is
      procedure Test_Memory is new Memory;
   begin
      NT.Section (Report, "Whitebox tests for Chunked_Strings");
      Test_Memory (Report);
      NT.End_Section (Report);
   end All_Whitebox_Tests;


   procedure All_Tests (Report : in out Natools.Tests.Reporter'Class) is
   begin
      NT.Section (Report, "All tests of Chunked_Strings");
      All_Blackbox_Tests (Report);
      All_Greybox_Tests (Report);
      All_Whitebox_Tests (Report);
      NT.End_Section (Report);
   end All_Tests;



   procedure Dump (Report : in out Natools.Tests.Reporter'Class;
                   Dumped : in     Chunked_String)

-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.Chunked_Strings.Tests is the test suite for Chunked_String.      --
--                                                                          --




-- It also provides private helper functions used in more specialized test  --
-- packages.                                                                --
------------------------------------------------------------------------------

with Natools.Tests;

generic package Natools.Chunked_Strings.Tests is
   pragma Preelaborate (Tests);

   procedure All_Blackbox_Tests (Report : in out Natools.Tests.Reporter'Class);

   procedure All_Greybox_Tests (Report : in out Natools.Tests.Reporter'Class);

   procedure All_Whitebox_Tests (Report : in out Natools.Tests.Reporter'Class);

   procedure All_Tests (Report : in out Natools.Tests.Reporter'Class);

private

   procedure Dump (Report : in out Natools.Tests.Reporter'Class;
                   Dumped : in     Chunked_String);