-----------------------------------------------------------------------
--  ADO Drivers -- Database Drivers
--  Copyright (C) 2010, 2011, 2012, 2013, 2015, 2016, 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.Log.Loggers;
with Util.Systems.DLLs;

with System;
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Exceptions;

package body ADO.Drivers.Connections is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Drivers.Connections");

   --  Load the database driver.
   procedure Load_Driver (Name : in String);

   --  ------------------------------
   --  Get the driver index that corresponds to the driver for this database connection string.
   --  ------------------------------
   function Get_Driver (Config : in Configuration) return Driver_Index is
      Driver  : constant Driver_Access := Get_Driver (Config.Get_Driver);
   begin
      if Driver = null then
         return Driver_Index'First;
      else
         return Driver.Get_Driver_Index;
      end if;
   end Get_Driver;

   --  ------------------------------
   --  Create a new connection using the configuration parameters.
   --  ------------------------------
   procedure Create_Connection (Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class) is
      Driver  : Driver_Access;
      Log_URI : constant String := Config.Get_Log_URI;
   begin
      Driver := Get_Driver (Config.Get_Driver);
      if Driver = null then
         Log.Error ("No driver found for connection {0}", Log_URI);
         raise ADO.Configs.Connection_Error with
           "Data source is not initialized: driver '" & Config.Get_Driver & "' not found";
      end if;
      Driver.Create_Connection (Config, Result);
      if Result.Is_Null then
         Log.Error ("Driver {0} failed to create connection {0}",
                    Driver.Name.all, Log_URI);
         raise ADO.Configs.Connection_Error with
           "Data source is not initialized: driver error";
      end if;
      Log.Info ("Created connection to '{0}' -> {1}", Log_URI, Result.Value.Ident);

   exception
      when others =>
         Log.Info ("Failed to create connection to '{0}'", Log_URI);
         raise;

   end Create_Connection;

   --  Get the database driver index.
   function Get_Driver_Index (Database : in Database_Connection) return Driver_Index is
      Driver : constant ADO.Drivers.Connections.Driver_Access
         := Database_Connection'Class (Database).Get_Driver;
   begin
      return Driver.Get_Driver_Index;
   end Get_Driver_Index;

   package Driver_List is
     new Ada.Containers.Doubly_Linked_Lists (Element_Type => Driver_Access);

   Next_Index : Driver_Index := 1;
   Drivers    : Driver_List.List;

   --  ------------------------------
   --  Get the driver unique index.
   --  ------------------------------
   function Get_Driver_Index (D : in Driver) return Driver_Index is
   begin
      return D.Index;
   end Get_Driver_Index;

   --  ------------------------------
   --  Get the driver name.
   --  ------------------------------
   function Get_Driver_Name (D : in Driver) return String is
   begin
      return D.Name.all;
   end Get_Driver_Name;

   --  ------------------------------
   --  Register a database driver.
   --  ------------------------------
   procedure Register (Driver : in Driver_Access) is
   begin
      Log.Info ("Register driver {0}", Driver.Name.all);

      Driver_List.Prepend (Container => Drivers, New_Item => Driver);
      Driver.Index := Next_Index;
      Next_Index := Next_Index + 1;
   end Register;

   --  ------------------------------
   --  Load the database driver.
   --  ------------------------------
   procedure Load_Driver (Name : in String) is
      Lib    : constant String := "libada_ado_" & Name & Util.Systems.DLLs.Extension;
      Symbol : constant String := "ado__drivers__connections__" & Name & "__initialize";
      Handle : Util.Systems.DLLs.Handle;
      Addr   : System.Address;

   begin
      Log.Debug ("Loading driver {0}", Lib);
      Handle := Util.Systems.DLLs.Load (Lib);
      Addr := Util.Systems.DLLs.Get_Symbol (Handle, Symbol);

      declare
         procedure Init;
         pragma Import (C, Init);
         for Init'Address use Addr;
      begin
         Log.Info ("Initialising driver {0}", Lib);
         Init;
      end;
   exception
      when Util.Systems.DLLs.Not_Found =>
         Log.Error ("Driver for {0} was loaded but does not define the initialization symbol",
                    Name);

      when E : Util.Systems.DLLs.Load_Error =>
         Log.Error ("Driver for {0} was not found: {1}",
                    Name, Ada.Exceptions.Exception_Message (E));

   end Load_Driver;

   --  ------------------------------
   --  Get a database driver given its name.
   --  ------------------------------
   function Get_Driver (Name : in String) return Driver_Access is
   begin
      Log.Debug ("Get driver {0}", Name);

      if Name'Length = 0 then
         return null;
      end if;

      for Retry in 0 .. 2 loop
         if Retry = 1 then
            ADO.Drivers.Initialize;
         elsif Retry = 2 then
            Load_Driver (Name);
         end if;
         declare
            Iter : Driver_List.Cursor := Driver_List.First (Drivers);
         begin
            while Driver_List.Has_Element (Iter) loop
               declare
                  D : constant Driver_Access := Driver_List.Element (Iter);
               begin
                  if Name = D.Name.all then
                     return D;
                  end if;
               end;
               Driver_List.Next (Iter);
            end loop;
         end;
      end loop;
      return null;
   end Get_Driver;

end ADO.Drivers.Connections;

-----------------------------------------------------------------------
--  ADO Drivers -- Database Drivers
--  Copyright (C) 2010, 2011, 2012, 2013, 2015, 2016, 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.Log.Loggers;
with Util.Systems.DLLs;

with System;
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Exceptions;

