-----------------------------------------------------------------------
--  wiki-plugins-template -- Template Plugin
--  Copyright (C) 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.Strings.Unbounded;
with Wiki.Strings;

--  === Template Plugins ===
--  The <b>Wiki.Plugins.Templates</b> package defines an abstract template plugin.
--  To use the template plugin, the <tt>Get_Template</tt> procedure must be implemented.
--  It is responsible for getting the template content according to the plugin parameters.
--
package Wiki.Plugins.Templates is

   type Template_Plugin is abstract new Wiki_Plugin with null record;

   --  Get the template content for the plugin evaluation.
   procedure Get_Template (Plugin   : in out Template_Plugin;
                           Params   : in out Wiki.Attributes.Attribute_List;
                           Template : out Wiki.Strings.UString) is abstract;

   --  Expand the template configured with the parameters for the document.
   --  The <tt>Get_Template</tt> operation is called and the template content returned
   --  by that operation is parsed in the current document.  Template parameters are passed
   --  in the <tt>Context</tt> instance and they can be evaluated within the template
   --  while parsing the template content.
   overriding
   procedure Expand (Plugin   : in out Template_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in Plugin_Context);

   type File_Template_Plugin is new Wiki_Plugin with private;

   --  Set the directory path that contains template files.
   procedure Set_Template_Path (Plugin : in out File_Template_Plugin;
                                Path   : in String);

   --  Expand the template configured with the parameters for the document.
   --  Read the file whose basename correspond to the first parameter and parse that file
   --  in the current document.  Template parameters are passed
   --  in the <tt>Context</tt> instance and they can be evaluated within the template
   --  while parsing the template content.
   overriding
   procedure Expand (Plugin   : in out File_Template_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in Plugin_Context);

private

   type File_Template_Plugin is new Wiki_Plugin with record
      Path : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end Wiki.Plugins.Templates;

-----------------------------------------------------------------------
--  wiki-plugins-template -- Template Plugin
--  Copyright (C) 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.Strings.Unbounded;
with Wiki.Strings;

--  === Template Plugins ===
--  The <b>Wiki.Plugins.Templates</b> package defines an abstract template plugin.
--  To use the template plugin, the <tt>Get_Template</tt> procedure must be implemented.
--  It is responsible for getting the template content according to the plugin parameters.
--
package Wiki.Plugins.Templates is

   type Template_Plugin is abstract new Wiki_Plugin with null record;

   --  Get the template content for the plugin evaluation.
   procedure Get_Template (Plugin   : in out Template_Plugin;
                           Params   : in out Wiki.Attributes.Attribute_List;
                           Template : out Wiki.Strings.UString) is abstract;

   --  Expand the template configured with the parameters for the document.
   --  The <tt>Get_Template</tt> operation is called and the template content returned
   --  by that operation is parsed in the current document.  Template parameters are passed
   --  in the <tt>Context</tt> instance and they can be evaluated within the template
   --  while parsing the template content.
   overriding
   procedure Expand (Plugin   : in out Template_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in Plugin_Context);

   type File_Template_Plugin is new Wiki_Plugin and Plugin_Factory with private;

   --  Find a plugin knowing its name.
   overriding
   function Find (Factory : in File_Template_Plugin;
                  Name    : in String) return Wiki_Plugin_Access;

   --  Set the directory path that contains template files.
   procedure Set_Template_Path (Plugin : in out File_Template_Plugin;
                                Path   : in String);

   --  Expand the template configured with the parameters for the document.
   --  Read the file whose basename correspond to the first parameter and parse that file
   --  in the current document.  Template parameters are passed
   --  in the <tt>Context</tt> instance and they can be evaluated within the template
   --  while parsing the template content.
   overriding
   procedure Expand (Plugin   : in out File_Template_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in Plugin_Context);

private

   type File_Template_Plugin is new Wiki_Plugin and Plugin_Factory with record
      Path : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end Wiki.Plugins.Templates;

Change the File_Template_Plugin to implement the Plugin_Factory interface


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

