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

with Util.Test_Caller;

with Util.Strings.Transforms;
with Util.Http.Tools;
with Util.Strings;
with Util.Log.Loggers;

package body Util.Http.Clients.Tests is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Http.Clients.Tests");

   package body Http_Tests is
      package Caller is new Util.Test_Caller (Http_Test, "Http-" & NAME);

      procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      begin
         Caller.Add_Test (Suite, "Test Util.Http.Clients." & NAME & ".Get",
                          Test_Http_Get'Access);
         Caller.Add_Test (Suite, "Test Util.Http.Clients." & NAME & ".Post",
                          Test_Http_Post'Access);
      end Add_Tests;

      overriding
      procedure Set_Up (T : in out Http_Test) is
      begin
         Test (T).Set_Up;
         Register;
      end Set_Up;

   end Http_Tests;

   overriding
   procedure Set_Up (T : in out Test) is
   begin
      Log.Info ("Starting test server");
      T.Server := new Test_Server;
      T.Server.Start;
   end Set_Up;

   overriding
   procedure Tear_Down (T : in out Test) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => Test_Server'Class,
                                         Name   => Test_Server_Access);
   begin
      if T.Server /= null then
         Log.Info ("Stopping test server");
         T.Server.Stop;
         Free (T.Server);
         T.Server := null;
      end if;
   end Tear_Down;

   --  ------------------------------
   --  Process the line received by the server.
   --  ------------------------------
   overriding
   procedure Process_Line (Into   : in out Test_Server;
                           Line   : in Ada.Strings.Unbounded.Unbounded_String;
                           Stream : in out Util.Streams.Texts.Reader_Stream'Class;
                           Client : in out Util.Streams.Sockets.Socket_Stream'Class) is
      L   : constant String := Ada.Strings.Unbounded.To_String (Line);
      Pos : Natural := Util.Strings.Index (L, ' ');
   begin
      if Pos > 0 and Into.Method = UNKNOWN then
         if L (L'First .. Pos - 1) = "GET" then
            Into.Method := GET;
         elsif L (L'First .. Pos - 1) = "POST" then
            Into.Method := POST;
         else
            Into.Method := UNKNOWN;
         end if;
      end if;

      Pos := Util.Strings.Index (L, ':');
      if Pos > 0 then
         if L (L'First .. Pos) = "Content-Type:" then
            Into.Content_Type
              := Ada.Strings.Unbounded.To_Unbounded_String (L (Pos + 2 .. L'Last - 2));
         elsif L (L'First .. Pos) = "Content-Length:" then
            Into.Length := Natural'Value (L (Pos + 1 .. L'Last - 2));

         end if;
      end if;
      if L'Length = 2 and then Into.Length > 0 then
         for I in 1 .. Into.Length loop
            declare
               C : Character;
            begin
               Stream.Read (C);
               Ada.Strings.Unbounded.Append (Into.Result, C);
            end;
         end loop;
         declare
            Output : Util.Streams.Texts.Print_Stream;
         begin
            Output.Initialize (Client'Unchecked_Access);
            Output.Write ("HTTP/1.1 200 Found" & ASCII.CR & ASCII.LF);
            Output.Write ("Content-Length: 4" & ASCII.CR & ASCII.LF);
            Output.Write (ASCII.CR & ASCII.LF);
            Output.Write ("OK" & ASCII.CR & ASCII.LF);
            Output.Flush;
         end;
      end if;
      Log.Info ("Received: {0}", L);
   end Process_Line;

   --  ------------------------------
   --  Get the test server base URI.
   --  ------------------------------
   function Get_Uri (T : in Test) return String is

   begin
      return "http://" & T.Server.Get_Host & ":" & Util.Strings.Image (T.Server.Get_Port);
   end Get_Uri;

   --  ------------------------------
   --  Test the http Get operation.
   --  ------------------------------
   procedure Test_Http_Get (T : in out Test) is
      Request : Client;
      Reply   : Response;
   begin
      Request.Get ("http://www.google.com", Reply);
      T.Assert (Reply.Get_Status = 200 or Reply.Get_Status = 302, "Get status is invalid");

      Util.Http.Tools.Save_Response (Util.Tests.Get_Test_Path ("http_get.txt"), Reply, True);

      --  Check the content.
      declare
         Content : constant String := Util.Strings.Transforms.To_Lower_Case (Reply.Get_Body);
      begin
         Util.Tests.Assert_Matches (T, ".*html.*", Content, "Invalid GET content");
      end;

      --  Check one header.
      declare
         Content : constant String := Reply.Get_Header ("Content-Type");
      begin
         T.Assert (Content'Length > 0, "Empty Content-Type header");
         Util.Tests.Assert_Matches (T, ".*text/html.*", Content, "Invalid content type");
      end;
   end Test_Http_Get;

   --  ------------------------------
   --  Test the http POST operation.
   --  ------------------------------
   procedure Test_Http_Post (T : in out Test) is
      Request : Client;
      Reply   : Response;
      Uri     : constant String := T.Get_Uri;
   begin
      Log.Info ("Post on " & Uri);

      T.Server.Method := UNKNOWN;
      Request.Post (Uri & "/post",
                    "p1=1", Reply);

      T.Assert (T.Server.Method = POST, "Invalid method received by server");
      Util.Tests.Assert_Equals (T, "application/x-www-form-urlencoded", T.Server.Content_Type,
                                "Invalid content type received by server");
      Util.Tests.Assert_Equals (T, "OK" & ASCII.CR & ASCII.LF, Reply.Get_Body, "Invalid response");
      Util.Http.Tools.Save_Response (Util.Tests.Get_Test_Path ("http_post.txt"), Reply, True);

   end Test_Http_Post;

end Util.Http.Clients.Tests;

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

with Util.Test_Caller;

with Util.Strings.Transforms;
with Util.Http.Tools;
with Util.Strings;
with Util.Log.Loggers;

package body Util.Http.Clients.Tests is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Http.Clients.Tests");

   package body Http_Tests is
      package Caller is new Util.Test_Caller (Http_Test, "Http-" & NAME);

      procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
      begin
         Caller.Add_Test (Suite, "Test Util.Http.Clients." & NAME & ".Get",
                          Test_Http_Get'Access);
         Caller.Add_Test (Suite, "Test Util.Http.Clients." & NAME & ".Post",
                          Test_Http_Post'Access);
      end Add_Tests;

      overriding
      procedure Set_Up (T : in out Http_Test) is
      begin
         Test (T).Set_Up;
         Register;
      end Set_Up;

   end Http_Tests;

   overriding
   procedure Set_Up (T : in out Test) is
   begin
      Log.Info ("Starting test server");
      T.Server := new Test_Server;
      T.Server.Start;
   end Set_Up;

   overriding
   procedure Tear_Down (T : in out Test) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => Test_Server'Class,
                                         Name   => Test_Server_Access);
   begin
      if T.Server /= null then
         Log.Info ("Stopping test server");
         T.Server.Stop;
         Free (T.Server);
         T.Server := null;
      end if;
   end Tear_Down;

   --  ------------------------------
   --  Process the line received by the server.
   --  ------------------------------
   overriding
   procedure Process_Line (Into   : in out Test_Server;
                           Line   : in Ada.Strings.Unbounded.Unbounded_String;
                           Stream : in out Util.Streams.Texts.Reader_Stream'Class;
                           Client : in out Util.Streams.Sockets.Socket_Stream'Class) is
      L   : constant String := Ada.Strings.Unbounded.To_String (Line);
      Pos : Natural := Util.Strings.Index (L, ' ');
   begin
      if Pos > 0 and Into.Method = UNKNOWN then
         if L (L'First .. Pos - 1) = "GET" then
            Into.Method := GET;
         elsif L (L'First .. Pos - 1) = "POST" then
            Into.Method := POST;
         else
            Into.Method := UNKNOWN;
         end if;
      end if;

      Pos := Util.Strings.Index (L, ':');
      if Pos > 0 then
         if L (L'First .. Pos) = "Content-Type:" then
            Into.Content_Type
              := Ada.Strings.Unbounded.To_Unbounded_String (L (Pos + 2 .. L'Last - 2));
         elsif L (L'First .. Pos) = "Content-Length:" then
            Into.Length := Natural'Value (L (Pos + 1 .. L'Last - 2));

         end if;
      end if;
      if L'Length = 2 and then Into.Length > 0 then
         for I in 1 .. Into.Length loop
            declare
               C : Character;
            begin
               Stream.Read (C);
               Ada.Strings.Unbounded.Append (Into.Result, C);
            end;
         end loop;
         declare
            Output : Util.Streams.Texts.Print_Stream;
         begin
            Output.Initialize (Client'Unchecked_Access);
            Output.Write ("HTTP/1.1 200 Found" & ASCII.CR & ASCII.LF);
            Output.Write ("Content-Length: 4" & ASCII.CR & ASCII.LF);
            Output.Write (ASCII.CR & ASCII.LF);
            Output.Write ("OK" & ASCII.CR & ASCII.LF);
            Output.Flush;
         end;
      end if;
      Log.Info ("Received: {0}", L);
   end Process_Line;

   --  ------------------------------
   --  Get the test server base URI.
   --  ------------------------------
   function Get_Uri (T : in Test) return String is

   begin
      return "http://" & T.Server.Get_Host & ":" & Util.Strings.Image (T.Server.Get_Port);
   end Get_Uri;

   --  ------------------------------
   --  Test the http Get operation.
   --  ------------------------------
   procedure Test_Http_Get (T : in out Test) is
      Request : Client;
      Reply   : Response;
   begin
      Request.Get ("http://www.google.com", Reply);
      T.Assert (Reply.Get_Status = 200 or Reply.Get_Status = 302,
                "Get status is invalid: " & Natural'Image (Reply.Get_Status));

      Util.Http.Tools.Save_Response (Util.Tests.Get_Test_Path ("http_get.txt"), Reply, True);

      --  Check the content.
      declare
         Content : constant String := Util.Strings.Transforms.To_Lower_Case (Reply.Get_Body);
      begin
         Util.Tests.Assert_Matches (T, ".*html.*", Content, "Invalid GET content");
      end;

      --  Check one header.
      declare
         Content : constant String := Reply.Get_Header ("Content-Type");
      begin
         T.Assert (Content'Length > 0, "Empty Content-Type header");
         Util.Tests.Assert_Matches (T, ".*text/html.*", Content, "Invalid content type");
      end;
   end Test_Http_Get;

   --  ------------------------------
   --  Test the http POST operation.
   --  ------------------------------
   procedure Test_Http_Post (T : in out Test) is
      Request : Client;
      Reply   : Response;
      Uri     : constant String := T.Get_Uri;
   begin
      Log.Info ("Post on " & Uri);

      T.Server.Method := UNKNOWN;
      Request.Post (Uri & "/post",
                    "p1=1", Reply);

      T.Assert (T.Server.Method = POST, "Invalid method received by server");
      Util.Tests.Assert_Equals (T, "application/x-www-form-urlencoded", T.Server.Content_Type,
                                "Invalid content type received by server");
      Util.Tests.Assert_Equals (T, "OK" & ASCII.CR & ASCII.LF, Reply.Get_Body, "Invalid response");
      Util.Http.Tools.Save_Response (Util.Tests.Get_Test_Path ("http_post.txt"), Reply, True);

   end Test_Http_Post;

end Util.Http.Clients.Tests;

Update the test to indicate the HTTP response status if an error occurs


-----------------------------------------------------------------------
--  awa-tags-beans -- Beans for the tags module
--  Copyright (C) 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.Strings.Unbounded;
with Ada.Containers.Hashed_Maps;
with Ada.Containers.Ordered_Sets;
with Ada.Finalization;

with Util.Beans.Basic;
with Util.Beans.Objects.Lists;
with Util.Beans.Lists.Strings;
with Util.Strings.Vectors;

with ADO;
with ADO.Utils;
with ADO.Schemas;
with ADO.Sessions;

with AWA.Tags.Models;
with AWA.Tags.Modules;

--  == Tag Beans ==
--  Several bean types are provided to represent and manage a list of tags.
--
--  === Tag_List_Bean ===
--  The <tt>Tag_List_Bean</tt> holds a list of tags and provides operations used by the
--  <tt>awa:tagList</tt> component to add or remove tags within a <tt>h:form</tt> component.
--  A bean can be declared and configured as follows in the XML application configuration file:
--
--    <managed-bean>
--      <managed-bean-name>questionTags</managed-bean-name>
--      <managed-bean-class>AWA.Tags.Beans.Tag_List_Bean</managed-bean-class>
--      <managed-bean-scope>request</managed-bean-scope>
--      <managed-property>
--        <property-name>entity_type</property-name>
--        <property-class>String</property-class>
--        <value>Awa_Question</value>
--      </managed-property>
--      <managed-property>
--        <property-name>permission</property-name>
--        <property-class>String</property-class>
--        <value>question-edit</value>
--      </managed-property>
--    </managed-bean>
--
--  The <tt>entity_type</tt> property defines the name of the database table to which the tags
--  are assigned.  The <tt>permission</tt> property defines the permission name that must be used
--  to verify that the user has the permission do add or remove the tag.  Such permission is
--  verified only when the <tt>awa:tagList</tt> component is used within a form.
--
--  === Tag_Search_Bean ===
--  The <tt>Tag_Search_Bean</tt> is dedicated to searching for tags that start with a given
--  pattern.  The auto complete feature of the <tt>awa:tagList</tt> component can use this
--  bean type to look in the database for tags matching a start pattern.  The declaration of the
--  bean should define the database table to search for tags associated with a given database
--  table.  This is done in the XML configuration with the <tt>entity_type</tt> property.
--
--    <managed-bean>
--      <managed-bean-name>questionTagSearch</managed-bean-name>
--      <managed-bean-class>AWA.Tags.Beans.Tag_Search_Bean</managed-bean-class>
--      <managed-bean-scope>request</managed-bean-scope>
--      <managed-property>
--        <property-name>entity_type</property-name>
--        <property-class>String</property-class>
--        <value>awa_question</value>
--      </managed-property>
--    </managed-bean>
--
--  === Tag_Info_List_Bean ===
--  The <tt>Tag_Info_List_Bean</tt> holds a collection of tags with their weight.  It is used
--  by the <tt>awa:tagCloud</tt> component.
--
--    <managed-bean>
--      <managed-bean-name>questionTagList</managed-bean-name>
--      <managed-bean-class>AWA.Tags.Beans.Tag_Info_List_Bean</managed-bean-class>
--      <managed-bean-scope>request</managed-bean-scope>
--      <managed-property>
--        <property-name>entity_type</property-name>
--        <property-class>String</property-class>
--        <value>awa_question</value>
--      </managed-property>
--    </managed-bean>
--
package AWA.Tags.Beans is

   --  Compare two tags on their count and name.
   function "<" (Left, Right : in AWA.Tags.Models.Tag_Info) return Boolean;

   package Tag_Ordered_Sets is
     new Ada.Containers.Ordered_Sets (Element_Type => AWA.Tags.Models.Tag_Info,
                                      "="          => AWA.Tags.Models."=");

   type Tag_List_Bean is
     new Util.Beans.Objects.Lists.List_Bean and Util.Beans.Basic.Bean with private;

   type Tag_List_Bean_Access is access all Tag_List_Bean'Class;

   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   overriding
   procedure Set_Value (From  : in out Tag_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Set the entity type (database table) onto which the tags are associated.
   procedure Set_Entity_Type (Into  : in out Tag_List_Bean;
                              Table : in ADO.Schemas.Class_Mapping_Access);

   --  Set the permission to check before removing or adding a tag on the entity.
   procedure Set_Permission (Into       : in out Tag_List_Bean;
                             Permission : in String);

   --  Load the tags associated with the given database identifier.
   procedure Load_Tags (Into          : in out Tag_List_Bean;
                        Session       : in ADO.Sessions.Session;
                        For_Entity_Id : in ADO.Identifier);

   --  Set the list of tags to add.
   procedure Set_Added (Into  : in out Tag_List_Bean;
                        Tags  : in Util.Strings.Vectors.Vector);

   --  Set the list of tags to remove.
   procedure Set_Deleted (Into : in out Tag_List_Bean;
                          Tags : in Util.Strings.Vectors.Vector);

   --  Update the tags associated with the tag entity represented by <tt>For_Entity_Id</tt>.
   --  The list of tags defined by <tt>Set_Deleted</tt> are removed first and the list of
   --  tags defined by <tt>Set_Added</tt> are associated with the database entity.
   procedure Update_Tags (From          : in Tag_List_Bean;
                          For_Entity_Id : in ADO.Identifier);

   --  Create the tag list bean instance.
   function Create_Tag_List_Bean (Module : in AWA.Tags.Modules.Tag_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   type Tag_Search_Bean is
     new Util.Beans.Objects.Lists.List_Bean and Util.Beans.Basic.Bean with private;
   type Tag_Search_Bean_Access is access all Tag_Search_Bean'Class;

   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   overriding
   procedure Set_Value (From  : in out Tag_Search_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Search the tags that match the search string.
   procedure Search_Tags (Into    : in out Tag_Search_Bean;
                          Session : in ADO.Sessions.Session;
                          Search  : in String);

   --  Set the entity type (database table) onto which the tags are associated.
   procedure Set_Entity_Type (Into  : in out Tag_Search_Bean;
                              Table : in ADO.Schemas.Class_Mapping_Access);

   --  Create the tag search bean instance.
   function Create_Tag_Search_Bean (Module : in AWA.Tags.Modules.Tag_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

   type Tag_Info_List_Bean is
     new AWA.Tags.Models.Tag_Info_List_Bean and Util.Beans.Basic.Bean with private;
   type Tag_Info_List_Bean_Access is access all Tag_Info_List_Bean'Class;

   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   overriding
   procedure Set_Value (From  : in out Tag_Info_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the list of tags.
   procedure Load_Tags (Into    : in out Tag_Info_List_Bean;
                        Session : in out ADO.Sessions.Session);

   --  Create the tag info list bean instance.
   function Create_Tag_Info_List_Bean (Module : in AWA.Tags.Modules.Tag_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access;

   --  The <tt>Entity_Tag_Map</tt> contains a list of tags associated with some entities.
   --  It allows to retrieve from the database all the tags associated with several entities
   --  and get the list of tags for a given entity.
   type Entity_Tag_Map is new Ada.Finalization.Limited_Controlled with private;

   --  Get the list of tags associated with the given entity.
   --  Returns null if the entity does not have any tag.
   function Get_Tags (From       : in Entity_Tag_Map;
                      For_Entity : in ADO.Identifier)
                      return Util.Beans.Lists.Strings.List_Bean_Access;

   --  Get the list of tags associated with the given entity.
   --  Returns a null object if the entity does not have any tag.
   function Get_Tags (From       : in Entity_Tag_Map;
                      For_Entity : in ADO.Identifier)
                      return Util.Beans.Objects.Object;

   --  Release the list of tags.
   procedure Clear (List : in out Entity_Tag_Map);

   --  Load the list of tags associated with a list of entities.
   procedure Load_Tags (Into        : in out Entity_Tag_Map;
                        Session     : in out ADO.Sessions.Session'Class;
                        Entity_Type : in String;
                        List        : in ADO.Utils.Identifier_Vector);

   --  Release the list of tags.
   overriding
   procedure Finalize (List : in out Entity_Tag_Map);

private

   type Tag_List_Bean is
     new Util.Beans.Objects.Lists.List_Bean and Util.Beans.Basic.Bean with record
      Module      : AWA.Tags.Modules.Tag_Module_Access;
      Entity_Type : Ada.Strings.Unbounded.Unbounded_String;
      Permission  : Ada.Strings.Unbounded.Unbounded_String;
      Current     : Natural := 0;
      Added       : Util.Strings.Vectors.Vector;
      Deleted     : Util.Strings.Vectors.Vector;
   end record;

   type Tag_Search_Bean is
     new Util.Beans.Objects.Lists.List_Bean and Util.Beans.Basic.Bean with record
      Module      : AWA.Tags.Modules.Tag_Module_Access;
      Entity_Type : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Tag_Info_List_Bean is
     new AWA.Tags.Models.Tag_Info_List_Bean and Util.Beans.Basic.Bean with record
      Module      : AWA.Tags.Modules.Tag_Module_Access;
      Entity_Type : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   package Entity_Tag_Maps is
     new Ada.Containers.Hashed_Maps (Key_Type        => ADO.Identifier,
                                     Element_Type    => Util.Beans.Lists.Strings.List_Bean_Access,
                                     Hash            => ADO.Utils.Hash,
                                     Equivalent_Keys => ADO."=",
                                     "="             => Util.Beans.Lists.Strings."=");

   type Entity_Tag_Map is new Ada.Finalization.Limited_Controlled with record
      Tags : Entity_Tag_Maps.Map;
   end record;

end AWA.Tags.Beans;

-----------------------------------------------------------------------
--  awa-tags-beans -- Beans for the tags module
--  Copyright (C) 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.Strings.Unbounded;
with Ada.Containers.Hashed_Maps;
with Ada.Containers.Ordered_Sets;
with Ada.Finalization;

with Util.Beans.Basic;
with Util.Beans.Objects.Lists;
with Util.Beans.Lists.Strings;
with Util.Strings.Vectors;

with ADO;
with ADO.Utils;
with ADO.Schemas;
with ADO.Sessions;

with AWA.Tags.Models;
with AWA.Tags.Modules;

--  == Tag Beans ==
--  Several bean types are provided to represent and manage a list of tags.
--  The tag module registers the bean constructors when it is initialized.
--  To use them, one must declare a bean definition in the application XML configuration.
--
--  === Tag_List_Bean ===
--  The <tt>Tag_List_Bean</tt> holds a list of tags and provides operations used by the
--  <tt>awa:tagList</tt> component to add or remove tags within a <tt>h:form</tt> component.
--  A bean can be declared and configured as follows in the XML application configuration file:
--
--    <managed-bean>
--      <managed-bean-name>questionTags</managed-bean-name>
--      <managed-bean-class>AWA.Tags.Beans.Tag_List_Bean</managed-bean-class>
--      <managed-bean-scope>request</managed-bean-scope>
--      <managed-property>
--        <property-name>entity_type</property-name>
--        <property-class>String</property-class>
--        <value>awa_question</value>
--      </managed-property>
--      <managed-property>
--        <property-name>permission</property-name>
--        <property-class>String</property-class>
--        <value>question-edit</value>
--      </managed-property>
--    </managed-bean>
--
--  The <tt>entity_type</tt> property defines the name of the database table to which the tags
--  are assigned.  The <tt>permission</tt> property defines the permission name that must be used
--  to verify that the user has the permission do add or remove the tag.  Such permission is
--  verified only when the <tt>awa:tagList</tt> component is used within a form.
--
--  === Tag_Search_Bean ===
--  The <tt>Tag_Search_Bean</tt> is dedicated to searching for tags that start with a given
--  pattern.  The auto complete feature of the <tt>awa:tagList</tt> component can use this
--  bean type to look in the database for tags matching a start pattern.  The declaration of the
--  bean should define the database table to search for tags associated with a given database
--  table.  This is done in the XML configuration with the <tt>entity_type</tt> property.
--
--    <managed-bean>
--      <managed-bean-name>questionTagSearch</managed-bean-name>
--      <managed-bean-class>AWA.Tags.Beans.Tag_Search_Bean</managed-bean-class>
--      <managed-bean-scope>request</managed-bean-scope>
--      <managed-property>
--        <property-name>entity_type</property-name>
--        <property-class>String</property-class>
--        <value>awa_question</value>
--      </managed-property>
--    </managed-bean>
--
--  === Tag_Info_List_Bean ===
--  The <tt>Tag_Info_List_Bean</tt> holds a collection of tags with their weight.  It is used
--  by the <tt>awa:tagCloud</tt> component.
--
--    <managed-bean>
--      <managed-bean-name>questionTagList</managed-bean-name>
--      <managed-bean-class>AWA.Tags.Beans.Tag_Info_List_Bean</managed-bean-class>
--      <managed-bean-scope>request</managed-bean-scope>
--      <managed-property>
--        <property-name>entity_type</property-name>
--        <property-class>String</property-class>
--        <value>awa_question</value>
--      </managed-property>
--    </managed-bean>
--
package AWA.Tags.Beans is

   --  Compare two tags on their count and name.
   function "<" (Left, Right : in AWA.Tags.Models.Tag_Info) return Boolean;

   package Tag_Ordered_Sets is
     new Ada.Containers.Ordered_Sets (Element_Type => AWA.Tags.Models.Tag_Info,
                                      "="          => AWA.Tags.Models."=");

   type Tag_List_Bean is
     new Util.Beans.Objects.Lists.List_Bean and Util.Beans.Basic.Bean with private;

   type Tag_List_Bean_Access is access all Tag_List_Bean'Class;

   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   overriding
   procedure Set_Value (From  : in out Tag_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Set the entity type (database table) onto which the tags are associated.
   procedure Set_Entity_Type (Into  : in out Tag_List_Bean;
                              Table : in ADO.Schemas.Class_Mapping_Access);

   --  Set the permission to check before removing or adding a tag on the entity.
   procedure Set_Permission (Into       : in out Tag_List_Bean;
                             Permission : in String);

   --  Load the tags associated with the given database identifier.
   procedure Load_Tags (Into          : in out Tag_List_Bean;
                        Session       : in ADO.Sessions.Session;
                        For_Entity_Id : in ADO.Identifier);

   --  Set the list of tags to add.
   procedure Set_Added (Into  : in out Tag_List_Bean;
                        Tags  : in Util.Strings.Vectors.Vector);

   --  Set the list of tags to remove.
   procedure Set_Deleted (Into : in out Tag_List_Bean;
                          Tags : in Util.Strings.Vectors.Vector);

   --  Update the tags associated with the tag entity represented by <tt>For_Entity_Id</tt>.
   --  The list of tags defined by <tt>Set_Deleted</tt> are removed first and the list of
   --  tags defined by <tt>Set_Added</tt> are associated with the database entity.
   procedure Update_Tags (From          : in Tag_List_Bean;
                          For_Entity_Id : in ADO.Identifier);

   --  Create the tag list bean instance.
   function Create_Tag_List_Bean (Module : in AWA.Tags.Modules.Tag_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   type Tag_Search_Bean is
     new Util.Beans.Objects.Lists.List_Bean and Util.Beans.Basic.Bean with private;
   type Tag_Search_Bean_Access is access all Tag_Search_Bean'Class;

   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   overriding
   procedure Set_Value (From  : in out Tag_Search_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Search the tags that match the search string.
   procedure Search_Tags (Into    : in out Tag_Search_Bean;
                          Session : in ADO.Sessions.Session;
                          Search  : in String);

   --  Set the entity type (database table) onto which the tags are associated.
   procedure Set_Entity_Type (Into  : in out Tag_Search_Bean;
                              Table : in ADO.Schemas.Class_Mapping_Access);

   --  Create the tag search bean instance.
   function Create_Tag_Search_Bean (Module : in AWA.Tags.Modules.Tag_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

   type Tag_Info_List_Bean is
     new AWA.Tags.Models.Tag_Info_List_Bean and Util.Beans.Basic.Bean with private;
   type Tag_Info_List_Bean_Access is access all Tag_Info_List_Bean'Class;

   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   overriding
   procedure Set_Value (From  : in out Tag_Info_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the list of tags.
   procedure Load_Tags (Into    : in out Tag_Info_List_Bean;
                        Session : in out ADO.Sessions.Session);

   --  Create the tag info list bean instance.
   function Create_Tag_Info_List_Bean (Module : in AWA.Tags.Modules.Tag_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access;

   --  The <tt>Entity_Tag_Map</tt> contains a list of tags associated with some entities.
   --  It allows to retrieve from the database all the tags associated with several entities
   --  and get the list of tags for a given entity.
   type Entity_Tag_Map is new Ada.Finalization.Limited_Controlled with private;

   --  Get the list of tags associated with the given entity.
   --  Returns null if the entity does not have any tag.
   function Get_Tags (From       : in Entity_Tag_Map;
                      For_Entity : in ADO.Identifier)
                      return Util.Beans.Lists.Strings.List_Bean_Access;

   --  Get the list of tags associated with the given entity.
   --  Returns a null object if the entity does not have any tag.
   function Get_Tags (From       : in Entity_Tag_Map;
                      For_Entity : in ADO.Identifier)
                      return Util.Beans.Objects.Object;

   --  Release the list of tags.
   procedure Clear (List : in out Entity_Tag_Map);

   --  Load the list of tags associated with a list of entities.
   procedure Load_Tags (Into        : in out Entity_Tag_Map;
                        Session     : in out ADO.Sessions.Session'Class;
                        Entity_Type : in String;
                        List        : in ADO.Utils.Identifier_Vector);

   --  Release the list of tags.
   overriding
   procedure Finalize (List : in out Entity_Tag_Map);

private

   type Tag_List_Bean is
     new Util.Beans.Objects.Lists.List_Bean and Util.Beans.Basic.Bean with record
      Module      : AWA.Tags.Modules.Tag_Module_Access;
      Entity_Type : Ada.Strings.Unbounded.Unbounded_String;
      Permission  : Ada.Strings.Unbounded.Unbounded_String;
      Current     : Natural := 0;
      Added       : Util.Strings.Vectors.Vector;
      Deleted     : Util.Strings.Vectors.Vector;
   end record;

   type Tag_Search_Bean is
     new Util.Beans.Objects.Lists.List_Bean and Util.Beans.Basic.Bean with record
      Module      : AWA.Tags.Modules.Tag_Module_Access;
      Entity_Type : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Tag_Info_List_Bean is
     new AWA.Tags.Models.Tag_Info_List_Bean and Util.Beans.Basic.Bean with record
      Module      : AWA.Tags.Modules.Tag_Module_Access;
      Entity_Type : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   package Entity_Tag_Maps is
     new Ada.Containers.Hashed_Maps (Key_Type        => ADO.Identifier,
                                     Element_Type    => Util.Beans.Lists.Strings.List_Bean_Access,
                                     Hash            => ADO.Utils.Hash,
                                     Equivalent_Keys => ADO."=",
                                     "="             => Util.Beans.Lists.Strings."=");

   type Entity_Tag_Map is new Ada.Finalization.Limited_Controlled with record
      Tags : Entity_Tag_Maps.Map;
   end record;

end AWA.Tags.Beans;

Fix comments and documentation

Fix comments and documentation


-----------------------------------------------------------------------
--  util-streams-buffered-encoders-tests -- Unit tests for encoding buffered streams
--  Copyright (C) 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 Util.Test_Caller;
with Util.Streams.Files;
with Util.Streams.Texts;
with Ada.Streams.Stream_IO;
package body Util.Streams.Buffered.Encoders.Tests is

   use Util.Tests;
   use Util.Streams.Files;
   use Ada.Streams.Stream_IO;

   package Caller is new Util.Test_Caller (Test, "Streams.Buffered.Encoders");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Encoders.Write, Read",
                       Test_Base64_Stream'Access);
   end Add_Tests;

   procedure Test_Base64_Stream (T : in out Test) is
      Stream  : aliased File_Stream;
      Buffer  : aliased Util.Streams.Buffered.Encoders.Encoding_Stream;
      Print   : Util.Streams.Texts.Print_Stream;
      Path    : constant String := Util.Tests.Get_Test_Path ("regtests/result/test-stream.b64");
      Expect  : constant String := Util.Tests.Get_Path ("regtests/expect/test-stream.b64");
   begin
      Print.Initialize (Output => Buffer'Unchecked_Access, Size => 5);
      Buffer.Initialize (Output => Stream'Unchecked_Access,
                         Size   => 1024,
                         Format => Util.Encoders.BASE_64);
      Stream.Create (Mode => Out_File, Name => Path);
      for I in 1 .. 32 loop
         Print.Write ("abcd");
         Print.Write (" fghij");
         Print.Write (ASCII.LF);
      end loop;
      Print.Flush;
      Stream.Close;

      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "Base64 stream");
   end Test_Base64_Stream;

end Util.Streams.Buffered.Encoders.Tests;

-----------------------------------------------------------------------
--  util-streams-buffered-encoders-tests -- Unit tests for encoding buffered streams
--  Copyright (C) 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 Util.Test_Caller;
with Util.Streams.Files;
with Util.Streams.Texts;
with Ada.Streams.Stream_IO;
package body Util.Streams.Buffered.Encoders.Tests is

   use Util.Streams.Files;
   use Ada.Streams.Stream_IO;

   package Caller is new Util.Test_Caller (Test, "Streams.Buffered.Encoders");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Encoders.Write, Read",
                       Test_Base64_Stream'Access);
   end Add_Tests;

   procedure Test_Base64_Stream (T : in out Test) is
      Stream  : aliased File_Stream;
      Buffer  : aliased Util.Streams.Buffered.Encoders.Encoding_Stream;
      Print   : Util.Streams.Texts.Print_Stream;
      Path    : constant String := Util.Tests.Get_Test_Path ("regtests/result/test-stream.b64");
      Expect  : constant String := Util.Tests.Get_Path ("regtests/expect/test-stream.b64");
   begin
      Print.Initialize (Output => Buffer'Unchecked_Access, Size => 5);
      Buffer.Initialize (Output => Stream'Unchecked_Access,
                         Size   => 1024,
                         Format => Util.Encoders.BASE_64);
      Stream.Create (Mode => Out_File, Name => Path);
      for I in 1 .. 32 loop
         Print.Write ("abcd");
         Print.Write (" fghij");
         Print.Write (ASCII.LF);
      end loop;
      Print.Flush;
      Stream.Close;

      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "Base64 stream");
   end Test_Base64_Stream;

end Util.Streams.Buffered.Encoders.Tests;

Remove unused use Util.Tests clause

Remove unused use Util.Tests clause


with Jack.Client;
with System;

package Jack.Port is

  --
  -- API
  --

  -- proc_map : jack_port_get_buffer
  function Buffer_Address
    (Port             : in Client.Port_t;
     Number_Of_Frames : in Client.Number_Of_Frames_t) return System.Address;

  -- proc_map : jack_port_connected
  function Connected (Port : in Client.Port_t) return Boolean;

  -- proc_map : jack_port_connected_to
  function Connected_To
    (Port      : in Client.Port_t;
     Port_Name : in Client.Port_Name_t) return Boolean;

  -- proc_map : jack_port_flags
  function Flags
    (Port : in Client.Port_t) return Client.Port_Flags_t;

  -- proc_map : jack_port_type
  function Get_Type
    (Port : in Client.Port_t) return Client.Port_Type_t;

  -- proc_map : jack_get_latency
  function Latency
    (Port : in Client.Port_t) return Client.Number_Of_Frames_t;

  -- proc_map : jack_port_name
  function Name
    (Port : in Client.Port_t) return Client.Port_Name_t;

  -- proc_map : jack_port_short_name
  function Short_Name
    (Port : in Client.Port_t) return Client.Port_Name_t;

end Jack.Port;

with Jack.Client;
with System;

package Jack.Port is

  --
  -- API
  --

  -- proc_map : jack_port_get_buffer
  function Buffer_Address
    (Port             : in Client.Port_t;
     Number_Of_Frames : in Client.Number_Of_Frames_t) return System.Address;

  -- proc_map : jack_port_connected
  function Connected (Port : in Client.Port_t) return Boolean;

  -- proc_map : jack_port_connected_to
  function Connected_To
    (Port      : in Client.Port_t;
     Port_Name : in Client.Port_Name_t) return Boolean;

  -- proc_map : jack_port_flags
  function Flags
    (Port : in Client.Port_t) return Client.Port_Flags_t;

  -- proc_map : jack_port_type
  function Get_Type
    (Port : in Client.Port_t) return Client.Port_Type_t;

  -- proc_map : jack_port_get_latency
  function Latency
    (Port : in Client.Port_t) return Client.Number_Of_Frames_t;

  -- proc_map : jack_port_name
  function Name
    (Port : in Client.Port_t) return Client.Port_Name_t;

  -- proc_map : jack_port_short_name
  function Short_Name
    (Port : in Client.Port_t) return Client.Port_Name_t;

end Jack.Port;

Fix proc_map

Fix proc_map


-----------------------------------------------------------------------
--  asf-routes-servlets-faces -- faces request routing
--  Copyright (C) 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.Finalization;
with Ada.Strings.Unbounded;
with ASF.Filters;
with ASF.Servlets;
package ASF.Routes.Servlets.Faces is

   type Faces_Route_Type is new Servlet_Route_Type with record
      View    : Ada.Strings.Unbounded.Unbounded_String;
   end record;
   type Faces_Route_Type_Access is access all Faces_Route_Type'Class;

   --  Release the storage held by the route.
--     overriding
--     procedure Finalize (Route : in out Servlet_Route_Type);

end ASF.Routes.Servlets.Faces;

-----------------------------------------------------------------------
--  asf-routes-servlets-faces -- faces request routing
--  Copyright (C) 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;
package ASF.Routes.Servlets.Faces is

   type Faces_Route_Type is new Servlet_Route_Type with record
      View    : Ada.Strings.Unbounded.Unbounded_String;
   end record;
   type Faces_Route_Type_Access is access all Faces_Route_Type'Class;

end ASF.Routes.Servlets.Faces;

Remove unused with clauses

Remove unused with clauses


-----------------------------------------------------------------------
--  mat-expressions -- Expressions for event and memory slot selection
--  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.Finalization;

private with Util.Concurrent.Counters;

with MAT.Types;
with MAT.Memory;
with MAT.Events.Targets;
package MAT.Expressions is

   type Context_Type is record
      Addr       : MAT.Types.Target_Addr;
      Allocation : MAT.Memory.Allocation;
   end record;

   type Inside_Type is (INSIDE_FILE,
                        INSIDE_DIRECT_FILE,
                        INSIDE_FUNCTION,
                        INSIDE_DIRECT_FUNCTION);

   type Expression_Type is tagged private;

   --  Create a NOT expression node.
   function Create_Not (Expr : in Expression_Type) return Expression_Type;

   --  Create a AND expression node.
   function Create_And (Left  : in Expression_Type;
                        Right : in Expression_Type) return Expression_Type;

   --  Create a OR expression node.
   function Create_Or (Left  : in Expression_Type;
                       Right : in Expression_Type) return Expression_Type;

   --  Create an INSIDE expression node.
   function Create_Inside (Name : in Ada.Strings.Unbounded.Unbounded_String;
                           Kind : in Inside_Type) return Expression_Type;

   --  Create an size range expression node.
   function Create_Size (Min : in MAT.Types.Target_Size;
                         Max : in MAT.Types.Target_Size) return Expression_Type;

   --  Create an addr range expression node.
   function Create_Addr (Min : in MAT.Types.Target_Addr;
                         Max : in MAT.Types.Target_Addr) return Expression_Type;

   --  Create an time range expression node.
   function Create_Time (Min : in MAT.Types.Target_Tick_Ref;
                         Max : in MAT.Types.Target_Tick_Ref) return Expression_Type;

   --  Create an event ID range expression node.
   function Create_Event (Min : in MAT.Events.Targets.Event_Id_Type;
                          Max : in MAT.Events.Targets.Event_Id_Type) return Expression_Type;

   --  Create a thread ID range expression node.
   function Create_Thread (Min : in MAT.Types.Target_Thread_Ref;
                           Max : in MAT.Types.Target_Thread_Ref) return Expression_Type;

   --  Create a event type expression check.
   function Create_Event_Type (Event_Kind : in MAT.Events.Targets.Probe_Index_Type)
                               return Expression_Type;

   --  Evaluate the expression to check if the memory slot described by the
   --  context is selected.  Returns True if the memory slot is selected.
   function Is_Selected (Node       : in Expression_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean;

   --  Evaluate the expression to check if the event described by the
   --  context is selected.  Returns True if the event is selected.
   function Is_Selected (Node       : in Expression_Type;
                         Event      : in MAT.Events.Targets.Probe_Event_Type) return Boolean;

   --  Parse the string and return the expression tree.
   function Parse (Expr : in String) return Expression_Type;

   --  Empty expression.
   EMPTY : constant Expression_Type;

   type yystype is record
      low   : MAT.Types.Uint64 := 0;
      high  : MAT.Types.Uint64 := 0;
      bval  : Boolean := False;
      name  : Ada.Strings.Unbounded.Unbounded_String;
      expr  : Expression_Type;
   end record;

private

   type Kind_Type is (N_NOT, N_OR, N_AND, N_TRUE, N_FALSE,
                      N_IN_FILE, N_IN_FILE_DIRECT, N_INSIDE,
                      N_CALL_ADDR, N_CALL_ADDR_DIRECT,
                      N_IN_FUNC, N_IN_FUNC_DIRECT,
                      N_RANGE_SIZE, N_RANGE_ADDR,
                      N_RANGE_TIME, N_EVENT, N_HAS_ADDR,
                      N_CONDITION, N_THREAD, N_TYPE, N_NO_FREE);

   type Node_Type;
   type Node_Type_Access is access all Node_Type;

   type Node_Type (Kind : Kind_Type) is record
      Ref_Counter : Util.Concurrent.Counters.Counter;
      case Kind is
         when N_NOT =>
            Expr : Node_Type_Access;

         when N_OR | N_AND =>
            Left, Right : Node_Type_Access;

         when N_INSIDE | N_IN_FILE | N_IN_FILE_DIRECT | N_IN_FUNC | N_IN_FUNC_DIRECT =>
            Name   : Ada.Strings.Unbounded.Unbounded_String;
            Inside : Inside_Type;

         when N_RANGE_SIZE =>
            Min_Size : MAT.Types.Target_Size;
            Max_Size : MAT.Types.Target_Size;

         when N_RANGE_ADDR | N_CALL_ADDR | N_CALL_ADDR_DIRECT | N_HAS_ADDR =>
            Min_Addr : MAT.Types.Target_Addr;
            Max_Addr : MAT.Types.Target_Addr;

         when N_RANGE_TIME =>
            Min_Time : MAT.Types.Target_Tick_Ref;
            Max_Time : MAT.Types.Target_Tick_Ref;

         when N_THREAD =>
            Min_Thread : MAT.Types.Target_Thread_Ref;
            Max_Thread : MAT.Types.Target_Thread_Ref;

         when N_EVENT =>
            Min_Event : MAT.Events.Targets.Event_Id_Type;
            Max_Event : MAT.Events.Targets.Event_Id_Type;

         when N_TYPE =>
            Event_Kind : MAT.Events.Targets.Probe_Index_Type;

         when others =>
            null;
      end case;
   end record;

   --  Evaluate the node against the context.  Returns True if the node expression
   --  selects the memory slot defined by the context.
   function Is_Selected (Node       : in Node_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean;

   --  Evaluate the expression to check if the event described by the
   --  context is selected.  Returns True if the event is selected.
   function Is_Selected (Node       : in Node_Type;
                         Event      : in MAT.Events.Targets.Probe_Event_Type) return Boolean;

   type Expression_Type is new Ada.Finalization.Controlled with record
      Node : Node_Type_Access;
   end record;

   --  Release the reference and destroy the expression tree if it was the last reference.
   overriding
   procedure Finalize (Obj : in out Expression_Type);

   --  Update the reference after an assignment.
   overriding
   procedure Adjust (Obj : in out Expression_Type);

   --  Empty expression.
   EMPTY : constant Expression_Type := Expression_Type'(Ada.Finalization.Controlled with
                                                        Node => null);

end MAT.Expressions;

-----------------------------------------------------------------------
--  mat-expressions -- Expressions for event and memory slot selection
--  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.Finalization;

private with Util.Concurrent.Counters;

with MAT.Types;
with MAT.Memory;
with MAT.Events.Targets;
package MAT.Expressions is

   type Context_Type is record
      Addr       : MAT.Types.Target_Addr;
      Allocation : MAT.Memory.Allocation;
   end record;

   type Inside_Type is (INSIDE_FILE,
                        INSIDE_DIRECT_FILE,
                        INSIDE_FUNCTION,
                        INSIDE_DIRECT_FUNCTION);

   type Expression_Type is tagged private;

   --  Create a NOT expression node.
   function Create_Not (Expr : in Expression_Type) return Expression_Type;

   --  Create a AND expression node.
   function Create_And (Left  : in Expression_Type;
                        Right : in Expression_Type) return Expression_Type;

   --  Create a OR expression node.
   function Create_Or (Left  : in Expression_Type;
                       Right : in Expression_Type) return Expression_Type;

   --  Create an INSIDE expression node.
   function Create_Inside (Name : in Ada.Strings.Unbounded.Unbounded_String;
                           Kind : in Inside_Type) return Expression_Type;

   --  Create an size range expression node.
   function Create_Size (Min : in MAT.Types.Target_Size;
                         Max : in MAT.Types.Target_Size) return Expression_Type;

   --  Create an addr range expression node.
   function Create_Addr (Min : in MAT.Types.Target_Addr;
                         Max : in MAT.Types.Target_Addr) return Expression_Type;

   --  Create an time range expression node.
   function Create_Time (Min : in MAT.Types.Target_Tick_Ref;
                         Max : in MAT.Types.Target_Tick_Ref) return Expression_Type;

   --  Create an event ID range expression node.
   function Create_Event (Min : in MAT.Events.Targets.Event_Id_Type;
                          Max : in MAT.Events.Targets.Event_Id_Type) return Expression_Type;

   --  Create a thread ID range expression node.
   function Create_Thread (Min : in MAT.Types.Target_Thread_Ref;
                           Max : in MAT.Types.Target_Thread_Ref) return Expression_Type;

   --  Create a event type expression check.
   function Create_Event_Type (Event_Kind : in MAT.Events.Targets.Probe_Index_Type)
                               return Expression_Type;

   --  Create an expression node to keep allocation events which don't have any associated free.
   function Create_No_Free return Expression_Type;

   --  Evaluate the expression to check if the memory slot described by the
   --  context is selected.  Returns True if the memory slot is selected.
   function Is_Selected (Node       : in Expression_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean;

   --  Evaluate the expression to check if the event described by the
   --  context is selected.  Returns True if the event is selected.
   function Is_Selected (Node       : in Expression_Type;
                         Event      : in MAT.Events.Targets.Probe_Event_Type) return Boolean;

   --  Parse the string and return the expression tree.
   function Parse (Expr : in String) return Expression_Type;

   --  Empty expression.
   EMPTY : constant Expression_Type;

   type yystype is record
      low   : MAT.Types.Uint64 := 0;
      high  : MAT.Types.Uint64 := 0;
      bval  : Boolean := False;
      name  : Ada.Strings.Unbounded.Unbounded_String;
      expr  : Expression_Type;
   end record;

private

   type Kind_Type is (N_NOT, N_OR, N_AND, N_TRUE, N_FALSE,
                      N_IN_FILE, N_IN_FILE_DIRECT, N_INSIDE,
                      N_CALL_ADDR, N_CALL_ADDR_DIRECT,
                      N_IN_FUNC, N_IN_FUNC_DIRECT,
                      N_RANGE_SIZE, N_RANGE_ADDR,
                      N_RANGE_TIME, N_EVENT, N_HAS_ADDR,
                      N_CONDITION, N_THREAD, N_TYPE, N_NO_FREE);

   type Node_Type;
   type Node_Type_Access is access all Node_Type;

   type Node_Type (Kind : Kind_Type) is record
      Ref_Counter : Util.Concurrent.Counters.Counter;
      case Kind is
         when N_NOT =>
            Expr : Node_Type_Access;

         when N_OR | N_AND =>
            Left, Right : Node_Type_Access;

         when N_INSIDE | N_IN_FILE | N_IN_FILE_DIRECT | N_IN_FUNC | N_IN_FUNC_DIRECT =>
            Name   : Ada.Strings.Unbounded.Unbounded_String;
            Inside : Inside_Type;

         when N_RANGE_SIZE =>
            Min_Size : MAT.Types.Target_Size;
            Max_Size : MAT.Types.Target_Size;

         when N_RANGE_ADDR | N_CALL_ADDR | N_CALL_ADDR_DIRECT | N_HAS_ADDR =>
            Min_Addr : MAT.Types.Target_Addr;
            Max_Addr : MAT.Types.Target_Addr;

         when N_RANGE_TIME =>
            Min_Time : MAT.Types.Target_Tick_Ref;
            Max_Time : MAT.Types.Target_Tick_Ref;

         when N_THREAD =>
            Min_Thread : MAT.Types.Target_Thread_Ref;
            Max_Thread : MAT.Types.Target_Thread_Ref;

         when N_EVENT =>
            Min_Event : MAT.Events.Targets.Event_Id_Type;
            Max_Event : MAT.Events.Targets.Event_Id_Type;

         when N_TYPE =>
            Event_Kind : MAT.Events.Targets.Probe_Index_Type;

         when others =>
            null;
      end case;
   end record;

   --  Evaluate the node against the context.  Returns True if the node expression
   --  selects the memory slot defined by the context.
   function Is_Selected (Node       : in Node_Type;
                         Addr       : in MAT.Types.Target_Addr;
                         Allocation : in MAT.Memory.Allocation) return Boolean;

   --  Evaluate the expression to check if the event described by the
   --  context is selected.  Returns True if the event is selected.
   function Is_Selected (Node       : in Node_Type;
                         Event      : in MAT.Events.Targets.Probe_Event_Type) return Boolean;

   type Expression_Type is new Ada.Finalization.Controlled with record
      Node : Node_Type_Access;
   end record;

   --  Release the reference and destroy the expression tree if it was the last reference.
   overriding
   procedure Finalize (Obj : in out Expression_Type);

   --  Update the reference after an assignment.
   overriding
   procedure Adjust (Obj : in out Expression_Type);

   --  Empty expression.
   EMPTY : constant Expression_Type := Expression_Type'(Ada.Finalization.Controlled with
                                                        Node => null);

end MAT.Expressions;

Declare the Create_No_Free function

Declare the Create_No_Free function


-----------------------------------------------------------------------
--  awa-wikis-modules-tests -- Unit tests for wikis service
--  Copyright (C) 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.Test_Caller;
with Util.Strings;
with ASF.Tests;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with AWA.Tests.Helpers;
with AWA.Tests.Helpers.Users;
with AWA.Services.Contexts;
with Security.Contexts;

package body AWA.Wikis.Modules.Tests is

   use ASF.Tests;
   use Util.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Space",
                       Test_Create_Wiki_Space'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Page",
                       Test_Create_Wiki_Page'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Content",
                       Test_Create_Wiki_Content'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Wiki_Page",
                       Test_Wiki_Page'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test creation of a wiki space.
   --  ------------------------------
   procedure Test_Create_Wiki_Space (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      W2        : AWA.Wikis.Models.Wiki_Space_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      T.Manager := AWA.Wikis.Modules.Get_Wiki_Module;
      T.Assert (T.Manager /= null, "There is no wiki manager");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);
      T.Assert (W.Is_Inserted, "The new wiki space was not created");

      W.Set_Name ("Test wiki space update");
      W.Set_Is_Public (True);
      T.Manager.Save_Wiki_Space (W);

      T.Manager.Load_Wiki_Space (Wiki => W2,
                                 Id   => W.Get_Id);
      Util.Tests.Assert_Equals (T, "Test wiki space update", String '(W2.Get_Name),
                                "Invalid wiki space name");
   end Test_Create_Wiki_Space;

   --  ------------------------------
   --  Test creation of a wiki page.
   --  ------------------------------
   procedure Test_Create_Wiki_Page (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      P         : AWA.Wikis.Models.Wiki_Page_Ref;
      C         : AWA.Wikis.Models.Wiki_Content_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);

      P.Set_Name ("Private");
      P.Set_Title ("The page title");
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Assert (P.Is_Inserted, "The new wiki page was not created");

      C := AWA.Wikis.Models.Null_Wiki_Content;
      P := AWA.Wikis.Models.Null_Wiki_Page;
      P.Set_Name ("Public");
      P.Set_Title ("The page title (public)");
      P.Set_Is_Public (True);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Assert (P.Is_Inserted, "The new wiki page was not created");
      T.Assert (P.Get_Is_Public, "The new wiki page is not public");

   end Test_Create_Wiki_Page;

   --  ------------------------------
   --  Test creation of a wiki page content.
   --  ------------------------------
   procedure Test_Create_Wiki_Content (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      P         : AWA.Wikis.Models.Wiki_Page_Ref;
      C         : AWA.Wikis.Models.Wiki_Content_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);
      T.Wiki_Id := W.Get_Id;

      P.Set_Name ("PrivatePage");
      P.Set_Title ("The page title");
      P.Set_Is_Public (False);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Private_Id := P.Get_Id;

      C := AWA.Wikis.Models.Null_Wiki_Content;
      C.Set_Format (AWA.Wikis.Models.FORMAT_MARKDOWN);
      C.Set_Content ("-- Title" & ASCII.LF & "A paragraph");
      C.Set_Save_Comment ("A first version");
      T.Manager.Create_Wiki_Content (P, C);
      T.Assert (C.Is_Inserted, "The new wiki content was not created");
      T.Assert (not C.Get_Author.Is_Null, "The wiki content has an author");
      T.Assert (not C.Get_Page.Is_Null, "The wiki content is associated with the wiki page");

      P := AWA.Wikis.Models.Null_Wiki_Page;
      C := AWA.Wikis.Models.Null_Wiki_Content;
      P.Set_Name ("PublicPage");
      P.Set_Title ("The public page title");
      P.Set_Is_Public (True);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Public_Id := P.Get_Id;

      C.Set_Format (AWA.Wikis.Models.FORMAT_MARKDOWN);
      C.Set_Content ("-- Title" & ASCII.LF & "A paragraph" & ASCII.LF
                     & "[Link](http://mylink.com)" & ASCII.LF
                     & "[Image](my-image.png)");
      C.Set_Save_Comment ("A first version");
      T.Manager.Create_Wiki_Content (P, C);
      T.Assert (C.Is_Inserted, "The new wiki content was not created");
      T.Assert (not C.Get_Author.Is_Null, "The wiki content has an author");
      T.Assert (not C.Get_Page.Is_Null, "The wiki content is associated with the wiki page");

   end Test_Create_Wiki_Content;

   procedure Test_Wiki_Page (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Ident     : constant String := Util.Strings.Image (Natural (T.Wiki_Id));
      Pub_Ident : constant String := Util.Strings.Image (Natural (T.Public_Id));
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Ident & "/PublicPage", "wiki-public-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PublicPage)");
      Assert_Matches (T, ".*The public page title.*", Reply, "Invalid PublicPage page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/info/" & Ident & "/" & Pub_Ident,
                        "wiki-public-info-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PublicPage info)");
      Assert_Matches (T, ".*The public page title.*", Reply, "Invalid PublicPage info page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/history/" & Ident & "/" & Pub_Ident,
                        "wiki-public-history-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PublicPage history)");
      Assert_Matches (T, ".*The public page title.*", Reply, "Invalid PublicPage info page returned",
                      Status => ASF.Responses.SC_OK);

      Request.Remove_Attribute ("wikiView");
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Ident & "/PrivatePage", "wiki-private-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PrivatePage)");
      Assert_Matches (T, ".*Protected Wiki Page.*", Reply, "Invalid PrivatePage page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/recent", "wiki-list-recent-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/recent)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/recent/grid", "wiki-list-grid-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/recent/grid)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/popular", "wiki-list-popular-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/popular)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/popular/grid", "wiki-list-popular-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/popular/grid)");
   end Test_Wiki_Page;

end AWA.Wikis.Modules.Tests;

-----------------------------------------------------------------------
--  awa-wikis-modules-tests -- Unit tests for wikis service
--  Copyright (C) 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.Test_Caller;
with Util.Strings;
with ASF.Tests;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with AWA.Tests.Helpers;
with AWA.Tests.Helpers.Users;
with AWA.Services.Contexts;
with Security.Contexts;

package body AWA.Wikis.Modules.Tests is

   use ASF.Tests;
   use Util.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Space",
                       Test_Create_Wiki_Space'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Page",
                       Test_Create_Wiki_Page'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Content",
                       Test_Create_Wiki_Content'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Wiki_Page",
                       Test_Wiki_Page'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test creation of a wiki space.
   --  ------------------------------
   procedure Test_Create_Wiki_Space (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      W2        : AWA.Wikis.Models.Wiki_Space_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      T.Manager := AWA.Wikis.Modules.Get_Wiki_Module;
      T.Assert (T.Manager /= null, "There is no wiki manager");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);
      T.Assert (W.Is_Inserted, "The new wiki space was not created");

      W.Set_Name ("Test wiki space update");
      W.Set_Is_Public (True);
      T.Manager.Save_Wiki_Space (W);

      T.Manager.Load_Wiki_Space (Wiki => W2,
                                 Id   => W.Get_Id);
      Util.Tests.Assert_Equals (T, "Test wiki space update", String '(W2.Get_Name),
                                "Invalid wiki space name");
   end Test_Create_Wiki_Space;

   --  ------------------------------
   --  Test creation of a wiki page.
   --  ------------------------------
   procedure Test_Create_Wiki_Page (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      P         : AWA.Wikis.Models.Wiki_Page_Ref;
      C         : AWA.Wikis.Models.Wiki_Content_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);

      P.Set_Name ("Private");
      P.Set_Title ("The page title");
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Assert (P.Is_Inserted, "The new wiki page was not created");

      C := AWA.Wikis.Models.Null_Wiki_Content;
      P := AWA.Wikis.Models.Null_Wiki_Page;
      P.Set_Name ("Public");
      P.Set_Title ("The page title (public)");
      P.Set_Is_Public (True);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Assert (P.Is_Inserted, "The new wiki page was not created");
      T.Assert (P.Get_Is_Public, "The new wiki page is not public");

   end Test_Create_Wiki_Page;

   --  ------------------------------
   --  Test creation of a wiki page content.
   --  ------------------------------
   procedure Test_Create_Wiki_Content (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      P         : AWA.Wikis.Models.Wiki_Page_Ref;
      C         : AWA.Wikis.Models.Wiki_Content_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);
      T.Wiki_Id := W.Get_Id;

      P.Set_Name ("PrivatePage");
      P.Set_Title ("The page title");
      P.Set_Is_Public (False);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Private_Id := P.Get_Id;

      C := AWA.Wikis.Models.Null_Wiki_Content;
      C.Set_Format (AWA.Wikis.Models.FORMAT_MARKDOWN);
      C.Set_Content ("-- Title" & ASCII.LF & "A paragraph");
      C.Set_Save_Comment ("A first version");
      T.Manager.Create_Wiki_Content (P, C);
      T.Assert (C.Is_Inserted, "The new wiki content was not created");
      T.Assert (not C.Get_Author.Is_Null, "The wiki content has an author");
      T.Assert (not C.Get_Page.Is_Null, "The wiki content is associated with the wiki page");

      P := AWA.Wikis.Models.Null_Wiki_Page;
      C := AWA.Wikis.Models.Null_Wiki_Content;
      P.Set_Name ("PublicPage");
      P.Set_Title ("The public page title");
      P.Set_Is_Public (True);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Public_Id := P.Get_Id;

      C.Set_Format (AWA.Wikis.Models.FORMAT_MARKDOWN);
      C.Set_Content ("-- Title" & ASCII.LF & "A paragraph" & ASCII.LF
                     & "[Link](http://mylink.com)" & ASCII.LF
                     & "[Image](my-image.png)");
      C.Set_Save_Comment ("A first version");
      T.Manager.Create_Wiki_Content (P, C);
      T.Assert (C.Is_Inserted, "The new wiki content was not created");
      T.Assert (not C.Get_Author.Is_Null, "The wiki content has an author");
      T.Assert (not C.Get_Page.Is_Null, "The wiki content is associated with the wiki page");

   end Test_Create_Wiki_Content;

   --  ------------------------------
   --  Test getting the wiki page as well as info, history pages.
   --  ------------------------------
   procedure Test_Wiki_Page (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Ident     : constant String := Util.Strings.Image (Natural (T.Wiki_Id));
      Pub_Ident : constant String := Util.Strings.Image (Natural (T.Public_Id));
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Ident & "/PublicPage", "wiki-public-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PublicPage)");
      Assert_Matches (T, ".*The public page title.*", Reply, "Invalid PublicPage page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/info/" & Ident & "/" & Pub_Ident,
                        "wiki-public-info-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PublicPage info)");
      Assert_Matches (T, ".*The public page title.*", Reply, "Invalid PublicPage info page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/history/" & Ident & "/" & Pub_Ident,
                        "wiki-public-history-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PublicPage history)");
      Assert_Matches (T, ".*The public page title.*", Reply, "Invalid PublicPage info page returned",
                      Status => ASF.Responses.SC_OK);

      Request.Remove_Attribute ("wikiView");
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Ident & "/PrivatePage", "wiki-private-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PrivatePage)");
      Assert_Matches (T, ".*Protected Wiki Page.*", Reply, "Invalid PrivatePage page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/recent", "wiki-list-recent-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/recent)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/recent/grid", "wiki-list-grid-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/recent/grid)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/popular", "wiki-list-popular-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/popular)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/popular/grid", "wiki-list-popular-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (list/popular/grid)");
   end Test_Wiki_Page;

end AWA.Wikis.Modules.Tests;

Add some documentation

Add some documentation


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

   --  ------------------------------
   --  Get the image link that must be rendered from the wiki image link.
   --  ------------------------------
   overriding
   procedure Make_Image_Link (Renderer : in Default_Link_Renderer;
                              Link     : in Wiki.Strings.WString;
                              URI      : out Wiki.Strings.UString;
                              Width    : out Natural;
                              Height   : out Natural) is
      pragma Unreferenced (Renderer);
   begin
      URI    := Wiki.Strings.To_UString (Link);
      Width  := 0;
      Height := 0;
   end Make_Image_Link;

   --  ------------------------------
   --  Get the page link that must be rendered from the wiki page link.
   --  ------------------------------
   overriding
   procedure Make_Page_Link (Renderer : in Default_Link_Renderer;
                             Link     : in Wiki.Strings.WString;
                             URI      : out Wiki.Strings.UString;
                             Exists   : out Boolean) is
      pragma Unreferenced (Renderer);
   begin
      URI    := Wiki.Strings.To_UString (Link);
      Exists := True;
   end Make_Page_Link;

end Wiki.Render.Links;

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

   --  ------------------------------
   --  Get the image link that must be rendered from the wiki image link.
   --  ------------------------------
   overriding
   procedure Make_Image_Link (Renderer : in out Default_Link_Renderer;
                              Link     : in Wiki.Strings.WString;
                              URI      : out Wiki.Strings.UString;
                              Width    : out Natural;
                              Height   : out Natural) is
      pragma Unreferenced (Renderer);
   begin
      URI    := Wiki.Strings.To_UString (Link);
      Width  := 0;
      Height := 0;
   end Make_Image_Link;

   --  ------------------------------
   --  Get the page link that must be rendered from the wiki page link.
   --  ------------------------------
   overriding
   procedure Make_Page_Link (Renderer : in out Default_Link_Renderer;
                             Link     : in Wiki.Strings.WString;
                             URI      : out Wiki.Strings.UString;
                             Exists   : out Boolean) is
      pragma Unreferenced (Renderer);
   begin
      URI    := Wiki.Strings.To_UString (Link);
      Exists := True;
   end Make_Page_Link;

end Wiki.Render.Links;

Change the Link_Renderer to use in out parameter


-----------------------------------------------------------------------
--  mat-types -- Global types
--  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.
-----------------------------------------------------------------------
with Ada.IO_Exceptions;

with Util.Log.Loggers;

with GNAT.Sockets;
with Readline;

with MAT.Commands;
with MAT.Targets;
with MAT.Consoles.Text;
with MAT.Readers.Sockets;
procedure Matp is

   procedure Interactive_Loop is
      Target  : MAT.Targets.Target_Type;
      Console : aliased MAT.Consoles.Text.Console_Type;
      Server  : MAT.Readers.Sockets.Socket_Reader_Type;
      Address : GNAT.Sockets.Sock_Addr_Type;
   begin
      Address.Addr := GNAT.Sockets.Any_Inet_Addr;
      Address.Port := 4096;
      Target.Console := Console'Unchecked_Access;
      Target.Initialize (Server);
      Server.Open (Address);
      loop
         declare
            Line : constant String := Readline.Get_Line ("matp>");
         begin
            MAT.Commands.Execute (Target, Line);

         exception
            when MAT.Commands.Stop_Interp =>
               return;
         end;
      end loop;

   exception

      when Ada.IO_Exceptions.End_Error =>
         return;

   end Interactive_Loop;

begin
   Util.Log.Loggers.Initialize ("matp.properties");
   Interactive_Loop;
end Matp;

-----------------------------------------------------------------------
--  mat-types -- Global types
--  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.
-----------------------------------------------------------------------
with Ada.IO_Exceptions;

with Util.Log.Loggers;

with GNAT.Sockets;
with Readline;

with MAT.Commands;
with MAT.Targets;
with MAT.Consoles.Text;
with MAT.Readers.Streams.Sockets;
procedure Matp is

   procedure Interactive_Loop is
      Target  : MAT.Targets.Target_Type;
      Console : aliased MAT.Consoles.Text.Console_Type;
      Server  : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
      Address : GNAT.Sockets.Sock_Addr_Type;
   begin
      Address.Addr := GNAT.Sockets.Any_Inet_Addr;
      Address.Port := 4096;
--        Target.Console := Console'Unchecked_Access;
--        Target.Initialize (Server);
      Server.Start (Address);
      loop
         declare
            Line : constant String := Readline.Get_Line ("matp>");
         begin
            MAT.Commands.Execute (Target, Line);

         exception
            when MAT.Commands.Stop_Interp =>
               exit;
         end;
      end loop;

      Server.Stop;
   exception

      when Ada.IO_Exceptions.End_Error =>
         Server.Stop;
         return;

   end Interactive_Loop;

begin
   Util.Log.Loggers.Initialize ("matp.properties");
   Interactive_Loop;
end Matp;

Stop the server before leaving the server scope so that the listener task is stopped