package body ADO.Drivers.Connections is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Drivers.Connections");

   --  Load the database driver.
   procedure Load_Driver (Name : in String);

   --  ------------------------------
   --  Get the driver index that corresponds to the driver for this database connection string.
   --  ------------------------------
   function Get_Driver (Config : in Configuration) return Driver_Index is
      Driver  : constant Driver_Access := Get_Driver (Config.Get_Driver);
   begin
      if Driver = null then
         return Driver_Index'First;
      else
         return Driver.Get_Driver_Index;
      end if;
   end Get_Driver;

   --  ------------------------------
   --  Create a new connection using the configuration parameters.
   --  ------------------------------
   procedure Create_Connection (Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class) is
      Driver  : Driver_Access;
      Log_URI : constant String := Config.Get_Log_URI;
   begin
      Driver := Get_Driver (Config.Get_Driver);
      if Driver = null then
         Log.Error ("No driver found for connection {0}", Log_URI);
         raise ADO.Configs.Connection_Error with
           "Data source is not initialized: driver '" & Config.Get_Driver & "' not found";
      end if;
      Driver.Create_Connection (Config, Result);
      Log.Info ("Created connection to '{0}' -> {1}", Log_URI, Result.Value.Ident);

   exception
      when others =>
         Log.Info ("Failed to create connection to '{0}'", Log_URI);
         raise;

   end Create_Connection;

   --  Get the database driver index.
   function Get_Driver_Index (Database : in Database_Connection) return Driver_Index is
      Driver : constant ADO.Drivers.Connections.Driver_Access
         := Database_Connection'Class (Database).Get_Driver;
   begin
      return Driver.Get_Driver_Index;
   end Get_Driver_Index;

   package Driver_List is
     new Ada.Containers.Doubly_Linked_Lists (Element_Type => Driver_Access);

   Next_Index : Driver_Index := 1;
   Drivers    : Driver_List.List;

   --  ------------------------------
   --  Get the driver unique index.
   --  ------------------------------
   function Get_Driver_Index (D : in Driver) return Driver_Index is
   begin
      return D.Index;
   end Get_Driver_Index;

   --  ------------------------------
   --  Get the driver name.
   --  ------------------------------
   function Get_Driver_Name (D : in Driver) return String is
   begin
      return D.Name.all;
   end Get_Driver_Name;

   --  ------------------------------
   --  Register a database driver.
   --  ------------------------------
   procedure Register (Driver : in Driver_Access) is
   begin
      Log.Info ("Register driver {0}", Driver.Name.all);

      Driver_List.Prepend (Container => Drivers, New_Item => Driver);
      Driver.Index := Next_Index;
      Next_Index := Next_Index + 1;
   end Register;

   --  ------------------------------
   --  Load the database driver.
   --  ------------------------------
   procedure Load_Driver (Name : in String) is
      Lib    : constant String := "libada_ado_" & Name & Util.Systems.DLLs.Extension;
      Symbol : constant String := "ado__drivers__connections__" & Name & "__initialize";
      Handle : Util.Systems.DLLs.Handle;
      Addr   : System.Address;

   begin
      Log.Debug ("Loading driver {0}", Lib);
      Handle := Util.Systems.DLLs.Load (Lib);
      Addr := Util.Systems.DLLs.Get_Symbol (Handle, Symbol);

      declare
         procedure Init;
         pragma Import (C, Init);
         for Init'Address use Addr;
      begin
         Log.Info ("Initialising driver {0}", Lib);
         Init;
      end;
   exception
      when Util.Systems.DLLs.Not_Found =>
         Log.Error ("Driver for {0} was loaded but does not define the initialization symbol",
                    Name);

      when E : Util.Systems.DLLs.Load_Error =>
         Log.Error ("Driver for {0} was not found: {1}",
                    Name, Ada.Exceptions.Exception_Message (E));

   end Load_Driver;

   --  ------------------------------
   --  Get a database driver given its name.
   --  ------------------------------
   function Get_Driver (Name : in String) return Driver_Access is
   begin
      Log.Debug ("Get driver {0}", Name);

      if Name'Length = 0 then
         return null;
      end if;

      for Retry in 0 .. 2 loop
         if Retry = 1 then
            ADO.Drivers.Initialize;
         elsif Retry = 2 then
            Load_Driver (Name);
         end if;
         declare
            Iter : Driver_List.Cursor := Driver_List.First (Drivers);
         begin
            while Driver_List.Has_Element (Iter) loop
               declare
                  D : constant Driver_Access := Driver_List.Element (Iter);
               begin
                  if Name = D.Name.all then
                     return D;
                  end if;
               end;
               Driver_List.Next (Iter);
            end loop;
         end;
      end loop;
      return null;
   end Get_Driver;

end ADO.Drivers.Connections;

Remove check of database driver connection because the post condition now guarantees it is never null


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

with Util.Log.Loggers;
with Util.Systems.DLLs;

with System;
with Ada.Strings.Fixed;
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Exceptions;

