-----------------------------------------------------------------------
--  gen-commands-templates -- Template based command
--  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 Ada.Text_IO;
with Ada.IO_Exceptions;
with Ada.Directories;
with Ada.Streams.Stream_IO;

with GNAT.Command_Line;

with Gen.Artifacts;

with EL.Contexts.Default;
with EL.Expressions;
with EL.Variables.Default;

with Util.Log.Loggers;
with Util.Files;
with Util.Streams.Files;
with Util.Streams.Texts;
with Util.Beans.Objects;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Serialize.IO.XML;
package body Gen.Commands.Templates is

   use Ada.Strings.Unbounded;
   use GNAT.Command_Line;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Commands.Templates");

   --  Apply the patch instruction
   procedure Patch_File (Generator : in out Gen.Generator.Handler;
                         Info      : in Patch);

   function Match_Line (Line    : in String;
                        Pattern : in String) return Boolean;

   --  ------------------------------
   --  Check if the line matches the pseudo pattern.
   --  ------------------------------
   function Match_Line (Line    : in String;
                        Pattern : in String) return Boolean is
      L_Pos : Natural := Line'First;
      P_Pos : Natural := Pattern'First;
   begin
      while P_Pos <= Pattern'Last loop
         if L_Pos > Line'Last then
            return False;
         end if;
         if Line (L_Pos) = Pattern (P_Pos) then
            if Pattern (P_Pos) /= ' ' then
               P_Pos := P_Pos + 1;
            end if;
            L_Pos := L_Pos + 1;
         elsif Pattern (P_Pos) = ' ' and Line (L_Pos) = Pattern (P_Pos + 1) then
            P_Pos := P_Pos + 2;
            L_Pos := L_Pos + 1;
         elsif Pattern (P_Pos) = ' ' and Pattern (P_Pos + 1) = '*' then
            P_Pos := P_Pos + 1;
            L_Pos := L_Pos + 1;
         elsif Pattern (P_Pos) = '*' and Line (L_Pos) = Pattern (P_Pos + 1) then
            P_Pos := P_Pos + 2;
            L_Pos := L_Pos + 1;
         elsif Pattern (P_Pos) = '*' and Line (L_Pos) /= ' ' then
            L_Pos := L_Pos + 1;
         else
            return False;
         end if;
      end loop;
      return True;
   end Match_Line;

   --  ------------------------------
   --  Apply the patch instruction
   --  ------------------------------
   procedure Patch_File (Generator : in out Gen.Generator.Handler;
                         Info      : in Patch) is
      procedure Save_Output (H       : in out Gen.Generator.Handler;
                             File    : in String;
                             Content : in Ada.Strings.Unbounded.Unbounded_String);

      Ctx         : EL.Contexts.Default.Default_Context;
      Variables   : aliased EL.Variables.Default.Default_Variable_Mapper;

      procedure Save_Output (H       : in out Gen.Generator.Handler;
                             File    : in String;
                             Content : in Ada.Strings.Unbounded.Unbounded_String) is

         type State is (MATCH_AFTER, MATCH_BEFORE, MATCH_DONE);

         Output_Dir    : constant String := H.Get_Result_Directory;
         Path          : constant String := Util.Files.Compose (Output_Dir, File);
         Tmp_File      : constant String := Path & ".tmp";
         Line_Number   : Natural := 0;
         After_Pos     : Natural := 1;
         Current_State : State := MATCH_AFTER;
         Tmp_Output    : aliased Util.Streams.Files.File_Stream;
         Output        : Util.Streams.Texts.Print_Stream;

         procedure Process (Line : in String);

         procedure Process (Line : in String) is
         begin
            Line_Number := Line_Number + 1;
            case Current_State is
            when MATCH_AFTER =>
               if Match_Line (Line, Info.After.Element (After_Pos)) then
                  Log.Info ("Match after at line {0}", Natural'Image (Line_Number));
                  After_Pos := After_Pos + 1;
                  if After_Pos >= Natural (Info.After.Length) then
                     Current_State := MATCH_BEFORE;
                  end if;
               end if;

            when MATCH_BEFORE =>
               if Match_Line (Line, To_String (Info.Before)) then
                  Log.Info ("Match before at line {0}", Natural'Image (Line_Number));
                  Log.Info ("Add content {0}", Content);
                  Output.Write (Content);
                  Current_State := MATCH_DONE;
               end if;

            when MATCH_DONE =>
               null;

            end case;
            Output.Write (Line);
            Output.Write (ASCII.LF);
         end Process;

      begin
         Tmp_Output.Create (Name => Tmp_File, Mode => Ada.Streams.Stream_IO.Out_File);
         Output.Initialize (Tmp_Output'Unchecked_Access);
         Util.Files.Read_File (Path, Process'Access);
         Output.Close;
         if Current_State /= MATCH_DONE then
            H.Error ("Patch {0} failed", Path);
            Ada.Directories.Delete_File (Tmp_File);
         else
            Ada.Directories.Delete_File (Path);
            Ada.Directories.Rename (Old_Name => Tmp_File,
                                    New_Name => Path);
         end if;

      exception
         when Ada.IO_Exceptions.Name_Error =>
            H.Error ("Cannot patch file {0}", Path);
      end Save_Output;

   begin
      Ctx.Set_Variable_Mapper (Variables'Unchecked_Access);
      Gen.Generator.Generate (Generator, Gen.Artifacts.ITERATION_TABLE,
                              To_String (Info.Template), Save_Output'Access);
   end Patch_File;

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      function Get_Output_Dir return String;

      function Get_Output_Dir return String is
         Dir        : constant String := Generator.Get_Result_Directory;
      begin
         if Length (Cmd.Base_Dir) = 0 then
            return Dir;
         else
            return Util.Files.Compose (Dir, To_String (Cmd.Base_Dir));
         end if;
      end Get_Output_Dir;

      Out_Dir : constant String := Get_Output_Dir;
      Iter    : Param_Vectors.Cursor := Cmd.Params.First;
   begin
      Generator.Read_Project ("dynamo.xml", False);
      while Param_Vectors.Has_Element (Iter) loop
         declare
            P     : constant Param := Param_Vectors.Element (Iter);
            Value : constant String := Get_Argument;
         begin
            if not P.Is_Optional and Value'Length = 0 then
               Generator.Error ("Missing argument for {0}", To_String (P.Argument));
               return;
            end if;
            Generator.Set_Global (To_String (P.Name), Value);
         end;
         Param_Vectors.Next (Iter);
      end loop;

      Generator.Set_Force_Save (False);
      Generator.Set_Result_Directory (Out_Dir);
      declare
         Iter : Util.Strings.Sets.Cursor := Cmd.Templates.First;
      begin
         while Util.Strings.Sets.Has_Element (Iter) loop
            Gen.Generator.Generate (Generator, Gen.Artifacts.ITERATION_TABLE,
                                    Util.Strings.Sets.Element (Iter),
                                    Gen.Generator.Save_Content'Access);
            Util.Strings.Sets.Next (Iter);
         end loop;
      end;

      --  Apply the patch instructions defined for the command.
      declare
         Iter : Patch_Vectors.Cursor := Cmd.Patches.First;
      begin
         while Patch_Vectors.Has_Element (Iter) loop
            Patch_File (Generator, Patch_Vectors.Element (Iter));
            Patch_Vectors.Next (Iter);
         end loop;
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Generator);

      use Ada.Text_IO;
   begin
      Put_Line (To_String (Cmd.Name) & ": " & To_String (Cmd.Title));
      Put_Line ("Usage: " & To_String (Cmd.Usage));
      New_Line;
      Put_Line (To_String (Cmd.Help_Msg));
   end Help;

   type Command_Fields is (FIELD_NAME,
                           FIELD_HELP,
                           FIELD_USAGE,
                           FIELD_TITLE,
                           FIELD_BASEDIR,
                           FIELD_PARAM,
                           FIELD_PARAM_NAME,
                           FIELD_PARAM_OPTIONAL,
                           FIELD_PARAM_ARG,
                           FIELD_TEMPLATE,
                           FIELD_PATCH,
                           FIELD_AFTER,
                           FIELD_BEFORE,
                           FIELD_INSERT_TEMPLATE,
                           FIELD_COMMAND);

   type Command_Loader is record
      Command : Command_Access := null;
      P       : Param;
      Info    : Patch;
   end record;
   type Command_Loader_Access is access all Command_Loader;

   procedure Set_Member (Closure : in out Command_Loader;
                         Field   : in Command_Fields;
                         Value   : in Util.Beans.Objects.Object);

   function To_String (Value : in Util.Beans.Objects.Object) return Unbounded_String;

   --  ------------------------------
   --  Convert the object value into a string and trim any space/tab/newlines.
   --  ------------------------------
   function To_String (Value : in Util.Beans.Objects.Object) return Unbounded_String is
      Result    : constant String := Util.Beans.Objects.To_String (Value);
      First_Pos : Natural := Result'First;
      Last_Pos  : Natural := Result'Last;
      C : Character;
   begin
      while First_Pos <= Last_Pos loop
         C := Result (First_Pos);
         exit when C /= ' ' and C /= ASCII.LF and C /= ASCII.CR and C /= ASCII.HT;
         First_Pos := First_Pos + 1;
      end loop;
      while Last_Pos >= First_Pos loop
         C := Result (Last_Pos);
         exit when C /= ' ' and C /= ASCII.LF and C /= ASCII.CR and C /= ASCII.HT;
         Last_Pos := Last_Pos - 1;
      end loop;
      return To_Unbounded_String (Result (First_Pos .. Last_Pos));
   end To_String;

   procedure Set_Member (Closure : in out Command_Loader;
                         Field   : in Command_Fields;
                         Value   : in Util.Beans.Objects.Object) is
      use Util.Beans.Objects;
   begin
      if Field = FIELD_COMMAND then
         if Closure.Command /= null then
            Log.Info ("Adding command {0}", Closure.Command.Name);

            Add_Command (Name => To_String (Closure.Command.Name),
                         Cmd  => Closure.Command.all'Access);
            Closure.Command := null;
         end if;
      else
         if Closure.Command = null then
            Closure.Command := new Gen.Commands.Templates.Command;
         end if;
         case Field is
            when FIELD_NAME =>
               Closure.Command.Name := To_String (Value);

            when FIELD_TITLE =>
               Closure.Command.Title := To_String (Value);

            when FIELD_USAGE =>
               Closure.Command.Usage := To_String (Value);

            when FIELD_HELP =>
               Closure.Command.Help_Msg := To_String (Value);

            when FIELD_TEMPLATE =>
               Closure.Command.Templates.Include (To_String (Value));

            when FIELD_PARAM_NAME =>
               Closure.P.Name := To_Unbounded_String (Value);

            when FIELD_PARAM_OPTIONAL =>
               Closure.P.Is_Optional := To_Boolean (Value);

            when FIELD_PARAM_ARG =>
               Closure.P.Argument := To_Unbounded_String (Value);

            when FIELD_PARAM =>
               Closure.P.Value := To_Unbounded_String (Value);
               Closure.Command.Params.Append (Closure.P);
               Closure.P.Name        := Ada.Strings.Unbounded.Null_Unbounded_String;
               Closure.P.Argument    := Ada.Strings.Unbounded.Null_Unbounded_String;
               Closure.P.Is_Optional := False;

            when FIELD_BASEDIR =>
               Closure.Command.Base_Dir := To_Unbounded_String (Value);

            when FIELD_COMMAND =>
               null;

            when FIELD_INSERT_TEMPLATE =>
               Closure.Info.Template := To_Unbounded_String (Value);

            when FIELD_AFTER =>
               Closure.Info.After.Append (To_String (Value));

            when FIELD_BEFORE =>
               Closure.Info.Before := To_Unbounded_String (Value);

            when FIELD_PATCH =>
               Closure.Command.Patches.Append (Closure.Info);
               Closure.Info.After.Clear;
               Closure.Info.Before := To_Unbounded_String ("");

         end case;
      end if;
   end Set_Member;

   package Command_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Command_Loader,
                                               Element_Type_Access => Command_Loader_Access,
                                               Fields              => Command_Fields,
                                               Set_Member          => Set_Member);

   Cmd_Mapper : aliased Command_Mapper.Mapper;

   --  ------------------------------
   --  Read the template commands defined in dynamo configuration directory.
   --  ------------------------------
   procedure Read_Commands (Generator : in out Gen.Generator.Handler) is

      procedure Read_Command (Name      : in String;
                              File_Path : in String;
                              Done      : out Boolean);

      --  ------------------------------
      --  Read the XML command file.
      --  ------------------------------
      procedure Read_Command (Name      : in String;
                              File_Path : in String;
                              Done      : out Boolean) is
         pragma Unreferenced (Name);

         Loader : aliased Command_Loader;
         Reader : Util.Serialize.IO.XML.Parser;
      begin
         Log.Info ("Reading command file '{0}'", File_Path);
         Done := False;

         --  Create the mapping to load the XML command file.
         Reader.Add_Mapping ("commands", Cmd_Mapper'Access);

         --  Set the context for Set_Member.
         Command_Mapper.Set_Context (Reader, Loader'Unchecked_Access);

         --  Read the XML command file.
         Reader.Parse (File_Path);

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Generator.Error ("Command file {0} does not exist", File_Path);
      end Read_Command;

      Config_Dir : constant String := Generator.Get_Config_Directory;
      Cmd_Dir    : constant String := Generator.Get_Parameter ("generator.commands.dir");
      Path       : constant String := Util.Files.Compose (Config_Dir, Cmd_Dir);
   begin
      Log.Debug ("Checking commands in {0}", Path);

      if Ada.Directories.Exists (Path) then
         Util.Files.Iterate_Files_Path (Path    => Path,
                                        Pattern => "*.xml",
                                        Process => Read_Command'Access);
      end if;
   end Read_Commands;

begin
   --  Setup the mapper to load XML commands.
   Cmd_Mapper.Add_Mapping ("command/name", FIELD_NAME);
   Cmd_Mapper.Add_Mapping ("command/title", FIELD_TITLE);
   Cmd_Mapper.Add_Mapping ("command/usage", FIELD_USAGE);
   Cmd_Mapper.Add_Mapping ("command/help", FIELD_HELP);
   Cmd_Mapper.Add_Mapping ("command/basedir", FIELD_BASEDIR);
   Cmd_Mapper.Add_Mapping ("command/param", FIELD_PARAM);
   Cmd_Mapper.Add_Mapping ("command/param/@name", FIELD_PARAM_NAME);
   Cmd_Mapper.Add_Mapping ("command/param/@optional", FIELD_PARAM_OPTIONAL);
   Cmd_Mapper.Add_Mapping ("command/param/@arg", FIELD_PARAM_ARG);
   Cmd_Mapper.Add_Mapping ("command/patch/template", FIELD_INSERT_TEMPLATE);
   Cmd_Mapper.Add_Mapping ("command/patch/after", FIELD_AFTER);
   Cmd_Mapper.Add_Mapping ("command/patch/before", FIELD_BEFORE);
   Cmd_Mapper.Add_Mapping ("command/template", FIELD_TEMPLATE);
   Cmd_Mapper.Add_Mapping ("command/patch", FIELD_PATCH);
   Cmd_Mapper.Add_Mapping ("command", FIELD_COMMAND);
end Gen.Commands.Templates;

-----------------------------------------------------------------------
--  gen-commands-templates -- Template based command
--  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 Ada.Text_IO;
with Ada.IO_Exceptions;
with Ada.Directories;
with Ada.Streams.Stream_IO;

with GNAT.Command_Line;

with Gen.Artifacts;

with EL.Contexts.Default;
with EL.Expressions;
with EL.Variables.Default;

with Util.Log.Loggers;
with Util.Files;
with Util.Streams.Files;
with Util.Streams.Texts;
with Util.Beans.Objects;
with Util.Serialize.Mappers.Record_Mapper;
with Util.Serialize.IO.XML;
package body Gen.Commands.Templates is

   use Ada.Strings.Unbounded;
   use GNAT.Command_Line;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Commands.Templates");

   --  Apply the patch instruction
   procedure Patch_File (Generator : in out Gen.Generator.Handler;
                         Info      : in Patch);

   function Match_Line (Line    : in String;
                        Pattern : in String) return Boolean;

   --  ------------------------------
   --  Check if the line matches the pseudo pattern.
   --  ------------------------------
   function Match_Line (Line    : in String;
                        Pattern : in String) return Boolean is
      L_Pos : Natural := Line'First;
      P_Pos : Natural := Pattern'First;
   begin
      while P_Pos <= Pattern'Last loop
         if L_Pos > Line'Last then
            return False;
         end if;
         if Line (L_Pos) = Pattern (P_Pos) then
            if Pattern (P_Pos) /= ' ' then
               P_Pos := P_Pos + 1;
            end if;
            L_Pos := L_Pos + 1;
         elsif Pattern (P_Pos) = ' ' and then Line (L_Pos) = Pattern (P_Pos + 1) then
            P_Pos := P_Pos + 2;
            L_Pos := L_Pos + 1;
         elsif Pattern (P_Pos) = ' ' and then Pattern (P_Pos + 1) = '*' then
            P_Pos := P_Pos + 1;
            L_Pos := L_Pos + 1;
         elsif Pattern (P_Pos) = '*' and then Line (L_Pos) = Pattern (P_Pos + 1) then
            P_Pos := P_Pos + 2;
            L_Pos := L_Pos + 1;
         elsif Pattern (P_Pos) = '*' and Line (L_Pos) /= ' ' then
            L_Pos := L_Pos + 1;
         else
            return False;
         end if;
      end loop;
      return True;
   end Match_Line;

   --  ------------------------------
   --  Apply the patch instruction
   --  ------------------------------
   procedure Patch_File (Generator : in out Gen.Generator.Handler;
                         Info      : in Patch) is
      procedure Save_Output (H       : in out Gen.Generator.Handler;
                             File    : in String;
                             Content : in Ada.Strings.Unbounded.Unbounded_String);

      Ctx         : EL.Contexts.Default.Default_Context;
      Variables   : aliased EL.Variables.Default.Default_Variable_Mapper;

      procedure Save_Output (H       : in out Gen.Generator.Handler;
                             File    : in String;
                             Content : in Ada.Strings.Unbounded.Unbounded_String) is

         type State is (MATCH_AFTER, MATCH_BEFORE, MATCH_DONE);

         Output_Dir    : constant String := H.Get_Result_Directory;
         Path          : constant String := Util.Files.Compose (Output_Dir, File);
         Tmp_File      : constant String := Path & ".tmp";
         Line_Number   : Natural := 0;
         After_Pos     : Natural := 1;
         Current_State : State := MATCH_AFTER;
         Tmp_Output    : aliased Util.Streams.Files.File_Stream;
         Output        : Util.Streams.Texts.Print_Stream;

         procedure Process (Line : in String);

         procedure Process (Line : in String) is
         begin
            Line_Number := Line_Number + 1;
            case Current_State is
            when MATCH_AFTER =>
               if Match_Line (Line, Info.After.Element (After_Pos)) then
                  Log.Info ("Match after at line {0}", Natural'Image (Line_Number));
                  After_Pos := After_Pos + 1;
                  if After_Pos > Natural (Info.After.Length) then
                     Current_State := MATCH_BEFORE;
                  end if;
               end if;

            when MATCH_BEFORE =>
               if Match_Line (Line, To_String (Info.Before)) then
                  Log.Info ("Match before at line {0}", Natural'Image (Line_Number));
                  Log.Info ("Add content {0}", Content);
                  Output.Write (Content);
                  Current_State := MATCH_DONE;
               end if;

            when MATCH_DONE =>
               null;

            end case;
            Output.Write (Line);
            Output.Write (ASCII.LF);
         end Process;

      begin
         Tmp_Output.Create (Name => Tmp_File, Mode => Ada.Streams.Stream_IO.Out_File);
         Output.Initialize (Tmp_Output'Unchecked_Access);
         Util.Files.Read_File (Path, Process'Access);
         Output.Close;
         if Current_State /= MATCH_DONE then
            H.Error ("Patch {0} failed", Path);
            Ada.Directories.Delete_File (Tmp_File);
         else
            Ada.Directories.Delete_File (Path);
            Ada.Directories.Rename (Old_Name => Tmp_File,
                                    New_Name => Path);
         end if;

      exception
         when Ada.IO_Exceptions.Name_Error =>
            H.Error ("Cannot patch file {0}", Path);
      end Save_Output;

   begin
      Ctx.Set_Variable_Mapper (Variables'Unchecked_Access);
      Gen.Generator.Generate (Generator, Gen.Artifacts.ITERATION_TABLE,
                              To_String (Info.Template), Save_Output'Access);
   end Patch_File;

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      function Get_Output_Dir return String;

      function Get_Output_Dir return String is
         Dir        : constant String := Generator.Get_Result_Directory;
      begin
         if Length (Cmd.Base_Dir) = 0 then
            return Dir;
         else
            return Util.Files.Compose (Dir, To_String (Cmd.Base_Dir));
         end if;
      end Get_Output_Dir;

      Out_Dir : constant String := Get_Output_Dir;
      Iter    : Param_Vectors.Cursor := Cmd.Params.First;
   begin
      Generator.Read_Project ("dynamo.xml", False);
      while Param_Vectors.Has_Element (Iter) loop
         declare
            P     : constant Param := Param_Vectors.Element (Iter);
            Value : constant String := Get_Argument;
         begin
            if not P.Is_Optional and Value'Length = 0 then
               Generator.Error ("Missing argument for {0}", To_String (P.Argument));
               return;
            end if;
            Generator.Set_Global (To_String (P.Name), Value);
         end;
         Param_Vectors.Next (Iter);
      end loop;

      Generator.Set_Force_Save (False);
      Generator.Set_Result_Directory (Out_Dir);
      declare
         Iter : Util.Strings.Sets.Cursor := Cmd.Templates.First;
      begin
         while Util.Strings.Sets.Has_Element (Iter) loop
            Gen.Generator.Generate (Generator, Gen.Artifacts.ITERATION_TABLE,
                                    Util.Strings.Sets.Element (Iter),
                                    Gen.Generator.Save_Content'Access);
            Util.Strings.Sets.Next (Iter);
         end loop;
      end;

      --  Apply the patch instructions defined for the command.
      declare
         Iter : Patch_Vectors.Cursor := Cmd.Patches.First;
      begin
         while Patch_Vectors.Has_Element (Iter) loop
            Patch_File (Generator, Patch_Vectors.Element (Iter));
            Patch_Vectors.Next (Iter);
         end loop;
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Generator);

      use Ada.Text_IO;
   begin
      Put_Line (To_String (Cmd.Name) & ": " & To_String (Cmd.Title));
      Put_Line ("Usage: " & To_String (Cmd.Usage));
      New_Line;
      Put_Line (To_String (Cmd.Help_Msg));
   end Help;

   type Command_Fields is (FIELD_NAME,
                           FIELD_HELP,
                           FIELD_USAGE,
                           FIELD_TITLE,
                           FIELD_BASEDIR,
                           FIELD_PARAM,
                           FIELD_PARAM_NAME,
                           FIELD_PARAM_OPTIONAL,
                           FIELD_PARAM_ARG,
                           FIELD_TEMPLATE,
                           FIELD_PATCH,
                           FIELD_AFTER,
                           FIELD_BEFORE,
                           FIELD_INSERT_TEMPLATE,
                           FIELD_COMMAND);

   type Command_Loader is record
      Command : Command_Access := null;
      P       : Param;
      Info    : Patch;
   end record;
   type Command_Loader_Access is access all Command_Loader;

   procedure Set_Member (Closure : in out Command_Loader;
                         Field   : in Command_Fields;
                         Value   : in Util.Beans.Objects.Object);

   function To_String (Value : in Util.Beans.Objects.Object) return Unbounded_String;

   --  ------------------------------
   --  Convert the object value into a string and trim any space/tab/newlines.
   --  ------------------------------
   function To_String (Value : in Util.Beans.Objects.Object) return Unbounded_String is
      Result    : constant String := Util.Beans.Objects.To_String (Value);
      First_Pos : Natural := Result'First;
      Last_Pos  : Natural := Result'Last;
      C : Character;
   begin
      while First_Pos <= Last_Pos loop
         C := Result (First_Pos);
         exit when C /= ' ' and C /= ASCII.LF and C /= ASCII.CR and C /= ASCII.HT;
         First_Pos := First_Pos + 1;
      end loop;
      while Last_Pos >= First_Pos loop
         C := Result (Last_Pos);
         exit when C /= ' ' and C /= ASCII.LF and C /= ASCII.CR and C /= ASCII.HT;
         Last_Pos := Last_Pos - 1;
      end loop;
      return To_Unbounded_String (Result (First_Pos .. Last_Pos));
   end To_String;

   procedure Set_Member (Closure : in out Command_Loader;
                         Field   : in Command_Fields;
                         Value   : in Util.Beans.Objects.Object) is
      use Util.Beans.Objects;
   begin
      if Field = FIELD_COMMAND then
         if Closure.Command /= null then
            Log.Info ("Adding command {0}", Closure.Command.Name);

            Add_Command (Name => To_String (Closure.Command.Name),
                         Cmd  => Closure.Command.all'Access);
            Closure.Command := null;
         end if;
      else
         if Closure.Command = null then
            Closure.Command := new Gen.Commands.Templates.Command;
         end if;
         case Field is
            when FIELD_NAME =>
               Closure.Command.Name := To_String (Value);

            when FIELD_TITLE =>
               Closure.Command.Title := To_String (Value);

            when FIELD_USAGE =>
               Closure.Command.Usage := To_String (Value);

            when FIELD_HELP =>
               Closure.Command.Help_Msg := To_String (Value);

            when FIELD_TEMPLATE =>
               Closure.Command.Templates.Include (To_String (Value));

            when FIELD_PARAM_NAME =>
               Closure.P.Name := To_Unbounded_String (Value);

            when FIELD_PARAM_OPTIONAL =>
               Closure.P.Is_Optional := To_Boolean (Value);

            when FIELD_PARAM_ARG =>
               Closure.P.Argument := To_Unbounded_String (Value);

            when FIELD_PARAM =>
               Closure.P.Value := To_Unbounded_String (Value);
               Closure.Command.Params.Append (Closure.P);
               Closure.P.Name        := Ada.Strings.Unbounded.Null_Unbounded_String;
               Closure.P.Argument    := Ada.Strings.Unbounded.Null_Unbounded_String;
               Closure.P.Is_Optional := False;

            when FIELD_BASEDIR =>
               Closure.Command.Base_Dir := To_Unbounded_String (Value);

            when FIELD_COMMAND =>
               null;

            when FIELD_INSERT_TEMPLATE =>
               Closure.Info.Template := To_Unbounded_String (Value);

            when FIELD_AFTER =>
               Closure.Info.After.Append (To_String (Value));

            when FIELD_BEFORE =>
               Closure.Info.Before := To_Unbounded_String (Value);

            when FIELD_PATCH =>
               Closure.Command.Patches.Append (Closure.Info);
               Closure.Info.After.Clear;
               Closure.Info.Before := To_Unbounded_String ("");

         end case;
      end if;
   end Set_Member;

   package Command_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Command_Loader,
                                               Element_Type_Access => Command_Loader_Access,
                                               Fields              => Command_Fields,
                                               Set_Member          => Set_Member);

   Cmd_Mapper : aliased Command_Mapper.Mapper;

   --  ------------------------------
   --  Read the template commands defined in dynamo configuration directory.
   --  ------------------------------
   procedure Read_Commands (Generator : in out Gen.Generator.Handler) is

      procedure Read_Command (Name      : in String;
                              File_Path : in String;
                              Done      : out Boolean);

      --  ------------------------------
      --  Read the XML command file.
      --  ------------------------------
      procedure Read_Command (Name      : in String;
                              File_Path : in String;
                              Done      : out Boolean) is
         pragma Unreferenced (Name);

         Loader : aliased Command_Loader;
         Reader : Util.Serialize.IO.XML.Parser;
      begin
         Log.Info ("Reading command file '{0}'", File_Path);
         Done := False;

         --  Create the mapping to load the XML command file.
         Reader.Add_Mapping ("commands", Cmd_Mapper'Access);

         --  Set the context for Set_Member.
         Command_Mapper.Set_Context (Reader, Loader'Unchecked_Access);

         --  Read the XML command file.
         Reader.Parse (File_Path);

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Generator.Error ("Command file {0} does not exist", File_Path);
      end Read_Command;

      Config_Dir : constant String := Generator.Get_Config_Directory;
      Cmd_Dir    : constant String := Generator.Get_Parameter ("generator.commands.dir");
      Path       : constant String := Util.Files.Compose (Config_Dir, Cmd_Dir);
   begin
      Log.Debug ("Checking commands in {0}", Path);

      if Ada.Directories.Exists (Path) then
         Util.Files.Iterate_Files_Path (Path    => Path,
                                        Pattern => "*.xml",
                                        Process => Read_Command'Access);
      end if;
   end Read_Commands;

begin
   --  Setup the mapper to load XML commands.
   Cmd_Mapper.Add_Mapping ("command/name", FIELD_NAME);
   Cmd_Mapper.Add_Mapping ("command/title", FIELD_TITLE);
   Cmd_Mapper.Add_Mapping ("command/usage", FIELD_USAGE);
   Cmd_Mapper.Add_Mapping ("command/help", FIELD_HELP);
   Cmd_Mapper.Add_Mapping ("command/basedir", FIELD_BASEDIR);
   Cmd_Mapper.Add_Mapping ("command/param", FIELD_PARAM);
   Cmd_Mapper.Add_Mapping ("command/param/@name", FIELD_PARAM_NAME);
   Cmd_Mapper.Add_Mapping ("command/param/@optional", FIELD_PARAM_OPTIONAL);
   Cmd_Mapper.Add_Mapping ("command/param/@arg", FIELD_PARAM_ARG);
   Cmd_Mapper.Add_Mapping ("command/patch/template", FIELD_INSERT_TEMPLATE);
   Cmd_Mapper.Add_Mapping ("command/patch/after", FIELD_AFTER);
   Cmd_Mapper.Add_Mapping ("command/patch/before", FIELD_BEFORE);
   Cmd_Mapper.Add_Mapping ("command/template", FIELD_TEMPLATE);
   Cmd_Mapper.Add_Mapping ("command/patch", FIELD_PATCH);
   Cmd_Mapper.Add_Mapping ("command", FIELD_COMMAND);
end Gen.Commands.Templates;

Fix matching rules when executing a patch command


-----------------------------------------------------------------------
--  mat-targets - Representation of target information
--  Copyright (C) 2014, 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.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Containers.Ordered_Maps;
with Ada.Finalization;

with GNAT.Sockets;

with MAT.Types;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Events.Targets;
with MAT.Events.Probes;
with MAT.Readers;
with MAT.Readers.Streams;
with MAT.Readers.Streams.Sockets;
with MAT.Consoles;
with MAT.Expressions;
package MAT.Targets is

   --  Exception raised if some option is invalid.
   Usage_Error : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      --  Enable and enter in the interactive TTY console mode.
      Interactive  : Boolean := True;

      --  Try to load the symbol file automatically when a new process is received.
      Load_Symbols : Boolean := True;

      --  Enable the graphical mode (when available).
      Graphical    : Boolean := False;

      --  Print the events as they are received.
      Print_Events : Boolean := False;

      --  The library search path.
      Search_Path  : Ada.Strings.Unbounded.Unbounded_String;

      --  Define the server listening address.
      Address      : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   type Target_Process_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Expressions.Resolver_Type with record
      Pid     : MAT.Types.Target_Process_Ref;
      Endian  : MAT.Readers.Endian_Type := MAT.Readers.LITTLE_ENDIAN;
      Path    : Ada.Strings.Unbounded.Unbounded_String;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols_Ref;
      Events  : MAT.Events.Targets.Target_Events_Access;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   --  Release the target process instance.
   overriding
   procedure Finalize (Target : in out Target_Process_Type);

   --  Find the region that matches the given name.
   overriding
   function Find_Region (Resolver : in Target_Process_Type;
                         Name     : in String) return MAT.Memory.Region_Info;

   --  Find the symbol in the symbol table and return the start and end address.
   overriding
   function Find_Symbol (Resolver : in Target_Process_Type;
                         Name     : in String) return MAT.Memory.Region_Info;

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with private;

   type Target_Type_Access is access all Target_Type'Class;

   --  Get the console instance.
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access;

   --  Set the console instance.
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access);

   --  Get the current process instance.
   function Process (Target : in Target_Type) return Target_Process_Type_Access;

   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   overriding
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Events.Probes.Probe_Manager_Type'Class);

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access);

   --  Find the process instance from the process ID.
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access;

   --  Iterate over the list of connected processes and execute the <tt>Process</tt> procedure.
   procedure Iterator (Target  : in Target_Type;
                       Process : access procedure (Proc : in Target_Process_Type'Class));

   --  Add a search path for the library and symbol loader.
   procedure Add_Search_Path (Target : in out MAT.Targets.Target_Type;
                              Path   : in String);

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out Target_Type);

   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   procedure Interactive (Target : in out MAT.Targets.Target_Type);

   --  Start the server to listen to MAT event socket streams.
   procedure Start (Target : in out Target_Type);

   --  Stop the server thread.
   procedure Stop (Target : in out Target_Type);

   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type;

   --  Print the application usage.
   procedure Usage;

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

   subtype Process_Map is Process_Maps.Map;
   subtype Process_Cursor is Process_Maps.Cursor;

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with record
      Current   : Target_Process_Type_Access;
      Processes : Process_Map;
      Console   : MAT.Consoles.Console_Access;
      Options   : Options_Type;
      Server    : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
   end record;

   --  Release the storage used by the target object.
   overriding
   procedure Finalize (Target : in out Target_Type);

end MAT.Targets;

-----------------------------------------------------------------------
--  mat-targets - Representation of target information
--  Copyright (C) 2014, 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.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Containers.Ordered_Maps;
with Ada.Finalization;

with GNAT.Sockets;

with MAT.Types;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Events.Targets;
with MAT.Events.Probes;
with MAT.Readers;
with MAT.Readers.Streams;
with MAT.Readers.Streams.Sockets;
with MAT.Consoles;
with MAT.Expressions;
package MAT.Targets is

   --  Exception raised if some option is invalid.
   Usage_Error : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      --  Enable and enter in the interactive TTY console mode.
      Interactive  : Boolean := True;

      --  Try to load the symbol file automatically when a new process is received.
      Load_Symbols : Boolean := True;

      --  Enable the graphical mode (when available).
      Graphical    : Boolean := False;

      --  Print the events as they are received.
      Print_Events : Boolean := False;

      --  The library search path.
      Search_Path  : Ada.Strings.Unbounded.Unbounded_String;

      --  Define the server listening address.
      Address      : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   type Target_Process_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Expressions.Resolver_Type with record
      Pid     : MAT.Types.Target_Process_Ref;
      Endian  : MAT.Readers.Endian_Type := MAT.Readers.LITTLE_ENDIAN;
      Path    : Ada.Strings.Unbounded.Unbounded_String;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols_Ref;
      Events  : MAT.Events.Targets.Target_Events_Access;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   --  Release the target process instance.
   overriding
   procedure Finalize (Target : in out Target_Process_Type);

   --  Find the region that matches the given name.
   overriding
   function Find_Region (Resolver : in Target_Process_Type;
                         Name     : in String) return MAT.Memory.Region_Info;

   --  Find the symbol in the symbol table and return the start and end address.
   overriding
   function Find_Symbol (Resolver : in Target_Process_Type;
                         Name     : in String) return MAT.Memory.Region_Info;

   --  Get the start time for the tick reference.
   overriding
   function Get_Start_Time (Resolver : in Target_Process_Type)
                            return MAT.Types.Target_Tick_Ref;

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with private;

   type Target_Type_Access is access all Target_Type'Class;

   --  Get the console instance.
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access;

   --  Set the console instance.
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access);

   --  Get the current process instance.
   function Process (Target : in Target_Type) return Target_Process_Type_Access;

   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   overriding
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Events.Probes.Probe_Manager_Type'Class);

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access);

   --  Find the process instance from the process ID.
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access;

   --  Iterate over the list of connected processes and execute the <tt>Process</tt> procedure.
   procedure Iterator (Target  : in Target_Type;
                       Process : access procedure (Proc : in Target_Process_Type'Class));

   --  Add a search path for the library and symbol loader.
   procedure Add_Search_Path (Target : in out MAT.Targets.Target_Type;
                              Path   : in String);

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out Target_Type);

   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   procedure Interactive (Target : in out MAT.Targets.Target_Type);

   --  Start the server to listen to MAT event socket streams.
   procedure Start (Target : in out Target_Type);

   --  Stop the server thread.
   procedure Stop (Target : in out Target_Type);

   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type;

   --  Print the application usage.
   procedure Usage;

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

   subtype Process_Map is Process_Maps.Map;
   subtype Process_Cursor is Process_Maps.Cursor;

   type Target_Type is new Ada.Finalization.Limited_Controlled
     and MAT.Events.Probes.Reader_List_Type with record
      Current   : Target_Process_Type_Access;
      Processes : Process_Map;
      Console   : MAT.Consoles.Console_Access;
      Options   : Options_Type;
      Server    : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
   end record;

   --  Release the storage used by the target object.
   overriding
   procedure Finalize (Target : in out Target_Type);

end MAT.Targets;

Declare the Get_Start_Time abstract function for the Target_Process_Type


-----------------------------------------------------------------------
--  Render Tests - Unit tests for ASF.Applications.Views
--  Copyright (C) 2009, 2010, 2011, 2012, 2014, 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.
-----------------------------------------------------------------------

with Ada.Text_IO;
with ASF.Applications.Main;
with ASF.Applications.Tests;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Servlets.Faces;
with ASF.Converters.Dates;
with ASF.Server;
with Ada.Directories;
with Ada.Unchecked_Deallocation;

with Util.Files;
with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Measures;
package body ASF.Applications.Views.Tests is

   use Ada.Strings.Unbounded;

   overriding
   procedure Set_Up (T : in out Test) is
   begin
      null;
   end Set_Up;
   --  Set up performed before each test case

   --  ------------------------------
   --  Test loading of facelet file
   --  ------------------------------
   procedure Test_Load_Facelet (T : in out Test) is
      use ASF.Contexts.Faces;

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => ASF.Converters.Dates.Date_Converter'Class,
                                        Name   => ASF.Converters.Dates.Date_Converter_Access);

      App         : aliased Applications.Main.Application;
      View_Name   : constant String := To_String (T.File);
      Result_File : constant String := To_String (T.Result);
      Conf        : Applications.Config;
      App_Factory : Applications.Main.Application_Factory;
      Dir         : constant String := "regtests/files";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      Faces       : aliased ASF.Servlets.Faces.Faces_Servlet;
      List        : Util.Beans.Basic.Readonly_Bean_Access;
      List_Bean   : Util.Beans.Objects.Object;
      Form        : Util.Beans.Basic.Readonly_Bean_Access;
      Form_Bean   : Util.Beans.Objects.Object;
      C           : ASF.Converters.Dates.Date_Converter_Access;
      Container   : ASF.Server.Container;
   begin
      List := Applications.Tests.Create_Form_List;
      List_Bean := Util.Beans.Objects.To_Object (List);

      Form := Applications.Tests.Create_Form_Bean;
      Form_Bean := Util.Beans.Objects.To_Object (Form);

      Conf.Load_Properties ("regtests/view.properties");
      Conf.Set ("view.dir", Path);
      App.Initialize (Conf, App_Factory);
      App.Register_Application ("/");
      App.Add_Servlet ("faces", Faces'Unchecked_Access);
      App.Add_Mapping ("*.xhtml", "faces");
      C := ASF.Converters.Dates.Create_Date_Converter (Date    => ASF.Converters.Dates.DEFAULT,
                                                       Time    => ASF.Converters.Dates.DEFAULT,
                                                       Format  => ASF.Converters.Dates.TIME,
                                                       Locale  => "en",
                                                       Pattern => "");
      App.Add_Converter ("date-default-converter", C.all'Access);

      App.Set_Global ("function", "Test_Load_Facelet");
      App.Set_Global ("date", "2011-12-03 03:04:05.23");
      Container.Register_Application ("/asfunit", App'Unchecked_Access);
      for I in 1 .. 2 loop
         declare
            S : Util.Measures.Stamp;
            Req       : ASF.Requests.Mockup.Request;
            Reply     : aliased ASF.Responses.Mockup.Response;
            Content   : Unbounded_String;
         begin
            Req.Set_Method ("GET");
            Req.Set_Request_URI ("/asfunit/" & View_Name);
            Req.Set_Parameter ("file-name", To_String (T.Name));
            Req.Set_Header ("file", To_String (T.Name));
            Req.Set_Attribute ("list", List_Bean);
            Req.Set_Attribute ("form", Form_Bean);
            Container.Service (Req, Reply);
            Util.Measures.Report (S, "Pass" & Integer'Image (I) & ": Render view "
                                  & View_Name);

            Reply.Read_Content (Content);
            Util.Files.Write_File (Result_File, Content);
            Util.Tests.Assert_Equal_Files (T       => T,
                                           Expect  => To_String (T.Expect),
                                           Test    => Result_File,
                                           Message => "Restore and render view");
         end;
      end loop;
      Free (C);
   end Test_Load_Facelet;

   --  ------------------------------
   --  Test case name
   --  ------------------------------
   overriding
   function Name (T : Test) return Util.Tests.Message_String is
   begin
      return Util.Tests.Format ("Test " & To_String (T.Name));
   end Name;

   --  ------------------------------
   --  Perform the test.
   --  ------------------------------
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Load_Facelet;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;

      Result_Dir  : constant String := "regtests/result/views";
      Dir         : constant String := "regtests/files/views";
      Expect_Dir  : constant String := "regtests/expect/views";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;
   begin
      if Kind (Path) /= Directory then
         Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
      end if;

      Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Simple    : constant String := Simple_Name (Ent);
            Tst      : Test_Case_Access;
         begin
            if Simple /= "." and then Simple /= ".."
              and then Simple /= ".svn"
            then
               Tst := new Test;
               Tst.Name := To_Unbounded_String (Dir & "/" & Simple);
               Tst.File := To_Unbounded_String ("views/" & Simple);
               Tst.Expect := To_Unbounded_String (Expect_Path & "/" & Simple);
               Tst.Result := To_Unbounded_String (Result_Path & "/" & Simple);
               Suite.Add_Test (Tst.all'Access);
            end if;
         end;
      end loop;
   end Add_Tests;

end ASF.Applications.Views.Tests;

-----------------------------------------------------------------------
--  Render Tests - Unit tests for ASF.Applications.Views
--  Copyright (C) 2009, 2010, 2011, 2012, 2014, 2015, 2018 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.Text_IO;
with ASF.Applications.Main;
with ASF.Applications.Tests;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Servlets.Faces;
with ASF.Converters.Dates;
with ASF.Server;
with Ada.Directories;
with Ada.Unchecked_Deallocation;

with Util.Files;
with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Measures;
package body ASF.Applications.Views.Tests is

   use Ada.Strings.Unbounded;

   overriding
   procedure Set_Up (T : in out Test) is
   begin
      null;
   end Set_Up;
   --  Set up performed before each test case

   --  ------------------------------
   --  Test loading of facelet file
   --  ------------------------------
   procedure Test_Load_Facelet (T : in out Test) is
      use ASF.Contexts.Faces;

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => ASF.Converters.Dates.Date_Converter'Class,
                                        Name   => ASF.Converters.Dates.Date_Converter_Access);

      App         : aliased Applications.Main.Application;
      View_Name   : constant String := To_String (T.File);
      Result_File : constant String := To_String (T.Result);
      Conf        : Applications.Config;
      App_Factory : Applications.Main.Application_Factory;
      Dir         : constant String := "regtests/files";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      Faces       : aliased ASF.Servlets.Faces.Faces_Servlet;
      List        : Util.Beans.Basic.Readonly_Bean_Access;
      List_Bean   : Util.Beans.Objects.Object;
      Form        : Util.Beans.Basic.Readonly_Bean_Access;
      Form_Bean   : Util.Beans.Objects.Object;
      C           : ASF.Converters.Dates.Date_Converter_Access;
      Container   : ASF.Server.Container;
   begin
      List := Applications.Tests.Create_Form_List;
      List_Bean := Util.Beans.Objects.To_Object (List);

      Form := Applications.Tests.Create_Form_Bean;
      Form_Bean := Util.Beans.Objects.To_Object (Form);

      Conf.Load_Properties ("regtests/view.properties");
      Conf.Set ("view.dir", Path);
      App.Initialize (Conf, App_Factory);
      App.Register_Application ("/");
      App.Add_Servlet ("faces", Faces'Unchecked_Access);
      App.Add_Mapping ("*.xhtml", "faces");
      C := ASF.Converters.Dates.Create_Date_Converter (Date    => ASF.Converters.Dates.DEFAULT,
                                                       Time    => ASF.Converters.Dates.DEFAULT,
                                                       Format  => ASF.Converters.Dates.TIME,
                                                       Locale  => "en",
                                                       Pattern => "");
      App.Add_Converter ("date-default-converter", C.all'Access);

      App.Set_Global ("function", "Test_Load_Facelet");
      App.Set_Global ("date", "2011-12-03 03:04:05.23");
      Container.Register_Application ("/asfunit", App'Unchecked_Access);
      Container.Start;
      for I in 1 .. 2 loop
         declare
            S : Util.Measures.Stamp;
            Req       : ASF.Requests.Mockup.Request;
            Reply     : aliased ASF.Responses.Mockup.Response;
            Content   : Unbounded_String;
         begin
            Req.Set_Method ("GET");
            Req.Set_Request_URI ("/asfunit/" & View_Name);
            Req.Set_Parameter ("file-name", To_String (T.Name));
            Req.Set_Header ("file", To_String (T.Name));
            Req.Set_Attribute ("list", List_Bean);
            Req.Set_Attribute ("form", Form_Bean);
            Container.Service (Req, Reply);
            Util.Measures.Report (S, "Pass" & Integer'Image (I) & ": Render view "
                                  & View_Name);

            Reply.Read_Content (Content);
            Util.Files.Write_File (Result_File, Content);
            Util.Tests.Assert_Equal_Files (T       => T,
                                           Expect  => To_String (T.Expect),
                                           Test    => Result_File,
                                           Message => "Restore and render view");
         end;
      end loop;
      Free (C);
   end Test_Load_Facelet;

   --  ------------------------------
   --  Test case name
   --  ------------------------------
   overriding
   function Name (T : Test) return Util.Tests.Message_String is
   begin
      return Util.Tests.Format ("Test " & To_String (T.Name));
   end Name;

   --  ------------------------------
   --  Perform the test.
   --  ------------------------------
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Load_Facelet;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;

      Result_Dir  : constant String := "regtests/result/views";
      Dir         : constant String := "regtests/files/views";
      Expect_Dir  : constant String := "regtests/expect/views";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;
   begin
      if Kind (Path) /= Directory then
         Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
      end if;

      Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Simple    : constant String := Simple_Name (Ent);
            Tst      : Test_Case_Access;
         begin
            if Simple /= "." and then Simple /= ".."
              and then Simple /= ".svn"
            then
               Tst := new Test;
               Tst.Name := To_Unbounded_String (Dir & "/" & Simple);
               Tst.File := To_Unbounded_String ("views/" & Simple);
               Tst.Expect := To_Unbounded_String (Expect_Path & "/" & Simple);
               Tst.Result := To_Unbounded_String (Result_Path & "/" & Simple);
               Suite.Add_Test (Tst.all'Access);
            end if;
         end;
      end loop;
   end Add_Tests;

end ASF.Applications.Views.Tests;

Call the Start procedure on the servlet registry


-----------------------------------------------------------------------
--  Render Tests - Unit tests for ASF.Applications.Views
--  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.Text_IO;
with ASF.Applications.Main;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with Ada.Directories;

with Util.Test_Caller;
with Util.Files;
with Util.Measures;
package body ASF.Applications.Views.Tests is

   use Ada.Strings.Unbounded;

   overriding
   procedure Set_Up (T : in out Test) is
   begin
      null;
   end Set_Up;
   --  Set up performed before each test case

   --  Test loading of facelet file
   procedure Test_Load_Facelet (T : in out Test) is

      use ASF;
      use ASF.Contexts.Faces;

      App      : Applications.Main.Application;
--        H        : Applications.Views.View_Handler;

      View_Name   : constant String := To_String (T.File);
      Result_File : constant String := To_String (T.Result);
      Conf        : Applications.Config;
      App_Factory : Applications.Main.Application_Factory;
      Dir         : constant String := "regtests/files";
      Path        : constant String := Util.Tests.Get_Path (Dir);
   begin
      Conf.Load_Properties ("regtests/view.properties");
      Conf.Set ("view.dir", Path);
      App.Initialize (Conf, App_Factory);

      App.Set_Global ("function", "Test_Load_Facelet");
      for I in 1 .. 2 loop
         declare
            S : Util.Measures.Stamp;
            Req       : ASF.Requests.Mockup.Request;
            Rep       : ASF.Responses.Mockup.Response;
            Content   : Unbounded_String;
         begin

            Req.Set_Method ("GET");
            Req.Set_Path_Info (View_Name);
            Req.Set_Parameter ("file-name", To_String (T.Name));
            Req.Set_Header ("file", To_String (T.Name));
            App.Dispatch (Page     => View_Name,
                          Request  => Req,
                          Response => Rep);
            Util.Measures.Report (S, "Pass" & Integer'Image (I) & ": Render view "
                                  & View_Name);

            Rep.Read_Content (Content);
            Util.Files.Write_File (Result_File, Content);
            Util.Tests.Assert_Equal_Files (T       => T,
                                           Expect  => To_String (T.Expect),
                                           Test    => Result_File,
                                           Message => "Restore and render view");
         end;
      end loop;
   end Test_Load_Facelet;

   --  Test case name
   overriding
   function Name (T : Test) return Util.Tests.Message_String is
   begin
      return Util.Tests.Format ("Test " & To_String (T.Name));
   end Name;

   --  Perform the test.
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Load_Facelet;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;

      Result_Dir  : constant String := "regtests/result/views";
      Dir         : constant String := "regtests/files/views";
      Expect_Dir  : constant String := "regtests/expect/views";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;
   begin
      if Kind (Path) = Directory then
         Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
      end if;

      Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Simple    : constant String := Simple_Name (Ent);
            Tst      : Test_Case_Access;
         begin
            if Simple /= "." and then Simple /= ".."
              and then Simple /= ".svn" then
               Tst := new Test;
               Tst.Name := To_Unbounded_String (Dir & "/" & Simple);
               Tst.File := To_Unbounded_String ("views/" & Simple);
               Tst.Expect := To_Unbounded_String (Expect_Path & "/" & Simple);
               Tst.Result := To_Unbounded_String (Result_Path & "/" & Simple);
               Suite.Add_Test (Tst);
            end if;
         end;
      end loop;
   end Add_Tests;

end ASF.Applications.Views.Tests;

-----------------------------------------------------------------------
--  Render Tests - Unit tests for ASF.Applications.Views
--  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.Text_IO;
with ASF.Applications.Main;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with Ada.Directories;

with Util.Test_Caller;
with Util.Files;
with Util.Measures;
package body ASF.Applications.Views.Tests is

   use Ada.Strings.Unbounded;

   overriding
   procedure Set_Up (T : in out Test) is
   begin
      null;
   end Set_Up;
   --  Set up performed before each test case

   --  Test loading of facelet file
   procedure Test_Load_Facelet (T : in out Test) is

      use ASF;
      use ASF.Contexts.Faces;

      App      : Applications.Main.Application;
--        H        : Applications.Views.View_Handler;

      View_Name   : constant String := To_String (T.File);
      Result_File : constant String := To_String (T.Result);
      Conf        : Applications.Config;
      App_Factory : Applications.Main.Application_Factory;
      Dir         : constant String := "regtests/files";
      Path        : constant String := Util.Tests.Get_Path (Dir);
   begin
      Conf.Load_Properties ("regtests/view.properties");
      Conf.Set ("view.dir", Path);
      App.Initialize (Conf, App_Factory);

      App.Set_Global ("function", "Test_Load_Facelet");
      for I in 1 .. 2 loop
         declare
            S : Util.Measures.Stamp;
            Req       : ASF.Requests.Mockup.Request;
            Rep       : ASF.Responses.Mockup.Response;
            Content   : Unbounded_String;
         begin

            Req.Set_Method ("GET");
            Req.Set_Path_Info (View_Name);
            Req.Set_Parameter ("file-name", To_String (T.Name));
            Req.Set_Header ("file", To_String (T.Name));
            App.Dispatch (Page     => View_Name,
                          Request  => Req,
                          Response => Rep);
            Util.Measures.Report (S, "Pass" & Integer'Image (I) & ": Render view "
                                  & View_Name);

            Rep.Read_Content (Content);
            Util.Files.Write_File (Result_File, Content);
            Util.Tests.Assert_Equal_Files (T       => T,
                                           Expect  => To_String (T.Expect),
                                           Test    => Result_File,
                                           Message => "Restore and render view");
         end;
      end loop;
   end Test_Load_Facelet;

   --  Test case name
   overriding
   function Name (T : Test) return Util.Tests.Message_String is
   begin
      return Util.Tests.Format ("Test " & To_String (T.Name));
   end Name;

   --  Perform the test.
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Load_Facelet;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;

      Result_Dir  : constant String := "regtests/result/views";
      Dir         : constant String := "regtests/files/views";
      Expect_Dir  : constant String := "regtests/expect/views";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;
   begin
      if Kind (Path) = Directory then
         Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
      end if;

      Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            Simple    : constant String := Simple_Name (Ent);
            Tst      : Test_Case_Access;
         begin
            if Simple /= "." and then Simple /= ".."
              and then Simple /= ".svn" then
               Tst := new Test;
               Tst.Name := To_Unbounded_String (Dir & "/" & Simple);
               Tst.File := To_Unbounded_String ("views/" & Simple);
               Tst.Expect := To_Unbounded_String (Expect_Path & "/" & Simple);
               Tst.Result := To_Unbounded_String (Result_Path & "/" & Simple);
               Suite.Add_Test (Tst.all'Access);
            end if;
         end;
      end loop;
   end Add_Tests;

end ASF.Applications.Views.Tests;

Fix compilation when Ahven is used as a test framework


-----------------------------------------------------------------------
--  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 Util.Tests;

package Util.Strings.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Escape_Javascript (T : in out Test);

   procedure Test_Escape_Xml (T : in out Test);

   procedure Test_Unescape_Xml (T : in out Test);

   procedure Test_Capitalize (T : in out Test);

   procedure Test_To_Upper_Case (T : in out Test);

   procedure Test_To_Lower_Case (T : in out Test);
   procedure Test_To_Hex (T : in out Test);
   procedure Test_Measure_Copy (T : in out Test);
   procedure Test_Index (T : in out Test);
   procedure Test_Rindex (T : in out Test);

   --  Do some benchmark on String -> X hash mapped.
   procedure Test_Measure_Hash (T : in out Test);

   --  Test String_Ref creation
   procedure Test_String_Ref (T : in out Test);

   --  Test perfect hash (samples/gperfhash)
   procedure Test_Perfect_Hash (T : in out Test);

   --  Test the token iteration.
   procedure Test_Iterate_Token (T : in out Test);

end Util.Strings.Tests;

-----------------------------------------------------------------------
--  strings.tests -- Unit tests for Strings
--  Copyright (C) 2009, 2010, 2011, 2012, 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.
-----------------------------------------------------------------------

with Util.Tests;

package Util.Strings.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Escape_Javascript (T : in out Test);

   procedure Test_Escape_Xml (T : in out Test);

   procedure Test_Unescape_Xml (T : in out Test);

   procedure Test_Capitalize (T : in out Test);

   procedure Test_To_Upper_Case (T : in out Test);

   procedure Test_To_Lower_Case (T : in out Test);
   procedure Test_To_Hex (T : in out Test);
   procedure Test_Measure_Copy (T : in out Test);
   procedure Test_Index (T : in out Test);
   procedure Test_Rindex (T : in out Test);

   --  Do some benchmark on String -> X hash mapped.
   procedure Test_Measure_Hash (T : in out Test);

   --  Test String_Ref creation
   procedure Test_String_Ref (T : in out Test);

   --  Benchmark comparison between the use of Iterate vs Query_Element.
   procedure Test_Perf_Vector (T : in out Test);

   --  Test perfect hash (samples/gperfhash)
   procedure Test_Perfect_Hash (T : in out Test);

   --  Test the token iteration.
   procedure Test_Iterate_Token (T : in out Test);

end Util.Strings.Tests;

Declare the Test_Perf_Vector procedure for some performance measurement


-----------------------------------------------------------------------
--  Render Tests - Unit tests for AWA Wiki rendering
--  Copyright (C) 2013, 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 Ada.Text_IO;
with Ada.Directories;
with Ada.Characters.Conversions;

with Util.Files;
with Util.Measures;

with Wiki.Render.Wiki;
with Wiki.Filters.Html;
with Wiki.Writers.Builders;
with Wiki.Utils;
package body Wiki.Writers.Tests is

   use Ada.Strings.Unbounded;
   use type Wiki.Parsers.Wiki_Syntax_Type;

   --  ------------------------------
   --  Test rendering a wiki text in HTML or text.
   --  ------------------------------
   procedure Test_Render (T : in out Test) is
      function To_Wide (Item : in String) return Wide_Wide_String
        renames Ada.Characters.Conversions.To_Wide_Wide_String;

      Result_File : constant String := To_String (T.Result);
      Content     : Unbounded_String;
   begin
      Util.Files.Read_File (Path     => To_String (T.File),
                            Into     => Content,
                            Max_Size => 10000);
      declare
         Time : Util.Measures.Stamp;
      begin
         if T.Source = Wiki.Parsers.SYNTAX_HTML then
            declare
               Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
               Writer      : aliased Wiki.Writers.Builders.Writer_Builder_Type;
               Renderer    : aliased Wiki.Render.Wiki.Wiki_Renderer;
            begin
               Renderer.Set_Writer (Writer'Unchecked_Access, T.Format);
               Html_Filter.Set_Document (Renderer'Unchecked_Access);
               Wiki.Parsers.Parse (Html_Filter'Unchecked_Access, To_Wide (To_String (Content)),
                                   Wiki.Parsers.SYNTAX_HTML);
               Content := To_Unbounded_String (Writer.To_String);
            end;
         elsif T.Is_Html then
            Content := To_Unbounded_String
              (Utils.To_Html (To_Wide (To_String (Content)), T.Format));
         else
            Content := To_Unbounded_String
              (Utils.To_Text (To_Wide (To_String (Content)), T.Format));
         end if;

         Util.Measures.Report (Time, "Render " & To_String (T.Name));
      end;

      Util.Files.Write_File (Result_File, Content);
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => To_String (T.Expect),
                                     Test    => Result_File,
                                     Message => "Render");
   end Test_Render;

   --  ------------------------------
   --  Test case name
   --  ------------------------------
   overriding
   function Name (T : in Test) return Util.Tests.Message_String is
   begin
      if T.Source = Wiki.Parsers.SYNTAX_HTML then
         return Util.Tests.Format ("Test IMPORT " & To_String (T.Name));
      elsif T.Is_Html then
         return Util.Tests.Format ("Test HTML " & To_String (T.Name));
      else
         return Util.Tests.Format ("Test TEXT " & To_String (T.Name));
      end if;
   end Name;

   --  ------------------------------
   --  Perform the test.
   --  ------------------------------
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Render;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;
      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Parsers.Wiki_Syntax_Type;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access;

      Result_Dir  : constant String := "regtests/result";
      Expect_Dir  : constant String := "regtests/expect";
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;

      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Parsers.Wiki_Syntax_Type;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access is
         Tst    : Test_Case_Access;
      begin
         Tst := new Test;
         Tst.Is_Html := Is_Html;
         Tst.Name    := To_Unbounded_String (Name);
         Tst.File    := To_Unbounded_String (Path);
         Tst.Expect  := To_Unbounded_String (Expect_Path & Prefix & Name);
         Tst.Result  := To_Unbounded_String (Result_Path & Prefix & Name);
         Tst.Format  := Format;
         Tst.Source  := Format;
         return Tst;
      end Create_Test;

      procedure Add_Wiki_Tests is
         Dir         : constant String := "regtests/files/wiki";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Ext    : constant String := Ada.Directories.Extension (Simple);
               Tst    : Test_Case_Access;
               Format : Wiki.Parsers.Wiki_Syntax_Type;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  if Ext = "wiki" then
                     Format := Wiki.Parsers.SYNTAX_GOOGLE;
                  elsif Ext = "dotclear" then
                     Format := Wiki.Parsers.SYNTAX_DOTCLEAR;
                  elsif Ext = "creole" then
                     Format := Wiki.Parsers.SYNTAX_CREOLE;
                  elsif Ext = "phpbb" then
                     Format := Wiki.Parsers.SYNTAX_PHPBB;
                  elsif Ext = "mediawiki" then
                     Format := Wiki.Parsers.SYNTAX_MEDIA_WIKI;
                  else
                     Format := Wiki.Parsers.SYNTAX_MIX;
                  end if;

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-html/", True);
                  Suite.Add_Test (Tst.all'Access);

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-txt/", False);
                  Suite.Add_Test (Tst.all'Access);
               end if;
            end;
         end loop;
      end Add_Wiki_Tests;

      procedure Add_Import_Tests is
         Dir         : constant String := "regtests/files/html";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Name   : constant String := Base_Name (Simple);
               Tst    : Test_Case_Access;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  for Syntax in Wiki.Parsers.Wiki_Syntax_Type'Range loop
                     case Syntax is
                        when Wiki.Parsers.SYNTAX_CREOLE =>
                           Tst := Create_Test (Name & ".creole", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.Parsers.SYNTAX_DOTCLEAR =>
                           Tst := Create_Test (Name & ".dotclear", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.Parsers.SYNTAX_MEDIA_WIKI =>
                           Tst := Create_Test (Name & ".mediawiki", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when others =>
                           Tst := null;

                     end case;
                     if Tst /= null then
                        Tst.Source := Wiki.Parsers.SYNTAX_HTML;
                        Suite.Add_Test (Tst.all'Access);
                     end if;
                  end loop;
               end if;
            end;
         end loop;
      end Add_Import_Tests;

   begin
      Add_Wiki_Tests;
      Add_Import_Tests;
   end Add_Tests;

end Wiki.Writers.Tests;

-----------------------------------------------------------------------
--  Render Tests - Unit tests for AWA Wiki rendering
--  Copyright (C) 2013, 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 Ada.Text_IO;
with Ada.Directories;
with Ada.Characters.Conversions;

with Util.Files;
with Util.Measures;

with Wiki.Render.Wiki;
with Wiki.Filters.Html;
with Wiki.Writers.Builders;
with Wiki.Utils;
package body Wiki.Writers.Tests is

   use Ada.Strings.Unbounded;
   use type Wiki.Parsers.Wiki_Syntax_Type;

   --  ------------------------------
   --  Test rendering a wiki text in HTML or text.
   --  ------------------------------
   procedure Test_Render (T : in out Test) is
      function To_Wide (Item : in String) return Wide_Wide_String
        renames Ada.Characters.Conversions.To_Wide_Wide_String;

      Result_File : constant String := To_String (T.Result);
      Content     : Unbounded_String;
   begin
      Util.Files.Read_File (Path     => To_String (T.File),
                            Into     => Content,
                            Max_Size => 10000);
      declare
         Time : Util.Measures.Stamp;
      begin
         if T.Source = Wiki.Parsers.SYNTAX_HTML then
            declare
               Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
               Writer      : aliased Wiki.Writers.Builders.Writer_Builder_Type;
               Renderer    : aliased Wiki.Render.Wiki.Wiki_Renderer;
            begin
               Renderer.Set_Writer (Writer'Unchecked_Access, T.Format);
               Html_Filter.Set_Document (Renderer'Unchecked_Access);
               Wiki.Parsers.Parse (Html_Filter'Unchecked_Access, To_Wide (To_String (Content)),
                                   Wiki.Parsers.SYNTAX_HTML);
               Content := To_Unbounded_String (Writer.To_String);
            end;
         elsif T.Is_Html then
            Content := To_Unbounded_String
              (Utils.To_Html (To_Wide (To_String (Content)), T.Format));
         else
            Content := To_Unbounded_String
              (Utils.To_Text (To_Wide (To_String (Content)), T.Format));
         end if;

         Util.Measures.Report (Time, "Render " & To_String (T.Name));
      end;

      Util.Files.Write_File (Result_File, Content);
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => To_String (T.Expect),
                                     Test    => Result_File,
                                     Message => "Render");
   end Test_Render;

   --  ------------------------------
   --  Test case name
   --  ------------------------------
   overriding
   function Name (T : in Test) return Util.Tests.Message_String is
   begin
      if T.Source = Wiki.Parsers.SYNTAX_HTML then
         return Util.Tests.Format ("Test IMPORT " & To_String (T.Name));
      elsif T.Is_Html then
         return Util.Tests.Format ("Test HTML " & To_String (T.Name));
      else
         return Util.Tests.Format ("Test TEXT " & To_String (T.Name));
      end if;
   end Name;

   --  ------------------------------
   --  Perform the test.
   --  ------------------------------
   overriding
   procedure Run_Test (T : in out Test) is
   begin
      T.Test_Render;
   end Run_Test;

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      use Ada.Directories;

      procedure Add_Import_Tests;
      procedure Add_Wiki_Tests;
      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Parsers.Wiki_Syntax_Type;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access;

      Result_Dir  : constant String := "regtests/result";
      Expect_Dir  : constant String := "regtests/expect";
      Expect_Path : constant String := Util.Tests.Get_Path (Expect_Dir);
      Result_Path : constant String := Util.Tests.Get_Test_Path (Result_Dir);
      Search      : Search_Type;
      Filter      : constant Filter_Type := (others => True);
      Ent         : Directory_Entry_Type;

      function Create_Test (Name    : in String;
                            Path    : in String;
                            Format  : in Wiki.Parsers.Wiki_Syntax_Type;
                            Prefix  : in String;
                            Is_Html : in Boolean) return Test_Case_Access is
         Tst    : Test_Case_Access;
      begin
         Tst := new Test;
         Tst.Is_Html := Is_Html;
         Tst.Name    := To_Unbounded_String (Name);
         Tst.File    := To_Unbounded_String (Path);
         Tst.Expect  := To_Unbounded_String (Expect_Path & Prefix & Name);
         Tst.Result  := To_Unbounded_String (Result_Path & Prefix & Name);
         Tst.Format  := Format;
         Tst.Source  := Format;
         return Tst;
      end Create_Test;

      procedure Add_Wiki_Tests is
         Dir         : constant String := "regtests/files/wiki";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Ext    : constant String := Ada.Directories.Extension (Simple);
               Tst    : Test_Case_Access;
               Format : Wiki.Parsers.Wiki_Syntax_Type;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  if Ext = "wiki" then
                     Format := Wiki.Parsers.SYNTAX_GOOGLE;
                  elsif Ext = "dotclear" then
                     Format := Wiki.Parsers.SYNTAX_DOTCLEAR;
                  elsif Ext = "creole" then
                     Format := Wiki.Parsers.SYNTAX_CREOLE;
                  elsif Ext = "phpbb" then
                     Format := Wiki.Parsers.SYNTAX_PHPBB;
                  elsif Ext = "mediawiki" then
                     Format := Wiki.Parsers.SYNTAX_MEDIA_WIKI;
                  else
                     Format := Wiki.Parsers.SYNTAX_MIX;
                  end if;

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-html/", True);
                  Suite.Add_Test (Tst.all'Access);

                  Tst := Create_Test (Simple, Path & "/" & Simple, Format, "/wiki-txt/", False);
                  Suite.Add_Test (Tst.all'Access);
               end if;
            end;
         end loop;
      end Add_Wiki_Tests;

      procedure Add_Import_Tests is
         Dir         : constant String := "regtests/files/html";
         Path        : constant String := Util.Tests.Get_Path (Dir);
      begin
         if Kind (Path) /= Directory then
            Ada.Text_IO.Put_Line ("Cannot read test directory: " & Path);
         end if;

         Start_Search (Search, Directory => Path, Pattern => "*.*", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Simple : constant String := Simple_Name (Ent);
               Name   : constant String := Base_Name (Simple);
               Tst    : Test_Case_Access;
            begin
               if Simple /= "." and then Simple /= ".."
                 and then Simple /= ".svn" and then Simple (Simple'Last) /= '~'
               then
                  for Syntax in Wiki.Parsers.Wiki_Syntax_Type'Range loop
                     case Syntax is
                        when Wiki.Parsers.SYNTAX_CREOLE =>
                           Tst := Create_Test (Name & ".creole", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.Parsers.SYNTAX_DOTCLEAR =>
                           Tst := Create_Test (Name & ".dotclear", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when Wiki.Parsers.SYNTAX_MEDIA_WIKI =>
                           Tst := Create_Test (Name & ".mediawiki", Path & "/" & Simple,
                                               Syntax, "/wiki-import/", True);

                        when others =>
                           Tst := null;

                     end case;
                     if Tst /= null then
                        Tst.Source := Wiki.Parsers.SYNTAX_HTML;
                        Suite.Add_Test (Tst.all'Access);
                     end if;
                  end loop;
               end if;
            end;
         end loop;
      end Add_Import_Tests;

   begin
      Add_Wiki_Tests;
      Add_Import_Tests;
   end Add_Tests;

end Wiki.Writers.Tests;

Fix compilation warning

Fix compilation warning