-----------------------------------------------------------------------
--  awa-workspaces-tests -- Unit tests for workspaces and invitations
--  Copyright (C) 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Test_Caller;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Helpers.Beans;
with ASF.Tests;
with AWA.Users.Models;
with AWA.Tests.Helpers.Users;
with AWA.Workspaces.Beans;

package body AWA.Workspaces.Tests is

   use Ada.Strings.Unbounded;
   use AWA.Tests;

   function Get_Invitation_Bean is
     new ASF.Helpers.Beans.Get_Request_Bean (Element_Type   => Beans.Invitation_Bean,
                                             Element_Access => Beans.Invitation_Bean_Access);

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Workspaces.Beans.Send",
                       Test_Invite_User'Access);
      Caller.Add_Test (Suite, "Test AWA.Workspaces.Beans.Delete",
                       Test_Delete_Member'Access);
      Caller.Add_Test (Suite, "Test AWA.Workspaces.Beans.Accept",
                       Test_Accept_Invitation'Access);
      Caller.Add_Test (Suite, "Test AWA.Workspaces.Beans.Accept (with Email)",
                       Test_Accept_Invitation_With_Email'Access);
      Caller.Add_Test (Suite, "Test AWA.Workspaces.Beans.Member_List",
                       Test_List_Members'Access);
   end Add_Tests;

   --  ------------------------------
   --  Verify the anonymous access for the invitation page.
   --  ------------------------------
   procedure Verify_Anonymous (T    : in out Test;
                               Key  : in String) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html", "invitation-view.html");
      ASF.Tests.Assert_Contains (T, "Bad or invalid invitation", Reply,
                                 "This invitation is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html?key=test", "invitation-bad.html");
      ASF.Tests.Assert_Contains (T, "This invitation is invalid or has expired", Reply,
                                 "This invitation is invalid (key)");

      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html?key=x" & key,
                        "invitation-bad2.html");
      ASF.Tests.Assert_Contains (T, "This invitation is invalid or has expired",
                                 Reply, "This invitation is invalid (key)");

      if Key = "" then
         return;
      end if;

      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html?key=" & Key, "invitation-ok.html");
      ASF.Tests.Assert_Contains (T, "Accept invitation", Reply,
                                 "Accept invitation page is invalid");

   end Verify_Anonymous;

   --  ------------------------------
   --  Test sending an invitation.
   --  ------------------------------
   procedure Test_Invite_User (T : in out Test) is
      use type ADO.Identifier;
      use type AWA.Workspaces.Beans.Invitation_Bean_Access;

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Invite    : AWA.Workspaces.Beans.Invitation_Bean_Access;
   begin
      AWA.Tests.Helpers.Users.Login ("test-invite@test.com", Request);
      Request.Set_Parameter ("email", "invited-user@test.com");
      Request.Set_Parameter ("message", "I invite you to this application");
      Request.Set_Parameter ("send", "1");
      Request.Set_Parameter ("invite", "1");
      ASF.Tests.Do_Post (Request, Reply, "/workspaces/invite.html", "invite.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Invalid response after invitation creation");

      --  Verify the invitation by looking at the inviteUser bean.
      Invite := Get_Invitation_Bean (Request, "inviteUser");
      T.Assert (Invite /= null, "Null inviteUser bean");
      T.Assert (Invite.Get_Id /= ADO.NO_IDENTIFIER, "The invite ID is invalid");
      T.Assert (not Invite.Get_Access_Key.Is_Null, "The invite access key is null");
      T.Assert (Invite.Get_Member.Is_Inserted, "The invitation has a workspace member");
      T.Key := Invite.Get_Access_Key.Get_Access_Key;
      T.Verify_Anonymous (Invite.Get_Access_Key.Get_Access_Key);

      T.Member_ID := Invite.Get_Member.Get_Id;
   end Test_Invite_User;

   --  ------------------------------
   --  Test deleting the member.
   --  ------------------------------
   procedure Test_Delete_Member (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      T.Test_Invite_User;
      AWA.Tests.Helpers.Users.Login ("test-invite@test.com", Request);
      declare
         Id : constant String := ADO.Identifier'Image (T.Member_Id);
      begin
         Request.Set_Parameter ("member-id", Id);
         Request.Set_Parameter ("delete", "1");
         Request.Set_Parameter ("delete-member-form", "1");
         ASF.Tests.Do_Post (Request, Reply, "/workspaces/forms/delete-member.html",
                            "delete-member.html");

         T.Assert (Reply.Get_Status = ASF.Responses.SC_OK,
                   "Invalid response after delete member operation");
         ASF.Tests.Assert_Contains (T, "deleteDialog_" & Id (Id'First + 1 .. Id'Last), Reply,
                                    "Delete member dialog operation response is invalid");
      end;
   end Test_Delete_Member;

   --  ------------------------------
   --  Test accepting the invitation.
   --  ------------------------------
   procedure Test_Accept_Invitation (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      T.Test_Invite_User;
      AWA.Tests.Helpers.Users.Recover_Password ("invited-user@test.com");
      AWA.Tests.Helpers.Users.Login ("invited-user@test.com", Request);
      ASF.Tests.Do_Get (Request, Reply, "/workspaces/accept-invitation.html?key="
                        & To_String (T.Key),
                        "accept-member.html");
      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Accept invitation page failed");
      Util.Tests.Assert_Equals (T, "/asfunit/workspaces/main.html", Reply.Get_Header ("Location"),
                                "The accept invitation page must redirect to the workspace");
   end Test_Accept_Invitation;

   --  ------------------------------
   --  Test accepting the invitation with a email and password process.
   --  ------------------------------
   procedure Test_Accept_Invitation_With_Email (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      T.Test_Invite_User;
      Request.Set_Parameter ("key", To_String (T.Key));
      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html?key="
                        & To_String (T.Key),
                        "accept-invitation-email-1.html");
      ASF.Tests.Assert_Contains (T, "input type=""hidden"" name=""key"" value="""
                                 & To_String (T.Key),
                                 Reply,
                                 "The invitation form must setup the invitation key form");

      Request.Set_Parameter ("key", To_String (T.Key));
      Request.Set_Parameter ("register", "1");
      Request.Set_Parameter ("register-button", "1");
      Request.Set_Parameter ("firstName", "Invitee");
      Request.Set_Parameter ("lastName", "With_Email");
      Request.Set_Parameter ("email", "accept-invitation@test.com");
      Request.Set_Parameter ("email", "invited-user@test.com");
      Request.Set_Parameter ("password", "admin");
      Request.Set_Parameter ("password2", "admin");

      ASF.Tests.Do_Post (Request, Reply, "/auth/invitation.html",
                         "accept-invitation-email-2.html");
      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Accept invitation page failed");
      Util.Tests.Assert_Equals (T, "/asfunit/workspaces/accept-invitation.html?key=" &
                                To_String (T.Key),
                                Reply.Get_Header ("Location"),
                                "The accept invitation page must redirect to the workspace");
   end Test_Accept_Invitation_With_Email;

   --  ------------------------------
   --  Test listing the members of the workspace.
   --  ------------------------------
   procedure Test_List_Members (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      T.Test_Invite_User;
      AWA.Tests.Helpers.Users.Login ("test-invite@test.com", Request);
      ASF.Tests.Do_Get (Request, Reply, "/workspaces/members.html",
                        "member-list.html");
      ASF.Tests.Assert_Contains (T, "invited-user@test.com", Reply,
                                 "The invited user is listed in the members page");
      ASF.Tests.Assert_Contains (T, "test-invite@test.com", Reply,
                                 "The invite user (owner) is listed in the members page");
   end Test_List_Members;

end AWA.Workspaces.Tests;

-----------------------------------------------------------------------
--  awa-workspaces-tests -- Unit tests for workspaces and invitations
--  Copyright (C) 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Test_Caller;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Helpers.Beans;
with ASF.Tests;
with AWA.Users.Models;
with AWA.Tests.Helpers.Users;
with AWA.Workspaces.Beans;

package body AWA.Workspaces.Tests is

   use Ada.Strings.Unbounded;

   function Get_Invitation_Bean is
     new ASF.Helpers.Beans.Get_Request_Bean (Element_Type   => Beans.Invitation_Bean,
                                             Element_Access => Beans.Invitation_Bean_Access);

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Workspaces.Beans.Send",
                       Test_Invite_User'Access);
      Caller.Add_Test (Suite, "Test AWA.Workspaces.Beans.Delete",
                       Test_Delete_Member'Access);
      Caller.Add_Test (Suite, "Test AWA.Workspaces.Beans.Accept",
                       Test_Accept_Invitation'Access);
      Caller.Add_Test (Suite, "Test AWA.Workspaces.Beans.Accept (with Email)",
                       Test_Accept_Invitation_With_Email'Access);
      Caller.Add_Test (Suite, "Test AWA.Workspaces.Beans.Member_List",
                       Test_List_Members'Access);
   end Add_Tests;

   --  ------------------------------
   --  Verify the anonymous access for the invitation page.
   --  ------------------------------
   procedure Verify_Anonymous (T    : in out Test;
                               Key  : in String) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html", "invitation-view.html");
      ASF.Tests.Assert_Contains (T, "Bad or invalid invitation", Reply,
                                 "This invitation is invalid");

      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html?key=test", "invitation-bad.html");
      ASF.Tests.Assert_Contains (T, "This invitation is invalid or has expired", Reply,
                                 "This invitation is invalid (key)");

      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html?key=x" & key,
                        "invitation-bad2.html");
      ASF.Tests.Assert_Contains (T, "This invitation is invalid or has expired",
                                 Reply, "This invitation is invalid (key)");

      if Key = "" then
         return;
      end if;

      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html?key=" & Key, "invitation-ok.html");
      ASF.Tests.Assert_Contains (T, "Accept invitation", Reply,
                                 "Accept invitation page is invalid");

   end Verify_Anonymous;

   --  ------------------------------
   --  Test sending an invitation.
   --  ------------------------------
   procedure Test_Invite_User (T : in out Test) is
      use type ADO.Identifier;
      use type AWA.Workspaces.Beans.Invitation_Bean_Access;

      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Invite    : AWA.Workspaces.Beans.Invitation_Bean_Access;
   begin
      AWA.Tests.Helpers.Users.Login ("test-invite@test.com", Request);
      Request.Set_Parameter ("email", "invited-user@test.com");
      Request.Set_Parameter ("message", "I invite you to this application");
      Request.Set_Parameter ("send", "1");
      Request.Set_Parameter ("invite", "1");
      ASF.Tests.Do_Post (Request, Reply, "/workspaces/invite.html", "invite.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Invalid response after invitation creation");

      --  Verify the invitation by looking at the inviteUser bean.
      Invite := Get_Invitation_Bean (Request, "inviteUser");
      T.Assert (Invite /= null, "Null inviteUser bean");
      T.Assert (Invite.Get_Id /= ADO.NO_IDENTIFIER, "The invite ID is invalid");
      T.Assert (not Invite.Get_Access_Key.Is_Null, "The invite access key is null");
      T.Assert (Invite.Get_Member.Is_Inserted, "The invitation has a workspace member");
      T.Key := Invite.Get_Access_Key.Get_Access_Key;
      T.Verify_Anonymous (Invite.Get_Access_Key.Get_Access_Key);

      T.Member_ID := Invite.Get_Member.Get_Id;
   end Test_Invite_User;

   --  ------------------------------
   --  Test deleting the member.
   --  ------------------------------
   procedure Test_Delete_Member (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      T.Test_Invite_User;
      AWA.Tests.Helpers.Users.Login ("test-invite@test.com", Request);
      declare
         Id : constant String := ADO.Identifier'Image (T.Member_Id);
      begin
         Request.Set_Parameter ("member-id", Id);
         Request.Set_Parameter ("delete", "1");
         Request.Set_Parameter ("delete-member-form", "1");
         ASF.Tests.Do_Post (Request, Reply, "/workspaces/forms/delete-member.html",
                            "delete-member.html");

         T.Assert (Reply.Get_Status = ASF.Responses.SC_OK,
                   "Invalid response after delete member operation");
         ASF.Tests.Assert_Contains (T, "deleteDialog_" & Id (Id'First + 1 .. Id'Last), Reply,
                                    "Delete member dialog operation response is invalid");
      end;
   end Test_Delete_Member;

   --  ------------------------------
   --  Test accepting the invitation.
   --  ------------------------------
   procedure Test_Accept_Invitation (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      T.Test_Invite_User;
      AWA.Tests.Helpers.Users.Recover_Password ("invited-user@test.com");
      AWA.Tests.Helpers.Users.Login ("invited-user@test.com", Request);
      ASF.Tests.Do_Get (Request, Reply, "/workspaces/accept-invitation.html?key="
                        & To_String (T.Key),
                        "accept-member.html");
      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Accept invitation page failed");
      Util.Tests.Assert_Equals (T, "/asfunit/workspaces/main.html", Reply.Get_Header ("Location"),
                                "The accept invitation page must redirect to the workspace");
   end Test_Accept_Invitation;

   --  ------------------------------
   --  Test accepting the invitation with a email and password process.
   --  ------------------------------
   procedure Test_Accept_Invitation_With_Email (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      T.Test_Invite_User;
      Request.Set_Parameter ("key", To_String (T.Key));
      ASF.Tests.Do_Get (Request, Reply, "/auth/invitation.html?key="
                        & To_String (T.Key),
                        "accept-invitation-email-1.html");
      ASF.Tests.Assert_Contains (T, "input type=""hidden"" name=""key"" value="""
                                 & To_String (T.Key),
                                 Reply,
                                 "The invitation form must setup the invitation key form");

      Request.Set_Parameter ("key", To_String (T.Key));
      Request.Set_Parameter ("register", "1");
      Request.Set_Parameter ("register-button", "1");
      Request.Set_Parameter ("firstName", "Invitee");
      Request.Set_Parameter ("lastName", "With_Email");
      Request.Set_Parameter ("email", "accept-invitation@test.com");
      Request.Set_Parameter ("email", "invited-user@test.com");
      Request.Set_Parameter ("password", "admin");
      Request.Set_Parameter ("password2", "admin");

      ASF.Tests.Do_Post (Request, Reply, "/auth/invitation.html",
                         "accept-invitation-email-2.html");
      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Accept invitation page failed");
      Util.Tests.Assert_Equals (T, "/asfunit/workspaces/accept-invitation.html?key=" &
                                To_String (T.Key),
                                Reply.Get_Header ("Location"),
                                "The accept invitation page must redirect to the workspace");
   end Test_Accept_Invitation_With_Email;

   --  ------------------------------
   --  Test listing the members of the workspace.
   --  ------------------------------
   procedure Test_List_Members (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      T.Test_Invite_User;
      AWA.Tests.Helpers.Users.Login ("test-invite@test.com", Request);
      ASF.Tests.Do_Get (Request, Reply, "/workspaces/members.html",
                        "member-list.html");
      ASF.Tests.Assert_Contains (T, "invited-user@test.com", Reply,
                                 "The invited user is listed in the members page");
      ASF.Tests.Assert_Contains (T, "test-invite@test.com", Reply,
                                 "The invite user (owner) is listed in the members page");
   end Test_List_Members;

end AWA.Workspaces.Tests;

Fix compilation warning

Fix compilation warning


-------------------------------------------------------------------------------
-- Copyright (c) 2015, Daniel King
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
--     * Redistributions of source code must retain the above copyright
--       notice, this list of conditions and the following disclaimer.
--     * Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in the
--       documentation and/or other materials provided with the distribution.
--     * The name of the copyright holder may not be used to endorse or promote
--       Products derived from this software without specific prior written
--       permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY
-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-- (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
-- THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-------------------------------------------------------------------------------

with Ada.Real_Time;
with Ada.Text_IO;
with Keccak.Types;
with Keccak.XOF;
with Keccak.Hash;
with Keccak.Duplex;
with Keccak.Keccak_1600;
with SHA3;
with SHAKE;
with RawSHAKE;

procedure Benchmark
is
   Benchmark_Data_Size_MiB : constant := 128; -- size of the benchmark data in MiB
   Repeat                  : constant := 10;  -- number of benchmark iterations

   -- A 1 MiB data chunk to use as an input to the algorithms.
   Data_Chunk : constant Keccak.Types.Byte_Array(1 .. 1024*1024) := (others => 16#A7#);

   ----------------------------------------------------------------------------
   -- Print_Number
   --
   -- Prints a number with the unit B/kiB/MiB/GiB depending on the magnitude
   -- of the value. E.g. 1_048_576 would be displayed as 1.0 MiB.
   ----------------------------------------------------------------------------
   procedure Print_Number(Value  : in Float;
                          Suffix : in String;
                          Aft    : in Natural)
   is
      package Float_IO  is new Ada.Text_IO.Float_IO(Float);

   begin
      if Value >= 1024.0*1024.0*1024.0 then
         Float_IO.Put(Value / (1024.0*1024.0*1024.0),
                      Fore => 0,
                      Aft => Aft,
                      Exp => 0);
         Ada.Text_IO.Put(" GiB" & Suffix);
      elsif Value >= 1024.0*1024.0 then
         Float_IO.Put(Value / (1024.0*1024.0),
                      Fore => 0,
                      Aft => Aft,
                      Exp => 0);
         Ada.Text_IO.Put(" MiB" & Suffix);
      elsif Value >= 1024.0 then
         Float_IO.Put(Value / 1024.0,
                      Fore => 0,
                      Aft => Aft,
                      Exp => 0);
         Ada.Text_IO.Put(" kiB" & Suffix);
      else
         Float_IO.Put(Value,
                      Fore => 0,
                      Aft => Aft,
                      Exp => 0);
         Ada.Text_IO.Put(" B" & Suffix);
      end if;

   end Print_Number;

   ----------------------------------------------------------------------------
   -- Print_Time
   --
   -- Prints a line displaying: the measurement time, the data size, and
   -- the performance (bytes per second).
   --
   -- E.g. Print_Time(1_048_576, Elapsed) where Elapsed represents a Time_Span
   -- of 0.123 seconds would be displayed as:
   -- "0.123000s, 1.0 MiB, 8.130 MiB/s"
   ----------------------------------------------------------------------------
   procedure Print_Time(Data_Size : in Natural;
                        Time      : in Ada.Real_Time.Time_Span)
   is
      package Duration_IO is new Ada.Text_IO.Fixed_IO(Duration);

   begin
      Duration_IO.Put(Ada.Real_Time.To_Duration(Time), Fore => 0, Aft => 6);
      Ada.Text_IO.Put("s, ");

      Print_Number(Float(Data_Size), "", 0);

      Ada.Text_IO.Put(", ");

      Print_Number(Float(Data_Size) / Float(Ada.Real_Time.To_Duration(Time)), "/s", 3);

      Ada.Text_IO.New_Line;
   end Print_Time;

   ----------------------------------------------------------------------------
   -- Hash_Benchmark
   --
   -- Generic procedure to run a benchmark for any hash algorithm (e.g. SHA3-224,
   -- Keccak-256, etc...).
   ----------------------------------------------------------------------------
   generic
       Name : String;
       with package Hash_Package is new Keccak.Hash(<>);
   procedure Hash_Benchmark;

   procedure Hash_Benchmark
   is
      use type Ada.Real_Time.Time;

      Ctx   : Hash_Package.Context;
      Digest : Hash_Package.Digest_Type;

      Start_Time : Ada.Real_Time.Time;
      End_Time   : Ada.Real_Time.Time;
   begin
      for I in Positive range 1 .. Repeat loop
         Start_Time := Ada.Real_Time.Clock;

         Hash_Package.Init(Ctx);

         for I in Positive range 1 .. Benchmark_Data_Size_MiB loop
            Hash_Package.Update(Ctx, Data_Chunk, Data_Chunk'Length*8);
         end loop;

         Hash_Package.Final(Ctx, Digest);

         End_Time := Ada.Real_Time.Clock;

         Ada.Text_IO.Put(Name & ", ");
         Print_Time(Data_Chunk'Length * Benchmark_Data_Size_MiB,
                    End_Time - Start_Time);
      end loop;
   end Hash_Benchmark;

   ----------------------------------------------------------------------------
   -- XOF_Benchmark
   --
   -- Generic procedure to run a benchmark for any XOF algorithm (e.g. SHAKE128,
   -- RawSHAKE256, etc...).
   ----------------------------------------------------------------------------
   generic
       Name : String;
       with package XOF_Package is new Keccak.XOF(<>);
   procedure XOF_Benchmark;

   procedure XOF_Benchmark
   is
      use type Ada.Real_Time.Time;

      Ctx    : XOF_Package.Context;
      Digest : XOF_Package.Byte_Array(1 .. 1024*1024);

      Start_Time : Ada.Real_Time.Time;
      End_Time   : Ada.Real_Time.Time;
   begin

      -- Benchmark Absorbing
      for I in Positive range 1 .. Repeat loop
         Start_Time := Ada.Real_Time.Clock;

         XOF_Package.Init(Ctx);

         for I in Positive range 1 .. Benchmark_Data_Size_MiB loop
            XOF_Package.Update(Ctx, Data_Chunk, Data_Chunk'Length*8);
         end loop;

         End_Time := Ada.Real_Time.Clock;

         Ada.Text_IO.Put(Name & " (Absorbing), ");
         Print_Time(Data_Chunk'Length * Benchmark_Data_Size_MiB,
                    End_Time - Start_Time);
      end loop;

      -- Benchmark squeezing
      for I in Positive range 1 .. Repeat loop
         Start_Time := Ada.Real_Time.Clock;

         for I in Positive range 1 .. Benchmark_Data_Size_MiB loop
            XOF_Package.Extract(Ctx, Digest);
         end loop;

         End_Time := Ada.Real_Time.Clock;

         Ada.Text_IO.Put(Name & " (Squeezing), ");
         Print_Time(Digest'Length * Benchmark_Data_Size_MiB,
                    End_Time - Start_Time);
      end loop;
   end XOF_Benchmark;

   ----------------------------------------------------------------------------
   -- Duplex_Benchmark
   --
   -- Generic procedure to run a benchmark for any Duplex algorithm.
   ----------------------------------------------------------------------------
   generic
      Name : String;
      Capacity : Positive;
      with package Duplex is new Keccak.Duplex(<>);
   procedure Duplex_Benchmark;

   procedure Duplex_Benchmark
   is
      use type Ada.Real_Time.Time;

      Ctx : Duplex.Context;

      Out_Data : Keccak.Types.Byte_Array(1 .. 1600/8);

      Start_Time : Ada.Real_Time.Time;
      End_Time   : Ada.Real_Time.Time;

      Num_Iterations : Natural := (Benchmark_Data_Size_MiB*1024*1024) / ((1600-Capacity)/8);

   begin

      for I in Positive range 1 .. Repeat loop
         Start_Time := Ada.Real_Time.Clock;

         Duplex.Init(Ctx, Capacity);

         for J in Positive range 1 .. Num_Iterations loop
            Duplex.Duplex(Ctx,
                          Data_Chunk(1 .. Duplex.Rate_Of(Ctx)/8),
                          Duplex.Rate_Of(Ctx) - Duplex.Min_Padding_Bits,
                          Out_Data(1 .. Duplex.Rate_Of(Ctx)/8));
         end loop;

         End_Time := Ada.Real_Time.Clock;

         Ada.Text_IO.Put(Name & ", ");
         Print_Time((Duplex.Rate_Of(Ctx)/8) * Num_Iterations,
                    End_Time - Start_Time);

      end loop;

   end Duplex_Benchmark;

   ----------------------------------------------------------------------------
   -- Benchmark procedure instantiations.
   ----------------------------------------------------------------------------

   procedure Benchmark_SHA_224 is new Hash_Benchmark
      ("SHA3-224", SHA3.SHA3_224);
   procedure Benchmark_SHA_256 is new Hash_Benchmark
      ("SHA3-256", SHA3.SHA3_256);
   procedure Benchmark_SHA_384 is new Hash_Benchmark
      ("SHA3-384", SHA3.SHA3_384);
   procedure Benchmark_SHA_512 is new Hash_Benchmark
      ("SHA3-512", SHA3.SHA3_512);

   procedure Benchmark_Keccak_224 is new Hash_Benchmark
      ("Keccak-224", SHA3.Keccak_224);
   procedure Benchmark_Keccak_256 is new Hash_Benchmark
      ("Keccak-256", SHA3.Keccak_256);
   procedure Benchmark_Keccak_384 is new Hash_Benchmark
      ("Keccak-384", SHA3.Keccak_384);
   procedure Benchmark_Keccak_512 is new Hash_Benchmark
      ("Keccak-512", SHA3.Keccak_512);

   procedure Benchmark_SHAKE128 is new XOF_Benchmark
      ("SHAKE128", SHAKE.SHAKE128);
   procedure Benchmark_SHAKE256 is new XOF_Benchmark
      ("SHAKE256", SHAKE.SHAKE256);

   procedure Benchmark_RawSHAKE128 is new XOF_Benchmark
      ("RawSHAKE128", RawSHAKE.RawSHAKE128);
   procedure Benchmark_RawSHAKE256 is new XOF_Benchmark
      ("RawSHAKE256", RawSHAKE.RawSHAKE256);

   procedure Benchmark_Duplex_r1152c448 is new Duplex_Benchmark
      ("Duplex r1152c448", 448, Keccak.Keccak_1600.Duplex);
   procedure Benchmark_Duplex_r1088c512 is new Duplex_Benchmark
      ("Duplex r1088c512", 512, Keccak.Keccak_1600.Duplex);
   procedure Benchmark_Duplex_r832c768 is new Duplex_Benchmark
      ("Duplex r832c768", 768, Keccak.Keccak_1600.Duplex);
   procedure Benchmark_Duplex_r576c1024 is new Duplex_Benchmark
      ("Duplex r576c1024", 1024, Keccak.Keccak_1600.Duplex);

begin
   Ada.Text_IO.Put_Line("Algorithm,Time,Data Length,Performance");

   Benchmark_SHA_224;
   Ada.Text_IO.New_Line;

   Benchmark_SHA_256;
   Ada.Text_IO.New_Line;

   Benchmark_SHA_384;
   Ada.Text_IO.New_Line;

   Benchmark_SHA_512;
   Ada.Text_IO.New_Line;

   Benchmark_Keccak_224;
   Ada.Text_IO.New_Line;

   Benchmark_Keccak_256;
   Ada.Text_IO.New_Line;

   Benchmark_Keccak_384;
   Ada.Text_IO.New_Line;

   Benchmark_Keccak_512;
   Ada.Text_IO.New_Line;

   Benchmark_SHAKE128;
   Ada.Text_IO.New_Line;

   Benchmark_SHAKE256;
   Ada.Text_IO.New_Line;

   Benchmark_RawSHAKE128;
   Ada.Text_IO.New_Line;

   Benchmark_RawSHAKE256;
   Ada.Text_IO.New_Line;

   Benchmark_Duplex_r1152c448;
   Ada.Text_IO.New_Line;

   Benchmark_Duplex_r1088c512;
   Ada.Text_IO.New_Line;

   Benchmark_Duplex_r832c768;
   Ada.Text_IO.New_Line;

   Benchmark_Duplex_r576c1024;
   Ada.Text_IO.New_Line;

end Benchmark;

-------------------------------------------------------------------------------
-- Copyright (c) 2015, Daniel King
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
--     * Redistributions of source code must retain the above copyright
--       notice, this list of conditions and the following disclaimer.
--     * Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in the
--       documentation and/or other materials provided with the distribution.
--     * The name of the copyright holder may not be used to endorse or promote
--       Products derived from this software without specific prior written
--       permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY
-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-- (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
-- THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-------------------------------------------------------------------------------

with Ada.Real_Time;
with Ada.Text_IO;
with Keccak.KeccakF;
with Keccak.Keccak_25;
with Keccak.Keccak_50;
with Keccak.Keccak_100;
with Keccak.Keccak_200;
with Keccak.Keccak_400;
with Keccak.Keccak_800;
with Keccak.Keccak_1600;
with Keccak.Types;
with Keccak.XOF;
with Keccak.Hash;
with Keccak.Duplex;
with Keccak.Keccak_1600;
with SHA3;
with SHAKE;
with RawSHAKE;

procedure Benchmark
is
   Benchmark_Data_Size_MiB : constant := 128; -- size of the benchmark data in MiB
   Repeat                  : constant := 10;  -- number of benchmark iterations

   -- A 1 MiB data chunk to use as an input to the algorithms.
   Data_Chunk : constant Keccak.Types.Byte_Array(1 .. 1024*1024) := (others => 16#A7#);

   ----------------------------------------------------------------------------
   -- Print_Number
   --
   -- Prints a number with the unit B/kiB/MiB/GiB depending on the magnitude
   -- of the value. E.g. 1_048_576 would be displayed as 1.0 MiB.
   ----------------------------------------------------------------------------
   procedure Print_Number(Value  : in Float;
                          Suffix : in String;
                          Aft    : in Natural)
   is
      package Float_IO  is new Ada.Text_IO.Float_IO(Float);

   begin
      if Value >= 1024.0*1024.0*1024.0 then
         Float_IO.Put(Value / (1024.0*1024.0*1024.0),
                      Fore => 0,
                      Aft => Aft,
                      Exp => 0);
         Ada.Text_IO.Put(" GiB" & Suffix);
      elsif Value >= 1024.0*1024.0 then
         Float_IO.Put(Value / (1024.0*1024.0),
                      Fore => 0,
                      Aft => Aft,
                      Exp => 0);
         Ada.Text_IO.Put(" MiB" & Suffix);
      elsif Value >= 1024.0 then
         Float_IO.Put(Value / 1024.0,
                      Fore => 0,
                      Aft => Aft,
                      Exp => 0);
         Ada.Text_IO.Put(" kiB" & Suffix);
      else
         Float_IO.Put(Value,
                      Fore => 0,
                      Aft => Aft,
                      Exp => 0);
         Ada.Text_IO.Put(" B" & Suffix);
      end if;

   end Print_Number;

   ----------------------------------------------------------------------------
   -- Print_Time
   --
   -- Prints a line displaying: the measurement time, the data size, and
   -- the performance (bytes per second).
   --
   -- E.g. Print_Time(1_048_576, Elapsed) where Elapsed represents a Time_Span
   -- of 0.123 seconds would be displayed as:
   -- "0.123000s, 1.0 MiB, 8.130 MiB/s"
   ----------------------------------------------------------------------------
   procedure Print_Time(Data_Size : in Natural;
                        Time      : in Ada.Real_Time.Time_Span)
   is
      package Duration_IO is new Ada.Text_IO.Fixed_IO(Duration);

   begin
      Duration_IO.Put(Ada.Real_Time.To_Duration(Time), Fore => 0, Aft => 6);
      Ada.Text_IO.Put("s, ");

      Print_Number(Float(Data_Size), "", 0);

      Ada.Text_IO.Put(", ");

      Print_Number(Float(Data_Size) / Float(Ada.Real_Time.To_Duration(Time)), "/s", 3);

      Ada.Text_IO.New_Line;
   end Print_Time;

   ----------------------------------------------------------------------------
   -- Hash_Benchmark
   --
   -- Generic procedure to run a benchmark for any hash algorithm (e.g. SHA3-224,
   -- Keccak-256, etc...).
   ----------------------------------------------------------------------------
   generic
       Name : String;
       with package Hash_Package is new Keccak.Hash(<>);
   procedure Hash_Benchmark;

   procedure Hash_Benchmark
   is
      use type Ada.Real_Time.Time;

      Ctx   : Hash_Package.Context;
      Digest : Hash_Package.Digest_Type;

      Start_Time : Ada.Real_Time.Time;
      End_Time   : Ada.Real_Time.Time;
   begin
      for I in Positive range 1 .. Repeat loop
         Start_Time := Ada.Real_Time.Clock;

         Hash_Package.Init(Ctx);

         for I in Positive range 1 .. Benchmark_Data_Size_MiB loop
            Hash_Package.Update(Ctx, Data_Chunk, Data_Chunk'Length*8);
         end loop;

         Hash_Package.Final(Ctx, Digest);

         End_Time := Ada.Real_Time.Clock;

         Ada.Text_IO.Put(Name & ", ");
         Print_Time(Data_Chunk'Length * Benchmark_Data_Size_MiB,
                    End_Time - Start_Time);
      end loop;
   end Hash_Benchmark;

   ----------------------------------------------------------------------------
   -- XOF_Benchmark
   --
   -- Generic procedure to run a benchmark for any XOF algorithm (e.g. SHAKE128,
   -- RawSHAKE256, etc...).
   ----------------------------------------------------------------------------
   generic
       Name : String;
       with package XOF_Package is new Keccak.XOF(<>);
   procedure XOF_Benchmark;

   procedure XOF_Benchmark
   is
      use type Ada.Real_Time.Time;

      Ctx    : XOF_Package.Context;
      Digest : XOF_Package.Byte_Array(1 .. 1024*1024);

      Start_Time : Ada.Real_Time.Time;
      End_Time   : Ada.Real_Time.Time;
   begin

      -- Benchmark Absorbing
      for I in Positive range 1 .. Repeat loop
         Start_Time := Ada.Real_Time.Clock;

         XOF_Package.Init(Ctx);

         for I in Positive range 1 .. Benchmark_Data_Size_MiB loop
            XOF_Package.Update(Ctx, Data_Chunk, Data_Chunk'Length*8);
         end loop;

         End_Time := Ada.Real_Time.Clock;

         Ada.Text_IO.Put(Name & " (Absorbing), ");
         Print_Time(Data_Chunk'Length * Benchmark_Data_Size_MiB,
                    End_Time - Start_Time);
      end loop;

      -- Benchmark squeezing
      for I in Positive range 1 .. Repeat loop
         Start_Time := Ada.Real_Time.Clock;

         for I in Positive range 1 .. Benchmark_Data_Size_MiB loop
            XOF_Package.Extract(Ctx, Digest);
         end loop;

         End_Time := Ada.Real_Time.Clock;

         Ada.Text_IO.Put(Name & " (Squeezing), ");
         Print_Time(Digest'Length * Benchmark_Data_Size_MiB,
                    End_Time - Start_Time);
      end loop;
   end XOF_Benchmark;

   ----------------------------------------------------------------------------
   -- Duplex_Benchmark
   --
   -- Generic procedure to run a benchmark for any Duplex algorithm.
   ----------------------------------------------------------------------------
   generic
      Name : String;
      Capacity : Positive;
      with package Duplex is new Keccak.Duplex(<>);
   procedure Duplex_Benchmark;

   procedure Duplex_Benchmark
   is
      use type Ada.Real_Time.Time;

      Ctx : Duplex.Context;

      Out_Data : Keccak.Types.Byte_Array(1 .. 1600/8);

      Start_Time : Ada.Real_Time.Time;
      End_Time   : Ada.Real_Time.Time;

      Num_Iterations : Natural := (Benchmark_Data_Size_MiB*1024*1024) / ((1600-Capacity)/8);

   begin

      for I in Positive range 1 .. Repeat loop
         Start_Time := Ada.Real_Time.Clock;

         Duplex.Init(Ctx, Capacity);

         for J in Positive range 1 .. Num_Iterations loop
            Duplex.Duplex(Ctx,
                          Data_Chunk(1 .. Duplex.Rate_Of(Ctx)/8),
                          Duplex.Rate_Of(Ctx) - Duplex.Min_Padding_Bits,
                          Out_Data(1 .. Duplex.Rate_Of(Ctx)/8));
         end loop;

         End_Time := Ada.Real_Time.Clock;

         Ada.Text_IO.Put(Name & ", ");
         Print_Time((Duplex.Rate_Of(Ctx)/8) * Num_Iterations,
                    End_Time - Start_Time);

      end loop;

   end Duplex_Benchmark;

   -------------------------------------------------------------------------		---
   -- KeccakF_Benchmark
   --
   -- Generic procedure to run a benchmark for a KeccakF permutation.
   ----------------------------------------------------------------------------
   generic
      Name : String;
      with package KeccakF is new Keccak.KeccakF(<>);
   procedure KeccakF_Benchmark;

   procedure KeccakF_Benchmark
   is
      use type Ada.Real_Time.Time;

      package Duration_IO is new Ada.Text_IO.Fixed_IO(Duration);
      package Integer_IO is new Ada.Text_IO.Integer_IO(Integer);

      State : KeccakF.State;

      Start_Time : Ada.Real_Time.Time;
      End_Time   : Ada.Real_Time.Time;

      Num_Iterations : Natural := 1_000_000;

   begin
      KeccakF.Init(State);

      for I in Positive range 1 .. Repeat loop
         Start_Time := Ada.Real_Time.Clock;

         for J in Positive range 1 .. Num_Iterations loop
            KeccakF.Permute(State);
         end loop;

         End_Time := Ada.Real_Time.Clock;

         Ada.Text_IO.Put(Name & ", ");

         Duration_IO.Put(Ada.Real_Time.To_Duration(End_Time - Start_Time), Fore => 0, Aft => 6);
         Ada.Text_IO.Put("s, ");

         Integer_IO.Put(Item => Num_Iterations, Width => 0);
         Ada.Text_IO.Put(" calls, ");

         Duration_IO.Put((Ada.Real_Time.To_Duration(End_Time - Start_Time) * 1_000_000) / Num_Iterations, Fore => 0);
         Ada.Text_IO.Put_Line(" us/call");
      end loop;

   end KeccakF_Benchmark;

   ----------------------------------------------------------------------------
   -- Benchmark procedure instantiations.
   ----------------------------------------------------------------------------

   procedure Benchmark_SHA_224 is new Hash_Benchmark
      ("SHA3-224", SHA3.SHA3_224);
   procedure Benchmark_SHA_256 is new Hash_Benchmark
      ("SHA3-256", SHA3.SHA3_256);
   procedure Benchmark_SHA_384 is new Hash_Benchmark
      ("SHA3-384", SHA3.SHA3_384);
   procedure Benchmark_SHA_512 is new Hash_Benchmark
      ("SHA3-512", SHA3.SHA3_512);

   procedure Benchmark_Keccak_224 is new Hash_Benchmark
      ("Keccak-224", SHA3.Keccak_224);
   procedure Benchmark_Keccak_256 is new Hash_Benchmark
      ("Keccak-256", SHA3.Keccak_256);
   procedure Benchmark_Keccak_384 is new Hash_Benchmark
      ("Keccak-384", SHA3.Keccak_384);
   procedure Benchmark_Keccak_512 is new Hash_Benchmark
      ("Keccak-512", SHA3.Keccak_512);

   procedure Benchmark_SHAKE128 is new XOF_Benchmark
      ("SHAKE128", SHAKE.SHAKE128);
   procedure Benchmark_SHAKE256 is new XOF_Benchmark
      ("SHAKE256", SHAKE.SHAKE256);

   procedure Benchmark_RawSHAKE128 is new XOF_Benchmark
      ("RawSHAKE128", RawSHAKE.RawSHAKE128);
   procedure Benchmark_RawSHAKE256 is new XOF_Benchmark
      ("RawSHAKE256", RawSHAKE.RawSHAKE256);

   procedure Benchmark_Duplex_r1152c448 is new Duplex_Benchmark
      ("Duplex r1152c448", 448, Keccak.Keccak_1600.Duplex);
   procedure Benchmark_Duplex_r1088c512 is new Duplex_Benchmark
      ("Duplex r1088c512", 512, Keccak.Keccak_1600.Duplex);
   procedure Benchmark_Duplex_r832c768 is new Duplex_Benchmark
      ("Duplex r832c768", 768, Keccak.Keccak_1600.Duplex);
   procedure Benchmark_Duplex_r576c1024 is new Duplex_Benchmark
     ("Duplex r576c1024", 1024, Keccak.Keccak_1600.Duplex);

   procedure Benchmark_KeccakF_25 is new KeccakF_Benchmark
     ("KeccakF[25]", Keccak.Keccak_25.KeccakF_25);
   procedure Benchmark_KeccakF_50 is new KeccakF_Benchmark
     ("KeccakF[50]", Keccak.Keccak_50.KeccakF_50);
   procedure Benchmark_KeccakF_100 is new KeccakF_Benchmark
     ("KeccakF[100]", Keccak.Keccak_100.KeccakF_100);
   procedure Benchmark_KeccakF_200 is new KeccakF_Benchmark
     ("KeccakF[200]", Keccak.Keccak_200.KeccakF_200);
   procedure Benchmark_KeccakF_400 is new KeccakF_Benchmark
     ("KeccakF[400]", Keccak.Keccak_400.KeccakF_400);
   procedure Benchmark_KeccakF_800 is new KeccakF_Benchmark
     ("KeccakF[800]", Keccak.Keccak_800.KeccakF_800);
   procedure Benchmark_KeccakF_1600 is new KeccakF_Benchmark
     ("KeccakF[1600]", Keccak.Keccak_1600.KeccakF_1600);

begin
   Ada.Text_IO.Put_Line("Algorithm,Time,Data Length,Performance");

   Benchmark_SHA_224;
   Ada.Text_IO.New_Line;

   Benchmark_SHA_256;
   Ada.Text_IO.New_Line;

   Benchmark_SHA_384;
   Ada.Text_IO.New_Line;

   Benchmark_SHA_512;
   Ada.Text_IO.New_Line;

   Benchmark_Keccak_224;
   Ada.Text_IO.New_Line;

   Benchmark_Keccak_256;
   Ada.Text_IO.New_Line;

   Benchmark_Keccak_384;
   Ada.Text_IO.New_Line;

   Benchmark_Keccak_512;
   Ada.Text_IO.New_Line;

   Benchmark_SHAKE128;
   Ada.Text_IO.New_Line;

   Benchmark_SHAKE256;
   Ada.Text_IO.New_Line;

   Benchmark_RawSHAKE128;
   Ada.Text_IO.New_Line;

   Benchmark_RawSHAKE256;
   Ada.Text_IO.New_Line;

   Benchmark_Duplex_r1152c448;
   Ada.Text_IO.New_Line;

   Benchmark_Duplex_r1088c512;
   Ada.Text_IO.New_Line;

   Benchmark_Duplex_r832c768;
   Ada.Text_IO.New_Line;

   Benchmark_Duplex_r576c1024;
   Ada.Text_IO.New_Line;

   Benchmark_KeccakF_1600;
   Ada.Text_IO.New_Line;

   Benchmark_KeccakF_800;
   Ada.Text_IO.New_Line;

   Benchmark_KeccakF_400;
   Ada.Text_IO.New_Line;

   Benchmark_KeccakF_200;
   Ada.Text_IO.New_Line;

   Benchmark_KeccakF_100;
   Ada.Text_IO.New_Line;

   Benchmark_KeccakF_50;
   Ada.Text_IO.New_Line;

   Benchmark_KeccakF_25;
   Ada.Text_IO.New_Line;

end Benchmark;

Add Keccak permutations to the benchmark


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

with Ada.Directories;
with Ada.Strings.Unbounded;

with Gen.Artifacts.XMI.Tests;
with Gen.Integration.Tests;
package body Gen.Testsuite is

   Tests : aliased Util.Tests.Test_Suite;

   Dir   : Ada.Strings.Unbounded.Unbounded_String;

   function Suite return Util.Tests.Access_Test_Suite is
      Result : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      Gen.Artifacts.XMI.Tests.Add_Tests (Result);
      Gen.Integration.Tests.Add_Tests (Result);
      return Result;
   end Suite;

   --  ------------------------------
   --  Get the test root directory.
   --  ------------------------------
   function Get_Test_Directory return String is
   begin
      return Ada.Strings.Unbounded.To_String (Dir);
   end Get_Test_Directory;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Dir := Ada.Strings.Unbounded.To_Unbounded_String (Ada.Directories.Current_Directory);
   end Initialize;

end Gen.Testsuite;

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

with Ada.Directories;
with Ada.Strings.Unbounded;

with Gen.Artifacts.XMI.Tests;
with Gen.Integration.Tests;
package body Gen.Testsuite is

   Tests : aliased Util.Tests.Test_Suite;

   Dir   : Ada.Strings.Unbounded.Unbounded_String;

   function Suite return Util.Tests.Access_Test_Suite is
      Result : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      Gen.Artifacts.XMI.Tests.Add_Tests (Result);
      Gen.Integration.Tests.Add_Tests (Result);
      return Result;
   end Suite;

   --  ------------------------------
   --  Get the test root directory.
   --  ------------------------------
   function Get_Test_Directory return String is
   begin
      return Ada.Strings.Unbounded.To_String (Dir);
   end Get_Test_Directory;

   procedure Initialize (Props : in Util.Properties.Manager) is
      pragma Unreferenced (Props);
   begin
      Dir := Ada.Strings.Unbounded.To_Unbounded_String (Ada.Directories.Current_Directory);
   end Initialize;

end Gen.Testsuite;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  awa-blogs-beans -- Beans for blog module
--  Copyright (C) 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019 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.Calendar;
with Ada.Strings.Unbounded;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Wide_Wide_Hash;
with Ada.Strings.Wide_Wide_Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;

with ADO;
with ADO.Objects;

with Wiki.Strings;

with AWA.Blogs.Modules;
with AWA.Blogs.Models;
with AWA.Tags.Beans;
with AWA.Counters.Beans;
with AWA.Events;
with AWA.Components.Wikis;

--  == Ada Beans ==
--  Several bean types are provided to represent and manage the blogs and their posts.
--  The blog module registers the bean constructors when it is initialized.
--  To use them, one must declare a bean definition in the application XML configuration.
package AWA.Blogs.Beans is

   --  Attributes exposed by Post_Bean
   BLOG_ID_ATTR      : constant String := "blogId";
   POST_ID_ATTR      : constant String := "id";
   POST_UID_ATTR     : constant String := "uid";
   POST_TITLE_ATTR   : constant String := "title";
   POST_TEXT_ATTR    : constant String := "text";
   POST_URI_ATTR     : constant String := "uri";
   POST_STATUS_ATTR  : constant String := "status";
   POST_USERNAME_ATTR : constant String := "username";
   POST_IMAGE_ATTR          : constant String := "image";
   POST_DESCRIPTION_ATTR    : constant String := "description";
   POST_TAG_ATTR            : constant String := "tags";
   POST_ALLOW_COMMENTS_ATTR : constant String := "allow_comments";
   COUNTER_ATTR             : constant String := "counter";

   use Ada.Strings.Wide_Wide_Unbounded;

   package Image_Info_Maps is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => Wiki.Strings.WString,
                                                Element_Type    => Models.Image_Info,
                                                Hash            => Ada.Strings.Wide_Wide_Hash,
                                                Equivalent_Keys => "=",
                                                "="             => Models."=");

   type Post_Links_Bean is new AWA.Components.Wikis.Link_Renderer_Bean with record
      --  The wiki space identifier.
      Post_Id : ADO.Identifier;
      Images  : Image_Info_Maps.Map;
   end record;

   procedure Make_Image_Link (Renderer : in out Post_Links_Bean;
                              Link     : in Wiki.Strings.WString;
                              Info     : in AWA.Blogs.Models.Image_Info;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : in out Natural;
                              Height   : in out Natural);

   procedure Find_Image_Link (Renderer : in out Post_Links_Bean;
                              Link     : in Wiki.Strings.WString;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : in out Natural;
                              Height   : in out Natural);

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in out Post_Links_Bean;
                              Link     : in Wiki.Strings.WString;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : in out Natural;
                              Height   : in out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in out Post_Links_Bean;
                             Link     : in Wiki.Strings.WString;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean);

   --  ------------------------------
   --  Blog Bean
   --  ------------------------------
   --  The Blog_Bean holds the information about the current blog.
   --  It allows to create the blog as well as update its primary title.
   type Blog_Bean is new AWA.Blogs.Models.Blog_Bean with record
      Module  : AWA.Blogs.Modules.Blog_Module_Access := null;
   end record;
   type Blog_Bean_Access is access all Blog_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Blog_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Blog_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create a new blog.
   overriding
   procedure Create (Bean    : in out Blog_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the blog information.
   overriding
   procedure Load (Bean    : in out Blog_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Handle an event to create the blog entry automatically.
   overriding
   procedure Create_Default (Bean    : in out Blog_Bean;
                             Event   : in AWA.Events.Module_Event'Class);

   --  Create the Blog_Bean bean instance.
   function Create_Blog_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Post Bean
   --  ------------------------------
   --  The Post_Bean is used to create, update or display a post associated with a blog.
   type Post_Bean is new AWA.Blogs.Models.Post_Bean with record
      Module  : AWA.Blogs.Modules.Blog_Module_Access := null;
      Blog_Id : ADO.Identifier := ADO.NO_IDENTIFIER;

      --  List of tags associated with the post.
      Tags      : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean : Util.Beans.Basic.Readonly_Bean_Access;

      --  The post page links.
      Links         : aliased Post_Links_Bean;
      Links_Bean    : Util.Beans.Basic.Readonly_Bean_Access;

      --  The read post counter associated with the post.
      Counter       : aliased AWA.Counters.Beans.Counter_Bean (Of_Type => ADO.Objects.KEY_INTEGER,
                                                               Of_Class => Models.POST_TABLE);
      Counter_Bean  : Util.Beans.Basic.Readonly_Bean_Access;

      --  The post description generated from the content.
      Description   : Ada.Strings.Unbounded.Unbounded_String;
      Image_Link    : Wiki.Strings.UString;
   end record;
   type Post_Bean_Access is access all Post_Bean'Class;

   --  Build the URI from the post title and the post date.
   function Get_Predefined_Uri (Title : in String;
                                Date  : in Ada.Calendar.Time) return String;

   --  Make the post description from the summary or the content.
   procedure Make_Description (From : in out Post_Bean);

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Post_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Post_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the post.
   procedure Load_Post (Post : in out Post_Bean;
                        Id   : in ADO.Identifier);

   --  Create or save the post.
   overriding
   procedure Save (Bean    : in out Post_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete a post.
   overriding
   procedure Delete (Bean    : in out Post_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the post from the URI for the public display.
   overriding
   procedure Load (Bean    : in out Post_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the post from the URI for the administrator.
   overriding
   procedure Load_Admin (Bean    : in out Post_Bean;
                         Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the post from the URI either with visible comments or with all comments.
   procedure Load (Bean         : in out Post_Bean;
                   Outcome      : in out Ada.Strings.Unbounded.Unbounded_String;
                   Publish_Only : in Boolean);

   --  Create the Post_Bean bean instance.
   function Create_Post_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Post List Bean
   --  ------------------------------
   --  The Post_List_Bean gives a list of visible posts to be displayed to users.
   --  The list can be filtered by a given tag.  The list pagination is supported.
   type Post_List_Bean is new AWA.Blogs.Models.Post_List_Bean with record
      Posts      : aliased AWA.Blogs.Models.Post_Info_List_Bean;
      Service    : Modules.Blog_Module_Access := null;
      Tags       : AWA.Tags.Beans.Entity_Tag_Map;
      Posts_Bean : AWA.Blogs.Models.Post_Info_List_Bean_Access;

      --  The post page links.
      Links         : aliased Post_Links_Bean;
      Links_Bean    : access Post_Links_Bean;

      --  The read post counter associated with the post.
      Counter       : aliased AWA.Counters.Beans.Counter_Bean (Of_Type => ADO.Objects.KEY_INTEGER,
                                                               Of_Class => Models.POST_TABLE);
      Counter_Bean  : AWA.Counters.Beans.Counter_Bean_Access;
   end record;
   type Post_List_Bean_Access is access all Post_List_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Post_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Post_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   overriding
   procedure Load (From    : in out Post_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the list of posts.  If a tag was set, filter the list of posts with the tag.
   procedure Load_List (Into : in out Post_List_Bean);

   --  Create the Post_List_Bean bean instance.
   function Create_Post_List_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access;

   --  Get a select item list which contains a list of post status.
   function Create_Status_List (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access;

   type Init_Flag is (INIT_BLOG_LIST, INIT_POST_LIST, INIT_COMMENT_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Admin List Bean
   --  ------------------------------
   --  The Blog_Admin_Bean is used for the administration of a blog.  It gives the
   --  list of posts that are created, published or not.
   type Blog_Admin_Bean is new Util.Beans.Basic.Bean with record
      Module : AWA.Blogs.Modules.Blog_Module_Access := null;

      --  The blog identifier.
      Blog_Id          : ADO.Identifier := ADO.NO_IDENTIFIER;

      --  List of blogs.
      Blog_List        : aliased AWA.Blogs.Models.Blog_Info_List_Bean;
      Blog_List_Bean   : AWA.Blogs.Models.Blog_Info_List_Bean_Access;

      --  List of posts.
      Post_List        : aliased AWA.Blogs.Models.Admin_Post_Info_List_Bean;
      Post_List_Bean   : AWA.Blogs.Models.Admin_Post_Info_List_Bean_Access;

      --  List of comments.
      Comment_List      : aliased AWA.Blogs.Models.Comment_Info_List_Bean;
      Comment_List_Bean : AWA.Blogs.Models.Comment_Info_List_Bean_Access;

      --  Initialization flags.
      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Blog_Admin_Bean_Access is access all Blog_Admin_Bean;

   --  Get the blog identifier.
   function Get_Blog_Id (List : in Blog_Admin_Bean) return ADO.Identifier;

   --  Load the posts associated with the current blog.
   procedure Load_Posts (List : in Blog_Admin_Bean);

   --  Load the comments associated with the current blog.
   procedure Load_Comments (List : in Blog_Admin_Bean);

   overriding
   function Get_Value (List : in Blog_Admin_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Blog_Admin_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the list of blogs.
   procedure Load_Blogs (List : in Blog_Admin_Bean);

   --  Create the Blog_Admin_Bean bean instance.
   function Create_Blog_Admin_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Blog Statistics Bean
   --  ------------------------------
   --  The Blog_Stat_Bean is used to report various statistics about the blog or some post.
   type Blog_Stat_Bean is new AWA.Blogs.Models.Stat_List_Bean with record
      Module           : AWA.Blogs.Modules.Blog_Module_Access := null;

      Stats            : aliased AWA.Blogs.Models.Month_Stat_Info_List_Bean;
      Stats_Bean       : AWA.Blogs.Models.Month_Stat_Info_List_Bean_Access;
   end record;
   type Blog_Stat_Bean_Access is access all Blog_Stat_Bean;

   overriding
   function Get_Value (List : in Blog_Stat_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Blog_Stat_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the statistics information.
   overriding
   procedure Load (List    : in out Blog_Stat_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Blog_Stat_Bean bean instance.
   function Create_Blog_Stat_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Blogs.Beans;

-----------------------------------------------------------------------
--  awa-blogs-beans -- Beans for blog module
--  Copyright (C) 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019 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.Calendar;
with Ada.Strings.Unbounded;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Wide_Wide_Hash;
with Ada.Strings.Wide_Wide_Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;

with ADO;
with ADO.Objects;

with Wiki.Strings;

with ASF.Helpers.Beans;

with AWA.Blogs.Modules;
with AWA.Blogs.Models;
with AWA.Tags.Beans;
with AWA.Counters.Beans;
with AWA.Events;
with AWA.Components.Wikis;

--  == Ada Beans ==
--  Several bean types are provided to represent and manage the blogs and their posts.
--  The blog module registers the bean constructors when it is initialized.
--  To use them, one must declare a bean definition in the application XML configuration.
package AWA.Blogs.Beans is

   --  Attributes exposed by Post_Bean
   BLOG_ID_ATTR      : constant String := "blogId";
   POST_ID_ATTR      : constant String := "id";
   POST_UID_ATTR     : constant String := "uid";
   POST_TITLE_ATTR   : constant String := "title";
   POST_TEXT_ATTR    : constant String := "text";
   POST_URI_ATTR     : constant String := "uri";
   POST_STATUS_ATTR  : constant String := "status";
   POST_USERNAME_ATTR : constant String := "username";
   POST_IMAGE_ATTR          : constant String := "image";
   POST_DESCRIPTION_ATTR    : constant String := "description";
   POST_TAG_ATTR            : constant String := "tags";
   POST_ALLOW_COMMENTS_ATTR : constant String := "allow_comments";
   COUNTER_ATTR             : constant String := "counter";

   use Ada.Strings.Wide_Wide_Unbounded;

   --  Get a select item list which contains a list of blog post formats.
   function Create_Format_List_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   package Image_Info_Maps is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => Wiki.Strings.WString,
                                                Element_Type    => Models.Image_Info,
                                                Hash            => Ada.Strings.Wide_Wide_Hash,
                                                Equivalent_Keys => "=",
                                                "="             => Models."=");

   type Post_Links_Bean is new AWA.Components.Wikis.Link_Renderer_Bean with record
      --  The wiki space identifier.
      Post_Id : ADO.Identifier;
      Images  : Image_Info_Maps.Map;
   end record;

   procedure Make_Image_Link (Renderer : in out Post_Links_Bean;
                              Link     : in Wiki.Strings.WString;
                              Info     : in AWA.Blogs.Models.Image_Info;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : in out Natural;
                              Height   : in out Natural);

   procedure Find_Image_Link (Renderer : in out Post_Links_Bean;
                              Link     : in Wiki.Strings.WString;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : in out Natural;
                              Height   : in out Natural);

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in out Post_Links_Bean;
                              Link     : in Wiki.Strings.WString;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : in out Natural;
                              Height   : in out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in out Post_Links_Bean;
                             Link     : in Wiki.Strings.WString;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean);

   --  ------------------------------
   --  Blog Bean
   --  ------------------------------
   --  The Blog_Bean holds the information about the current blog.
   --  It allows to create the blog as well as update its primary title.
   type Blog_Bean is new AWA.Blogs.Models.Blog_Bean with record
      Module  : AWA.Blogs.Modules.Blog_Module_Access := null;
   end record;
   type Blog_Bean_Access is access all Blog_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Blog_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Blog_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Create a new blog.
   overriding
   procedure Create (Bean    : in out Blog_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the blog information.
   overriding
   procedure Load (Bean    : in out Blog_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Handle an event to create the blog entry automatically.
   overriding
   procedure Create_Default (Bean    : in out Blog_Bean;
                             Event   : in AWA.Events.Module_Event'Class);

   --  Create the Blog_Bean bean instance.
   function Create_Blog_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access;

   function Get_Blog_Bean is
     new ASF.Helpers.Beans.Get_Bean (Element_Type   => Blog_Bean,
                                     Element_Access => Blog_Bean_Access);

   --  ------------------------------
   --  Post Bean
   --  ------------------------------
   --  The Post_Bean is used to create, update or display a post associated with a blog.
   type Post_Bean is new AWA.Blogs.Models.Post_Bean with record
      Module  : AWA.Blogs.Modules.Blog_Module_Access := null;
      Blog_Id : ADO.Identifier := ADO.NO_IDENTIFIER;

      --  List of tags associated with the post.
      Tags      : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean : Util.Beans.Basic.Readonly_Bean_Access;

      --  The post page links.
      Links         : aliased Post_Links_Bean;
      Links_Bean    : Util.Beans.Basic.Readonly_Bean_Access;

      --  The read post counter associated with the post.
      Counter       : aliased AWA.Counters.Beans.Counter_Bean (Of_Type => ADO.Objects.KEY_INTEGER,
                                                               Of_Class => Models.POST_TABLE);
      Counter_Bean  : Util.Beans.Basic.Readonly_Bean_Access;

      --  The post description generated from the content.
      Description   : Ada.Strings.Unbounded.Unbounded_String;
      Image_Link    : Wiki.Strings.UString;
   end record;
   type Post_Bean_Access is access all Post_Bean'Class;

   --  Build the URI from the post title and the post date.
   function Get_Predefined_Uri (Title : in String;
                                Date  : in Ada.Calendar.Time) return String;

   --  Make the post description from the summary or the content.
   procedure Make_Description (From : in out Post_Bean);

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Post_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Post_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the post.
   procedure Load_Post (Post : in out Post_Bean;
                        Id   : in ADO.Identifier);

   --  Create or save the post.
   overriding
   procedure Save (Bean    : in out Post_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete a post.
   overriding
   procedure Delete (Bean    : in out Post_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the post from the URI for the public display.
   overriding
   procedure Load (Bean    : in out Post_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Setup the bean to create a new post.
   overriding
   procedure Setup (Bean    : in out Post_Bean;
                    Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the post from the URI for the administrator.
   overriding
   procedure Load_Admin (Bean    : in out Post_Bean;
                         Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the post from the URI either with visible comments or with all comments.
   procedure Load (Bean         : in out Post_Bean;
                   Outcome      : in out Ada.Strings.Unbounded.Unbounded_String;
                   Publish_Only : in Boolean);

   --  Create the Post_Bean bean instance.
   function Create_Post_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                              return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Post List Bean
   --  ------------------------------
   --  The Post_List_Bean gives a list of visible posts to be displayed to users.
   --  The list can be filtered by a given tag.  The list pagination is supported.
   type Post_List_Bean is new AWA.Blogs.Models.Post_List_Bean with record
      Posts      : aliased AWA.Blogs.Models.Post_Info_List_Bean;
      Service    : Modules.Blog_Module_Access := null;
      Tags       : AWA.Tags.Beans.Entity_Tag_Map;
      Posts_Bean : AWA.Blogs.Models.Post_Info_List_Bean_Access;

      --  The post page links.
      Links         : aliased Post_Links_Bean;
      Links_Bean    : access Post_Links_Bean;

      --  The read post counter associated with the post.
      Counter       : aliased AWA.Counters.Beans.Counter_Bean (Of_Type => ADO.Objects.KEY_INTEGER,
                                                               Of_Class => Models.POST_TABLE);
      Counter_Bean  : AWA.Counters.Beans.Counter_Bean_Access;
   end record;
   type Post_List_Bean_Access is access all Post_List_Bean'Class;

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Post_List_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Post_List_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   overriding
   procedure Load (From    : in out Post_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the list of posts.  If a tag was set, filter the list of posts with the tag.
   procedure Load_List (Into : in out Post_List_Bean);

   --  Create the Post_List_Bean bean instance.
   function Create_Post_List_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access;

   --  Get a select item list which contains a list of post status.
   function Create_Status_List (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                                return Util.Beans.Basic.Readonly_Bean_Access;

   type Init_Flag is (INIT_BLOG_LIST, INIT_POST_LIST, INIT_COMMENT_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Admin List Bean
   --  ------------------------------
   --  The Blog_Admin_Bean is used for the administration of a blog.  It gives the
   --  list of posts that are created, published or not.
   type Blog_Admin_Bean is new Util.Beans.Basic.Bean with record
      Module : AWA.Blogs.Modules.Blog_Module_Access := null;

      --  The blog identifier.
      Blog_Id          : ADO.Identifier := ADO.NO_IDENTIFIER;

      --  List of blogs.
      Blog_List        : aliased AWA.Blogs.Models.Blog_Info_List_Bean;
      Blog_List_Bean   : AWA.Blogs.Models.Blog_Info_List_Bean_Access;

      --  List of posts.
      Post_List        : aliased AWA.Blogs.Models.Admin_Post_Info_List_Bean;
      Post_List_Bean   : AWA.Blogs.Models.Admin_Post_Info_List_Bean_Access;

      --  List of comments.
      Comment_List      : aliased AWA.Blogs.Models.Comment_Info_List_Bean;
      Comment_List_Bean : AWA.Blogs.Models.Comment_Info_List_Bean_Access;

      --  Initialization flags.
      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Blog_Admin_Bean_Access is access all Blog_Admin_Bean;

   --  Get the blog identifier.
   function Get_Blog_Id (List : in Blog_Admin_Bean) return ADO.Identifier;

   --  Load the posts associated with the current blog.
   procedure Load_Posts (List : in Blog_Admin_Bean);

   --  Load the comments associated with the current blog.
   procedure Load_Comments (List : in Blog_Admin_Bean);

   overriding
   function Get_Value (List : in Blog_Admin_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Blog_Admin_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the list of blogs.
   procedure Load_Blogs (List : in Blog_Admin_Bean);

   --  Create the Blog_Admin_Bean bean instance.
   function Create_Blog_Admin_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Blog Statistics Bean
   --  ------------------------------
   --  The Blog_Stat_Bean is used to report various statistics about the blog or some post.
   type Blog_Stat_Bean is new AWA.Blogs.Models.Stat_List_Bean with record
      Module           : AWA.Blogs.Modules.Blog_Module_Access := null;

      Stats            : aliased AWA.Blogs.Models.Month_Stat_Info_List_Bean;
      Stats_Bean       : AWA.Blogs.Models.Month_Stat_Info_List_Bean_Access;
   end record;
   type Blog_Stat_Bean_Access is access all Blog_Stat_Bean;

   overriding
   function Get_Value (List : in Blog_Stat_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Blog_Stat_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Load the statistics information.
   overriding
   procedure Load (List    : in out Blog_Stat_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Blog_Stat_Bean bean instance.
   function Create_Blog_Stat_Bean (Module : in AWA.Blogs.Modules.Blog_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Blogs.Beans;

Add Create_Format_List_Bean function and override Setup procedure for the Post_Bean


with Ada.Numerics.Generic_Real_Arrays;
with OpenGL.Thin;

package OpenGL.Types is

  package Float_Arrays is new Ada.Numerics.Generic_Real_Arrays
    (Real => OpenGL.Thin.Float_t);
  package Double_Arrays is new Ada.Numerics.Generic_Real_Arrays
    (Real => OpenGL.Thin.Double_t);

  type Vector_3f_t is new Float_Arrays.Real_Vector (1 .. 3);
  type Vector_4f_t is new Float_Arrays.Real_Vector (1 .. 3);

  subtype Float_t          is Thin.Float_t;
  subtype Double_t         is Thin.Double_t;

  subtype Clamped_Double_t is Double_t range 0.0 .. 1.0;
  subtype Clamped_Float_t  is Float_t range 0.0 .. 1.0;

end OpenGL.Types;

with Ada.Numerics.Generic_Real_Arrays;
with OpenGL.Thin;

package OpenGL.Types is

  package Float_Arrays is new Ada.Numerics.Generic_Real_Arrays
    (Real => OpenGL.Thin.Float_t);
  package Double_Arrays is new Ada.Numerics.Generic_Real_Arrays
    (Real => OpenGL.Thin.Double_t);

  type Vector_2f_t is new Float_Arrays.Real_Vector (1 .. 2);
  type Vector_3f_t is new Float_Arrays.Real_Vector (1 .. 3);
  type Vector_4f_t is new Float_Arrays.Real_Vector (1 .. 4);

  subtype Float_t          is Thin.Float_t;
  subtype Double_t         is Thin.Double_t;

  subtype Clamped_Double_t is Double_t range 0.0 .. 1.0;
  subtype Clamped_Float_t  is Float_t range 0.0 .. 1.0;

end OpenGL.Types;

update vector types.

update vector types.


-----------------------------------------------------------------------
--  util-system-os -- Unix system operations
--  Copyright (C) 2011, 2012, 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 System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Processes;
with Util.Systems.Constants;
with Util.Systems.Types;

--  The Util.Systems.Os package defines various types and operations which are specific
--  to the OS (Unix).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '/';

   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype Ptr_Array is Interfaces.C.Strings.chars_ptr_array;
   type Ptr_Ptr_Array is access all Ptr_Array;

   type File_Type is new Integer;

   --  Standard file streams Posix, X/Open standard values.
   STDIN_FILENO  : constant File_Type := 0;
   STDOUT_FILENO : constant File_Type := 1;
   STDERR_FILENO : constant File_Type := 2;

   --  File is not opened
   NO_FILE       : constant File_Type := -1;

   --  The following values should be externalized.  They are valid for GNU/Linux.
   F_SETFL    : constant Interfaces.C.int := Util.Systems.Constants.F_SETFL;
   FD_CLOEXEC : constant Interfaces.C.int := Util.Systems.Constants.FD_CLOEXEC;

   --  These values are specific to Linux.
   O_RDONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_RDONLY;
   O_WRONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_WRONLY;
   O_RDWR     : constant Interfaces.C.int := Util.Systems.Constants.O_RDWR;
   O_CREAT    : constant Interfaces.C.int := Util.Systems.Constants.O_CREAT;
   O_EXCL     : constant Interfaces.C.int := Util.Systems.Constants.O_EXCL;
   O_TRUNC    : constant Interfaces.C.int := Util.Systems.Constants.O_TRUNC;
   O_APPEND   : constant Interfaces.C.int := Util.Systems.Constants.O_APPEND;

   type Size_T is mod 2 ** Standard'Address_Size;

   type Ssize_T is range -(2 ** (Standard'Address_Size - 1))
     .. +(2 ** (Standard'Address_Size - 1)) - 1;

   function Close (Fd : in File_Type) return Integer;
   pragma Import (C, Close, "close");

   function Read (Fd   : in File_Type;
                  Buf  : in System.Address;
                  Size : in Size_T) return Ssize_T;
   pragma Import (C, Read, "read");

   function Write (Fd   : in File_Type;
                   Buf  : in System.Address;
                   Size : in Size_T) return Ssize_T;
   pragma Import (C, Write, "write");

   --  System exit without any process cleaning.
   --  (destructors, finalizers, atexit are not called)
   procedure Sys_Exit (Code : in Integer);
   pragma Import (C, Sys_Exit, "_exit");

   --  Fork a new process
   function Sys_Fork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_Fork, "fork");

   --  Fork a new process (vfork implementation)
   function Sys_VFork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_VFork, "fork");

   --  Execute a process with the given arguments.
   function Sys_Execvp (File : in Ptr;
                        Args : in Ptr_Array) return Integer;
   pragma Import (C, Sys_Execvp, "execvp");

   --  Wait for the process Pid to finish and return
   function Sys_Waitpid (Pid     : in Integer;
                         Status  : in System.Address;
                         Options : in Integer) return Integer;
   pragma Import (C, Sys_Waitpid, "waitpid");

   --  Create a bi-directional pipe
   function Sys_Pipe (Fds : in System.Address) return Integer;
   pragma Import (C, Sys_Pipe, "pipe");

   --  Make fd2 the copy of fd1
   function Sys_Dup2 (Fd1, Fd2 : in File_Type) return Integer;
   pragma Import (C, Sys_Dup2, "dup2");

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer;
   pragma Import (C, Sys_Close, "close");

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Interfaces.C.int) return File_Type;
   pragma Import (C, Sys_Open, "open");

   --  Change the file settings
   function Sys_Fcntl (Fd    : in File_Type;
                       Cmd   : in Interfaces.C.int;
                       Flags : in Interfaces.C.int) return Integer;
   pragma Import (C, Sys_Fcntl, "fcntl");

   function Sys_Kill (Pid : in Integer;
                      Signal : in Integer) return Integer;
   pragma Import (C, Sys_Kill, "kill");

   function Sys_Stat (Path : in Ptr;
                      Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Stat, "stat");

   function Sys_Fstat (Fs : in File_Type;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Fstat, "fstat");

end Util.Systems.Os;

-----------------------------------------------------------------------
--  util-system-os -- Unix system operations
--  Copyright (C) 2011, 2012, 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 System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Processes;
with Util.Systems.Constants;
with Util.Systems.Types;

--  The Util.Systems.Os package defines various types and operations which are specific
--  to the OS (Unix).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '/';

   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype Ptr_Array is Interfaces.C.Strings.chars_ptr_array;
   type Ptr_Ptr_Array is access all Ptr_Array;

   type File_Type is new Integer;

   --  Standard file streams Posix, X/Open standard values.
   STDIN_FILENO  : constant File_Type := 0;
   STDOUT_FILENO : constant File_Type := 1;
   STDERR_FILENO : constant File_Type := 2;

   --  File is not opened
   NO_FILE       : constant File_Type := -1;

   --  The following values should be externalized.  They are valid for GNU/Linux.
   F_SETFL    : constant Interfaces.C.int := Util.Systems.Constants.F_SETFL;
   FD_CLOEXEC : constant Interfaces.C.int := Util.Systems.Constants.FD_CLOEXEC;

   --  These values are specific to Linux.
   O_RDONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_RDONLY;
   O_WRONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_WRONLY;
   O_RDWR     : constant Interfaces.C.int := Util.Systems.Constants.O_RDWR;
   O_CREAT    : constant Interfaces.C.int := Util.Systems.Constants.O_CREAT;
   O_EXCL     : constant Interfaces.C.int := Util.Systems.Constants.O_EXCL;
   O_TRUNC    : constant Interfaces.C.int := Util.Systems.Constants.O_TRUNC;
   O_APPEND   : constant Interfaces.C.int := Util.Systems.Constants.O_APPEND;

   type Size_T is mod 2 ** Standard'Address_Size;

   type Ssize_T is range -(2 ** (Standard'Address_Size - 1))
     .. +(2 ** (Standard'Address_Size - 1)) - 1;

   function Close (Fd : in File_Type) return Integer;
   pragma Import (C, Close, "close");

   function Read (Fd   : in File_Type;
                  Buf  : in System.Address;
                  Size : in Size_T) return Ssize_T;
   pragma Import (C, Read, "read");

   function Write (Fd   : in File_Type;
                   Buf  : in System.Address;
                   Size : in Size_T) return Ssize_T;
   pragma Import (C, Write, "write");

   --  System exit without any process cleaning.
   --  (destructors, finalizers, atexit are not called)
   procedure Sys_Exit (Code : in Integer);
   pragma Import (C, Sys_Exit, "_exit");

   --  Fork a new process
   function Sys_Fork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_Fork, "fork");

   --  Fork a new process (vfork implementation)
   function Sys_VFork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_VFork, "fork");

   --  Execute a process with the given arguments.
   function Sys_Execvp (File : in Ptr;
                        Args : in Ptr_Array) return Integer;
   pragma Import (C, Sys_Execvp, "execvp");

   --  Wait for the process Pid to finish and return
   function Sys_Waitpid (Pid     : in Integer;
                         Status  : in System.Address;
                         Options : in Integer) return Integer;
   pragma Import (C, Sys_Waitpid, "waitpid");

   --  Create a bi-directional pipe
   function Sys_Pipe (Fds : in System.Address) return Integer;
   pragma Import (C, Sys_Pipe, "pipe");

   --  Make fd2 the copy of fd1
   function Sys_Dup2 (Fd1, Fd2 : in File_Type) return Integer;
   pragma Import (C, Sys_Dup2, "dup2");

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer;
   pragma Import (C, Sys_Close, "close");

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Interfaces.C.int) return File_Type;
   pragma Import (C, Sys_Open, "open");

   --  Change the file settings
   function Sys_Fcntl (Fd    : in File_Type;
                       Cmd   : in Interfaces.C.int;
                       Flags : in Interfaces.C.int) return Integer;
   pragma Import (C, Sys_Fcntl, "fcntl");

   function Sys_Kill (Pid : in Integer;
                      Signal : in Integer) return Integer;
   pragma Import (C, Sys_Kill, "kill");

   function Sys_Stat (Path : in Ptr;
                      Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Stat, Util.Systems.Types.STAT_NAME);

   function Sys_Fstat (Fs : in File_Type;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Fstat, Util.Systems.Types.FSTAT_NAME);

end Util.Systems.Os;

Use the generated system call name for stat() and fstat()