with MAT.Readers.Marshaller;
package body MAT.Targets.Probes is

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

   MSG_BEGIN     : constant MAT.Events.Internal_Reference := 0;
   MSG_END       : constant MAT.Events.Internal_Reference := 1;

   M_PID         : constant MAT.Events.Internal_Reference := 1;
   M_EXE         : constant MAT.Events.Internal_Reference := 2;
   M_HEAP_START  : constant MAT.Events.Internal_Reference := 3;
   M_HEAP_END    : constant MAT.Events.Internal_Reference := 4;
   M_END         : constant MAT.Events.Internal_Reference := 5;

   PID_NAME      : aliased constant String := "pid";
   EXE_NAME      : aliased constant String := "exe";
   HP_START_NAME : aliased constant String := "hp_start";
   HP_END_NAME   : aliased constant String := "hp_end";
   END_NAME      : aliased constant String := "end";

   Process_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => PID_NAME'Access, Size => 0,
            Kind => MAT.Events.T_SIZE_T, Ref => M_PID),
      2 => (Name => EXE_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_EXE),
      3 => (Name => HP_START_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_HEAP_START),
      4 => (Name => HP_END_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_HEAP_END),
      5 => (Name => END_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_END));

   --  ------------------------------
   --  Create a new process after the begin event is received from the event stream.
   --  ------------------------------
   procedure Create_Process (For_Servant : in out Process_Probe_Type;
                             Pid         : in MAT.Types.Target_Process_Ref;
                             Path        : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      For_Servant.Target.Create_Process (Pid     => Pid,
                                         Path    => Path,
                                         Process => For_Servant.Process);
      For_Servant.Process.Events := For_Servant.Events;
      MAT.Memory.Targets.Initialize (Memory => For_Servant.Process.Memory,
                                     Reader => For_Servant.Reader.all);
   end Create_Process;

   procedure Probe_Begin (Probe : in out Process_Probe_Type;
                          Id          : in MAT.Events.Internal_Reference;
                          Defs        : in MAT.Events.Attribute_Table;
                          Frame       : in MAT.Events.Frame_Info;
                          Msg         : in out MAT.Readers.Message) is
      Pid  : MAT.Types.Target_Process_Ref := 0;
      Path : Ada.Strings.Unbounded.Unbounded_String;
      Heap : MAT.Memory.Region_Info;
   begin
      for I in Defs'Range loop
         declare
            Def : MAT.Events.Attribute renames Defs (I);
         begin
            case Def.Ref is
               when M_PID =>
                  Pid := MAT.Readers.Marshaller.Get_Target_Size (Msg, Def.Kind);

               when M_EXE =>
                  Path := MAT.Readers.Marshaller.Get_String (Msg);

               when M_HEAP_START =>
                  Heap.Start_Addr := MAT.Readers.Marshaller.Get_Target_Addr (Msg, Def.Kind);

               when M_HEAP_END =>
                  Heap.End_Addr := MAT.Readers.Marshaller.Get_Target_Addr (Msg, Def.Kind);

               when others =>
                  MAT.Readers.Marshaller.Skip (Msg, Def.Size);
            end case;
         end;
      end loop;
      Heap.Size       := Heap.End_Addr - Heap.Start_Addr;
      Heap.Path       := Ada.Strings.Unbounded.To_Unbounded_String ("[heap]");
      For_Servant.Create_Process (Pid, Path);
      For_Servant.Reader.Read_Message (Msg);
      For_Servant.Reader.Read_Event_Definitions (Msg);
      For_Servant.Process.Memory.Add_Region (Heap);
   end Probe_Begin;

   overriding
   procedure Extract (Probe  : in Process_Probe_Type;
                      Params : in MAT.Events.Const_Attribute_Table_Access;
                      Msg    : in out MAT.Readers.Message_Type;
                      Event  : in out MAT.Events.Targets.Probe_Event_Type) is
   begin
      null;
   end Extract;

   procedure Execute (Probe : in Process_Probe_Type;
                      Event : in MAT.Events.Targets.Probe_Event_Type) is
   begin
      null;
   end Execute;

   --  ------------------------------
   --  Register the reader to extract and analyze process events.
   --  ------------------------------
   procedure Register (Into  : in out MAT.Events.Probes.Probe_Manager_Type'Class;
                       Probe : in Process_Probe_Type_Access) is
   begin
      Probe.Manager := Into'Unchecked_Access;
      Into.Register_Probe (Probe.all'Access, "begin", MSG_BEGIN,
                           Process_Attributes'Access);
      Into.Register_Probe (Probe.all'Access, "end", MSG_END,
                           Process_Attributes'Access);
   end Register;

   --  ------------------------------
   --  Initialize the target object to prepare for reading process events.
   --  ------------------------------
   procedure Initialize (Target : in out Target_Type;
                         Manager : in out MAT.Events.Probes.Probe_Manager_Type_Access) is
      Process_Probe : constant Process_Probe_Type_Access
        := new Process_Probe_Type;
   begin
      Process_Probe.Target := Target'Unrestricted_Access;
      Process_Probe.Events := Manager.Get_Target_Events;
      Register (Manager.all, Process_Probe);
   end Initialize;

end MAT.Targets.Probes;

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

with MAT.Readers.Marshaller;
package body MAT.Targets.Probes is

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

   MSG_BEGIN     : constant MAT.Events.Targets.Probe_Index_Type := 0;
   MSG_END       : constant MAT.Events.Targets.Probe_Index_Type := 1;

   M_PID         : constant MAT.Events.Internal_Reference := 1;
   M_EXE         : constant MAT.Events.Internal_Reference := 2;
   M_HEAP_START  : constant MAT.Events.Internal_Reference := 3;
   M_HEAP_END    : constant MAT.Events.Internal_Reference := 4;
   M_END         : constant MAT.Events.Internal_Reference := 5;

   PID_NAME      : aliased constant String := "pid";
   EXE_NAME      : aliased constant String := "exe";
   HP_START_NAME : aliased constant String := "hp_start";
   HP_END_NAME   : aliased constant String := "hp_end";
   END_NAME      : aliased constant String := "end";

   Process_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => PID_NAME'Access, Size => 0,
            Kind => MAT.Events.T_SIZE_T, Ref => M_PID),
      2 => (Name => EXE_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_EXE),
      3 => (Name => HP_START_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_HEAP_START),
      4 => (Name => HP_END_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_HEAP_END),
      5 => (Name => END_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_END));

   --  ------------------------------
   --  Create a new process after the begin event is received from the event stream.
   --  ------------------------------
   procedure Create_Process (Probe : in out Process_Probe_Type;
                             Pid         : in MAT.Types.Target_Process_Ref;
                             Path        : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
--        Probe.Target.Create_Process (Pid     => Pid,
--                                           Path    => Path,
--                                           Process => Probe.Process);
      Probe.Process.Events := Probe.Events;
      MAT.Memory.Targets.Initialize (Memory  => Probe.Process.Memory,
                                     Manager => Probe.Manager.all);
   end Create_Process;

   procedure Probe_Begin (Probe : in out Process_Probe_Type;
                          Id          : in MAT.Events.Internal_Reference;
                          Defs        : in MAT.Events.Attribute_Table;
                          Frame       : in MAT.Events.Frame_Info;
                          Msg         : in out MAT.Readers.Message) is
      Pid  : MAT.Types.Target_Process_Ref := 0;
      Path : Ada.Strings.Unbounded.Unbounded_String;
      Heap : MAT.Memory.Region_Info;
   begin
      for I in Defs'Range loop
         declare
            Def : MAT.Events.Attribute renames Defs (I);
         begin
            case Def.Ref is
               when M_PID =>
                  Pid := MAT.Readers.Marshaller.Get_Target_Size (Msg, Def.Kind);

               when M_EXE =>
                  Path := MAT.Readers.Marshaller.Get_String (Msg);

               when M_HEAP_START =>
                  Heap.Start_Addr := MAT.Readers.Marshaller.Get_Target_Addr (Msg, Def.Kind);

               when M_HEAP_END =>
                  Heap.End_Addr := MAT.Readers.Marshaller.Get_Target_Addr (Msg, Def.Kind);

               when others =>
                  MAT.Readers.Marshaller.Skip (Msg, Def.Size);
            end case;
         end;
      end loop;
      Heap.Size       := Heap.End_Addr - Heap.Start_Addr;
      Heap.Path       := Ada.Strings.Unbounded.To_Unbounded_String ("[heap]");
      Probe.Create_Process (Pid, Path);
      Probe.Manager.Read_Message (Msg);
      Probe.Manager.Read_Event_Definitions (Msg);
      Probe.Process.Memory.Add_Region (Heap);
   end Probe_Begin;

   overriding
   procedure Extract (Probe  : in Process_Probe_Type;
                      Params : in MAT.Events.Const_Attribute_Table_Access;
                      Msg    : in out MAT.Readers.Message_Type;
                      Event  : in out MAT.Events.Targets.Probe_Event_Type) is
   begin
      null;
   end Extract;

   procedure Execute (Probe : in Process_Probe_Type;
                      Event : in MAT.Events.Targets.Probe_Event_Type) is
   begin
      null;
   end Execute;

   --  ------------------------------
   --  Register the reader to extract and analyze process events.
   --  ------------------------------
   procedure Register (Into  : in out MAT.Events.Probes.Probe_Manager_Type'Class;
                       Probe : in Process_Probe_Type_Access) is
   begin
      Probe.Manager := Into'Unchecked_Access;
      Into.Register_Probe (Probe.all'Access, "begin", MSG_BEGIN,
                           Process_Attributes'Access);
      Into.Register_Probe (Probe.all'Access, "end", MSG_END,
                           Process_Attributes'Access);
   end Register;

   --  ------------------------------
   --  Initialize the target object to prepare for reading process events.
   --  ------------------------------
   procedure Initialize (Target  : in out Target_Type;
                         Manager : in out MAT.Events.Probes.Probe_Manager_Type'Class) is
      Process_Probe : constant Process_Probe_Type_Access
        := new Process_Probe_Type;
   begin
      Process_Probe.Target := Target'Unrestricted_Access;
      Process_Probe.Events := Manager.Get_Target_Events;
      Register (Manager, Process_Probe);
   end Initialize;

end MAT.Targets.Probes;

Fix the Initialize and Create_Process procedures


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

with NRF51_SVD.TEMP; use NRF51_SVD.TEMP;
with HAL;            use HAL;

package body nRF51.Temperature is

   type RAW_Temp is delta 0.25 range
     Temp_Celcius'First * 4.0 .. Temp_Celcius'Last * 4.0;

   ----------
   -- Read --
   ----------

   function Read return Temp_Celcius is
      Raw : RAW_Temp;
   begin

      --  Clear event
      TEMP_Periph.EVENTS_DATARDY := 0;

      --  Start temperature measurement
      TEMP_Periph.TASKS_START := 1;

      while TEMP_Periph.EVENTS_DATARDY = 0 loop
         null;
      end loop;

      Raw := RAW_Temp (TEMP_Periph.TEMP);
      return Temp_Celcius (Raw / 4);
   end Read;

end nRF51.Temperature;

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

with NRF51_SVD.TEMP; use NRF51_SVD.TEMP;
with HAL;            use HAL;

package body nRF51.Temperature is

   type RAW_Temp is delta 0.25 range
     Temp_Celsius'First * 4.0 .. Temp_Celsius'Last * 4.0;

   ----------
   -- Read --
   ----------

   function Read return Temp_Celsius is
      Raw : RAW_Temp;
   begin

      --  Clear event
      TEMP_Periph.EVENTS_DATARDY := 0;

      --  Start temperature measurement
      TEMP_Periph.TASKS_START := 1;

      while TEMP_Periph.EVENTS_DATARDY = 0 loop
         null;
      end loop;

      Raw := RAW_Temp (TEMP_Periph.TEMP);
      return Temp_Celsius (Raw / 4);
   end Read;

end nRF51.Temperature;

Update nrf51-temperature.adb

Update nrf51-temperature.adb


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

   --  --------------------
   --  Expand the name from the given group into a target parameter value to be used in
   --  the SQL query.  The expander can look in a cache or in some configuration to find
   --  the value associated with the name and return it.  The Expander can return a
   --  T_NULL when a value is not found or it may also raise some exception.
   --  --------------------
   overriding
   function Expand (Instance : in Cache_Manager;
                    Group    : in String;
                    Name     : in String) return ADO.Parameters.Parameter is
      use type Ada.Strings.Unbounded.Unbounded_String;
      C : Cache_Type_Access := Instance.First;
   begin
      while C /= null loop
         if C.Name = Group then
            return C.Expand (Name);
         end if;
         C := C.Next;
      end loop;
      raise No_Value;
   end Expand;

   --  --------------------
   --  Insert a new cache in the manager.  The cache is identified by the given name.
   --  --------------------
   procedure Add_Cache (Manager : in out Cache_Manager;
                        Name    : in String;
                        Cache   : in Cache_Type_Access) is
   begin
      Cache.Next    := Manager.First;
      Cache.Name    := Ada.Strings.Unbounded.To_Unbounded_String (Name);
      Manager.First := Cache;
   end Add_Cache;

   --  --------------------
   --  Finalize the cache manager releasing every cache group.
   --  --------------------
   overriding
   procedure Finalize (Manager : in out Cache_Manager) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Cache_Type'Class,
                                        Name   => Cache_Type_Access);
      Cache : Cache_Type_Access;
   begin
      loop
         Cache := Manager.First;
         exit when Cache = null;
         Manager.First := Cache.Next;
         Free (Cache);
      end loop;
   end Finalize;

end ADO.Caches;

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

   --  --------------------
   --  Expand the name from the given group into a target parameter value to be used in
   --  the SQL query.  The expander can look in a cache or in some configuration to find
   --  the value associated with the name and return it.  The Expander can return a
   --  T_NULL when a value is not found or it may also raise some exception.
   --  --------------------
   overriding
   function Expand (Instance : in Cache_Manager;
                    Group    : in String;
                    Name     : in String) return ADO.Parameters.Parameter is
      use type Ada.Strings.Unbounded.Unbounded_String;
      C : Cache_Type_Access := Instance.First;
   begin
      while C /= null loop
         if C.Name = Group then
            return C.Expand (Name);
         end if;
         C := C.Next;
      end loop;
      Log.Warn ("There is no group {0} registered in the cache manager", Group);
      raise No_Value with "No group '" & Group & "'";
   end Expand;

   --  --------------------
   --  Insert a new cache in the manager.  The cache is identified by the given name.
   --  --------------------
   procedure Add_Cache (Manager : in out Cache_Manager;
                        Name    : in String;
                        Cache   : in Cache_Type_Access) is
   begin
      Log.Debug ("Adding cache group {0}", Name);

      Cache.Next    := Manager.First;
      Cache.Name    := Ada.Strings.Unbounded.To_Unbounded_String (Name);
      Manager.First := Cache;
   end Add_Cache;

   --  --------------------
   --  Finalize the cache manager releasing every cache group.
   --  --------------------
   overriding
   procedure Finalize (Manager : in out Cache_Manager) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Object => Cache_Type'Class,
                                        Name   => Cache_Type_Access);
      Cache : Cache_Type_Access;
   begin
      loop
         Cache := Manager.First;
         exit when Cache = null;
         Manager.First := Cache.Next;
         Free (Cache);
      end loop;
   end Finalize;

end ADO.Caches;

Add some log and report a message when the No_Value exception is raised


-----------------------------------------------------------------------
--  util-streams-buffered-lzma -- LZMA streams
--  Copyright (C) 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.Encoders;
package Util.Streams.Buffered.Lzma is

   --  -----------------------
   --  Compress stream
   --  -----------------------
   --  The <b>Compress_Stream</b> is an output stream which uses the LZMA encoder to
   --  compress the data before writing it to the output.
   type Compress_Stream is limited new Util.Streams.Buffered.Output_Buffer_Stream with private;

   --  Initialize the stream to write on the given stream.
   --  An internal buffer is allocated for writing the stream.
   procedure Initialize (Stream  : in out Compress_Stream;
                         Output  : in Output_Stream_Access;
                         Size    : in Natural;
                         Format  : in String);

   --  Close the sink.
   overriding
   procedure Close (Stream : in out Compress_Stream);

   --  Write the buffer array to the output stream.
   overriding
   procedure Write (Stream : in out Compress_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array);

   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   overriding
   procedure Flush (Stream : in out Compress_Stream);

private

   type Compress_Stream is limited new Util.Streams.Buffered.Output_Buffer_Stream with record
      Transform   : Util.Encoders.Transformer_Access;
   end record;

   --  Flush the stream and release the buffer.
   overriding
   procedure Finalize (Object : in out Compress_Stream);

end Util.Streams.Buffered.Lzma;

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

package Util.Streams.Buffered.Lzma is

   --  -----------------------
   --  Compress stream
   --  -----------------------
   --  The <b>Compress_Stream</b> is an output stream which uses the LZMA encoder to
   --  compress the data before writing it to the output.
   type Compress_Stream is limited new Util.Streams.Buffered.Output_Buffer_Stream with private;

   --  Initialize the stream to write on the given stream.
   --  An internal buffer is allocated for writing the stream.
   overriding
   procedure Initialize (Stream  : in out Compress_Stream;
                         Output  : in Output_Stream_Access;
                         Size    : in Positive);

   --  Close the sink.
   overriding
   procedure Close (Stream : in out Compress_Stream);

   --  Write the buffer array to the output stream.
   overriding
   procedure Write (Stream : in out Compress_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array);

   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   overriding
   procedure Flush (Stream : in out Compress_Stream);

private

   type Compress_Stream is limited new Util.Streams.Buffered.Output_Buffer_Stream with record
      Stream : aliased Base.lzma_stream := Base.LZMA_STREAM_INIT;
   end record;

   --  Flush the stream and release the buffer.
   overriding
   procedure Finalize (Object : in out Compress_Stream);

end Util.Streams.Buffered.Lzma;

Refactor the LZMA buffered stream implementation


-----------------------------------------------------------------------
--  security -- Security
--  Copyright (C) 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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <tt>Security</tt> package provides security frameworks that allows
--  an application to use OpenID or OAuth security frameworks.  This security
--  framework was first developed within the Ada Server Faces project.
--  This package defines abstractions that are close or similar to Java
--  security package.
--
--  @include security-permissions.ads
--  @include security-openid.ads
--  @include security-oauth.ads
--  @include security-contexts.ads
--  @include security-controllers.ads
package Security is

   --  ------------------------------
   --  Principal
   --  ------------------------------
   type Principal is limited interface;
   type Principal_Access is access all Principal'Class;
--
--     --  Returns true if the given role is stored in the user principal.
--     function Has_Role (User : in Principal;
--                        Role : in Role_Type) return Boolean is abstract;

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

end Security;

-----------------------------------------------------------------------
--  security -- Security
--  Copyright (C) 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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <tt>Security</tt> package provides security frameworks that allows
--  an application to use OpenID or OAuth security frameworks.  This security
--  framework was first developed within the Ada Server Faces project.
--  This package defines abstractions that are close or similar to Java
--  security package.
--
--  @include security-permissions.ads
--  @include security-openid.ads
--  @include security-oauth.ads
--  @include security-contexts.ads
--  @include security-controllers.ads
package Security is

   --  ------------------------------
   --  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;

Make the Principal be a real principal (ie, no knowledge of roles)


-----------------------------------------------------------------------
--  Util testsuite - Util Testsuite
--  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 AWA.Users.Services.Tests;
with AWA.Users.Tests;
with AWA.Blogs.Services.Tests;
with AWA.Wikis.Parsers.Tests;
with AWA.Helpers.Selectors.Tests;
with AWA.Storages.Services.Tests;
with AWA.Events.Services.Tests;
with AWA.Mail.Clients.Tests;
with AWA.Mail.Modules.Tests;
with AWA.Images.Services.Tests;
with AWA.Modules.Tests;

with ASF.Converters.Dates;

with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;
with AWA.Images.Modules;

with AWA.Converters.Dates;
with AWA.Tests;
with AWA.Services.Contexts;
with AWA.Jobs.Services.Tests;
with AWA.Jobs.Modules.Tests;

with ASF.Server.Web;
with ASF.Server.Tests;
package body AWA.Testsuite is
   Users          : aliased AWA.Users.Modules.User_Module;

   Workspaces     : aliased AWA.Workspaces.Modules.Workspace_Module;

   Mail           : aliased AWA.Mail.Modules.Mail_Module;

   Jobs           : aliased AWA.Jobs.Modules.Job_Module;

   Blogs          : aliased AWA.Blogs.Modules.Blog_Module;

   Storages       : aliased AWA.Storages.Modules.Storage_Module;

   Images         : aliased AWA.Images.Modules.Image_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      AWA.Modules.Tests.Add_Tests (Ret);
      AWA.Events.Services.Tests.Add_Tests (Ret);
      AWA.Mail.Clients.Tests.Add_Tests (Ret);
      AWA.Mail.Modules.Tests.Add_Tests (Ret);
      AWA.Users.Services.Tests.Add_Tests (Ret);
      AWA.Users.Tests.Add_Tests (Ret);
      AWA.Wikis.Parsers.Tests.Add_Tests (Ret);
      AWA.Helpers.Selectors.Tests.Add_Tests (Ret);
      AWA.Jobs.Modules.Tests.Add_Tests (Ret);
      AWA.Jobs.Services.Tests.Add_Tests (Ret);
      AWA.Blogs.Services.Tests.Add_Tests (Ret);
      AWA.Storages.Services.Tests.Add_Tests (Ret);
      AWA.Images.Services.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      AWA.Tests.Initialize (App, Props, Add_Modules);

      if Add_Modules then
         declare
            Application : constant Applications.Application_Access := AWA.Tests.Get_Application;
            Ctx         : AWA.Services.Contexts.Service_Context;
            Users  : constant AWA.Users.Modules.User_Module_Access := AWA.Testsuite.Users'Access;
         begin
            Ctx.Set_Context (Application, null);
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Modules.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Storages.Modules.NAME,
                      URI    => "storages",
                      Module => Storages'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Images.Modules.NAME,
                      URI    => "images",
                      Module => Images'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Jobs.Modules.NAME,
                      URI    => "jobs",
                      Module => Jobs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Modules.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            Application.Start;
            if Props.Exists ("test.server") then
               declare
                  WS : ASF.Server.Web.AWS_Container;
               begin
                  Application.Add_Converter (Name      => "dateConverter",
                                             Converter => Date_Converter'Access);
                  Application.Add_Converter (Name      => "smartDateConverter",
                                             Converter => Rel_Date_Converter'Access);

                  WS.Register_Application ("/asfunit", Application.all'Access);

                  WS.Start;
                  delay 6000.0;
               end;
            end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

end AWA.Testsuite;

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

with AWA.Users.Services.Tests;
with AWA.Users.Tests;
with AWA.Blogs.Services.Tests;
with AWA.Wikis.Parsers.Tests;
with AWA.Wikis.Writers.Tests;
with AWA.Helpers.Selectors.Tests;
with AWA.Storages.Services.Tests;
with AWA.Events.Services.Tests;
with AWA.Mail.Clients.Tests;
with AWA.Mail.Modules.Tests;
with AWA.Images.Services.Tests;
with AWA.Modules.Tests;

with ASF.Converters.Dates;

with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;
with AWA.Images.Modules;

with AWA.Converters.Dates;
with AWA.Tests;
with AWA.Services.Contexts;
with AWA.Jobs.Services.Tests;
with AWA.Jobs.Modules.Tests;

with ASF.Server.Web;
with ASF.Server.Tests;
package body AWA.Testsuite is
   Users          : aliased AWA.Users.Modules.User_Module;

   Workspaces     : aliased AWA.Workspaces.Modules.Workspace_Module;

   Mail           : aliased AWA.Mail.Modules.Mail_Module;

   Jobs           : aliased AWA.Jobs.Modules.Job_Module;

   Blogs          : aliased AWA.Blogs.Modules.Blog_Module;

   Storages       : aliased AWA.Storages.Modules.Storage_Module;

   Images         : aliased AWA.Images.Modules.Image_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      AWA.Modules.Tests.Add_Tests (Ret);
      AWA.Events.Services.Tests.Add_Tests (Ret);
      AWA.Mail.Clients.Tests.Add_Tests (Ret);
      AWA.Mail.Modules.Tests.Add_Tests (Ret);
      AWA.Users.Services.Tests.Add_Tests (Ret);
      AWA.Users.Tests.Add_Tests (Ret);
      AWA.Wikis.Parsers.Tests.Add_Tests (Ret);
      AWA.Wikis.Writers.Tests.Add_Tests (Ret);
      AWA.Helpers.Selectors.Tests.Add_Tests (Ret);
      AWA.Jobs.Modules.Tests.Add_Tests (Ret);
      AWA.Jobs.Services.Tests.Add_Tests (Ret);
      AWA.Blogs.Services.Tests.Add_Tests (Ret);
      AWA.Storages.Services.Tests.Add_Tests (Ret);
      AWA.Images.Services.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      AWA.Tests.Initialize (App, Props, Add_Modules);

      if Add_Modules then
         declare
            Application : constant Applications.Application_Access := AWA.Tests.Get_Application;
            Ctx         : AWA.Services.Contexts.Service_Context;
            Users  : constant AWA.Users.Modules.User_Module_Access := AWA.Testsuite.Users'Access;
         begin
            Ctx.Set_Context (Application, null);
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Modules.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Storages.Modules.NAME,
                      URI    => "storages",
                      Module => Storages'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Images.Modules.NAME,
                      URI    => "images",
                      Module => Images'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Jobs.Modules.NAME,
                      URI    => "jobs",
                      Module => Jobs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Modules.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            Application.Start;
            if Props.Exists ("test.server") then
               declare
                  WS : ASF.Server.Web.AWS_Container;
               begin
                  Application.Add_Converter (Name      => "dateConverter",
                                             Converter => Date_Converter'Access);
                  Application.Add_Converter (Name      => "smartDateConverter",
                                             Converter => Rel_Date_Converter'Access);

                  WS.Register_Application ("/asfunit", Application.all'Access);

                  WS.Start;
                  delay 6000.0;
               end;
            end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

end AWA.Testsuite;

Add the new wiki tests in the testsuite

Add the new wiki tests in the testsuite


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

with Util.Serialize.IO.XML;

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

--  The <b>AWA.Modules.Reader</b> package reads the module configuration files
--  and initializes the module.
package body AWA.Modules.Reader is

   --  ------------------------------
   --  Read the module configuration file and configure the components
   --  ------------------------------
   procedure Read_Configuration (Plugin  : in out Module'Class;
                                 File    : in String;
                                 Context : in EL.Contexts.ELContext_Access) is

      Reader     : Util.Serialize.IO.XML.Parser;

      Nav : constant ASF.Navigations.Navigation_Handler_Access := Plugin.App.Get_Navigation_Handler;

      package Bean_Config is
        new ASF.Beans.Mappers.Reader_Config (Reader, Plugin.Factory'Unchecked_Access, Context);
      package Navigation_Config is
        new ASF.Navigations.Mappers.Reader_Config (Reader, Nav);
      package Servlet_Config is
        new ASF.Servlets.Mappers.Reader_Config (Reader, Plugin.App.all'Unchecked_Access);
      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Navigation_Config);
      pragma Warnings (Off, Servlet_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;

end AWA.Modules.Reader;

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

with Util.Serialize.IO.XML;

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

with Security.Permissions;
with Security.Controllers.Roles;
with AWA.Permissions.Configs;
with AWA.Services.Contexts;

--  The <b>AWA.Modules.Reader</b> package reads the module configuration files
--  and initializes the module.
package body AWA.Modules.Reader is

   --  ------------------------------
   --  Read the module configuration file and configure the components
   --  ------------------------------
   procedure Read_Configuration (Plugin  : in out Module'Class;
                                 File    : in String;
                                 Context : in EL.Contexts.ELContext_Access) is

      Reader     : Util.Serialize.IO.XML.Parser;

      Ctx : AWA.Services.Contexts.Service_Context;
      Nav : constant ASF.Navigations.Navigation_Handler_Access := Plugin.App.Get_Navigation_Handler;
      Sec : constant Security.Permissions.Permission_Manager_Access
        := Plugin.App.Get_Permission_Manager;

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

      Ctx.Set_Context (Plugin.App.all'Unchecked_Access, null);
      declare
         package Bean_Config is
           new ASF.Beans.Mappers.Reader_Config (Reader, Plugin.Factory'Unchecked_Access, Context);
         package Navigation_Config is
           new ASF.Navigations.Mappers.Reader_Config (Reader, Nav);
         package Servlet_Config is
           new ASF.Servlets.Mappers.Reader_Config (Reader, Plugin.App.all'Unchecked_Access);
         package Policy_Config is
           new Security.Permissions.Reader_Config (Reader, Sec);
         package Role_Config is
           new Security.Controllers.Roles.Reader_Config (Reader, Sec);
         package Entity_Config is
           new AWA.Permissions.Configs.Reader_Config (Reader, Sec);

         pragma Warnings (Off, Bean_Config);
         pragma Warnings (Off, Navigation_Config);
         pragma Warnings (Off, Servlet_Config);
         pragma Warnings (Off, Policy_Config);
         pragma Warnings (Off, Role_Config);
         pragma Warnings (Off, Entity_Config);
      begin

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

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

end AWA.Modules.Reader;

Read the XML entity-permission from the module XML files


--  Copyright (c) 2016 onox <denkpadje@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 GL.Buffers;
with GL.Objects.Buffers;
with GL.Types.Indirect;

with Orka.Buffers.MDI;
with Orka.Meshes.Attributes;
with Orka.Programs.Modules;

with GL_Test.Display_Backend;

procedure Orka_Test.Test_4_MDI is
   Initialized : constant Boolean := GL_Test.Display_Backend.Init
     (Major => 3, Minor => 2, Width => 500, Height => 500, Resizable => False);
   pragma Unreferenced (Initialized);

   use Orka.Meshes;
   use Orka.Programs;
   use GL.Objects.Buffers;

   function Load_Mesh (Program : Orka.Programs.Program;
                       MDI_Buffers : out Orka.Buffers.MDI.MDI_Buffers) return Vertex_Format is
      use GL.Types;

      Vertices_1 : constant Indirect.Single_Array_Access
        := new Single_Array'(-0.3,  0.5, -1.0,
                             -0.8, -0.5, -1.0,
                              0.2, -0.5, -1.0);

      Vertices_2 : constant Indirect.Single_Array_Access
        := new Single_Array'(-0.2,  0.5, -1.0,
                              0.3, -0.5, -1.0,
                              0.8,  0.5, -1.0);

      Indices_1 : constant Indirect.UInt_Array_Access
        := new UInt_Array'(0, 1, 2);

      Indices_2 : constant Indirect.UInt_Array_Access
        := new UInt_Array'(0, 1, 2);

      MDI : Orka.Buffers.MDI.Batch := Orka.Buffers.MDI.Create_Batch (3);
      Instance_ID : Natural;
   begin
      --  Create one VBO, one IBO, and a buffer containing the draw commands
      MDI.Append (Vertices_1, Indices_1, Instance_ID);
      MDI.Append (Vertices_2, Indices_2, Instance_ID);
      pragma Assert (MDI.Length = 2);
      MDI_Buffers := MDI.Create_Buffers (Storage_Bits'(others => False));

      --  Create mesh and its attributes
      return Result : Vertex_Format := Orka.Meshes.Create_Vertex_Format (Triangles) do
         declare
            Attributes_Pos : Attributes.Attribute_Buffer := Result.Add_Attribute_Buffer (Single_Type);
            Attributes_Ins : Attributes.Attribute_Buffer := Result.Add_Attribute_Buffer (UInt_Type);
         begin
            Attributes_Pos.Add_Attribute (Program.Attribute_Location ("in_Position"), 3);
            Attributes_Pos.Set_Buffer (MDI_Buffers.Vertex_Buffer);

            Attributes_Ins.Add_Attribute (Program.Attribute_Location ("in_InstanceID"), 1);
            Attributes_Ins.Set_Per_Instance (True);
            Attributes_Ins.Set_Buffer (MDI_Buffers.Instances_Buffer);
         end;
         Result.Set_Index_Buffer (MDI_Buffers.Index_Buffer);
      end return;
   end Load_Mesh;

   use GL.Buffers;

   MDI_Buffers : Orka.Buffers.MDI.MDI_Buffers;

   Program_1 : constant Program := Orka.Programs.Create_Program (Modules.Create_Module
     (VS => "../examples/orka/shaders/test-4-module-1.vert",
      FS => "../examples/orka/shaders/test-4-module-1.frag"));

   Mesh_1 : constant Vertex_Format := Load_Mesh (Program_1, MDI_Buffers);
begin
   Program_1.Use_Program;

   while not GL_Test.Display_Backend.Get_Window.Should_Close loop
      Clear (Buffer_Bits'(Color => True, Depth => True, others => False));

      Mesh_1.Draw_Indirect (MDI_Buffers.Command_Buffer);

      GL_Test.Display_Backend.Swap_Buffers_And_Poll_Events;
   end loop;

   GL_Test.Display_Backend.Shutdown;
end Orka_Test.Test_4_MDI;

--  Copyright (c) 2016 onox <denkpadje@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 GL.Buffers;
with GL.Objects.Buffers;
with GL.Types.Indirect;

with Orka.Buffers.MDI;
with Orka.Meshes.Attributes;
with Orka.Programs.Modules;

with GL_Test.Display_Backend;

procedure Orka_Test.Test_4_MDI is
   Initialized : constant Boolean := GL_Test.Display_Backend.Init
     (Major => 3, Minor => 2, Width => 500, Height => 500, Resizable => False);
   pragma Unreferenced (Initialized);

   use Orka.Meshes;
   use Orka.Programs;
   use GL.Objects.Buffers;

   function Load_Mesh (Program : Orka.Programs.Program;
                       MDI_Buffers : out Orka.Buffers.MDI.MDI_Buffers) return Vertex_Format is
      use GL.Types;

      Vertices_1 : constant Indirect.Single_Array_Access
        := new Single_Array'(-0.3,  0.5, -1.0,
                             -0.8, -0.5, -1.0,
                              0.2, -0.5, -1.0);

      Vertices_2 : constant Indirect.Single_Array_Access
        := new Single_Array'(-0.2,  0.5, -1.0,
                              0.3, -0.5, -1.0,
                              0.8,  0.5, -1.0);

      Indices_1 : constant Indirect.UInt_Array_Access
        := new UInt_Array'(0, 1, 2);

      Indices_2 : constant Indirect.UInt_Array_Access
        := new UInt_Array'(0, 1, 2);

      MDI : Orka.Buffers.MDI.Batch := Orka.Buffers.MDI.Create_Batch (3);
      Instance_ID : Natural;
   begin
      --  Create one VBO, one IBO, and a buffer containing the draw commands
      MDI.Append (Vertices_1, Indices_1, Instance_ID);
      MDI.Append (Vertices_2, Indices_2, Instance_ID);
      pragma Assert (MDI.Length = 2);
      MDI_Buffers := MDI.Create_Buffers (Storage_Bits'(others => False));

      --  Create mesh and its attributes
      return Result : Vertex_Format := Orka.Meshes.Create_Vertex_Format (Triangles) do
         declare
            Attributes_Pos : Attributes.Attribute_Buffer := Result.Add_Attribute_Buffer (Half_Type);
            Attributes_Ins : Attributes.Attribute_Buffer := Result.Add_Attribute_Buffer (UInt_Type);
         begin
            Attributes_Pos.Add_Attribute (Program.Attribute_Location ("in_Position"), 3);
            Attributes_Pos.Set_Buffer (MDI_Buffers.Vertex_Buffer);

            Attributes_Ins.Add_Attribute (Program.Attribute_Location ("in_InstanceID"), 1);
            Attributes_Ins.Set_Per_Instance (True);
            Attributes_Ins.Set_Buffer (MDI_Buffers.Instances_Buffer);
         end;
         Result.Set_Index_Buffer (MDI_Buffers.Index_Buffer);
      end return;
   end Load_Mesh;

   use GL.Buffers;

   MDI_Buffers : Orka.Buffers.MDI.MDI_Buffers;

   Program_1 : constant Program := Orka.Programs.Create_Program (Modules.Create_Module
     (VS => "../examples/orka/shaders/test-4-module-1.vert",
      FS => "../examples/orka/shaders/test-4-module-1.frag"));

   Mesh_1 : constant Vertex_Format := Load_Mesh (Program_1, MDI_Buffers);
begin
   Program_1.Use_Program;

   while not GL_Test.Display_Backend.Get_Window.Should_Close loop
      Clear (Buffer_Bits'(Color => True, Depth => True, others => False));

      Mesh_1.Draw_Indirect (MDI_Buffers.Command_Buffer);

      GL_Test.Display_Backend.Swap_Buffers_And_Poll_Events;
   end loop;

   GL_Test.Display_Backend.Shutdown;
end Orka_Test.Test_4_MDI;

Fix MDI example

examples: Fix MDI example

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


-----------------------------------------------------------------------
--  ado-testsuite -- Testsuite for ADO
--  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 ADO.Tests;
with ADO.Sequences.Tests;
with ADO.Schemas.Tests;
with ADO.Objects.Tests;
with ADO.Queries.Tests;
with ADO.Parameters.Tests;
package body ADO.Testsuite is

   use ADO.Tests;

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

   procedure Drivers (Suite : in Util.Tests.Access_Test_Suite) is separate;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      ADO.Parameters.Tests.Add_Tests (Ret);
      ADO.Sequences.Tests.Add_Tests (Ret);
      ADO.Objects.Tests.Add_Tests (Ret);
      ADO.Tests.Add_Tests (Ret);
      ADO.Schemas.Tests.Add_Tests (Ret);
      Drivers (Ret);
      ADO.Queries.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

end ADO.Testsuite;

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

with ADO.Tests;
with ADO.Sequences.Tests;
with ADO.Schemas.Tests;
with ADO.Objects.Tests;
with ADO.Queries.Tests;
with ADO.Parameters.Tests;
with ADO.Datasets.Tests;
package body ADO.Testsuite is

   use ADO.Tests;

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

   procedure Drivers (Suite : in Util.Tests.Access_Test_Suite) is separate;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      ADO.Parameters.Tests.Add_Tests (Ret);
      ADO.Sequences.Tests.Add_Tests (Ret);
      ADO.Objects.Tests.Add_Tests (Ret);
      ADO.Tests.Add_Tests (Ret);
      ADO.Schemas.Tests.Add_Tests (Ret);
      Drivers (Ret);
      ADO.Queries.Tests.Add_Tests (Ret);
      ADO.Datasets.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

end ADO.Testsuite;

Add the new unit tests

Add the new unit tests


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

   --  Compute the SHA1 signature of the data stored in the buffer.
   procedure Sha1 (Buffer : in Babel.Files.Buffers.Buffer;
                   Result : out Util.Encoders.SHA1.Hash_Array);

   --  Write the SHA1 checksum for the files stored in the map.
   procedure Save_Checksum (Path  : in String;
                            Files : in Babel.Files.Maps.File_Map);

end Babel.Files.Signatures;

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

   --  Compute the SHA1 signature of the data stored in the buffer.
   procedure Sha1 (Buffer : in Babel.Files.Buffers.Buffer;
                   Result : out Util.Encoders.SHA1.Hash_Array);

   --  Compute the SHA1 signature of the file stream.
   procedure Sha1 (Stream : in Babel.Streams.Refs.Stream_Ref;
                   Result : out Util.Encoders.SHA1.Hash_Array);

   --  Write the SHA1 checksum for the files stored in the map.
   procedure Save_Checksum (Path  : in String;
                            Files : in Babel.Files.Maps.File_Map);

end Babel.Files.Signatures;

Define Sha1 procedure with a Stream_Ref object


-----------------------------------------------------------------------
--  gen-model-mappings -- Type mappings for Code Generator
--  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 Ada.Strings.Unbounded;
with Ada.Containers.Hashed_Maps;
with Ada.Strings.Unbounded.Hash;

with Util.Beans.Objects;

--  The Gen.Model.Mappings package controls the mappings to convert an XML
--  type into the Ada type.
package Gen.Model.Mappings is

   ADA_MAPPING    : constant String := "Ada05";

   MySQL_MAPPING  : constant String := "MySQL";

   SQLite_MAPPING : constant String := "SQLite";

   type Basic_Type is (T_BOOLEAN, T_INTEGER, T_DATE, T_ENUM, T_IDENTIFIER, T_STRING, T_BLOB);

   --  ------------------------------
   --  Mapping Definition
   --  ------------------------------
   type Mapping_Definition is new Definition with record
      Target        : Ada.Strings.Unbounded.Unbounded_String;
      Kind          : Basic_Type := T_INTEGER;
   end record;
   type Mapping_Definition_Access is access all Mapping_Definition'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Mapping_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Find the mapping for the given type name.
   function Find_Type (Name : in Ada.Strings.Unbounded.Unbounded_String)
                       return Mapping_Definition_Access;

   procedure Register_Type (Name    : in String;
                            Mapping : in Mapping_Definition_Access;
                            Kind    : in Basic_Type);

   --  Register a type mapping From that is mapped to Target.
   procedure Register_Type (Target        : in String;
                            From          : in String;
                            Kind          : in Basic_Type);

   --  Setup the type mapping for the language identified by the given name.
   procedure Set_Mapping_Name (Name : in String);

   package Mapping_Maps is
     new Ada.Containers.Hashed_Maps (Key_Type        => Ada.Strings.Unbounded.Unbounded_String,
                                     Element_Type    => Mapping_Definition_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => Ada.Strings.Unbounded."=");

end Gen.Model.Mappings;

-----------------------------------------------------------------------
--  gen-model-mappings -- Type mappings for Code Generator
--  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 Ada.Strings.Unbounded;
with Ada.Containers.Hashed_Maps;
with Ada.Strings.Unbounded.Hash;

with Util.Beans.Objects;

--  The Gen.Model.Mappings package controls the mappings to convert an XML
--  type into the Ada type.
package Gen.Model.Mappings is

   ADA_MAPPING    : constant String := "Ada05";

   MySQL_MAPPING  : constant String := "MySQL";

   SQLite_MAPPING : constant String := "SQLite";

   type Basic_Type is (T_BOOLEAN, T_INTEGER, T_DATE, T_ENUM, T_IDENTIFIER, T_STRING, T_BLOB);

   --  ------------------------------
   --  Mapping Definition
   --  ------------------------------
   type Mapping_Definition is new Definition with record
      Target        : Ada.Strings.Unbounded.Unbounded_String;
      Kind          : Basic_Type := T_INTEGER;
   end record;
   type Mapping_Definition_Access is access all Mapping_Definition'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Mapping_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Find the mapping for the given type name.
   function Find_Type (Name : in Ada.Strings.Unbounded.Unbounded_String)
                       return Mapping_Definition_Access;

   procedure Register_Type (Name    : in String;
                            Mapping : in Mapping_Definition_Access;
                            Kind    : in Basic_Type);

   --  Register a type mapping From that is mapped to Target.
   procedure Register_Type (Target        : in String;
                            From          : in String;
                            Kind          : in Basic_Type);

   --  Setup the type mapping for the language identified by the given name.
   procedure Set_Mapping_Name (Name : in String);

   package Mapping_Maps is
     new Ada.Containers.Hashed_Maps (Key_Type        => Ada.Strings.Unbounded.Unbounded_String,
                                     Element_Type    => Mapping_Definition_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => Ada.Strings.Unbounded."=");

   subtype Map is Mapping_Maps.Map;

   subtype Cursor is Mapping_Maps.Cursor;

end Gen.Model.Mappings;

Define the Map and Cursor subtypes

Define the Map and Cursor subtypes


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

with Util.Tests;

package ASF.Servlets.Tests is

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

   type Test_Servlet1 is new Servlet with null record;

   procedure Do_Get (Server   : in Test_Servlet1;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class);

   type Test_Servlet2 is new Test_Servlet1 with null record;

   procedure Do_Post (Server   : in Test_Servlet2;
                      Request  : in out Requests.Request'Class;
                      Response : in out Responses.Response'Class);

   type Test is new Util.Tests.Test with record
      Writer    : Integer;
   end record;

   --  Test creation of session
   procedure Test_Create_Servlet (T : in out Test);

   --  Test add servlet
   procedure Test_Add_Servlet (T : in out Test);

   --  Test getting a resource path
   procedure Test_Get_Resource (T : in out Test);

   procedure Test_Request_Dispatcher (T : in out Test);

   --  Test mapping and servlet path on a request.
   procedure Test_Servlet_Path (T : in out Test);

   --  Test mapping and servlet path on a request.
   procedure Test_Filter_Mapping (T : in out Test);

   --  Test execution of filters
   procedure Test_Filter_Execution (T : in out Test);

   --  Test execution of filters on complex mapping.
   procedure Test_Complex_Filter_Execution (T : in out Test);

   --  Check that the mapping for the given URI matches the server.
   procedure Check_Mapping (T      : in out Test;
                            Ctx    : in Servlet_Registry;
                            URI    : in String;
                            Server : in Servlet_Access;
                            Filter : in Natural := 0);

   --  Check that the request is done on the good servlet and with the correct servlet path
   --  and path info.
   procedure Check_Request (T            : in out Test;
                            Ctx          : in Servlet_Registry;
                            URI          : in String;
                            Servlet_Path : in String;
                            Path_Info    : in String);

end ASF.Servlets.Tests;

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

with Util.Tests;

package ASF.Servlets.Tests is

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

   type Test_Servlet1 is new Servlet with null record;

   procedure Do_Get (Server   : in Test_Servlet1;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class);

   type Test_Servlet2 is new Test_Servlet1 with null record;

   procedure Do_Post (Server   : in Test_Servlet2;
                      Request  : in out Requests.Request'Class;
                      Response : in out Responses.Response'Class);

   type Test is new Util.Tests.Test with record
      Writer    : Integer;
   end record;

   --  Test creation of session
   procedure Test_Create_Servlet (T : in out Test);

   --  Test add servlet
   procedure Test_Add_Servlet (T : in out Test);

   --  Test getting a resource path
   procedure Test_Get_Resource (T : in out Test);

   procedure Test_Request_Dispatcher (T : in out Test);

   --  Test mapping and servlet path on a request.
   procedure Test_Servlet_Path (T : in out Test);

   --  Test mapping and servlet path on a request.
   procedure Test_Filter_Mapping (T : in out Test);

   --  Test execution of filters
   procedure Test_Filter_Execution (T : in out Test);

   --  Test execution of filters on complex mapping.
   procedure Test_Complex_Filter_Execution (T : in out Test);

   --  Test execution of the cache control filter.
   procedure Test_Cache_Control_Filter (T : in out Test);

   --  Check that the mapping for the given URI matches the server.
   procedure Check_Mapping (T      : in out Test;
                            Ctx    : in Servlet_Registry;
                            URI    : in String;
                            Server : in Servlet_Access;
                            Filter : in Natural := 0);

   --  Check that the request is done on the good servlet and with the correct servlet path
   --  and path info.
   procedure Check_Request (T            : in out Test;
                            Ctx          : in Servlet_Registry;
                            URI          : in String;
                            Servlet_Path : in String;
                            Path_Info    : in String);

end ASF.Servlets.Tests;

Declare the Test_Cache_Control_Filter procedure


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

with Util.Tests;

package Util.Streams.Tests is

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

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

   procedure Test_Base64_Stream (T : in out Test);

   procedure Test_AES_Stream (T : in out Test);

end Util.Streams.Tests;

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

with Util.Tests;
with Util.Encoders.AES;

package Util.Streams.Tests is

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

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

   procedure Test_AES (T     : in out Test;
                       Item  : in String;
                       Count : in Positive;
                       Mode  : in Util.Encoders.AES.AES_Mode;
                       Label : in String);

   procedure Test_Base64_Stream (T : in out Test);

end Util.Streams.Tests;

Declare Test_AES procedure and remove Test_AES_Stream