package body ADO.Drivers.Connections is

   use Util.Log;
   use Ada.Strings.Fixed;

   Log : constant Loggers.Logger := Loggers.Create ("ADO.Drivers.Connections");

   --  ------------------------------
   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   --  ------------------------------
   procedure Set_Connection (Controller : in out Configuration;
                             URI        : in String) is

      Pos, Pos2, Slash_Pos, Next : Natural;
   begin
      Log.Info ("Set connection URI: {0}", URI);

      Controller.URI := To_Unbounded_String (URI);
      Pos := Index (URI, "://");
      if Pos <= 1 then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid URI: '" & URI & "'";
      end if;
      Controller.Driver := Get_Driver (URI (URI'First .. Pos - 1));
      if Controller.Driver = null then
         Log.Error ("No driver found for connection URI: {0}", URI);
         raise Connection_Error
           with "Driver '" & URI (URI'First .. Pos - 1) & "' not found";
      end if;

      Pos := Pos + 3;
      Slash_Pos := Index (URI, "/", Pos);
      if Slash_Pos < Pos then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid connection URI: '" & URI & "'";
      end if;

      --  Extract the server and port.
      Pos2 := Index (URI, ":", Pos);
      if Pos2 > Pos then
         Controller.Server := To_Unbounded_String (URI (Pos .. Pos2 - 1));
         Controller.Port := Integer'Value (URI (Pos2 + 1 .. Slash_Pos - 1));

      else
         Controller.Port := 0;
         Controller.Server := To_Unbounded_String (URI (Pos .. Slash_Pos - 1));
      end if;

      --  Extract the database name.
      Pos := Index (URI, "?", Slash_Pos);
      if Pos - 1 > Slash_Pos + 1 then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. Pos - 1));
      elsif Pos = 0 and Slash_Pos + 1 < URI'Last then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. URI'Last));
      else
         Controller.Database := Null_Unbounded_String;
      end if;

      --  Parse the optional properties
      if Pos > Slash_Pos then
         while Pos < URI'Last loop
            Pos2 := Index (URI, "=", Pos + 1);
            if Pos2 > Pos then
               Next := Index (URI, "&", Pos2 + 1);
               if Next > 0 then
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. Next - 1));
                  Pos := Next;
               else
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. URI'Last));
                  Pos := URI'Last;
               end if;
            else
               Controller.Properties.Set (URI (Pos + 1 .. URI'Last), "");
               Pos := URI'Last;
            end if;
         end loop;
      end if;
   end Set_Connection;

   --  ------------------------------
   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   --  ------------------------------
   procedure Set_Property (Controller : in out Configuration;
                           Name       : in String;
                           Value      : in String) is
   begin
      Controller.Properties.Set (Name, Value);
   end Set_Property;

   --  ------------------------------
   --  Get a property from the datasource configuration.
   --  If the property does not exist, an empty string is returned.
   --  ------------------------------
   function Get_Property (Controller : in Configuration;
                          Name       : in String) return String is
   begin
      return Controller.Properties.Get (Name, "");
   end Get_Property;

   --  ------------------------------
   --  Get the server hostname.
   --  ------------------------------
   function Get_Server (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Server);
   end Get_Server;

   --  ------------------------------
   --  Get the server port.
   --  ------------------------------
   function Get_Port (Controller : in Configuration) return Integer is
   begin
      return Controller.Port;
   end Get_Port;

   --  ------------------------------
   --  Get the database name.
   --  ------------------------------
   function Get_Database (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Database);
   end Get_Database;

   --  ------------------------------
   --  Create a new connection using the configuration parameters.
   --  ------------------------------
   procedure Create_Connection (Config : in Configuration'Class;
                                Result : out Database_Connection_Access) is
   begin
      if Config.Driver = null then
         Log.Error ("No driver found for connection {0}", To_String (Config.URI));
         raise Connection_Error with "Data source is not initialized: driver not found";
      end if;
      Config.Driver.Create_Connection (Config, Result);
      Log.Info ("Created connection to '{0}' -> {1}", Config.URI, Result.Ident);

   exception
      when others =>
         Log.Info ("Failed to create connection to '{0}'", Config.URI);
         raise;

   end Create_Connection;

   package Driver_List is
     new Ada.Containers.Doubly_Linked_Lists (Element_Type => Driver_Access);

   Next_Index : Driver_Index := 1;
   Drivers    : Driver_List.List;

   --  ------------------------------
   --  Get the driver unique index.
   --  ------------------------------
   function Get_Driver_Index (D : in Driver) return Driver_Index is
   begin
      return D.Index;
   end Get_Driver_Index;

   --  ------------------------------
   --  Get the driver name.
   --  ------------------------------
   function Get_Driver_Name (D : in Driver) return String is
   begin
      return D.Name.all;
   end Get_Driver_Name;

   --  ------------------------------
   --  Register a database driver.
   --  ------------------------------
   procedure Register (Driver : in Driver_Access) is
   begin
      Log.Info ("Register driver {0}", Driver.Name.all);

      Driver_List.Prepend (Container => Drivers, New_Item => Driver);
      Driver.Index := Next_Index;
      Next_Index := Next_Index + 1;
   end Register;

   type Driver_Initialize_Access is not null access procedure;

   procedure Load_Driver (Name : in String) is
      Lib    : constant String := "libada_ado_" & Name & Util.Systems.DLLs.Extension;
      Symbol : constant String := "ado__drivers__connections__" & Name & "__initialize";
      Handle : Util.Systems.DLLs.Handle;
      Addr   : System.Address;

   begin
      Log.Info ("Loading driver {0}", Lib);
      Handle := Util.Systems.DLLs.Load (Lib);
      Addr := Util.Systems.DLLs.Get_Symbol (Handle, Symbol);

      declare
         procedure Init;
         pragma Import (C, Init);
         for Init'Address use Addr;
      begin
         Init;
      end;
   exception
      when Util.Systems.DLLs.Not_Found =>
         Log.Error ("Driver for {0} was loaded but does not define the initialization symbol",
                    Name);

      when E : Util.Systems.DLLs.Load_Error =>
         Log.Error ("Driver for {0} was not found: {1}",
                    Name, Ada.Exceptions.Exception_Message (E));

   end Load_Driver;

   --  ------------------------------
   --  Get a database driver given its name.
   --  ------------------------------
   function Get_Driver (Name : in String) return Driver_Access is
   begin
      Log.Info ("Get driver {0}", Name);

      for Retry in 0 .. 1 loop
         if Retry > 0 then
            Load_Driver (Name);
         end if;
         declare
            Iter : Driver_List.Cursor := Driver_List.First (Drivers);
         begin
            while Driver_List.Has_Element (Iter) loop
               declare
                  D : constant Driver_Access := Driver_List.Element (Iter);
               begin
                  if Name = D.Name.all then
                     return D;
                  end if;
               end;
               Driver_List.Next (Iter);
            end loop;
         end;
      end loop;
      return null;
   end Get_Driver;

end ADO.Drivers.Connections;

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

with Util.Log.Loggers;
with Util.Systems.DLLs;

with System;
with Ada.Strings.Fixed;
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Exceptions;

package body ADO.Drivers.Connections is

   use Ada.Strings.Fixed;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("ADO.Drivers.Connections");

   --  Load the database driver.
   procedure Load_Driver (Name : in String);

   --  ------------------------------
   --  Set the connection URL to connect to the database.
   --  The driver connection is a string of the form:
   --
   --   driver://[host][:port]/[database][?property1][=value1]...
   --
   --  If the string is invalid or if the driver cannot be found,
   --  the Connection_Error exception is raised.
   --  ------------------------------
   procedure Set_Connection (Controller : in out Configuration;
                             URI        : in String) is

      Pos, Pos2, Slash_Pos, Next : Natural;
   begin
      Log.Info ("Set connection URI: {0}", URI);

      Controller.URI := To_Unbounded_String (URI);
      Pos := Index (URI, "://");
      if Pos <= 1 then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid URI: '" & URI & "'";
      end if;
      Controller.Driver := Get_Driver (URI (URI'First .. Pos - 1));
      if Controller.Driver = null then
         Log.Error ("No driver found for connection URI: {0}", URI);
         raise Connection_Error
           with "Driver '" & URI (URI'First .. Pos - 1) & "' not found";
      end if;

      Pos := Pos + 3;
      Slash_Pos := Index (URI, "/", Pos);
      if Slash_Pos < Pos then
         Log.Error ("Invalid connection URI: {0}", URI);
         raise Connection_Error
           with "Invalid connection URI: '" & URI & "'";
      end if;

      --  Extract the server and port.
      Pos2 := Index (URI, ":", Pos);
      if Pos2 > Pos then
         Controller.Server := To_Unbounded_String (URI (Pos .. Pos2 - 1));
         Controller.Port := Integer'Value (URI (Pos2 + 1 .. Slash_Pos - 1));

      else
         Controller.Port := 0;
         Controller.Server := To_Unbounded_String (URI (Pos .. Slash_Pos - 1));
      end if;

      --  Extract the database name.
      Pos := Index (URI, "?", Slash_Pos);
      if Pos - 1 > Slash_Pos + 1 then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. Pos - 1));
      elsif Pos = 0 and Slash_Pos + 1 < URI'Last then
         Controller.Database := To_Unbounded_String (URI (Slash_Pos + 1 .. URI'Last));
      else
         Controller.Database := Null_Unbounded_String;
      end if;

      --  Parse the optional properties
      if Pos > Slash_Pos then
         while Pos < URI'Last loop
            Pos2 := Index (URI, "=", Pos + 1);
            if Pos2 > Pos then
               Next := Index (URI, "&", Pos2 + 1);
               if Next > 0 then
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. Next - 1));
                  Pos := Next;
               else
                  Controller.Properties.Set (URI (Pos + 1 .. Pos2 - 1),
                                             URI (Pos2 + 1 .. URI'Last));
                  Pos := URI'Last;
               end if;
            else
               Controller.Properties.Set (URI (Pos + 1 .. URI'Last), "");
               Pos := URI'Last;
            end if;
         end loop;
      end if;
   end Set_Connection;

   --  ------------------------------
   --  Set a property on the datasource for the driver.
   --  The driver can retrieve the property to configure and open
   --  the database connection.
   --  ------------------------------
   procedure Set_Property (Controller : in out Configuration;
                           Name       : in String;
                           Value      : in String) is
   begin
      Controller.Properties.Set (Name, Value);
   end Set_Property;

   --  ------------------------------
   --  Get a property from the datasource configuration.
   --  If the property does not exist, an empty string is returned.
   --  ------------------------------
   function Get_Property (Controller : in Configuration;
                          Name       : in String) return String is
   begin
      return Controller.Properties.Get (Name, "");
   end Get_Property;

   --  ------------------------------
   --  Get the server hostname.
   --  ------------------------------
   function Get_Server (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Server);
   end Get_Server;

   --  ------------------------------
   --  Get the server port.
   --  ------------------------------
   function Get_Port (Controller : in Configuration) return Integer is
   begin
      return Controller.Port;
   end Get_Port;

   --  ------------------------------
   --  Get the database name.
   --  ------------------------------
   function Get_Database (Controller : in Configuration) return String is
   begin
      return To_String (Controller.Database);
   end Get_Database;

   --  ------------------------------
   --  Create a new connection using the configuration parameters.
   --  ------------------------------
   procedure Create_Connection (Config : in Configuration'Class;
                                Result : out Database_Connection_Access) is
   begin
      if Config.Driver = null then
         Log.Error ("No driver found for connection {0}", To_String (Config.URI));
         raise Connection_Error with "Data source is not initialized: driver not found";
      end if;
      Config.Driver.Create_Connection (Config, Result);
      Log.Info ("Created connection to '{0}' -> {1}", Config.URI, Result.Ident);

   exception
      when others =>
         Log.Info ("Failed to create connection to '{0}'", Config.URI);
         raise;

   end Create_Connection;

   package Driver_List is
     new Ada.Containers.Doubly_Linked_Lists (Element_Type => Driver_Access);

   Next_Index : Driver_Index := 1;
   Drivers    : Driver_List.List;

   --  ------------------------------
   --  Get the driver unique index.
   --  ------------------------------
   function Get_Driver_Index (D : in Driver) return Driver_Index is
   begin
      return D.Index;
   end Get_Driver_Index;

   --  ------------------------------
   --  Get the driver name.
   --  ------------------------------
   function Get_Driver_Name (D : in Driver) return String is
   begin
      return D.Name.all;
   end Get_Driver_Name;

   --  ------------------------------
   --  Register a database driver.
   --  ------------------------------
   procedure Register (Driver : in Driver_Access) is
   begin
      Log.Info ("Register driver {0}", Driver.Name.all);

      Driver_List.Prepend (Container => Drivers, New_Item => Driver);
      Driver.Index := Next_Index;
      Next_Index := Next_Index + 1;
   end Register;

   --  ------------------------------
   --  Load the database driver.
   --  ------------------------------
   procedure Load_Driver (Name : in String) is
      Lib    : constant String := "libada_ado_" & Name & Util.Systems.DLLs.Extension;
      Symbol : constant String := "ado__drivers__connections__" & Name & "__initialize";
      Handle : Util.Systems.DLLs.Handle;
      Addr   : System.Address;

   begin
      Log.Info ("Loading driver {0}", Lib);
      Handle := Util.Systems.DLLs.Load (Lib);
      Addr := Util.Systems.DLLs.Get_Symbol (Handle, Symbol);

      declare
         procedure Init;
         pragma Import (C, Init);
         for Init'Address use Addr;
      begin
         Init;
      end;
   exception
      when Util.Systems.DLLs.Not_Found =>
         Log.Error ("Driver for {0} was loaded but does not define the initialization symbol",
                    Name);

      when E : Util.Systems.DLLs.Load_Error =>
         Log.Error ("Driver for {0} was not found: {1}",
                    Name, Ada.Exceptions.Exception_Message (E));

   end Load_Driver;

   --  ------------------------------
   --  Get a database driver given its name.
   --  ------------------------------
   function Get_Driver (Name : in String) return Driver_Access is
   begin
      Log.Info ("Get driver {0}", Name);

      for Retry in 0 .. 1 loop
         if Retry > 0 then
            Load_Driver (Name);
         end if;
         declare
            Iter : Driver_List.Cursor := Driver_List.First (Drivers);
         begin
            while Driver_List.Has_Element (Iter) loop
               declare
                  D : constant Driver_Access := Driver_List.Element (Iter);
               begin
                  if Name = D.Name.all then
                     return D;
                  end if;
               end;
               Driver_List.Next (Iter);
            end loop;
         end;
      end loop;
      return null;
   end Get_Driver;

end ADO.Drivers.Connections;

Fix some compilation warnings

Fix some compilation warnings


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

with MAT.Memory.Readers;
package body MAT.Memory.Targets is

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

   --  ------------------------------
   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   --  ------------------------------
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class) is
      Memory_Reader : constant MAT.Memory.Readers.Memory_Reader_Access
        := new MAT.Memory.Readers.Memory_Servant;
   begin
      Memory.Reader := Memory_Reader.all'Access;
      Memory_Reader.Data := Memory'Unrestricted_Access;
      Memory.Frames := Frames.Create_Root;
      MAT.Memory.Readers.Register (Reader, Memory_Reader);
   end Initialize;

   --  ------------------------------
   --  Collect the information about memory slot sizes allocated by the application.
   --  ------------------------------
   procedure Size_Information (Memory : in Target_Memory;
                               Sizes  : in out Size_Info_Map) is
      Iter : Allocation_Cursor := Memory.Memory_Slots.First;

      procedure Update_Count (Size : in MAT.Types.Target_Size;
                              Info : in out Size_Info_Type) is
      begin
         Info.Count := Info.Count + 1;
      end Update_Count;

      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation) is
         Pos : Size_Info_Cursor := Sizes.Find (Slot.Size);
      begin
         if Size_Info_Maps.Has_Element (Pos) then
            Sizes.Update_Element (Pos, Update_Count'Access);
         else
            declare
               Info : Size_Info_Type;
            begin
               Info.Count := 1;
               Sizes.Insert (Slot.Size, Info);
            end;
         end if;
      end Collect;

   begin
      while Allocation_Maps.Has_Element (Iter) loop
         Allocation_Maps.Query_Element (Iter, Collect'Access);
         Allocation_Maps.Next (Iter);
      end loop;
   end Size_Information;

   protected body Memory_Allocator is

      --  ------------------------------
      --  Remove the memory region [Addr .. Addr + Size] from the free list.
      --  ------------------------------
      procedure Remove_Free (Addr : in MAT.Types.Target_Addr;
                             Size : in MAT.Types.Target_Size) is
         Iter : Allocation_Cursor;
         Last : constant MAT.Types.Target_Addr := Addr + MAT.Types.Target_Addr (Size);
         Slot : Allocation;
      begin
         --  Walk the list of free blocks and remove all the blocks which intersect the region
         --  [Addr .. Addr + Slot.Size].  We start walking at the first block below and near
         --  the address.  Slots are then removed when they intersect the malloc'ed region.
         Iter := Freed_Slots.Floor (Addr);
         while Allocation_Maps.Has_Element (Iter) loop
            declare
               Freed_Addr : constant MAT.Types.Target_Addr := Allocation_Maps.Key (Iter);
            begin
               exit when Freed_Addr > Last;
               Slot := Allocation_Maps.Element (Iter);
               if Freed_Addr + MAT.Types.Target_Addr (Slot.Size) > Addr then
                  Freed_Slots.Delete (Iter);
                  Iter := Freed_Slots.Floor (Addr);
               else
                  Allocation_Maps.Next (Iter);
               end if;
            end;
         end loop;
      end Remove_Free;

      --  ------------------------------
      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      --  ------------------------------
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation) is
      begin
         Remove_Free (Addr, Slot.Size);
         Used_Slots.Insert (Addr, Slot);
      end Probe_Malloc;

      --  ------------------------------
      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      --  ------------------------------
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation) is
         Item : Allocation;
         Iter : Allocation_Cursor;
      begin
         Iter := Used_Slots.Find (Addr);
         if Allocation_Maps.Has_Element (Iter) then
            Item := Allocation_Maps.Element (Iter);
            MAT.Frames.Release (Item.Frame);
            Used_Slots.Delete (Iter);
            Item.Frame := Slot.Frame;
            Freed_Slots.Insert (Addr, Item);
         end if;
      end Probe_Free;

      --  ------------------------------
      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      --  ------------------------------
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation) is
         Old_Slot : Allocation;
         Pos      : Allocation_Cursor;

         procedure Update_Size (Key : in MAT.Types.Target_Addr;
                                Element : in out Allocation) is
         begin
            Element.Size := Slot.Size;
            MAT.Frames.Release (Element.Frame);
            Element.Frame := Slot.Frame;
         end Update_Size;

      begin
         if Old_Addr /= 0 then
            Pos := Used_Slots.Find (Old_Addr);
            if Allocation_Maps.Has_Element (Pos) then
               if Addr = Old_Addr then
                  Used_Slots.Update_Element (Pos, Update_Size'Access);
               else
                  Used_Slots.Delete (Pos);
                  Used_Slots.Insert (Addr, Slot);
               end if;
            else
               Used_Slots.Insert (Addr, Slot);
            end if;
         else
            Used_Slots.Insert (Addr, Slot);
         end if;
         Remove_Free (Addr, Slot.Size);
      end Probe_Realloc;

   end Memory_Allocator;

end MAT.Memory.Targets;

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

with MAT.Memory.Readers;
package body MAT.Memory.Targets is

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

   --  ------------------------------
   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   --  ------------------------------
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class) is
      Memory_Reader : constant MAT.Memory.Readers.Memory_Reader_Access
        := new MAT.Memory.Readers.Memory_Servant;
   begin
      Memory.Reader := Memory_Reader.all'Access;
      Memory_Reader.Data := Memory'Unrestricted_Access;
      Memory.Frames := Frames.Create_Root;
      MAT.Memory.Readers.Register (Reader, Memory_Reader);
   end Initialize;

   --  ------------------------------
   --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
   --  in the used slots map.  The freed slots that intersect the malloc'ed region are
   --  removed from the freed map.
   --  ------------------------------
   procedure Probe_Malloc (Memory : in out Target_Memory;
                           Addr   : in MAT.Types.Target_Addr;
                           Slot   : in Allocation) is
   begin
      Memory.Memory.Probe_Malloc (Addr, Slot);
   end Probe_Malloc;

   --  ------------------------------
   --  Collect the information about memory slot sizes allocated by the application.
   --  ------------------------------
   procedure Size_Information (Memory : in Target_Memory;
                               Sizes  : in out Size_Info_Map) is
      Iter : Allocation_Cursor := Memory.Memory_Slots.First;

      procedure Update_Count (Size : in MAT.Types.Target_Size;
                              Info : in out Size_Info_Type) is
      begin
         Info.Count := Info.Count + 1;
      end Update_Count;

      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation) is
         Pos : Size_Info_Cursor := Sizes.Find (Slot.Size);
      begin
         if Size_Info_Maps.Has_Element (Pos) then
            Sizes.Update_Element (Pos, Update_Count'Access);
         else
            declare
               Info : Size_Info_Type;
            begin
               Info.Count := 1;
               Sizes.Insert (Slot.Size, Info);
            end;
         end if;
      end Collect;

   begin
      while Allocation_Maps.Has_Element (Iter) loop
         Allocation_Maps.Query_Element (Iter, Collect'Access);
         Allocation_Maps.Next (Iter);
      end loop;
   end Size_Information;

   protected body Memory_Allocator is

      --  ------------------------------
      --  Remove the memory region [Addr .. Addr + Size] from the free list.
      --  ------------------------------
      procedure Remove_Free (Addr : in MAT.Types.Target_Addr;
                             Size : in MAT.Types.Target_Size) is
         Iter : Allocation_Cursor;
         Last : constant MAT.Types.Target_Addr := Addr + MAT.Types.Target_Addr (Size);
         Slot : Allocation;
      begin
         --  Walk the list of free blocks and remove all the blocks which intersect the region
         --  [Addr .. Addr + Slot.Size].  We start walking at the first block below and near
         --  the address.  Slots are then removed when they intersect the malloc'ed region.
         Iter := Freed_Slots.Floor (Addr);
         while Allocation_Maps.Has_Element (Iter) loop
            declare
               Freed_Addr : constant MAT.Types.Target_Addr := Allocation_Maps.Key (Iter);
            begin
               exit when Freed_Addr > Last;
               Slot := Allocation_Maps.Element (Iter);
               if Freed_Addr + MAT.Types.Target_Addr (Slot.Size) > Addr then
                  Freed_Slots.Delete (Iter);
                  Iter := Freed_Slots.Floor (Addr);
               else
                  Allocation_Maps.Next (Iter);
               end if;
            end;
         end loop;
      end Remove_Free;

      --  ------------------------------
      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      --  ------------------------------
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation) is
      begin
         Remove_Free (Addr, Slot.Size);
         Used_Slots.Insert (Addr, Slot);
      end Probe_Malloc;

      --  ------------------------------
      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      --  ------------------------------
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation) is
         Item : Allocation;
         Iter : Allocation_Cursor;
      begin
         Iter := Used_Slots.Find (Addr);
         if Allocation_Maps.Has_Element (Iter) then
            Item := Allocation_Maps.Element (Iter);
            MAT.Frames.Release (Item.Frame);
            Used_Slots.Delete (Iter);
            Item.Frame := Slot.Frame;
            Freed_Slots.Insert (Addr, Item);
         end if;
      end Probe_Free;

      --  ------------------------------
      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      --  ------------------------------
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation) is
         Old_Slot : Allocation;
         Pos      : Allocation_Cursor;

         procedure Update_Size (Key : in MAT.Types.Target_Addr;
                                Element : in out Allocation) is
         begin
            Element.Size := Slot.Size;
            MAT.Frames.Release (Element.Frame);
            Element.Frame := Slot.Frame;
         end Update_Size;

      begin
         if Old_Addr /= 0 then
            Pos := Used_Slots.Find (Old_Addr);
            if Allocation_Maps.Has_Element (Pos) then
               if Addr = Old_Addr then
                  Used_Slots.Update_Element (Pos, Update_Size'Access);
               else
                  Used_Slots.Delete (Pos);
                  Used_Slots.Insert (Addr, Slot);
               end if;
            else
               Used_Slots.Insert (Addr, Slot);
            end if;
         else
            Used_Slots.Insert (Addr, Slot);
         end if;
         Remove_Free (Addr, Slot.Size);
      end Probe_Realloc;

   end Memory_Allocator;

end MAT.Memory.Targets;

Implement the Probe_Malloc operation

Implement the Probe_Malloc operation


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

with Sax.Readers;
with Ada.Text_IO;

with Ada.Strings.Unbounded;
with Ada.Exceptions;
with Ada.Directories;
with Ada.Command_Line;

with Util.Log.Loggers;
with Gen.Generator;
with Gen.Commands;
procedure Dynamo is
   use Ada;
   use Ada.Strings.Unbounded;
   use Ada.Directories;
   use Ada.Command_Line;
   use Gen.Commands;

   procedure Set_Config_Directory (Path   : in String;
                                   Silent : in Boolean := False);

   Out_Dir      : Unbounded_String;
   Config_Dir   : Unbounded_String;
   Template_Dir : Unbounded_String;
   Status       : Exit_Status := Success;

   --  ------------------------------
   --  Verify and set the configuration path
   --  ------------------------------
   procedure Set_Config_Directory (Path   : in String;
                                   Silent : in Boolean := False) is
      Log_Path : constant String := Ada.Directories.Compose (Path, "log4j.properties");
   begin
      --  Ignore if the config directory was already set.
      if Length (Config_Dir) > 0 then
         return;
      end if;

      --  Check that we can read some configuration file.
      if not Ada.Directories.Exists (Log_Path) then
         if not Silent then
            Ada.Text_IO.Put_Line ("Invalid config directory: " & Path);
            Status := Failure;
         end if;
         return;
      end if;

      --  Configure the logs
      Util.Log.Loggers.Initialize (Log_Path);
      Config_Dir := To_Unbounded_String (Path);
   end Set_Config_Directory;

begin
   --  Parse the command line
   loop
      case Getopt ("o: t: c:") is
         when ASCII.NUL => exit;

         when 'o' =>
            Out_Dir := To_Unbounded_String (Parameter & "/");

         when 't' =>
            Template_Dir := To_Unbounded_String (Parameter & "/");

         when 'c' =>
            Set_Config_Directory (Parameter);

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

   if Length (Config_Dir) = 0 then
      declare
         Name : constant String := Ada.Command_Line.Command_Name;
         Path : constant String := Ada.Directories.Containing_Directory (Name);
      begin
         Set_Config_Directory (Compose (Containing_Directory (Path), "config"), True);
         Set_Config_Directory (Gen.CONFIG_DIR, True);
      end;
   end if;
   if Status /= Success then
      Ada.Command_Line.Set_Exit_Status (Status);
      return;
   end if;

   declare
      Cmd_Name  : constant String := Get_Argument;
      Cmd       : constant Gen.Commands.Command_Access := Gen.Commands.Find_Command (Cmd_Name);
      Generator : Gen.Generator.Handler;
   begin
      --  Check that the command exists.
      if Cmd = null then
         if Cmd_Name'Length > 0 then
            Ada.Text_IO.Put_Line ("Invalid command: '" & Cmd_Name & "'");
         else
            Ada.Text_IO.Put_Line (Gen.RELEASE);
            Ada.Text_IO.Put ("Type '");
            Ada.Text_IO.Put (Ada.Command_Line.Command_Name);
            Ada.Text_IO.Put_Line (" help' for usage.");
         end if;
         Set_Exit_Status (Failure);
         return;
      end if;
      if Length (Out_Dir) > 0 then
         Gen.Generator.Set_Result_Directory (Generator, Out_Dir);
      end if;
      if Length (Template_Dir) > 0 then
         Gen.Generator.Set_Template_Directory (Generator, Template_Dir);
      end if;

      Gen.Generator.Initialize (Generator, Config_Dir);

      Cmd.Execute (Generator);

      Ada.Command_Line.Set_Exit_Status (Gen.Generator.Get_Status (Generator));
   end;

exception
   when Invalid_Switch =>
      Ada.Text_IO.Put_Line ("Invalid option.");
      Ada.Text_IO.Put_Line ("Use the 'help' command.");
      Ada.Command_Line.Set_Exit_Status (2);

   when E : Gen.Generator.Fatal_Error =>
      Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Message (E));
      Ada.Command_Line.Set_Exit_Status (1);

   when E : Sax.Readers.XML_Fatal_Error =>
      Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Message (E));
      Ada.Command_Line.Set_Exit_Status (1);

   when E : others =>
      Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Message (E));
      Ada.Text_IO.Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
      Ada.Command_Line.Set_Exit_Status (1);

