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

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

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

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

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

   --  ------------------------------
   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   --  ------------------------------
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in Allocation) is
   begin
      Memory.Memory.Probe_Free (Addr, Slot);
   end Probe_Free;

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

   --  ------------------------------
   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   --  ------------------------------
   procedure Create_Frame (Memory : in out Target_Memory;
                           Pc     : in MAT.Frames.Frame_Table;
                           Result : out MAT.Frames.Frame_Type) is
   begin
      Memory.Memory.Create_Frame (Pc, Result);
   end Create_Frame;

   --  ------------------------------
   --  Collect the information about memory slot sizes allocated by the application.
   --  ------------------------------
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out MAT.Memory.Tools.Size_Info_Map) is
   begin
      Memory.Memory.Size_Information (Sizes);
   end Size_Information;

   --  ------------------------------
   --  Collect the information about threads and the memory allocations they've made.
   --  ------------------------------
   procedure Thread_Information (Memory  : in out Target_Memory;
                                 Threads : in out Memory_Info_Map) is
   begin
      Memory.Memory.Thread_Information (Threads);
   end Thread_Information;

   --  ------------------------------
   --  Collect the information about frames and the memory allocations they've made.
   --  ------------------------------
   procedure Frame_Information (Memory : in out Target_Memory;
                                Level  : in Natural;
                                Frames : in out Frame_Info_Map) is
   begin
      Memory.Memory.Frame_Information (Level, Frames);
   end Frame_Information;

   --  ------------------------------
   --  Get the global memory and allocation statistics.
   --  ------------------------------
   procedure Stat_Information (Memory : in out Target_Memory;
                               Result : out Memory_Stat) is
   begin
      Memory.Memory.Stat_Information (Result);
   end Stat_Information;

   --  ------------------------------
   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and which is selected by the given filter expression.
   --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
   --  the memory slot.
   --  ------------------------------
   procedure Find (Memory : in out Target_Memory;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Filter : in MAT.Expressions.Expression_Type;
                   Into   : in out MAT.Memory.Allocation_Map) is
   begin
      Memory.Memory.Find (From, To, Filter, Into);
   end Find;

   protected body Memory_Allocator is

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

      --  ------------------------------
      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      --  ------------------------------
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation) is
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Malloc at {0} size {1}", MAT.Types.Hex_Image (Addr),
                       MAT.Types.Target_Size'Image (Slot.Size));
         end if;
         Stats.Malloc_Count := Stats.Malloc_Count + 1;
         Stats.Total_Alloc := Stats.Total_Alloc + Slot.Size;
         Remove_Free (Addr, Slot.Size);
         Used_Slots.Insert (Addr, Slot);
      end Probe_Malloc;

      --  ------------------------------
      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      --  ------------------------------
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation) is
         Item : Allocation;
         Iter : Allocation_Cursor;
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Free {0}", MAT.Types.Hex_Image (Addr));
         end if;
         Stats.Free_Count := Stats.Free_Count + 1;
         Iter := Used_Slots.Find (Addr);
         if Allocation_Maps.Has_Element (Iter) then
            Item := Allocation_Maps.Element (Iter);
            if Stats.Total_Alloc >= Item.Size then
               Stats.Total_Alloc := Stats.Total_Alloc - Item.Size;
            else
               Stats.Total_Alloc := 0;
            end if;
            Stats.Total_Free := Stats.Total_Free + Item.Size;
            MAT.Frames.Release (Item.Frame);
            Used_Slots.Delete (Iter);
            Item.Frame := Slot.Frame;
            Freed_Slots.Insert (Addr, Item);
         end if;
      end Probe_Free;

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

         procedure Update_Size (Key     : in MAT.Types.Target_Addr;
                                Element : in out Allocation) is
            pragma Unreferenced (Key);
         begin
            if Stats.Total_Alloc >= Element.Size then
               Stats.Total_Alloc := Stats.Total_Alloc - Element.Size;
            else
               Stats.Total_Alloc := 0;
            end if;
            Element.Size := Slot.Size;
            MAT.Frames.Release (Element.Frame);
            Element.Frame := Slot.Frame;
         end Update_Size;

         Pos      : Allocation_Cursor;
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Realloc {0} to {1} size {2}", MAT.Types.Hex_Image (Old_Addr),
                       MAT.Types.Hex_Image (Addr), MAT.Types.Target_Size'Image (Slot.Size));
         end if;
         Stats.Realloc_Count := Stats.Realloc_Count + 1;
         if Addr /= 0 then
            Stats.Total_Alloc := Stats.Total_Alloc + Slot.Size;
            Pos := Used_Slots.Find (Old_Addr);
            if Allocation_Maps.Has_Element (Pos) then
               if Addr = Old_Addr then
                  Used_Slots.Update_Element (Pos, Update_Size'Access);
               else
                  Used_Slots.Delete (Pos);
                  Used_Slots.Insert (Addr, Slot);
               end if;
            else
               Used_Slots.Insert (Addr, Slot);
            end if;
            Remove_Free (Addr, Slot.Size);
         end if;
      end Probe_Realloc;

      --  ------------------------------
      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      --  ------------------------------
      procedure Create_Frame (Pc     : in MAT.Frames.Frame_Table;
                              Result : out MAT.Frames.Frame_Type) is
      begin
         MAT.Frames.Insert (Frames, Pc, Result);
      end Create_Frame;

      --  ------------------------------
      --  Collect the information about memory slot sizes allocated by the application.
      --  ------------------------------
      procedure Size_Information (Sizes  : in out MAT.Memory.Tools.Size_Info_Map) is
      begin
         MAT.Memory.Tools.Size_Information (Used_Slots, Sizes);
      end Size_Information;

      --  ------------------------------
      --  Collect the information about threads and the memory allocations they've made.
      --  ------------------------------
      procedure Thread_Information (Threads : in out Memory_Info_Map) is
      begin
         MAT.Memory.Tools.Thread_Information (Used_Slots, Threads);
      end Thread_Information;

      --  ------------------------------
      --  Collect the information about frames and the memory allocations they've made.
      --  ------------------------------
      procedure Frame_Information (Level  : in Natural;
                                   Frames : in out Frame_Info_Map) is
      begin
         MAT.Memory.Tools.Frame_Information (Used_Slots, Level, Frames);
      end Frame_Information;

      --  ------------------------------
      --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
      --  the region [From .. To] and which is selected by the given filter expression.
      --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
      --  the memory slot.
      --  ------------------------------
      procedure Find (From   : in MAT.Types.Target_Addr;
                      To     : in MAT.Types.Target_Addr;
                      Filter : in MAT.Expressions.Expression_Type;
                      Into   : in out MAT.Memory.Allocation_Map) is
      begin
         MAT.Memory.Tools.Find (Used_Slots, From, To, Filter, Into);
      end Find;

      --  ------------------------------
      --  Get the global memory and allocation statistics.
      --  ------------------------------
      procedure Stat_Information (Result : out Memory_Stat) is
      begin
         Result := Stats;
      end Stat_Information;

   end Memory_Allocator;

end MAT.Memory.Targets;

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

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

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

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

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

   --  ------------------------------
   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   --  ------------------------------
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in Allocation) is
   begin
      Memory.Memory.Probe_Free (Addr, Slot);
   end Probe_Free;

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

   --  ------------------------------
   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   --  ------------------------------
   procedure Create_Frame (Memory : in out Target_Memory;
                           Pc     : in MAT.Frames.Frame_Table;
                           Result : out MAT.Frames.Frame_Type) is
   begin
      Memory.Memory.Create_Frame (Pc, Result);
   end Create_Frame;

   --  ------------------------------
   --  Collect the information about memory slot sizes allocated by the application.
   --  ------------------------------
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out MAT.Memory.Tools.Size_Info_Map) is
   begin
      Memory.Memory.Size_Information (Sizes);
   end Size_Information;

   --  ------------------------------
   --  Collect the information about threads and the memory allocations they've made.
   --  ------------------------------
   procedure Thread_Information (Memory  : in out Target_Memory;
                                 Threads : in out Memory_Info_Map) is
   begin
      Memory.Memory.Thread_Information (Threads);
   end Thread_Information;

   --  ------------------------------
   --  Collect the information about frames and the memory allocations they've made.
   --  ------------------------------
   procedure Frame_Information (Memory : in out Target_Memory;
                                Level  : in Natural;
                                Frames : in out Frame_Info_Map) is
   begin
      Memory.Memory.Frame_Information (Level, Frames);
   end Frame_Information;

   --  ------------------------------
   --  Get the global memory and allocation statistics.
   --  ------------------------------
   procedure Stat_Information (Memory : in out Target_Memory;
                               Result : out Memory_Stat) is
   begin
      Memory.Memory.Stat_Information (Result);
   end Stat_Information;

   --  ------------------------------
   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and which is selected by the given filter expression.
   --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
   --  the memory slot.
   --  ------------------------------
   procedure Find (Memory : in out Target_Memory;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Filter : in MAT.Expressions.Expression_Type;
                   Into   : in out MAT.Memory.Allocation_Map) is
   begin
      Memory.Memory.Find (From, To, Filter, Into);
   end Find;

   protected body Memory_Allocator is

      --  ------------------------------
      --  Add the memory region from the list of memory region managed by the program.
      --  ------------------------------
      procedure Add_Region (Region : in Region_Info) is
      begin
         Regions.Insert (Region.Start_Addr, Region);
      end Add_Region;

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

      --  ------------------------------
      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      --  ------------------------------
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation) is
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Malloc at {0} size {1}", MAT.Types.Hex_Image (Addr),
                       MAT.Types.Target_Size'Image (Slot.Size));
         end if;
         Stats.Malloc_Count := Stats.Malloc_Count + 1;
         Stats.Total_Alloc := Stats.Total_Alloc + Slot.Size;
         Remove_Free (Addr, Slot.Size);
         Used_Slots.Insert (Addr, Slot);
      end Probe_Malloc;

      --  ------------------------------
      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      --  ------------------------------
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation) is
         Item : Allocation;
         Iter : Allocation_Cursor;
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Free {0}", MAT.Types.Hex_Image (Addr));
         end if;
         Stats.Free_Count := Stats.Free_Count + 1;
         Iter := Used_Slots.Find (Addr);
         if Allocation_Maps.Has_Element (Iter) then
            Item := Allocation_Maps.Element (Iter);
            if Stats.Total_Alloc >= Item.Size then
               Stats.Total_Alloc := Stats.Total_Alloc - Item.Size;
            else
               Stats.Total_Alloc := 0;
            end if;
            Stats.Total_Free := Stats.Total_Free + Item.Size;
            MAT.Frames.Release (Item.Frame);
            Used_Slots.Delete (Iter);
            Item.Frame := Slot.Frame;
            Freed_Slots.Insert (Addr, Item);
         end if;
      end Probe_Free;

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

         procedure Update_Size (Key     : in MAT.Types.Target_Addr;
                                Element : in out Allocation) is
            pragma Unreferenced (Key);
         begin
            if Stats.Total_Alloc >= Element.Size then
               Stats.Total_Alloc := Stats.Total_Alloc - Element.Size;
            else
               Stats.Total_Alloc := 0;
            end if;
            Element.Size := Slot.Size;
            MAT.Frames.Release (Element.Frame);
            Element.Frame := Slot.Frame;
         end Update_Size;

         Pos      : Allocation_Cursor;
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Realloc {0} to {1} size {2}", MAT.Types.Hex_Image (Old_Addr),
                       MAT.Types.Hex_Image (Addr), MAT.Types.Target_Size'Image (Slot.Size));
         end if;
         Stats.Realloc_Count := Stats.Realloc_Count + 1;
         if Addr /= 0 then
            Stats.Total_Alloc := Stats.Total_Alloc + Slot.Size;
            Pos := Used_Slots.Find (Old_Addr);
            if Allocation_Maps.Has_Element (Pos) then
               if Addr = Old_Addr then
                  Used_Slots.Update_Element (Pos, Update_Size'Access);
               else
                  Used_Slots.Delete (Pos);
                  Used_Slots.Insert (Addr, Slot);
               end if;
            else
               Used_Slots.Insert (Addr, Slot);
            end if;
            Remove_Free (Addr, Slot.Size);
         end if;
      end Probe_Realloc;

      --  ------------------------------
      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      --  ------------------------------
      procedure Create_Frame (Pc     : in MAT.Frames.Frame_Table;
                              Result : out MAT.Frames.Frame_Type) is
      begin
         MAT.Frames.Insert (Frames, Pc, Result);
      end Create_Frame;

      --  ------------------------------
      --  Collect the information about memory slot sizes allocated by the application.
      --  ------------------------------
      procedure Size_Information (Sizes  : in out MAT.Memory.Tools.Size_Info_Map) is
      begin
         MAT.Memory.Tools.Size_Information (Used_Slots, Sizes);
      end Size_Information;

      --  ------------------------------
      --  Collect the information about threads and the memory allocations they've made.
      --  ------------------------------
      procedure Thread_Information (Threads : in out Memory_Info_Map) is
      begin
         MAT.Memory.Tools.Thread_Information (Used_Slots, Threads);
      end Thread_Information;

      --  ------------------------------
      --  Collect the information about frames and the memory allocations they've made.
      --  ------------------------------
      procedure Frame_Information (Level  : in Natural;
                                   Frames : in out Frame_Info_Map) is
      begin
         MAT.Memory.Tools.Frame_Information (Used_Slots, Level, Frames);
      end Frame_Information;

      --  ------------------------------
      --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
      --  the region [From .. To] and which is selected by the given filter expression.
      --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
      --  the memory slot.
      --  ------------------------------
      procedure Find (From   : in MAT.Types.Target_Addr;
                      To     : in MAT.Types.Target_Addr;
                      Filter : in MAT.Expressions.Expression_Type;
                      Into   : in out MAT.Memory.Allocation_Map) is
      begin
         MAT.Memory.Tools.Find (Used_Slots, From, To, Filter, Into);
      end Find;

      --  ------------------------------
      --  Get the global memory and allocation statistics.
      --  ------------------------------
      procedure Stat_Information (Result : out Memory_Stat) is
      begin
         Result := Stats;
      end Stat_Information;

   end Memory_Allocator;

end MAT.Memory.Targets;

Implement the protected operation Add_Region


-----------------------------------------------------------------------
--  files.tests -- Unit tests for files
--  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.Tests;

package Util.Files.Tests is

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

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

   procedure Test_Read_File (T : in out Test);
   procedure Test_Read_File_Missing (T : in out Test);
   procedure Test_Read_File_Truncate (T : in out Test);
   procedure Test_Write_File (T : in out Test);
   procedure Test_Find_File_Path (T : in out Test);
   procedure Test_Iterate_Path (T : in out Test);
   procedure Test_Compose_Path (T : in out Test);

   --  Test the Get_Relative_Path operation.
   procedure Test_Get_Relative_Path (T : in out Test);

end Util.Files.Tests;

-----------------------------------------------------------------------
--  files.tests -- Unit tests for files
--  Copyright (C) 2009, 2010, 2011, 2012, 2022 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.Files.Tests is

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

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

   procedure Test_Read_File (T : in out Test);
   procedure Test_Read_File_Missing (T : in out Test);
   procedure Test_Read_File_Truncate (T : in out Test);
   procedure Test_Write_File (T : in out Test);
   procedure Test_Find_File_Path (T : in out Test);
   procedure Test_Iterate_Path (T : in out Test);
   procedure Test_Compose_Path (T : in out Test);

   --  Test the Get_Relative_Path operation.
   procedure Test_Get_Relative_Path (T : in out Test);

   --  Test the Delete_Tree operation.
   procedure Test_Delete_Tree (T : in out Test);

end Util.Files.Tests;

Declare the Test_Delete_Tree procedure

Declare the Test_Delete_Tree procedure


-----------------------------------------------------------------------
--  util-processes-os -- System specific and low level operations
--  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.Streams.Raw;
with Util.Systems.Os;
with Interfaces.C;
with Interfaces.C.Strings;

private package Util.Processes.Os is

   type System_Process is new Util.Processes.System_Process with record
      Argv       : Util.Systems.Os.Ptr_Ptr_Array := null;
      Argc       : Interfaces.C.Size_T := 0;
      In_File    : Util.Systems.Os.Ptr := Interfaces.C.Strings.Null_Ptr;
      Out_File   : Util.Systems.Os.Ptr := Interfaces.C.Strings.Null_Ptr;
      Err_File   : Util.Systems.Os.Ptr := Interfaces.C.Strings.Null_Ptr;
      Out_Append : Boolean := False;
      Err_Append : Boolean := False;
   end record;

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

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

   --  Spawn a new process.
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE);

   --  Append the argument to the process argument list.
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String);

   --  Set the process input, output and error streams to redirect and use specified files.
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean);

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

