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

with Security.Permissions;

with ADO;
with ASF.Parts;
with AWA.Modules;
with AWA.Modules.Lifecycles;

with AWA.Storages.Models;
with AWA.Storages.Stores;
with AWA.Storages.Stores.Databases;

--  == Storage Service ==
--  The <tt>Storage_Service</tt> provides the operations to access and use the persisent storage.
--  It controls the permissions that grant access to the service for users.
--
--  Other modules can be notified of storage changes by registering a listener
--  on the storage module.
--
--  @include awa-storages-stores.ads
package AWA.Storages.Services is

   package ACL_Create_Storage is new Security.Permissions.Definition ("storage-create");
   package ACL_Delete_Storage is new Security.Permissions.Definition ("storage-delete");
   package ACL_Create_Folder is new Security.Permissions.Definition ("folder-create");

   type Read_Mode is (READ, WRITE);

   type Expire_Type is (ONE_HOUR, ONE_DAY, TWO_DAYS, ONE_WEEK, ONE_YEAR, NEVER);

   package Storage_Lifecycle is
     new AWA.Modules.Lifecycles (Element_Type => AWA.Storages.Models.Storage_Ref'Class);

   subtype Listener is Storage_Lifecycle.Listener;

   --  ------------------------------
   --  Storage Service
   --  ------------------------------
   --  The Storage_Service defines a set of operations to store and retrieve
   --  a data object from the persistent storage.  The data object is treated as a raw
   --  byte stream.  The persistent storage can be implemented by a database, a file
   --  system or a remote service such as Amazon AWS.
   type Storage_Service is new AWA.Modules.Module_Manager with private;
   type Storage_Service_Access is access all Storage_Service'Class;

   --  Initializes the storage service.
   overriding
   procedure Initialize (Service : in out Storage_Service;
                         Module  : in AWA.Modules.Module'Class);

   --  Get the persistent store that manages the data store identified by <tt>Kind</tt>.
   function Get_Store (Service : in Storage_Service;
                       Kind    : in AWA.Storages.Models.Storage_Type)
                       return AWA.Storages.Stores.Store_Access;

   --  Create or save the folder.
   procedure Save_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class);

   --  Load the folder instance identified by the given identifier.
   procedure Load_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class;
                          Id      : in ADO.Identifier);

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Data    : in ASF.Parts.Part'Class;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Save the file pointed to by the Path string in the storage
   --  object represented by Into and managed by the storage service.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Load the storage instance identified by the given identifier.
   procedure Load_Storage (Service : in Storage_Service;
                           Storage : in out AWA.Storages.Models.Storage_Ref'Class;
                           Id      : in ADO.Identifier);

   --  Load the storage content identified by From into the blob descriptor Into.
   --  Raises the NOT_FOUND exception if there is no such storage.
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Name    : out Ada.Strings.Unbounded.Unbounded_String;
                   Mime    : out Ada.Strings.Unbounded.Unbounded_String;
                   Date    : out Ada.Calendar.Time;
                   Into    : out ADO.Blob_Ref);

   --  Load the storage content into a file.  If the data is not stored in a file, a temporary
   --  file is created with the data content fetched from the store (ex: the database).
   --  The `Mode` parameter indicates whether the file will be read or written.
   --  The `Expire` parameter allows to control the expiration of the temporary file.
   procedure Get_Local_File (Service : in Storage_Service;
                             From    : in ADO.Identifier;
                             Mode    : in Read_Mode := READ;
                             Into    : out Storage_File);

   procedure Create_Local_File (Service : in Storage_Service;
                                Into    : out Storage_File);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in out AWA.Storages.Models.Storage_Ref'Class);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in ADO.Identifier);

private

   type Store_Access_Array is
     array (AWA.Storages.Models.Storage_Type) of AWA.Storages.Stores.Store_Access;

   type Storage_Service is new AWA.Modules.Module_Manager with record
      Stores         : Store_Access_Array;
      Database_Store : aliased AWA.Storages.Stores.Databases.Database_Store;
   end record;

end AWA.Storages.Services;

-----------------------------------------------------------------------
--  awa-storages-services -- Storage service
--  Copyright (C) 2012, 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.Calendar;
with Ada.Strings.Unbounded;

with Security.Permissions;

with ADO;
with ASF.Parts;
with AWA.Modules;
with AWA.Modules.Lifecycles;

with AWA.Storages.Models;
with AWA.Storages.Stores;
with AWA.Storages.Stores.Databases;

--  == Storage Service ==
--  The <tt>Storage_Service</tt> provides the operations to access and use the persisent storage.
--  It controls the permissions that grant access to the service for users.
--
--  Other modules can be notified of storage changes by registering a listener
--  on the storage module.
--
--  @include awa-storages-stores.ads
package AWA.Storages.Services is

   package ACL_Create_Storage is new Security.Permissions.Definition ("storage-create");
   package ACL_Delete_Storage is new Security.Permissions.Definition ("storage-delete");
   package ACL_Create_Folder is new Security.Permissions.Definition ("folder-create");

   type Read_Mode is (READ, WRITE);

   type Expire_Type is (ONE_HOUR, ONE_DAY, TWO_DAYS, ONE_WEEK, ONE_YEAR, NEVER);

   package Storage_Lifecycle is
     new AWA.Modules.Lifecycles (Element_Type => AWA.Storages.Models.Storage_Ref'Class);

   subtype Listener is Storage_Lifecycle.Listener;

   --  ------------------------------
   --  Storage Service
   --  ------------------------------
   --  The Storage_Service defines a set of operations to store and retrieve
   --  a data object from the persistent storage.  The data object is treated as a raw
   --  byte stream.  The persistent storage can be implemented by a database, a file
   --  system or a remote service such as Amazon AWS.
   type Storage_Service is new AWA.Modules.Module_Manager with private;
   type Storage_Service_Access is access all Storage_Service'Class;

   --  Initializes the storage service.
   overriding
   procedure Initialize (Service : in out Storage_Service;
                         Module  : in AWA.Modules.Module'Class);

   --  Get the persistent store that manages the data store identified by <tt>Kind</tt>.
   function Get_Store (Service : in Storage_Service;
                       Kind    : in AWA.Storages.Models.Storage_Type)
                       return AWA.Storages.Stores.Store_Access;

   --  Create or save the folder.
   procedure Save_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class);

   --  Load the folder instance identified by the given identifier.
   procedure Load_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class;
                          Id      : in ADO.Identifier);

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Data    : in ASF.Parts.Part'Class;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Save the file described File in the storage
   --  object represented by Into and managed by the storage service.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   File    : in AWA.Storages.Storage_File;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Save the file pointed to by the Path string in the storage
   --  object represented by Into and managed by the storage service.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Load the storage instance identified by the given identifier.
   procedure Load_Storage (Service : in Storage_Service;
                           Storage : in out AWA.Storages.Models.Storage_Ref'Class;
                           Id      : in ADO.Identifier);

   --  Load the storage content identified by From into the blob descriptor Into.
   --  Raises the NOT_FOUND exception if there is no such storage.
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Name    : out Ada.Strings.Unbounded.Unbounded_String;
                   Mime    : out Ada.Strings.Unbounded.Unbounded_String;
                   Date    : out Ada.Calendar.Time;
                   Into    : out ADO.Blob_Ref);

   --  Load the storage content into a file.  If the data is not stored in a file, a temporary
   --  file is created with the data content fetched from the store (ex: the database).
   --  The `Mode` parameter indicates whether the file will be read or written.
   --  The `Expire` parameter allows to control the expiration of the temporary file.
   procedure Get_Local_File (Service : in Storage_Service;
                             From    : in ADO.Identifier;
                             Mode    : in Read_Mode := READ;
                             Into    : out Storage_File);

   procedure Create_Local_File (Service : in Storage_Service;
                                Into    : out Storage_File);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in out AWA.Storages.Models.Storage_Ref'Class);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in ADO.Identifier);

private

   type Store_Access_Array is
     array (AWA.Storages.Models.Storage_Type) of AWA.Storages.Stores.Store_Access;

   type Storage_Service is new AWA.Modules.Module_Manager with record
      Stores         : Store_Access_Array;
      Database_Store : aliased AWA.Storages.Stores.Databases.Database_Store;
   end record;

end AWA.Storages.Services;

Declare the Save procedure with a Storage_File type


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

with Bfd.Symbols;
with Bfd.Files;
with Bfd.Constants;

with Util.Refs;