end Dynamo;

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

with Sax.Readers;
with Ada.Text_IO;

with Ada.Strings.Unbounded;
with Ada.Exceptions;
with Ada.Directories;
with Ada.Command_Line;

with Util.Files;
with Util.Log.Loggers;
with Gen.Generator;
with Gen.Commands;
procedure Dynamo is
   use Ada;
   use Ada.Strings.Unbounded;
   use Ada.Directories;
   use Ada.Command_Line;
   use Gen.Commands;

   procedure Set_Config_Directory (Path   : in String;
                                   Silent : in Boolean := False);

   Out_Dir      : Unbounded_String;
   Config_Dir   : Unbounded_String;
   Template_Dir : Unbounded_String;
   Status       : Exit_Status := Success;

   --  ------------------------------
   --  Verify and set the configuration path
   --  ------------------------------
   procedure Set_Config_Directory (Path   : in String;
                                   Silent : in Boolean := False) is
      Log_Path : constant String := Ada.Directories.Compose (Path, "log4j.properties");
   begin
      --  Ignore if the config directory was already set.
      if Length (Config_Dir) > 0 then
         return;
      end if;

      --  Check that we can read some configuration file.
      if not Ada.Directories.Exists (Log_Path) then
         if not Silent then
            Ada.Text_IO.Put_Line ("Invalid config directory: " & Path);
            Status := Failure;
         end if;
         return;
      end if;

      --  Configure the logs
      Util.Log.Loggers.Initialize (Log_Path);
      Config_Dir := To_Unbounded_String (Path);
   end Set_Config_Directory;