private

   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   function Create_Stream (File : in Util.Systems.Os.File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access;

end Util.Processes.Os;

-----------------------------------------------------------------------
--  util-processes-os -- System specific and low level operations
--  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.Streams.Raw;
with Util.Systems.Os;
with Interfaces.C;
with Interfaces.C.Strings;

private package Util.Processes.Os is

   type System_Process is new Util.Processes.System_Process with record
      Argv       : Util.Systems.Os.Ptr_Ptr_Array := null;
      Argc       : Interfaces.C.size_t := 0;
      In_File    : Util.Systems.Os.Ptr := Interfaces.C.Strings.Null_Ptr;
      Out_File   : Util.Systems.Os.Ptr := Interfaces.C.Strings.Null_Ptr;
      Err_File   : Util.Systems.Os.Ptr := Interfaces.C.Strings.Null_Ptr;
      Out_Append : Boolean := False;
      Err_Append : Boolean := False;
   end record;

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

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

   --  Spawn a new process.
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE);

   --  Append the argument to the process argument list.
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String);

   --  Set the process input, output and error streams to redirect and use specified files.
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean);

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

private

   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   function Create_Stream (File : in Util.Systems.Os.File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access;

end Util.Processes.Os;

Fix style in size_t identifier

Fix style in size_t identifier


-----------------------------------------------------------------------
--  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.Test_Caller;
with Util.Strings.Transforms;

with ADO.Utils;
with ADO.Sessions;

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

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

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

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

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

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

      exception
         when Invalid_Statement =>
            null;
      end;

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

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

   end Test_Query_Get_Value_T;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end ADO.Statements.Tests;

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

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

with ADO.Utils;
with ADO.Sessions;

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

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

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

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

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

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

      exception
         when Invalid_Statement =>
            null;
      end;

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

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

   end Test_Query_Get_Value_T;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   --  ------------------------------
   --  Test executing a SQL query and getting an invalid column.
   --  ------------------------------
   procedure Test_Invalid_Column (T : in out Test) is
      DB    : constant ADO.Sessions.Session := Regtests.Get_Database;
      Stmt  : ADO.Statements.Query_Statement;
      Count : Natural := 0;
      Name  : Ada.Strings.Unbounded.Unbounded_String;
      Value : Integer := 123456789;
   begin
      Stmt := DB.Create_Statement ("SELECT name FROM entity_type");
      Stmt.Execute;
      while Stmt.Has_Elements loop
         Name := Stmt.Get_Unbounded_String (0);
         T.Assert (Ada.Strings.Unbounded.Length (Name) > 0, "Invalid entity_type name");
         begin
            Value := Stmt.Get_Integer (1);
            Util.Tests.Fail (T, "No exception raised for Stmt.Get_Integer");

         exception
            when ADO.Statements.Invalid_Column =>
               null;
         end;
         begin
            Name := Stmt.Get_Unbounded_String (1);
            Util.Tests.Fail (T, "No exception raised for Stmt.Get_Unbounded_String");

         exception
            when ADO.Statements.Invalid_Column =>
               null;
         end;
         begin
            T.Assert (Stmt.Get_Boolean (1), "Get_Boolean");
            Util.Tests.Fail (T, "No exception raised for Stmt.Get_Unbounded_String");

         exception
            when ADO.Statements.Invalid_Column =>
               null;
         end;
         Util.Tests.Assert_Equals (T, 123456789, Value, "Value was corrupted");
         Count := Count + 1;
         Stmt.Next;
      end loop;
      T.Assert (Count > 0, "Query must return at least on entity_type");
   end Test_Invalid_Column;

end ADO.Statements.Tests;

Implement the Test_Invalid_Column procedure to verify the Invalid_Column exception is raised correctly


-----------------------------------------------------------------------
--  mat-readers -- Reader
--  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 Ada.Containers;
with Ada.Containers.Hashed_Maps;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;

with System;

with Util.Properties;

with MAT.Types;
with MAT.Events;
package MAT.Readers is

   type Buffer_Type is private;
   type Buffer_Ptr is access Buffer_Type;

   type Message is record
      Kind   : MAT.Events.Event_Type;
      Size   : Natural;
      Buffer : Buffer_Ptr;
   end record;

   -----------------
   --  Abstract servant definition
   -----------------
   --  The Servant is a small proxy that binds the specific message
   --  handlers to the client specific dispatcher.
   type Reader_Base is abstract tagged limited private;
   type Reader_Access is access all Reader_Base'Class;

   procedure Dispatch (For_Servant : in out Reader_Base;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Msg         : in out Message) is abstract;
   --  Dispatch the message

   procedure Bind (For_Servant : in out Reader_Base) is abstract;
   --  Bind the servant with the object adapter to register the
   --  events it recognizes.  This is called once we have all the
   --  information about the structures of events that we can
   --  receive.

   -----------------
   --  Ipc Client Manager
   -----------------
   --  The Manager is a kind of object adapter. It registers a collection
   --  of servants and dispatches incomming messages to those servants.
   type Manager_Base is tagged limited private;
   type Manager is access all Manager_Base'Class;

   --  Register the reader to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   procedure Register_Reader (Into   : in out Manager_Base;
                              Reader : in Reader_Access;
                              Name   : in String;
                              Id     : in MAT.Events.Internal_Reference;
                              Model  : in MAT.Events.Attribute_Table_Ptr);

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg    : in out Message);