with MAT.Types;
with MAT.Memory.Targets;
package MAT.Symbols.Targets is

   type Symbol_Info is record
      File : Ada.Strings.Unbounded.Unbounded_String;
      Name : Ada.Strings.Unbounded.Unbounded_String;
      Line : Natural;
   end record;

   --  The <tt>Region_Symbols</tt> holds the symbol table associated with the program or
   --  a shared library loaded by the program.  The <tt>Region</tt> indicates
   --  the text segment address of the program or the loaded library.
   type Region_Symbols is new Util.Refs.Ref_Entity with record
      Region     : MAT.Memory.Region_Info;
      Offset     : MAT.Types.Target_Addr;
      File       : Bfd.Files.File_Type;
      Symbols    : Bfd.Symbols.Symbol_Table;
   end record;
   type Region_Symbols_Access is access all Region_Symbols;

   package Region_Symbols_Refs is
     new Util.Refs.References (Region_Symbols, Region_Symbols_Access);

   subtype Region_Symbols_Ref is Region_Symbols_Refs.Ref;

   --  The <tt>Symbols_Maps</tt> keeps a sorted list of symbol tables indexed
   --  by their mapping address.
   use type Region_Symbols_Refs.Ref;
   use type MAT.Types.Target_Addr;
   package Symbols_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Region_Symbols_Ref);

   subtype Symbols_Map is Symbols_Maps.Map;
   subtype Symbols_Cursor is Symbols_Maps.Cursor;

   type Target_Symbols is new Util.Refs.Ref_Entity with record
      File      : Bfd.Files.File_Type;
      Symbols   : Bfd.Symbols.Symbol_Table;
      Libraries : Symbols_Maps.Map;
      Demangle  : Bfd.Demangle_Flags := Bfd.Constants.DMGL_AUTO;
   end record;
   type Target_Symbols_Access is access all Target_Symbols;

   --  Open the binary and load the symbols from that file.
   procedure Open (Symbols : in out Target_Symbols;
                   Path    : in String);

   --  Load the symbols associated with a shared library described by the memory region.
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Region      : in MAT.Memory.Region_Info;
                           Offset_Addr : in MAT.Types.Target_Addr);

   --  Find the nearest source file and line for the given address.
   procedure Find_Nearest_Line (Symbols : in Target_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info);

   package Target_Symbols_Refs is
     new Util.Refs.References (Target_Symbols, Target_Symbols_Access);

   subtype Target_Symbols_Ref is Target_Symbols_Refs.Ref;

end MAT.Symbols.Targets;

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

with Bfd.Symbols;
with Bfd.Files;
with Bfd.Constants;

with Util.Refs;

with MAT.Types;
with MAT.Memory.Targets;
package MAT.Symbols.Targets is

   type Symbol_Info is record
      File : Ada.Strings.Unbounded.Unbounded_String;
      Name : Ada.Strings.Unbounded.Unbounded_String;
      Line : Natural;
   end record;

   --  The <tt>Region_Symbols</tt> holds the symbol table associated with the program or
   --  a shared library loaded by the program.  The <tt>Region</tt> indicates
   --  the text segment address of the program or the loaded library.
   type Region_Symbols is new Util.Refs.Ref_Entity with record
      Region     : MAT.Memory.Region_Info;
      Offset     : MAT.Types.Target_Addr;
      File       : Bfd.Files.File_Type;
      Symbols    : Bfd.Symbols.Symbol_Table;
   end record;
   type Region_Symbols_Access is access all Region_Symbols;

   package Region_Symbols_Refs is
     new Util.Refs.References (Region_Symbols, Region_Symbols_Access);

   subtype Region_Symbols_Ref is Region_Symbols_Refs.Ref;

   --  The <tt>Symbols_Maps</tt> keeps a sorted list of symbol tables indexed
   --  by their mapping address.
   use type Region_Symbols_Refs.Ref;
   use type MAT.Types.Target_Addr;
   package Symbols_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Region_Symbols_Ref);

   subtype Symbols_Map is Symbols_Maps.Map;
   subtype Symbols_Cursor is Symbols_Maps.Cursor;

   type Target_Symbols is new Util.Refs.Ref_Entity with record
      File      : Bfd.Files.File_Type;
      Symbols   : Bfd.Symbols.Symbol_Table;
      Libraries : Symbols_Maps.Map;
      Demangle  : Bfd.Demangle_Flags := Bfd.Constants.DMGL_AUTO;
   end record;
   type Target_Symbols_Access is access all Target_Symbols;

   --  Open the binary and load the symbols from that file.
   procedure Open (Symbols : in out Target_Symbols;
                   Path    : in String);

   --  Load the symbols associated with a shared library described by the memory region.
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Region      : in MAT.Memory.Region_Info;
                           Offset_Addr : in MAT.Types.Target_Addr);

   --  Demangle the symbol.
   procedure Demangle (Symbols : in Target_Symbols;
                       Symbol  : in out Symbol_Info);

   --  Find the nearest source file and line for the given address.
   procedure Find_Nearest_Line (Symbols : in Target_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info);

   package Target_Symbols_Refs is
     new Util.Refs.References (Target_Symbols, Target_Symbols_Access);

   subtype Target_Symbols_Ref is Target_Symbols_Refs.Ref;

end MAT.Symbols.Targets;

Declare the Demangle procedure to demangle a symbol


-----------------------------------------------------------------------
--  ado-statements-tests -- Test statements package
--  Copyright (C) 2015, 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.Tests;
package ADO.Statements.Tests is

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

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

   --  Test creation of several rows in test_table with different column type.
   procedure Test_Save (T : in out Test);

   --  Test queries using the $entity_type[] cache group.
   procedure Test_Entity_Types (T : in out Test);

   --  Test executing a SQL query and getting an invalid column.
   procedure Test_Invalid_Column (T : in out Test);

end ADO.Statements.Tests;

-----------------------------------------------------------------------
--  ado-statements-tests -- Test statements package
--  Copyright (C) 2015, 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.Tests;
package ADO.Statements.Tests is

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

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

   --  Test creation of several rows in test_table with different column type.
   procedure Test_Save (T : in out Test);

   --  Test queries using the $entity_type[] cache group.
   procedure Test_Entity_Types (T : in out Test);

   --  Test executing a SQL query and getting an invalid column.
   procedure Test_Invalid_Column (T : in out Test);

   --  Test executing a SQL query and getting an invalid value.
   procedure Test_Invalid_Type (T : in out Test);

end ADO.Statements.Tests;

Declare the Test_Invalid_Type procedure

Declare the Test_Invalid_Type procedure


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