begin
   --  Parse the command line
   loop
      case Getopt ("o: t: c:") is
         when ASCII.NUL => exit;

         when 'o' =>
            Out_Dir := To_Unbounded_String (Parameter & "/");

         when 't' =>
            Template_Dir := To_Unbounded_String (Parameter & "/");

         when 'c' =>
            Set_Config_Directory (Parameter);

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

   if Length (Config_Dir) = 0 then
      declare
         Name : constant String := Ada.Command_Line.Command_Name;
         Path : constant String := Ada.Directories.Containing_Directory (Name);
         Dir  : constant String := Containing_Directory (Path);
      begin
         Set_Config_Directory (Compose (Dir, "config"), True);
         Set_Config_Directory (Util.Files.Compose (Dir, "share/dynamo/base"), True);
         Set_Config_Directory (Gen.CONFIG_DIR, True);
      end;
   end if;
   if Status /= Success then
      Ada.Command_Line.Set_Exit_Status (Status);
      return;
   end if;

   declare
      Cmd_Name  : constant String := Get_Argument;
      Cmd       : constant Gen.Commands.Command_Access := Gen.Commands.Find_Command (Cmd_Name);
      Generator : Gen.Generator.Handler;
   begin
      --  Check that the command exists.
      if Cmd = null then
         if Cmd_Name'Length > 0 then
            Ada.Text_IO.Put_Line ("Invalid command: '" & Cmd_Name & "'");
         else
            Ada.Text_IO.Put_Line (Gen.RELEASE);
            Ada.Text_IO.Put ("Type '");
            Ada.Text_IO.Put (Ada.Command_Line.Command_Name);
            Ada.Text_IO.Put_Line (" help' for usage.");
         end if;
         Set_Exit_Status (Failure);
         return;
      end if;
      if Length (Out_Dir) > 0 then
         Gen.Generator.Set_Result_Directory (Generator, Out_Dir);
      end if;
      if Length (Template_Dir) > 0 then
         Gen.Generator.Set_Template_Directory (Generator, Template_Dir);
      end if;

      Gen.Generator.Initialize (Generator, Config_Dir);

      Cmd.Execute (Generator);

      Ada.Command_Line.Set_Exit_Status (Gen.Generator.Get_Status (Generator));
   end;