private

   type Buffer_Type is record
      Current : System.Address;
      Start   : System.Address;
      Last    : System.Address;
      Size    : Natural;
      Total   : Natural;
   end record;

   type Reader_Base is abstract tagged limited record
      Owner : Manager := null;
   end record;

   --  Record a servant
   type Message_Handler is record
      For_Servant : Reader_Access;
      Id          : MAT.Events.Internal_Reference;
      Attributes  : MAT.Events.Attribute_Table_Ptr;
      Mapping     : MAT.Events.Attribute_Table_Ptr;
   end record;

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type;

   use type MAT.Types.Uint16;

   package Reader_Maps is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => Message_Handler,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=");

   --  Runtime handlers associated with the events.
   package Handler_Maps is
     new Ada.Containers.Hashed_Maps (Key_Type     => MAT.Types.Uint16,
                                     Element_Type => Message_Handler,
                                     Hash         => Hash,
                                     Equivalent_Keys => "=");

   type Manager_Base is tagged limited record
      Readers     : Reader_Maps.Map;
      Handlers    : Handler_Maps.Map;
      Version     : MAT.Types.Uint16;
      Flags       : MAT.Types.Uint16;
   end record;

   --  Read an event definition from the stream and configure the reader.
   procedure Read_Definition (Client : in out Manager_Base;
                              Msg    : in out Message);

