-----------------------------------------------------------------------
--  awa-comments-beans -- Beans for the comments module
--  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 ADO.Sessions.Entities;
with ADO.Queries;
with ADO.Statements;
package body AWA.Comments.Beans is

   --  ------------------------------
   --  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 Comment_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "entity_type" then
         From.Entity_Type := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "permission" then
         From.Permission := Util.Beans.Objects.To_Unbounded_String (Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Set the entity type (database table) with which the comments are associated.
   --  ------------------------------
   procedure Set_Entity_Type (Into  : in out Comment_List_Bean;
                              Table : in ADO.Schemas.Class_Mapping_Access) is
   begin
      Into.Entity_Type := Ada.Strings.Unbounded.To_Unbounded_String (Table.Table.all);
   end Set_Entity_Type;

   --  ------------------------------
   --  Set the permission to check before removing or adding a comment on the entity.
   --  ------------------------------
   procedure Set_Permission (Into       : in out Comment_List_Bean;
                             Permission : in String) is
   begin
      Into.Permission := Ada.Strings.Unbounded.To_Unbounded_String (Permission);
   end Set_Permission;

   --  ------------------------------
   --  Load the comments associated with the given database identifier.
   --  ------------------------------
   procedure Load_Comments (Into          : in out Comment_List_Bean;
                            Session       : in ADO.Sessions.Session;
                            For_Entity_Id : in ADO.Identifier) is
      use ADO.Sessions.Entities;

      Entity_Type : constant String := Ada.Strings.Unbounded.To_String (Into.Entity_Type);
      Kind        : constant ADO.Entity_Type := Find_Entity_Type (Session, Entity_Type);
      Query       : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Comments.Models.Query_Comment_List);
      Query.Bind_Param ("entity_type", Kind);
      Query.Bind_Param ("entity_id", For_Entity_Id);
      declare
         Stmt : ADO.Statements.Query_Statement := Session.Create_Statement (Query);
      begin
         Stmt.Execute;

         while Stmt.Has_Elements loop
            Into.List.Append (Util.Beans.Objects.To_Object (Stmt.Get_String (0)));
            Stmt.Next;
         end loop;
      end;
   end Load_Comments;

   --  ------------------------------
   --  Create the comment list bean instance.
   --  ------------------------------
   function Create_Comment_List_Bean (Module : in AWA.Comments.Modules.Comment_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Comment_List_Bean_Access := new Comment_List_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Comment_List_Bean;

end AWA.Comments.Beans;

-----------------------------------------------------------------------
--  awa-comments-beans -- Beans for the comments module
--  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 ADO.Sessions.Entities;
with ADO.Queries;
with ADO.Statements;
with ADO.Utils;
with AWA.Services.Contexts;
package body AWA.Comments.Beans is

   package ASC renames AWA.Services.Contexts;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Comment_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if From.Is_Null then
         return Util.Beans.Objects.Null_Object;
      else
         return AWA.Comments.Models.Comment_Bean (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Comment_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "comment" then
         From.Set_Message (Util.Beans.Objects.To_String (Value));

      elsif Name = "entity_type" then
         From.Entity_Type := Util.Beans.Objects.To_Unbounded_String (Value);

      elsif Name = "permission" then
         From.Permission := Util.Beans.Objects.To_Unbounded_String (Value);

      elsif Name = "status" then
         From.Set_Status (AWA.Comments.Models.Status_Type_Objects.To_Value (Value));

      elsif Name = "id" and not Util.Beans.Objects.Is_Empty (Value) then
         declare
            Ctx : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
            DB  : constant ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
            Id  : constant ADO.Identifier := ADO.Utils.To_Identifier (Value);
         begin
            From.Module.Load_Comment (From, Id);
         end;
      end if;
   end Set_Value;

   --  Create the comment.
   overriding
   procedure Create (Bean    : in out Comment_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Bean.Module.Create_Comment (Ada.Strings.Unbounded.To_String (Bean.Permission), Bean);
   end Create;

   --  Save the comment.
   overriding
   procedure Save (Bean    : in out Comment_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Save;

   --  Delete the comment.
   overriding
   procedure Delete (Bean    : in out Comment_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Delete;

   --  ------------------------------
   --  Create a new comment bean instance.
   --  ------------------------------
   function Create_Comment_Bean (Module : in AWA.Comments.Modules.Comment_Module_Access)
                                 return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Comment_Bean_Access := new Comment_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Comment_Bean;

   --  ------------------------------
   --  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 Comment_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "entity_type" then
         From.Entity_Type := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "permission" then
         From.Permission := Util.Beans.Objects.To_Unbounded_String (Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Set the entity type (database table) with which the comments are associated.
   --  ------------------------------
   procedure Set_Entity_Type (Into  : in out Comment_List_Bean;
                              Table : in ADO.Schemas.Class_Mapping_Access) is
   begin
      Into.Entity_Type := Ada.Strings.Unbounded.To_Unbounded_String (Table.Table.all);
   end Set_Entity_Type;

   --  ------------------------------
   --  Set the permission to check before removing or adding a comment on the entity.
   --  ------------------------------
   procedure Set_Permission (Into       : in out Comment_List_Bean;
                             Permission : in String) is
   begin
      Into.Permission := Ada.Strings.Unbounded.To_Unbounded_String (Permission);
   end Set_Permission;

   --  ------------------------------
   --  Load the comments associated with the given database identifier.
   --  ------------------------------
   procedure Load_Comments (Into          : in out Comment_List_Bean;
                            Session       : in ADO.Sessions.Session;
                            For_Entity_Id : in ADO.Identifier) is
      use ADO.Sessions.Entities;

      Entity_Type : constant String := Ada.Strings.Unbounded.To_String (Into.Entity_Type);
      Kind        : constant ADO.Entity_Type := Find_Entity_Type (Session, Entity_Type);
      Query       : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Comments.Models.Query_Comment_List);
      Query.Bind_Param ("entity_type", Kind);
      Query.Bind_Param ("entity_id", For_Entity_Id);
      declare
         Stmt : ADO.Statements.Query_Statement := Session.Create_Statement (Query);
      begin
         Stmt.Execute;

         while Stmt.Has_Elements loop
            Into.List.Append (Util.Beans.Objects.To_Object (Stmt.Get_String (0)));
            Stmt.Next;
         end loop;
      end;
   end Load_Comments;

   --  ------------------------------
   --  Create the comment list bean instance.
   --  ------------------------------
   function Create_Comment_List_Bean (Module : in AWA.Comments.Modules.Comment_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Result : constant Comment_List_Bean_Access := new Comment_List_Bean;
   begin
      Result.Module := Module;
      return Result.all'Access;
   end Create_Comment_List_Bean;

end AWA.Comments.Beans;

Implement the Comment_Bean with the create operation


-----------------------------------------------------------------------
--  mat-readers -- Reader
--  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 Util.Log.Loggers;

with MAT.Events;
with MAT.Types;
with MAT.Readers.Marshaller;
with Interfaces;
package body MAT.Readers is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers");

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type is
   begin
      return Ada.Containers.Hash_Type (Key);
   end Hash;

   --  ------------------------------
   --  Register the reader to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   --  ------------------------------
   procedure Register_Reader (Into   : in out Manager_Base;
                              Reader : in Reader_Access;
                              Name   : in String;
                              Id     : in MAT.Events.Internal_Reference;
                              Model  : in MAT.Events.Const_Attribute_Table_Access) is
      Handler : Message_Handler;
   begin
      Handler.For_Servant := Reader;
      Handler.Id := Id;
      Handler.Attributes  := Model;
      Handler.Mapping     := null;
      Into.Readers.Insert (Name, Handler);
   end Register_Reader;

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg    : in out Message) is
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Handler_Maps.Cursor := Client.Handlers.Find (Event);
   begin
      if Handler_Maps.Has_Element (Pos) then
         --  Message is not handled, skip it.
         null;
      else
         declare
            Handler : constant Message_Handler := Handler_Maps.Element (Pos);
         begin
            Dispatch (Handler.For_Servant.all, Handler.Id, Handler.Mapping.all'Access, Msg);
         end;
      end if;
   end Dispatch_Message;

   --  ------------------------------
   --  Read an event definition from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Definition (Client : in out Manager_Base;
                              Msg    : in out Message) is
      Name  : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count : constant MAT.Types.Uint8 := MAT.Readers.Marshaller.Get_Uint8 (Msg.Buffer);
      Pos   : constant Reader_Maps.Cursor := Client.Readers.Find (Name);

      procedure Read_Attributes (Key     : in String;
                                 Element : in out Message_Handler) is
      begin
         Element.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
         for I in 1 .. Natural (Count) loop
            declare
               Name : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
               Size : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
            begin
               for J in Element.Attributes'Range loop
                  if Element.Attributes (J).Name.all = Name then
                     Element.Mapping (I) := Element.Attributes (J);
                  end if;
               end loop;
            end;
         end loop;
      end Read_Attributes;

   begin
      Log.Debug ("Read event definition {0}", Name);
      if Reader_Maps.Has_Element (Pos) then
         Client.Readers.Update_Element (Pos, Read_Attributes'Access);
      end if;
   end Read_Definition;

   procedure Read_Headers (Client : in out Manager_Base;
                           Msg    : in out Message) is
      Count : MAT.Types.Uint16;
   begin
      Client.Version := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Client.Flags   := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

      Log.Info ("Read event stream version {0} with {1} definitions",
                MAT.Types.Uint16'Image (Client.Version),
                MAT.Types.Uint16'Image (Count));
      for I in 1 .. Count loop
         Read_Definition (Client, Msg);
      end loop;
   end Read_Headers;

end MAT.Readers;

-----------------------------------------------------------------------
--  mat-readers -- Reader
--  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 Util.Log.Loggers;

with MAT.Events;
with MAT.Types;
with MAT.Readers.Marshaller;
with Interfaces;
package body MAT.Readers is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers");

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type is
   begin
      return Ada.Containers.Hash_Type (Key);
   end Hash;

   --  ------------------------------
   --  Register the reader to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   --  ------------------------------
   procedure Register_Reader (Into   : in out Manager_Base;
                              Reader : in Reader_Access;
                              Name   : in String;
                              Id     : in MAT.Events.Internal_Reference;
                              Model  : in MAT.Events.Const_Attribute_Table_Access) is
      Handler : Message_Handler;
   begin
      Handler.For_Servant := Reader;
      Handler.Id := Id;
      Handler.Attributes  := Model;
      Handler.Mapping     := null;
      Into.Readers.Insert (Name, Handler);
   end Register_Reader;

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg    : in out Message) is
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Handler_Maps.Cursor := Client.Handlers.Find (Event);
   begin
      if Handler_Maps.Has_Element (Pos) then
         --  Message is not handled, skip it.
         null;
      else
         declare
            Handler : constant Message_Handler := Handler_Maps.Element (Pos);
         begin
            Dispatch (Handler.For_Servant.all, Handler.Id, Handler.Mapping.all'Access, Msg);
         end;
      end if;
   end Dispatch_Message;

   --  ------------------------------
   --  Read an event definition from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Definition (Client : in out Manager_Base;
                              Msg    : in out Message) is
      Name  : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count : constant MAT.Types.Uint8 := MAT.Readers.Marshaller.Get_Uint8 (Msg.Buffer);
      Pos   : constant Reader_Maps.Cursor := Client.Readers.Find (Name);

      procedure Read_Attributes (Key     : in String;
                                 Element : in out Message_Handler) is
      begin
         Element.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
         for I in 1 .. Natural (Count) loop
            declare
               Name : constant String := MAT.Readers.Marshaller.Get_String (Msg.Buffer);
               Size : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
            begin
               for J in Element.Attributes'Range loop
                  if Element.Attributes (J).Name.all = Name then
                     Element.Mapping (I) := Element.Attributes (J);
                  end if;
               end loop;
            end;
         end loop;
      end Read_Attributes;

   begin
      Log.Debug ("Read event definition {0}", Name);
      if Reader_Maps.Has_Element (Pos) then
         Client.Readers.Update_Element (Pos, Read_Attributes'Access);
      end if;
   end Read_Definition;

   --  ------------------------------
   --  Read the event data stream headers with the event description.
   --  Configure the reader to analyze the data stream according to the event descriptions.
   --  ------------------------------
   procedure Read_Headers (Client : in out Manager_Base;
                           Msg    : in out Message) is
      Count : MAT.Types.Uint16;
   begin
      Client.Version := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

      Log.Info ("Read event stream version {0} with {1} definitions",
                MAT.Types.Uint16'Image (Client.Version),
                MAT.Types.Uint16'Image (Count));
      for I in 1 .. Count loop
         Read_Definition (Client, Msg);
      end loop;
   end Read_Headers;

end MAT.Readers;

Add documentation on Read_Headers

Add documentation on Read_Headers


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

with Util.Test_Caller;

with ADO;

with Security.Contexts;

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

   use Util.Tests;
   use ADO;

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

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

   end Add_Tests;

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

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

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

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

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

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

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

         Manager.Delete_Post (Post_Id => Post_Id);

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

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

   end Test_Create_Post;

end AWA.Blogs.Modules.Tests;

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

with Util.Test_Caller;

with ADO;

with Security.Contexts;

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

   use Util.Tests;
   use ADO;

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

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

   end Add_Tests;

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

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

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

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

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

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

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

         Manager.Delete_Post (Post_Id => Post_Id);

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

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

   end Test_Create_Post;

end AWA.Blogs.Modules.Tests;

Update the unit tests

Update the unit tests


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

with Util.Streams.Buffered;
package body Util.Measures is

   ISO_DATE_TIME : constant GNAT.Calendar.Time_IO.Picture_String := "%Y-%m-%d %H:%M:%S";

   procedure Free is
     new Ada.Unchecked_Deallocation (Buckets_Type, Buckets_Access);

   procedure Free is
     new Ada.Unchecked_Deallocation (Measure, Measure_Access);

   procedure Free is
     new Ada.Unchecked_Deallocation (String, String_Access);

   package Task_Context is new Ada.Task_Attributes
     (Measure_Set_Access, null);

   function Format (D : in Duration) return String;

   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   function Format (D    : in Duration;
                    Unit : in Unit_Type) return String;

   --  ------------------------------
   --  Disable collecting measures on the measure set.
   --  ------------------------------
   procedure Disable (Measures : in out Measure_Set) is
   begin
      Measures.Enabled := False;
   end Disable;

   --  ------------------------------
   --  Enable collecting measures on the measure set.
   --  ------------------------------
   procedure Enable (Measures : in out Measure_Set) is
   begin
      Measures.Enabled := True;
   end Enable;

   --  ------------------------------
   --  Set the per-thread measure set.
   --  ------------------------------
   procedure Set_Current (Measures : in Measure_Set_Access) is
   begin
      Task_Context.Set_Value (Measures);
   end Set_Current;

   --  ------------------------------
   --  Get the per-thread measure set.
   --  ------------------------------
   function Get_Current return Measure_Set_Access is
   begin
      return Task_Context.Value;
   end Get_Current;

   --  ------------------------------
   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in out Util.Streams.Texts.Print_Stream'Class) is

      use Util.Streams.Buffered;

      procedure Dump_XML (Item : in Measure_Access);

      procedure Dump_XML (Item : in Measure_Access) is
         Time  : constant String := Format (Item.Time);
      begin
         Stream.Write ("<time count=""");
         Stream.Write (Item.Count);
         Stream.Write (""" time=""");
         Stream.Write (Time (Time'First + 1 .. Time'Last));
         Stream.Write (""" title=""");
         Util.Streams.Texts.TR.Escape_Java_Script (Into => Buffered_Stream (Stream),
                                                   Content => Item.Name.all);
         Stream.Write ("""/>");
         Stream.Write (ASCII.LF);
      end Dump_XML;

      Buckets : Buckets_Access;
      TS, TE  : Ada.Calendar.Time;

   begin
      Measures.Data.Steal_Map (Buckets, TS, TE);
      Stream.Write ("<measures title=""");
      Util.Streams.Texts.TR.Escape_Java_Script (Into    => Buffered_Stream (Stream),
                                                Content => Title);
      Stream.Write (""" start=""");
      Stream.Write (TS, ISO_DATE_TIME);
      Stream.Write (""" end=""");
      Stream.Write (TE, ISO_DATE_TIME);
      Stream.Write (""">");
      if Buckets /= null then
         begin
            for I in Buckets'Range loop
               declare
                  Next : Measure_Access;
                  Node : Measure_Access := Buckets (I);
               begin
                  while Node /= null loop
                     Dump_XML (Node);
                     Free (Node.Name);
                     Next := Node.Next;
                     Free (Node);
                     Node := Next;
                  end loop;
               end;
            end loop;

         exception
            when others =>
               Free (Buckets);
               raise;
         end;
         Free (Buckets);
      end if;
      Stream.Write ("</measures>");
   end Write;

   --  ------------------------------
   --  Dump an XML result with the measures collected by the measure set.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in Ada.Text_IO.File_Type) is

      Buffer : aliased Util.Streams.Buffered.Buffered_Stream;
      Output : Util.Streams.Texts.Print_Stream;

   begin
      Buffer.Initialize (Size => 128 * 1024);
      Output.Initialize (To => Buffer'Unchecked_Access);
      Write (Measures, Title, Output);
      Output.Flush;
      Ada.Text_IO.Put_Line (Stream, Util.Streams.Texts.To_String (Buffer));
   end Write;

   --  ------------------------------
   --  Dump  an XML result with the measures in a file.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Path     : in String) is
      File : Ada.Text_IO.File_Type;
   begin
      Ada.Text_IO.Create (File => File, Name => Path);
      Write (Measures, Title, File);
      Ada.Text_IO.Close (File);
   exception
      when others =>
         if Ada.Text_IO.Is_Open (File) then
            Ada.Text_IO.Close (File);
         end if;
         raise;
   end Write;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the per-thread measure set under the given measure
   --  title.
   --  ------------------------------
   procedure Report (S     : in out Stamp;
                     Title : in String) is
      Measures : constant Measure_Set_Access := Task_Context.Value;
   begin
      if Measures /= null and then Measures.Enabled then
         Report (Measures.all, S, Title);
      end if;
   end Report;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the measure set under the given measure title.
   --  ------------------------------
   procedure Report (Measures : in out Measure_Set;
                     S        : in out Stamp;
                     Title    : in String) is
      use Ada.Calendar;
   begin
      if Measures.Enabled then
         declare
            D : constant Duration := Ada.Calendar.Clock - S.Start;
         begin
            Measures.Data.Add (Title, D);
         end;
         S.Start := Ada.Calendar.Clock;
      end if;
   end Report;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  The report is written in the file with the given title.  The duration is
   --  expressed in the unit defined in <tt>Unit</tt>.
   --  ------------------------------
   procedure Report (S     : in out Stamp;
                     File  : in out Ada.Text_IO.File_Type;
                     Title : in String;
                     Unit  : in Unit_Type := Microseconds) is
      use Ada.Calendar;

      D : constant Duration := Ada.Calendar.Clock - S.Start;
   begin
      Ada.Text_IO.Put (File, Title);
      Ada.Text_IO.Put (File, Format (D, Unit));
      S.Start := Ada.Calendar.Clock;
   end Report;

   protected body Measure_Data is

      --  ------------------------------
      --  Get the measures and clear to start a new set of measures.
      --  Return in Time_Start and Time_End the period of time.
      --  ------------------------------
      procedure Steal_Map (Result     : out Buckets_Access;
                           Time_Start : out Ada.Calendar.Time;
                           Time_End   : out Ada.Calendar.Time) is
      begin
         Result     := Buckets;
         Time_Start := Start;
         Start      := Ada.Calendar.Clock;
         Time_End   := Start;
         Buckets    := null;
      end Steal_Map;

      --  ------------------------------
      --  Add the measure
      --  ------------------------------
      procedure Add (Title : String; D : Duration) is

         use Ada.Containers;
         use Ada.Calendar;

         Pos  : Hash_Type;
         Node : Measure_Access;
      begin
         if Buckets = null then
            Buckets := new Buckets_Type (0 .. 256);
         end if;
         Pos := Ada.Strings.Hash (Title) mod Buckets'Length;
         Node := Buckets (Pos);
         while Node /= null loop
            if Node.Name'Length = Title'Length
              and then Node.Name.all = Title then
               Node.Count := Node.Count + 1;
               Node.Time := Node.Time + D;
               return;
            end if;
            Node := Node.Next;
         end loop;
         Buckets (Pos) := new Measure '(Name => new String '(Title),
                                        Time  => D,
                                        Count => 1,
                                        Next  => Buckets (Pos));
      end Add;

   end Measure_Data;

   --  ------------------------------
   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   --  ------------------------------
   function Format (D : Duration) return String is
   begin
      if D < 0.000_001 then
         return Duration'Image (D * 1_000_000_000) & "ns";
      elsif D < 0.001 then
         return Duration'Image (D * 1_000_000) & "us";
      elsif D < 1.0 then
         return Duration'Image (D * 1_000) & "ms";
      else
         return Duration'Image (D) & "s";
      end if;
   end Format;

   --  ------------------------------
   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   --  ------------------------------
   function Format (D    : in Duration;
                    Unit : in Unit_Type) return String is
   begin
      case Unit is
         when Seconds =>
            return Duration'Image (D);

         when Milliseconds =>
            return Duration'Image (D * 1_000);

         when Microseconds =>
            return Duration'Image (D * 1_000_000);

         when Nanoseconds =>
            return Duration'Image (D * 1_000_000_000);

      end case;
   end Format;

   --  ------------------------------
   --  Finalize the measures and release the storage.
   --  ------------------------------
   overriding
   procedure Finalize (Measures : in out Measure_Set) is
      Buckets : Buckets_Access;
      TS, TE  : Ada.Calendar.Time;
   begin
      --  When deleting the measure set, we have to release the buckets and measures
      --  that were allocated.  We could call Write but we don't know where
      --  the measures have to be written.
      Measures.Data.Steal_Map (Buckets, TS, TE);
      if Buckets /= null then
         for I in Buckets'Range loop
            declare
               Next : Measure_Access;
               Node : Measure_Access := Buckets (I);
            begin
               while Node /= null loop
                  Free (Node.Name);
                  Next := Node.Next;
                  Free (Node);
                  Node := Next;
               end loop;
            end;
         end loop;
         Free (Buckets);
      end if;
   end Finalize;

end Util.Measures;

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

with Util.Streams.Buffered;
package body Util.Measures is

   ISO_DATE_TIME : constant GNAT.Calendar.Time_IO.Picture_String := "%Y-%m-%d %H:%M:%S";

   procedure Free is
     new Ada.Unchecked_Deallocation (Buckets_Type, Buckets_Access);

   procedure Free is
     new Ada.Unchecked_Deallocation (Measure, Measure_Access);

   procedure Free is
     new Ada.Unchecked_Deallocation (String, String_Access);

   package Task_Context is new Ada.Task_Attributes
     (Measure_Set_Access, null);

   function Format (D : in Duration) return String;

   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   function Format (D    : in Duration;
                    Unit : in Unit_Type) return String;

   --  ------------------------------
   --  Disable collecting measures on the measure set.
   --  ------------------------------
   procedure Disable (Measures : in out Measure_Set) is
   begin
      Measures.Enabled := False;
   end Disable;

   --  ------------------------------
   --  Enable collecting measures on the measure set.
   --  ------------------------------
   procedure Enable (Measures : in out Measure_Set) is
   begin
      Measures.Enabled := True;
   end Enable;

   --  ------------------------------
   --  Set the per-thread measure set.
   --  ------------------------------
   procedure Set_Current (Measures : in Measure_Set_Access) is
   begin
      Task_Context.Set_Value (Measures);
   end Set_Current;

   --  ------------------------------
   --  Get the per-thread measure set.
   --  ------------------------------
   function Get_Current return Measure_Set_Access is
   begin
      return Task_Context.Value;
   end Get_Current;

   --  ------------------------------
   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in out Util.Streams.Texts.Print_Stream'Class) is

      use Util.Streams.Buffered;

      procedure Dump_XML (Item : in Measure_Access);

      procedure Dump_XML (Item : in Measure_Access) is
         Time  : constant String := Format (Item.Time);
      begin
         Stream.Write ("<time count=""");
         Stream.Write (Item.Count);
         Stream.Write (""" time=""");
         Stream.Write (Time (Time'First + 1 .. Time'Last));
         Stream.Write (""" title=""");
         Util.Streams.Texts.TR.Escape_Java_Script (Into => Buffered_Stream (Stream),
                                                   Content => Item.Name.all);
         Stream.Write ("""/>");
         Stream.Write (ASCII.LF);
      end Dump_XML;

      Buckets : Buckets_Access;
      TS, TE  : Ada.Calendar.Time;

   begin
      Measures.Data.Steal_Map (Buckets, TS, TE);
      Stream.Write ("<measures title=""");
      Util.Streams.Texts.TR.Escape_Java_Script (Into    => Buffered_Stream (Stream),
                                                Content => Title);
      Stream.Write (""" start=""");
      Stream.Write (TS, ISO_DATE_TIME);
      Stream.Write (""" end=""");
      Stream.Write (TE, ISO_DATE_TIME);
      Stream.Write (""">");
      if Buckets /= null then
         begin
            for I in Buckets'Range loop
               declare
                  Next : Measure_Access;
                  Node : Measure_Access := Buckets (I);
               begin
                  while Node /= null loop
                     Dump_XML (Node);
                     Free (Node.Name);
                     Next := Node.Next;
                     Free (Node);
                     Node := Next;
                  end loop;
               end;
            end loop;

         exception
            when others =>
               Free (Buckets);
               raise;
         end;
         Free (Buckets);
      end if;
      Stream.Write ("</measures>");
   end Write;

   --  ------------------------------
   --  Dump an XML result with the measures collected by the measure set.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in Ada.Text_IO.File_Type) is

      Buffer : aliased Util.Streams.Buffered.Buffered_Stream;
      Output : Util.Streams.Texts.Print_Stream;

   begin
      Buffer.Initialize (Size => 128 * 1024);
      Output.Initialize (To => Buffer'Unchecked_Access);
      Write (Measures, Title, Output);
      Output.Flush;
      Ada.Text_IO.Put_Line (Stream, Util.Streams.Texts.To_String (Buffer));
   end Write;

   --  ------------------------------
   --  Dump  an XML result with the measures in a file.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Path     : in String) is
      File : Ada.Text_IO.File_Type;
   begin
      Ada.Text_IO.Create (File => File, Name => Path);
      Write (Measures, Title, File);
      Ada.Text_IO.Close (File);
   exception
      when others =>
         if Ada.Text_IO.Is_Open (File) then
            Ada.Text_IO.Close (File);
         end if;
         raise;
   end Write;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the per-thread measure set under the given measure
   --  title.
   --  ------------------------------
   procedure Report (S     : in out Stamp;
                     Title : in String;
                     Count : in Positive := 1) is
      Measures : constant Measure_Set_Access := Task_Context.Value;
   begin
      if Measures /= null and then Measures.Enabled then
         Report (Measures.all, S, Title, Count);
      end if;
   end Report;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the measure set under the given measure title.
   --  ------------------------------
   procedure Report (Measures : in out Measure_Set;
                     S        : in out Stamp;
                     Title    : in String;
                     Count    : in Positive := 1) is
      use Ada.Calendar;
   begin
      if Measures.Enabled then
         declare
            D : constant Duration := Ada.Calendar.Clock - S.Start;
         begin
            Measures.Data.Add (Title, D, Count);
         end;
         S.Start := Ada.Calendar.Clock;
      end if;
   end Report;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  The report is written in the file with the given title.  The duration is
   --  expressed in the unit defined in <tt>Unit</tt>.
   --  ------------------------------
   procedure Report (S     : in out Stamp;
                     File  : in out Ada.Text_IO.File_Type;
                     Title : in String;
                     Unit  : in Unit_Type := Microseconds) is
      use Ada.Calendar;

      D : constant Duration := Ada.Calendar.Clock - S.Start;
   begin
      Ada.Text_IO.Put (File, Title);
      Ada.Text_IO.Put (File, Format (D, Unit));
      S.Start := Ada.Calendar.Clock;
   end Report;

   protected body Measure_Data is

      --  ------------------------------
      --  Get the measures and clear to start a new set of measures.
      --  Return in Time_Start and Time_End the period of time.
      --  ------------------------------
      procedure Steal_Map (Result     : out Buckets_Access;
                           Time_Start : out Ada.Calendar.Time;
                           Time_End   : out Ada.Calendar.Time) is
      begin
         Result     := Buckets;
         Time_Start := Start;
         Start      := Ada.Calendar.Clock;
         Time_End   := Start;
         Buckets    := null;
      end Steal_Map;

      --  ------------------------------
      --  Add the measure
      --  ------------------------------
      procedure Add (Title : in String;
                     D     : in Duration;
                     Count : in Positive := 1) is

         use Ada.Containers;
         use Ada.Calendar;

         Pos  : Hash_Type;
         Node : Measure_Access;
      begin
         if Buckets = null then
            Buckets := new Buckets_Type (0 .. 256);
         end if;
         Pos := Ada.Strings.Hash (Title) mod Buckets'Length;
         Node := Buckets (Pos);
         while Node /= null loop
            if Node.Name'Length = Title'Length
              and then Node.Name.all = Title then
               Node.Count := Node.Count + Count;
               Node.Time := Node.Time + D;
               return;
            end if;
            Node := Node.Next;
         end loop;
         Buckets (Pos) := new Measure '(Name => new String '(Title),
                                        Time  => D,
                                        Count => Count,
                                        Next  => Buckets (Pos));
      end Add;

   end Measure_Data;

   --  ------------------------------
   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   --  ------------------------------
   function Format (D : Duration) return String is
   begin
      if D < 0.000_001 then
         return Duration'Image (D * 1_000_000_000) & "ns";
      elsif D < 0.001 then
         return Duration'Image (D * 1_000_000) & "us";
      elsif D < 1.0 then
         return Duration'Image (D * 1_000) & "ms";
      else
         return Duration'Image (D) & "s";
      end if;
   end Format;

   --  ------------------------------
   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   --  ------------------------------
   function Format (D    : in Duration;
                    Unit : in Unit_Type) return String is
   begin
      case Unit is
         when Seconds =>
            return Duration'Image (D);

         when Milliseconds =>
            return Duration'Image (D * 1_000);

         when Microseconds =>
            return Duration'Image (D * 1_000_000);

         when Nanoseconds =>
            return Duration'Image (D * 1_000_000_000);

      end case;
   end Format;

   --  ------------------------------
   --  Finalize the measures and release the storage.
   --  ------------------------------
   overriding
   procedure Finalize (Measures : in out Measure_Set) is
      Buckets : Buckets_Access;
      TS, TE  : Ada.Calendar.Time;
   begin
      --  When deleting the measure set, we have to release the buckets and measures
      --  that were allocated.  We could call Write but we don't know where
      --  the measures have to be written.
      Measures.Data.Steal_Map (Buckets, TS, TE);
      if Buckets /= null then
         for I in Buckets'Range loop
            declare
               Next : Measure_Access;
               Node : Measure_Access := Buckets (I);
            begin
               while Node /= null loop
                  Free (Node.Name);
                  Next := Node.Next;
                  Free (Node);
                  Node := Next;
               end loop;
            end;
         end loop;
         Free (Buckets);
      end if;
   end Finalize;

end Util.Measures;

Use the Count parameter from the Report to keep track of the number of times the measure is made


-----------------------------------------------------------------------
--  util-encodes-tests - Test for encoding
--  Copyright (C) 2009, 2010, 2011, 2012, 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 Util.Tests;
package Util.Encoders.Tests is

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

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

   procedure Test_Hex (T : in out Test);
   procedure Test_Base64_Encode (T : in out Test);
   procedure Test_Base64_Decode (T : in out Test);
   procedure Test_Base64_URL_Encode (T : in out Test);
   procedure Test_Base64_URL_Decode (T : in out Test);
   procedure Test_Encoder (T : in out Test;
                           C : in out Util.Encoders.Encoder);
   procedure Test_Base64_Benchmark (T : in out Test);
   procedure Test_SHA1_Encode (T : in out Test);
   procedure Test_SHA256_Encode (T : in out Test);

   --  Benchmark test for SHA1
   procedure Test_SHA1_Benchmark (T : in out Test);

   --  Test HMAC-SHA1
   procedure Test_HMAC_SHA1_RFC2202_T1 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T2 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T3 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T4 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T5 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T6 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T7 (T : in out Test);

   --  Test HMAC-SHA256
   procedure Test_HMAC_SHA256_RFC4231_T1 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T2 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T3 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T4 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T5 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T6 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T7 (T : in out Test);

   --  Test encoding leb128.
   procedure Test_LEB128 (T : in out Test);

   --  Test encoding leb128 + base64url.
   procedure Test_Base64_LEB128 (T : in out Test);

   --  Test encrypt and decrypt operations.
   procedure Test_AES (T : in out Test);

end Util.Encoders.Tests;

-----------------------------------------------------------------------
--  util-encodes-tests - Test for encoding
--  Copyright (C) 2009, 2010, 2011, 2012, 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 Util.Tests;
package Util.Encoders.Tests is

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

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

   procedure Test_Hex (T : in out Test);
   procedure Test_Base64_Encode (T : in out Test);
   procedure Test_Base64_Decode (T : in out Test);
   procedure Test_Base64_URL_Encode (T : in out Test);
   procedure Test_Base64_URL_Decode (T : in out Test);
   procedure Test_Encoder (T : in out Test;
                           C : in Util.Encoders.Encoder;
                           D : in Util.Encoders.Decoder);
   procedure Test_Base64_Benchmark (T : in out Test);
   procedure Test_SHA1_Encode (T : in out Test);
   procedure Test_SHA256_Encode (T : in out Test);

   --  Benchmark test for SHA1
   procedure Test_SHA1_Benchmark (T : in out Test);

   --  Test HMAC-SHA1
   procedure Test_HMAC_SHA1_RFC2202_T1 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T2 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T3 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T4 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T5 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T6 (T : in out Test);
   procedure Test_HMAC_SHA1_RFC2202_T7 (T : in out Test);

   --  Test HMAC-SHA256
   procedure Test_HMAC_SHA256_RFC4231_T1 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T2 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T3 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T4 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T5 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T6 (T : in out Test);
   procedure Test_HMAC_SHA256_RFC4231_T7 (T : in out Test);

   --  Test encoding leb128.
   procedure Test_LEB128 (T : in out Test);

   --  Test encoding leb128 + base64url.
   procedure Test_Base64_LEB128 (T : in out Test);

   --  Test encrypt and decrypt operations.
   procedure Test_AES (T : in out Test);

end Util.Encoders.Tests;

Add a decoder object to Test_Encoder operation


-----------------------------------------------------------------------
--  ADO Objects Tests -- Tests for ADO.Objects
--  Copyright (C) 2011, 2012, 2013, 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 Util.Test_Caller;
with ADO.Sessions;
with Regtests.Simple.Model;
with Regtests.Comments;
with Regtests.Statements.Model;
package body ADO.Objects.Tests is

   use Util.Tests;
   use type Ada.Containers.Hash_Type;

   --  Test the Set_xxx and Get_xxx operation on various simple times.
   generic
      Name : String;
      type Element_Type (<>) is private;
      with function "=" (Left, Right : in Element_Type) return Boolean is <>;
      with procedure Set_Value (Item : in out Regtests.Statements.Model.Nullable_Table_Ref;
                                Val  : in Element_Type);
      with function Get_Value (Item : in Regtests.Statements.Model.Nullable_Table_Ref)
                               return Element_Type;
      Val1 : Element_Type;
      Val2 : Element_Type;
   procedure Test_Op (T : in out Test);

   procedure Test_Op (T : in out Test) is
      Item1 : Regtests.Statements.Model.Nullable_Table_Ref;
      Item2 : Regtests.Statements.Model.Nullable_Table_Ref;
      Item3 : Regtests.Statements.Model.Nullable_Table_Ref;
      DB    : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
   begin
      Set_Value (Item1, Val1);
      Item1.Save (DB);
      T.Assert (Item1.Is_Inserted, Name & " item is created");
      --  Util.Tests.Assert_Equals (T, T'Image (Val), T'Image (

      --  Load in a second item and check the value.
      Item2.Load (DB, Item1.Get_Id);
      T.Assert (Item2.Get_Id = Item1.Get_Id, Name & " item2 cannot be loaded");
      --  T.Assert (Get_Value (Item2) = Val1, Name & " invalid value loaded in item2");

      --  Change the item in database.
      Set_Value (Item2, Val2);
      Item2.Save (DB);
      T.Assert (Get_Value (Item2) = Val2, Name & " invalid value loaded in item2");

      --  Load again and compare to check the update.
      Item3.Load (DB, Item2.Get_Id);
      T.Assert (Get_Value (Item3) = Val2, Name & " invalid value loaded in item3");
   end Test_Op;

   procedure Test_Object_Nullable_Integer is
     new Test_Op ("Nullable_Integer",
                  Nullable_Integer, "=",
                  Regtests.Statements.Model.Set_Int_Value,
                  Regtests.Statements.Model.Get_Int_Value,
                  Nullable_Integer '(Value => 123, Is_Null => False),
                  Nullable_Integer '(Value => 0, Is_Null => True));

   procedure Test_Object_Nullable_Entity_Type is
     new Test_Op ("Nullable_Entity_Type",
                  Nullable_Entity_Type, "=",
                  Regtests.Statements.Model.Set_Entity_Value,
                  Regtests.Statements.Model.Get_Entity_Value,
                  Nullable_Entity_Type '(Value => 456, Is_Null => False),
                  Nullable_Entity_Type '(Value => 0, Is_Null => True));

   procedure Test_Object_Nullable_Time is
     new Test_Op ("Nullable_Time",
                  Nullable_Time, "=",
                  Regtests.Statements.Model.Set_Time_Value,
                  Regtests.Statements.Model.Get_Time_Value,
                  Nullable_Time '(Value => 456, Is_Null => False),
                  Nullable_Time '(Value => <>, Is_Null => False));

   function Get_Allocate_Key (N : Identifier) return Object_Key;

   function Get_Allocate_Key (N : Identifier) return Object_Key is
      Result : Object_Key (Of_Type  => KEY_INTEGER,
                           Of_Class => Regtests.Simple.Model.ALLOCATE_TABLE);
   begin
      Set_Value (Result, N);
      return Result;
   end Get_Allocate_Key;

   --  ------------------------------
   --  Various tests on Hash and key comparison
   --  ------------------------------
   procedure Test_Key (T : in out Test) is
      K1 : constant Object_Key := Get_Allocate_Key (1);
      K2 : Object_Key (Of_Type  => KEY_STRING,
                       Of_Class => Regtests.Simple.Model.USER_TABLE);
      K3 : Object_Key := K1;
      K4 : Object_Key (Of_Type  => KEY_INTEGER,
                       Of_Class => Regtests.Simple.Model.USER_TABLE);
   begin
      T.Assert (not (K1 = K2), "Key on different tables must be different");
      T.Assert (not (K2 = K4), "Key with different type must be different");
      T.Assert (K1 = K3, "Keys are identical");
      T.Assert (Equivalent_Elements (K1, K3), "Keys are identical");
      T.Assert (Equivalent_Elements (K3, K1), "Keys are identical");

      T.Assert (Hash (K1) = Hash (K3), "Hash of identical keys should be identical");

      Set_Value (K3, 2);
      T.Assert (not (K1 = K3), "Keys should be different");
      T.Assert (Hash (K1) /= Hash (K3), "Hash should be different");
      T.Assert (Hash (K1) /= Hash (K2), "Hash should be different");

      Set_Value (K4, 1);
      T.Assert (Hash (K1) /= Hash (K4),
               "Hash on key with same value and different tables should be different");
      T.Assert (not (K4 = K1), "Key on different tables should be different");

      Set_Value (K2, 1);
      T.Assert (Hash (K1) /= Hash (K2), "Hash should be different");
   end Test_Key;

   --  ------------------------------
   --  Check:
   --    Object_Ref := (reference counting)
   --    Object_Ref.Copy
   --    Object_Ref.Get_xxx generated method
   --    Object_Ref.Set_xxx generated method
   --    Object_Ref.=
   --  ------------------------------
   procedure Test_Object_Ref (T : in out Test) is
      use type Regtests.Simple.Model.User_Ref;
      Obj1     : Regtests.Simple.Model.User_Ref;
      Null_Obj : Regtests.Simple.Model.User_Ref;
   begin
      T.Assert (Obj1 = Null_Obj, "Two null objects are identical");
      for I in 1 .. 10 loop
         Obj1.Set_Name ("User name");
         T.Assert (Obj1.Get_Name = "User name", "User_Ref.Set_Name invalid result");

         T.Assert (Obj1 /= Null_Obj, "Object is not identical as the null object");
         declare
            Obj2 : constant Regtests.Simple.Model.User_Ref := Obj1;
            Obj3 : Regtests.Simple.Model.User_Ref;
         begin
            Obj1.Copy (Obj3);
            Obj3.Set_Id (2);
            --  Check the copy
            T.Assert (Obj2.Get_Name = "User name", "Object_Ref.Copy invalid copy");
            T.Assert (Obj3.Get_Name = "User name", "Object_Ref.Copy invalid copy");
            T.Assert (Obj2 = Obj1, "Object_Ref.'=' invalid comparison after assignment");

            T.Assert (Obj3 /= Obj1, "Object_Ref.'=' invalid comparison after copy");

            --  Change original, make sure it's the same of Obj2.
            Obj1.Set_Name ("Second name");
            T.Assert (Obj2.Get_Name = "Second name", "Object_Ref.Copy invalid copy");
            T.Assert (Obj2 = Obj1, "Object_Ref.'=' invalid comparison after assignment");

            --  The copy is not modified
            T.Assert (Obj3.Get_Name = "User name", "Object_Ref.Copy invalid copy");
         end;
      end loop;
   end Test_Object_Ref;

   --  ------------------------------
   --  Test creation of an object with lazy loading.
   --  ------------------------------
   procedure Test_Create_Object (T : in out Test) is
      User : Regtests.Simple.Model.User_Ref;
      Cmt  : Regtests.Comments.Comment_Ref;
   begin
      --  Create an object within a transaction.
      declare
         S : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      begin
         S.Begin_Transaction;
         User.Set_Name ("Joe");
         User.Set_Value (0);
         User.Save (S);
         S.Commit;
      end;

      --  Load it from another session.
      declare
         S  : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
         U2 : Regtests.Simple.Model.User_Ref;
      begin
         U2.Load (S, User.Get_Id);
         Assert_Equals (T, "Joe", Ada.Strings.Unbounded.To_String (U2.Get_Name),
                        "Cannot load created object");
         Assert_Equals (T, Integer (0), Integer (U2.Get_Value), "Invalid load");
         T.Assert (User.Get_Key = U2.Get_Key, "Invalid key after load");
      end;

      --  Create a comment for the user.
      declare
         S  : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      begin
         S.Begin_Transaction;
         Cmt.Set_Message (Ada.Strings.Unbounded.To_Unbounded_String ("A comment from Joe"));
         Cmt.Set_User (User);
         Cmt.Set_Entity_Id (2);
         Cmt.Set_Entity_Type (1);
         --  Cmt.Set_Date (ADO.DEFAULT_TIME);
         Cmt.Set_Date (Ada.Calendar.Clock);
         Cmt.Save (S);
         S.Commit;
      end;

      --  Load that comment.
      declare
         S  : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
         C2 : Regtests.Comments.Comment_Ref;
      begin
         T.Assert (not C2.Is_Loaded, "Object is not loaded");
         C2.Load (S, Cmt.Get_Id);
         T.Assert (not C2.Is_Null, "Loading of object failed");
         T.Assert (C2.Is_Loaded, "Object is loaded");
         T.Assert (Cmt.Get_Key = C2.Get_Key, "Invalid key after load");
         T.Assert_Equals ("A comment from Joe", Ada.Strings.Unbounded.To_String (C2.Get_Message),
                          "Invalid message");

         T.Assert (not C2.Get_User.Is_Null, "User associated with the comment should not be null");
--           T.Assert (not C2.Get_Entity_Type.Is_Null, "Entity type was not set");

         --  Check that we can access the user name (lazy load)
         Assert_Equals (T, "Joe", Ada.Strings.Unbounded.To_String (C2.Get_User.Get_Name),
                        "Cannot load created object");
      end;
   end Test_Create_Object;

   --  ------------------------------
   --  Test creation and deletion of an object record
   --  ------------------------------
   procedure Test_Delete_Object (T : in out Test) is
      User : Regtests.Simple.Model.User_Ref;
   begin
      --  Create an object within a transaction.
      declare
         S : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      begin
         S.Begin_Transaction;
         User.Set_Name ("Joe (delete)");
         User.Set_Value (0);
         User.Save (S);
         S.Commit;
      end;

      --  Load it and delete it from another session.
      declare
         S  : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
         U2 : Regtests.Simple.Model.User_Ref;
      begin
         U2.Load (S, User.Get_Id);

         S.Begin_Transaction;
         U2.Delete (S);
         S.Commit;
      end;

      --  Try to load the deleted object.
      declare
         S  : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
         U2 : Regtests.Simple.Model.User_Ref;
      begin
         U2.Load (S, User.Get_Id);
         T.Assert (False, "Load of a deleted object should raise NOT_FOUND");

      exception
         when ADO.Objects.NOT_FOUND =>
            null;
      end;
   end Test_Delete_Object;

   --  ------------------------------
   --  Test Is_Inserted and Is_Null
   --  ------------------------------
   procedure Test_Is_Inserted (T : in out Test) is
      User : Regtests.Simple.Model.User_Ref;
   begin
      T.Assert (not User.Is_Inserted, "A null object should not be marked as INSERTED");
      T.Assert (User.Is_Null, "A null object should be marked as NULL");

      --  Create an object within a transaction.
      declare
         S : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      begin
         S.Begin_Transaction;
         User.Set_Name ("John");
         T.Assert (not User.Is_Null, "User should not be NULL");
         T.Assert (not User.Is_Inserted, "User was not saved and not yet inserted in database");

         User.Set_Value (1);
         User.Save (S);
         S.Commit;
         T.Assert (User.Is_Inserted, "After a save operation, the user should be marked INSERTED");
         T.Assert (not User.Is_Null, "User should not be NULL");
      end;

      declare
         S    : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
         John : Regtests.Simple.Model.User_Ref;
      begin
         John.Load (S, User.Get_Id);
         T.Assert (John.Is_Inserted, "After a load, the object should be marked INSERTED");
         T.Assert (not John.Is_Null, "After a load, the object should not be NULL");
      end;
   end Test_Is_Inserted;

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

   --  ------------------------------
   --  Add the tests in the test suite
   --  ------------------------------
   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Objects.Hash", Test_Key'Access);
      Caller.Add_Test (Suite, "Test Object_Ref.Get/Set", Test_Object_Ref'Access);
      Caller.Add_Test (Suite, "Test ADO.Objects.Create", Test_Create_Object'Access);
      Caller.Add_Test (Suite, "Test ADO.Objects.Delete", Test_Delete_Object'Access);
      Caller.Add_Test (Suite, "Test ADO.Objects.Is_Created", Test_Is_Inserted'Access);
      Caller.Add_Test (Suite, "Test ADO.Objects (Nullable_Integer)",
                       Test_Object_Nullable_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Objects (Nullable_Entity_Type)",
                       Test_Object_Nullable_Entity_Type'Access);
      Caller.Add_Test (Suite, "Test ADO.Objects (Nullable_Time)",
                       Test_Object_Nullable_Time'Access);
   end Add_Tests;

end ADO.Objects.Tests;

-----------------------------------------------------------------------
--  ADO Objects Tests -- Tests for ADO.Objects
--  Copyright (C) 2011, 2012, 2013, 2014, 2015, 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.Test_Caller;
with ADO.Sessions;
with Regtests.Simple.Model;
with Regtests.Comments;
with Regtests.Statements.Model;
package body ADO.Objects.Tests is

   use Util.Tests;
   use type Ada.Containers.Hash_Type;

   --  Test the Set_xxx and Get_xxx operation on various simple times.
   generic
      Name : String;
      type Element_Type (<>) is private;
      with function "=" (Left, Right : in Element_Type) return Boolean is <>;
      with procedure Set_Value (Item : in out Regtests.Statements.Model.Nullable_Table_Ref;
                                Val  : in Element_Type);
      with function Get_Value (Item : in Regtests.Statements.Model.Nullable_Table_Ref)
                               return Element_Type;
      Val1 : Element_Type;
      Val2 : Element_Type;
   procedure Test_Op (T : in out Test);

   procedure Test_Op (T : in out Test) is
      Item1 : Regtests.Statements.Model.Nullable_Table_Ref;
      Item2 : Regtests.Statements.Model.Nullable_Table_Ref;
      Item3 : Regtests.Statements.Model.Nullable_Table_Ref;
      DB    : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
   begin
      Set_Value (Item1, Val1);
      Item1.Save (DB);
      T.Assert (Item1.Is_Inserted, Name & " item is created");
      --  Util.Tests.Assert_Equals (T, T'Image (Val), T'Image (

      --  Load in a second item and check the value.
      Item2.Load (DB, Item1.Get_Id);
      T.Assert (Item2.Get_Id = Item1.Get_Id, Name & " item2 cannot be loaded");
      --  T.Assert (Get_Value (Item2) = Val1, Name & " invalid value loaded in item2");

      --  Change the item in database.
      Set_Value (Item2, Val2);
      Item2.Save (DB);
      T.Assert (Get_Value (Item2) = Val2, Name & " invalid value loaded in item2");

      --  Load again and compare to check the update.
      Item3.Load (DB, Item2.Get_Id);
      T.Assert (Get_Value (Item3) = Val2, Name & " invalid value loaded in item3");
   end Test_Op;

   procedure Test_Object_Nullable_Integer is
     new Test_Op ("Nullable_Integer",
                  Nullable_Integer, "=",
                  Regtests.Statements.Model.Set_Int_Value,
                  Regtests.Statements.Model.Get_Int_Value,
                  Nullable_Integer '(Value => 123, Is_Null => False),
                  Nullable_Integer '(Value => 0, Is_Null => True));

   procedure Test_Object_Nullable_Entity_Type is
     new Test_Op ("Nullable_Entity_Type",
                  Nullable_Entity_Type, "=",
                  Regtests.Statements.Model.Set_Entity_Value,
                  Regtests.Statements.Model.Get_Entity_Value,
                  Nullable_Entity_Type '(Value => 456, Is_Null => False),
                  Nullable_Entity_Type '(Value => 0, Is_Null => True));

   procedure Test_Object_Nullable_Time is
     new Test_Op ("Nullable_Time",
                  Nullable_Time, "=",
                  Regtests.Statements.Model.Set_Time_Value,
                  Regtests.Statements.Model.Get_Time_Value,
                  Nullable_Time '(Value => 456, Is_Null => False),
                  Nullable_Time '(Value => <>, Is_Null => True));

   function Get_Allocate_Key (N : Identifier) return Object_Key;

   function Get_Allocate_Key (N : Identifier) return Object_Key is
      Result : Object_Key (Of_Type  => KEY_INTEGER,
                           Of_Class => Regtests.Simple.Model.ALLOCATE_TABLE);
   begin
      Set_Value (Result, N);
      return Result;
   end Get_Allocate_Key;

   --  ------------------------------
   --  Various tests on Hash and key comparison
   --  ------------------------------
   procedure Test_Key (T : in out Test) is
      K1 : constant Object_Key := Get_Allocate_Key (1);
      K2 : Object_Key (Of_Type  => KEY_STRING,
                       Of_Class => Regtests.Simple.Model.USER_TABLE);
      K3 : Object_Key := K1;
      K4 : Object_Key (Of_Type  => KEY_INTEGER,
                       Of_Class => Regtests.Simple.Model.USER_TABLE);
   begin
      T.Assert (not (K1 = K2), "Key on different tables must be different");
      T.Assert (not (K2 = K4), "Key with different type must be different");
      T.Assert (K1 = K3, "Keys are identical");
      T.Assert (Equivalent_Elements (K1, K3), "Keys are identical");
      T.Assert (Equivalent_Elements (K3, K1), "Keys are identical");

      T.Assert (Hash (K1) = Hash (K3), "Hash of identical keys should be identical");

      Set_Value (K3, 2);
      T.Assert (not (K1 = K3), "Keys should be different");
      T.Assert (Hash (K1) /= Hash (K3), "Hash should be different");
      T.Assert (Hash (K1) /= Hash (K2), "Hash should be different");

      Set_Value (K4, 1);
      T.Assert (Hash (K1) /= Hash (K4),
               "Hash on key with same value and different tables should be different");
      T.Assert (not (K4 = K1), "Key on different tables should be different");

      Set_Value (K2, 1);
      T.Assert (Hash (K1) /= Hash (K2), "Hash should be different");
   end Test_Key;

   --  ------------------------------
   --  Check:
   --    Object_Ref := (reference counting)
   --    Object_Ref.Copy
   --    Object_Ref.Get_xxx generated method
   --    Object_Ref.Set_xxx generated method
   --    Object_Ref.=
   --  ------------------------------
   procedure Test_Object_Ref (T : in out Test) is
      use type Regtests.Simple.Model.User_Ref;
      Obj1     : Regtests.Simple.Model.User_Ref;
      Null_Obj : Regtests.Simple.Model.User_Ref;
   begin
      T.Assert (Obj1 = Null_Obj, "Two null objects are identical");
      for I in 1 .. 10 loop
         Obj1.Set_Name ("User name");
         T.Assert (Obj1.Get_Name = "User name", "User_Ref.Set_Name invalid result");

         T.Assert (Obj1 /= Null_Obj, "Object is not identical as the null object");
         declare
            Obj2 : constant Regtests.Simple.Model.User_Ref := Obj1;
            Obj3 : Regtests.Simple.Model.User_Ref;
         begin
            Obj1.Copy (Obj3);
            Obj3.Set_Id (2);
            --  Check the copy
            T.Assert (Obj2.Get_Name = "User name", "Object_Ref.Copy invalid copy");
            T.Assert (Obj3.Get_Name = "User name", "Object_Ref.Copy invalid copy");
            T.Assert (Obj2 = Obj1, "Object_Ref.'=' invalid comparison after assignment");

            T.Assert (Obj3 /= Obj1, "Object_Ref.'=' invalid comparison after copy");

            --  Change original, make sure it's the same of Obj2.
            Obj1.Set_Name ("Second name");
            T.Assert (Obj2.Get_Name = "Second name", "Object_Ref.Copy invalid copy");
            T.Assert (Obj2 = Obj1, "Object_Ref.'=' invalid comparison after assignment");

            --  The copy is not modified
            T.Assert (Obj3.Get_Name = "User name", "Object_Ref.Copy invalid copy");
         end;
      end loop;
   end Test_Object_Ref;

   --  ------------------------------
   --  Test creation of an object with lazy loading.
   --  ------------------------------
   procedure Test_Create_Object (T : in out Test) is
      User : Regtests.Simple.Model.User_Ref;
      Cmt  : Regtests.Comments.Comment_Ref;
   begin
      --  Create an object within a transaction.
      declare
         S : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      begin
         S.Begin_Transaction;
         User.Set_Name ("Joe");
         User.Set_Value (0);
         User.Save (S);
         S.Commit;
      end;

      --  Load it from another session.
      declare
         S  : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
         U2 : Regtests.Simple.Model.User_Ref;
      begin
         U2.Load (S, User.Get_Id);
         Assert_Equals (T, "Joe", Ada.Strings.Unbounded.To_String (U2.Get_Name),
                        "Cannot load created object");
         Assert_Equals (T, Integer (0), Integer (U2.Get_Value), "Invalid load");
         T.Assert (User.Get_Key = U2.Get_Key, "Invalid key after load");
      end;

      --  Create a comment for the user.
      declare
         S  : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      begin
         S.Begin_Transaction;
         Cmt.Set_Message (Ada.Strings.Unbounded.To_Unbounded_String ("A comment from Joe"));
         Cmt.Set_User (User);
         Cmt.Set_Entity_Id (2);
         Cmt.Set_Entity_Type (1);
         --  Cmt.Set_Date (ADO.DEFAULT_TIME);
         Cmt.Set_Date (Ada.Calendar.Clock);
         Cmt.Save (S);
         S.Commit;
      end;

      --  Load that comment.
      declare
         S  : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
         C2 : Regtests.Comments.Comment_Ref;
      begin
         T.Assert (not C2.Is_Loaded, "Object is not loaded");
         C2.Load (S, Cmt.Get_Id);
         T.Assert (not C2.Is_Null, "Loading of object failed");
         T.Assert (C2.Is_Loaded, "Object is loaded");
         T.Assert (Cmt.Get_Key = C2.Get_Key, "Invalid key after load");
         T.Assert_Equals ("A comment from Joe", Ada.Strings.Unbounded.To_String (C2.Get_Message),
                          "Invalid message");

         T.Assert (not C2.Get_User.Is_Null, "User associated with the comment should not be null");
--           T.Assert (not C2.Get_Entity_Type.Is_Null, "Entity type was not set");

         --  Check that we can access the user name (lazy load)
         Assert_Equals (T, "Joe", Ada.Strings.Unbounded.To_String (C2.Get_User.Get_Name),
                        "Cannot load created object");
      end;
   end Test_Create_Object;

   --  ------------------------------
   --  Test creation and deletion of an object record
   --  ------------------------------
   procedure Test_Delete_Object (T : in out Test) is
      User : Regtests.Simple.Model.User_Ref;
   begin
      --  Create an object within a transaction.
      declare
         S : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      begin
         S.Begin_Transaction;
         User.Set_Name ("Joe (delete)");
         User.Set_Value (0);
         User.Save (S);
         S.Commit;
      end;

      --  Load it and delete it from another session.
      declare
         S  : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
         U2 : Regtests.Simple.Model.User_Ref;
      begin
         U2.Load (S, User.Get_Id);

         S.Begin_Transaction;
         U2.Delete (S);
         S.Commit;
      end;

      --  Try to load the deleted object.
      declare
         S  : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
         U2 : Regtests.Simple.Model.User_Ref;
      begin
         U2.Load (S, User.Get_Id);
         T.Assert (False, "Load of a deleted object should raise NOT_FOUND");

      exception
         when ADO.Objects.NOT_FOUND =>
            null;
      end;
   end Test_Delete_Object;

   --  ------------------------------
   --  Test Is_Inserted and Is_Null
   --  ------------------------------
   procedure Test_Is_Inserted (T : in out Test) is
      User : Regtests.Simple.Model.User_Ref;
   begin
      T.Assert (not User.Is_Inserted, "A null object should not be marked as INSERTED");
      T.Assert (User.Is_Null, "A null object should be marked as NULL");

      --  Create an object within a transaction.
      declare
         S : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      begin
         S.Begin_Transaction;
         User.Set_Name ("John");
         T.Assert (not User.Is_Null, "User should not be NULL");
         T.Assert (not User.Is_Inserted, "User was not saved and not yet inserted in database");

         User.Set_Value (1);
         User.Save (S);
         S.Commit;
         T.Assert (User.Is_Inserted, "After a save operation, the user should be marked INSERTED");
         T.Assert (not User.Is_Null, "User should not be NULL");
      end;

      declare
         S    : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
         John : Regtests.Simple.Model.User_Ref;
      begin
         John.Load (S, User.Get_Id);
         T.Assert (John.Is_Inserted, "After a load, the object should be marked INSERTED");
         T.Assert (not John.Is_Null, "After a load, the object should not be NULL");
      end;
   end Test_Is_Inserted;

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

   --  ------------------------------
   --  Add the tests in the test suite
   --  ------------------------------
   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Objects.Hash", Test_Key'Access);
      Caller.Add_Test (Suite, "Test Object_Ref.Get/Set", Test_Object_Ref'Access);
      Caller.Add_Test (Suite, "Test ADO.Objects.Create", Test_Create_Object'Access);
      Caller.Add_Test (Suite, "Test ADO.Objects.Delete", Test_Delete_Object'Access);
      Caller.Add_Test (Suite, "Test ADO.Objects.Is_Created", Test_Is_Inserted'Access);
      Caller.Add_Test (Suite, "Test ADO.Objects (Nullable_Integer)",
                       Test_Object_Nullable_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Objects (Nullable_Entity_Type)",
                       Test_Object_Nullable_Entity_Type'Access);
      Caller.Add_Test (Suite, "Test ADO.Objects (Nullable_Time)",
                       Test_Object_Nullable_Time'Access);
   end Add_Tests;

end ADO.Objects.Tests;

Fix the unit test on nullable_time

Fix the unit test on nullable_time


-----------------------------------------------------------------------
--  util-encoders-sha256 -- Compute SHA-1 hash
--  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 Ada.Streams;
with GNAT.SHA256;

package Util.Encoders.SHA256 is

   --  The SHA-256 binary hash (256-bit).
   subtype Hash_Array is Ada.Streams.Stream_Element_Array (0 .. 31);

   --  The SHA-256 hash as hexadecimal string.
   subtype Digest is String (1 .. 64);

   subtype Base64_Digest is String (1 .. 44);

   --  ------------------------------
   --  SHA256 Context
   --  ------------------------------
   subtype Context is GNAT.SHA256.Context;

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in String) renames GNAT.SHA256.Update;

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in Ada.Streams.Stream_Element_Array) renames GNAT.SHA256.Update;

   --  Computes the SHA256 hash and returns the raw binary hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Hash_Array);

   --  Computes the SHA256 hash and returns the hexadecimal hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Digest);

   --  Computes the SHA256 hash and returns the base64 hash in Hash.
   procedure Finish_Base64 (E    : in out Context;
                            Hash : out Base64_Digest);

end Util.Encoders.SHA256;

-----------------------------------------------------------------------
--  util-encoders-sha256 -- Compute SHA-256 hash
--  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 Ada.Streams;
with GNAT.SHA256;

package Util.Encoders.SHA256 is

   --  The SHA-256 binary hash (256-bit).
   subtype Hash_Array is Ada.Streams.Stream_Element_Array (0 .. 31);

   --  The SHA-256 hash as hexadecimal string.
   subtype Digest is String (1 .. 64);

   subtype Base64_Digest is String (1 .. 44);

   --  ------------------------------
   --  SHA256 Context
   --  ------------------------------
   subtype Context is GNAT.SHA256.Context;

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in String) renames GNAT.SHA256.Update;

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in Ada.Streams.Stream_Element_Array) renames GNAT.SHA256.Update;

   --  Computes the SHA256 hash and returns the raw binary hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Hash_Array);

   --  Computes the SHA256 hash and returns the hexadecimal hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Digest);

   --  Computes the SHA256 hash and returns the base64 hash in Hash.
   procedure Finish_Base64 (E    : in out Context;
                            Hash : out Base64_Digest);

end Util.Encoders.SHA256;

Fix header comment

Fix header comment