exception
   when Invalid_Switch =>
      Ada.Text_IO.Put_Line ("Invalid option.");
      Ada.Text_IO.Put_Line ("Use the 'help' command.");
      Ada.Command_Line.Set_Exit_Status (2);

   when E : Gen.Generator.Fatal_Error =>
      Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Message (E));
      Ada.Command_Line.Set_Exit_Status (1);

   when E : Sax.Readers.XML_Fatal_Error =>
      Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Message (E));
      Ada.Command_Line.Set_Exit_Status (1);

   when E : others =>
      Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Message (E));
      Ada.Text_IO.Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
      Ada.Command_Line.Set_Exit_Status (1);

end Dynamo;

Fix config directory search path - look for the dynamo configuration files in ../share/dynamo/base (relative to the dynamo executable path)


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

with Util.Files;
with Util.Log.Loggers;
with Util.Encoders;
with Util.Encoders.Base64;
package body AWA.Storages.Stores.Files is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Storages.Stores.Files");

   --  ------------------------------
   --  Create a file storage service and use the <tt>Root</tt> directory to store the files.
   --  ------------------------------
   function Create_File_Store (Root : in String) return Store_Access is
      Result : constant File_Store_Access := new File_Store '(Len => Root'Length,
                                                              Root => Root);
   begin
      return Result.all'Access;
   end Create_File_Store;

   --  ------------------------------
   --  Build a path where the file store represented by <tt>Store</tt> is saved.
   --  ------------------------------
   function Get_Path (Storage : in File_Store;
                      Store   : in AWA.Storages.Models.Storage_Ref'Class) return String is
   begin
      return Storage.Get_Path (Store.Get_Workspace.Get_Id, Store.Get_Id);
   end Get_Path;

   --  ------------------------------
   --  Build a path where the file store represented by <tt>Store</tt> is saved.
   --  ------------------------------
   function Get_Path (Storage      : in File_Store;
                      Workspace_Id : in ADO.Identifier;
                      File_Id      : in ADO.Identifier) return String is
      use Interfaces;
      use type Ada.Streams.Stream_Element_Offset;

      T      : Util.Encoders.Base64.Encoder;
      Buffer : Ada.Streams.Stream_Element_Array (1 .. 10);
      R      : Ada.Streams.Stream_Element_Array (1 .. 32);
      Last   : Ada.Streams.Stream_Element_Offset;
      Encoded : Ada.Streams.Stream_Element_Offset;
      Pos  : Positive := 1;
      Res : String (1 .. 16 + 5);
   begin
      Util.Encoders.Encode_LEB128 (Buffer, Buffer'First, Unsigned_64 (Workspace_Id), Last);
      Util.Encoders.Encode_LEB128 (Buffer, Last, Unsigned_64 (File_Id), Last);

      T.Transform (Data    => Buffer (1 .. Last),
                   Into    => R, Last => Last,
                   Encoded => Encoded);

      for I in 1 .. Last loop
         Res (Pos) := Character'Val (R (I));
         Pos := Pos + 1;
         if (I mod 2) = 0 and I /= Last then
            Res (Pos) := '/';
            Pos := Pos + 1;
         end if;
      end loop;
      return Util.Files.Compose (Storage.Root, Res (1 .. Pos - 1));
   end Get_Path;

   --  ------------------------------
   --  Save the file represented by the `Path` variable into a store and associate that
   --  content with the storage reference represented by `Into`.
   --  ------------------------------
   procedure Save (Storage : in File_Store;
                   Session : in out ADO.Sessions.Master_Session;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String) is
      pragma Unreferenced (Session);

      Store : constant String := Storage.Get_Path (Into);
      Dir   : constant String := Ada.Directories.Containing_Directory (Store);
   begin
      Log.Info ("Storage save {0} to {1}", Path, Store);
      Ada.Directories.Create_Path (Dir);
      Ada.Directories.Copy_File (Source_Name => Path,
                                 Target_Name => Store,
                                 Form        => "all");
   end Save;

   procedure Load (Storage : in File_Store;
                   Session : in out ADO.Sessions.Session'Class;
                   From    : in AWA.Storages.Models.Storage_Ref'Class;
                   Into    : in out Storage_File) is
      pragma Unreferenced (Session);

      Store : constant String := Storage.Get_Path (From);
   begin
      Into.Path := Ada.Strings.Unbounded.To_Unbounded_String (Store);
   end Load;

   --  ------------------------------
   --  Create a storage
   --  ------------------------------
   procedure Create (Storage : in File_Store;
                     Session : in out ADO.Sessions.Master_Session;
                     From    : in AWA.Storages.Models.Storage_Ref'Class;
                     Into    : in out AWA.Storages.Storage_File) is
      pragma Unreferenced (Storage);

      Store : constant String := Storage.Get_Path (From);
      Dir   : constant String := Ada.Directories.Containing_Directory (Store);
   begin
      Log.Info ("Storage create {0}", Store);
      Ada.Directories.Create_Path (Dir);
      Into.Path := Ada.Strings.Unbounded.To_Unbounded_String (Store);
   end Create;

   --  ------------------------------
   --  Delete the content associate with the storage represented by `From`.
   --  ------------------------------
   procedure Delete (Storage : in File_Store;
                     Session : in out ADO.Sessions.Master_Session;
                     From    : in out AWA.Storages.Models.Storage_Ref'Class) is
      pragma Unreferenced (Session);

      Store : constant String := Storage.Get_Path (From);
   begin
      if Ada.Directories.Exists (Store) then
         Log.Info ("Storage delete {0}", Store);
         Ada.Directories.Delete_File (Store);
      end if;
   end Delete;

end AWA.Storages.Stores.Files;

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

with Util.Files;
with Util.Log.Loggers;
with Util.Encoders;
with Util.Encoders.Base64;
package body AWA.Storages.Stores.Files is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Storages.Stores.Files");

   --  ------------------------------
   --  Create a file storage service and use the <tt>Root</tt> directory to store the files.
   --  ------------------------------
   function Create_File_Store (Root : in String) return Store_Access is
      Result : constant File_Store_Access := new File_Store '(Len => Root'Length,
                                                              Root => Root);
   begin
      return Result.all'Access;
   end Create_File_Store;

   --  ------------------------------
   --  Build a path where the file store represented by <tt>Store</tt> is saved.
   --  ------------------------------
   function Get_Path (Storage : in File_Store;
                      Store   : in AWA.Storages.Models.Storage_Ref'Class) return String is
   begin
      return Storage.Get_Path (Store.Get_Workspace.Get_Id, Store.Get_Id);
   end Get_Path;

   --  ------------------------------
   --  Build a path where the file store represented by <tt>Store</tt> is saved.
   --  ------------------------------
   function Get_Path (Storage      : in File_Store;
                      Workspace_Id : in ADO.Identifier;
                      File_Id      : in ADO.Identifier) return String is
      use Interfaces;
      use type Ada.Streams.Stream_Element_Offset;

      T      : Util.Encoders.Base64.Encoder;
      Buffer : Ada.Streams.Stream_Element_Array (1 .. 10);
      R      : Ada.Streams.Stream_Element_Array (1 .. 32);
      Last   : Ada.Streams.Stream_Element_Offset;
      Encoded : Ada.Streams.Stream_Element_Offset;
      Pos  : Positive := 1;
      Res : String (1 .. 16 + 5);
   begin
      Util.Encoders.Encode_LEB128 (Buffer, Buffer'First, Unsigned_64 (Workspace_Id), Last);
      Util.Encoders.Encode_LEB128 (Buffer, Last, Unsigned_64 (File_Id), Last);

      T.Transform (Data    => Buffer (1 .. Last),
                   Into    => R, Last => Last,
                   Encoded => Encoded);

      for I in 1 .. Last loop
         Res (Pos) := Character'Val (R (I));
         Pos := Pos + 1;
         if (I mod 2) = 0 and I /= Last then
            Res (Pos) := '/';
            Pos := Pos + 1;
         end if;
      end loop;
      return Util.Files.Compose (Storage.Root, Res (1 .. Pos - 1));
   end Get_Path;

   --  ------------------------------
   --  Save the file represented by the `Path` variable into a store and associate that
   --  content with the storage reference represented by `Into`.
   --  ------------------------------
   procedure Save (Storage : in File_Store;
                   Session : in out ADO.Sessions.Master_Session;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String) is
      pragma Unreferenced (Session);

      Store : constant String := Storage.Get_Path (Into);
      Dir   : constant String := Ada.Directories.Containing_Directory (Store);
   begin
      Log.Info ("Storage save {0} to {1}", Path, Store);
      Ada.Directories.Create_Path (Dir);
      Ada.Directories.Copy_File (Source_Name => Path,
                                 Target_Name => Store,
                                 Form        => "all");
   end Save;

   procedure Load (Storage : in File_Store;
                   Session : in out ADO.Sessions.Session'Class;
                   From    : in AWA.Storages.Models.Storage_Ref'Class;
                   Into    : in out Storage_File) is
      pragma Unreferenced (Session);

      Store : constant String := Storage.Get_Path (From);
   begin
      Into.Path := Ada.Strings.Unbounded.To_Unbounded_String (Store);
   end Load;

   --  ------------------------------
   --  Create a storage
   --  ------------------------------
   procedure Create (Storage : in File_Store;
                     Session : in out ADO.Sessions.Master_Session;
                     From    : in AWA.Storages.Models.Storage_Ref'Class;
                     Into    : in out AWA.Storages.Storage_File) is
      pragma Unreferenced (Session);

      Store : constant String := Storage.Get_Path (From);
      Dir   : constant String := Ada.Directories.Containing_Directory (Store);
   begin
      Log.Info ("Storage create {0}", Store);
      Ada.Directories.Create_Path (Dir);
      Into.Path := Ada.Strings.Unbounded.To_Unbounded_String (Store);
   end Create;

   --  ------------------------------
   --  Delete the content associate with the storage represented by `From`.
   --  ------------------------------
   procedure Delete (Storage : in File_Store;
                     Session : in out ADO.Sessions.Master_Session;
                     From    : in out AWA.Storages.Models.Storage_Ref'Class) is
      pragma Unreferenced (Session);

      Store : constant String := Storage.Get_Path (From);
   begin
      if Ada.Directories.Exists (Store) then
         Log.Info ("Storage delete {0}", Store);
         Ada.Directories.Delete_File (Store);
      end if;
   end Delete;

end AWA.Storages.Stores.Files;

Fix compilation warning

Fix compilation warning


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

with Ada.Strings.Hash;
with Ada.Strings.Wide_Wide_Hash;
with Ada.Unchecked_Conversion;
with Interfaces;
with Util.Beans.Basic;
function Util.Beans.Objects.Hash (Key : in Object) return Ada.Containers.Hash_Type is
   use Ada.Containers;
   use Ada.Strings;
   use Interfaces;
   use Util.Beans.Basic;

   type Unsigned_32_Array is array (Natural range <>) of Unsigned_32;

   subtype U32_For_Float is Unsigned_32_Array (1 .. Long_Long_Float'Size / 32);

   subtype U32_For_Duration is Unsigned_32_Array (1 .. Duration'Size / 32);

   subtype U32_For_Long is Unsigned_32_Array (1 .. Long_Long_Integer'Size / 32);

   subtype U32_For_Access is Unsigned_32_Array (1 .. Readonly_Bean_Access'Size / 32);

   --  Hash the integer and floats using 32-bit values.
   function To_U32_For_Long is new Ada.Unchecked_Conversion (Source => Long_Long_Integer,
                                                             Target => U32_For_Long);

   --  Likewise for floats.
   function To_U32_For_Float is new Ada.Unchecked_Conversion (Source => Long_Long_Float,
                                                              Target => U32_For_Float);

   --  Likewise for duration.
   function To_U32_For_Duration is new Ada.Unchecked_Conversion (Source => Duration,
                                                                 Target => U32_For_Duration);

   --  Likewise for the bean pointer
   function To_U32_For_Access is new Ada.Unchecked_Conversion (Source => Readonly_Bean_Access,
                                                               Target => U32_For_Access);

begin
   case Key.V.Of_Type is
      when TYPE_NULL =>
         return 0;

      when TYPE_BOOLEAN =>
         if Key.V.Bool_Value then
            return 1;
         else
            return 2;
         end if;

      when TYPE_INTEGER =>
         declare
            U32 : constant U32_For_Long :=  To_U32_For_Long (Key.V.Int_Value);
            Val : Unsigned_32 := U32 (U32'First);
         begin
            for I in U32'First + 1 .. U32'Last loop
               Val := Val xor U32 (I);
            end loop;
            return Hash_Type (Val);
         end;

      when TYPE_FLOAT =>
         declare
            U32 : constant U32_For_Float :=  To_U32_For_Float (Key.V.Float_Value);
            Val : Unsigned_32 := U32 (U32'First);
         begin
            for I in U32'First + 1 .. U32'Last loop
               Val := Val xor U32 (I);
            end loop;
            return Hash_Type (Val);
         end;

      when TYPE_STRING =>
         if Key.V.String_Proxy = null then
            return 0;
         else
            return Hash (Key.V.String_Proxy.Value);
         end if;

      when TYPE_TIME =>
         declare
            U32 : constant U32_For_Duration :=  To_U32_For_Duration (Key.V.Time_Value);
            Val : Unsigned_32 := U32 (U32'First);
         begin
            for I in U32'First + 1 .. U32'Last loop
               Val := Val xor U32 (I);
            end loop;
            return Hash_Type (Val);
         end;

      when TYPE_WIDE_STRING =>
         if Key.V.Wide_Proxy = null then
            return 0;
         else
            return Wide_Wide_Hash (Key.V.Wide_Proxy.Value);
         end if;

      when TYPE_BEAN =>
         if Key.V.Proxy = null or else Bean_Proxy (Key.V.Proxy.all).Bean = null then
            return 0;
         end if;
         declare
            U32 : constant U32_For_Access
              :=  To_U32_For_Access (Bean_Proxy (Key.V.Proxy.all).Bean.all'Access);
            Val : Unsigned_32 := U32 (U32'First);

            --  The loop is not executed if pointers are 32-bit wide.
            pragma Warnings (Off);
         begin
            for I in U32'First + 1 .. U32'Last loop
               Val := Val xor U32 (I);
            end loop;
            return Hash_Type (Val);
         end;

   end case;
end Util.Beans.Objects.Hash;

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

with Ada.Strings.Hash;
with Ada.Strings.Wide_Wide_Hash;
with Ada.Unchecked_Conversion;
with Interfaces;
with Util.Beans.Basic;
function Util.Beans.Objects.Hash (Key : in Object) return Ada.Containers.Hash_Type is
   use Ada.Containers;
   use Ada.Strings;
   use Interfaces;
   use Util.Beans.Basic;

   type Unsigned_32_Array is array (Natural range <>) of Unsigned_32;

   subtype U32_For_Float is Unsigned_32_Array (1 .. Long_Long_Float'Size / 32);

   subtype U32_For_Duration is Unsigned_32_Array (1 .. Duration'Size / 32);

   subtype U32_For_Long is Unsigned_32_Array (1 .. Long_Long_Integer'Size / 32);

   subtype U32_For_Access is Unsigned_32_Array (1 .. Readonly_Bean_Access'Size / 32);

   --  Hash the integer and floats using 32-bit values.
   function To_U32_For_Long is new Ada.Unchecked_Conversion (Source => Long_Long_Integer,
                                                             Target => U32_For_Long);

   --  Likewise for floats.
   function To_U32_For_Float is new Ada.Unchecked_Conversion (Source => Long_Long_Float,
                                                              Target => U32_For_Float);

   --  Likewise for duration.
   function To_U32_For_Duration is new Ada.Unchecked_Conversion (Source => Duration,
                                                                 Target => U32_For_Duration);

   --  Likewise for the bean pointer
   function To_U32_For_Access is new Ada.Unchecked_Conversion (Source => Readonly_Bean_Access,
                                                               Target => U32_For_Access);

begin
   case Key.V.Of_Type is
      when TYPE_NULL =>
         return 0;

      when TYPE_BOOLEAN =>
         if Key.V.Bool_Value then
            return 1;
         else
            return 2;
         end if;

      when TYPE_INTEGER =>
         declare
            U32 : constant U32_For_Long :=  To_U32_For_Long (Key.V.Int_Value);
            Val : Unsigned_32 := U32 (U32'First);
         begin
            for I in U32'First + 1 .. U32'Last loop
               Val := Val xor U32 (I);
            end loop;
            return Hash_Type (Val);
         end;

      when TYPE_FLOAT =>
         declare
            U32 : constant U32_For_Float :=  To_U32_For_Float (Key.V.Float_Value);
            Val : Unsigned_32 := U32 (U32'First);
         begin
            for I in U32'First + 1 .. U32'Last loop
               Val := Val xor U32 (I);
            end loop;
            return Hash_Type (Val);
         end;

      when TYPE_STRING =>
         if Key.V.String_Proxy = null then
            return 0;
         else
            return Hash (Key.V.String_Proxy.Value);
         end if;

      when TYPE_TIME =>
         declare
            U32 : constant U32_For_Duration :=  To_U32_For_Duration (Key.V.Time_Value);
            Val : Unsigned_32 := U32 (U32'First);
         begin
            for I in U32'First + 1 .. U32'Last loop
               Val := Val xor U32 (I);
            end loop;
            return Hash_Type (Val);
         end;

      when TYPE_WIDE_STRING =>
         if Key.V.Wide_Proxy = null then
            return 0;
         else
            return Wide_Wide_Hash (Key.V.Wide_Proxy.Value);
         end if;

      when TYPE_BEAN =>
         if Key.V.Proxy = null or else Bean_Proxy (Key.V.Proxy.all).Bean = null then
            return 0;
         end if;
         declare
            U32 : constant U32_For_Access
              :=  To_U32_For_Access (Bean_Proxy (Key.V.Proxy.all).Bean.all'Access);
            Val : Unsigned_32 := U32 (U32'First);

            --  The loop is not executed if pointers are 32-bit wide.
            pragma Warnings (Off);
         begin
            for I in U32'First + 1 .. U32'Last loop
               Val := Val xor U32 (I);
            end loop;
            return Hash_Type (Val);
         end;

      when TYPE_ARRAY =>
         declare
            Result : Unsigned_32 := 0;
         begin
            for Object of Key.V.Array_Proxy.Values loop
               Result := Result xor Unsigned_32 (Hash (Object));
            end loop;
            return Hash_Type (Result);
         end;

   end case;
end Util.Beans.Objects.Hash;

Update the Hash function to compute the hash for the array type