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

with MAT.Expressions;
with MAT.Events.Targets;
package MAT.Events.Timelines is

   --  Describe a section of the timeline.  The section has a starting and ending
   --  event that marks the boundary of the section within the collected events.
   --  The timeline section gives the duration and some statistics about memory
   --  allocation made in the section.
   type Timeline_Info is record
      Start_Id       : MAT.Events.Targets.Event_Id_Type := 0;
      Start_Time     : MAT.Types.Target_Tick_Ref := 0;
      End_Id         : MAT.Events.Targets.Event_Id_Type := 0;
      End_Time       : MAT.Types.Target_Tick_Ref := 0;
      Duration       : MAT.Types.Target_Time := 0;
      Malloc_Count   : Natural := 0;
      Realloc_Count  : Natural := 0;
      Free_Count     : Natural := 0;
   end record;

   package Timeline_Info_Vectors is
     new Ada.Containers.Vectors (Positive, Timeline_Info);

   subtype Timeline_Info_Vector is Timeline_Info_Vectors.Vector;
   subtype Timeline_Info_Cursor is Timeline_Info_Vectors.Cursor;

   procedure Extract (Target : in out MAT.Events.Targets.Target_Events;
                      Into   : in out Timeline_Info_Vector);

   --  Find in the events stream the events which are associated with a given event.
   --  When the <tt>Event</tt> is a memory allocation, find the associated reallocation
   --  and free events.  When the event is a free, find the associated allocations.
   --  Collect at most <tt>Max</tt> events.
   procedure Find_Related (Target : in out MAT.Events.Targets.Target_Events'Class;
                           Event  : in MAT.Events.Targets.Probe_Event_Type;
                           Max    : in Positive;
                           List   : in out MAT.Events.Targets.Target_Event_Vector);

   --  Find the sizes of malloc and realloc events which is selected by the given filter.
   --  Update the <tt>Sizes</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding size.
   procedure Find_Sizes (Target : in out MAT.Events.Targets.Target_Events'Class;
                         Filter : in MAT.Expressions.Expression_Type;
                         Sizes  : in out MAT.Events.Targets.Size_Event_Info_Map);

   --  Find the function address from the call event frames for the events which is selected
   --  by the given filter.  The function addresses are collected up to the given frame depth.
   --  Update the <tt>Frames</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding frame address.
   procedure Find_Frames (Target : in out MAT.Events.Targets.Target_Events'Class;
                          Filter : in MAT.Expressions.Expression_Type;
                          Depth  : in Natural;
                          Frames : in out MAT.Events.Targets.Frame_Event_Info_Map);

end MAT.Events.Timelines;

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

with MAT.Expressions;
with MAT.Events.Targets;
package MAT.Events.Timelines is

   --  Describe a section of the timeline.  The section has a starting and ending
   --  event that marks the boundary of the section within the collected events.
   --  The timeline section gives the duration and some statistics about memory
   --  allocation made in the section.
   type Timeline_Info is record
      First_Event    : MAT.Events.Targets.Probe_Event_Type;
      Last_Event     : MAT.Events.Targets.Probe_Event_Type;
      Duration       : MAT.Types.Target_Time := 0;
      Malloc_Count   : Natural := 0;
      Realloc_Count  : Natural := 0;
      Free_Count     : Natural := 0;
   end record;

   package Timeline_Info_Vectors is
     new Ada.Containers.Vectors (Positive, Timeline_Info);

   subtype Timeline_Info_Vector is Timeline_Info_Vectors.Vector;
   subtype Timeline_Info_Cursor is Timeline_Info_Vectors.Cursor;

   procedure Extract (Target : in out MAT.Events.Targets.Target_Events'Class;
                      Into   : in out Timeline_Info_Vector);

   --  Find in the events stream the events which are associated with a given event.
   --  When the <tt>Event</tt> is a memory allocation, find the associated reallocation
   --  and free events.  When the event is a free, find the associated allocations.
   --  Collect at most <tt>Max</tt> events.
   procedure Find_Related (Target : in out MAT.Events.Targets.Target_Events'Class;
                           Event  : in MAT.Events.Targets.Probe_Event_Type;
                           Max    : in Positive;
                           List   : in out MAT.Events.Targets.Target_Event_Vector);

   --  Find the sizes of malloc and realloc events which is selected by the given filter.
   --  Update the <tt>Sizes</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding size.
   procedure Find_Sizes (Target : in out MAT.Events.Targets.Target_Events'Class;
                         Filter : in MAT.Expressions.Expression_Type;
                         Sizes  : in out MAT.Events.Targets.Size_Event_Info_Map);

   --  Find the function address from the call event frames for the events which is selected
   --  by the given filter.  The function addresses are collected up to the given frame depth.
   --  Update the <tt>Frames</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding frame address.
   procedure Find_Frames (Target : in out MAT.Events.Targets.Target_Events'Class;
                          Filter : in MAT.Expressions.Expression_Type;
                          Depth  : in Natural;
                          Frames : in out MAT.Events.Targets.Frame_Event_Info_Map);

end MAT.Events.Timelines;

Store the first and last event in the Timeline_Info record


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

with Util.Test_Caller;
with Util.Strings.Transforms;

with ADO.Utils;
with ADO.Sessions;