end MAT.Readers;

-----------------------------------------------------------------------
--  mat-readers -- Reader
--  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 Ada.Containers;
with Ada.Containers.Hashed_Maps;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;

with System;

with Util.Properties;

with MAT.Types;
with MAT.Events;
package MAT.Readers is

   type Buffer_Type is private;
   type Buffer_Ptr is access Buffer_Type;

   type Message is record
      Kind   : MAT.Events.Event_Type;
      Size   : Natural;
      Buffer : Buffer_Ptr;
   end record;

   -----------------
   --  Abstract servant definition
   -----------------
   --  The Servant is a small proxy that binds the specific message
   --  handlers to the client specific dispatcher.
   type Reader_Base is abstract tagged limited private;
   type Reader_Access is access all Reader_Base'Class;

   procedure Dispatch (For_Servant : in out Reader_Base;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Msg         : in out Message) is abstract;
   --  Dispatch the message

--     procedure Bind (For_Servant : in out Reader_Base) is abstract;
   --  Bind the servant with the object adapter to register the
   --  events it recognizes.  This is called once we have all the
   --  information about the structures of events that we can
   --  receive.

   -----------------
   --  Ipc Client Manager
   -----------------
   --  The Manager is a kind of object adapter. It registers a collection
   --  of servants and dispatches incomming messages to those servants.
   type Manager_Base is tagged limited private;
   type Manager is access all Manager_Base'Class;

   --  Register the reader to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   procedure Register_Reader (Into   : in out Manager_Base;
                              Reader : in Reader_Access;
                              Name   : in String;
                              Id     : in MAT.Events.Internal_Reference;
                              Model  : in MAT.Events.Const_Attribute_Table_Access);

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg    : in out Message);

