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

package body MAT.Consoles.Text is

   --  ------------------------------
   --  Print the field value for the given field.
   --  ------------------------------
   overriding
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in String) is
   begin
      Ada.Text_IO.Put (Value);
   end Print_Field;

   --  ------------------------------
   --  Print the title for the given field.
   --  ------------------------------
   overriding
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String) is
   begin
      Ada.Text_IO.Put (Title);
   end Print_Title;

   --  ------------------------------
   --  Start a new title in a report.
   --  ------------------------------
   overriding
   procedure Start_Title (Console : in out Console_Type) is
   begin
      null;
   end Start_Title;

   --  ------------------------------
   --  Start a new row in a report.
   --  ------------------------------
   overriding
   procedure Start_Row (Console : in out Console_Type) is
   begin
      null;
   end Start_Row;

   --  ------------------------------
   --  Finish a new row in a report.
   --  ------------------------------
   overriding
   procedure End_Row (Console : in out Console_Type) is
   begin
      Ada.Text_IO.New_Line;
   end End_Row;

end MAT.Consoles.Text;

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

package body MAT.Consoles.Text is

   --  ------------------------------
   --  Print the field value for the given field.
   --  ------------------------------
   overriding
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in String) is
   begin
      Ada.Text_IO.Put (Value);
   end Print_Field;

   --  ------------------------------
   --  Print the title for the given field.
   --  ------------------------------
   overriding
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String) is
   begin
      Ada.Text_IO.Put (Title);
   end Print_Title;

   --  ------------------------------
   --  Start a new title in a report.
   --  ------------------------------
   overriding
   procedure Start_Title (Console : in out Console_Type) is
   begin
      null;
   end Start_Title;

   --  ------------------------------
   --  Finish a new title in a report.
   --  ------------------------------
   procedure End_Title (Console : in out Console_Type) is
   begin
      Ada.Text_IO.New_Line;
   end End_Title;

   --  ------------------------------
   --  Start a new row in a report.
   --  ------------------------------
   overriding
   procedure Start_Row (Console : in out Console_Type) is
   begin
      null;
   end Start_Row;

   --  ------------------------------
   --  Finish a new row in a report.
   --  ------------------------------
   overriding
   procedure End_Row (Console : in out Console_Type) is
   begin
      Ada.Text_IO.New_Line;
   end End_Row;

end MAT.Consoles.Text;

Implement the End_Title procedure

Implement the End_Title procedure


-----------------------------------------------------------------------
--  awa-mail -- Mail module
--  Copyright (C) 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.Beans.Objects.Maps;

with ASF.Applications;

with AWA.Modules;
with AWA.Events;
with AWA.Mail.Clients;