with Regtests.Statements.Model;
package body ADO.Statements.Tests is

   use Util.Tests;

   procedure Populate (Tst : in out Test);
   function Get_Sum (T     : in Test;
                     Table : in String) return Natural;

   --  Test the query statement Get_Xxx operation for various types.
   generic
      type T (<>) is private;
      with function Get_Value (Stmt   : in ADO.Statements.Query_Statement;
                               Column : in Natural) return T is <>;
      Name   : String;
      Column : String;
   procedure Test_Query_Get_Value_T (Tst   : in out Test);

   procedure Populate (Tst : in out Test) is
      DB    : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
   begin
      DB.Begin_Transaction;
      for I in 1 .. 10 loop
         declare
            Item : Regtests.Statements.Model.Table_Ref;
         begin
            Item.Set_Id_Value (ADO.Identifier (I * I));
            Item.Set_Int_Value (I);
            Item.Set_Bool_Value ((I mod 2) = 0);
            Item.Set_String_Value ("Item" & Integer'Image (I));
            Item.Set_Time_Value (Ada.Calendar.Clock);
            Item.Set_Entity_Value (ADO.Entity_Type (10 - I));
            Item.Save (DB);
            Tst.Assert (Item.Is_Inserted, "Item inserted in database");
         end;
      end loop;
      DB.Commit;
   end Populate;

   --  ------------------------------
   --  Test the query statement Get_Xxx operation for various types.
   --  ------------------------------
   procedure Test_Query_Get_Value_T (Tst   : in out Test) is
      Stmt : ADO.Statements.Query_Statement;
      DB   : constant ADO.Sessions.Session := Regtests.Get_Database;
   begin
      Populate (Tst);

      --  Check that Get_Value raises an exception if the statement is invalid.
      begin
         declare
            V    : T := Get_Value (Stmt, 0);
            pragma Unreferenced (V);
         begin
            Util.Tests.Fail (Tst, "No Invalid_Statement exception raised for " & Name);
         end;

      exception
         when Invalid_Statement =>
            null;
      end;

      --  Execute a query to fetch one column.
      Stmt := DB.Create_Statement ("SELECT " & Column & " FROM test_table WHERE id = 1");
      Stmt.Execute;

      --  Verify the query result and the Get_Value operation.
      Tst.Assert (Stmt.Has_Elements, "The query statement must return a value for "
                  & Name & ":" & Column);
      Tst.Assert (not Stmt.Is_Null (0), "The query statement must return a non null value for "
                  & Name & ":" & Column);
      Util.Tests.Assert_Equals (Tst, Column,
                                Util.Strings.Transforms.To_Lower_Case (Stmt.Get_Column_Name (0)),
                                "The query returns an invalid column name");
      declare
         V : T := Get_Value (Stmt, 0);
         pragma Unreferenced (V);
      begin
         Stmt.Clear;
      end;

   end Test_Query_Get_Value_T;

   procedure Test_Query_Get_Int64 is
     new Test_Query_Get_Value_T (Int64, ADO.Statements.Get_Int64, "Get_Int64", "id_value");

   procedure Test_Query_Get_Integer is
     new Test_Query_Get_Value_T (Integer, ADO.Statements.Get_Integer, "Get_Integer", "int_value");

   procedure Test_Query_Get_Nullable_Integer is
     new Test_Query_Get_Value_T (Nullable_Integer, ADO.Statements.Get_Nullable_Integer,
                                 "Get_Nullable_Integer", "int_value");

   procedure Test_Query_Get_Nullable_Entity_Type is
     new Test_Query_Get_Value_T (Nullable_Entity_Type, ADO.Statements.Get_Nullable_Entity_Type,
                                 "Get_Nullable_Entity_Type", "entity_value");

   procedure Test_Query_Get_Natural is
     new Test_Query_Get_Value_T (Natural, ADO.Statements.Get_Natural, "Get_Natural", "int_value");

   procedure Test_Query_Get_Identifier is
     new Test_Query_Get_Value_T (ADO.Identifier, ADO.Statements.Get_Identifier,
                                 "Get_Identifier", "id_value");

   procedure Test_Query_Get_Boolean is
     new Test_Query_Get_Value_T (Boolean, ADO.Statements.Get_Boolean, "Get_Boolean", "bool_value");

   procedure Test_Query_Get_String is
     new Test_Query_Get_Value_T (String, ADO.Statements.Get_String, "Get_String", "string_value");

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Statements.Save",
                       Test_Save'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Int64",
                       Test_Query_Get_Int64'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Integer",
                       Test_Query_Get_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Nullable_Integer",
                       Test_Query_Get_Nullable_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Natural",
                       Test_Query_Get_Natural'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Identifier",
                       Test_Query_Get_Identifier'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Boolean",
                       Test_Query_Get_Boolean'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_String",
                       Test_Query_Get_String'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Nullable_Entity_Type",
                       Test_Query_Get_Nullable_Entity_Type'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Create_Statement (using $entity_type[])",
                       Test_Entity_Types'Access);
   end Add_Tests;

   function Get_Sum (T : in Test;
                     Table : in String) return Natural is
      DB   : constant ADO.Sessions.Session := Regtests.Get_Database;
      Stmt : ADO.Statements.Query_Statement := DB.Create_Statement ("SELECT SUM(id_value) FROM "
                                                                    & Table);
   begin
      Stmt.Execute;
      T.Assert (Stmt.Has_Elements, "The query statement must return a value for table " & Table);
      return Stmt.Get_Integer (0);
   end Get_Sum;

   function Get_Sum (T     : in Test;
                     Table : in String;
                     Ids   : in ADO.Utils.Identifier_Vector) return Natural is
      DB   : constant ADO.Sessions.Session := Regtests.Get_Database;
      Stmt : ADO.Statements.Query_Statement := DB.Create_Statement ("SELECT SUM(id_value) FROM "
                                                                    & Table
                                                                    & " WHERE id IN (:ids)");
   begin
      Stmt.Bind_Param ("ids", Ids);
      Stmt.Execute;
      T.Assert (Stmt.Has_Elements, "The query statement must return a value for table " & Table);
      return Stmt.Get_Integer (0);
   end Get_Sum;

   --  ------------------------------
   --  Test creation of several rows in test_table with different column type.
   --  ------------------------------
   procedure Test_Save (T : in out Test) is
      First  : constant Natural := Get_Sum (T, "test_table");
      DB     : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      List   : ADO.Utils.Identifier_Vector;
   begin
      DB.Begin_Transaction;
      for I in 1 .. 10 loop
         declare
            Item : Regtests.Statements.Model.Table_Ref;
         begin
            Item.Set_Id_Value (ADO.Identifier (I * I));
            Item.Set_Int_Value (I);
            Item.Set_Bool_Value ((I mod 2) = 0);
            Item.Set_String_Value ("Item" & Integer'Image (I));
            Item.Set_Time_Value (Ada.Calendar.Clock);
            Item.Set_Entity_Value (ADO.Entity_Type (10 - I));
            Item.Save (DB);
            List.Append (Item.Get_Id);
         end;
      end loop;
      DB.Commit;

      Util.Tests.Assert_Equals (T, First + 385, Get_Sum (T, "test_table"),
                                "The SUM query returns an invalid value for test_table");
      Util.Tests.Assert_Equals (T, 385, Get_Sum (T, "test_table", List),
                                "The SUM query returns an invalid value for test_table");
   end Test_Save;

   --  ------------------------------
   --  Test queries using the $entity_type[] cache group.
   --  ------------------------------
   procedure Test_Entity_Types (T : in out Test) is
      DB    : constant ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Stmt  : ADO.Statements.Query_Statement;
      Count : Natural := 0;
   begin
      Stmt := DB.Create_Statement ("SELECT name FROM entity_type "
                                   & "WHERE entity_type.id = $entity_type[test_user]");
      Stmt.Execute;
      while Stmt.Has_Elements loop
         Util.Tests.Assert_Equals (T, "test_user", Stmt.Get_String (0), "Invalid query response");
         Count := Count + 1;
         Stmt.Next;
      end loop;
      Util.Tests.Assert_Equals (T, 1, Count, "Query must return one row");
   end Test_Entity_Types;

end ADO.Statements.Tests;

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

with Util.Test_Caller;
with Util.Strings.Transforms;

with ADO.Utils;
with ADO.Sessions;

with Regtests.Statements.Model;
package body ADO.Statements.Tests is

   use Util.Tests;

   procedure Populate (Tst : in out Test);
   function Get_Sum (T     : in Test;
                     Table : in String) return Natural;
   function Get_Sum (T     : in Test;
                     Table : in String;
                     Ids   : in ADO.Utils.Identifier_Vector) return Natural;

   --  Test the query statement Get_Xxx operation for various types.
   generic
      type T (<>) is private;
      with function Get_Value (Stmt   : in ADO.Statements.Query_Statement;
                               Column : in Natural) return T is <>;
      Name   : String;
      Column : String;
   procedure Test_Query_Get_Value_T (Tst   : in out Test);

   procedure Populate (Tst : in out Test) is
      DB    : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
   begin
      DB.Begin_Transaction;
      for I in 1 .. 10 loop
         declare
            Item : Regtests.Statements.Model.Table_Ref;
         begin
            Item.Set_Id_Value (ADO.Identifier (I * I));
            Item.Set_Int_Value (I);
            Item.Set_Bool_Value ((I mod 2) = 0);
            Item.Set_String_Value ("Item" & Integer'Image (I));
            Item.Set_Time_Value (Ada.Calendar.Clock);
            Item.Set_Entity_Value (ADO.Entity_Type (10 - I));
            Item.Save (DB);
            Tst.Assert (Item.Is_Inserted, "Item inserted in database");
         end;
      end loop;
      DB.Commit;
   end Populate;

   --  ------------------------------
   --  Test the query statement Get_Xxx operation for various types.
   --  ------------------------------
   procedure Test_Query_Get_Value_T (Tst   : in out Test) is
      Stmt : ADO.Statements.Query_Statement;
      DB   : constant ADO.Sessions.Session := Regtests.Get_Database;
   begin
      Populate (Tst);

      --  Check that Get_Value raises an exception if the statement is invalid.
      begin
         declare
            V    : T := Get_Value (Stmt, 0);
            pragma Unreferenced (V);
         begin
            Util.Tests.Fail (Tst, "No Invalid_Statement exception raised for " & Name);
         end;

      exception
         when Invalid_Statement =>
            null;
      end;

      --  Execute a query to fetch one column.
      Stmt := DB.Create_Statement ("SELECT " & Column & " FROM test_table WHERE id = 1");
      Stmt.Execute;

      --  Verify the query result and the Get_Value operation.
      Tst.Assert (Stmt.Has_Elements, "The query statement must return a value for "
                  & Name & ":" & Column);
      Tst.Assert (not Stmt.Is_Null (0), "The query statement must return a non null value for "
                  & Name & ":" & Column);
      Util.Tests.Assert_Equals (Tst, Column,
                                Util.Strings.Transforms.To_Lower_Case (Stmt.Get_Column_Name (0)),
                                "The query returns an invalid column name");
      declare
         V : T := Get_Value (Stmt, 0);
         pragma Unreferenced (V);
      begin
         Stmt.Clear;
      end;

   end Test_Query_Get_Value_T;

   procedure Test_Query_Get_Int64 is
     new Test_Query_Get_Value_T (Int64, ADO.Statements.Get_Int64, "Get_Int64", "id_value");

   procedure Test_Query_Get_Integer is
     new Test_Query_Get_Value_T (Integer, ADO.Statements.Get_Integer, "Get_Integer", "int_value");

   procedure Test_Query_Get_Nullable_Integer is
     new Test_Query_Get_Value_T (Nullable_Integer, ADO.Statements.Get_Nullable_Integer,
                                 "Get_Nullable_Integer", "int_value");

   procedure Test_Query_Get_Nullable_Entity_Type is
     new Test_Query_Get_Value_T (Nullable_Entity_Type, ADO.Statements.Get_Nullable_Entity_Type,
                                 "Get_Nullable_Entity_Type", "entity_value");

   procedure Test_Query_Get_Natural is
     new Test_Query_Get_Value_T (Natural, ADO.Statements.Get_Natural, "Get_Natural", "int_value");

   procedure Test_Query_Get_Identifier is
     new Test_Query_Get_Value_T (ADO.Identifier, ADO.Statements.Get_Identifier,
                                 "Get_Identifier", "id_value");

   procedure Test_Query_Get_Boolean is
     new Test_Query_Get_Value_T (Boolean, ADO.Statements.Get_Boolean, "Get_Boolean", "bool_value");

   procedure Test_Query_Get_String is
     new Test_Query_Get_Value_T (String, ADO.Statements.Get_String, "Get_String", "string_value");

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Statements.Save",
                       Test_Save'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Int64",
                       Test_Query_Get_Int64'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Integer",
                       Test_Query_Get_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Nullable_Integer",
                       Test_Query_Get_Nullable_Integer'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Natural",
                       Test_Query_Get_Natural'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Identifier",
                       Test_Query_Get_Identifier'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Boolean",
                       Test_Query_Get_Boolean'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_String",
                       Test_Query_Get_String'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Get_Nullable_Entity_Type",
                       Test_Query_Get_Nullable_Entity_Type'Access);
      Caller.Add_Test (Suite, "Test ADO.Statements.Create_Statement (using $entity_type[])",
                       Test_Entity_Types'Access);
   end Add_Tests;

   function Get_Sum (T : in Test;
                     Table : in String) return Natural is
      DB   : constant ADO.Sessions.Session := Regtests.Get_Database;
      Stmt : ADO.Statements.Query_Statement := DB.Create_Statement ("SELECT SUM(id_value) FROM "
                                                                    & Table);
   begin
      Stmt.Execute;
      T.Assert (Stmt.Has_Elements, "The query statement must return a value for table " & Table);
      return Stmt.Get_Integer (0);
   end Get_Sum;

   function Get_Sum (T     : in Test;
                     Table : in String;
                     Ids   : in ADO.Utils.Identifier_Vector) return Natural is
      DB   : constant ADO.Sessions.Session := Regtests.Get_Database;
      Stmt : ADO.Statements.Query_Statement := DB.Create_Statement ("SELECT SUM(id_value) FROM "
                                                                    & Table
                                                                    & " WHERE id IN (:ids)");
   begin
      Stmt.Bind_Param ("ids", Ids);
      Stmt.Execute;
      T.Assert (Stmt.Has_Elements, "The query statement must return a value for table " & Table);
      return Stmt.Get_Integer (0);
   end Get_Sum;

   --  ------------------------------
   --  Test creation of several rows in test_table with different column type.
   --  ------------------------------
   procedure Test_Save (T : in out Test) is
      First  : constant Natural := Get_Sum (T, "test_table");
      DB     : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      List   : ADO.Utils.Identifier_Vector;
   begin
      DB.Begin_Transaction;
      for I in 1 .. 10 loop
         declare
            Item : Regtests.Statements.Model.Table_Ref;
         begin
            Item.Set_Id_Value (ADO.Identifier (I * I));
            Item.Set_Int_Value (I);
            Item.Set_Bool_Value ((I mod 2) = 0);
            Item.Set_String_Value ("Item" & Integer'Image (I));
            Item.Set_Time_Value (Ada.Calendar.Clock);
            Item.Set_Entity_Value (ADO.Entity_Type (10 - I));
            Item.Save (DB);
            List.Append (Item.Get_Id);
         end;
      end loop;
      DB.Commit;

      Util.Tests.Assert_Equals (T, First + 385, Get_Sum (T, "test_table"),
                                "The SUM query returns an invalid value for test_table");
      Util.Tests.Assert_Equals (T, 385, Get_Sum (T, "test_table", List),
                                "The SUM query returns an invalid value for test_table");
   end Test_Save;

   --  ------------------------------
   --  Test queries using the $entity_type[] cache group.
   --  ------------------------------
   procedure Test_Entity_Types (T : in out Test) is
      DB    : constant ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Stmt  : ADO.Statements.Query_Statement;
      Count : Natural := 0;
   begin
      Stmt := DB.Create_Statement ("SELECT name FROM entity_type "
                                   & "WHERE entity_type.id = $entity_type[test_user]");
      Stmt.Execute;
      while Stmt.Has_Elements loop
         Util.Tests.Assert_Equals (T, "test_user", Stmt.Get_String (0), "Invalid query response");
         Count := Count + 1;
         Stmt.Next;
      end loop;
      Util.Tests.Assert_Equals (T, 1, Count, "Query must return one row");
   end Test_Entity_Types;

end ADO.Statements.Tests;

Declare the Get_Sum function

Declare the Get_Sum function


------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.Web.List_Templates provides an abstraction around list rendering --
-- parameters, and a generic procedure to use it.                           --
------------------------------------------------------------------------------

with Ada.Containers;
with Ada.Iterator_Interfaces;
with Natools.S_Expressions.Atom_Refs;
with Natools.S_Expressions.Caches;
with Natools.S_Expressions.Lockable;
with Natools.Web.Sites;

package Natools.Web.List_Templates is

   type Count is new Ada.Containers.Count_Type;

   type Direction is (Forward, Backward);

   type List_End is (Beginning, Ending);

   type Parameters is record
      Ellipses_Are_Items : Boolean := False;
      Ellipsis_Prefix : S_Expressions.Atom_Refs.Immutable_Reference;
      Ellipsis_Suffix : S_Expressions.Atom_Refs.Immutable_Reference;
      Going : Direction := Forward;
      Shown_End : List_End := Beginning;
      If_Empty : S_Expressions.Atom_Refs.Immutable_Reference;
      Limit : Count := 0;
      Prefix : S_Expressions.Atom_Refs.Immutable_Reference;
      Separator : S_Expressions.Atom_Refs.Immutable_Reference;
      Suffix : S_Expressions.Atom_Refs.Immutable_Reference;
      Template : S_Expressions.Caches.Cursor;
   end record;

   procedure Read_Parameters
     (Object : in out Parameters;
      Expression : in out S_Expressions.Lockable.Descriptor'Class);

   function Read_Parameters
     (Expression : in out S_Expressions.Lockable.Descriptor'Class)
     return Parameters;

   generic
      with package Iterators is new Ada.Iterator_Interfaces (<>);
      with procedure Render
        (Exchange : in out Sites.Exchange;
         Position : in Iterators.Cursor;
         Expression : in out S_Expressions.Lockable.Descriptor'Class) is <>;
   procedure Render
     (Exchange : in out Sites.Exchange;
      Iterator : in Iterators.Reversible_Iterator'Class;
      Param : in Parameters);

end Natools.Web.List_Templates;

------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.Web.List_Templates provides an abstraction around list rendering --
-- parameters, and a generic procedure to use it.                           --
-- When the list is empty, only If_Empty is output, otherwise the following --
-- scheme is rendered:                                                      --
-- <prefix> [<ellipsis_prefix>] <item_1> <separator> <item_2> ...           --
--    ... <separator> <item_n> [<ellipsis_suffix>] <suffix>                 --
-- The optional ellipses are output when the list is only partially output. --
-- Ellipses_Are_Items controls whether the non-empty ellipses count towards --
-- the given limit.                                                         --
-- Shown_End controls whether partially rendered lists omit items at the    --
-- beginning or at the end of the displayed list (i.e. after taking into    --
-- account Going).                                                          --
------------------------------------------------------------------------------

with Ada.Containers;
with Ada.Iterator_Interfaces;
with Natools.S_Expressions.Atom_Refs;
with Natools.S_Expressions.Caches;
with Natools.S_Expressions.Lockable;
with Natools.Web.Sites;

package Natools.Web.List_Templates is

   type Count is new Ada.Containers.Count_Type;

   type Direction is (Forward, Backward);

   type List_End is (Beginning, Ending);

   type Parameters is record
      Ellipses_Are_Items : Boolean := False;
      Ellipsis_Prefix : S_Expressions.Atom_Refs.Immutable_Reference;
      Ellipsis_Suffix : S_Expressions.Atom_Refs.Immutable_Reference;
      Going : Direction := Forward;
      Shown_End : List_End := Beginning;
      If_Empty : S_Expressions.Atom_Refs.Immutable_Reference;
      Limit : Count := 0;
      Prefix : S_Expressions.Atom_Refs.Immutable_Reference;
      Separator : S_Expressions.Atom_Refs.Immutable_Reference;
      Suffix : S_Expressions.Atom_Refs.Immutable_Reference;
      Template : S_Expressions.Caches.Cursor;
   end record;

   procedure Read_Parameters
     (Object : in out Parameters;
      Expression : in out S_Expressions.Lockable.Descriptor'Class);

   function Read_Parameters
     (Expression : in out S_Expressions.Lockable.Descriptor'Class)
     return Parameters;

   generic
      with package Iterators is new Ada.Iterator_Interfaces (<>);
      with procedure Render
        (Exchange : in out Sites.Exchange;
         Position : in Iterators.Cursor;
         Expression : in out S_Expressions.Lockable.Descriptor'Class) is <>;
   procedure Render
     (Exchange : in out Sites.Exchange;
      Iterator : in Iterators.Reversible_Iterator'Class;
      Param : in Parameters);

end Natools.Web.List_Templates;

list_templates: document the new fields in the package description comment


-----------------------------------------------------------------------
--  util-processes-os -- System specific and low level operations
--  Copyright (C) 2011, 2012, 2018, 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 System;

with Ada.Unchecked_Deallocation;
with Ada.Characters.Conversions;

with Util.Log.Loggers;
package body Util.Processes.Os is

   use type Interfaces.C.size_t;

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

   procedure Free is
      new Ada.Unchecked_Deallocation (Object => Interfaces.C.wchar_array,
                                      Name   => Wchar_Ptr);

   function To_WSTR (Value : in String) return Wchar_Ptr;

   --  ------------------------------
   --  Wait for the process to exit.
   --  ------------------------------
   overriding
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration) is

      use type Util.Streams.Output_Stream_Access;

      Result : DWORD;
      T      : DWORD;
      Code   : aliased DWORD;
      Status : BOOL;
   begin
      --  Close the input stream pipe if there is one.
      if Proc.Input /= null then
         Util.Streams.Raw.Raw_Stream'Class (Proc.Input.all).Close;
      end if;

      if Timeout < 0.0 then
         T := DWORD'Last;
      else
         T := DWORD (Timeout * 1000.0);
      end if;
      Log.Debug ("Waiting {0}", DWORD'Image (T));

      Result := Wait_For_Single_Object (H    => Sys.Process_Info.hProcess,
                                        Time => T);

      Log.Debug ("Status {0}", DWORD'Image (Result));

      Status := Get_Exit_Code_Process (Proc => Sys.Process_Info.hProcess,
                                       Code => Code'Unchecked_Access);
      if Status = 0 then
         Log.Error ("Process is still running.  Error {0}", Integer'Image (Get_Last_Error));
      end if;
      Proc.Exit_Value := Integer (Code);
      Log.Debug ("Process exit is: {0}", Integer'Image (Proc.Exit_Value));
   end Wait;

   --  ------------------------------
   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   --  ------------------------------
   overriding
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15) is
      pragma Unreferenced (Proc);
      Result : Integer;
      pragma Unreferenced (Result);
   begin
      Result := Terminate_Process (Sys.Process_Info.hProcess, DWORD (Signal));
   end Stop;

   procedure Prepare_Working_Directory (Sys  : in out System_Process;
                                        Proc : in out Process'Class) is
      Dir : constant String := Ada.Strings.Unbounded.To_String (Proc.Dir);
   begin
      Free (Sys.Dir);
      if Dir'Length > 0 then
         if not Ada.Directories.Exists (Dir)
           or else Ada.Directories.Kind (Dir) /= Ada.Directories.Directory
         then
            raise Ada.Directories.Name_Error with "Invalid directory: " & Dir;
         end if;
         Sys.Dir := To_WSTR (Dir);
      end if;
   end Prepare_Working_Directory;

   --  Spawn a new process.
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE) is
      use Util.Streams.Raw;
      use Ada.Characters.Conversions;
      use Interfaces.C;
      use type System.Address;

      Result  : Integer;
      Startup : aliased Startup_Info;
      R       : BOOL;
   begin
      Sys.Prepare_Working_Directory (Proc);

      --  Since checks are disabled, verify by hand that the argv table is correct.
      if Sys.Command = null or else Sys.Command'Length < 1 then
         raise Program_Error with "Invalid process argument list";
      end if;

      Startup.cb         := Startup'Size / 8;
      Startup.hStdInput  := Get_Std_Handle (STD_INPUT_HANDLE);
      Startup.hStdOutput := Get_Std_Handle (STD_OUTPUT_HANDLE);
      Startup.hStdError  := Get_Std_Handle (STD_ERROR_HANDLE);
      if Mode = READ or Mode = READ_WRITE or Mode = READ_ALL then
         Build_Output_Pipe (Proc, Startup);
      end if;
      if Mode = WRITE or Mode = READ_WRITE or Mode = READ_WRITE_ALL then
         Build_Input_Pipe (Proc, Startup);
      end if;

      --  Start the child process.
      Result := Create_Process (System.Null_Address,
                                Sys.Command.all'Address,
                                null,
                                null,
                                True,
                                16#0#,
                                System.Null_Address,
                                Sys.Dir,
                                Startup'Unchecked_Access,
                                Sys.Process_Info'Unchecked_Access);

      --  Close the handles which are not necessary.
      if Startup.hStdInput /= Get_Std_Handle (STD_INPUT_HANDLE) then
         R := Close_Handle (Startup.hStdInput);
      end if;
      if Startup.hStdOutput /= Get_Std_Handle (STD_OUTPUT_HANDLE) then
         R := Close_Handle (Startup.hStdOutput);
      end if;
      if Startup.hStdError /= Get_Std_Handle (STD_ERROR_HANDLE) then
         R := Close_Handle (Startup.hStdError);
      end if;
      if Result /= 1 then
         Result := Get_Last_Error;
         Log.Error ("Process creation failed: {0}", Integer'Image (Result));
         raise Process_Error with "Cannot create process";
      end if;

      Proc.Pid := Process_Identifier (Sys.Process_Info.dwProcessId);
   end Spawn;

   --  ------------------------------
   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   --  ------------------------------
   function Create_Stream (File : in Util.Streams.Raw.File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access is
      Stream : constant Util.Streams.Raw.Raw_Stream_Access := new Util.Streams.Raw.Raw_Stream;
   begin
      Stream.Initialize (File);
      return Stream;
   end Create_Stream;

   --  ------------------------------
   --  Build the output pipe redirection to read the process output.
   --  ------------------------------
   procedure Build_Output_Pipe (Proc : in out Process'Class;
                                Into : in out Startup_Info) is
      Sec              : aliased Security_Attributes;
      Read_Handle      : aliased HANDLE;
      Write_Handle     : aliased HANDLE;
      Read_Pipe_Handle : aliased HANDLE;
      Error_Handle     : aliased HANDLE;
      Result           : BOOL;
      Current_Proc     : constant HANDLE := Get_Current_Process;
   begin
      Sec.Length  := Sec'Size / 8;
      Sec.Inherit := True;
      Sec.Security_Descriptor := System.Null_Address;

      Result := Create_Pipe (Read_Handle  => Read_Handle'Unchecked_Access,
                             Write_Handle => Write_Handle'Unchecked_Access,
                             Attributes   => Sec'Unchecked_Access,
                             Buf_Size     => 0);
      if Result = 0 then
         Log.Error ("Cannot create pipe: {0}", Integer'Image (Get_Last_Error));
         raise Program_Error with "Cannot create pipe";
      end if;

      Result := Duplicate_Handle (SourceProcessHandle => Current_Proc,
                                  SourceHandle        => Read_Handle,
                                  TargetProcessHandle => Current_Proc,
                                  TargetHandle        => Read_Pipe_Handle'Unchecked_Access,
                                  DesiredAccess       => 0,
                                  InheritHandle       => 0,
                                  Options             => 2);
      if Result = 0 then
         raise Program_Error with "Cannot create pipe";
      end if;
      Result := Close_Handle (Read_Handle);

      Result := Duplicate_Handle (SourceProcessHandle => Current_Proc,
                                  SourceHandle        => Write_Handle,
                                  TargetProcessHandle => Current_Proc,
                                  TargetHandle        => Error_Handle'Unchecked_Access,
                                  DesiredAccess       => 0,
                                  InheritHandle       => 1,
                                  Options             => 2);
      if Result = 0 then
         raise Program_Error with "Cannot create pipe";
      end if;
      Into.dwFlags    := 16#100#;
      Into.hStdOutput := Write_Handle;
      Into.hStdError  := Error_Handle;
      Proc.Output     := Create_Stream (Read_Pipe_Handle).all'Access;
   end Build_Output_Pipe;

   --  ------------------------------
   --  Build the input pipe redirection to write the process standard input.
   --  ------------------------------
   procedure Build_Input_Pipe (Proc : in out Process'Class;
                               Into : in out Startup_Info) is
      Sec               : aliased Security_Attributes;
      Read_Handle       : aliased HANDLE;
      Write_Handle      : aliased HANDLE;
      Write_Pipe_Handle : aliased HANDLE;
      Result            : BOOL;
      Current_Proc      : constant HANDLE := Get_Current_Process;
   begin
      Sec.Length  := Sec'Size / 8;
      Sec.Inherit := True;
      Sec.Security_Descriptor := System.Null_Address;

      Result := Create_Pipe (Read_Handle  => Read_Handle'Unchecked_Access,
                             Write_Handle => Write_Handle'Unchecked_Access,
                             Attributes   => Sec'Unchecked_Access,
                             Buf_Size     => 0);
      if Result = 0 then
         Log.Error ("Cannot create pipe: {0}", Integer'Image (Get_Last_Error));
         raise Program_Error with "Cannot create pipe";
      end if;

      Result := Duplicate_Handle (SourceProcessHandle => Current_Proc,
                                  SourceHandle        => Write_Handle,
                                  TargetProcessHandle => Current_Proc,
                                  TargetHandle        => Write_Pipe_Handle'Unchecked_Access,
                                  DesiredAccess       => 0,
                                  InheritHandle       => 0,
                                  Options             => 2);
      if Result = 0 then
         raise Program_Error with "Cannot create pipe";
      end if;
      Result := Close_Handle (Write_Handle);

      Into.dwFlags   := 16#100#;
      Into.hStdInput := Read_Handle;
      Proc.Input     := Create_Stream (Write_Pipe_Handle).all'Access;
   end Build_Input_Pipe;

   --  ------------------------------
   --  Append the argument to the process argument list.
   --  ------------------------------
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String) is
      Len : Interfaces.C.size_t := Arg'Length;
   begin
      if Sys.Command /= null then
         Len := Len + Sys.Command'Length + 2;
         declare
            S : constant Wchar_Ptr := new Interfaces.C.wchar_array (0 .. Len);
         begin
            S (Sys.Command'Range) := Sys.Command.all;
            Free (Sys.Command);
            Sys.Command := S;
         end;
         Sys.Command (Sys.Pos) := Interfaces.C.To_C (' ');
         Sys.Pos := Sys.Pos + 1;

      else
         Sys.Command := new Interfaces.C.wchar_array (0 .. Len + 1);
         Sys.Pos := 0;
      end if;
      for I in Arg'Range loop
         Sys.Command (Sys.Pos)
           := Interfaces.C.To_C (Ada.Characters.Conversions.To_Wide_Character (Arg (I)));
         Sys.Pos := Sys.Pos + 1;
      end loop;
      Sys.Command (Sys.Pos) := Interfaces.C.wide_nul;
   end Append_Argument;

   function To_WSTR (Value : in String) return Wchar_Ptr is
      Result : constant Wchar_Ptr := new Interfaces.C.wchar_array (0 .. Value'Length + 1);
      Pos    : Interfaces.C.size_t := 0;
   begin
      for C of Value loop
         Result (Pos)
           := Interfaces.C.To_C (Ada.Characters.Conversions.To_Wide_Character (C));
         Pos := Pos + 1;
      end loop;
      Result (Pos) := Interfaces.C.wide_nul;
      return Result;
   end To_WSTR;

   --  ------------------------------
   --  Set the process input, output and error streams to redirect and use specified files.
   --  ------------------------------
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean;
                          To_Close      : in File_Type_Array_Access) is
   begin
      if Input'Length > 0 then
         Sys.In_File := To_WSTR (Input);
      end if;
      if Output'Length > 0 then
         Sys.Out_File   := To_WSTR (Output);
         Sys.Out_Append := Append_Output;
      end if;
      if Error'Length > 0 then
         Sys.Err_File   := To_WSTR (Error);
         Sys.Err_Append := Append_Error;
      end if;
      Sys.To_Close := To_Close;
   end Set_Streams;

   --  ------------------------------
   --  Deletes the storage held by the system process.
   --  ------------------------------
   overriding
   procedure Finalize (Sys : in out System_Process) is
      use type System.Address;

      Result : BOOL;
      pragma Unreferenced (Result);
   begin
      if Sys.Process_Info.hProcess /= NO_FILE then
         Result := Close_Handle (Sys.Process_Info.hProcess);
         Sys.Process_Info.hProcess := NO_FILE;
      end if;
      if Sys.Process_Info.hThread /= NO_FILE then
         Result := Close_Handle (Sys.Process_Info.hThread);
         Sys.Process_Info.hThread := NO_FILE;
      end if;
      Free (Sys.In_File);
      Free (Sys.Out_File);
      Free (Sys.Err_File);
      Free (Sys.Dir);
      Free (Sys.Command);
   end Finalize;

end Util.Processes.Os;

-----------------------------------------------------------------------
--  util-processes-os -- System specific and low level operations
--  Copyright (C) 2011, 2012, 2018, 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 System;

with Ada.Unchecked_Deallocation;
with Ada.Characters.Conversions;
with Ada.Directories;

with Util.Log.Loggers;
package body Util.Processes.Os is

   use type Interfaces.C.size_t;

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

   procedure Free is
      new Ada.Unchecked_Deallocation (Object => Interfaces.C.wchar_array,
                                      Name   => Wchar_Ptr);

   function To_WSTR (Value : in String) return Wchar_Ptr;

   --  ------------------------------
   --  Wait for the process to exit.
   --  ------------------------------
   overriding
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration) is

      use type Util.Streams.Output_Stream_Access;

      Result : DWORD;
      T      : DWORD;
      Code   : aliased DWORD;
      Status : BOOL;
   begin
      --  Close the input stream pipe if there is one.
      if Proc.Input /= null then
         Util.Streams.Raw.Raw_Stream'Class (Proc.Input.all).Close;
      end if;

      if Timeout < 0.0 then
         T := DWORD'Last;
      else
         T := DWORD (Timeout * 1000.0);
      end if;
      Log.Debug ("Waiting {0}", DWORD'Image (T));

      Result := Wait_For_Single_Object (H    => Sys.Process_Info.hProcess,
                                        Time => T);

      Log.Debug ("Status {0}", DWORD'Image (Result));

      Status := Get_Exit_Code_Process (Proc => Sys.Process_Info.hProcess,
                                       Code => Code'Unchecked_Access);
      if Status = 0 then
         Log.Error ("Process is still running.  Error {0}", Integer'Image (Get_Last_Error));
      end if;
      Proc.Exit_Value := Integer (Code);
      Log.Debug ("Process exit is: {0}", Integer'Image (Proc.Exit_Value));
   end Wait;

   --  ------------------------------
   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   --  ------------------------------
   overriding
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15) is
      pragma Unreferenced (Proc);
      Result : Integer;
      pragma Unreferenced (Result);
   begin
      Result := Terminate_Process (Sys.Process_Info.hProcess, DWORD (Signal));
   end Stop;

   procedure Prepare_Working_Directory (Sys  : in out System_Process;
                                        Proc : in out Process'Class) is
      Dir : constant String := Ada.Strings.Unbounded.To_String (Proc.Dir);
   begin
      Free (Sys.Dir);
      if Dir'Length > 0 then
         if not Ada.Directories.Exists (Dir)
           or else Ada.Directories.Kind (Dir) /= Ada.Directories.Directory
         then
            raise Ada.Directories.Name_Error with "Invalid directory: " & Dir;
         end if;
         Sys.Dir := To_WSTR (Dir);
      end if;
   end Prepare_Working_Directory;

   --  Spawn a new process.
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE) is
      use Util.Streams.Raw;
      use Ada.Characters.Conversions;
      use Interfaces.C;
      use type System.Address;

      Result  : Integer;
      Startup : aliased Startup_Info;
      R       : BOOL;
   begin
      Sys.Prepare_Working_Directory (Proc);

      --  Since checks are disabled, verify by hand that the argv table is correct.
      if Sys.Command = null or else Sys.Command'Length < 1 then
         raise Program_Error with "Invalid process argument list";
      end if;

      Startup.cb         := Startup'Size / 8;
      Startup.hStdInput  := Get_Std_Handle (STD_INPUT_HANDLE);
      Startup.hStdOutput := Get_Std_Handle (STD_OUTPUT_HANDLE);
      Startup.hStdError  := Get_Std_Handle (STD_ERROR_HANDLE);
      if Mode = READ or Mode = READ_WRITE or Mode = READ_ALL then
         Build_Output_Pipe (Proc, Startup);
      end if;
      if Mode = WRITE or Mode = READ_WRITE or Mode = READ_WRITE_ALL then
         Build_Input_Pipe (Proc, Startup);
      end if;

      --  Start the child process.
      Result := Create_Process (System.Null_Address,
                                Sys.Command.all'Address,
                                null,
                                null,
                                True,
                                16#0#,
                                System.Null_Address,
                                Sys.Dir.all'Address,
                                Startup'Unchecked_Access,
                                Sys.Process_Info'Unchecked_Access);

      --  Close the handles which are not necessary.
      if Startup.hStdInput /= Get_Std_Handle (STD_INPUT_HANDLE) then
         R := Close_Handle (Startup.hStdInput);
      end if;
      if Startup.hStdOutput /= Get_Std_Handle (STD_OUTPUT_HANDLE) then
         R := Close_Handle (Startup.hStdOutput);
      end if;
      if Startup.hStdError /= Get_Std_Handle (STD_ERROR_HANDLE) then
         R := Close_Handle (Startup.hStdError);
      end if;
      if Result /= 1 then
         Result := Get_Last_Error;
         Log.Error ("Process creation failed: {0}", Integer'Image (Result));
         raise Process_Error with "Cannot create process";
      end if;

      Proc.Pid := Process_Identifier (Sys.Process_Info.dwProcessId);
   end Spawn;

   --  ------------------------------
   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   --  ------------------------------
   function Create_Stream (File : in Util.Streams.Raw.File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access is
      Stream : constant Util.Streams.Raw.Raw_Stream_Access := new Util.Streams.Raw.Raw_Stream;
   begin
      Stream.Initialize (File);
      return Stream;
   end Create_Stream;

   --  ------------------------------
   --  Build the output pipe redirection to read the process output.
   --  ------------------------------
   procedure Build_Output_Pipe (Proc : in out Process'Class;
                                Into : in out Startup_Info) is
      Sec              : aliased Security_Attributes;
      Read_Handle      : aliased HANDLE;
      Write_Handle     : aliased HANDLE;
      Read_Pipe_Handle : aliased HANDLE;
      Error_Handle     : aliased HANDLE;
      Result           : BOOL;
      Current_Proc     : constant HANDLE := Get_Current_Process;
   begin
      Sec.Length  := Sec'Size / 8;
      Sec.Inherit := True;
      Sec.Security_Descriptor := System.Null_Address;

      Result := Create_Pipe (Read_Handle  => Read_Handle'Unchecked_Access,
                             Write_Handle => Write_Handle'Unchecked_Access,
                             Attributes   => Sec'Unchecked_Access,
                             Buf_Size     => 0);
      if Result = 0 then
         Log.Error ("Cannot create pipe: {0}", Integer'Image (Get_Last_Error));
         raise Program_Error with "Cannot create pipe";
      end if;

      Result := Duplicate_Handle (SourceProcessHandle => Current_Proc,
                                  SourceHandle        => Read_Handle,
                                  TargetProcessHandle => Current_Proc,
                                  TargetHandle        => Read_Pipe_Handle'Unchecked_Access,
                                  DesiredAccess       => 0,
                                  InheritHandle       => 0,
                                  Options             => 2);
      if Result = 0 then
         raise Program_Error with "Cannot create pipe";
      end if;
      Result := Close_Handle (Read_Handle);

      Result := Duplicate_Handle (SourceProcessHandle => Current_Proc,
                                  SourceHandle        => Write_Handle,
                                  TargetProcessHandle => Current_Proc,
                                  TargetHandle        => Error_Handle'Unchecked_Access,
                                  DesiredAccess       => 0,
                                  InheritHandle       => 1,
                                  Options             => 2);
      if Result = 0 then
         raise Program_Error with "Cannot create pipe";
      end if;
      Into.dwFlags    := 16#100#;
      Into.hStdOutput := Write_Handle;
      Into.hStdError  := Error_Handle;
      Proc.Output     := Create_Stream (Read_Pipe_Handle).all'Access;
   end Build_Output_Pipe;

   --  ------------------------------
   --  Build the input pipe redirection to write the process standard input.
   --  ------------------------------
   procedure Build_Input_Pipe (Proc : in out Process'Class;
                               Into : in out Startup_Info) is
      Sec               : aliased Security_Attributes;
      Read_Handle       : aliased HANDLE;
      Write_Handle      : aliased HANDLE;
      Write_Pipe_Handle : aliased HANDLE;
      Result            : BOOL;
      Current_Proc      : constant HANDLE := Get_Current_Process;
   begin
      Sec.Length  := Sec'Size / 8;
      Sec.Inherit := True;
      Sec.Security_Descriptor := System.Null_Address;

      Result := Create_Pipe (Read_Handle  => Read_Handle'Unchecked_Access,
                             Write_Handle => Write_Handle'Unchecked_Access,
                             Attributes   => Sec'Unchecked_Access,
                             Buf_Size     => 0);
      if Result = 0 then
         Log.Error ("Cannot create pipe: {0}", Integer'Image (Get_Last_Error));
         raise Program_Error with "Cannot create pipe";
      end if;

      Result := Duplicate_Handle (SourceProcessHandle => Current_Proc,
                                  SourceHandle        => Write_Handle,
                                  TargetProcessHandle => Current_Proc,
                                  TargetHandle        => Write_Pipe_Handle'Unchecked_Access,
                                  DesiredAccess       => 0,
                                  InheritHandle       => 0,
                                  Options             => 2);
      if Result = 0 then
         raise Program_Error with "Cannot create pipe";
      end if;
      Result := Close_Handle (Write_Handle);

      Into.dwFlags   := 16#100#;
      Into.hStdInput := Read_Handle;
      Proc.Input     := Create_Stream (Write_Pipe_Handle).all'Access;
   end Build_Input_Pipe;

   --  ------------------------------
   --  Append the argument to the process argument list.
   --  ------------------------------
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String) is
      Len : Interfaces.C.size_t := Arg'Length;
   begin
      if Sys.Command /= null then
         Len := Len + Sys.Command'Length + 2;
         declare
            S : constant Wchar_Ptr := new Interfaces.C.wchar_array (0 .. Len);
         begin
            S (Sys.Command'Range) := Sys.Command.all;
            Free (Sys.Command);
            Sys.Command := S;
         end;
         Sys.Command (Sys.Pos) := Interfaces.C.To_C (' ');
         Sys.Pos := Sys.Pos + 1;

      else
         Sys.Command := new Interfaces.C.wchar_array (0 .. Len + 1);
         Sys.Pos := 0;
      end if;
      for I in Arg'Range loop
         Sys.Command (Sys.Pos)
           := Interfaces.C.To_C (Ada.Characters.Conversions.To_Wide_Character (Arg (I)));
         Sys.Pos := Sys.Pos + 1;
      end loop;
      Sys.Command (Sys.Pos) := Interfaces.C.wide_nul;
   end Append_Argument;

   function To_WSTR (Value : in String) return Wchar_Ptr is
      Result : constant Wchar_Ptr := new Interfaces.C.wchar_array (0 .. Value'Length + 1);
      Pos    : Interfaces.C.size_t := 0;
   begin
      for C of Value loop
         Result (Pos)
           := Interfaces.C.To_C (Ada.Characters.Conversions.To_Wide_Character (C));
         Pos := Pos + 1;
      end loop;
      Result (Pos) := Interfaces.C.wide_nul;
      return Result;
   end To_WSTR;

   --  ------------------------------
   --  Set the process input, output and error streams to redirect and use specified files.
   --  ------------------------------
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean;
                          To_Close      : in File_Type_Array_Access) is
   begin
      if Input'Length > 0 then
         Sys.In_File := To_WSTR (Input);
      end if;
      if Output'Length > 0 then
         Sys.Out_File   := To_WSTR (Output);
         Sys.Out_Append := Append_Output;
      end if;
      if Error'Length > 0 then
         Sys.Err_File   := To_WSTR (Error);
         Sys.Err_Append := Append_Error;
      end if;
      Sys.To_Close := To_Close;
   end Set_Streams;

   --  ------------------------------
   --  Deletes the storage held by the system process.
   --  ------------------------------
   overriding
   procedure Finalize (Sys : in out System_Process) is
      use type System.Address;

      Result : BOOL;
      pragma Unreferenced (Result);
   begin
      if Sys.Process_Info.hProcess /= NO_FILE then
         Result := Close_Handle (Sys.Process_Info.hProcess);
         Sys.Process_Info.hProcess := NO_FILE;
      end if;
      if Sys.Process_Info.hThread /= NO_FILE then
         Result := Close_Handle (Sys.Process_Info.hThread);
         Sys.Process_Info.hThread := NO_FILE;
      end if;
      Free (Sys.In_File);
      Free (Sys.Out_File);
      Free (Sys.Err_File);
      Free (Sys.Dir);
      Free (Sys.Command);
   end Finalize;

end Util.Processes.Os;

Fix compilation on Windows

Fix compilation on Windows


-----------------------------------------------------------------------
--  mat-targets-gtkmat - Gtk target management
--  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 Glib.Error;
with Glib.Object;

with Gtk.Main;
with Gtk.Label;
with Gtk.Frame;

with MAT.Callbacks;
with MAT.Consoles.Text;
with MAT.Consoles.Gtkmat;
package body MAT.Targets.Gtkmat is

   --  ------------------------------
   --  Initialize the target instance.
   --  ------------------------------
   overriding
   procedure Initialize (Target : in out Target_Type) is
   begin
      Target.Options.Interactive := False;
      Target.Options.Graphical   := True;
      Target.Console := new MAT.Consoles.Text.Console_Type;
   end Initialize;

   --  ------------------------------
   --  Initialize the widgets and create the Gtk gui.
   --  ------------------------------
   procedure Initialize_Widget (Target : in out Target_Type;
                                Widget : out Gtk.Widget.Gtk_Widget) is
      Error   : aliased Glib.Error.GError;
      Result  : Glib.Guint;
   begin
      if Target.Options.Graphical then
         Gtk.Main.Init;
         Gtkada.Builder.Gtk_New (Target.Builder);
         Result := Target.Builder.Add_From_File ("mat.glade", Error'Access);
         MAT.Callbacks.Initialize (Target'Unchecked_Access, Target.Builder);
         Target.Builder.Do_Connect;
         Widget := Gtk.Widget.Gtk_Widget (Target.Builder.Get_Object ("main"));
         Target.Gtk_Console := new MAT.Consoles.Gtkmat.Console_Type;
         Target.Gtk_Console.Initialize
           (Gtk.Frame.Gtk_Frame (Target.Builder.Get_Object ("consoleFrame")));
         Target.Console := Target.Gtk_Console.all'Access;
      else
         Widget := null;
      end if;
   end Initialize_Widget;

   --  ------------------------------
   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   --  ------------------------------
   overriding
   procedure Interactive (Target : in out Target_Type) is
      Main : Gtk.Widget.Gtk_Widget;
   begin
      if Target.Options.Graphical then
         Main := Gtk.Widget.Gtk_Widget (Target.Builder.Get_Object ("main"));
         Main.Show_All;
      end if;
      if Target.Options.Interactive and Target.Options.Graphical then
         Target.Gui_Task.Start (Target'Unchecked_Access);
      end if;
      if Target.Options.Graphical then
         Gtk.Main.Main;
      else
         MAT.Targets.Target_Type (Target).Interactive;
      end if;
   end Interactive;

   task body Gtk_Loop is
      Main : Target_Type_Access;
   begin
      select
         accept Start (Target : in Target_Type_Access) do
            Main := Target;
         end Start;
         MAT.Targets.Target_Type (Main.all).Interactive;
      or
         terminate;
      end select;
   end Gtk_Loop;

   --  ------------------------------
   --  Set the UI label with the given value.
   --  ------------------------------
   procedure Set_Label (Target : in Target_Type;
                        Name   : in String;
                        Value  : in String) is
      use type Glib.Object.GObject;

      Object : constant Glib.Object.GObject := Target.Builder.Get_Object (Name);
      Label  : Gtk.Label.Gtk_Label;
   begin
      if Object /= null then
         Label := Gtk.Label.Gtk_Label (Object);
         Label.Set_Label (Value);
      end if;
   end Set_Label;

   --  ------------------------------
   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   --  ------------------------------
   overriding
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access) is
   begin
      MAT.Targets.Target_Type (Target).Create_Process (Pid, Path, Process);
      Target.Set_Label ("process_info", "Pid:" & MAT.Types.Target_Process_Ref'Image (Pid));
   end Create_Process;

   --  ------------------------------
   --  Refresh the information about the current process.
   --  ------------------------------
   procedure Refresh_Process (Target  : in out Target_Type) is
      use type MAT.Events.Targets.Target_Events_Access;

      Counter : Integer;
      Stats   : MAT.Memory.Targets.Memory_Stat;
   begin
      if Target.Current = null or else Target.Current.Events = null then
         return;
      end if;
      Counter := Target.Current.Events.Get_Event_Counter;
      if Counter = Target.Previous_Event_Counter then
         return;
      end if;
      Target.Previous_Event_Counter := Counter;
      Target.Set_Label ("event_info", "Events:" & Integer'Image (Counter));
      Target.Current.Memory.Stat_Information (Stats);
      Target.Set_Label ("thread_info", "Threads:"
                        & Natural'Image (Stats.Thread_Count));
      Target.Set_Label ("mem_used_info", "Used:"
                        & MAT.Types.Target_Size'Image (Stats.Total_Alloc));
      Target.Set_Label ("mem_free_info", "Free:"
                        & MAT.Types.Target_Size'Image (Stats.Total_Free));
   end Refresh_Process;

end MAT.Targets.Gtkmat;

-----------------------------------------------------------------------
--  mat-targets-gtkmat - Gtk target management
--  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 Glib.Error;
with Glib.Object;

with Gtk.Main;
with Gtk.Label;
with Gtk.Frame;

with MAT.Callbacks;
with MAT.Consoles.Text;
with MAT.Consoles.Gtkmat;
package body MAT.Targets.Gtkmat is

   --  ------------------------------
   --  Initialize the target instance.
   --  ------------------------------
   overriding
   procedure Initialize (Target : in out Target_Type) is
   begin
      Target.Options.Interactive := False;
      Target.Options.Graphical   := True;
      Target.Console := new MAT.Consoles.Text.Console_Type;
   end Initialize;

   --  ------------------------------
   --  Release the storage.
   --  ------------------------------
   overriding
   procedure Finalize (Target : in out Target_Type) is
      use type Gtk.Widget.Gtk_Widget;
   begin
      if Target.Main /= null then
         Target.Main.Destroy;
         Target.About.Destroy;
         Target.Chooser.Destroy;
      end if;
   end Finalize;

   --  ------------------------------
   --  Initialize the widgets and create the Gtk gui.
   --  ------------------------------
   procedure Initialize_Widget (Target : in out Target_Type;
                                Widget : out Gtk.Widget.Gtk_Widget) is
      Error   : aliased Glib.Error.GError;
      Result  : Glib.Guint;
   begin
      if Target.Options.Graphical then
         Gtk.Main.Init;
         Gtkada.Builder.Gtk_New (Target.Builder);
         Result := Target.Builder.Add_From_File ("mat.glade", Error'Access);
         MAT.Callbacks.Initialize (Target'Unchecked_Access, Target.Builder);
         Target.Builder.Do_Connect;
         Widget := Gtk.Widget.Gtk_Widget (Target.Builder.Get_Object ("main"));
         Target.Main := Widget;
         Target.About := Gtk.Widget.Gtk_Widget (Target.Builder.Get_Object ("about"));
         Target.Chooser := Gtk.Widget.Gtk_Widget (Target.Builder.Get_Object ("filechooser"));

         Target.Gtk_Console := new MAT.Consoles.Gtkmat.Console_Type;
         Target.Gtk_Console.Initialize
           (Gtk.Frame.Gtk_Frame (Target.Builder.Get_Object ("consoleFrame")));
         Target.Console := Target.Gtk_Console.all'Access;
      else
         Widget := null;
      end if;
   end Initialize_Widget;

   --  ------------------------------
   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   --  ------------------------------
   overriding
   procedure Interactive (Target : in out Target_Type) is
      Main : Gtk.Widget.Gtk_Widget;
   begin
      if Target.Options.Graphical then
         Main := Gtk.Widget.Gtk_Widget (Target.Builder.Get_Object ("main"));
         Main.Show_All;
      end if;
      if Target.Options.Interactive and Target.Options.Graphical then
         Target.Gui_Task.Start (Target'Unchecked_Access);
      end if;
      if Target.Options.Graphical then
         Gtk.Main.Main;
      else
         MAT.Targets.Target_Type (Target).Interactive;
      end if;
   end Interactive;

   task body Gtk_Loop is
      Main : Target_Type_Access;
   begin
      select
         accept Start (Target : in Target_Type_Access) do
            Main := Target;
         end Start;
         MAT.Targets.Target_Type (Main.all).Interactive;
      or
         terminate;
      end select;
   end Gtk_Loop;

   --  ------------------------------
   --  Set the UI label with the given value.
   --  ------------------------------
   procedure Set_Label (Target : in Target_Type;
                        Name   : in String;
                        Value  : in String) is
      use type Glib.Object.GObject;

      Object : constant Glib.Object.GObject := Target.Builder.Get_Object (Name);
      Label  : Gtk.Label.Gtk_Label;
   begin
      if Object /= null then
         Label := Gtk.Label.Gtk_Label (Object);
         Label.Set_Label (Value);
      end if;
   end Set_Label;

   --  ------------------------------
   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   --  ------------------------------
   overriding
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access) is
   begin
      MAT.Targets.Target_Type (Target).Create_Process (Pid, Path, Process);
      Target.Set_Label ("process_info", "Pid:" & MAT.Types.Target_Process_Ref'Image (Pid));
   end Create_Process;

   --  ------------------------------
   --  Refresh the information about the current process.
   --  ------------------------------
   procedure Refresh_Process (Target  : in out Target_Type) is
      use type MAT.Events.Targets.Target_Events_Access;

      Counter : Integer;
      Stats   : MAT.Memory.Targets.Memory_Stat;
   begin
      if Target.Current = null or else Target.Current.Events = null then
         return;
      end if;
      Counter := Target.Current.Events.Get_Event_Counter;
      if Counter = Target.Previous_Event_Counter then
         return;
      end if;
      Target.Previous_Event_Counter := Counter;
      Target.Set_Label ("event_info", "Events:" & Integer'Image (Counter));
      Target.Current.Memory.Stat_Information (Stats);
      Target.Set_Label ("thread_info", "Threads:"
                        & Natural'Image (Stats.Thread_Count));
      Target.Set_Label ("mem_used_info", "Used:"
                        & MAT.Types.Target_Size'Image (Stats.Total_Alloc));
      Target.Set_Label ("mem_free_info", "Free:"
                        & MAT.Types.Target_Size'Image (Stats.Total_Free));
   end Refresh_Process;

end MAT.Targets.Gtkmat;

Implement the Finalize procedure to release some widgets and other data


--  Generated by utildgen.c from system includes
with Interfaces.C;
package Util.Systems.Constants is

   pragma Pure;

   --  Flags used when opening a file with open/creat.
   O_RDONLY                      : constant Interfaces.C.int := 8#000000#;
   O_WRONLY                      : constant Interfaces.C.int := 8#000001#;
   O_RDWR                        : constant Interfaces.C.int := 8#000002#;
   O_CREAT                       : constant Interfaces.C.int := 8#001000#;
   O_EXCL                        : constant Interfaces.C.int := 8#004000#;
   O_TRUNC                       : constant Interfaces.C.int := 8#002000#;
   O_APPEND                      : constant Interfaces.C.int := 8#000010#;
   O_CLOEXEC                     : constant Interfaces.C.int := 8#4000000#;
   O_SYNC                        : constant Interfaces.C.int := 8#000200#;
   O_DIRECT                      : constant Interfaces.C.int := 8#200000#;
   O_NONBLOCK                    : constant Interfaces.C.int := 8#000004#;

   --  Flags used by fcntl
   F_SETFL                       : constant Interfaces.C.int := 4;
   F_GETFL                       : constant Interfaces.C.int := 3;
   FD_CLOEXEC                    : constant Interfaces.C.int := 1;

   --  Flags used by dlopen
   RTLD_LAZY                     : constant Interfaces.C.int := 8#000001#;
   RTLD_NOW                      : constant Interfaces.C.int := 8#000002#;
   RTLD_NOLOAD                   : constant Interfaces.C.int := 8#020000#;
   RTLD_DEEPBIND                 : constant Interfaces.C.int := 8#000000#;
   RTLD_GLOBAL                   : constant Interfaces.C.int := 8#000400#;
   RTLD_LOCAL                    : constant Interfaces.C.int := 8#000000#;
   RTLD_NODELETE                 : constant Interfaces.C.int := 8#010000#;

   DLL_OPTIONS : constant String := "-ldl";

end Util.Systems.Constants;

--  Generated by utildgen.c from system includes
with Interfaces.C;
package Util.Systems.Constants is

   pragma Pure;

   --  Flags used when opening a file with open/creat.
   O_RDONLY                      : constant Interfaces.C.int := 8#000000#;
   O_WRONLY                      : constant Interfaces.C.int := 8#000001#;
   O_RDWR                        : constant Interfaces.C.int := 8#000002#;
   O_CREAT                       : constant Interfaces.C.int := 8#001000#;
   O_EXCL                        : constant Interfaces.C.int := 8#004000#;
   O_TRUNC                       : constant Interfaces.C.int := 8#002000#;
   O_APPEND                      : constant Interfaces.C.int := 8#000010#;
   O_CLOEXEC                     : constant Interfaces.C.int := 8#4000000#;
   O_SYNC                        : constant Interfaces.C.int := 8#000200#;
   O_DIRECT                      : constant Interfaces.C.int := 8#200000#;
   O_NONBLOCK                    : constant Interfaces.C.int := 8#000004#;

   --  Flags used by fcntl
   F_SETFL                       : constant Interfaces.C.int := 4;
   F_GETFL                       : constant Interfaces.C.int := 3;
   FD_CLOEXEC                    : constant Interfaces.C.int := 1;

   --  Flags used by dlopen
   RTLD_LAZY                     : constant Interfaces.C.int := 8#000001#;
   RTLD_NOW                      : constant Interfaces.C.int := 8#000002#;
   RTLD_NOLOAD                   : constant Interfaces.C.int := 8#020000#;
   RTLD_DEEPBIND                 : constant Interfaces.C.int := 8#000000#;
   RTLD_GLOBAL                   : constant Interfaces.C.int := 8#000400#;
   RTLD_LOCAL                    : constant Interfaces.C.int := 8#000000#;
   RTLD_NODELETE                 : constant Interfaces.C.int := 8#010000#;

   DLL_OPTIONS   : constant String := "-ldl";
   SYMBOL_PREFIX : constant String := "";

end Util.Systems.Constants;

Declare SYMBOL_PREFIX

Declare SYMBOL_PREFIX