private

   type Buffer_Type is record
      Current : System.Address;
      Start   : System.Address;
      Last    : System.Address;
      Size    : Natural;
      Total   : Natural;
   end record;

   type Reader_Base is abstract tagged limited record
      Owner : Manager := null;
   end record;

   --  Record a servant
   type Message_Handler is record
      For_Servant : Reader_Access;
      Id          : MAT.Events.Internal_Reference;
      Attributes  : MAT.Events.Const_Attribute_Table_Access;
      Mapping     : MAT.Events.Attribute_Table_Ptr;
   end record;

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type;

   use type MAT.Types.Uint16;

   package Reader_Maps is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => Message_Handler,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=");

   --  Runtime handlers associated with the events.
   package Handler_Maps is
     new Ada.Containers.Hashed_Maps (Key_Type     => MAT.Types.Uint16,
                                     Element_Type => Message_Handler,
                                     Hash         => Hash,
                                     Equivalent_Keys => "=");

   type Manager_Base is tagged limited record
      Readers     : Reader_Maps.Map;
      Handlers    : Handler_Maps.Map;
      Version     : MAT.Types.Uint16;
      Flags       : MAT.Types.Uint16;
   end record;

   --  Read an event definition from the stream and configure the reader.
   procedure Read_Definition (Client : in out Manager_Base;
                              Msg    : in out Message);