--  == Documentation ==
--  The *mail* module allows an application to format and send a mail
--  to users.  This module does not define any web interface.  It provides
--  a set of services and methods to send a mail when an event is
--  received.  All this is done through configuration.  The module
--  defines a set of specific ASF components to format and prepare the
--  email.
--
--  == Configuration ==
--  The *mail* module needs some properties to configure the SMTP
--  server.
--
--  ||mail.smtp.host||localhost||Defines the SMTP server host name||
--  ||mail.smtp.port||25||Defines the SMTP connection port||
--  ||mail.smtp.enable||1|||Defines whether sending email is enabled or not||
--
--  == Sending an email ==
--  Sending an email when an event is posted can be done by using
--  an XML configuration.  Basically, the *mail* module uses the event
--  framework provided by AWA.  The XML definition looks like:
--
--    <on-event name="user-register">
--      <action>#{userMail.send}</action>
--      <property name="template">/mail/register-user-message.xhtml</property>
--    </on-event>
--
--  With this definition, the mail template `/mail/register-user-message.xhtml`
--  is formatted by using the event and application context when the
--  `user-register` event is posted.
--
--  @include awa-mail-components.ads
--  @include awa-mail-components-recipients.ads
--  @include awa-mail-components-messages.ads
--
--  == Ada Beans ==
--  @include mail.xml
--
package AWA.Mail.Modules is

   NAME : constant String := "mail";

   type Mail_Module is new AWA.Modules.Module with private;
   type Mail_Module_Access is access all Mail_Module'Class;

   --  Initialize the mail module.
   overriding
   procedure Initialize (Plugin : in out Mail_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Configures the module after its initialization and after having read its XML configuration.
   overriding
   procedure Configure (Plugin : in out Mail_Module;
                        Props  : in ASF.Applications.Config);

   --  Create a new mail message.
   function Create_Message (Plugin : in Mail_Module)
                            return AWA.Mail.Clients.Mail_Message_Access;

   --  Get the mail template that must be used for the given event name.
   --  The mail template is configured by the property: module.template.event.
   function Get_Template (Plugin : in Mail_Module;
                          Name   : in String) return String;

   --  Format and send an email.
   procedure Send_Mail (Plugin   : in Mail_Module;
                        Template : in String;
                        Props    : in Util.Beans.Objects.Maps.Map;
                        Content  : in AWA.Events.Module_Event'Class);

   --  Get the mail module instance associated with the current application.
   function Get_Mail_Module return Mail_Module_Access;

private

   type Mail_Module is new AWA.Modules.Module with record
      Mailer : AWA.Mail.Clients.Mail_Manager_Access;
   end record;

end AWA.Mail.Modules;

-----------------------------------------------------------------------
--  awa-mail -- Mail module
--  Copyright (C) 2011, 2012, 2017 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.Beans.Objects.Maps;

with ASF.Applications;

with AWA.Modules;
with AWA.Events;
with AWA.Mail.Clients;

--  == Documentation ==
--  The *mail* module allows an application to format and send a mail
--  to users.  This module does not define any web interface.  It provides
--  a set of services and methods to send a mail when an event is
--  received.  All this is done through configuration.  The module
--  defines a set of specific ASF components to format and prepare the
--  email.
--
--  == Configuration ==
--  The *mail* module needs some properties to configure the SMTP
--  server.
--
--  ||mail.smtp.host||localhost||Defines the SMTP server host name||
--  ||mail.smtp.port||25||Defines the SMTP connection port||
--  ||mail.smtp.enable||1|||Defines whether sending email is enabled or not||
--
--  == Sending an email ==
--  Sending an email when an event is posted can be done by using
--  an XML configuration.  Basically, the *mail* module uses the event
--  framework provided by AWA.  The XML definition looks like:
--
--    <on-event name="user-register">
--      <action>#{userMail.send}</action>
--      <property name="template">/mail/register-user-message.xhtml</property>
--    </on-event>
--
--  With this definition, the mail template `/mail/register-user-message.xhtml`
--  is formatted by using the event and application context when the
--  `user-register` event is posted.
--
--  @include awa-mail-components.ads
--  @include awa-mail-components-recipients.ads
--  @include awa-mail-components-messages.ads
--
--  == Ada Beans ==
--  @include mail.xml
--
package AWA.Mail.Modules is

   NAME : constant String := "mail";

   type Mail_Module is new AWA.Modules.Module with private;
   type Mail_Module_Access is access all Mail_Module'Class;

   --  Initialize the mail module.
   overriding
   procedure Initialize (Plugin : in out Mail_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Configures the module after its initialization and after having read its XML configuration.
   overriding
   procedure Configure (Plugin : in out Mail_Module;
                        Props  : in ASF.Applications.Config);

   --  Create a new mail message.
   function Create_Message (Plugin : in Mail_Module)
                            return AWA.Mail.Clients.Mail_Message_Access;

   --  Format and send an email.
   procedure Send_Mail (Plugin   : in Mail_Module;
                        Template : in String;
                        Props    : in Util.Beans.Objects.Maps.Map;
                        Content  : in AWA.Events.Module_Event'Class);

   --  Get the mail module instance associated with the current application.
   function Get_Mail_Module return Mail_Module_Access;

private

   type Mail_Module is new AWA.Modules.Module with record
      Mailer : AWA.Mail.Clients.Mail_Manager_Access;
   end record;

end AWA.Mail.Modules;

Remove the Get_Template function that is not used


-----------------------------------------------------------------------
--  util-texts-builders_tests -- Unit tests for text builders
--  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.Strings.Unbounded;
with Ada.Text_IO;

with Util.Test_Caller;
with Util.Texts.Builders;
with Util.Measures;

package body Util.Texts.Builders_Tests is

   package String_Builder is new Util.Texts.Builders (Element_Type => Character,
                                                      Input        => String,
                                                      Chunk_Size   => 100);

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Length",
                       Test_Length'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Append",
                       Test_Append'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Clear",
                       Test_Clear'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Iterate",
                       Test_Iterate'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Tail",
                       Test_Tail'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Perf",
                       Test_Perf'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the length operation.
   --  ------------------------------
   procedure Test_Length (T : in out Test) is
      B : String_Builder.Builder (10);
   begin
      Util.Tests.Assert_Equals (T, 0, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, 10, String_Builder.Capacity (B), "Invalid capacity");
   end Test_Length;

   --  ------------------------------
   --  Test the append operation.
   --  ------------------------------
   procedure Test_Append (T : in out Test) is
      S : constant String := "0123456789";
      B : String_Builder.Builder (3);
   begin
      String_Builder.Append (B, "a string");
      Util.Tests.Assert_Equals (T, 8, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, "a string", String_Builder.To_Array (B), "Invalid content");
      Util.Tests.Assert_Equals (T, 100 + 3, String_Builder.Capacity (B), "Invalid capacity");

      --  Append new string and check content.
      String_Builder.Append (B, " b string");
      Util.Tests.Assert_Equals (T, 17, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, "a string b string", String_Builder.To_Array (B),
                                "Invalid content");
      Util.Tests.Assert_Equals (T, 100 + 3, String_Builder.Capacity (B), "Invalid capacity");

      String_Builder.Clear (B);
      for I in S'Range loop
         String_Builder.Append (B, S (I));
      end loop;
      Util.Tests.Assert_Equals (T, 10, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, S, String_Builder.To_Array (B), "Invalid append");
   end Test_Append;

   --  ------------------------------
   --  Test the clear operation.
   --  ------------------------------
   procedure Test_Clear (T : in out Test) is
      B : String_Builder.Builder (7);
   begin
      for I in 1 .. 10 loop
         String_Builder.Append (B, "a string");
      end loop;
      Util.Tests.Assert_Equals (T, 8 * 10, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, 100 + 7, String_Builder.Capacity (B), "Invalid capacity");

      String_Builder.Clear (B);
      Util.Tests.Assert_Equals (T, 0, String_Builder.Length (B), "Invalid length after clear");
      Util.Tests.Assert_Equals (T, 7, String_Builder.Capacity (B), "Invalid capacity after clear");
   end Test_Clear;

   --  ------------------------------
   --  Test the tail operation.
   --  ------------------------------
   procedure Test_Tail (T : in out Test) is

      procedure Check_Tail (Min : in Positive;
                            Max : in Positive;
                            L   : in Natural);

      procedure Check_Tail (Min : in Positive;
                            Max : in Positive;
                            L   : in Natural) is
         P : constant String := "0123456789";
         B : String_Builder.Builder (Min);
      begin
         for I in 1 .. Max loop
            String_Builder.Append (B, P (1 + (I mod 10)));
         end loop;
         declare
            S  : constant String := String_Builder.Tail (B, L);
            S2 : constant String := String_Builder.To_Array (B);
         begin
            Util.Tests.Assert_Equals (T, Max, S2'Length, "Invalid length");
            if L >= Max then
               Util.Tests.Assert_Equals (T, S2, S, "Invalid Tail result");
            else
               Util.Tests.Assert_Equals (T, S2 (S2'Last - L + 1.. S2'Last), S,
                                         "Invalid Tail result {"
                                         & Positive'Image (Min) & ","
                                         & Positive'Image (Max) & ","
                                         & Positive'Image (L) & "]");
            end if;
         end;
      end Check_Tail;

   begin
      for I in 1 .. 100 loop
         for J in 1 .. 8 loop
            for K in 1 .. I + 3 loop
               Check_Tail (J, I, K);
            end loop;
         end loop;
      end loop;
   end Test_Tail;

   --  ------------------------------
   --  Test the iterate operation.
   --  ------------------------------
   procedure Test_Iterate (T : in out Test) is
      procedure Process (S : in String);

      B : String_Builder.Builder (13);
      R : Ada.Strings.Unbounded.Unbounded_String;

      procedure Process (S : in String) is
      begin
         Ada.Strings.Unbounded.Append (R, S);
      end Process;

   begin
      for I in 1 .. 100 loop
         String_Builder.Append (B, "The Iterate procedure avoids the string copy "
                                & "on the secondary stack");
      end loop;
      String_Builder.Iterate (B, Process'Access);
      Util.Tests.Assert_Equals (T, String_Builder.Length (B), Ada.Strings.Unbounded.Length (R),
                                "Invalid length in iterate string");
      Util.Tests.Assert_Equals (T, String_Builder.To_Array (B),
                                Ada.Strings.Unbounded.To_String (R), "Invalid Iterate");
   end Test_Iterate;

   --  ------------------------------
   --  Test the append and iterate performance.
   --  ------------------------------
   procedure Test_Perf (T : in out Test) is
      Perf : Ada.Text_IO.File_Type;
   begin
      Ada.Text_IO.Create (File => Perf,
                          Name => Util.Tests.Get_Test_Path ("string-append.csv"));
      Ada.Text_IO.Put_Line (Perf, "Block_Size,Append Time,To_Array Time,Iterate Time");
      for Block_Size in 1 .. 300 loop
         declare
            B : String_Builder.Builder (10);
            N : constant String := Natural'Image (Block_Size * 10) & ",";
         begin
            String_Builder.Set_Block_Size (B, Block_Size * 10);
            declare
               S : Util.Measures.Stamp;
            begin
               for I in 1 .. 1000 loop
                  String_Builder.Append (B, "some item");
               end loop;
               Util.Measures.Report (S, Perf, N, Util.Measures.Microseconds);
            end;
            declare
               S : Util.Measures.Stamp;
               R : constant String := String_Builder.To_Array (B);
            begin
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
               T.Assert (R'Length > 0, "Invalid string length");
            end;

            declare
               Count : Natural := 0;

               procedure Process (Item : in String);

               procedure Process (Item : in String) is
                  pragma Unreferenced (Item);
               begin
                  Count := Count + 1;
               end Process;

               S : Util.Measures.Stamp;
            begin
               String_Builder.Iterate (B, Process'Access);
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
               T.Assert (Count > 0, "The string builder was empty");
            end;
         end;
         Ada.Text_IO.New_Line (Perf);
      end loop;
      Ada.Text_IO.Close (Perf);

      Ada.Text_IO.Create (File => Perf,
                          Name => Util.Tests.Get_Test_Path ("string.csv"));
      Ada.Text_IO.Put_Line (Perf, "Size,Append (100),Append (512),"
                            & "Append (1024),Unbounded,Iterate Time");
      for I in 1 .. 4000 loop
         declare
            N  : constant String := Natural'Image (I) & ",";
            B  : String_Builder.Builder (10);
            B2 : String_Builder.Builder (10);
            B3 : String_Builder.Builder (10);
            U  : Ada.Strings.Unbounded.Unbounded_String;
            S  : Util.Measures.Stamp;
         begin
            for J in 1 .. I loop
               String_Builder.Append (B, "some item");
            end loop;
            Util.Measures.Report (S, Perf, N, Util.Measures.Microseconds);

            String_Builder.Set_Block_Size (B2, 512);
            for J in 1 .. I loop
               String_Builder.Append (B2, "some item");
            end loop;
            Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);

            String_Builder.Set_Block_Size (B3, 1024);
            for J in 1 .. I loop
               String_Builder.Append (B3, "some item");
            end loop;
            Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);

            for J in 1 .. I loop
               Ada.Strings.Unbounded.Append (U, "some item");
            end loop;
            Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);

            declare
               R : constant String := String_Builder.To_Array (B);
               pragma Unreferenced (R);
            begin
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
            end;

            declare
               R : constant String := Ada.Strings.Unbounded.To_String (U);
               pragma Unreferenced (R);
            begin
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
            end;
         end;
         Ada.Text_IO.New_Line (Perf);
      end loop;
   end Test_Perf;

end Util.Texts.Builders_Tests;

-----------------------------------------------------------------------
--  util-texts-builders_tests -- Unit tests for text builders
--  Copyright (C) 2013, 2016, 2017 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.Text_IO;

with Util.Test_Caller;
with Util.Texts.Builders;
with Util.Measures;

package body Util.Texts.Builders_Tests is

   package String_Builder is new Util.Texts.Builders (Element_Type => Character,
                                                      Input        => String,
                                                      Chunk_Size   => 100);

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Length",
                       Test_Length'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Append",
                       Test_Append'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Clear",
                       Test_Clear'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Iterate",
                       Test_Iterate'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Tail",
                       Test_Tail'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Perf",
                       Test_Perf'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the length operation.
   --  ------------------------------
   procedure Test_Length (T : in out Test) is
      B : String_Builder.Builder (10);
   begin
      Util.Tests.Assert_Equals (T, 0, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, 10, String_Builder.Capacity (B), "Invalid capacity");
   end Test_Length;

   --  ------------------------------
   --  Test the append operation.
   --  ------------------------------
   procedure Test_Append (T : in out Test) is
      S : constant String := "0123456789";
      B : String_Builder.Builder (3);
   begin
      String_Builder.Append (B, "a string");
      Util.Tests.Assert_Equals (T, 8, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, "a string", String_Builder.To_Array (B), "Invalid content");
      Util.Tests.Assert_Equals (T, 100 + 3, String_Builder.Capacity (B), "Invalid capacity");

      --  Append new string and check content.
      String_Builder.Append (B, " b string");
      Util.Tests.Assert_Equals (T, 17, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, "a string b string", String_Builder.To_Array (B),
                                "Invalid content");
      Util.Tests.Assert_Equals (T, 100 + 3, String_Builder.Capacity (B), "Invalid capacity");

      String_Builder.Clear (B);
      for I in S'Range loop
         String_Builder.Append (B, S (I));
      end loop;
      Util.Tests.Assert_Equals (T, 10, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, S, String_Builder.To_Array (B), "Invalid append");
   end Test_Append;

   --  ------------------------------
   --  Test the clear operation.
   --  ------------------------------
   procedure Test_Clear (T : in out Test) is
      B : String_Builder.Builder (7);
   begin
      for I in 1 .. 10 loop
         String_Builder.Append (B, "a string");
      end loop;
      Util.Tests.Assert_Equals (T, 8 * 10, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, 100 + 7, String_Builder.Capacity (B), "Invalid capacity");

      String_Builder.Clear (B);
      Util.Tests.Assert_Equals (T, 0, String_Builder.Length (B), "Invalid length after clear");
      Util.Tests.Assert_Equals (T, 7, String_Builder.Capacity (B), "Invalid capacity after clear");
   end Test_Clear;

   --  ------------------------------
   --  Test the tail operation.
   --  ------------------------------
   procedure Test_Tail (T : in out Test) is

      procedure Check_Tail (Min : in Positive;
                            Max : in Positive;
                            L   : in Natural);

      procedure Check_Tail (Min : in Positive;
                            Max : in Positive;
                            L   : in Natural) is
         P : constant String := "0123456789";
         B : String_Builder.Builder (Min);
      begin
         for I in 1 .. Max loop
            String_Builder.Append (B, P (1 + (I mod 10)));
         end loop;
         declare
            S  : constant String := String_Builder.Tail (B, L);
            S2 : constant String := String_Builder.To_Array (B);
         begin
            Util.Tests.Assert_Equals (T, Max, S2'Length, "Invalid length");
            if L >= Max then
               Util.Tests.Assert_Equals (T, S2, S, "Invalid Tail result");
            else
               Util.Tests.Assert_Equals (T, S2 (S2'Last - L + 1 .. S2'Last), S,
                                         "Invalid Tail result {"
                                         & Positive'Image (Min) & ","
                                         & Positive'Image (Max) & ","
                                         & Positive'Image (L) & "]");
            end if;
         end;
      end Check_Tail;

   begin
      for I in 1 .. 100 loop
         for J in 1 .. 8 loop
            for K in 1 .. I + 3 loop
               Check_Tail (J, I, K);
            end loop;
         end loop;
      end loop;
   end Test_Tail;

   --  ------------------------------
   --  Test the iterate operation.
   --  ------------------------------
   procedure Test_Iterate (T : in out Test) is
      procedure Process (S : in String);

      B : String_Builder.Builder (13);
      R : Ada.Strings.Unbounded.Unbounded_String;

      procedure Process (S : in String) is
      begin
         Ada.Strings.Unbounded.Append (R, S);
      end Process;

   begin
      for I in 1 .. 100 loop
         String_Builder.Append (B, "The Iterate procedure avoids the string copy "
                                & "on the secondary stack");
      end loop;
      String_Builder.Iterate (B, Process'Access);
      Util.Tests.Assert_Equals (T, String_Builder.Length (B), Ada.Strings.Unbounded.Length (R),
                                "Invalid length in iterate string");
      Util.Tests.Assert_Equals (T, String_Builder.To_Array (B),
                                Ada.Strings.Unbounded.To_String (R), "Invalid Iterate");
   end Test_Iterate;

   --  ------------------------------
   --  Test the append and iterate performance.
   --  ------------------------------
   procedure Test_Perf (T : in out Test) is
      Perf : Ada.Text_IO.File_Type;
   begin
      Ada.Text_IO.Create (File => Perf,
                          Name => Util.Tests.Get_Test_Path ("string-append.csv"));
      Ada.Text_IO.Put_Line (Perf, "Block_Size,Append Time,To_Array Time,Iterate Time");
      for Block_Size in 1 .. 300 loop
         declare
            B : String_Builder.Builder (10);
            N : constant String := Natural'Image (Block_Size * 10) & ",";
         begin
            String_Builder.Set_Block_Size (B, Block_Size * 10);
            declare
               S : Util.Measures.Stamp;
            begin
               for I in 1 .. 1000 loop
                  String_Builder.Append (B, "some item");
               end loop;
               Util.Measures.Report (S, Perf, N, Util.Measures.Microseconds);
            end;
            declare
               S : Util.Measures.Stamp;
               R : constant String := String_Builder.To_Array (B);
            begin
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
               T.Assert (R'Length > 0, "Invalid string length");
            end;

            declare
               Count : Natural := 0;

               procedure Process (Item : in String);

               procedure Process (Item : in String) is
                  pragma Unreferenced (Item);
               begin
                  Count := Count + 1;
               end Process;

               S : Util.Measures.Stamp;
            begin
               String_Builder.Iterate (B, Process'Access);
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
               T.Assert (Count > 0, "The string builder was empty");
            end;
         end;
         Ada.Text_IO.New_Line (Perf);
      end loop;
      Ada.Text_IO.Close (Perf);

      Ada.Text_IO.Create (File => Perf,
                          Name => Util.Tests.Get_Test_Path ("string.csv"));
      Ada.Text_IO.Put_Line (Perf, "Size,Append (100),Append (512),"
                            & "Append (1024),Unbounded,Iterate Time");
      for I in 1 .. 4000 loop
         declare
            N  : constant String := Natural'Image (I) & ",";
            B  : String_Builder.Builder (10);
            B2 : String_Builder.Builder (10);
            B3 : String_Builder.Builder (10);
            U  : Ada.Strings.Unbounded.Unbounded_String;
            S  : Util.Measures.Stamp;
         begin
            for J in 1 .. I loop
               String_Builder.Append (B, "some item");
            end loop;
            Util.Measures.Report (S, Perf, N, Util.Measures.Microseconds);

            String_Builder.Set_Block_Size (B2, 512);
            for J in 1 .. I loop
               String_Builder.Append (B2, "some item");
            end loop;
            Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);

            String_Builder.Set_Block_Size (B3, 1024);
            for J in 1 .. I loop
               String_Builder.Append (B3, "some item");
            end loop;
            Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);

            for J in 1 .. I loop
               Ada.Strings.Unbounded.Append (U, "some item");
            end loop;
            Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);

            declare
               R : constant String := String_Builder.To_Array (B);
               pragma Unreferenced (R);
            begin
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
            end;

            declare
               R : constant String := Ada.Strings.Unbounded.To_String (U);
               pragma Unreferenced (R);
            begin
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
            end;
         end;
         Ada.Text_IO.New_Line (Perf);
      end loop;
   end Test_Perf;

end Util.Texts.Builders_Tests;

Fix style compilation warning

Fix style compilation warning


-----------------------------------------------------------------------
--  gen-commands-docs -- Extract and generate documentation for the project
--  Copyright (C) 2012, 2015, 2017, 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 GNAT.Command_Line;

with Ada.Text_IO;
with Ada.Directories;

with Gen.Artifacts.Docs;
with Gen.Model.Packages;
package body Gen.Commands.Docs is

   use GNAT.Command_Line;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name, Args);

      Doc    : Gen.Artifacts.Docs.Artifact;
      M      : Gen.Model.Packages.Model_Definition;
      Arg1   : constant String := Get_Argument;
      Arg2   : constant String := Get_Argument;
      Footer : Boolean := True;
      Fmt    : Gen.Artifacts.Docs.Doc_Format := Gen.Artifacts.Docs.DOC_WIKI_GOOGLE;
   begin
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml", False);
      end if;

      if Arg1'Length = 0 then
         Generator.Error ("Missing target directory");
         return;
      elsif Arg1 (Arg1'First) /= '-' then
         if Arg2'Length /= 0 then
            Generator.Error ("Invalid markup option " & Arg1);
            return;
         end if;
         --  Setup the target directory where the distribution is created.
         Generator.Set_Result_Directory (Arg1);
      else
         if Arg1 = "-markdown" then
            Fmt := Gen.Artifacts.Docs.DOC_MARKDOWN;
         elsif Arg1 = "-google" then
            Fmt := Gen.Artifacts.Docs.DOC_WIKI_GOOGLE;
         elsif Arg1 = "-pandoc" then
            Fmt := Gen.Artifacts.Docs.DOC_MARKDOWN;
            Footer := False;
         else
            Generator.Error ("Invalid markup option " & Arg1);
            return;
         end if;
         if Arg2'Length = 0 then
            Generator.Error ("Missing target directory");
            return;
         end if;
         Generator.Set_Result_Directory (Arg2);
      end if;
      Doc.Set_Format (Fmt, Footer);
      Doc.Read_Links (Generator.Get_Project_Property ("links", "links.txt"));
      Doc.Prepare (M, Generator);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in out Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("build-doc: Extract and generate the project documentation");
      Put_Line ("Usage: build-doc [-markdown|-google|-pandoc] target-dir");
      New_Line;
      Put_Line ("  Extract the documentation from the project source files and generate the");
      Put_Line ("  project documentation.  The following files are scanned:");
      Put_Line ("    - Ada specifications (src/*.ads)");
      Put_Line ("    - XML configuration files (config/*.xml)");
      Put_Line ("    - XML database model files (db/*.xml)");
   end Help;

end Gen.Commands.Docs;

-----------------------------------------------------------------------
--  gen-commands-docs -- Extract and generate documentation for the project
--  Copyright (C) 2012, 2015, 2017, 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 GNAT.Command_Line;

with Ada.Text_IO;
with Ada.Directories;

with Gen.Artifacts.Docs;
with Gen.Model.Packages;
package body Gen.Commands.Docs is

   use GNAT.Command_Line;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name, Args);

      Doc    : Gen.Artifacts.Docs.Artifact;
      M      : Gen.Model.Packages.Model_Definition;
      Arg1   : constant String := Get_Argument;
      Arg2   : constant String := Get_Argument;
      Footer : Boolean := True;
      Fmt    : Gen.Artifacts.Docs.Doc_Format := Gen.Artifacts.Docs.DOC_WIKI_GOOGLE;
   begin
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml", False);
      end if;

      if Arg1'Length = 0 then
         Generator.Error ("Missing target directory");
         return;
      elsif Arg1 (Arg1'First) /= '-' then
         if Arg2'Length /= 0 then
            Generator.Error ("Invalid markup option " & Arg1);
            return;
         end if;
         --  Setup the target directory where the distribution is created.
         Generator.Set_Result_Directory (Arg1);
      else
         if Arg1 = "-markdown" then
            Fmt := Gen.Artifacts.Docs.DOC_MARKDOWN;
         elsif Arg1 = "-google" then
            Fmt := Gen.Artifacts.Docs.DOC_WIKI_GOOGLE;
         elsif Arg1 = "-pandoc" then
            Fmt := Gen.Artifacts.Docs.DOC_MARKDOWN;
            Footer := False;
         else
            Generator.Error ("Invalid markup option " & Arg1);
            return;
         end if;
         if Arg2'Length = 0 then
            Generator.Error ("Missing target directory");
            return;
         end if;
         Generator.Set_Result_Directory (Arg2);
      end if;
      Doc.Set_Format (Fmt, Footer);
      Doc.Read_Links (Generator.Get_Project_Property ("links", "links.txt"));
      Doc.Prepare (M, Generator);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in out Command;
                   Name      : in String;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("build-doc: Extract and generate the project documentation");
      Put_Line ("Usage: build-doc [-markdown|-google|-pandoc] target-dir");
      New_Line;
      Put_Line ("  Extract the documentation from the project source files and generate the");
      Put_Line ("  project documentation.  The following files are scanned:");
      Put_Line ("    - Ada specifications (src/*.ads)");
      Put_Line ("    - XML configuration files (config/*.xml)");
      Put_Line ("    - XML database model files (db/*.xml)");
   end Help;

end Gen.Commands.Docs;

Add Name parameter to the Help procedure


-----------------------------------------------------------------------
--  ASF tests - ASF Tests Framework
--  Copyright (C) 2011, 2012, 2013, 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 GNAT.Regpat;

with Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;

with Util.Files;

with ASF.Streams;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Servlets.Ajax;
with ASF.Servlets.Measures;
with ASF.Responses;
with ASF.Responses.Tools;

with ASF.Filters.Dump;
with ASF.Contexts.Faces;
with EL.Variables.Default;

package body ASF.Tests is

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

   CONTEXT_PATH : constant String := "/asfunit";

   Server   : access ASF.Server.Container;

   App      : ASF.Applications.Main.Application_Access := null;
   Faces    : aliased ASF.Servlets.Faces.Faces_Servlet;
   Files    : aliased ASF.Servlets.Files.File_Servlet;
   Ajax     : aliased ASF.Servlets.Ajax.Ajax_Servlet;
   Dump     : aliased ASF.Filters.Dump.Dump_Filter;
   Measures : aliased ASF.Servlets.Measures.Measure_Servlet;

   --  Save the response headers and content in a file
   procedure Save_Response (Name     : in String;
                            Response : in out ASF.Responses.Mockup.Response);

   --  ------------------------------
   --  Initialize the awa test framework mockup.
   --  ------------------------------
   procedure Initialize (Props       : in Util.Properties.Manager;
                         Application : in ASF.Applications.Main.Application_Access := null;
                         Factory     : in out ASF.Applications.Main.Application_Factory'Class) is
      use type ASF.Applications.Main.Application_Access;

      C        : ASF.Applications.Config;
   begin
      if Application /= null then
         App := Application;
      else
         App := new ASF.Applications.Main.Application;
      end if;

      Server := new ASF.Server.Container;
      Server.Register_Application (CONTEXT_PATH, App.all'Access);

      C.Copy (Props);
      App.Initialize (C, Factory);
      App.Register ("layoutMsg", "layout");
      App.Set_Global ("contextPath", CONTEXT_PATH);

      --  Register the servlets and filters
      App.Add_Servlet (Name => "faces", Server => Faces'Access);
      App.Add_Servlet (Name => "files", Server => Files'Access);
      App.Add_Servlet (Name => "ajax", Server => Ajax'Access);
      App.Add_Servlet (Name => "measures", Server => Measures'Access);
      App.Add_Filter (Name => "dump", Filter => Dump'Access);
      App.Add_Filter (Name => "measures", Filter => ASF.Filters.Filter'Class (Measures)'Access);

      --  Define servlet mappings
      App.Add_Mapping (Name => "faces", Pattern => "*.html");
      App.Add_Mapping (Name => "files", Pattern => "*.css");
      App.Add_Mapping (Name => "files", Pattern => "*.js");
      App.Add_Mapping (Name => "files", Pattern => "*.properties");
      App.Add_Mapping (Name => "files", Pattern => "*.xhtml");
      App.Add_Mapping (Name => "ajax", Pattern => "/ajax/*");
      App.Add_Mapping (Name => "measures", Pattern => "stats.xml");

      App.Add_Filter_Mapping (Name => "measures", Pattern => "*");
      App.Add_Filter_Mapping (Name => "measures", Pattern => "/ajax/*");
      App.Add_Filter_Mapping (Name => "measures", Pattern => "*.html");
      App.Add_Filter_Mapping (Name => "measures", Pattern => "*.xhtml");
      App.Add_Filter_Mapping (Name => "dump", Pattern => "*.html");
      App.Add_Filter_Mapping (Name => "dump", Pattern => "*.css");
      App.Add_Filter_Mapping (Name => "dump", Pattern => "/ajax/*");
   end Initialize;

   --  ------------------------------
   --  Get the server
   --  ------------------------------
   function Get_Server return access ASF.Server.Container is
   begin
      return Server;
   end Get_Server;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return ASF.Applications.Main.Application_Access is
   begin
      return App;
   end Get_Application;

   --  ------------------------------
   --  Save the response headers and content in a file
   --  ------------------------------
   procedure Save_Response (Name     : in String;
                            Response : in out ASF.Responses.Mockup.Response) is
      use ASF.Responses;

      Info        : constant String := Tools.To_String (Reply         => Response,
                                                        Html          => False,
                                                        Print_Headers => True);
      Result_Path : constant String := Util.Tests.Get_Test_Path ("regtests/result");
      Content     : Unbounded_String;
      Stream      : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
   begin
      Response.Read_Content (Content);
      Stream.Write (Content);

      Insert (Content, 1, Info);
      Util.Files.Write_File (Result_Path & "/" & Name, Content);

   end Save_Response;

   --  ------------------------------
   --  Simulate a raw request.  The URI and method must have been set on the Request object.
   --  ------------------------------
   procedure Do_Req (Request  : in out ASF.Requests.Mockup.Request;
                     Response : in out ASF.Responses.Mockup.Response) is
   begin
      --  For the purpose of writing tests, clear the buffer before invoking the service.
      Response.Clear;
      Server.Service (Request  => Request,
                      Response => Response);
   end Do_Req;

   --  ------------------------------
   --  Simulate a GET request on the given URI with the request parameters.
   --  Get the result in the response object.
   --  ------------------------------
   procedure Do_Get (Request  : in out ASF.Requests.Mockup.Request;
                     Response : in out ASF.Responses.Mockup.Response;
                     URI      : in String;
                     Save     : in String := "") is
   begin
      Request.Set_Method (Method => "GET");
      Request.Set_Request_URI (URI => CONTEXT_PATH & URI);
      Request.Set_Protocol (Protocol => "HTTP/1.1");
      Do_Req (Request, Response);

      if Save'Length > 0 then
         Save_Response (Save, Response);
      end if;
   end Do_Get;

   --  ------------------------------
   --  Simulate a POST request on the given URI with the request parameters.
   --  Get the result in the response object.
   --  ------------------------------
   procedure Do_Post (Request  : in out ASF.Requests.Mockup.Request;
                      Response : in out ASF.Responses.Mockup.Response;
                      URI      : in String;
                      Save     : in String := "") is
   begin
      Request.Set_Method (Method => "POST");
      Request.Set_Request_URI (URI => CONTEXT_PATH & URI);
      Request.Set_Protocol (Protocol => "HTTP/1.1");
      Do_Req (Request, Response);

      if Save'Length > 0 then
         Save_Response (Save, Response);
      end if;
   end Do_Post;

   --  ------------------------------
   --  Check that the response body contains the string
   --  ------------------------------
   procedure Assert_Contains (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line) is
      Stream  : ASF.Streams.Print_Stream := Reply.Get_Output_Stream;
      Content : Unbounded_String;
   begin
      Reply.Read_Content (Content);
      Stream.Write (Content);

      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response", Source, Line);

      T.Assert (Condition => Index (Content, Value) > 0,
                Message   => Message & ": value '" & Value & "' not found",
                Source    => Source,
                Line      => Line);
   end Assert_Contains;

   --  ------------------------------
   --  Check that the response body matches the regular expression
   --  ------------------------------
   procedure Assert_Matches (T       : in Util.Tests.Test'Class;
                             Pattern : in String;
                             Reply   : in out ASF.Responses.Mockup.Response;
                             Message : in String := "Test failed";
                             Status  : in Natural := ASF.Responses.SC_OK;
                             Source  : String := GNAT.Source_Info.File;
                             Line    : Natural := GNAT.Source_Info.Line) is
      use GNAT.Regpat;

      Stream  : ASF.Streams.Print_Stream := Reply.Get_Output_Stream;
      Content : Unbounded_String;
      Regexp  : constant Pattern_Matcher := Compile (Expression => Pattern,
                                                     Flags      => Multiple_Lines);
   begin
      Reply.Read_Content (Content);
      Stream.Write (Content);

      Assert_Equals (T, Status, Reply.Get_Status, "Invalid response", Source, Line);

      T.Assert (Condition => Match (Regexp, To_String (Content)),
                Message   => Message & ": does not match '" & Pattern & "'",
                Source    => Source,
                Line      => Line);
   end Assert_Matches;

   --  ------------------------------
   --  Check that the response contains the given header.
   --  ------------------------------
   procedure Assert_Header (T       : in Util.Tests.Test'Class;
                            Header  : in String;
                            Value   : in String;
                            Reply   : in out ASF.Responses.Mockup.Response;
                            Message : in String := "Test failed";
                            Status  : in Natural := ASF.Responses.SC_OK;
                            Source  : String := GNAT.Source_Info.File;
                            Line    : Natural := GNAT.Source_Info.Line) is
   begin
      T.Assert (Condition => Reply.Contains_Header (Header),
                Message   => Message & ": missing header '" & Header & "'",
                Source    => Source,
                Line      => Line);
      Assert_Equals (T, Value, Reply.Get_Header (Header), Message, Source, Line);
   end Assert_Header;

   --  ------------------------------
   --  Check that the response body is a redirect to the given URI.
   --  ------------------------------
   procedure Assert_Redirect (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line) is
   begin
      Assert_Equals (T, ASF.Responses.SC_MOVED_TEMPORARILY, Reply.Get_Status,
                     "Invalid response", Source, Line);

      Util.Tests.Assert_Equals (T, Value, Reply.Get_Header ("Location"),
                                Message & ": missing Location",
                                Source, Line);
   end Assert_Redirect;

   --  ------------------------------
   --  Cleanup the test instance.
   --  ------------------------------
   overriding
   procedure Tear_Down (T : in out EL_Test) is
      procedure Free is
        new Ada.Unchecked_Deallocation (EL.Contexts.Default.Default_Context'Class,
                                        EL.Contexts.Default.Default_Context_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (EL.Variables.Variable_Mapper'Class,
                                        EL.Variables.Variable_Mapper_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (EL.Contexts.Default.Default_ELResolver'Class,
                                        EL.Contexts.Default.Default_ELResolver_Access);
   begin
      ASF.Contexts.Faces.Restore (null);
      Free (T.ELContext);
      Free (T.Variables);
      Free (T.Root_Resolver);
   end Tear_Down;

   --  ------------------------------
   --  Setup the test instance.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out EL_Test) is
   begin
      T.ELContext     := new EL.Contexts.Default.Default_Context;
      T.Root_Resolver := new EL.Contexts.Default.Default_ELResolver;
      T.Variables     := new EL.Variables.Default.Default_Variable_Mapper;
      T.ELContext.Set_Resolver (T.Root_Resolver.all'Access);
      T.ELContext.Set_Variable_Mapper (T.Variables.all'Access);
   end Set_Up;

end ASF.Tests;

-----------------------------------------------------------------------
--  ASF tests - ASF Tests Framework
--  Copyright (C) 2011, 2012, 2013, 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 GNAT.Regpat;

with Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;

with Util.Files;

with ASF.Streams;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Servlets.Ajax;
with ASF.Servlets.Measures;
with ASF.Responses;
with ASF.Responses.Tools;

with ASF.Filters.Dump;
with ASF.Contexts.Faces;
with EL.Variables.Default;

package body ASF.Tests is

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

   CONTEXT_PATH : constant String := "/asfunit";

   type Container_Access is access ASF.Server.Container;

   Server      : Container_Access;

   App_Created : ASF.Applications.Main.Application_Access;
   App         : ASF.Applications.Main.Application_Access;
   Faces       : aliased ASF.Servlets.Faces.Faces_Servlet;
   Files       : aliased ASF.Servlets.Files.File_Servlet;
   Ajax        : aliased ASF.Servlets.Ajax.Ajax_Servlet;
   Dump        : aliased ASF.Filters.Dump.Dump_Filter;
   Measures    : aliased ASF.Servlets.Measures.Measure_Servlet;

   --  Save the response headers and content in a file
   procedure Save_Response (Name     : in String;
                            Response : in out ASF.Responses.Mockup.Response);

   --  ------------------------------
   --  Initialize the awa test framework mockup.
   --  ------------------------------
   procedure Initialize (Props       : in Util.Properties.Manager;
                         Application : in ASF.Applications.Main.Application_Access := null;
                         Factory     : in out ASF.Applications.Main.Application_Factory'Class) is
      use type ASF.Applications.Main.Application_Access;

      C        : ASF.Applications.Config;
   begin
      if Application /= null then
         App := Application;
      else
         if App_Created = null then
            App_Created := new ASF.Applications.Main.Application;
         end if;
         App := App_Created;
      end if;

      Server := new ASF.Server.Container;
      Server.Register_Application (CONTEXT_PATH, App.all'Access);

      C.Copy (Props);
      App.Initialize (C, Factory);
      App.Register ("layoutMsg", "layout");
      App.Set_Global ("contextPath", CONTEXT_PATH);

      --  Register the servlets and filters
      App.Add_Servlet (Name => "faces", Server => Faces'Access);
      App.Add_Servlet (Name => "files", Server => Files'Access);
      App.Add_Servlet (Name => "ajax", Server => Ajax'Access);
      App.Add_Servlet (Name => "measures", Server => Measures'Access);
      App.Add_Filter (Name => "dump", Filter => Dump'Access);
      App.Add_Filter (Name => "measures", Filter => ASF.Filters.Filter'Class (Measures)'Access);

      --  Define servlet mappings
      App.Add_Mapping (Name => "faces", Pattern => "*.html");
      App.Add_Mapping (Name => "files", Pattern => "*.css");
      App.Add_Mapping (Name => "files", Pattern => "*.js");
      App.Add_Mapping (Name => "files", Pattern => "*.properties");
      App.Add_Mapping (Name => "files", Pattern => "*.xhtml");
      App.Add_Mapping (Name => "ajax", Pattern => "/ajax/*");
      App.Add_Mapping (Name => "measures", Pattern => "stats.xml");

      App.Add_Filter_Mapping (Name => "measures", Pattern => "*");
      App.Add_Filter_Mapping (Name => "measures", Pattern => "/ajax/*");
      App.Add_Filter_Mapping (Name => "measures", Pattern => "*.html");
      App.Add_Filter_Mapping (Name => "measures", Pattern => "*.xhtml");
      App.Add_Filter_Mapping (Name => "dump", Pattern => "*.html");
      App.Add_Filter_Mapping (Name => "dump", Pattern => "*.css");
      App.Add_Filter_Mapping (Name => "dump", Pattern => "/ajax/*");
   end Initialize;

   --  ------------------------------
   --  Called when the testsuite execution has finished.
   --  ------------------------------
   procedure Finish (Status : in Util.XUnit.Status) is
      pragma Unreferenced (Status);

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => ASF.Applications.Main.Application'Class,
                                        Name   => ASF.Applications.Main.Application_Access);

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => ASF.Server.Container,
                                        Name   => Container_Access);

   begin
      Free (App_Created);
      Free (Server);
   end Finish;

   --  ------------------------------
   --  Get the server
   --  ------------------------------
   function Get_Server return access ASF.Server.Container is
   begin
      return Server;
   end Get_Server;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return ASF.Applications.Main.Application_Access is
   begin
      return App;
   end Get_Application;

   --  ------------------------------
   --  Save the response headers and content in a file
   --  ------------------------------
   procedure Save_Response (Name     : in String;
                            Response : in out ASF.Responses.Mockup.Response) is
      use ASF.Responses;

      Info        : constant String := Tools.To_String (Reply         => Response,
                                                        Html          => False,
                                                        Print_Headers => True);
      Result_Path : constant String := Util.Tests.Get_Test_Path ("regtests/result");
      Content     : Unbounded_String;
      Stream      : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
   begin
      Response.Read_Content (Content);
      Stream.Write (Content);

      Insert (Content, 1, Info);
      Util.Files.Write_File (Result_Path & "/" & Name, Content);

   end Save_Response;

   --  ------------------------------
   --  Simulate a raw request.  The URI and method must have been set on the Request object.
   --  ------------------------------
   procedure Do_Req (Request  : in out ASF.Requests.Mockup.Request;
                     Response : in out ASF.Responses.Mockup.Response) is
   begin
      --  For the purpose of writing tests, clear the buffer before invoking the service.
      Response.Clear;
      Server.Service (Request  => Request,
                      Response => Response);
   end Do_Req;

   --  ------------------------------
   --  Simulate a GET request on the given URI with the request parameters.
   --  Get the result in the response object.
   --  ------------------------------
   procedure Do_Get (Request  : in out ASF.Requests.Mockup.Request;
                     Response : in out ASF.Responses.Mockup.Response;
                     URI      : in String;
                     Save     : in String := "") is
   begin
      Request.Set_Method (Method => "GET");
      Request.Set_Request_URI (URI => CONTEXT_PATH & URI);
      Request.Set_Protocol (Protocol => "HTTP/1.1");
      Do_Req (Request, Response);

      if Save'Length > 0 then
         Save_Response (Save, Response);
      end if;
   end Do_Get;

   --  ------------------------------
   --  Simulate a POST request on the given URI with the request parameters.
   --  Get the result in the response object.
   --  ------------------------------
   procedure Do_Post (Request  : in out ASF.Requests.Mockup.Request;
                      Response : in out ASF.Responses.Mockup.Response;
                      URI      : in String;
                      Save     : in String := "") is
   begin
      Request.Set_Method (Method => "POST");
      Request.Set_Request_URI (URI => CONTEXT_PATH & URI);
      Request.Set_Protocol (Protocol => "HTTP/1.1");
      Do_Req (Request, Response);

      if Save'Length > 0 then
         Save_Response (Save, Response);
      end if;
   end Do_Post;

   --  ------------------------------
   --  Check that the response body contains the string
   --  ------------------------------
   procedure Assert_Contains (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line) is
      Stream  : ASF.Streams.Print_Stream := Reply.Get_Output_Stream;
      Content : Unbounded_String;
   begin
      Reply.Read_Content (Content);
      Stream.Write (Content);

      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response", Source, Line);

      T.Assert (Condition => Index (Content, Value) > 0,
                Message   => Message & ": value '" & Value & "' not found",
                Source    => Source,
                Line      => Line);
   end Assert_Contains;

   --  ------------------------------
   --  Check that the response body matches the regular expression
   --  ------------------------------
   procedure Assert_Matches (T       : in Util.Tests.Test'Class;
                             Pattern : in String;
                             Reply   : in out ASF.Responses.Mockup.Response;
                             Message : in String := "Test failed";
                             Status  : in Natural := ASF.Responses.SC_OK;
                             Source  : String := GNAT.Source_Info.File;
                             Line    : Natural := GNAT.Source_Info.Line) is
      use GNAT.Regpat;

      Stream  : ASF.Streams.Print_Stream := Reply.Get_Output_Stream;
      Content : Unbounded_String;
      Regexp  : constant Pattern_Matcher := Compile (Expression => Pattern,
                                                     Flags      => Multiple_Lines);
   begin
      Reply.Read_Content (Content);
      Stream.Write (Content);

      Assert_Equals (T, Status, Reply.Get_Status, "Invalid response", Source, Line);

      T.Assert (Condition => Match (Regexp, To_String (Content)),
                Message   => Message & ": does not match '" & Pattern & "'",
                Source    => Source,
                Line      => Line);
   end Assert_Matches;

   --  ------------------------------
   --  Check that the response contains the given header.
   --  ------------------------------
   procedure Assert_Header (T       : in Util.Tests.Test'Class;
                            Header  : in String;
                            Value   : in String;
                            Reply   : in out ASF.Responses.Mockup.Response;
                            Message : in String := "Test failed";
                            Status  : in Natural := ASF.Responses.SC_OK;
                            Source  : String := GNAT.Source_Info.File;
                            Line    : Natural := GNAT.Source_Info.Line) is
   begin
      T.Assert (Condition => Reply.Contains_Header (Header),
                Message   => Message & ": missing header '" & Header & "'",
                Source    => Source,
                Line      => Line);
      Assert_Equals (T, Value, Reply.Get_Header (Header), Message, Source, Line);
   end Assert_Header;

   --  ------------------------------
   --  Check that the response body is a redirect to the given URI.
   --  ------------------------------
   procedure Assert_Redirect (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line) is
   begin
      Assert_Equals (T, ASF.Responses.SC_MOVED_TEMPORARILY, Reply.Get_Status,
                     "Invalid response", Source, Line);

      Util.Tests.Assert_Equals (T, Value, Reply.Get_Header ("Location"),
                                Message & ": missing Location",
                                Source, Line);
   end Assert_Redirect;

   --  ------------------------------
   --  Cleanup the test instance.
   --  ------------------------------
   overriding
   procedure Tear_Down (T : in out EL_Test) is
      procedure Free is
        new Ada.Unchecked_Deallocation (EL.Contexts.Default.Default_Context'Class,
                                        EL.Contexts.Default.Default_Context_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (EL.Variables.Variable_Mapper'Class,
                                        EL.Variables.Variable_Mapper_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (EL.Contexts.Default.Default_ELResolver'Class,
                                        EL.Contexts.Default.Default_ELResolver_Access);
   begin
      ASF.Contexts.Faces.Restore (null);
      Free (T.ELContext);
      Free (T.Variables);
      Free (T.Root_Resolver);
   end Tear_Down;

   --  ------------------------------
   --  Setup the test instance.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out EL_Test) is
   begin
      T.ELContext     := new EL.Contexts.Default.Default_Context;
      T.Root_Resolver := new EL.Contexts.Default.Default_ELResolver;
      T.Variables     := new EL.Variables.Default.Default_Variable_Mapper;
      T.ELContext.Set_Resolver (T.Root_Resolver.all'Access);
      T.ELContext.Set_Variable_Mapper (T.Variables.all'Access);
   end Set_Up;

end ASF.Tests;

Implement the Finish procedure to release the application and server container


-----------------------------------------------------------------------
--  druss-tools -- Druss main tool
--  Copyright (C) 2017 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 GNAT.Command_Line;  use GNAT.Command_Line;
with Ada.Command_Line;
with Ada.Text_IO;
with Ada.Exceptions;
with Ada.Strings.Unbounded;
with Util.Commands;
with Util.Http.Clients.Curl;
with Util.Log.Loggers;
with Util.Properties;
with Druss.Config;
with Druss.Commands;
procedure Druss.Tools is

   use Ada.Text_IO;
   use Ada.Strings.Unbounded;

   Log_Config : Util.Properties.Manager;
   Config     : Ada.Strings.Unbounded.Unbounded_String;
   Output     : Ada.Strings.Unbounded.Unbounded_String;
   Debug      : Boolean := False;
   Verbose    : Boolean := False;
   First      : Natural := 0;
   All_Args   : Util.Commands.Default_Argument_List (0);
   Console    : aliased Druss.Commands.Text_Consoles.Console_Type;
begin
   Log_Config.Set ("log4j.rootCategory", "DEBUG,console");
   Log_Config.Set ("log4j.appender.console", "Console");
   Log_Config.Set ("log4j.appender.console.level", "ERROR");
   Log_Config.Set ("log4j.appender.console.layout", "level-message");
   Log_Config.Set ("log4j.appender.stdout", "Console");
   Log_Config.Set ("log4j.appender.stdout.level", "INFO");
   Log_Config.Set ("log4j.appender.stdout.layout", "message");
   Log_Config.Set ("log4j.logger.Util", "WARN");

   Util.Log.Loggers.Initialize (Log_Config);
   Druss.Commands.Initialize;
   Initialize_Option_Scan (Stop_At_First_Non_Switch => True, Section_Delimiters => "targs");
   --  Parse the command line
   loop
      case Getopt ("* v d o: c:") is
         when ASCII.NUL => exit;

         when 'c' =>
            Config := Ada.Strings.Unbounded.To_Unbounded_String (Parameter);

         when 'o' =>
            Output := Ada.Strings.Unbounded.To_Unbounded_String (Parameter);

         when 'd' =>
            Debug := True;

         when 'v' =>
            Verbose := True;

         when '*' =>
            exit;

         when others =>
            null;
      end case;
      First := First + 1;
   end loop;
   if Verbose then
      Log_Config.Set ("log4j.appender.console.level", "INFO");
   end if;
   if Debug then
      Log_Config.Set ("log4j.appender.console.level", "DEBUG");
   end if;
   Util.Log.Loggers.Initialize (Log_Config);
   Druss.Config.Initialize (To_String (Config));
   Util.Http.Clients.Curl.Register;
   if First >= Ada.Command_Line.Argument_Count then
      Ada.Text_IO.Put_Line ("Missing command name to execute.");
      Druss.Commands.Driver.Usage (All_Args);
      Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
      return;
   end if;
   declare
      Cmd_Name : constant String := Full_Switch;
      Args     : Util.Commands.Default_Argument_List (First + 1);
      Ctx      : Druss.Commands.Context_Type;
   begin
      Ctx.Console := Console'Unchecked_Access;
      Druss.Config.Get_Gateways (Ctx.Gateways);
      Druss.Commands.Driver.Execute (Cmd_Name, Args, Ctx);
   end;

exception
   when E : Invalid_Switch =>
      Ada.Text_IO.Put_Line ("Invalid option: " & Ada.Exceptions.Exception_Message (E));
      Ada.Command_Line.Set_Exit_Status (2);

end Druss.Tools;

-----------------------------------------------------------------------
--  druss-tools -- Druss main tool
--  Copyright (C) 2017 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 GNAT.Command_Line;  use GNAT.Command_Line;
with Ada.Command_Line;
with Ada.Text_IO;
with Ada.Exceptions;
with Ada.Strings.Unbounded;
with Util.Commands;
with Util.Http.Clients.Curl;
with Util.Log.Loggers;
with Util.Properties;
with Druss.Config;
with Druss.Commands;
procedure Druss.Tools is

   use Ada.Text_IO;
   use Ada.Strings.Unbounded;

   Log_Config : Util.Properties.Manager;
   Config     : Ada.Strings.Unbounded.Unbounded_String;
   Output     : Ada.Strings.Unbounded.Unbounded_String;
   Debug      : Boolean := False;
   Verbose    : Boolean := False;
   First      : Natural := 0;
   All_Args   : Util.Commands.Default_Argument_List (0);
   Console    : aliased Druss.Commands.Text_Consoles.Console_Type;
begin
   Log_Config.Set ("log4j.rootCategory", "DEBUG,console");
   Log_Config.Set ("log4j.appender.console", "Console");
   Log_Config.Set ("log4j.appender.console.level", "ERROR");
   Log_Config.Set ("log4j.appender.console.layout", "level-message");
   Log_Config.Set ("log4j.appender.stdout", "Console");
   Log_Config.Set ("log4j.appender.stdout.level", "INFO");
   Log_Config.Set ("log4j.appender.stdout.layout", "message");
   Log_Config.Set ("log4j.logger.Util", "FATAL");
   Log_Config.Set ("log4j.logger.Bbox", "FATAL");

   Util.Log.Loggers.Initialize (Log_Config);
   Druss.Commands.Initialize;
   Initialize_Option_Scan (Stop_At_First_Non_Switch => True, Section_Delimiters => "targs");
   --  Parse the command line
   loop
      case Getopt ("* v d o: c:") is
         when ASCII.NUL => exit;

         when 'c' =>
            Config := Ada.Strings.Unbounded.To_Unbounded_String (Parameter);

         when 'o' =>
            Output := Ada.Strings.Unbounded.To_Unbounded_String (Parameter);

         when 'd' =>
            Debug := True;

         when 'v' =>
            Verbose := True;

         when '*' =>
            exit;

         when others =>
            null;
      end case;
      First := First + 1;
   end loop;
   if Verbose or Debug then
      Log_Config.Set ("log4j.appender.console.level", "INFO");
      Log_Config.Set ("log4j.logger.Util", "WARN");
      Log_Config.Set ("log4j.logger.Bbox", "ERR");
   end if;
   if Debug then
      Log_Config.Set ("log4j.appender.console.level", "DEBUG");
   end if;
   Util.Log.Loggers.Initialize (Log_Config);
   Druss.Config.Initialize (To_String (Config));
   Util.Http.Clients.Curl.Register;
   if First >= Ada.Command_Line.Argument_Count then
      Ada.Text_IO.Put_Line ("Missing command name to execute.");
      Druss.Commands.Driver.Usage (All_Args);
      Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
      return;
   end if;
   declare
      Cmd_Name : constant String := Full_Switch;
      Args     : Util.Commands.Default_Argument_List (First + 1);
      Ctx      : Druss.Commands.Context_Type;
   begin
      Ctx.Console := Console'Unchecked_Access;
      Druss.Config.Get_Gateways (Ctx.Gateways);
      Druss.Commands.Driver.Execute (Cmd_Name, Args, Ctx);
   end;

exception
   when E : Invalid_Switch =>
      Ada.Text_IO.Put_Line ("Invalid option: " & Ada.Exceptions.Exception_Message (E));
      Ada.Command_Line.Set_Exit_Status (2);

end Druss.Tools;

Update the -v and -d option to enable more logging