-----------------------------------------------------------------------
--  strings.tests -- Unit tests for strings
--  Copyright (C) 2009, 2010, 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings;
with Ada.Strings.Unbounded;
with Ada.Strings.Fixed;
with Ada.Strings.Unbounded.Hash;
with Util.Test_Caller;
with Util.Strings.Transforms;
with Util.Strings.Maps;
with Util.Perfect_Hash;
with Ada.Streams;
with Util.Measures;
package body Util.Strings.Tests is

   use Ada.Strings.Unbounded;
   use Util.Tests;
   use Util.Strings.Transforms;

   package Caller is new Util.Test_Caller (Test, "Strings");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Strings.Transforms.Escape_Javascript",
                       Test_Escape_Javascript'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Transforms.Escape_Xml",
                       Test_Escape_Xml'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Transforms.Capitalize",
                       Test_Capitalize'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Transforms.To_Upper_Case",
                       Test_To_Upper_Case'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Transforms.To_Lower_Case",
                       Test_To_Lower_Case'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Transforms.To_Hex",
                       Test_To_Hex'Access);
      Caller.Add_Test (Suite, "Test Measure",
                       Test_Measure_Copy'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Index",
                       Test_Index'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Rindex",
                       Test_Rindex'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Benchmark",
                       Test_Measure_Hash'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.String_Ref",
                       Test_String_Ref'Access);
      Caller.Add_Test (Suite, "Test perfect hash",
                       Test_Perfect_Hash'Access);

   end Add_Tests;

   procedure Test_Escape_Javascript (T : in out Test) is
      Result : Unbounded_String;
   begin
      Escape_Javascript (Content => ASCII.LF & " ""a string"" a 'single quote'",
                         Into    => Result);
      Assert_Equals (T, "\n \""a string\"" a \'single quote\'", Result);

      Result := To_Unbounded_String ("");
      Escape_Javascript (Content => ASCII.ESC & "[m " & Character'Val (255),
                         Into    => Result);
      Assert_Equals (T, "\u001B[m \u00FF", Result);
   end Test_Escape_Javascript;

   procedure Test_Escape_Xml (T : in out Test) is
      Result : Unbounded_String;
   begin
      Escape_Xml (Content => ASCII.LF & " < ""a string"" a 'single quote' >& ",
                  Into    => Result);
      Assert_Equals (T, ASCII.LF & " < ""a string"" a 'single quote' >& ",
                     Result);

      Result := To_Unbounded_String ("");
      Escape_Xml (Content => ASCII.ESC & "[m " & Character'Val (255),
                  Into    => Result);
      Assert_Equals (T, ASCII.ESC & "[m ÿ", Result);
   end Test_Escape_Xml;

   procedure Test_Capitalize (T : in out Test) is
      Result : Unbounded_String;
   begin
      Assert_Equals (T, "Capitalize_A_String", Capitalize ("capITalIZe_a_strING"));

      Capitalize ("CapAS_String", Result);
      Assert_Equals (T, "Capas_String", Result);
   end Test_Capitalize;

   procedure Test_To_Upper_Case (T : in out Test) is
   begin
      Assert_Equals (T, "UPPERCASE_0123_STR", To_Upper_Case ("upperCase_0123_str"));
   end Test_To_Upper_Case;

   procedure Test_To_Lower_Case (T : in out Test) is
   begin
      Assert_Equals (T, "lowercase_0123_str", To_Lower_Case ("LowERCase_0123_STR"));
   end Test_To_Lower_Case;

   procedure Test_To_Hex (T : in out Test) is
      Result : Unbounded_String;
   begin
      To_Hex (Result, Character'Val (23));
      Assert_Equals (T, "\u0017", Result);

      To_Hex (Result, Character'Val (31));
      Assert_Equals (T, "\u0017\u001F", Result);

      To_Hex (Result, Character'Val (255));
      Assert_Equals (T, "\u0017\u001F\u00FF", Result);
   end Test_To_Hex;

   procedure Test_Measure_Copy (T : in out Test) is
      pragma Unreferenced (T);

      Buf : constant Ada.Streams.Stream_Element_Array (1 .. 10_024) := (others => 23);
      pragma Suppress (All_Checks, Buf);
   begin
      declare
         T : Util.Measures.Stamp;
         R : Ada.Strings.Unbounded.Unbounded_String;
      begin
         for I in Buf'Range loop
            Append (R, Character'Val (Buf (I)));
         end loop;
         Util.Measures.Report (T, "Stream transform using Append (1024 bytes)");
      end;
      declare
         T : Util.Measures.Stamp;
         R : Ada.Strings.Unbounded.Unbounded_String;
         S : String (1 .. 10_024);
         pragma Suppress (All_Checks, S);
      begin
         for I in Buf'Range loop
            S (Natural (I)) := Character'Val (Buf (I));
         end loop;
         Append (R, S);
         Util.Measures.Report (T, "Stream transform using temporary string (1024 bytes)");
      end;
--        declare
--           T : Util.Measures.Stamp;
--           R : Ada.Strings.Unbounded.Unbounded_String;
--           P : constant Ptr := new String (1 .. Buf'Length);
--
--           pragma Suppress (All_Checks, P);
--        begin
--           for I in P'Range loop
--              P (I) := Character'Val (Buf (Ada.Streams.Stream_Element_Offset (I)));
--           end loop;
--           Ada.Strings.Unbounded.Aux.Set_String (R, P.all'Access);
--           Util.Measures.Report (T, "Stream transform using Aux string (1024 bytes)");
--        end;
   end Test_Measure_Copy;

   --  Test the Index operation
   procedure Test_Index (T : in out Test) is
      Str : constant String := "0123456789abcdefghijklmnopq";
   begin
      declare
         St  : Util.Measures.Stamp;
         Pos : Integer;
      begin
         for I in 1 .. 10 loop
            Pos := Index (Str, 'q');
         end loop;
         Util.Measures.Report (St, "Util.Strings.Index");
         Assert_Equals (T, 27, Pos, "Invalid index position");
      end;
      declare
         St  : Util.Measures.Stamp;
         Pos : Integer;
      begin
         for I in 1 .. 10 loop
            Pos := Ada.Strings.Fixed.Index (Str, "q");
         end loop;
         Util.Measures.Report (St, "Ada.Strings.Fixed.Index");
         Assert_Equals (T, 27, Pos, "Invalid index position");
      end;
   end Test_Index;

   --  Test the Rindex operation
   procedure Test_Rindex (T : in out Test) is
      Str : constant String := "0123456789abcdefghijklmnopq";
   begin
      declare
         St  : Util.Measures.Stamp;
         Pos : Natural;
      begin
         for I in 1 .. 10 loop
            Pos := Rindex (Str, '0');
         end loop;
         Util.Measures.Report (St, "Util.Strings.Rindex");
         Assert_Equals (T, 1, Pos, "Invalid rindex position");
      end;
      declare
         St  : Util.Measures.Stamp;
         Pos : Natural;
      begin
         for I in 1 .. 10 loop
            Pos := Ada.Strings.Fixed.Index (Str, "0", Ada.Strings.Backward);
         end loop;
         Util.Measures.Report (St, "Ada.Strings.Fixed.Rindex");
         Assert_Equals (T, 1, Pos, "Invalid rindex position");
      end;
   end Test_Rindex;

   package String_Map is new Ada.Containers.Hashed_Maps
     (Key_Type        => Unbounded_String,
      Element_Type    => Unbounded_String,
      Hash            => Hash,
      Equivalent_Keys => "=");

   package String_Ref_Map is new Ada.Containers.Hashed_Maps
     (Key_Type        => String_Ref,
      Element_Type    => String_Ref,
      Hash            => Hash,
      Equivalent_Keys => Equivalent_Keys);

   --  Do some benchmark on String -> X hash mapped.
   procedure Test_Measure_Hash (T : in out Test) is
      KEY     : aliased constant String := "testing";
      Str_Map : Util.Strings.Maps.Map;
      Ptr_Map : Util.Strings.String_Access_Map.Map;
      Ref_Map : String_Ref_Map.Map;
      Unb_Map : String_Map.Map;
      Name    : String_Access := new String '(KEY);
      Ref     : constant String_Ref := To_String_Ref (KEY);
   begin
      Str_Map.Insert (Name.all, Name.all);
      Ptr_Map.Insert (Name.all'Access, Name.all'Access);
      Unb_Map.Insert (To_Unbounded_String (KEY), To_Unbounded_String (KEY));
      Ref_Map.Insert (Ref, Ref);

      --  Performance of Hashed_Map Name_Access -> Name_Access
      --  (the fastest hash)
      declare
         St  : Util.Measures.Stamp;
         Pos : constant Strings.String_Access_Map.Cursor := Ptr_Map.Find (KEY'Unchecked_Access);
         Val : constant Name_Access := Util.Strings.String_Access_Map.Element (Pos);
      begin
         Util.Measures.Report (St, "Util.Strings.String_Access_Maps.Find+Element");
         Assert_Equals (T, "testing", Val.all, "Invalid value returned");
      end;

      --  Performance of Hashed_Map String_Ref -> String_Ref
      --  (almost same performance as Hashed_Map Name_Access -> Name_Access)
      declare
         St  : Util.Measures.Stamp;
         Pos : constant String_Ref_Map.Cursor := Ref_Map.Find (Ref);
         Val : constant String_Ref := String_Ref_Map.Element (Pos);
      begin
         Util.Measures.Report (St, "Util.Strings.String_Ref_Maps.Find+Element");
         Assert_Equals (T, "testing", String '(To_String (Val)), "Invalid value returned");
      end;

      --  Performance of Hashed_Map Unbounded_String -> Unbounded_String
      --  (little overhead due to String copy made by Unbounded_String)
      declare
         St  : Util.Measures.Stamp;
         Pos : constant String_Map.Cursor := Unb_Map.Find (To_Unbounded_String (KEY));
         Val : constant Unbounded_String := String_Map.Element (Pos);
      begin
         Util.Measures.Report (St, "Hashed_Maps<Unbounded,Unbounded..Find+Element");
         Assert_Equals (T, "testing", Val, "Invalid value returned");
      end;

      --  Performance for Indefinite_Hashed_Map String -> String
      --  (the slowest hash, string copy to get the result, pointer to key and element
      --  in the hash map implementation)
      declare
         St  : Util.Measures.Stamp;
         Pos : constant Util.Strings.Maps.Cursor := Str_Map.Find (KEY);
         Val : constant String := Util.Strings.Maps.Element (Pos);
      begin
         Util.Measures.Report (St, "Util.Strings.Maps.Find+Element");
         Assert_Equals (T, "testing", Val, "Invalid value returned");
      end;

      Free (Name);
   end Test_Measure_Hash;

   --  ------------------------------
   --  Test String_Ref creation
   --  ------------------------------
   procedure Test_String_Ref (T : in out Test) is
      R1 : String_Ref := To_String_Ref ("testing a string");
   begin
      for I in 1 .. 1_000 loop
         declare
            S  : constant String (1 .. I) := (others => 'x');
            R2 : constant String_Ref := To_String_Ref (S);
         begin
            Assert_Equals (T, S, To_String (R2), "Invalid String_Ref");
            T.Assert (R2 = S, "Invalid comparison");
            Assert_Equals (T, I, Length (R2), "Invalid length");
            R1 := R2;
            T.Assert (R1 = R2, "Invalid String_Ref copy");
         end;
      end loop;
   end Test_String_Ref;

   --  Test perfect hash (samples/gperfhash)
   procedure Test_Perfect_Hash (T : in out Test) is
   begin
      for I in Util.Perfect_Hash.Keywords'Range loop
         declare
            K : constant String := Util.Perfect_Hash.Keywords (I).all;
         begin
            Assert_Equals (T, I, Util.Perfect_Hash.Hash (K),
                           "Invalid hash");
            Assert_Equals (T, I, Util.Perfect_Hash.Hash (To_Lower_Case (K)),
                           "Invalid hash");
            Assert (T, Util.Perfect_Hash.Is_Keyword (K), "Keyword " & K & " is not a keyword");
            Assert (T, Util.Perfect_Hash.Is_Keyword (To_Lower_Case (K)),
                    "Keyword " & K & " is not a keyword");
         end;
      end loop;
   end Test_Perfect_Hash;

end Util.Strings.Tests;

-----------------------------------------------------------------------
--  strings.tests -- Unit tests for strings
--  Copyright (C) 2009, 2010, 2011, 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings;
with Ada.Strings.Unbounded;
with Ada.Strings.Fixed;
with Ada.Strings.Unbounded.Hash;
with Util.Test_Caller;
with Util.Strings.Transforms;
with Util.Strings.Maps;
with Util.Perfect_Hash;
with Ada.Streams;
with Util.Measures;
package body Util.Strings.Tests is

   use Ada.Strings.Unbounded;
   use Util.Tests;
   use Util.Strings.Transforms;

   package Caller is new Util.Test_Caller (Test, "Strings");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Strings.Transforms.Escape_Javascript",
                       Test_Escape_Javascript'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Transforms.Escape_Xml",
                       Test_Escape_Xml'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Transforms.Capitalize",
                       Test_Capitalize'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Transforms.To_Upper_Case",
                       Test_To_Upper_Case'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Transforms.To_Lower_Case",
                       Test_To_Lower_Case'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Transforms.To_Hex",
                       Test_To_Hex'Access);
      Caller.Add_Test (Suite, "Test Measure",
                       Test_Measure_Copy'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Index",
                       Test_Index'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Rindex",
                       Test_Rindex'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.Benchmark",
                       Test_Measure_Hash'Access);
      Caller.Add_Test (Suite, "Test Util.Strings.String_Ref",
                       Test_String_Ref'Access);
      Caller.Add_Test (Suite, "Test perfect hash",
                       Test_Perfect_Hash'Access);

   end Add_Tests;

   procedure Test_Escape_Javascript (T : in out Test) is
      Result : Unbounded_String;
   begin
      Escape_Javascript (Content => ASCII.LF & " ""a string"" a 'single quote'",
                         Into    => Result);
      Assert_Equals (T, "\n \""a string\"" a \'single quote\'", Result);

      Result := To_Unbounded_String ("");
      Escape_Javascript (Content => ASCII.ESC & "[m " & Character'Val (255),
                         Into    => Result);
      Assert_Equals (T, "\u001B[m " & Character'Val (255), Result);
   end Test_Escape_Javascript;

   procedure Test_Escape_Xml (T : in out Test) is
      Result : Unbounded_String;
   begin
      Escape_Xml (Content => ASCII.LF & " < ""a string"" a 'single quote' >& ",
                  Into    => Result);
      Assert_Equals (T, ASCII.LF & " < ""a string"" a 'single quote' >& ",
                     Result);

      Result := To_Unbounded_String ("");
      Escape_Xml (Content => ASCII.ESC & "[m " & Character'Val (255),
                  Into    => Result);
      Assert_Equals (T, ASCII.ESC & "[m ÿ", Result);
   end Test_Escape_Xml;

   procedure Test_Capitalize (T : in out Test) is
      Result : Unbounded_String;
   begin
      Assert_Equals (T, "Capitalize_A_String", Capitalize ("capITalIZe_a_strING"));

      Capitalize ("CapAS_String", Result);
      Assert_Equals (T, "Capas_String", Result);
   end Test_Capitalize;

   procedure Test_To_Upper_Case (T : in out Test) is
   begin
      Assert_Equals (T, "UPPERCASE_0123_STR", To_Upper_Case ("upperCase_0123_str"));
   end Test_To_Upper_Case;

   procedure Test_To_Lower_Case (T : in out Test) is
   begin
      Assert_Equals (T, "lowercase_0123_str", To_Lower_Case ("LowERCase_0123_STR"));
   end Test_To_Lower_Case;

   procedure Test_To_Hex (T : in out Test) is
      Result : Unbounded_String;
   begin
      To_Hex (Result, Character'Val (23));
      Assert_Equals (T, "\u0017", Result);

      To_Hex (Result, Character'Val (31));
      Assert_Equals (T, "\u0017\u001F", Result);

      To_Hex (Result, Character'Val (255));
      Assert_Equals (T, "\u0017\u001F\u00FF", Result);
   end Test_To_Hex;

   procedure Test_Measure_Copy (T : in out Test) is
      pragma Unreferenced (T);

      Buf : constant Ada.Streams.Stream_Element_Array (1 .. 10_024) := (others => 23);
      pragma Suppress (All_Checks, Buf);
   begin
      declare
         T : Util.Measures.Stamp;
         R : Ada.Strings.Unbounded.Unbounded_String;
      begin
         for I in Buf'Range loop
            Append (R, Character'Val (Buf (I)));
         end loop;
         Util.Measures.Report (T, "Stream transform using Append (1024 bytes)");
      end;
      declare
         T : Util.Measures.Stamp;
         R : Ada.Strings.Unbounded.Unbounded_String;
         S : String (1 .. 10_024);
         pragma Suppress (All_Checks, S);
      begin
         for I in Buf'Range loop
            S (Natural (I)) := Character'Val (Buf (I));
         end loop;
         Append (R, S);
         Util.Measures.Report (T, "Stream transform using temporary string (1024 bytes)");
      end;
--        declare
--           T : Util.Measures.Stamp;
--           R : Ada.Strings.Unbounded.Unbounded_String;
--           P : constant Ptr := new String (1 .. Buf'Length);
--
--           pragma Suppress (All_Checks, P);
--        begin
--           for I in P'Range loop
--              P (I) := Character'Val (Buf (Ada.Streams.Stream_Element_Offset (I)));
--           end loop;
--           Ada.Strings.Unbounded.Aux.Set_String (R, P.all'Access);
--           Util.Measures.Report (T, "Stream transform using Aux string (1024 bytes)");
--        end;
   end Test_Measure_Copy;

   --  Test the Index operation
   procedure Test_Index (T : in out Test) is
      Str : constant String := "0123456789abcdefghijklmnopq";
   begin
      declare
         St  : Util.Measures.Stamp;
         Pos : Integer;
      begin
         for I in 1 .. 10 loop
            Pos := Index (Str, 'q');
         end loop;
         Util.Measures.Report (St, "Util.Strings.Index");
         Assert_Equals (T, 27, Pos, "Invalid index position");
      end;
      declare
         St  : Util.Measures.Stamp;
         Pos : Integer;
      begin
         for I in 1 .. 10 loop
            Pos := Ada.Strings.Fixed.Index (Str, "q");
         end loop;
         Util.Measures.Report (St, "Ada.Strings.Fixed.Index");
         Assert_Equals (T, 27, Pos, "Invalid index position");
      end;
   end Test_Index;

   --  Test the Rindex operation
   procedure Test_Rindex (T : in out Test) is
      Str : constant String := "0123456789abcdefghijklmnopq";
   begin
      declare
         St  : Util.Measures.Stamp;
         Pos : Natural;
      begin
         for I in 1 .. 10 loop
            Pos := Rindex (Str, '0');
         end loop;
         Util.Measures.Report (St, "Util.Strings.Rindex");
         Assert_Equals (T, 1, Pos, "Invalid rindex position");
      end;
      declare
         St  : Util.Measures.Stamp;
         Pos : Natural;
      begin
         for I in 1 .. 10 loop
            Pos := Ada.Strings.Fixed.Index (Str, "0", Ada.Strings.Backward);
         end loop;
         Util.Measures.Report (St, "Ada.Strings.Fixed.Rindex");
         Assert_Equals (T, 1, Pos, "Invalid rindex position");
      end;
   end Test_Rindex;

   package String_Map is new Ada.Containers.Hashed_Maps
     (Key_Type        => Unbounded_String,
      Element_Type    => Unbounded_String,
      Hash            => Hash,
      Equivalent_Keys => "=");

   package String_Ref_Map is new Ada.Containers.Hashed_Maps
     (Key_Type        => String_Ref,
      Element_Type    => String_Ref,
      Hash            => Hash,
      Equivalent_Keys => Equivalent_Keys);

   --  Do some benchmark on String -> X hash mapped.
   procedure Test_Measure_Hash (T : in out Test) is
      KEY     : aliased constant String := "testing";
      Str_Map : Util.Strings.Maps.Map;
      Ptr_Map : Util.Strings.String_Access_Map.Map;
      Ref_Map : String_Ref_Map.Map;
      Unb_Map : String_Map.Map;
      Name    : String_Access := new String '(KEY);
      Ref     : constant String_Ref := To_String_Ref (KEY);
   begin
      Str_Map.Insert (Name.all, Name.all);
      Ptr_Map.Insert (Name.all'Access, Name.all'Access);
      Unb_Map.Insert (To_Unbounded_String (KEY), To_Unbounded_String (KEY));
      Ref_Map.Insert (Ref, Ref);

      --  Performance of Hashed_Map Name_Access -> Name_Access
      --  (the fastest hash)
      declare
         St  : Util.Measures.Stamp;
         Pos : constant Strings.String_Access_Map.Cursor := Ptr_Map.Find (KEY'Unchecked_Access);
         Val : constant Name_Access := Util.Strings.String_Access_Map.Element (Pos);
      begin
         Util.Measures.Report (St, "Util.Strings.String_Access_Maps.Find+Element");
         Assert_Equals (T, "testing", Val.all, "Invalid value returned");
      end;

      --  Performance of Hashed_Map String_Ref -> String_Ref
      --  (almost same performance as Hashed_Map Name_Access -> Name_Access)
      declare
         St  : Util.Measures.Stamp;
         Pos : constant String_Ref_Map.Cursor := Ref_Map.Find (Ref);
         Val : constant String_Ref := String_Ref_Map.Element (Pos);
      begin
         Util.Measures.Report (St, "Util.Strings.String_Ref_Maps.Find+Element");
         Assert_Equals (T, "testing", String '(To_String (Val)), "Invalid value returned");
      end;

      --  Performance of Hashed_Map Unbounded_String -> Unbounded_String
      --  (little overhead due to String copy made by Unbounded_String)
      declare
         St  : Util.Measures.Stamp;
         Pos : constant String_Map.Cursor := Unb_Map.Find (To_Unbounded_String (KEY));
         Val : constant Unbounded_String := String_Map.Element (Pos);
      begin
         Util.Measures.Report (St, "Hashed_Maps<Unbounded,Unbounded..Find+Element");
         Assert_Equals (T, "testing", Val, "Invalid value returned");
      end;

      --  Performance for Indefinite_Hashed_Map String -> String
      --  (the slowest hash, string copy to get the result, pointer to key and element
      --  in the hash map implementation)
      declare
         St  : Util.Measures.Stamp;
         Pos : constant Util.Strings.Maps.Cursor := Str_Map.Find (KEY);
         Val : constant String := Util.Strings.Maps.Element (Pos);
      begin
         Util.Measures.Report (St, "Util.Strings.Maps.Find+Element");
         Assert_Equals (T, "testing", Val, "Invalid value returned");
      end;

      Free (Name);
   end Test_Measure_Hash;

   --  ------------------------------
   --  Test String_Ref creation
   --  ------------------------------
   procedure Test_String_Ref (T : in out Test) is
      R1 : String_Ref := To_String_Ref ("testing a string");
   begin
      for I in 1 .. 1_000 loop
         declare
            S  : constant String (1 .. I) := (others => 'x');
            R2 : constant String_Ref := To_String_Ref (S);
         begin
            Assert_Equals (T, S, To_String (R2), "Invalid String_Ref");
            T.Assert (R2 = S, "Invalid comparison");
            Assert_Equals (T, I, Length (R2), "Invalid length");
            R1 := R2;
            T.Assert (R1 = R2, "Invalid String_Ref copy");
         end;
      end loop;
   end Test_String_Ref;

   --  Test perfect hash (samples/gperfhash)
   procedure Test_Perfect_Hash (T : in out Test) is
   begin
      for I in Util.Perfect_Hash.Keywords'Range loop
         declare
            K : constant String := Util.Perfect_Hash.Keywords (I).all;
         begin
            Assert_Equals (T, I, Util.Perfect_Hash.Hash (K),
                           "Invalid hash");
            Assert_Equals (T, I, Util.Perfect_Hash.Hash (To_Lower_Case (K)),
                           "Invalid hash");
            Assert (T, Util.Perfect_Hash.Is_Keyword (K), "Keyword " & K & " is not a keyword");
            Assert (T, Util.Perfect_Hash.Is_Keyword (To_Lower_Case (K)),
                    "Keyword " & K & " is not a keyword");
         end;
      end loop;
   end Test_Perfect_Hash;

end Util.Strings.Tests;

Update the unit test

Update the unit test


-----------------------------------------------------------------------
--  awa-blogs-tests -- Unit tests for blogs module
--  Copyright (C) 2011, 2012, 2013 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Test_Caller;

with ADO;

with Security.Contexts;

with AWA.Services.Contexts;
with AWA.Blogs.Modules;
with AWA.Tests.Helpers.Users;
package body AWA.Blogs.Modules.Tests is

   use Util.Tests;
   use ADO;

   package Caller is new Util.Test_Caller (Test, "Blogs.Services");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Blogs.Services.Create_Blog",
                       Test_Create_Blog'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Services.Create_Post",
                       Test_Create_Post'Access);

   end Add_Tests;

   --  ------------------------------
   --  Test creation of a blog
   --  ------------------------------
   procedure Test_Create_Blog (T : in out Test) is
      Manager   : AWA.Blogs.Modules.Blog_Module_Access;
      Blog_Id   : ADO.Identifier;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-blog@test.com");

      Manager := AWA.Blogs.Modules.Get_Blog_Module;
      Manager.Create_Blog (Workspace_Id => 0,
                           Title        => "My blog",
                           Result       => Blog_Id);
      T.Assert (Blog_Id > 0, "Invalid blog identifier");
   end Test_Create_Blog;

   --  ------------------------------
   --  Test creating and updating of a blog post
   --  ------------------------------
   procedure Test_Create_Post (T : in out Test) is
      Manager   : AWA.Blogs.Modules.Blog_Module_Access;
      Blog_Id   : ADO.Identifier;
      Post_Id   : ADO.Identifier;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-blog-post@test.com");

      Manager := AWA.Blogs.Modules.Get_Blog_Module;
      Manager.Create_Blog (Workspace_Id => 0,
                           Title        => "My blog post",
                           Result       => Blog_Id);
      T.Assert (Blog_Id > 0, "Invalid blog identifier");

      for I in 1 .. 5 loop
         Manager.Create_Post (Blog_Id => Blog_Id,
                              Title   => "Testing blog title",
                              URI     => "testing-blog-title",
                              Text    => "The blog content",
                              Status  => AWA.Blogs.Models.POST_DRAFT,
                              Result  => Post_Id);
         T.Assert (Post_Id > 0, "Invalid post identifier");

         Manager.Update_Post (Post_Id => Post_Id,
                              Title   => "New blog post title",
                              Text    => "The new post content",
                              Status  => AWA.Blogs.Models.POST_DRAFT);

         --  Keep the last post in the database.
         exit when I = 5;

         Manager.Delete_Post (Post_Id => Post_Id);

         --  Verify that a Not_Found exception is raised if the post was deleted.
         begin
            Manager.Update_Post (Post_Id => Post_Id,
                                 Title   => "Something",
                                 Text    => "Content",
                                 Status  => AWA.Blogs.Models.POST_DRAFT);
            T.Assert (False, "Exception Not_Found was not raised");
         exception
            when Not_Found =>
               null;
         end;

         --  Verify that a Not_Found exception is raised if the post was deleted.
         begin
            Manager.Delete_Post (Post_Id => Post_Id);
            T.Assert (False, "Exception Not_Found was not raised");
         exception
            when Not_Found =>
               null;
         end;
      end loop;

   end Test_Create_Post;

end AWA.Blogs.Modules.Tests;

-----------------------------------------------------------------------
--  awa-blogs-tests -- Unit tests for blogs module
--  Copyright (C) 2011, 2012, 2013, 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Test_Caller;

with ADO;

with Security.Contexts;

with AWA.Services.Contexts;
with AWA.Blogs.Modules;
with AWA.Tests.Helpers.Users;
package body AWA.Blogs.Modules.Tests is

   use Util.Tests;
   use ADO;

   package Caller is new Util.Test_Caller (Test, "Blogs.Services");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Blogs.Services.Create_Blog",
                       Test_Create_Blog'Access);
      Caller.Add_Test (Suite, "Test AWA.Blogs.Services.Create_Post",
                       Test_Create_Post'Access);

   end Add_Tests;

   --  ------------------------------
   --  Test creation of a blog
   --  ------------------------------
   procedure Test_Create_Blog (T : in out Test) is
      Manager   : AWA.Blogs.Modules.Blog_Module_Access;
      Blog_Id   : ADO.Identifier;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-blog@test.com");

      Manager := AWA.Blogs.Modules.Get_Blog_Module;
      Manager.Create_Blog (Workspace_Id => 0,
                           Title        => "My blog",
                           Result       => Blog_Id);
      T.Assert (Blog_Id > 0, "Invalid blog identifier");
   end Test_Create_Blog;

   --  ------------------------------
   --  Test creating and updating of a blog post
   --  ------------------------------
   procedure Test_Create_Post (T : in out Test) is
      Manager   : AWA.Blogs.Modules.Blog_Module_Access;
      Blog_Id   : ADO.Identifier;
      Post_Id   : ADO.Identifier;
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-blog-post@test.com");

      Manager := AWA.Blogs.Modules.Get_Blog_Module;
      Manager.Create_Blog (Workspace_Id => 0,
                           Title        => "My blog post",
                           Result       => Blog_Id);
      T.Assert (Blog_Id > 0, "Invalid blog identifier");

      for I in 1 .. 5 loop
         Manager.Create_Post (Blog_Id => Blog_Id,
                              Title   => "Testing blog title",
                              URI     => "testing-blog-title",
                              Text    => "The blog content",
                              Status  => AWA.Blogs.Models.POST_DRAFT,
                              Result  => Post_Id);
         T.Assert (Post_Id > 0, "Invalid post identifier");

         Manager.Update_Post (Post_Id => Post_Id,
                              Title   => "New blog post title",
                              URI     => "testing-blog-title",
                              Text    => "The new post content",
                              Status  => AWA.Blogs.Models.POST_DRAFT);

         --  Keep the last post in the database.
         exit when I = 5;

         Manager.Delete_Post (Post_Id => Post_Id);

         --  Verify that a Not_Found exception is raised if the post was deleted.
         begin
            Manager.Update_Post (Post_Id => Post_Id,
                                 Title   => "Something",
                                 Text    => "Content",
                                 URI     => "testing-blog-title",
                                 Status  => AWA.Blogs.Models.POST_DRAFT);
            T.Assert (False, "Exception Not_Found was not raised");
         exception
            when Not_Found =>
               null;
         end;

         --  Verify that a Not_Found exception is raised if the post was deleted.
         begin
            Manager.Delete_Post (Post_Id => Post_Id);
            T.Assert (False, "Exception Not_Found was not raised");
         exception
            when Not_Found =>
               null;
         end;
      end loop;

   end Test_Create_Post;

end AWA.Blogs.Modules.Tests;

Update the unit test

Update the unit test


-----------------------------------------------------------------------
--  asf.responses -- ASF Requests
--  Copyright (C) 2010, 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

--  The ASF.Responses package is an Ada implementation of
--  the Java servlet response (JSR 315 5. The Response).
package body ASF.Responses.Mockup is

   --  ------------------------------
   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   --  ------------------------------
   function Contains_Header (Resp : in Response;
                             Name : in String) return Boolean is
      Pos : constant Util.Strings.Maps.Cursor := Resp.Headers.Find (Name);
   begin
      return Util.Strings.Maps.Has_Element (Pos);
   end Contains_Header;

   --  ------------------------------
   --  Iterate over the response headers and executes the Process procedure.
   --  ------------------------------
   procedure Iterate_Headers (Resp    : in Response;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is

      procedure Process_Wrapper (Position : in Util.Strings.Maps.Cursor);

      procedure Process_Wrapper (Position : in Util.Strings.Maps.Cursor) is
      begin
         Process.all (Name  => Util.Strings.Maps.Key (Position),
                      Value => Util.Strings.Maps.Element (Position));
      end Process_Wrapper;

   begin
      Resp.Headers.Iterate (Process => Process_Wrapper'Access);
   end Iterate_Headers;

   --  ------------------------------
   --  Sets a response header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   --  ------------------------------
   procedure Set_Header (Resp  : in out Response;
                         Name  : in String;
                         Value : in String) is
   begin
      Resp.Headers.Include (Name, Value);
   end Set_Header;

   --  ------------------------------
   --  Adds a response header with the given name and value.
   --  This method allows response headers to have multiple values.
   --  ------------------------------
   procedure Add_Header (Resp  : in out Response;
                         Name  : in String;
                         Value : in String) is
   begin
      if Resp.Headers.Contains (Name) then
         Resp.Headers.Include (Name, Resp.Headers.Element (Name) & ASCII.LF
                               & Name & ": " & Value);
      else
         Resp.Headers.Insert (Name, Value);
      end if;
   end Add_Header;

   --  ------------------------------
   --  Returns the value of the specified response header as a String. If the response
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the response. The header name is case insensitive. You can use
   --  this method with any response header.
   --  ------------------------------
   function Get_Header (Resp : in Response;
                        Name : in String) return String is
      Pos : constant Util.Strings.Maps.Cursor := Resp.Headers.Find (Name);
   begin
      if Util.Strings.Maps.Has_Element (Pos) then
         return Util.Strings.Maps.Element (Pos);
      else
         return "";
      end if;
   end Get_Header;

   --  ------------------------------
   --  Get the content written to the mockup output stream.
   --  ------------------------------
   procedure Read_Content (Resp : in out Response;
                           Into : out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Resp.Content.Read (Into => Into);
   end Read_Content;

   --  ------------------------------
   --  Clear the response content.
   --  This operation removes any content held in the output stream, clears the status,
   --  removes any header in the response.
   --  ------------------------------
   procedure Clear (Resp : in out Response) is
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Resp.Read_Content (Content);
      Resp.Status := SC_OK;
      Resp.Headers.Clear;
   end Clear;

   --  ------------------------------
   --  Initialize the response mockup output stream.
   --  ------------------------------
   overriding
   procedure Initialize (Resp : in out Response) is
   begin
      Resp.Content.Initialize (128 * 1024);
      Resp.Stream := Resp.Content'Unchecked_Access;
   end Initialize;

end ASF.Responses.Mockup;

-----------------------------------------------------------------------
--  asf.responses -- ASF Requests
--  Copyright (C) 2010, 2011, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

--  The ASF.Responses package is an Ada implementation of
--  the Java servlet response (JSR 315 5. The Response).
package body ASF.Responses.Mockup is

   --  ------------------------------
   --  Returns a boolean indicating whether the named response header has already
   --  been set.
   --  ------------------------------
   function Contains_Header (Resp : in Response;
                             Name : in String) return Boolean is
      Pos : constant Util.Strings.Maps.Cursor := Resp.Headers.Find (Name);
   begin
      return Util.Strings.Maps.Has_Element (Pos);
   end Contains_Header;

   --  ------------------------------
   --  Iterate over the response headers and executes the Process procedure.
   --  ------------------------------
   procedure Iterate_Headers (Resp    : in Response;
                              Process : not null access
                                procedure (Name  : in String;
                                           Value : in String)) is

      procedure Process_Wrapper (Position : in Util.Strings.Maps.Cursor);

      procedure Process_Wrapper (Position : in Util.Strings.Maps.Cursor) is
      begin
         Process.all (Name  => Util.Strings.Maps.Key (Position),
                      Value => Util.Strings.Maps.Element (Position));
      end Process_Wrapper;

   begin
      Resp.Headers.Iterate (Process => Process_Wrapper'Access);
   end Iterate_Headers;

   --  ------------------------------
   --  Sets a response header with the given name and value. If the header had already
   --  been set, the new value overwrites the previous one. The containsHeader
   --  method can be used to test for the presence of a header before setting its value.
   --  ------------------------------
   procedure Set_Header (Resp  : in out Response;
                         Name  : in String;
                         Value : in String) is
   begin
      Resp.Headers.Include (Name, Value);
   end Set_Header;

   --  ------------------------------
   --  Adds a response header with the given name and value.
   --  This method allows response headers to have multiple values.
   --  ------------------------------
   procedure Add_Header (Resp  : in out Response;
                         Name  : in String;
                         Value : in String) is
   begin
      if Resp.Headers.Contains (Name) then
         Resp.Headers.Include (Name, Resp.Headers.Element (Name) & ASCII.LF
                               & Value);
      else
         Resp.Headers.Insert (Name, Value);
      end if;
   end Add_Header;

   --  ------------------------------
   --  Returns the value of the specified response header as a String. If the response
   --  did not include a header of the specified name, this method returns null.
   --  If there are multiple headers with the same name, this method returns the
   --  first head in the response. The header name is case insensitive. You can use
   --  this method with any response header.
   --  ------------------------------
   function Get_Header (Resp : in Response;
                        Name : in String) return String is
      Pos : constant Util.Strings.Maps.Cursor := Resp.Headers.Find (Name);
   begin
      if Util.Strings.Maps.Has_Element (Pos) then
         return Util.Strings.Maps.Element (Pos);
      else
         return "";
      end if;
   end Get_Header;

   --  ------------------------------
   --  Get the content written to the mockup output stream.
   --  ------------------------------
   procedure Read_Content (Resp : in out Response;
                           Into : out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Resp.Headers.Include ("Content-Type", Resp.Get_Content_Type);
      Resp.Content.Read (Into => Into);
   end Read_Content;

   --  ------------------------------
   --  Clear the response content.
   --  This operation removes any content held in the output stream, clears the status,
   --  removes any header in the response.
   --  ------------------------------
   procedure Clear (Resp : in out Response) is
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Resp.Read_Content (Content);
      Resp.Status := SC_OK;
      Resp.Headers.Clear;
   end Clear;

   --  ------------------------------
   --  Initialize the response mockup output stream.
   --  ------------------------------
   overriding
   procedure Initialize (Resp : in out Response) is
   begin
      Resp.Content.Initialize (128 * 1024);
      Resp.Stream := Resp.Content'Unchecked_Access;
   end Initialize;

end ASF.Responses.Mockup;

Include the Content-Type header at the end so that tests can get it as a header


-----------------------------------------------------------------------
--  launch -- Launch an external process redirecting the input and output
--  Copyright (C) 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Processes;
with Ada.Text_IO;
with Ada.Strings.Unbounded;

with Util.Streams.Pipes;
with Util.Streams.Buffered;
with Util.Streams.Texts;
procedure Launch is
   use Ada.Strings.Unbounded;

   Pipe    : aliased Util.Streams.Pipes.Pipe_Stream;
   Buffer  : Util.Streams.Buffered.Buffered_Stream;
   Content : Unbounded_String;
   Print   : Util.Streams.Texts.Print_Stream;
begin
      --  Write on the process input stream
   Pipe.Open ("nslookup", Util.Processes.READ_WRITE);
   Buffer.Initialize (null, Pipe'Unchecked_Access, 1024);
   Print.Initialize (Pipe'Unchecked_Access);

   --  Write on the 'nslookup' input pipe a list of domains to resolve.
   Print.Write ("www.google.com" & ASCII.LF);
   Print.Write ("set type=NS" & ASCII.LF);
   Print.Write ("www.google.com" & ASCII.LF);
   Print.Write ("set type=MX" & ASCII.LF);
   Print.Write ("www.google.com" & ASCII.LF);
   Print.Close;

   --  Read the 'nslookup' output.
   Buffer.Read (Content);
   Pipe.Close;
   Ada.Text_IO.Put_Line ("Result lenght: " & Integer'Image (Length (Content)));
   Ada.Text_IO.Put_Line ("Exit status: " & Integer'Image (Pipe.Get_Exit_Status));
   Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Content));
end Launch;

-----------------------------------------------------------------------
--  launch -- Launch an external process redirecting the input and output
--  Copyright (C) 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Processes;
with Ada.Text_IO;
with Ada.Strings.Unbounded;

with Util.Streams.Pipes;
with Util.Streams.Buffered;
with Util.Streams.Texts;
procedure Launch is
   use Ada.Strings.Unbounded;

   Pipe    : aliased Util.Streams.Pipes.Pipe_Stream;
   Buffer  : Util.Streams.Buffered.Input_Buffer_Stream;
   Content : Unbounded_String;
   Print   : Util.Streams.Texts.Print_Stream;
begin
      --  Write on the process input stream
   Pipe.Open ("nslookup", Util.Processes.READ_WRITE);
   Buffer.Initialize (Pipe'Unchecked_Access, 1024);
   Print.Initialize (Pipe'Unchecked_Access);

   --  Write on the 'nslookup' input pipe a list of domains to resolve.
   Print.Write ("www.google.com" & ASCII.LF);
   Print.Write ("set type=NS" & ASCII.LF);
   Print.Write ("www.google.com" & ASCII.LF);
   Print.Write ("set type=MX" & ASCII.LF);
   Print.Write ("www.google.com" & ASCII.LF);
   Print.Close;

   --  Read the 'nslookup' output.
   Buffer.Read (Content);
   Pipe.Close;
   Ada.Text_IO.Put_Line ("Result lenght: " & Integer'Image (Length (Content)));
   Ada.Text_IO.Put_Line ("Exit status: " & Integer'Image (Pipe.Get_Exit_Status));
   Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Content));
end Launch;

Use the Input_Buffer_Stream

Use the Input_Buffer_Stream


-----------------------------------------------------------------------
--  asf-routes-tests - Unit tests for ASF.Routes
--  Copyright (C) 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Measures;
with Util.Log.Loggers;
with Util.Test_Caller;

with EL.Contexts.Default;
package body ASF.Routes.Tests is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ASF.Routes.Tests");

   package Caller is new Util.Test_Caller (Test, "Routes");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (fixed path)",
                       Test_Add_Route_With_Path'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (:param path)",
                       Test_Add_Route_With_Param'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (*.ext path)",
                       Test_Add_Route_With_Ext'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (#{} path)",
                       Test_Add_Route_With_EL'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Iterate",
                       Test_Iterate'Access);
   end Add_Tests;

   overriding
   function Get_Value (Bean : in Test_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "id" then
         return Util.Beans.Objects.To_Object (Bean.Id);
      elsif Name = "name" then
         return Util.Beans.Objects.To_Object (Bean.Name);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   overriding
   procedure Set_Value (Bean  : in out Test_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "id" then
         Bean.Id := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "name" then
         Bean.Name := Util.Beans.Objects.To_Unbounded_String (Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Setup the test instance.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
   begin
      T.Bean := new Test_Bean;
      ASF.Tests.EL_Test (T).Set_Up;
      T.Root_Resolver.Register (Ada.Strings.Unbounded.To_Unbounded_String ("user"),
                                Util.Beans.Objects.To_Object (T.Bean.all'Access));
      for I in T.Routes'Range loop
         T.Routes (I) := Route_Type_Refs.Create (new Test_Route_Type '(Util.Refs.Ref_Entity with Index => I));
      end loop;
   end Set_Up;

   --  ------------------------------
   --  Verify that the path matches the given route.
   --  ------------------------------
   procedure Verify_Route (T      : in out Test;
                           Router : in out Router_Type;
                           Path   : in String;
                           Index  : in Positive;
                           Bean   : in out Test_Bean'Class) is
      Route   : constant Route_Type_Access := T.Routes (Index).Value;
      R       : Route_Context_Type;
   begin
      Router.Find_Route (Path, R);
      declare
         P : constant String := Get_Path (R);
      begin
         T.Assert_Equals (Path, P, "Add_Route + Find_Route with " & Path);
         T.Assert (Get_Route (R) /= null, "Get_Route returns a null route for " & Path);
         T.Assert (Get_Route (R) = Route, "Get_Route returns a wrong route for " & Path);

         --  Inject the path parameters in the bean instance.
         Inject_Parameters (R, Bean, T.ELContext.all);
      end;
   end Verify_Route;

   --  ------------------------------
   --  Add the route associted with the path pattern.
   --  ------------------------------
   procedure Add_Route (T      : in out Test;
                        Router : in out Router_Type;
                        Path   : in String;
                        Index  : in Positive;
                        Bean   : in out Test_Bean'Class) is
      Route   : constant Route_Type_Access := T.Routes (Index).Value;
   begin
      Router.Add_Route (Path, Route, T.ELContext.all);
      Verify_Route (T, Router, Path, Index, Bean);
   end Add_Route;

   --  ------------------------------
   --  Test the Add_Route with simple fixed path components.
   --  Example: /list/index.html
   --  ------------------------------
   procedure Test_Add_Route_With_Path (T : in out Test) is
      Router  : Router_Type;
      Bean    : Test_Bean;
   begin
      Add_Route (T, Router, "/page.html", 1, Bean);
      Add_Route (T, Router, "/list/page.html", 2, Bean);
      Add_Route (T, Router, "/list/index.html", 3, Bean);
      Add_Route (T, Router, "/view/page/content/index.html", 4, Bean);
      Add_Route (T, Router, "/list//page/view.html", 5, Bean);
      Add_Route (T, Router, "/list////page/content.html", 6, Bean);

      Verify_Route (T, Router, "/list/index.html", 3, Bean);
   end Test_Add_Route_With_Path;

   --  ------------------------------
   --  Test the Add_Route with extension mapping.
   --  Example: /list/*.html
   --  ------------------------------
   procedure Test_Add_Route_With_Ext (T : in out Test) is
      Router  : Router_Type;
      Bean    : Test_Bean;
   begin
      Add_Route (T, Router, "/page.html", 1, Bean);
      Add_Route (T, Router, "/list/*.html", 2, Bean);
      Add_Route (T, Router, "/list/index.html", 3, Bean);
      Add_Route (T, Router, "/view/page/content/page1.html", 4, Bean);
      Add_Route (T, Router, "/view/page/content/page2.html", 5, Bean);
      Add_Route (T, Router, "/view/page/content/*.html", 6, Bean);
      Add_Route (T, Router, "/ajax/*", 7, Bean);
      Add_Route (T, Router, "*.html", 8, Bean);

      --  Verify precedence and wildcard matching.
      Verify_Route (T, Router, "/list/index.html", 3, Bean);
      Verify_Route (T, Router, "/list/admin.html", 2, Bean);
      Verify_Route (T, Router, "/list/1/2/3/admin.html", 2, Bean);
      Verify_Route (T, Router, "/view/page/content/t.html", 6, Bean);
      Verify_Route (T, Router, "/view/page/content/1/t.html", 6, Bean);
      Verify_Route (T, Router, "/view/page/content/1/2/t.html", 6, Bean);
      Verify_Route (T, Router, "/ajax/form/save", 7, Bean);
      Verify_Route (T, Router, "/view/index.html", 8, Bean);

      Add_Route (T, Router, "/ajax/timeKeeper/*", 9, Bean);
      Verify_Route (T, Router, "/ajax/form/save", 7, Bean);
      Verify_Route (T, Router, "/ajax/timeKeeper/save", 9, Bean);
   end Test_Add_Route_With_Ext;

   --  ------------------------------
   --  Test the Add_Route with fixed path components and path parameters.
   --  Example: /users/:id/view.html
   --  ------------------------------
   procedure Test_Add_Route_With_Param (T : in out Test) is
      use Ada.Strings.Unbounded;

      Router  : Router_Type;
      Bean    : Test_Bean;
   begin
      Add_Route (T, Router, "/users/:id/view.html", 1, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");

      Bean.Id := To_Unbounded_String ("");
      Add_Route (T, Router, "/users/:id/list.html", 2, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");

      Bean.Id := To_Unbounded_String ("");
      Add_Route (T, Router, "/users/:id/index.html", 3, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");

      Bean.Id := To_Unbounded_String ("");
      Add_Route (T, Router, "/view/page/content/index.html", 4, Bean);
      Add_Route (T, Router, "/list//page/view.html", 5, Bean);
      Add_Route (T, Router, "/list////page/content.html", 6, Bean);
      T.Assert_Equals ("", To_String (Bean.Id), "Bean injection failed for fixed path");

      Add_Route (T, Router, "/users/:id/:name/index.html", 7, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");
      T.Assert_Equals (":name", To_String (Bean.Name), "Bean injection failed for :name");

      Add_Route (T, Router, "/users/list/index.html", 8, Bean);

      Verify_Route (T, Router, "/users/1234/view.html", 1, Bean);
      T.Assert_Equals ("1234", To_String (Bean.Id), "Bean injection failed for :id");

      Verify_Route (T, Router, "/users/234/567/index.html", 7, Bean);
      T.Assert_Equals ("234", To_String (Bean.Id), "Bean injection failed for :id");
      T.Assert_Equals ("567", To_String (Bean.Name), "Bean injection failed for :name");

   end Test_Add_Route_With_Param;

   --  ------------------------------
   --  Test the Add_Route with fixed path components and EL path injection.
   --  Example: /users/#{user.id}/view.html
   --  ------------------------------
   procedure Test_Add_Route_With_EL (T : in out Test) is
            use Ada.Strings.Unbounded;

      Router  : Router_Type;
      Bean    : aliased Test_Bean;
   begin
      Add_Route (T, Router, "/users/#{user.id}", 1, Bean);
      Add_Route (T, Router, "/users/view.html", 2, Bean);
      Add_Route (T, Router, "/users/#{user.id}/#{user.name}/index.html", 3, Bean);
      Add_Route (T, Router, "/users/admin/#{user.id}/pages/#{user.name}", 4, Bean);

      --  Verify that the path parameters are injected in the 'user' bean (= T.Bean).
      Verify_Route (T, Router, "/users/234/567/index.html", 3, Bean);
      T.Assert_Equals ("234", To_String (T.Bean.Id), "Bean injection failed for :id");
      T.Assert_Equals ("567", To_String (T.Bean.Name), "Bean injection failed for :name");

   end Test_Add_Route_With_EL;

   P_1 : aliased constant String := "/list/index.html";
   P_2 : aliased constant String := "/users/:id";
   P_3 : aliased constant String := "/users/:id/view";
   P_4 : aliased constant String := "/users/index.html";
   P_5 : aliased constant String := "/users/:id/:name";
   P_6 : aliased constant String := "/users/:id/:name/view.html";
   P_7 : aliased constant String := "/users/:id/list";
   P_8 : aliased constant String := "/users/test.html";
   P_9 : aliased constant String := "/admin/1/2/3/4/5/list.html";
   P_10 : aliased constant String := "/admin/*.html";
   P_11 : aliased constant String := "/admin/*.png";
   P_12 : aliased constant String := "/admin/*.jpg";
   P_13 : aliased constant String := "/users/:id/page/*.xml";
   P_14 : aliased constant String := "/*.jsf";

   type Const_String_Access is access constant String;

   type String_Array is array (Positive range <>) of Const_String_Access;

   Path_Array : constant String_Array :=
     (P_1'Access, P_2'Access, P_3'Access, P_4'Access,
      P_5'Access, P_6'Access, P_7'Access, P_8'Access,
      P_9'Access, P_10'Access, P_11'Access, P_12'Access,
      P_13'Access, P_14'Access);

   --  ------------------------------
   --  Test the Iterate over several paths.
   --  ------------------------------
   procedure Test_Iterate (T : in out Test) is
      Router  : Router_Type;
      Bean    : Test_Bean;

      procedure Process (Pattern : in String;
                         Route   : in Route_Type_Access) is
      begin
         T.Assert (Route /= null, "The route is null for " & Pattern);
         T.Assert (Route.all in Test_Route_Type'Class, "Invalid route for " & Pattern);

         Log.Info ("Route {0} to {1}", Pattern, Natural'Image (Test_Route_Type (Route.all).Index));
         T.Assert_Equals (Pattern, Path_Array (Test_Route_Type (Route.all).Index).all,
                          "Invalid route for " & Pattern);
      end Process;

   begin
      for I in Path_Array'Range loop
         Add_Route (T, Router, Path_Array (I).all, I, Bean);
      end loop;
      Router.Iterate (Process'Access);

      declare
         St : Util.Measures.Stamp;
      begin
         for I in 1 .. 1000 loop
            declare
               R : Route_Context_Type;
            begin
               Router.Find_Route ("/admin/1/2/3/4/5/list.html", R);
            end;
         end loop;
         Util.Measures.Report (St, "Find 1000 routes (fixed path)");
      end;

      declare
         St : Util.Measures.Stamp;
      begin
         for I in 1 .. 1000 loop
            declare
               R : Route_Context_Type;
            begin
               Router.Find_Route ("/admin/1/2/3/4/5/list.jsf", R);
            end;
         end loop;
         Util.Measures.Report (St, "Find 1000 routes (extension)");
      end;
   end Test_Iterate;

end ASF.Routes.Tests;

-----------------------------------------------------------------------
--  asf-routes-tests - Unit tests for ASF.Routes
--  Copyright (C) 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Measures;
with Util.Log.Loggers;
with Util.Test_Caller;

with EL.Contexts.Default;
package body ASF.Routes.Tests is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ASF.Routes.Tests");

   package Caller is new Util.Test_Caller (Test, "Routes");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (fixed path)",
                       Test_Add_Route_With_Path'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (:param path)",
                       Test_Add_Route_With_Param'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (*.ext path)",
                       Test_Add_Route_With_Ext'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Add_Route (#{} path)",
                       Test_Add_Route_With_EL'Access);
      Caller.Add_Test (Suite, "Test ASF.Routes.Iterate",
                       Test_Iterate'Access);
   end Add_Tests;

   overriding
   function Get_Value (Bean : in Test_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "id" then
         return Util.Beans.Objects.To_Object (Bean.Id);
      elsif Name = "name" then
         return Util.Beans.Objects.To_Object (Bean.Name);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   overriding
   procedure Set_Value (Bean  : in out Test_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "id" then
         Bean.Id := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "name" then
         Bean.Name := Util.Beans.Objects.To_Unbounded_String (Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Setup the test instance.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
   begin
      T.Bean := new Test_Bean;
      ASF.Tests.EL_Test (T).Set_Up;
      T.Root_Resolver.Register (Ada.Strings.Unbounded.To_Unbounded_String ("user"),
                                Util.Beans.Objects.To_Object (T.Bean.all'Access));
      for I in T.Routes'Range loop
         T.Routes (I) := Route_Type_Refs.Create (new Test_Route_Type '(Util.Refs.Ref_Entity with Index => I));
      end loop;
   end Set_Up;

   --  ------------------------------
   --  Verify that the path matches the given route.
   --  ------------------------------
   procedure Verify_Route (T      : in out Test;
                           Router : in out Router_Type;
                           Path   : in String;
                           Index  : in Positive;
                           Bean   : in out Test_Bean'Class) is
      Route   : constant Route_Type_Access := T.Routes (Index).Value;
      R       : Route_Context_Type;
   begin
      Router.Find_Route (Path, R);
      declare
         P : constant String := Get_Path (R);
      begin
         T.Assert_Equals (Path, P, "Add_Route + Find_Route with " & Path);
         T.Assert (Get_Route (R) /= null, "Get_Route returns a null route for " & Path);
         T.Assert (Get_Route (R) = Route, "Get_Route returns a wrong route for " & Path);

         --  Inject the path parameters in the bean instance.
         Inject_Parameters (R, Bean, T.ELContext.all);
      end;
   end Verify_Route;

   --  ------------------------------
   --  Add the route associated with the path pattern.
   --  ------------------------------
   procedure Add_Route (T      : in out Test;
                        Router : in out Router_Type;
                        Path   : in String;
                        Index  : in Positive;
                        Bean   : in out Test_Bean'Class) is
      procedure Insert (Route : in out ASF.Routes.Route_Type_Ref) is
      begin
         Route := T.Routes (Index);
      end Insert;
   begin
      Router.Add_Route (Path, T.ELContext.all, Insert'Access);
      Verify_Route (T, Router, Path, Index, Bean);
   end Add_Route;

   --  ------------------------------
   --  Test the Add_Route with simple fixed path components.
   --  Example: /list/index.html
   --  ------------------------------
   procedure Test_Add_Route_With_Path (T : in out Test) is
      Router  : Router_Type;
      Bean    : Test_Bean;
   begin
      Add_Route (T, Router, "/page.html", 1, Bean);
      Add_Route (T, Router, "/list/page.html", 2, Bean);
      Add_Route (T, Router, "/list/index.html", 3, Bean);
      Add_Route (T, Router, "/view/page/content/index.html", 4, Bean);
      Add_Route (T, Router, "/list//page/view.html", 5, Bean);
      Add_Route (T, Router, "/list////page/content.html", 6, Bean);

      Verify_Route (T, Router, "/list/index.html", 3, Bean);
   end Test_Add_Route_With_Path;

   --  ------------------------------
   --  Test the Add_Route with extension mapping.
   --  Example: /list/*.html
   --  ------------------------------
   procedure Test_Add_Route_With_Ext (T : in out Test) is
      Router  : Router_Type;
      Bean    : Test_Bean;
   begin
      Add_Route (T, Router, "/page.html", 1, Bean);
      Add_Route (T, Router, "/list/*.html", 2, Bean);
      Add_Route (T, Router, "/list/index.html", 3, Bean);
      Add_Route (T, Router, "/view/page/content/page1.html", 4, Bean);
      Add_Route (T, Router, "/view/page/content/page2.html", 5, Bean);
      Add_Route (T, Router, "/view/page/content/*.html", 6, Bean);
      Add_Route (T, Router, "/ajax/*", 7, Bean);
      Add_Route (T, Router, "*.html", 8, Bean);

      --  Verify precedence and wildcard matching.
      Verify_Route (T, Router, "/list/index.html", 3, Bean);
      Verify_Route (T, Router, "/list/admin.html", 2, Bean);
      Verify_Route (T, Router, "/list/1/2/3/admin.html", 2, Bean);
      Verify_Route (T, Router, "/view/page/content/t.html", 6, Bean);
      Verify_Route (T, Router, "/view/page/content/1/t.html", 6, Bean);
      Verify_Route (T, Router, "/view/page/content/1/2/t.html", 6, Bean);
      Verify_Route (T, Router, "/ajax/form/save", 7, Bean);
      Verify_Route (T, Router, "/view/index.html", 8, Bean);

      Add_Route (T, Router, "/ajax/timeKeeper/*", 9, Bean);
      Verify_Route (T, Router, "/ajax/form/save", 7, Bean);
      Verify_Route (T, Router, "/ajax/timeKeeper/save", 9, Bean);
   end Test_Add_Route_With_Ext;

   --  ------------------------------
   --  Test the Add_Route with fixed path components and path parameters.
   --  Example: /users/:id/view.html
   --  ------------------------------
   procedure Test_Add_Route_With_Param (T : in out Test) is
      use Ada.Strings.Unbounded;

      Router  : Router_Type;
      Bean    : Test_Bean;
   begin
      Add_Route (T, Router, "/users/:id/view.html", 1, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");

      Bean.Id := To_Unbounded_String ("");
      Add_Route (T, Router, "/users/:id/list.html", 2, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");

      Bean.Id := To_Unbounded_String ("");
      Add_Route (T, Router, "/users/:id/index.html", 3, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");

      Bean.Id := To_Unbounded_String ("");
      Add_Route (T, Router, "/view/page/content/index.html", 4, Bean);
      Add_Route (T, Router, "/list//page/view.html", 5, Bean);
      Add_Route (T, Router, "/list////page/content.html", 6, Bean);
      T.Assert_Equals ("", To_String (Bean.Id), "Bean injection failed for fixed path");

      Add_Route (T, Router, "/users/:id/:name/index.html", 7, Bean);
      T.Assert_Equals (":id", To_String (Bean.Id), "Bean injection failed for :id");
      T.Assert_Equals (":name", To_String (Bean.Name), "Bean injection failed for :name");

      Add_Route (T, Router, "/users/list/index.html", 8, Bean);

      Verify_Route (T, Router, "/users/1234/view.html", 1, Bean);
      T.Assert_Equals ("1234", To_String (Bean.Id), "Bean injection failed for :id");

      Verify_Route (T, Router, "/users/234/567/index.html", 7, Bean);
      T.Assert_Equals ("234", To_String (Bean.Id), "Bean injection failed for :id");
      T.Assert_Equals ("567", To_String (Bean.Name), "Bean injection failed for :name");

   end Test_Add_Route_With_Param;

   --  ------------------------------
   --  Test the Add_Route with fixed path components and EL path injection.
   --  Example: /users/#{user.id}/view.html
   --  ------------------------------
   procedure Test_Add_Route_With_EL (T : in out Test) is
            use Ada.Strings.Unbounded;

      Router  : Router_Type;
      Bean    : aliased Test_Bean;
   begin
      Add_Route (T, Router, "/users/#{user.id}", 1, Bean);
      Add_Route (T, Router, "/users/view.html", 2, Bean);
      Add_Route (T, Router, "/users/#{user.id}/#{user.name}/index.html", 3, Bean);
      Add_Route (T, Router, "/users/admin/#{user.id}/pages/#{user.name}", 4, Bean);

      --  Verify that the path parameters are injected in the 'user' bean (= T.Bean).
      Verify_Route (T, Router, "/users/234/567/index.html", 3, Bean);
      T.Assert_Equals ("234", To_String (T.Bean.Id), "Bean injection failed for :id");
      T.Assert_Equals ("567", To_String (T.Bean.Name), "Bean injection failed for :name");

   end Test_Add_Route_With_EL;

   P_1 : aliased constant String := "/list/index.html";
   P_2 : aliased constant String := "/users/:id";
   P_3 : aliased constant String := "/users/:id/view";
   P_4 : aliased constant String := "/users/index.html";
   P_5 : aliased constant String := "/users/:id/:name";
   P_6 : aliased constant String := "/users/:id/:name/view.html";
   P_7 : aliased constant String := "/users/:id/list";
   P_8 : aliased constant String := "/users/test.html";
   P_9 : aliased constant String := "/admin/1/2/3/4/5/list.html";
   P_10 : aliased constant String := "/admin/*.html";
   P_11 : aliased constant String := "/admin/*.png";
   P_12 : aliased constant String := "/admin/*.jpg";
   P_13 : aliased constant String := "/users/:id/page/*.xml";
   P_14 : aliased constant String := "/*.jsf";

   type Const_String_Access is access constant String;

   type String_Array is array (Positive range <>) of Const_String_Access;

   Path_Array : constant String_Array :=
     (P_1'Access, P_2'Access, P_3'Access, P_4'Access,
      P_5'Access, P_6'Access, P_7'Access, P_8'Access,
      P_9'Access, P_10'Access, P_11'Access, P_12'Access,
      P_13'Access, P_14'Access);

   --  ------------------------------
   --  Test the Iterate over several paths.
   --  ------------------------------
   procedure Test_Iterate (T : in out Test) is
      Router  : Router_Type;
      Bean    : Test_Bean;

      procedure Process (Pattern : in String;
                         Route   : in Route_Type_Access) is
      begin
         T.Assert (Route /= null, "The route is null for " & Pattern);
         T.Assert (Route.all in Test_Route_Type'Class, "Invalid route for " & Pattern);

         Log.Info ("Route {0} to {1}", Pattern, Natural'Image (Test_Route_Type (Route.all).Index));
         T.Assert_Equals (Pattern, Path_Array (Test_Route_Type (Route.all).Index).all,
                          "Invalid route for " & Pattern);
      end Process;

   begin
      for I in Path_Array'Range loop
         Add_Route (T, Router, Path_Array (I).all, I, Bean);
      end loop;
      Router.Iterate (Process'Access);

      declare
         St : Util.Measures.Stamp;
      begin
         for I in 1 .. 1000 loop
            declare
               R : Route_Context_Type;
            begin
               Router.Find_Route ("/admin/1/2/3/4/5/list.html", R);
            end;
         end loop;
         Util.Measures.Report (St, "Find 1000 routes (fixed path)");
      end;

      declare
         St : Util.Measures.Stamp;
      begin
         for I in 1 .. 1000 loop
            declare
               R : Route_Context_Type;
            begin
               Router.Find_Route ("/admin/1/2/3/4/5/list.jsf", R);
            end;
         end loop;
         Util.Measures.Report (St, "Find 1000 routes (extension)");
      end;
   end Test_Iterate;

end ASF.Routes.Tests;

Update the route test creation

Update the route test creation


-----------------------------------------------------------------------
--  monitor - A simple monitor API
--  Copyright (C) 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with ASF.Responses;
with ASF.Rest.Definition;
package body Monitor is

   type Monitor_Array is array (1 .. MAX_MONITOR) of Monitor_Data;

   Monitors : Monitor_Array;

   --  Get values of the monitor.
   procedure Get_Values (D : in out Mon;
                         Req    : in out ASF.Rest.Request'Class;
                         Reply  : in out ASF.Rest.Response'Class;
                         Stream : in out ASF.Rest.Output_Stream'Class) is
      Id  : constant String := Req.Get_Path_Parameter (1);
      Pos : Positive;
   begin
      Pos := Positive'Value (Id);
      --  Monitors (Pos).Put (0);

      --  Get the monitor values.
      declare
         Values : constant Value_Array := Monitors (Pos).Get_Values;
      begin

         --  Write the JSON/XML document.
         Stream.Start_Document;
         Stream.Start_Array ("values");
         for V of Values loop
            Stream.Write_Long_Entity ("value", Long_Long_Integer (V));
         end loop;
         Stream.End_Array ("values");
         Stream.End_Document;
      end;

   exception
      when others =>
         Reply.Set_Status (ASF.Responses.SC_NOT_FOUND);
   end Get_Values;

   --  PUT /mon/:id
   procedure Put_Value (D : in out Mon;
                        Req    : in out ASF.Rest.Request'Class;
                        Reply  : in out ASF.Rest.Response'Class;
                        Stream : in out ASF.Rest.Output_Stream'Class) is
      Id  : constant String := Req.Get_Path_Parameter (1);
      Pos : Positive;
      Val : Natural;
   begin
      Pos := Positive'Value (Id);
      begin
         Val := Natural'Value (Req.Get_Parameter ("value"));
         Monitors (Pos).Put (Val);

      exception
         when others =>
            Reply.Set_Status (ASF.Responses.SC_BAD_REQUEST);
      end;

   exception
      when others =>
         Reply.Set_Status (ASF.Responses.SC_NOT_FOUND);
   end Put_Value;

   protected body Monitor_Data is

      procedure Put (Value : in Natural) is
         use type Ada.Calendar.Time;

         Now : constant Ada.Calendar.Time := Ada.Calendar.Clock;
         Dt  : constant Duration := Now - Slot_Start;
         Cnt : Natural := Natural (Dt / Slot_Size);
      begin
         if Cnt > 0 then
            while Cnt > 0 loop
               Cnt := Cnt - 1;
               Pos := Pos + 1;
               if Pos > Values'Last then
                  Pos := Values'First;
                  Value_Count := Values'Length;
               elsif Value_Count < Values'Length then
                  Value_Count := Value_Count + 1;
               end if;
               Slot_Start := Slot_Start + Slot_Size;
            end loop;
         end if;
         Values (Pos) := Value;
      end Put;

      procedure Put (Value : in Natural; Slot : in Natural) is
      begin
         null;
      end Put;

      function Get_Values return Value_Array is
         Result : Value_Array (1 .. Value_Count);
         Cnt    : Natural;
         N      : Natural;
      begin
         if Value_Count = Values'Length then
            Cnt := Values'Last - Pos;
         else
            Cnt := 0;
         end if;
         if Cnt > 0 then
            Result (1 .. Cnt) := Values (Pos + 1 .. Pos + 1 + Cnt - 1);
            N := Cnt + 1;
         else
            N := 1;
         end if;
         if Value_Count = Values'Length then
            Cnt := Pos;
         else
            Cnt := Pos - 1;
         end if;
         if Cnt > 0 then
            Result (N .. N + Cnt - 1) := Values (1 .. Cnt);
         end if;
         return Result;
      end Get_Values;

   end Monitor_Data;

end Monitor;

-----------------------------------------------------------------------
--  monitor - A simple monitor API
--  Copyright (C) 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with ASF.Responses;
with ASF.Rest.Definition;
package body Monitor is

   type Monitor_Array is array (1 .. MAX_MONITOR) of Monitor_Data;

   Monitors : Monitor_Array;

   --  Get values of the monitor.
   procedure Get_Values (Req    : in out ASF.Rest.Request'Class;
                         Reply  : in out ASF.Rest.Response'Class;
                         Stream : in out ASF.Rest.Output_Stream'Class) is
      Id  : constant String := Req.Get_Path_Parameter (1);
      Pos : Positive;
   begin
      Pos := Positive'Value (Id);
      --  Monitors (Pos).Put (0);

      --  Get the monitor values.
      declare
         Values : constant Value_Array := Monitors (Pos).Get_Values;
      begin

         --  Write the JSON/XML document.
         Stream.Start_Document;
         Stream.Start_Array ("values");
         for V of Values loop
            Stream.Write_Long_Entity ("value", Long_Long_Integer (V));
         end loop;
         Stream.End_Array ("values");
         Stream.End_Document;
      end;

   exception
      when others =>
         Reply.Set_Status (ASF.Responses.SC_NOT_FOUND);
   end Get_Values;

   --  PUT /mon/:id
   procedure Put_Value (Req    : in out ASF.Rest.Request'Class;
                        Reply  : in out ASF.Rest.Response'Class;
                        Stream : in out ASF.Rest.Output_Stream'Class) is
      Id  : constant String := Req.Get_Path_Parameter (1);
      Pos : Positive;
      Val : Natural;
   begin
      Pos := Positive'Value (Id);
      begin
         Val := Natural'Value (Req.Get_Parameter ("value"));
         Monitors (Pos).Put (Val);

      exception
         when others =>
            Reply.Set_Status (ASF.Responses.SC_BAD_REQUEST);
      end;

   exception
      when others =>
         Reply.Set_Status (ASF.Responses.SC_NOT_FOUND);
   end Put_Value;

   protected body Monitor_Data is

      procedure Put (Value : in Natural) is
         use type Ada.Calendar.Time;

         Now : constant Ada.Calendar.Time := Ada.Calendar.Clock;
         Dt  : constant Duration := Now - Slot_Start;
         Cnt : Natural := Natural (Dt / Slot_Size);
      begin
         if Cnt > 0 then
            while Cnt > 0 loop
               Cnt := Cnt - 1;
               Pos := Pos + 1;
               if Pos > Values'Last then
                  Pos := Values'First;
                  Value_Count := Values'Length;
               elsif Value_Count < Values'Length then
                  Value_Count := Value_Count + 1;
               end if;
               Slot_Start := Slot_Start + Slot_Size;
            end loop;
         end if;
         Values (Pos) := Value;
      end Put;

      procedure Put (Value : in Natural; Slot : in Natural) is
      begin
         null;
      end Put;

      function Get_Values return Value_Array is
         Result : Value_Array (1 .. Value_Count);
         Cnt    : Natural;
         N      : Natural;
      begin
         if Value_Count = Values'Length then
            Cnt := Values'Last - Pos;
         else
            Cnt := 0;
         end if;
         if Cnt > 0 then
            Result (1 .. Cnt) := Values (Pos + 1 .. Pos + 1 + Cnt - 1);
            N := Cnt + 1;
         else
            N := 1;
         end if;
         if Value_Count = Values'Length then
            Cnt := Pos;
         else
            Cnt := Pos - 1;
         end if;
         if Cnt > 0 then
            Result (N .. N + Cnt - 1) := Values (1 .. Cnt);
         end if;
         return Result;
      end Get_Values;

   end Monitor_Data;

end Monitor;

Simplify the REST API operations

Simplify the REST API operations