with Util.Log.Loggers;
with Util.Test_Caller;
with Util.Files;
with Util.Streams.Pipes;
with Util.Streams.Buffered;
with Util.Streams.Texts;
with Util.Systems.Os;
package body Util.Processes.Tests is

   use Util.Log;

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

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Processes.Is_Running",
                       Test_No_Process'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn/Wait/Get_Exit_Status",
                       Test_Spawn'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(READ pipe)",
                       Test_Output_Pipe'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(WRITE pipe)",
                       Test_Input_Pipe'Access);
      if Util.Systems.Os.Directory_Separator /= '\' then
         Caller.Add_Test (Suite, "Test Util.Processes.Spawn(OUTPUT redirect)",
                          Test_Output_Redirect'Access);
      end if;

      Caller.Add_Test (Suite, "Test Util.Streams.Pipes.Open/Read/Close (Multi spawn)",
                       Test_Multi_Spawn'Access);

   end Add_Tests;

   --  ------------------------------
   --  Tests when the process is not launched
   --  ------------------------------
   procedure Test_No_Process (T : in out Test) is
      P : Process;
   begin
      T.Assert (not P.Is_Running, "Process should not be running");
      T.Assert (P.Get_Pid < 0, "Invalid process id");
   end Test_No_Process;

   --  ------------------------------
   --  Test executing a process
   --  ------------------------------
   procedure Test_Spawn (T : in out Test) is
      P : Process;
   begin
      --  Launch the test process => exit code 2
      P.Spawn ("bin/util_test_process");
      T.Assert (P.Is_Running, "Process is running");
      P.Wait;
      T.Assert (not P.Is_Running, "Process has stopped");
      T.Assert (P.Get_Pid > 0, "Invalid process id");
      Util.Tests.Assert_Equals (T, 2, P.Get_Exit_Status, "Invalid exit status");

      --  Launch the test process => exit code 0
      P.Spawn ("bin/util_test_process 0 write b c d e f");
      T.Assert (P.Is_Running, "Process is running");
      P.Wait;
      T.Assert (not P.Is_Running, "Process has stopped");
      T.Assert (P.Get_Pid > 0, "Invalid process id");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Invalid exit status");
   end Test_Spawn;

   --  ------------------------------
   --  Test output pipe redirection: read the process standard output
   --  ------------------------------
   procedure Test_Output_Pipe (T : in out Test) is
      P : aliased Util.Streams.Pipes.Pipe_Stream;
   begin
      P.Open ("bin/util_test_process 0 write b c d e f test_marker");
      declare
         Buffer  : Util.Streams.Buffered.Buffered_Stream;
         Content : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Buffer.Initialize (null, P'Unchecked_Access, 19);
         Buffer.Read (Content);
         P.Close;
         Util.Tests.Assert_Matches (T, "b\s+c\s+d\s+e\s+f\s+test_marker\s+", Content,
                                    "Invalid content");
      end;
      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Invalid exit status");
   end Test_Output_Pipe;

   --  ------------------------------
   --  Test input pipe redirection: write the process standard input
   --  At the same time, read the process standard output.
   --  ------------------------------
   procedure Test_Input_Pipe (T : in out Test) is
      P : aliased Util.Streams.Pipes.Pipe_Stream;
   begin
      P.Open ("bin/util_test_process 0 read -", READ_WRITE);
      declare
         Buffer  : Util.Streams.Buffered.Buffered_Stream;
         Content : Ada.Strings.Unbounded.Unbounded_String;
         Print   : Util.Streams.Texts.Print_Stream;
      begin
         --  Write on the process input stream.
         Print.Initialize (P'Unchecked_Access);
         Print.Write ("Write test on the input pipe");
         Print.Close;

         --  Read the output.
         Buffer.Initialize (null, P'Unchecked_Access, 19);
         Buffer.Read (Content);

         --  Wait for the process to finish.
         P.Close;

         Util.Tests.Assert_Matches (T, "Write test on the input pipe-\s", Content,
                                    "Invalid content");
      end;
      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Invalid exit status");
   end Test_Input_Pipe;

   --  ------------------------------
   --  Test launching several processes through pipes in several threads.
   --  ------------------------------
   procedure Test_Multi_Spawn (T : in out Test) is
      Task_Count    : constant Natural := 8;
      Count_By_Task : constant Natural := 10;

      type State_Array is array (1 .. Task_Count) of Boolean;

      States : State_Array;
   begin
      declare
         task type Worker is
            entry Start (Count : in Natural);
            entry Result (Status : out Boolean);
         end Worker;

         task body Worker is
            Cnt   : Natural;
            State : Boolean := True;
         begin
            accept Start (Count : in Natural) do
               Cnt := Count;
            end Start;
            declare
               type Pipe_Array is array (1 .. Cnt) of aliased Util.Streams.Pipes.Pipe_Stream;

               Pipes : Pipe_Array;
            begin
               --  Launch the processes.
               --  They will print their arguments on stdout, one by one on each line.
               --  The expected exit status is the first argument.
               for I in 1 .. Cnt loop
                  Pipes (I).Open ("bin/util_test_process 0 write b c d e f test_marker");
               end loop;

               --  Read their output
               for I in 1 .. Cnt loop
                  declare
                     Buffer  : Util.Streams.Buffered.Buffered_Stream;
                     Content : Ada.Strings.Unbounded.Unbounded_String;
                  begin
                     Buffer.Initialize (null, Pipes (I)'Unchecked_Access, 19);
                     Buffer.Read (Content);
                     Pipes (I).Close;

                     --  Check status and output.
                     State := State and Pipes (I).Get_Exit_Status = 0;
                     State := State and Ada.Strings.Unbounded.Index (Content, "test_marker") > 0;
                  end;
               end loop;

            exception
               when E : others =>
                  Log.Error ("Exception raised", E);
                  State := False;
            end;

            accept Result (Status : out Boolean) do
               Status := State;
            end Result;
         end Worker;

         type Worker_Array is array (1 .. Task_Count) of Worker;

         Tasks : Worker_Array;
      begin
         for I in Tasks'Range loop
            Tasks (I).Start (Count_By_Task);
         end loop;

         --  Get the results (do not raise any assertion here because we have to call
         --  'Result' to ensure the thread terminates.
         for I in Tasks'Range loop
            Tasks (I).Result (States (I));
         end loop;

         --  Leaving the Worker task scope means we are waiting for our tasks to finish.
      end;

      for I in States'Range loop
         T.Assert (States (I), "Task " & Natural'Image (I) & " failed");
      end loop;
   end Test_Multi_Spawn;

   --  ------------------------------
   --  Test output file redirection.
   --  ------------------------------
   procedure Test_Output_Redirect (T : in out Test) is
      P       : Process;
      Path    : constant String := Util.Tests.Get_Test_Path ("proc-output.txt");
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Util.Processes.Set_Output_Stream (P, Path);
      Util.Processes.Spawn (P, "bin/util_test_process 0 write b c d e f test_marker");
      Util.Processes.Wait (P);

      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Process failed");

      Util.Files.Read_File (Path, Content);
      Util.Tests.Assert_Matches (T, ".*test_marker", Content,
                                 "Invalid content");

      Util.Processes.Set_Output_Stream (P, Path, True);
      Util.Processes.Spawn (P, "bin/util_test_process 0 write appended_text");
      Util.Processes.Wait (P);

      Content := Ada.Strings.Unbounded.Null_Unbounded_String;
      Util.Files.Read_File (Path, Content);
      Util.Tests.Assert_Matches (T, ".*appended_text", Content,
                                 "Invalid content");
      Util.Tests.Assert_Matches (T, ".*test_marker.*", Content,
                                 "Invalid content");

   end Test_Output_Redirect;

end Util.Processes.Tests;

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

with Util.Log.Loggers;
with Util.Test_Caller;
with Util.Files;
with Util.Streams.Pipes;
with Util.Streams.Buffered;
with Util.Streams.Texts;
with Util.Systems.Os;
package body Util.Processes.Tests is

   use Util.Log;

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

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Processes.Is_Running",
                       Test_No_Process'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn/Wait/Get_Exit_Status",
                       Test_Spawn'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(READ pipe)",
                       Test_Output_Pipe'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(WRITE pipe)",
                       Test_Input_Pipe'Access);

      pragma Warnings (Off);
      if Util.Systems.Os.Directory_Separator /= '\' then
         Caller.Add_Test (Suite, "Test Util.Processes.Spawn(OUTPUT redirect)",
                          Test_Output_Redirect'Access);
      end if;
      pragma Warnings (On);

      Caller.Add_Test (Suite, "Test Util.Streams.Pipes.Open/Read/Close (Multi spawn)",
                       Test_Multi_Spawn'Access);

   end Add_Tests;

   --  ------------------------------
   --  Tests when the process is not launched
   --  ------------------------------
   procedure Test_No_Process (T : in out Test) is
      P : Process;
   begin
      T.Assert (not P.Is_Running, "Process should not be running");
      T.Assert (P.Get_Pid < 0, "Invalid process id");
   end Test_No_Process;

   --  ------------------------------
   --  Test executing a process
   --  ------------------------------
   procedure Test_Spawn (T : in out Test) is
      P : Process;
   begin
      --  Launch the test process => exit code 2
      P.Spawn ("bin/util_test_process");
      T.Assert (P.Is_Running, "Process is running");
      P.Wait;
      T.Assert (not P.Is_Running, "Process has stopped");
      T.Assert (P.Get_Pid > 0, "Invalid process id");
      Util.Tests.Assert_Equals (T, 2, P.Get_Exit_Status, "Invalid exit status");

      --  Launch the test process => exit code 0
      P.Spawn ("bin/util_test_process 0 write b c d e f");
      T.Assert (P.Is_Running, "Process is running");
      P.Wait;
      T.Assert (not P.Is_Running, "Process has stopped");
      T.Assert (P.Get_Pid > 0, "Invalid process id");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Invalid exit status");
   end Test_Spawn;

   --  ------------------------------
   --  Test output pipe redirection: read the process standard output
   --  ------------------------------
   procedure Test_Output_Pipe (T : in out Test) is
      P : aliased Util.Streams.Pipes.Pipe_Stream;
   begin
      P.Open ("bin/util_test_process 0 write b c d e f test_marker");
      declare
         Buffer  : Util.Streams.Buffered.Buffered_Stream;
         Content : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Buffer.Initialize (null, P'Unchecked_Access, 19);
         Buffer.Read (Content);
         P.Close;
         Util.Tests.Assert_Matches (T, "b\s+c\s+d\s+e\s+f\s+test_marker\s+", Content,
                                    "Invalid content");
      end;
      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Invalid exit status");
   end Test_Output_Pipe;

   --  ------------------------------
   --  Test input pipe redirection: write the process standard input
   --  At the same time, read the process standard output.
   --  ------------------------------
   procedure Test_Input_Pipe (T : in out Test) is
      P : aliased Util.Streams.Pipes.Pipe_Stream;
   begin
      P.Open ("bin/util_test_process 0 read -", READ_WRITE);
      declare
         Buffer  : Util.Streams.Buffered.Buffered_Stream;
         Content : Ada.Strings.Unbounded.Unbounded_String;
         Print   : Util.Streams.Texts.Print_Stream;
      begin
         --  Write on the process input stream.
         Print.Initialize (P'Unchecked_Access);
         Print.Write ("Write test on the input pipe");
         Print.Close;

         --  Read the output.
         Buffer.Initialize (null, P'Unchecked_Access, 19);
         Buffer.Read (Content);

         --  Wait for the process to finish.
         P.Close;

         Util.Tests.Assert_Matches (T, "Write test on the input pipe-\s", Content,
                                    "Invalid content");
      end;
      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Invalid exit status");
   end Test_Input_Pipe;

   --  ------------------------------
   --  Test launching several processes through pipes in several threads.
   --  ------------------------------
   procedure Test_Multi_Spawn (T : in out Test) is
      Task_Count    : constant Natural := 8;
      Count_By_Task : constant Natural := 10;

      type State_Array is array (1 .. Task_Count) of Boolean;

      States : State_Array;
   begin
      declare
         task type Worker is
            entry Start (Count : in Natural);
            entry Result (Status : out Boolean);
         end Worker;

         task body Worker is
            Cnt   : Natural;
            State : Boolean := True;
         begin
            accept Start (Count : in Natural) do
               Cnt := Count;
            end Start;
            declare
               type Pipe_Array is array (1 .. Cnt) of aliased Util.Streams.Pipes.Pipe_Stream;

               Pipes : Pipe_Array;
            begin
               --  Launch the processes.
               --  They will print their arguments on stdout, one by one on each line.
               --  The expected exit status is the first argument.
               for I in 1 .. Cnt loop
                  Pipes (I).Open ("bin/util_test_process 0 write b c d e f test_marker");
               end loop;

               --  Read their output
               for I in 1 .. Cnt loop
                  declare
                     Buffer  : Util.Streams.Buffered.Buffered_Stream;
                     Content : Ada.Strings.Unbounded.Unbounded_String;
                  begin
                     Buffer.Initialize (null, Pipes (I)'Unchecked_Access, 19);
                     Buffer.Read (Content);
                     Pipes (I).Close;

                     --  Check status and output.
                     State := State and Pipes (I).Get_Exit_Status = 0;
                     State := State and Ada.Strings.Unbounded.Index (Content, "test_marker") > 0;
                  end;
               end loop;

            exception
               when E : others =>
                  Log.Error ("Exception raised", E);
                  State := False;
            end;

            accept Result (Status : out Boolean) do
               Status := State;
            end Result;
         end Worker;

         type Worker_Array is array (1 .. Task_Count) of Worker;

         Tasks : Worker_Array;
      begin
         for I in Tasks'Range loop
            Tasks (I).Start (Count_By_Task);
         end loop;

         --  Get the results (do not raise any assertion here because we have to call
         --  'Result' to ensure the thread terminates.
         for I in Tasks'Range loop
            Tasks (I).Result (States (I));
         end loop;

         --  Leaving the Worker task scope means we are waiting for our tasks to finish.
      end;

      for I in States'Range loop
         T.Assert (States (I), "Task " & Natural'Image (I) & " failed");
      end loop;
   end Test_Multi_Spawn;

   --  ------------------------------
   --  Test output file redirection.
   --  ------------------------------
   procedure Test_Output_Redirect (T : in out Test) is
      P       : Process;
      Path    : constant String := Util.Tests.Get_Test_Path ("proc-output.txt");
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Util.Processes.Set_Output_Stream (P, Path);
      Util.Processes.Spawn (P, "bin/util_test_process 0 write b c d e f test_marker");
      Util.Processes.Wait (P);

      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Process failed");

      Util.Files.Read_File (Path, Content);
      Util.Tests.Assert_Matches (T, ".*test_marker", Content,
                                 "Invalid content");

      Util.Processes.Set_Output_Stream (P, Path, True);
      Util.Processes.Spawn (P, "bin/util_test_process 0 write appended_text");
      Util.Processes.Wait (P);

      Content := Ada.Strings.Unbounded.Null_Unbounded_String;
      Util.Files.Read_File (Path, Content);
      Util.Tests.Assert_Matches (T, ".*appended_text", Content,
                                 "Invalid content");
      Util.Tests.Assert_Matches (T, ".*test_marker.*", Content,
                                 "Invalid content");

   end Test_Output_Redirect;

end Util.Processes.Tests;

Fix compilation warning

Fix compilation warning


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

with Util.Log.Loggers;

with ASF.Navigations;
with ASF.Navigations.Mappers;
with ASF.Servlets.Mappers;
with ASF.Beans.Mappers;

package body ASF.Applications.Main.Configs is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("ASF.Applications.Main.Configs");

   --  ------------------------------
   --  Save in the application config object the value associated with the given field.
   --  When the TAG_MESSAGE_BUNDLE field is reached, insert the new bundle definition
   --  in the application.
   --  ------------------------------
   procedure Set_Member (N     : in out Application_Config;
                         Field : in Application_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when TAG_MESSAGE_VAR =>
            N.Name := Value;

         when TAG_MESSAGE_BUNDLE =>
            declare
               Bundle : constant String := Util.Beans.Objects.To_String (Value);
               Name   : constant String := Util.Beans.Objects.To_String (N.Name);
            begin
               if Name'Length = 0 then
                  N.App.Register (Name   => Bundle & "Msg",
                                  Bundle => Bundle);
               else
                  N.App.Register (Name   => Name,
                                  Bundle => Bundle);
               end if;
            end;

      end case;
   end Set_Member;

   AMapper : aliased Application_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the managed bean definitions.
   --  By instantiating this package, the Reader gets populated with the XML mappings
   --  to read the servlet, managed beans and navigation rules.
   --  ------------------------------
   package body Reader_Config is
      --  Get the navigation handler for the Navigation_Config instantiation
      --  GNAT crashes if the call is made in the instantation part.
      Nav     : constant ASF.Navigations.Navigation_Handler_Access := App.Get_Navigation_Handler;

      package Bean_Config is
        new ASF.Beans.Mappers.Reader_Config (Reader, App.Factory'Access,
                                             Context.all'Access);
      package Navigation_Config is
        new ASF.Navigations.Mappers.Reader_Config (Reader, Nav, Context.all'Access);

      package Servlet_Config is
        new ASF.Servlets.Mappers.Reader_Config (Reader, App.all'Access,
                                                Context.all'Access);
      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Navigation_Config);
      pragma Warnings (Off, Servlet_Config);

      Config : aliased Application_Config;

   begin
      --  Install the property context that gives access
      --  to the application configuration properties
      Prop_Context.Set_Properties (App.Conf);
      Context.Set_Resolver (Prop_Context'Unchecked_Access);

      Reader.Add_Mapping ("faces-config", AMapper'Access);
      Reader.Add_Mapping ("module", AMapper'Access);
      Reader.Add_Mapping ("web-app", AMapper'Access);
      Config.App := App;
      Application_Mapper.Set_Context (Reader, Config'Unchecked_Access);
   end Reader_Config;

   --  ------------------------------
   --  Read the configuration file associated with the application.  This includes:
   --

   --
The servlet and filter mappings

   --
The managed bean definitions

   --
The navigation rules

   --

   --  ------------------------------
   procedure Read_Configuration (App  : in out Application'Class;
                                 File : in String) is

      Reader  : Util.Serialize.IO.XML.Parser;
      Context : aliased EL.Contexts.Default.Default_Context;

      --  Setup the Reader to parse and build the configuration for managed beans,
      --  navigation rules, servlet rules.  Each package instantiation creates a local variable
      --  used while parsing the XML file.
      package Config is
        new Reader_Config (Reader, App'Unchecked_Access, Context'Unchecked_Access);

      pragma Warnings (Off, Config);
   begin
      Log.Info ("Reading module configuration file {0}", File);

      --        Util.Serialize.IO.Dump (Reader, AWA.Modules.Log);

      --  Read the configuration file and record managed beans, navigation rules.
      Reader.Parse (File);
   end Read_Configuration;

   --  ------------------------------
   --  Create the configuration parameter definition instance.
   --  ------------------------------
   package body Parameter is
      PARAM_NAME  : aliased constant String := Name;
      PARAM_VALUE : aliased constant String := Default;
      Param       : constant Config_Param := ASF.Applications.P '(Name => PARAM_NAME'Access,
                                                                  Default => PARAM_VALUE'Access);

      --  ------------------------------
      --  Returns the configuration parameter.
      --  ------------------------------
      function P return Config_Param is
      begin
         return Param;
      end P;

   end Parameter;

begin
   AMapper.Add_Mapping ("application/message-bundle/@var", TAG_MESSAGE_VAR);
   AMapper.Add_Mapping ("application/message-bundle", TAG_MESSAGE_BUNDLE);
end ASF.Applications.Main.Configs;

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

with Util.Log.Loggers;

with ASF.Navigations;
with ASF.Navigations.Mappers;
with ASF.Servlets.Mappers;
with ASF.Beans.Mappers;

package body ASF.Applications.Main.Configs is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("ASF.Applications.Main.Configs");

   --  ------------------------------
   --  Save in the application config object the value associated with the given field.
   --  When the TAG_MESSAGE_BUNDLE field is reached, insert the new bundle definition
   --  in the application.
   --  ------------------------------
   procedure Set_Member (N     : in out Application_Config;
                         Field : in Application_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when TAG_MESSAGE_VAR =>
            N.Name := Value;

         when TAG_MESSAGE_BUNDLE =>
            declare
               Bundle : constant String := Util.Beans.Objects.To_String (Value);
            begin
               if Util.Beans.Objects.Is_Null (N.Name) then
                  N.App.Register (Name   => Bundle & "Msg",
                                  Bundle => Bundle);
               else
                  N.App.Register (Name   => Util.Beans.Objects.To_String (N.Name),
                                  Bundle => Bundle);
               end if;
               N.Name := Util.Beans.Objects.Null_Object;
            end;

      end case;
   end Set_Member;

   AMapper : aliased Application_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the managed bean definitions.
   --  By instantiating this package, the Reader gets populated with the XML mappings
   --  to read the servlet, managed beans and navigation rules.
   --  ------------------------------
   package body Reader_Config is
      --  Get the navigation handler for the Navigation_Config instantiation
      --  GNAT crashes if the call is made in the instantation part.
      Nav     : constant ASF.Navigations.Navigation_Handler_Access := App.Get_Navigation_Handler;

      package Bean_Config is
        new ASF.Beans.Mappers.Reader_Config (Reader, App.Factory'Access,
                                             Context.all'Access);
      package Navigation_Config is
        new ASF.Navigations.Mappers.Reader_Config (Reader, Nav, Context.all'Access);

      package Servlet_Config is
        new ASF.Servlets.Mappers.Reader_Config (Reader, App.all'Access,
                                                Context.all'Access);
      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Navigation_Config);
      pragma Warnings (Off, Servlet_Config);

      Config : aliased Application_Config;

   begin
      --  Install the property context that gives access
      --  to the application configuration properties
      Prop_Context.Set_Properties (App.Conf);
      Context.Set_Resolver (Prop_Context'Unchecked_Access);

      Reader.Add_Mapping ("faces-config", AMapper'Access);
      Reader.Add_Mapping ("module", AMapper'Access);
      Reader.Add_Mapping ("web-app", AMapper'Access);
      Config.App := App;
      Application_Mapper.Set_Context (Reader, Config'Unchecked_Access);
   end Reader_Config;

   --  ------------------------------
   --  Read the configuration file associated with the application.  This includes:
   --

   --
The servlet and filter mappings

   --
The managed bean definitions

   --
The navigation rules

   --

   --  ------------------------------
   procedure Read_Configuration (App  : in out Application'Class;
                                 File : in String) is

      Reader  : Util.Serialize.IO.XML.Parser;
      Context : aliased EL.Contexts.Default.Default_Context;

      --  Setup the Reader to parse and build the configuration for managed beans,
      --  navigation rules, servlet rules.  Each package instantiation creates a local variable
      --  used while parsing the XML file.
      package Config is
        new Reader_Config (Reader, App'Unchecked_Access, Context'Unchecked_Access);

      pragma Warnings (Off, Config);
   begin
      Log.Info ("Reading module configuration file {0}", File);

      --        Util.Serialize.IO.Dump (Reader, AWA.Modules.Log);

      --  Read the configuration file and record managed beans, navigation rules.
      Reader.Parse (File);
   end Read_Configuration;

   --  ------------------------------
   --  Create the configuration parameter definition instance.
   --  ------------------------------
   package body Parameter is
      PARAM_NAME  : aliased constant String := Name;
      PARAM_VALUE : aliased constant String := Default;
      Param       : constant Config_Param := ASF.Applications.P '(Name => PARAM_NAME'Access,
                                                                  Default => PARAM_VALUE'Access);

      --  ------------------------------
      --  Returns the configuration parameter.
      --  ------------------------------
      function P return Config_Param is
      begin
         return Param;
      end P;

   end Parameter;

begin
   AMapper.Add_Mapping ("application/message-bundle/@var", TAG_MESSAGE_VAR);
   AMapper.Add_Mapping ("application/message-bundle", TAG_MESSAGE_BUNDLE);
end ASF.Applications.Main.Configs;

Fix reading configuration and setup of application bundles


------------------------------------------------------------------------------
-- Copyright (c) 2017, 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.           --
------------------------------------------------------------------------------

with Ada.Containers.Doubly_Linked_Lists;

package body Natools.Web.String_Tables is

   package Row_Lists is new Ada.Containers.Doubly_Linked_Lists
     (Containers.Atom_Array_Refs.Immutable_Reference,
      Containers.Atom_Array_Refs."=");

   ------------------
   -- Constructors --
   ------------------

   not overriding function Create
     (Expression : in out S_Expressions.Lockable.Descriptor'Class)
     return String_Table is
   begin
      return String_Table'(Ref => Create (Expression));
   end Create;

   function Create
     (Expression : in out S_Expressions.Lockable.Descriptor'Class)
     return Table_References.Immutable_Reference
   is
      List : Row_Lists.List;
      Event : S_Expressions.Events.Event := Expression.Current_Event;
      Lock : S_Expressions.Lockable.Lock_State;
   begin
      Read_Expression :
      loop
         case Event is
            when S_Expressions.Events.Close_List
              | S_Expressions.Events.End_Of_Input
              | S_Expressions.Events.Error
            =>
               exit Read_Expression;

            when S_Expressions.Events.Add_Atom => null;

            when S_Expressions.Events.Open_List =>
               Expression.Lock (Lock);
               begin
                  Expression.Next (Event);

                  if Event in S_Expressions.Events.Add_Atom
                            | S_Expressions.Events.Open_List
                  then
                     List.Append (Containers.Create (Expression));
                  end if;

                  Expression.Unlock (Lock);
               exception
                  when others =>
                     Expression.Unlock (Lock, False);
                     raise;
               end;
         end case;

         Expression.Next (Event);
      end loop Read_Expression;

      if Row_Lists.Is_Empty (List) then
         return Table_References.Null_Immutable_Reference;
      end if;

      Build_Table :
      declare
         Data : constant Table_References.Data_Access
           := new Table (1 .. S_Expressions.Count (Row_Lists.Length (List)));
         Ref : constant Table_References.Immutable_Reference
           := Table_References.Create (Data);
         Cursor : Row_Lists.Cursor := Row_Lists.First (List);
      begin
         for I in Data.all'Range loop
            Data (I) := Row_Lists.Element (Cursor);
            Row_Lists.Next (Cursor);
         end loop;

         pragma Assert (not Row_Lists.Has_Element (Cursor));

         return Ref;
      end Build_Table;
   end Create;

   ---------------
   -- Renderers --
   ---------------

   overriding procedure Render
     (Exchange : in out Sites.Exchange;
      Object : in String_Table;
      Expression : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Exchange);
      pragma Unreferenced (Object);
      pragma Unreferenced (Expression);
   begin
      raise Program_Error with "Not implemented yet";
   end Render;

end Natools.Web.String_Tables;

------------------------------------------------------------------------------
-- Copyright (c) 2017, 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.           --
------------------------------------------------------------------------------

with Ada.Containers.Doubly_Linked_Lists;
with Natools.S_Expressions.Interpreter_Loop;

package body Natools.Web.String_Tables is

   package Row_Lists is new Ada.Containers.Doubly_Linked_Lists
     (Containers.Atom_Array_Refs.Immutable_Reference,
      Containers.Atom_Array_Refs."=");

   procedure Append
     (Exchange : in out Sites.Exchange;
      Context : in Containers.Atom_Array_Refs.Immutable_Reference;
      Data : in S_Expressions.Atom);

   procedure Execute
     (Exchange : in out Sites.Exchange;
      Row : in Containers.Atom_Array_Refs.Immutable_Reference;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class);

   procedure Render_Row is new S_Expressions.Interpreter_Loop
     (Sites.Exchange, Containers.Atom_Array_Refs.Immutable_Reference,
      Execute, Append);

   ------------------------
   -- Renderer Fragments --
   ------------------------

   procedure Append
     (Exchange : in out Sites.Exchange;
      Context : in Containers.Atom_Array_Refs.Immutable_Reference;
      Data : in S_Expressions.Atom)
   is
      pragma Unreferenced (Context);
   begin
      Exchange.Append (Data);
   end Append;

   procedure Execute
     (Exchange : in out Sites.Exchange;
      Row : in Containers.Atom_Array_Refs.Immutable_Reference;
      Name : in S_Expressions.Atom;
      Arguments : in out S_Expressions.Lockable.Descriptor'Class)
   is
      pragma Unreferenced (Arguments);

      Column : S_Expressions.Offset;
      S_Name : constant String := S_Expressions.To_String (Name);
   begin
      To_Column :
      begin
         if S_Name'Length > 6
           and then S_Name (S_Name'First .. S_Name'First + 5) = "value-"
         then
            Column := S_Expressions.Offset'Value
              (S_Name (S_Name'First + 6 .. S_Name'Last));
         else
            Column := S_Expressions.Offset'Value (S_Name);
         end if;
      exception
         when Constraint_Error =>
            Log (Severities.Error, "Invalid row command """ & S_Name & '"');
            return;
      end To_Column;

      declare
         Atoms : constant Containers.Atom_Array_Refs.Accessor := Row.Query;
      begin
         if Column in Atoms.Data'Range then
            Exchange.Append (Atoms (Column).Query);
         else
            Log
              (Severities.Error,
               "Column"
               & S_Expressions.Offset'Image (Column)
               & " not in row range"
               & S_Expressions.Offset'Image (Atoms.Data'First)
               & " .."
               & S_Expressions.Offset'Image (Atoms.Data'Last));
         end if;
      end;
   end Execute;

   ------------------
   -- Constructors --
   ------------------

   not overriding function Create
     (Expression : in out S_Expressions.Lockable.Descriptor'Class)
     return String_Table is
   begin
      return String_Table'(Ref => Create (Expression));
   end Create;

   function Create
     (Expression : in out S_Expressions.Lockable.Descriptor'Class)
     return Table_References.Immutable_Reference
   is
      List : Row_Lists.List;
      Event : S_Expressions.Events.Event := Expression.Current_Event;
      Lock : S_Expressions.Lockable.Lock_State;
   begin
      Read_Expression :
      loop
         case Event is
            when S_Expressions.Events.Close_List
              | S_Expressions.Events.End_Of_Input
              | S_Expressions.Events.Error
            =>
               exit Read_Expression;

            when S_Expressions.Events.Add_Atom => null;

            when S_Expressions.Events.Open_List =>
               Expression.Lock (Lock);
               begin
                  Expression.Next (Event);

                  if Event in S_Expressions.Events.Add_Atom
                            | S_Expressions.Events.Open_List
                  then
                     List.Append (Containers.Create (Expression));
                  end if;

                  Expression.Unlock (Lock);
               exception
                  when others =>
                     Expression.Unlock (Lock, False);
                     raise;
               end;
         end case;

         Expression.Next (Event);
      end loop Read_Expression;

      if Row_Lists.Is_Empty (List) then
         return Table_References.Null_Immutable_Reference;
      end if;

      Build_Table :
      declare
         Data : constant Table_References.Data_Access
           := new Table (1 .. S_Expressions.Count (Row_Lists.Length (List)));
         Ref : constant Table_References.Immutable_Reference
           := Table_References.Create (Data);
         Cursor : Row_Lists.Cursor := Row_Lists.First (List);
      begin
         for I in Data.all'Range loop
            Data (I) := Row_Lists.Element (Cursor);
            Row_Lists.Next (Cursor);
         end loop;

         pragma Assert (not Row_Lists.Has_Element (Cursor));

         return Ref;
      end Build_Table;
   end Create;

   ---------------
   -- Renderers --
   ---------------

   overriding procedure Render
     (Exchange : in out Sites.Exchange;
      Object : in String_Table;
      Expression : in out S_Expressions.Lockable.Descriptor'Class) is
   begin
      for Row of Object.Ref.Query.Data.all loop
         Render_Row (Expression, Exchange, Row);
      end loop;
   end Render;

end Natools.Web.String_Tables;

implement row rendering

string_tables: implement row rendering


--------------------------------------------------------------------------------
-- Copyright (c) 2016 onox <denkpadje@gmail.com>
--
-- Permission to use, copy, modify, and/or 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.
--------------------------------------------------------------------------------

with GL.Low_Level;

package GL.Objects.Queries is
   pragma Preelaborate;

   type Query_Type is (Time_Elapsed,
                       Samples_Passed, Any_Samples_Passed,
                       Primitives_Generated,
                       Transform_Feedback_Primitives_Written,
                       Any_Samples_Passed_Conservative,
                       Timestamp);

   --  Has to be defined here because of the subtype declaration below
   for Query_Type use (Time_Elapsed                          => 16#88BF#,
                       Samples_Passed                        => 16#8914#,
                       Any_Samples_Passed                    => 16#8C2F#,
                       Primitives_Generated                  => 16#8C87#,
                       Transform_Feedback_Primitives_Written => 16#8C88#,
                       Any_Samples_Passed_Conservative       => 16#8D6A#,
                       Timestamp                             => 16#8E28#);
   for Query_Type'Size use Low_Level.Enum'Size;

   subtype Async_Query_Type is Query_Type range Time_Elapsed .. Any_Samples_Passed_Conservative;

   subtype Timestamp_Query_Type is Query_Type range Timestamp .. Timestamp;

   subtype Primitive_Query_Type is Query_Type
     with Static_Predicate =>
       Primitive_Query_Type in Primitives_Generated | Transform_Feedback_Primitives_Written;

   subtype Occlusion_Query_Type is Query_Type
     with Static_Predicate =>
       Occlusion_Query_Type in Samples_Passed | Any_Samples_Passed | Any_Samples_Passed_Conservative;

   subtype Time_Query_Type is Query_Type
     with Static_Predicate => Time_Query_Type = Time_Elapsed;

   type Query_Mode is (Wait, No_Wait, By_Region_Wait, By_Region_No_Wait);

   type Query_Param is (Result, Result_Available, Result_No_Wait);

   type Target_Param is (Counter_Bits, Current_Query);

   type Query is new GL_Object with private;

   overriding
   procedure Initialize_Id (Object : in out Query);

   overriding
   procedure Delete_Id (Object : in out Query);

   type Active_Query is limited new Ada.Finalization.Limited_Controlled with private;

   type Conditional_Render is limited new Ada.Finalization.Limited_Controlled with private;

   function Begin_Primitive_Query (Object : in out Query;
                                   Target : in     Primitive_Query_Type;
                                   Index  : in     Natural := 0)
     return Active_Query'Class;
   --  Start a primitive query. The value returned is of a controlled
   --  type, meaning you must assign it to some local variable, so that
   --  the query will be automatically ended when the variable goes out
   --  of scope.
   --
   --  Primitive queries support multiple query operations; one for each
   --  index. The index represents the vertex output stream used in a
   --  Geometry Shader. If the target type is
   --  Transform_Feedback_Primitives_Written, then the query should be
   --  issued while within a transform feedback scope.

   function Begin_Occlusion_Query (Object : in out Query;
                                   Target : in     Occlusion_Query_Type)
     return Active_Query'Class;
   --  Start an occlusion query. The value returned is of a controlled
   --  type, meaning you must assign it to some local variable, so that
   --  the query will be automatically ended when the variable goes out
   --  of scope.

   function Begin_Timer_Query (Object : in out Query;
                               Target : in     Time_Query_Type)
     return Active_Query'Class;
   --  Start a timer query. The value returned is of a controlled
   --  type, meaning you must assign it to some local variable, so that
   --  the query will be automatically ended when the variable goes out
   --  of scope.
   --
   --  This function is used only for queries of type Time_Elapsed.
   --  Queries of type Timestamp are not used within a scope. For such
   --  a query you can record the time into the query object by calling
   --  Record_Current_Time.

   function Begin_Conditional_Render (Object : in out Query;
                                      Mode   : in     Query_Mode)
     return Conditional_Render'Class;
   --  Start a conditional rendering. The value returned is of a controlled
   --  type, meaning you must assign it to some local variable, so that
   --  the rendering will be automatically ended when the variable goes
   --  out of scope.

   function Result_Available (Object : in out Query) return Boolean;
   --  Return true if a result is available, false otherwise. This function
   --  can be used to avoid calling Result (and thereby stalling the CPU)
   --  when the result is not yet available.

   function Result_If_Available (Object : in out Query; Default_Value : Boolean)
     return Boolean;
   --  Return the result if available, otherwise return the default value

   function Result_If_Available (Object : in out Query; Default_Value : Natural)
     return Natural;
   --  Return the result if available, otherwise return the default value

   function Result (Object : in out Query) return Boolean;
   --  Return the result. If the result is not yet available, then the
   --  CPU will stall until the result becomes available. This means
   --  that if you do not call Result_Available, then this function call
   --  will make the query synchronous.

   function Result (Object : in out Query) return Natural;
   --  Return the result. If the result is not yet available, then the
   --  CPU will stall until the result becomes available. This means
   --  that if you do not call Result_Available, then this function call
   --  will make the query synchronous.

   function Result_Bits (Target : in Query_Type) return Natural;

   procedure Record_Current_Time (Object : in out Query);
   --  Record the time when the GPU has completed all previous commands
   --  in a query object. The result must be retrieved asynchronously using
   --  one of the Result functions.

   function Get_Current_Time return Long;
   --  Return the time when the GPU has received (but not necessarily
   --  completed) all previous commands. Calling this function stalls the CPU.

private

   for Query_Mode use (Wait              => 16#8E13#,
                       No_Wait           => 16#8E14#,
                       By_Region_Wait    => 16#8E15#,
                       By_Region_No_Wait => 16#8E16#);
   for Query_Mode'Size use Low_Level.Enum'Size;

   for Target_Param use (Counter_Bits  => 16#8864#,
                         Current_Query => 16#8865#);
   for Target_Param'Size use Low_Level.Enum'Size;

   for Query_Param use (Result           => 16#8866#,
                        Result_Available => 16#8867#,
                        Result_No_Wait   => 16#9194#);
   for Query_Param'Size use Low_Level.Enum'Size;

   type Query is new GL_Object with null record;

   type Active_Query is limited new Ada.Finalization.Limited_Controlled with record
     Target : Query_Type;
     Index  : Natural;
     Finalized : Boolean := True;
   end record;

   overriding
   procedure Finalize (Object : in out Active_Query);

   type Conditional_Render is limited new Ada.Finalization.Limited_Controlled with record
     Finalized : Boolean := True;
   end record;

   overriding
   procedure Finalize (Object : in out Conditional_Render);

end GL.Objects.Queries;

--------------------------------------------------------------------------------
-- Copyright (c) 2016 onox <denkpadje@gmail.com>
--
-- Permission to use, copy, modify, and/or 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.
--------------------------------------------------------------------------------

with GL.Low_Level;

package GL.Objects.Queries is
   pragma Preelaborate;

   type Query_Type is (Time_Elapsed,
                       Samples_Passed, Any_Samples_Passed,
                       Primitives_Generated,
                       Transform_Feedback_Primitives_Written,
                       Any_Samples_Passed_Conservative,
                       Timestamp);

   --  Has to be defined here because of the subtype declaration below
   for Query_Type use (Time_Elapsed                          => 16#88BF#,
                       Samples_Passed                        => 16#8914#,
                       Any_Samples_Passed                    => 16#8C2F#,
                       Primitives_Generated                  => 16#8C87#,
                       Transform_Feedback_Primitives_Written => 16#8C88#,
                       Any_Samples_Passed_Conservative       => 16#8D6A#,
                       Timestamp                             => 16#8E28#);
   for Query_Type'Size use Low_Level.Enum'Size;

   subtype Async_Query_Type is Query_Type range Time_Elapsed .. Any_Samples_Passed_Conservative;

   subtype Timestamp_Query_Type is Query_Type range Timestamp .. Timestamp;

   subtype Primitive_Query_Type is Query_Type
     with Static_Predicate =>
       Primitive_Query_Type in Primitives_Generated | Transform_Feedback_Primitives_Written;

   subtype Occlusion_Query_Type is Query_Type
     with Static_Predicate =>
       Occlusion_Query_Type in Samples_Passed | Any_Samples_Passed | Any_Samples_Passed_Conservative;

   subtype Time_Query_Type is Query_Type
     with Static_Predicate => Time_Query_Type = Time_Elapsed;

   type Query_Mode is (Wait, No_Wait, By_Region_Wait, By_Region_No_Wait,
                       Wait_Inverted, No_Wait_Inverted, By_Region_Wait_Inverted,
                       By_Region_No_Wait_Inverted);

   type Query_Param is (Result, Result_Available, Result_No_Wait);

   type Target_Param is (Counter_Bits, Current_Query);

   type Query is new GL_Object with private;

   overriding
   procedure Initialize_Id (Object : in out Query);

   overriding
   procedure Delete_Id (Object : in out Query);

   type Active_Query is limited new Ada.Finalization.Limited_Controlled with private;

   type Conditional_Render is limited new Ada.Finalization.Limited_Controlled with private;

   function Begin_Primitive_Query (Object : in out Query;
                                   Target : in     Primitive_Query_Type;
                                   Index  : in     Natural := 0)
     return Active_Query'Class;
   --  Start a primitive query. The value returned is of a controlled
   --  type, meaning you must assign it to some local variable, so that
   --  the query will be automatically ended when the variable goes out
   --  of scope.
   --
   --  Primitive queries support multiple query operations; one for each
   --  index. The index represents the vertex output stream used in a
   --  Geometry Shader. If the target type is
   --  Transform_Feedback_Primitives_Written, then the query should be
   --  issued while within a transform feedback scope.

   function Begin_Occlusion_Query (Object : in out Query;
                                   Target : in     Occlusion_Query_Type)
     return Active_Query'Class;
   --  Start an occlusion query. The value returned is of a controlled
   --  type, meaning you must assign it to some local variable, so that
   --  the query will be automatically ended when the variable goes out
   --  of scope.

   function Begin_Timer_Query (Object : in out Query;
                               Target : in     Time_Query_Type)
     return Active_Query'Class;
   --  Start a timer query. The value returned is of a controlled
   --  type, meaning you must assign it to some local variable, so that
   --  the query will be automatically ended when the variable goes out
   --  of scope.
   --
   --  This function is used only for queries of type Time_Elapsed.
   --  Queries of type Timestamp are not used within a scope. For such
   --  a query you can record the time into the query object by calling
   --  Record_Current_Time.

   function Begin_Conditional_Render (Object : in out Query;
                                      Mode   : in     Query_Mode)
     return Conditional_Render'Class;
   --  Start a conditional rendering. The value returned is of a controlled
   --  type, meaning you must assign it to some local variable, so that
   --  the rendering will be automatically ended when the variable goes
   --  out of scope.
   --
   --  If Mode is (By_Region_)Wait, then OpenGL will wait until the result
   --  becomes available and uses the value of the result to determine
   --  whether to execute or discard rendering commands.
   --
   --  If Mode is *_Inverted, then the condition is inverted, meaning it
   --  will execute rendering commands if the query result is zero/false.
   --
   --  If Mode is (By_Region_)No_Wait(_Inverted), then OpenGL may choose
   --  to execute rendering commands while the result of the query is not
   --  available.

   function Result_Available (Object : in out Query) return Boolean;
   --  Return true if a result is available, false otherwise. This function
   --  can be used to avoid calling Result (and thereby stalling the CPU)
   --  when the result is not yet available.

   function Result_If_Available (Object : in out Query; Default_Value : Boolean)
     return Boolean;
   --  Return the result if available, otherwise return the default value

   function Result_If_Available (Object : in out Query; Default_Value : Natural)
     return Natural;
   --  Return the result if available, otherwise return the default value

   function Result (Object : in out Query) return Boolean;
   --  Return the result. If the result is not yet available, then the
   --  CPU will stall until the result becomes available. This means
   --  that if you do not call Result_Available, then this function call
   --  will make the query synchronous.

   function Result (Object : in out Query) return Natural;
   --  Return the result. If the result is not yet available, then the
   --  CPU will stall until the result becomes available. This means
   --  that if you do not call Result_Available, then this function call
   --  will make the query synchronous.

   function Result_Bits (Target : in Query_Type) return Natural;

   procedure Record_Current_Time (Object : in out Query);
   --  Record the time when the GPU has completed all previous commands
   --  in a query object. The result must be retrieved asynchronously using
   --  one of the Result functions.

   function Get_Current_Time return Long;
   --  Return the time when the GPU has received (but not necessarily
   --  completed) all previous commands. Calling this function stalls the CPU.

private

   for Query_Mode use (Wait                       => 16#8E13#,
                       No_Wait                    => 16#8E14#,
                       By_Region_Wait             => 16#8E15#,
                       By_Region_No_Wait          => 16#8E16#,
                       Wait_Inverted              => 16#8E17#,
                       No_Wait_Inverted           => 16#8E18#,
                       By_Region_Wait_Inverted    => 16#8E19#,
                       By_Region_No_Wait_Inverted => 16#8E1A#);
   for Query_Mode'Size use Low_Level.Enum'Size;

   for Target_Param use (Counter_Bits  => 16#8864#,
                         Current_Query => 16#8865#);
   for Target_Param'Size use Low_Level.Enum'Size;

   for Query_Param use (Result           => 16#8866#,
                        Result_Available => 16#8867#,
                        Result_No_Wait   => 16#9194#);
   for Query_Param'Size use Low_Level.Enum'Size;

   type Query is new GL_Object with null record;

   type Active_Query is limited new Ada.Finalization.Limited_Controlled with record
     Target : Query_Type;
     Index  : Natural;
     Finalized : Boolean := True;
   end record;

   overriding
   procedure Finalize (Object : in out Active_Query);

   type Conditional_Render is limited new Ada.Finalization.Limited_Controlled with record
     Finalized : Boolean := True;
   end record;

   overriding
   procedure Finalize (Object : in out Conditional_Render);

end GL.Objects.Queries;

gl: Support inverted query condition for conditional rendering

 * Extension ARB_conditional_render_inverted (OpenGL 4.5)

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  security -- Security
--  Copyright (C) 2010, 2011, 2012, 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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <tt>Security</tt> package provides a security framework that allows
--  an application to use OpenID or OAuth security frameworks.  This security
--  framework was first developed within the Ada Server Faces project.
--  It was moved to a separate project so that it can easyly be used with AWS.
--  This package defines abstractions that are close or similar to Java
--  security package.
--
--  The security framework uses the following abstractions:
--
--  === Policy and policy manager ===
--  The <tt>Policy</tt> defines and implements the set of security rules that specify how to
--  protect the system or resources.  The <tt>Policy_Manager</tt> maintains the security policies.
--
--  === Principal ===
--  The <tt>Principal</tt> is the entity that can be authenticated.  A principal is obtained
--  after successful authentication of a user or of a system through an authorization process.
--  The OpenID or OAuth authentication processes generate such security principal.
--
--  === Permission ===
--  The <tt>Permission</tt> represents an access to a system or application resource.
--  A permission is checked by using the security policy manager.  The policy manager uses a
--  security controller to enforce the permission.
--
--  === Security Context ===
--  The <tt>Security_Context</tt> holds the contextual information that the security controller
--  can use to verify the permission.  The security context is associated with a principal and
--  a set of policy context.
--
--  == Overview ==
--  An application will create a security policy manager and register one or several security
--  policies (yellow).  The framework defines a simple role based security policy and an URL
--  security policy intended to provide security in web applications.  The security policy manager
--  reads some security policy configuration file which allows the security policies to configure
--  and create the security controllers.  These controllers will enforce the security according
--  to the application security rules.  All these components are built only once when
--  an application starts.
--
--  A user is authenticated through an authentication system which creates a <tt>Principal</tt>
--  instance that identifies the user (green).  The security framework provides two authentication
--  systems: OpenID and OAuth 2.0 OpenID Connect.
--
--  [images/ModelOverview.png]
--
--  When a permission must be enforced, a security context is created and linked to the
--  <tt>Principal</tt> instance (blue).  Additional security policy context can be added depending
--  on the application context.  To check the permission, the security policy manager is called
--  and it will ask a security controller to verify the permission.
--
--  The framework allows an application to plug its own security policy, its own policy context,
--  its own principal and authentication mechanism.
--
--  @include security-permissions.ads
--
--  == Principal ==
--  A principal is created by using either the [Security_Auth OpenID],
--  the [Security_OAuth OAuth] or another authentication mechanism.  The authentication produces
--  an object that must implement the <tt>Principal</tt> interface.  For example:
--
--    P : Security.Auth.Principal_Access := Security.Auth.Create_Principal (Auth);
--
--  or
--
--    P : Security.OAuth.Clients.Access_Token_Access := Security.OAuth.Clients.Create_Access_Token
--
--  The principal is then stored in a security context.
--
--  @include security-contexts.ads
--
--  [Security_Policies Security Policies]
--  [Security_Auth OpenID]
--  [Security_OAuth OAuth]
--
package Security is

   pragma Preelaborate;

   --  ------------------------------
   --  Principal
   --  ------------------------------
   type Principal is limited interface;
   type Principal_Access is access all Principal'Class;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String is abstract;

end Security;

-----------------------------------------------------------------------
--  security -- Security
--  Copyright (C) 2010, 2011, 2012, 2015, 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.
-----------------------------------------------------------------------

--  = Security =
--  The `Security` package provides a security framework that allows
--  an application to use OpenID or OAuth security frameworks.  This security
--  framework was first developed within the Ada Server Faces project.
--  It was moved to a separate project so that it can easyly be used with AWS.
--  This package defines abstractions that are close or similar to Java
--  security package.
--
--  The security framework uses the following abstractions:
--
--  * **Policy and policy manager**:
--    The `Policy` defines and implements the set of security rules that specify how to
--    protect the system or resources.  The `Policy_Manager` maintains the security policies.
--
--  * **Principal**:
--    The `Principal` is the entity that can be authenticated.  A principal is obtained
--    after successful authentication of a user or of a system through an authorization process.
--    The OpenID or OAuth authentication processes generate such security principal.
--
--  * **Permission**:
--    The `Permission` represents an access to a system or application resource.
--    A permission is checked by using the security policy manager.  The policy manager uses a
--    security controller to enforce the permission.
--
--  === Security Context ===
--  The `Security_Context` holds the contextual information that the security controller
--  can use to verify the permission.  The security context is associated with a principal and
--  a set of policy context.
--
--  == Overview ==
--  An application will create a security policy manager and register one or several security
--  policies (yellow).  The framework defines a simple role based security policy and an URL
--  security policy intended to provide security in web applications.  The security policy manager
--  reads some security policy configuration file which allows the security policies to configure
--  and create the security controllers.  These controllers will enforce the security according
--  to the application security rules.  All these components are built only once when
--  an application starts.
--
--  A user is authenticated through an authentication system which creates a `Principal`
--  instance that identifies the user (green).  The security framework provides two authentication
--  systems: OpenID and OAuth 2.0 OpenID Connect.
--
--  [images/ModelOverview.png]
--
--  When a permission must be enforced, a security context is created and linked to the
--  `Principal` instance (blue).  Additional security policy context can be added depending
--  on the application context.  To check the permission, the security policy manager is called
--  and it will ask a security controller to verify the permission.
--
--  The framework allows an application to plug its own security policy, its own policy context,
--  its own principal and authentication mechanism.
--
--  @include security-permissions.ads
--
--  == Principal ==
--  A principal is created by using either the [Security_Auth OpenID],
--  the [Security_OAuth OAuth] or another authentication mechanism.  The authentication produces
--  an object that must implement the `Principal` interface.  For example:
--
--    P : Security.Auth.Principal_Access := Security.Auth.Create_Principal (Auth);
--
--  or
--
--    P : Security.OAuth.Clients.Access_Token_Access := Security.OAuth.Clients.Create_Access_Token
--
--  The principal is then stored in a security context.
--
--  @include security-contexts.ads
--
--  [Security_Policies Security Policies]
--  [Security_Auth OpenID]
--  [Security_OAuth OAuth]
--
package Security is

   pragma Preelaborate;

   --  ------------------------------
   --  Principal
   --  ------------------------------
   type Principal is limited interface;
   type Principal_Access is access all Principal'Class;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String is abstract;

end Security;

Update the documentation

Update the documentation