end MAT.Readers;

Fix the Message_Handler and Register_Reader to use a constant attribute definition table


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

with ASF.Applications;

with ADO;
with ADO.Sessions;
with AWA.Events;
with AWA.Modules;
with AWA.Modules.Lifecycles;
with AWA.Wikis.Models;
with AWA.Wikis.Servlets;
with AWA.Tags.Beans;
with AWA.Counters.Definition;
with Security.Permissions;
with Wiki.Strings;

--  == Events ==
--  The <tt>wikis</tt> exposes a number of events which are posted when some action
--  are performed at the service level.
--
--  === wiki-create-page ===
--  This event is posted when a new wiki page is created.
--
--  === wiki-create-content ===
--  This event is posted when a new wiki page content is created.  Each time a wiki page is
--  modified, a new wiki page content is created and this event is posted.
--
package AWA.Wikis.Modules is

   --  The name under which the module is registered.
   NAME : constant String := "wikis";

   --  The configuration parameter that defines the image link prefix in rendered HTML content.
   PARAM_IMAGE_PREFIX : constant String := "image_prefix";

   --  The configuration parameter that defines the page link prefix in rendered HTML content.
   PARAM_PAGE_PREFIX : constant String := "page_prefix";

   package ACL_Create_Wiki_Pages is new Security.Permissions.Definition ("wiki-page-create");
   package ACL_Delete_Wiki_Pages is new Security.Permissions.Definition ("wiki-page-delete");
   package ACL_Update_Wiki_Pages is new Security.Permissions.Definition ("wiki-page-update");
   package ACL_View_Wiki_Page is new Security.Permissions.Definition ("wiki-page-view");

   --  Define the permissions.
   package ACL_Create_Wiki_Space is new Security.Permissions.Definition ("wiki-space-create");
   package ACL_Delete_Wiki_Space is new Security.Permissions.Definition ("wiki-space-delete");
   package ACL_Update_Wiki_Space is new Security.Permissions.Definition ("wiki-space-update");

   --  Event posted when a new wiki page is created.
   package Create_Page_Event is new AWA.Events.Definition (Name => "wiki-create-page");

   --  Event posted when a new wiki content is created.
   package Create_Content_Event is new AWA.Events.Definition (Name => "wiki-create-content");

   --  Define the read wiki page counter.
   package Read_Counter is new AWA.Counters.Definition (Models.WIKI_PAGE_TABLE, "read_count");

   package Wiki_Lifecycle is
     new AWA.Modules.Lifecycles (Element_Type => AWA.Wikis.Models.Wiki_Page_Ref'Class);

   subtype Listener is Wiki_Lifecycle.Listener;

   --  The configuration parameter that defines a list of wiki page ID to copy when a new
   --  wiki space is created.
   PARAM_WIKI_COPY_LIST : constant String := "wiki_copy_list";

   --  Exception raised when a wiki page name is already used for the wiki space.
   Name_Used : exception;

   --  ------------------------------
   --  Module wikis
   --  ------------------------------
   type Wiki_Module is new AWA.Modules.Module with private;
   type Wiki_Module_Access is access all Wiki_Module'Class;

   --  Initialize the wikis module.
   overriding
   procedure Initialize (Plugin : in out Wiki_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Configures the module after its initialization and after having read its XML configuration.
   overriding
   procedure Configure (Plugin : in out Wiki_Module;
                        Props  : in ASF.Applications.Config);

   --  Get the image prefix that was configured for the Wiki module.
   function Get_Image_Prefix (Module : in Wiki_Module)
                              return Wiki.Strings.UString;

   --  Get the page prefix that was configured for the Wiki module.
   function Get_Page_Prefix (Module : in Wiki_Module)
                              return Wiki.Strings.UString;

   --  Get the wikis module.
   function Get_Wiki_Module return Wiki_Module_Access;

   --  Create the wiki space.
   procedure Create_Wiki_Space (Module : in Wiki_Module;
                                Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class);

   --  Save the wiki space.
   procedure Save_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class);

   --  Load the wiki space.
   procedure Load_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class;
                              Id     : in ADO.Identifier);

   --  Create the wiki page into the wiki space.
   procedure Create_Wiki_Page (Model   : in Wiki_Module;
                               Into    : in AWA.Wikis.Models.Wiki_Space_Ref'Class;
                               Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                               Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class);

   --  Save the wiki page.
   procedure Save (Model  : in Wiki_Module;
                   Page   : in out AWA.Wikis.Models.Wiki_Page_Ref'Class);

   --  Delete the wiki page as well as all its versions.
   procedure Delete (Model  : in Wiki_Module;
                     Page   : in out AWA.Wikis.Models.Wiki_Page_Ref'Class);

   --  Load the wiki page and its content.
   procedure Load_Page (Model   : in Wiki_Module;
                        Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                        Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class;
                        Tags    : in out AWA.Tags.Beans.Tag_List_Bean;
                        Id      : in ADO.Identifier);

   --  Load the wiki page and its content from the wiki space Id and the page name.
   procedure Load_Page (Model   : in Wiki_Module;
                        Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                        Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class;
                        Tags    : in out AWA.Tags.Beans.Tag_List_Bean;
                        Wiki    : in ADO.Identifier;
                        Name    : in String);

   --  Create a new wiki content for the wiki page.
   procedure Create_Wiki_Content (Model   : in Wiki_Module;
                                  Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                                  Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class);

   --  Save a new wiki content for the wiki page.
   procedure Save_Wiki_Content (Model   : in Wiki_Module;
                                Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                                Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class);

   procedure Load_Image (Model    : in Wiki_Module;
                         Wiki_Id  : in ADO.Identifier;
                         Image_Id : in ADO.Identifier;
                         Mime     : out Ada.Strings.Unbounded.Unbounded_String;
                         Date     : out Ada.Calendar.Time;
                         Into     : out ADO.Blob_Ref);

private
   --  Copy the wiki page with its last version to the wiki space.
   procedure Copy_Page (Module  : in Wiki_Module;
                        DB      : in out ADO.Sessions.Master_Session;
                        Wiki    : in AWA.Wikis.Models.Wiki_Space_Ref'Class;
                        Page_Id : in ADO.Identifier);

   --  Copy the wiki page with its last version to the wiki space.
   procedure Copy_Page (Module  : in Wiki_Module;
                        DB      : in out ADO.Sessions.Master_Session;
                        Wiki    : in AWA.Wikis.Models.Wiki_Space_Ref'Class;
                        Page    : in AWA.Wikis.Models.Wiki_Page_Ref'Class);

   --  Save a new wiki content for the wiki page.
   procedure Save_Wiki_Content (Model   : in Wiki_Module;
                                DB      : in out ADO.Sessions.Master_Session;
                                Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                                Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class);

   type Wiki_Module is new AWA.Modules.Module with record
      Image_Prefix  : Wiki.Strings.UString;
      Image_Servlet : aliased AWA.Wikis.Servlets.Image_Servlet;
      Page_Prefix   : Wiki.Strings.UString;
   end record;

end AWA.Wikis.Modules;

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

with ASF.Applications;

with ADO;
with ADO.Sessions;
with AWA.Events;
with AWA.Modules;
with AWA.Modules.Lifecycles;
with AWA.Wikis.Models;
with AWA.Wikis.Servlets;
with AWA.Tags.Beans;
with AWA.Counters.Definition;
with Security.Permissions;
with Wiki.Strings;

--  == Events ==
--  The <tt>wikis</tt> exposes a number of events which are posted when some action
--  are performed at the service level.
--
--  === wiki-create-page ===
--  This event is posted when a new wiki page is created.
--
--  === wiki-create-content ===
--  This event is posted when a new wiki page content is created.  Each time a wiki page is
--  modified, a new wiki page content is created and this event is posted.
--
package AWA.Wikis.Modules is

   --  The name under which the module is registered.
   NAME : constant String := "wikis";

   --  The configuration parameter that defines the image link prefix in rendered HTML content.
   PARAM_IMAGE_PREFIX : constant String := "image_prefix";

   --  The configuration parameter that defines the page link prefix in rendered HTML content.
   PARAM_PAGE_PREFIX : constant String := "page_prefix";

   package ACL_Create_Wiki_Pages is new Security.Permissions.Definition ("wiki-page-create");
   package ACL_Delete_Wiki_Pages is new Security.Permissions.Definition ("wiki-page-delete");
   package ACL_Update_Wiki_Pages is new Security.Permissions.Definition ("wiki-page-update");
   package ACL_View_Wiki_Page is new Security.Permissions.Definition ("wiki-page-view");

   --  Define the permissions.
   package ACL_Create_Wiki_Space is new Security.Permissions.Definition ("wiki-space-create");
   package ACL_Delete_Wiki_Space is new Security.Permissions.Definition ("wiki-space-delete");
   package ACL_Update_Wiki_Space is new Security.Permissions.Definition ("wiki-space-update");

   --  Event posted when a new wiki page is created.
   package Create_Page_Event is new AWA.Events.Definition (Name => "wiki-create-page");

   --  Event posted when a new wiki content is created.
   package Create_Content_Event is new AWA.Events.Definition (Name => "wiki-create-content");

   --  Define the read wiki page counter.
   package Read_Counter is new AWA.Counters.Definition (Models.WIKI_PAGE_TABLE, "read_count");

   package Wiki_Lifecycle is
     new AWA.Modules.Lifecycles (Element_Type => AWA.Wikis.Models.Wiki_Page_Ref'Class);

   subtype Listener is Wiki_Lifecycle.Listener;

   --  The configuration parameter that defines a list of wiki page ID to copy when a new
   --  wiki space is created.
   PARAM_WIKI_COPY_LIST : constant String := "wiki_copy_list";

   --  Exception raised when a wiki page name is already used for the wiki space.
   Name_Used : exception;

   --  ------------------------------
   --  Module wikis
   --  ------------------------------
   type Wiki_Module is new AWA.Modules.Module with private;
   type Wiki_Module_Access is access all Wiki_Module'Class;

   --  Initialize the wikis module.
   overriding
   procedure Initialize (Plugin : in out Wiki_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Configures the module after its initialization and after having read its XML configuration.
   overriding
   procedure Configure (Plugin : in out Wiki_Module;
                        Props  : in ASF.Applications.Config);

   --  Get the image prefix that was configured for the Wiki module.
   function Get_Image_Prefix (Module : in Wiki_Module)
                              return Wiki.Strings.UString;

   --  Get the page prefix that was configured for the Wiki module.
   function Get_Page_Prefix (Module : in Wiki_Module)
                              return Wiki.Strings.UString;

   --  Get the wikis module.
   function Get_Wiki_Module return Wiki_Module_Access;

   --  Create the wiki space.
   procedure Create_Wiki_Space (Module : in Wiki_Module;
                                Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class);

   --  Save the wiki space.
   procedure Save_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class);

   --  Load the wiki space.
   procedure Load_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class;
                              Id     : in ADO.Identifier);

   --  Create the wiki page into the wiki space.
   procedure Create_Wiki_Page (Model   : in Wiki_Module;
                               Into    : in AWA.Wikis.Models.Wiki_Space_Ref'Class;
                               Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                               Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class);

   --  Save the wiki page.
   procedure Save (Model  : in Wiki_Module;
                   Page   : in out AWA.Wikis.Models.Wiki_Page_Ref'Class);

   --  Delete the wiki page as well as all its versions.
   procedure Delete (Model  : in Wiki_Module;
                     Page   : in out AWA.Wikis.Models.Wiki_Page_Ref'Class);

   --  Load the wiki page and its content.
   procedure Load_Page (Model   : in Wiki_Module;
                        Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                        Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class;
                        Tags    : in out AWA.Tags.Beans.Tag_List_Bean;
                        Id      : in ADO.Identifier);

   --  Load the wiki page and its content from the wiki space Id and the page name.
   procedure Load_Page (Model   : in Wiki_Module;
                        Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                        Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class;
                        Tags    : in out AWA.Tags.Beans.Tag_List_Bean;
                        Wiki    : in ADO.Identifier;
                        Name    : in String);

   --  Create a new wiki content for the wiki page.
   procedure Create_Wiki_Content (Model   : in Wiki_Module;
                                  Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                                  Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class);

   --  Save a new wiki content for the wiki page.
   procedure Save_Wiki_Content (Model   : in Wiki_Module;
                                Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                                Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class);

   procedure Load_Image (Model    : in Wiki_Module;
                         Wiki_Id  : in ADO.Identifier;
                         Image_Id : in ADO.Identifier;
                         Width    : in out Natural;
                         Height   : in out Natural;
                         Mime     : out Ada.Strings.Unbounded.Unbounded_String;
                         Date     : out Ada.Calendar.Time;
                         Into     : out ADO.Blob_Ref);

private
   --  Copy the wiki page with its last version to the wiki space.
   procedure Copy_Page (Module  : in Wiki_Module;
                        DB      : in out ADO.Sessions.Master_Session;
                        Wiki    : in AWA.Wikis.Models.Wiki_Space_Ref'Class;
                        Page_Id : in ADO.Identifier);

   --  Copy the wiki page with its last version to the wiki space.
   procedure Copy_Page (Module  : in Wiki_Module;
                        DB      : in out ADO.Sessions.Master_Session;
                        Wiki    : in AWA.Wikis.Models.Wiki_Space_Ref'Class;
                        Page    : in AWA.Wikis.Models.Wiki_Page_Ref'Class);

   --  Save a new wiki content for the wiki page.
   procedure Save_Wiki_Content (Model   : in Wiki_Module;
                                DB      : in out ADO.Sessions.Master_Session;
                                Page    : in out AWA.Wikis.Models.Wiki_Page_Ref'Class;
                                Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class);

   type Wiki_Module is new AWA.Modules.Module with record
      Image_Prefix  : Wiki.Strings.UString;
      Image_Servlet : aliased AWA.Wikis.Servlets.Image_Servlet;
      Page_Prefix   : Wiki.Strings.UString;
   end record;

end AWA.Wikis.Modules;

Change Load_Image to have a Width and Height parameter