-- Simple Lumen demo/test program, using earliest incomplete library
--
-- Build with: gnatmake square

with Ada.Text_IO;

with Lumen.Window;
with Lumen.Events.Keys;
with Lumen.Joystick;

with GL;
with GLU;

procedure Square is

   ---------------------------------------------------------------------------

   Win     : Lumen.Window.Handle;
   Event   : Lumen.Events.Event_Data;
   Stick   : Lumen.Joystick.Handle;
   Joy     : Lumen.Joystick.Joystick_Event_Data;

   ---------------------------------------------------------------------------

   -- Set or reset the window view parameters
   procedure Set_View (W, H : in GL.GLsizei) is

      use GL;
      use GLU;

      Aspect : GLdouble;

   begin  -- Set_View

      -- Viewport dimensions
      glViewport (0, 0, W, H);

      -- Set up the projection matrix based on the window's shape--wider than
      -- high, or higher than wide
      glMatrixMode (GL_PROJECTION);
      glLoadIdentity;
      if W <= H then
         Aspect := GLdouble (H) / GLdouble (W);
         gluOrtho2D (-2.0, 2.0, -2.0 * Aspect, 2.0 * Aspect);
      else
         Aspect := GLdouble (W) / GLdouble (H);
         gluOrtho2D (-2.0 * Aspect, 2.0 * Aspect, -2.0, 2.0);
      end if;
   end Set_View;

   ---------------------------------------------------------------------------

   package IIO is new Ada.Text_IO.Integer_IO (Lumen.Events.Key_Symbol);

   ---------------------------------------------------------------------------

begin  -- Square

   -- Create Lumen window, accepting most defaults; turn double buffering off
   -- for simplicity
   Lumen.Window.Create (Win, Name => "Ooh, Square!", Animated => False,
                        Events => (Lumen.Window.Want_Key_Press => True, others => False));

   Set_View (400, 400);

   -- Try opening first joystick
   Lumen.Joystick.Open (Stick);

   -- Loop until user hits a key or clicks the window's Close button
   Outer: loop

      -- Process window events if there are any pending
      while Lumen.Events.Pending (Win) > 0 loop
         declare
            use type Lumen.Events.Event_Type;
         begin
            Event := Lumen.Events.Next_Event (Win);

            -- Exit when they destroy the window
            exit Outer when Event.Which = Lumen.Events.Close_Window;

            -- Check for keypresses
            if Event.Which = Lumen.Events.Key_Press then
               declare
                  use Ada.Text_IO;
                  use Lumen.Events;
               begin
                  Put ("Got ");
                  IIO.Put (Event.Key_Data.Key, Width => 1, Base => 16);
                  if Event.Key_Data.Key_Type = Key_Graphic then
                     Put (" '" & To_Character (Event.Key_Data.Key) & "'");
                  end if;
                  New_Line;

                  exit Outer when
                     (Event.Key_Data.Key_Type = Key_Control and then To_Character (Event.Key_Data.Key) = ASCII.ESC) or
                     (Event.Key_Data.Key_Type = Key_Graphic and then To_Character (Event.Key_Data.Key) = 'q');
               end;
            end if;

            -- If we were resized, adjust the viewport dimensions
            if Event.Which = Lumen.Events.Resized then
               Set_View (GL.GLsizei (Event.Resize_Data.Width), GL.GLsizei (Event.Resize_Data.Height));
            end if;
         end;
      end loop;

      -- Process joystick events if there are any pending
      while Lumen.Joystick.Pending (Stick) > 0 loop
         declare
            use Ada.Text_IO;
            use Lumen.Joystick;
         begin
            Joy := Next_Event (Stick);
            case Joy.Which is
               when Joystick_Button_Press =>
                  Put_Line ("Button" & Positive'Image (Joy.Number) & " press");

               when Joystick_Button_Release =>
                  Put_Line ("Button" & Positive'Image (Joy.Number) & " release");

               when Joystick_Axis_Change =>
                  Put_Line ("Axis" & Positive'Image (Joy.Number) & " --> " & Integer'Image (Joy.Axis_Value));
            end case;
         end;
      end loop;

      -- Do our drawing
      declare
         use GL;
      begin
         glClearColor (0.0, 0.0, 0.0, 0.0);
         glClear (GL_COLOR_BUFFER_BIT);

         glColor3f (1.0, 1.0, 1.0);

         glBegin (GL_POLYGON);
         begin
            glVertex2f (-0.5, -0.5);
            glVertex2f (-0.5, 0.5);
            glVertex2f (0.5, 0.5);
            glVertex2f (0.5, -0.5);
         end;
         glEnd;

         glRotated (20.0, 0.0, 0.0, 1.0);

         glFlush;
         delay 0.25;
      end;
   end loop Outer;

end Square;

-- Simple Lumen demo/test program, using earliest incomplete library
--
-- Build with: gnatmake square

with Ada.Text_IO;

with Lumen.Window;
with Lumen.Events.Keys;
with Lumen.Joystick;

with GL;
with GLU;

procedure Square is

   ---------------------------------------------------------------------------

   Win     : Lumen.Window.Handle;
   Event   : Lumen.Events.Event_Data;
   Have_JS : Boolean;
   Stick   : Lumen.Joystick.Handle;
   Joy     : Lumen.Joystick.Joystick_Event_Data;

   ---------------------------------------------------------------------------

   -- Set or reset the window view parameters
   procedure Set_View (W, H : in GL.GLsizei) is

      use GL;
      use GLU;

      Aspect : GLdouble;

   begin  -- Set_View

      -- Viewport dimensions
      glViewport (0, 0, W, H);

      -- Set up the projection matrix based on the window's shape--wider than
      -- high, or higher than wide
      glMatrixMode (GL_PROJECTION);
      glLoadIdentity;
      if W <= H then
         Aspect := GLdouble (H) / GLdouble (W);
         gluOrtho2D (-2.0, 2.0, -2.0 * Aspect, 2.0 * Aspect);
      else
         Aspect := GLdouble (W) / GLdouble (H);
         gluOrtho2D (-2.0 * Aspect, 2.0 * Aspect, -2.0, 2.0);
      end if;
   end Set_View;

   ---------------------------------------------------------------------------

   package IIO is new Ada.Text_IO.Integer_IO (Lumen.Events.Key_Symbol);

   ---------------------------------------------------------------------------

begin  -- Square

   -- Create Lumen window, accepting most defaults; turn double buffering off
   -- for simplicity
   Lumen.Window.Create (Win, Name => "Ooh, Square!", Animated => False,
                        Events => (Lumen.Window.Want_Key_Press => True, others => False));

   Set_View (400, 400);

   -- Try opening first joystick
   begin
      Lumen.Joystick.Open (Stick);
      Have_JS := True;

   exception
      when others =>
         Ada.Text_IO.Put_Line ("You don't seem to have a joystick.  Too bad!");
         Have_JS := False;
   end;

   -- Loop until user hits a key or clicks the window's Close button
   Outer: loop

      -- Process window events if there are any pending
      while Lumen.Events.Pending (Win) > 0 loop
         declare
            use type Lumen.Events.Event_Type;
         begin
            Event := Lumen.Events.Next_Event (Win);

            -- Exit when they destroy the window
            exit Outer when Event.Which = Lumen.Events.Close_Window;

            -- Check for keypresses
            if Event.Which = Lumen.Events.Key_Press then
               declare
                  use Ada.Text_IO;
                  use Lumen.Events;
               begin
                  Put ("Got ");
                  IIO.Put (Event.Key_Data.Key, Width => 1, Base => 16);
                  if Event.Key_Data.Key_Type = Key_Graphic then
                     Put (" '" & To_Character (Event.Key_Data.Key) & "'");
                  end if;
                  New_Line;

                  exit Outer when
                     (Event.Key_Data.Key_Type = Key_Control and then To_Character (Event.Key_Data.Key) = ASCII.ESC) or
                     (Event.Key_Data.Key_Type = Key_Graphic and then To_Character (Event.Key_Data.Key) = 'q');
               end;
            end if;

            -- If we were resized, adjust the viewport dimensions
            if Event.Which = Lumen.Events.Resized then
               Set_View (GL.GLsizei (Event.Resize_Data.Width), GL.GLsizei (Event.Resize_Data.Height));
            end if;
         end;
      end loop;

      -- Process joystick events if there are any pending
      if Have_JS then
         while Lumen.Joystick.Pending (Stick) > 0 loop
            declare
               use Ada.Text_IO;
               use Lumen.Joystick;
            begin
               Joy := Next_Event (Stick);
               case Joy.Which is
                  when Joystick_Button_Press =>
                     Put_Line ("Button" & Positive'Image (Joy.Number) & " press");

                  when Joystick_Button_Release =>
                     Put_Line ("Button" & Positive'Image (Joy.Number) & " release");

                  when Joystick_Axis_Change =>
                     Put_Line ("Axis" & Positive'Image (Joy.Number) & " --> " & Integer'Image (Joy.Axis_Value));
               end case;
            end;
         end loop;
      end if;

      -- Do our drawing
      declare
         use GL;
      begin
         glClearColor (0.0, 0.0, 0.0, 0.0);
         glClear (GL_COLOR_BUFFER_BIT);

         glColor3f (1.0, 1.0, 1.0);

         glBegin (GL_POLYGON);
         begin
            glVertex2f (-0.5, -0.5);
            glVertex2f (-0.5, 0.5);
            glVertex2f (0.5, 0.5);
            glVertex2f (0.5, -0.5);
         end;
         glEnd;

         glRotated (20.0, 0.0, 0.0, 1.0);

         glFlush;
         delay 0.25;
      end;
   end loop Outer;

end Square;

Allow demo to be run without a joystick

Allow demo to be run without a joystick


-----------------------------------------------------------------------
--  awa-events-configs -- Event configuration
--  Copyright (C) 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 Ada.Strings.Unbounded;

with Util.Beans.Objects;
with Util.Serialize.IO.XML;
with EL.Expressions;
with EL.Beans;
with EL.Contexts;
with ADO.Sessions;

with AWA.Events.Queues;
with AWA.Events.Services;
package AWA.Events.Configs is

   --  ------------------------------
   --  Event Config Controller
   --  ------------------------------
   type Controller_Config is record
      Name       : Util.Beans.Objects.Object;
      Queue      : AWA.Events.Queues.Queue_Ref;
      Queue_Type : Util.Beans.Objects.Object;
      Prop_Name  : Util.Beans.Objects.Object;
      Params     : EL.Beans.Param_Vectors.Vector;
      Priority   : Integer;
      Count      : Integer;
      Manager    : AWA.Events.Services.Event_Manager_Access;
      Action     : EL.Expressions.Method_Expression;
      Properties : EL.Beans.Param_Vectors.Vector;
      Context    : EL.Contexts.ELContext_Access;
      Session    : ADO.Sessions.Session;
      Match      : Ada.Strings.Unbounded.Unbounded_String;
   end record;
   type Controller_Config_Access is access all Controller_Config;

   type Config_Fields is (FIELD_ON_EVENT, FIELD_NAME, FIELD_QUEUE_NAME, FIELD_ACTION,
                          FIELD_PROPERTY_NAME, FIELD_QUEUE, FIELD_TYPE,
                          FIELD_PROPERTY_VALUE,
                          FIELD_DISPATCHER, FIELD_DISPATCHER_QUEUE, FIELD_DISPATCHER_PRIORITY,
                          FIELD_DISPATCHER_COUNT);

   --  Set the configuration value identified by Value after having parsed
   --  the element identified by Field.
   procedure Set_Member (Into  : in out Controller_Config;
                         Field : in Config_Fields;
                         Value : in Util.Beans.Objects.Object);

   --  Setup the XML parser to read the queue and on-event description.
   --  For example:
   --
   --  <dispatcher name="async">
   --     <queue name="async"/>
   --     <queue name="persist"/>
   --     <count>4</count>
   --     <priority>10</priority>
   --  </dispatcher>
   --
   --  <queue name="async" type="fifo">
   --     <property name="size">254</property>
   --  </queue>
   --
   --  <queue name="defer" type="persist">
   --  </queue>
   --
   --  <on-event name="create-user" queue="async">
   --     <action>#{mail.send}</action>
   --     <property name="user">#{event.name}</property>
   --     <property name="template">mail/welcome.xhtml</property>
   --  </on-event>
   --
   --  This defines an event action called when the create-user event is posted.
   --  The Ada bean mail is created and is populated with the user and
   --  template properties.  The Ada bean action method send is called.
   generic
      Reader  : in out Util.Serialize.IO.XML.Parser;
      Manager : in AWA.Events.Services.Event_Manager_Access;
      Context : in EL.Contexts.ELContext_Access;
   package Reader_Config is
      Config : aliased Controller_Config;
   end Reader_Config;

end AWA.Events.Configs;

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

with Util.Beans.Objects;
with Util.Serialize.Mappers;
with EL.Expressions;
with EL.Beans;
with EL.Contexts;
with ADO.Sessions;

with AWA.Events.Queues;
with AWA.Events.Services;
package AWA.Events.Configs is

   --  ------------------------------
   --  Event Config Controller
   --  ------------------------------
   type Controller_Config is record
      Name       : Util.Beans.Objects.Object;
      Queue      : AWA.Events.Queues.Queue_Ref;
      Queue_Type : Util.Beans.Objects.Object;
      Prop_Name  : Util.Beans.Objects.Object;
      Params     : EL.Beans.Param_Vectors.Vector;
      Priority   : Integer;
      Count      : Integer;
      Manager    : AWA.Events.Services.Event_Manager_Access;
      Action     : EL.Expressions.Method_Expression;
      Properties : EL.Beans.Param_Vectors.Vector;
      Context    : EL.Contexts.ELContext_Access;
      Session    : ADO.Sessions.Session;
      Match      : Ada.Strings.Unbounded.Unbounded_String;
   end record;
   type Controller_Config_Access is access all Controller_Config;

   type Config_Fields is (FIELD_ON_EVENT, FIELD_NAME, FIELD_QUEUE_NAME, FIELD_ACTION,
                          FIELD_PROPERTY_NAME, FIELD_QUEUE, FIELD_TYPE,
                          FIELD_PROPERTY_VALUE,
                          FIELD_DISPATCHER, FIELD_DISPATCHER_QUEUE, FIELD_DISPATCHER_PRIORITY,
                          FIELD_DISPATCHER_COUNT);

   --  Set the configuration value identified by Value after having parsed
   --  the element identified by Field.
   procedure Set_Member (Into  : in out Controller_Config;
                         Field : in Config_Fields;
                         Value : in Util.Beans.Objects.Object);

   --  Setup the XML parser to read the queue and on-event description.
   --  For example:
   --
   --  <dispatcher name="async">
   --     <queue name="async"/>
   --     <queue name="persist"/>
   --     <count>4</count>
   --     <priority>10</priority>
   --  </dispatcher>
   --
   --  <queue name="async" type="fifo">
   --     <property name="size">254</property>
   --  </queue>
   --
   --  <queue name="defer" type="persist">
   --  </queue>
   --
   --  <on-event name="create-user" queue="async">
   --     <action>#{mail.send}</action>
   --     <property name="user">#{event.name}</property>
   --     <property name="template">mail/welcome.xhtml</property>
   --  </on-event>
   --
   --  This defines an event action called when the create-user event is posted.
   --  The Ada bean mail is created and is populated with the user and
   --  template properties.  The Ada bean action method send is called.
   generic
      Mapper  : in out Util.Serialize.Mappers.Processing;
      Manager : in AWA.Events.Services.Event_Manager_Access;
      Context : in EL.Contexts.ELContext_Access;
   package Reader_Config is
      Config : aliased Controller_Config;
   end Reader_Config;

end AWA.Events.Configs;

Update the Prepare_Config to use the new parser/mapper interface


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

package Wiki.Utils is

   --  Render the wiki text according to the wiki syntax in HTML into a string.
   function To_Html (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Wiki_Syntax) return String;

   --  Render the wiki text according to the wiki syntax in text into a string.
   --  Wiki formatting and decoration are removed.
   function To_Text (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Wiki_Syntax) return String;

end Wiki.Utils;

-----------------------------------------------------------------------
--  wiki-utils -- Wiki utility operations
--  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 Wiki.Strings;
package Wiki.Utils is

   --  Render the wiki text according to the wiki syntax in HTML into a string.
   function To_Html (Text   : in Wiki.Strings.WString;
                     Syntax : in Wiki.Wiki_Syntax) return String;

   --  Render the wiki text according to the wiki syntax in text into a string.
   --  Wiki formatting and decoration are removed.
   function To_Text (Text   : in Wiki.Strings.WString;
                     Syntax : in Wiki.Wiki_Syntax) return String;

end Wiki.Utils;

Use the Wiki.Strings.WString type

Use the Wiki.Strings.WString type


----------------------------------------------------------------------
-- Ada for POSIX (AdaFPX)
----------------------------------------------------------------------
-- Warren W. Gay VE3WWG     Tue Dec  3 18:49:48 2013
--
-- This is generated source code. Edit at your own risk.

package body Posix is

   function C_Last(C_String: String) return Natural is
   begin
      for X in C_String'Range loop
         if Character'Pos(C_String(X)) = 0 then
            return Natural(X-1);
         end if;
      end loop;
      return C_String'Last;
   end C_Last;

   function To_Count(Status: ssize_t) return Natural is
   begin
      if Status <= 0 then
         return 0;
      else
         return Natural(Status);
      end if;
   end To_Count;

   pragma Inline(To_Count);

   function To_Count(Status: int_t) return Natural is
   begin
      if Status <= 0 then
         return 0;
      else
         return Natural(Status);
      end if;
   end To_Count;

   pragma Inline(To_Count);

   function C_Error(Ret_Val: int_t) return errno_t is
      function c_errno return errno_t;
      pragma Import(C,c_errno,"c_errno");
   begin
      if Ret_Val >= 0 then
         return 0;
      else
         return c_errno;
      end if;
   end C_Error;

   pragma Inline(C_Error);

   function C_Error(Ret_Val: ssize_t) return errno_t is
      function c_errno return errno_t;
      pragma Import(C,c_errno,"c_errno");
   begin
      if Ret_Val >= 0 then
         return 0;
      else
         return c_errno;
      end if;
   end C_Error;

   pragma Inline(C_Error);

   function C_Error(PID: pid_t) return errno_t is
      function c_errno return errno_t;
      pragma Import(C,c_errno,"c_errno");
   begin
      if PID /= -1 then
         return 0;
      else
         return c_errno;
      end if;
   end C_Error;

   pragma Inline(C_Error);

   function C_Error(Ret_Val: clock_t) return errno_t is
      function c_errno return errno_t;
      pragma Import(C,c_errno,"c_errno");
   begin
      pragma Warnings(Off,"condition is always False");
      if Ret_Val < 0 or  else Ret_Val = clock_t'Last then
         return c_errno;
      else
         return 0;
      end if;
      pragma Warnings(On,"condition is always False");
   end C_Error;

   function C_Error(Ret_Val: sig_t) return errno_t is
      function c_errno return errno_t;
      pragma Import(C,c_errno,"c_errno");
   begin
      if Ret_Val = SIG_ERR then
         return c_errno;
      else
         return 0;
      end if;
   end C_Error;

   function C_String(Ada_String: String) return String is
      T : String(Ada_String'First..Ada_String'Last+1);
   begin
      T(T'First..T'Last-1) := Ada_String;
      T(T'Last) := Character'Val(0);
      return T;
   end C_String;

   function Ada_String(C_String: String) return String is
   begin
      for X in C_String'Range loop
         if Character'Pos(C_String(X)) = 0 then
            return C_String(C_String'First..X-1);
         end if;
      end loop;
      return C_String;
   end Ada_String;

   function Pos_PID(Status: int_t) return pid_t is
   begin
      if Status >= 0 then
         return pid_t(Status);
      else
         return 0;
      end if;
   end Pos_PID;

   pragma Inline(Pos_PID);

   function Neg_PID(Status: int_t) return pid_t is
   begin
      if Status < 0 then
         return pid_t(-Status);
      else
         return 0;
      end if;
   end Neg_PID;

   pragma Inline(Neg_PID);

   function Argv_Length(Argvs: String) return Natural is
      Count : Natural := 0;
   begin
      for X in Argvs'Range loop
         if Character'Pos(Argvs(x)) = 0 then
            Count := Count + 1;
         end if;
      end loop;
      return Count + 1;
   end Argv_Length;

   function Argv_Length(Argv: argv_array) return Natural is
      use System;
   begin
      for X in Argv'Range loop
         if Argv(X) = System.Null_Address then
            return X - Argv'First;
         end if;
      end loop;
      return Argv'Length;
   end Argv_Length;

   procedure Find_Nul(S: String; X: out Natural; Found: out Boolean) is
   begin
      for Y in S'Range loop
         if Character'Pos(S(Y)) = 0 then
            X := Y;
            Found := True;
         end if;
      end loop;
      X := S'Last;
      Found := False;
   end Find_Nul;

   function To_Argv(Argvs: String) return argv_array is
      Count : constant Natural := Argv_Length(Argvs);
      X :     Natural := Argvs'First;
      Y :     Natural;
      Found : Boolean;
   begin
      declare
         Argv :  argv_array(0..Count-1);
         Arg_X : Natural := Argv'First;
      begin
         while X <= Argvs'Last loop
            Find_Nul(Argvs(X..Argv'Last),Y,Found);
            exit when not Found;
            Argv(Arg_X) := Argvs(X)'Address;
            Arg_X       := Arg_X + 1;
            X           := Y + 1;
         end loop;
         Argv(Arg_X) := System.Null_Address;
         return Argv;
      end;
   end To_Argv;

   procedure To_Argv(Argvs: String; Argv: out argv_array) is
      Count : Natural := Argv_Length(Argvs);
      Arg_X : Natural := Argv'First;
      C :     Natural := 0;
      X :     Natural := Argvs'First;
      Y :     Natural;
      Found : Boolean;
   begin
      pragma Assert(Argv'Length>1);

      if Count > Argv'Length then
         Count := Argv'Length - 1;
      end if;

      while C < Count and X <= Argvs'Last loop
          Find_Nul(Argvs(X..Argv'Last),Y,Found);
          exit when not Found;
          Argv(Arg_X) := Argvs(X)'Address;
          Arg_X       := Arg_X + 1;
          X           := Y + 1;
          C           := C + 1;
      end loop;

      Argv(Arg_X) := System.Null_Address;

   end To_Argv;

   function To_Clock(Ticks: clock_t) return clock_t is
   begin
        pragma Warnings(Off,"condition is always False");
        if Ticks < 0 or else Ticks = clock_t'Last then
            return 0;
        else
            return Ticks;
        end if;
        pragma Warnings(On,"condition is always False");
   end To_Clock;

----------------------------------------------------------------------
-- Ada for POSIX (AdaFPX)
----------------------------------------------------------------------
-- Warren W. Gay VE3WWG     Tue Dec  3 18:49:48 2013
--
-- This is generated source code. Edit at your own risk.

package body Posix is

   function C_Last(C_String: String) return Natural is
   begin
      for X in C_String'Range loop
         if Character'Pos(C_String(X)) = 0 then
            return Natural(X-1);
         end if;
      end loop;
      return C_String'Last;
   end C_Last;

   function To_Count(Status: ssize_t) return Natural is
   begin
      if Status <= 0 then
         return 0;
      else
         return Natural(Status);
      end if;
   end To_Count;

   pragma Inline(To_Count);

   function To_Count(Status: int_t) return Natural is
   begin
      if Status <= 0 then
         return 0;
      else
         return Natural(Status);
      end if;
   end To_Count;

   pragma Inline(To_Count);

   function C_Error(Ret_Val: int_t) return errno_t is
      function c_errno return errno_t;
      pragma Import(C,c_errno,"c_errno");
   begin
      if Ret_Val >= 0 then
         return 0;
      else
         return c_errno;
      end if;
   end C_Error;

   pragma Inline(C_Error);

   function C_Error(Ret_Val: ssize_t) return errno_t is
      function c_errno return errno_t;
      pragma Import(C,c_errno,"c_errno");
   begin
      if Ret_Val >= 0 then
         return 0;
      else
         return c_errno;
      end if;
   end C_Error;

   pragma Inline(C_Error);

   function C_Error(PID: pid_t) return errno_t is
      function c_errno return errno_t;
      pragma Import(C,c_errno,"c_errno");
   begin
      if PID /= -1 then
         return 0;
      else
         return c_errno;
      end if;
   end C_Error;

   pragma Inline(C_Error);

   function C_Error(Ret_Val: clock_t) return errno_t is
      function c_errno return errno_t;
      pragma Import(C,c_errno,"c_errno");
   begin
      pragma Warnings(Off);
      if Ret_Val < 0 or  else Ret_Val = clock_t'Last then
         return c_errno;
      else
         return 0;
      end if;
      pragma Warnings(On);
   end C_Error;

   function C_Error(Ret_Val: sig_t) return errno_t is
      function c_errno return errno_t;
      pragma Import(C,c_errno,"c_errno");
   begin
      if Ret_Val = SIG_ERR then
         return c_errno;
      else
         return 0;
      end if;
   end C_Error;

   function C_String(Ada_String: String) return String is
      T : String(Ada_String'First..Ada_String'Last+1);
   begin
      T(T'First..T'Last-1) := Ada_String;
      T(T'Last) := Character'Val(0);
      return T;
   end C_String;

   function Ada_String(C_String: String) return String is
   begin
      for X in C_String'Range loop
         if Character'Pos(C_String(X)) = 0 then
            return C_String(C_String'First..X-1);
         end if;
      end loop;
      return C_String;
   end Ada_String;

   function Pos_PID(Status: int_t) return pid_t is
   begin
      if Status >= 0 then
         return pid_t(Status);
      else
         return 0;
      end if;
   end Pos_PID;

   pragma Inline(Pos_PID);

   function Neg_PID(Status: int_t) return pid_t is
   begin
      if Status < 0 then
         return pid_t(-Status);
      else
         return 0;
      end if;
   end Neg_PID;

   pragma Inline(Neg_PID);

   function Argv_Length(Argvs: String) return Natural is
      Count : Natural := 0;
   begin
      for X in Argvs'Range loop
         if Character'Pos(Argvs(x)) = 0 then
            Count := Count + 1;
         end if;
      end loop;
      return Count + 1;
   end Argv_Length;

   function Argv_Length(Argv: argv_array) return Natural is
      use System;
   begin
      for X in Argv'Range loop
         if Argv(X) = System.Null_Address then
            return X - Argv'First;
         end if;
      end loop;
      return Argv'Length;
   end Argv_Length;

   procedure Find_Nul(S: String; X: out Natural; Found: out Boolean) is
   begin
      for Y in S'Range loop
         if Character'Pos(S(Y)) = 0 then
            X := Y;
            Found := True;
         end if;
      end loop;
      X := S'Last;
      Found := False;
   end Find_Nul;

   function To_Argv(Argvs: String) return argv_array is
      Count : constant Natural := Argv_Length(Argvs);
      X :     Natural := Argvs'First;
      Y :     Natural;
      Found : Boolean;
   begin
      declare
         Argv :  argv_array(0..Count-1);
         Arg_X : Natural := Argv'First;
      begin
         while X <= Argvs'Last loop
            Find_Nul(Argvs(X..Argv'Last),Y,Found);
            exit when not Found;
            Argv(Arg_X) := Argvs(X)'Address;
            Arg_X       := Arg_X + 1;
            X           := Y + 1;
         end loop;
         Argv(Arg_X) := System.Null_Address;
         return Argv;
      end;
   end To_Argv;

   procedure To_Argv(Argvs: String; Argv: out argv_array) is
      Count : Natural := Argv_Length(Argvs);
      Arg_X : Natural := Argv'First;
      C :     Natural := 0;
      X :     Natural := Argvs'First;
      Y :     Natural;
      Found : Boolean;
   begin
      pragma Assert(Argv'Length>1);

      if Count > Argv'Length then
         Count := Argv'Length - 1;
      end if;

      while C < Count and X <= Argvs'Last loop
          Find_Nul(Argvs(X..Argv'Last),Y,Found);
          exit when not Found;
          Argv(Arg_X) := Argvs(X)'Address;
          Arg_X       := Arg_X + 1;
          X           := Y + 1;
          C           := C + 1;
      end loop;

      Argv(Arg_X) := System.Null_Address;

   end To_Argv;

   function To_Clock(Ticks: clock_t) return clock_t is
   begin
        pragma Warnings(Off);
        if Ticks < 0 or else Ticks = clock_t'Last then
            return 0;
        else
            return Ticks;
        end if;
        pragma Warnings(On);
   end To_Clock;

Fix warnings for other gnat versions

Fix warnings for other gnat versions


-----------------------------------------------------------------------
--  util-encoders-aes -- AES encryption and decryption
--  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.Streams;
with Interfaces;

--  The Util.Encodes.SHA1 package generates SHA-1 hash according to
--  RFC3174 or [FIPS-180-1].
package Util.Encoders.AES is

   type AES_Mode is (ECB, CBC, PCBC, CFB, OFB, CTR);

   type Key_Type is private;

   --  ------------------------------
   --  ------------------------------
   subtype Block_Type is Ada.Streams.Stream_Element_Array (1 .. 16);

   type Word_Block_Type is array (1 .. 4) of Interfaces.Unsigned_32;

   procedure Set_Encrypt_Key (Key  : out Key_Type;
                              Data : in Ada.Streams.Stream_Element_Array);

   procedure Set_Decrypt_Key (Key  : out Key_Type;
                              Data : in Ada.Streams.Stream_Element_Array);

   procedure Encrypt (Input  : in Block_Type;
                      Output : out Block_Type;
                      Key    : in Key_Type);
   procedure Encrypt (Input  : in Word_Block_Type;
                      Output : out Word_Block_Type;
                      Key    : in Key_Type);

   procedure Encrypt (Input  : in Ada.Streams.Stream_Element_Array;
                      Output : out Ada.Streams.Stream_Element_Array;
                      Last   : out Ada.Streams.Stream_Element_Offset;
                      Key    : in Key_Type);

   procedure Decrypt (Input  : in Block_Type;
                      Output : out Block_Type;
                      Key    : in Key_Type);

   --  ------------------------------
   --  AES encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  an SHA1 hexadecimal stream.  The encoding alphabet is: 0123456789ABCDEF.
   type Encoder is new Util.Encoders.Transformer with private;

   --  Encodes the binary input stream represented by Data into
   --  an SHA-1 hash output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in out Encoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

   --  Finish encoding the input array.
   overriding
   procedure Finish (E    : in out Encoder;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset);

   --  Set the encryption key to use.
   procedure Set_Key (E    : in out Encoder;
                      Data : in Ada.Streams.Stream_Element_Array;
                      Mode : in AES_Mode := CBC);

private

   use Interfaces;

   type Block_Key is array (0 .. 59) of Unsigned_32;

   type Key_Type is record
      Key    : Block_Key;
      Rounds : Natural := 0;
   end record;

   type Encoder is new Util.Encoders.Transformer with record
      IV   : Word_Block_Type;
      Key  : Key_Type;
      Mode : AES_Mode := CBC;
   end record;

end Util.Encoders.AES;

-----------------------------------------------------------------------
--  util-encoders-aes -- AES encryption and decryption
--  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 Ada.Streams;
with Interfaces;

--  The Util.Encodes.SHA1 package generates SHA-1 hash according to
--  RFC3174 or [FIPS-180-1].
package Util.Encoders.AES is

   use type Ada.Streams.Stream_Element_Offset;

   type AES_Mode is (ECB, CBC, PCBC, CFB, OFB, CTR);

   type Key_Type is private;

   --  ------------------------------
   --  ------------------------------
   subtype Block_Type is Ada.Streams.Stream_Element_Array (1 .. 16);

   type Word_Block_Type is array (1 .. 4) of Interfaces.Unsigned_32;

   procedure Set_Encrypt_Key (Key  : out Key_Type;
                              Data : in Ada.Streams.Stream_Element_Array)
     with Pre => Data'Length = 16 or Data'Length = 24 or Data'Length = 32;

   procedure Set_Decrypt_Key (Key  : out Key_Type;
                              Data : in Ada.Streams.Stream_Element_Array);

   procedure Encrypt (Input  : in Block_Type;
                      Output : out Block_Type;
                      Key    : in Key_Type);
   procedure Encrypt (Input  : in Word_Block_Type;
                      Output : out Word_Block_Type;
                      Key    : in Key_Type);

   procedure Encrypt (Input  : in Ada.Streams.Stream_Element_Array;
                      Output : out Ada.Streams.Stream_Element_Array;
                      Last   : out Ada.Streams.Stream_Element_Offset;
                      Key    : in Key_Type);

   procedure Decrypt (Input  : in Block_Type;
                      Output : out Block_Type;
                      Key    : in Key_Type);

   --  ------------------------------
   --  AES encoder
   --  ------------------------------
   --  This Encoder translates the (binary) input stream into
   --  an SHA1 hexadecimal stream.  The encoding alphabet is: 0123456789ABCDEF.
   type Encoder is new Util.Encoders.Transformer with private;

   --  Encodes the binary input stream represented by Data into
   --  an SHA-1 hash output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   overriding
   procedure Transform (E       : in out Encoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset);

   --  Finish encoding the input array.
   overriding
   procedure Finish (E    : in out Encoder;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset)
     with Pre => Into'Length >= Block_Type'Length,
     Post => Last = Into'First - 1 or Last = Into'First + Block_Type'Length;

   --  Set the encryption key to use.
   procedure Set_Key (E    : in out Encoder;
                      Data : in Ada.Streams.Stream_Element_Array;
                      Mode : in AES_Mode := CBC);

   --  Set the encryption initialization vector before starting the encryption.
   procedure Set_IV (E  : in out Encoder;
                     IV : in Word_Block_Type);

private

   use Interfaces;

   type Block_Key is array (0 .. 59) of Unsigned_32;

   type Key_Type is record
      Key    : Block_Key;
      Rounds : Natural := 0;
   end record;

   type Encoder is new Util.Encoders.Transformer with record
      IV         : Word_Block_Type;
      Key        : Key_Type;
      Mode       : AES_Mode := CBC;
      Data_Count : Ada.Streams.Stream_Element_Offset := 0;
      Data       : Block_Type;
   end record;

end Util.Encoders.AES;

Add Set_IV procedure and add several post/pre conditions


-----------------------------------------------------------------------
--  wiki-plugins-variables -- Variables plugin
--  Copyright (C) 2020 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 Wiki.Filters.Variables;
package body Wiki.Plugins.Variables is

   --  ------------------------------
   --  Set or update a variable in the `Wiki.Filters.Variable` filter.
   --  ------------------------------
   overriding
   procedure Expand (Plugin   : in out Variable_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in Plugin_Context) is
      pragma Unreferenced (Plugin, Document);
   begin
      if Wiki.Attributes.Length (Params) >= 3 then
         declare
            First  : Wiki.Attributes.Cursor := Wiki.Attributes.First (Params);
            Second : Wiki.Attributes.Cursor;
         begin
            Wiki.Attributes.Next (First);
            Second := First;
            Wiki.Attributes.Next (Second);
            Wiki.Filters.Variables.Add_Variable (Context.Filters,
                                                 Wiki.Attributes.Get_Wide_Value (First),
                                                 Wiki.Attributes.Get_Wide_Value (Second));
         end;
      end if;
   end Expand;

end Wiki.Plugins.Variables;

-----------------------------------------------------------------------
--  wiki-plugins-variables -- Variables plugin
--  Copyright (C) 2020 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 Wiki.Filters.Variables;
package body Wiki.Plugins.Variables is

   --  ------------------------------
   --  Set or update a variable in the `Wiki.Filters.Variable` filter.
   --  ------------------------------
   overriding
   procedure Expand (Plugin   : in out Variable_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in out Plugin_Context) is
      pragma Unreferenced (Plugin, Document);
   begin
      if Wiki.Attributes.Length (Params) >= 3 then
         declare
            First  : Wiki.Attributes.Cursor := Wiki.Attributes.First (Params);
            Second : Wiki.Attributes.Cursor;
         begin
            Wiki.Attributes.Next (First);
            Second := First;
            Wiki.Attributes.Next (Second);
            Wiki.Filters.Variables.Add_Variable (Context.Filters,
                                                 Wiki.Attributes.Get_Wide_Value (First),
                                                 Wiki.Attributes.Get_Wide_Value (Second));
         end;
      end if;
   end Expand;

   --  ------------------------------
   --  List the variables from the `Wiki.Filters.Variable` filter.
   --  ------------------------------
   overriding
   procedure Expand (Plugin   : in out List_Variable_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in out Plugin_Context) is
      pragma Unreferenced (Plugin);
      procedure Print_Variable (Name  : in Wiki.Strings.WString;
                                Value : in Wiki.Strings.WString);

      Has_Table  : Boolean := False;
      Format     : Format_Map := (others => False);
      Attributes : Wiki.Attributes.Attribute_List;

      procedure Print_Variable (Name  : in Wiki.Strings.WString;
                                Value : in Wiki.Strings.WString) is
      begin
         Has_Table := True;
         Context.Filters.Add_Row (Document);
         Context.Filters.Add_Column (Document, Attributes);
         Context.Filters.Add_Text (Document, Name, Format);
         Context.Filters.Add_Column (Document, Attributes);
         Context.Filters.Add_Text (Document, Value, Format);
      end Print_Variable;

   begin
      Wiki.Filters.Variables.Iterate (Context.Filters, Print_Variable'Access);
      if Has_Table then
         Context.Filters.Finish_Table (Document);
      end if;
   end Expand;

end Wiki.Plugins.Variables;

Implement the Expand procedure for the List_Variables_Plugin to iterate over the filter variables and print them within a table


-----------------------------------------------------------------------
--  babel-files-maps -- Hash maps for files and directories
--  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.
-----------------------------------------------------------------------

package body Babel.Files.Maps is

   --  ------------------------------
   --  Find the file with the given name in the file map.
   --  ------------------------------
   function Find (From : in File_Map;
                  Name : in String) return File_Cursor is
   begin
      return From.Find (Key => Name'Unrestricted_Access);
   end Find;

   --  ------------------------------
   --  Find the file with the given name in the file map.
   --  ------------------------------
   function Find (From : in File_Map;
                  Name : in String) return File_Type is
      Pos : constant File_Cursor := From.Find (Key => Name'Unrestricted_Access);
   begin
      if File_Maps.Has_Element (Pos) then
         return File_Maps.Element (Pos);
      else
         return NO_FILE;
      end if;
   end Find;

   --  ------------------------------
   --  Add the file with the given name in the container.
   --  ------------------------------
   procedure Add_File (Into    : in out Differential_Container;
                       Element : in File_Type) is
      use type ADO.Identifier;
   begin
      if Element.Id = ADO.NO_IDENTIFIER then
         Into.Known_Files.Insert (Element.Name'Unrestricted_Access, Element);
      end if;
   end Add_File;

   --  ------------------------------
   --  Add the directory with the given name in the container.
   --  ------------------------------
   procedure Add_Directory (Into    : in out Differential_Container;
                            Element : in Directory_Type) is
      use type ADO.Identifier;
   begin
      if Element.Id = ADO.NO_IDENTIFIER then
         Into.Known_Dirs.Insert (Element.Name'Unrestricted_Access, Element);
      end if;
   end Add_Directory;

   --  ------------------------------
   --  Create a new file instance with the given name in the container.
   --  ------------------------------
   function Create (Into : in Differential_Container;
                    Name : in String) return File_Type is
   begin
      return Allocate (Name => Name,
                       Dir  => Into.Current);
   end Create;

   --  ------------------------------
   --  Create a new directory instance with the given name in the container.
   --  ------------------------------
   function Create (Into : in Differential_Container;
                    Name : in String) return Directory_Type is
   begin
      return Allocate (Name => Name,
                       Dir  => Into.Current);
   end Create;

   --  ------------------------------
   --  Find the file with the given name in this file container.
   --  Returns NO_FILE if the file was not found.
   --  ------------------------------
   function Find (From : in Differential_Container;
                  Name : in String) return File_Type is
   begin
      return Find (From.Known_Files, Name);
   end Find;

   --  ------------------------------
   --  Find the directory with the given name in this file container.
   --  Returns NO_DIRECTORY if the directory was not found.
   --  ------------------------------
   function Find (From : in Differential_Container;
                  Name : in String) return Directory_Type is
   begin
      return Find (From.Known_Dirs, Name);
   end Find;

   --  ------------------------------
   --  Set the directory object associated with the container.
   --  ------------------------------
   overriding
   procedure Set_Directory (Into      : in out Differential_Container;
                            Directory : in Directory_Type) is
   begin
      Default_Container (Into).Set_Directory (Directory);
      Into.Known_Files.Clear;
      Into.Known_Dirs.Clear;
   end Set_Directory;

   --  ------------------------------
   --  Prepare the differential container by setting up the known files and known
   --  directories.  The <tt>Update</tt> procedure is called to give access to the
   --  maps that can be updated.
   --  ------------------------------
   procedure Prepare (Container : in out Differential_Container;
                      Update    : access procedure (Files : in out File_Map;
                                                    Dirs  : in out Directory_Map)) is
   begin
      Update (Container.Known_Files, Container.Known_Dirs);
   end Prepare;

end Babel.Files.Maps;

-----------------------------------------------------------------------
--  babel-files-maps -- Hash maps for files and directories
--  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.
-----------------------------------------------------------------------

package body Babel.Files.Maps is

   --  ------------------------------
   --  Find the file with the given name in the file map.
   --  ------------------------------
   function Find (From : in File_Map;
                  Name : in String) return File_Cursor is
   begin
      return From.Find (Key => Name'Unrestricted_Access);
   end Find;

   --  ------------------------------
   --  Find the file with the given name in the file map.
   --  ------------------------------
   function Find (From : in File_Map;
                  Name : in String) return File_Type is
      Pos : constant File_Cursor := From.Find (Key => Name'Unrestricted_Access);
   begin
      if File_Maps.Has_Element (Pos) then
         return File_Maps.Element (Pos);
      else
         return NO_FILE;
      end if;
   end Find;

   --  ------------------------------
   --  Find the directory with the given name in the directory map.
   --  ------------------------------
   function Find (From : in Directory_Map;
                  Name : in String) return Directory_Cursor is
   begin
      return From.Find (Key => Name'Unrestricted_Access);
   end Find;

   --  ------------------------------
   --  Find the directory with the given name in the directory map.
   --  ------------------------------
   function Find (From : in Directory_Map;
                  Name : in String) return Directory_Type is
      Pos : constant Directory_Cursor := From.Find (Key => Name'Unrestricted_Access);
   begin
      if Directory_Maps.Has_Element (Pos) then
         return Directory_Maps.Element (Pos);
      else
         return NO_DIRECTORY;
      end if;
   end Find;

   --  ------------------------------
   --  Add the file with the given name in the container.
   --  ------------------------------
   procedure Add_File (Into    : in out Differential_Container;
                       Element : in File_Type) is
      use type ADO.Identifier;
   begin
      if Element.Id = ADO.NO_IDENTIFIER then
         Into.Known_Files.Insert (Element.Name'Unrestricted_Access, Element);
      end if;
   end Add_File;

   --  ------------------------------
   --  Add the directory with the given name in the container.
   --  ------------------------------
   procedure Add_Directory (Into    : in out Differential_Container;
                            Element : in Directory_Type) is
      use type ADO.Identifier;
   begin
      if Element.Id = ADO.NO_IDENTIFIER then
         Into.Known_Dirs.Insert (Element.Name'Unrestricted_Access, Element);
      end if;
   end Add_Directory;

   --  ------------------------------
   --  Create a new file instance with the given name in the container.
   --  ------------------------------
   function Create (Into : in Differential_Container;
                    Name : in String) return File_Type is
   begin
      return Allocate (Name => Name,
                       Dir  => Into.Current);
   end Create;

   --  ------------------------------
   --  Create a new directory instance with the given name in the container.
   --  ------------------------------
   function Create (Into : in Differential_Container;
                    Name : in String) return Directory_Type is
   begin
      return Allocate (Name => Name,
                       Dir  => Into.Current);
   end Create;

   --  ------------------------------
   --  Find the file with the given name in this file container.
   --  Returns NO_FILE if the file was not found.
   --  ------------------------------
   function Find (From : in Differential_Container;
                  Name : in String) return File_Type is
   begin
      return Find (From.Known_Files, Name);
   end Find;

   --  ------------------------------
   --  Find the directory with the given name in this file container.
   --  Returns NO_DIRECTORY if the directory was not found.
   --  ------------------------------
   function Find (From : in Differential_Container;
                  Name : in String) return Directory_Type is
   begin
      return Find (From.Known_Dirs, Name);
   end Find;

   --  ------------------------------
   --  Set the directory object associated with the container.
   --  ------------------------------
   overriding
   procedure Set_Directory (Into      : in out Differential_Container;
                            Directory : in Directory_Type) is
   begin
      Default_Container (Into).Set_Directory (Directory);
      Into.Known_Files.Clear;
      Into.Known_Dirs.Clear;
   end Set_Directory;

   --  ------------------------------
   --  Prepare the differential container by setting up the known files and known
   --  directories.  The <tt>Update</tt> procedure is called to give access to the
   --  maps that can be updated.
   --  ------------------------------
   procedure Prepare (Container : in out Differential_Container;
                      Update    : access procedure (Files : in out File_Map;
                                                    Dirs  : in out Directory_Map)) is
   begin
      Update (Container.Known_Files, Container.Known_Dirs);
   end Prepare;

end Babel.Files.Maps;

Implement the Find operation to find a directory by its name


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

with Util.Test_Caller;

with AWA.Jobs.Modules;
with AWA.Jobs.Services.Tests;

package body AWA.Jobs.Modules.Tests is

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Jobs.Modules.Register",
                       Test_Register'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the job factory.
   --  ------------------------------
   procedure Test_Register (T : in out Test) is
      M : AWA.Jobs.Modules.Job_Module;
   begin
      M.Register (Definition => Services.Tests.Test_Definition.Factory'Access);
      Util.Tests.Assert_Equals (T, 1, Integer (M.Factory.Length), "Invalid factory length");

      M.Register (Definition => Services.Tests.Work_1_Definition.Factory'Access);
      Util.Tests.Assert_Equals (T, 2, Integer (M.Factory.Length), "Invalid factory length");

      M.Register (Definition => Services.Tests.Work_2_Definition.Factory'Access);
      Util.Tests.Assert_Equals (T, 3, Integer (M.Factory.Length), "Invalid factory length");
   end Test_Register;

end AWA.Jobs.Modules.Tests;

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

with Util.Test_Caller;

with AWA.Jobs.Modules;
with AWA.Jobs.Services.Tests;

package body AWA.Jobs.Modules.Tests is

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Jobs.Modules.Register",
                       Test_Register'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the job factory.
   --  ------------------------------
   procedure Test_Register (T : in out Test) is
      M : AWA.Jobs.Modules.Job_Module;
   begin
      M.Register (Definition => Services.Tests.Test_Definition.Factory);
      Util.Tests.Assert_Equals (T, 1, Integer (M.Factory.Length), "Invalid factory length");

      M.Register (Definition => Services.Tests.Work_1_Definition.Factory);
      Util.Tests.Assert_Equals (T, 2, Integer (M.Factory.Length), "Invalid factory length");

      M.Register (Definition => Services.Tests.Work_2_Definition.Factory);
      Util.Tests.Assert_Equals (T, 3, Integer (M.Factory.Length), "Invalid factory length");
   end Test_Register;

end AWA.Jobs.Modules.Tests;

Fix compilation

Fix compilation


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

with Util.Beans.Objects;
package Util.Beans.Basic is

   pragma Preelaborate;

   --  ------------------------------
   --  Read-only Bean interface.
   --  ------------------------------
   --  The ''Readonly_Bean'' interface allows to plug a complex
   --  runtime object to the expression resolver.  This interface
   --  must be implemented by any tagged record that should be
   --  accessed as a variable for an expression.
   --
   --  For example, if 'foo' is bound to an object implementing that
   --  interface, expressions like 'foo.name' will resolve to 'foo'
   --  and the 'Get_Value' method will be called with 'name'.
   --
   type Readonly_Bean is limited interface;
   type Readonly_Bean_Access is access all Readonly_Bean'Class;

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

   --  ------------------------------
   --  Bean interface.
   --  ------------------------------
   --  The ''Bean'' interface allows to modify a property value.
   type Bean is limited interface and Readonly_Bean;

   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   procedure Set_Value (From  : in out Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is abstract;

   --  ------------------------------
   --  List of objects
   --  ------------------------------
   --  The <b>List_Bean</b> interface gives access to a list of objects.
   type List_Bean is limited interface and Readonly_Bean;
   type List_Bean_Access is access all List_Bean'Class;

   --  Get the number of elements in the list.
   function Get_Count (From : in List_Bean) return Natural is abstract;

   --  Set the current row index.  Valid row indexes start at 1.
   procedure Set_Row_Index (From  : in out List_Bean;
                            Index : in Natural) is abstract;

   --  Get the element at the current row index.
   function Get_Row (From  : in List_Bean) return Util.Beans.Objects.Object is abstract;

end Util.Beans.Basic;

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

with Util.Beans.Objects;
package Util.Beans.Basic is

   pragma Preelaborate;

   --  ------------------------------
   --  Read-only Bean interface.
   --  ------------------------------
   --  The ''Readonly_Bean'' interface allows to plug a complex
   --  runtime object to the expression resolver.  This interface
   --  must be implemented by any tagged record that should be
   --  accessed as a variable for an expression.
   --
   --  For example, if 'foo' is bound to an object implementing that
   --  interface, expressions like 'foo.name' will resolve to 'foo'
   --  and the 'Get_Value' method will be called with 'name'.
   --
   type Readonly_Bean is limited interface;
   type Readonly_Bean_Access is access all Readonly_Bean'Class;

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

   --  ------------------------------
   --  Bean interface.
   --  ------------------------------
   --  The ''Bean'' interface allows to modify a property value.
   type Bean is limited interface and Readonly_Bean;

   --  Set the value identified by the name.
   --  If the name cannot be found, the method should raise the No_Value
   --  exception.
   procedure Set_Value (From  : in out Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is abstract;

   --  ------------------------------
   --  List of objects
   --  ------------------------------
   --  The <b>List_Bean</b> interface gives access to a list of objects.
   type List_Bean is limited interface and Readonly_Bean;
   type List_Bean_Access is access all List_Bean'Class;

   --  Get the number of elements in the list.
   function Get_Count (From : in List_Bean) return Natural is abstract;

   --  Set the current row index.  Valid row indexes start at 1.
   procedure Set_Row_Index (From  : in out List_Bean;
                            Index : in Natural) is abstract;

   --  Get the element at the current row index.
   function Get_Row (From  : in List_Bean) return Util.Beans.Objects.Object is abstract;

   --  ------------------------------
   --  Arrays of objects
   --  ------------------------------
   --  The <tt>Array_Bean</tt> interface gives access to an array of objects.
   --  Unlike the <tt>List_Bean</tt> interface, it does not maintain any current position.
   --  The drawback is that there is no current row concept and a position must be specified
   --  to return a given row.
   type Array_Bean is limited interface and Readonly_Bean;
   type Array_Bean_Access is access all Array_Bean'Class;

   --  Get the number of elements in the array.
   function Get_Count (From : in Array_Bean) return Natural is abstract;

   --  Get the element at the given position.
   function Get_Row (From     : in Array_Bean;
                     Position : in Natural) return Util.Beans.Objects.Object is abstract;

end Util.Beans.Basic;

Declare the Array_Bean interface

Declare the Array_Bean interface


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

with Util.Tests;
with AWA.Tests;
with Ada.Strings.Unbounded;

package AWA.Blogs.Tests is

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

   type Test is new AWA.Tests.Test with record
      Blog_Ident : Ada.Strings.Unbounded.Unbounded_String;
      Post_Ident : Ada.Strings.Unbounded.Unbounded_String;
      Post_Uri   : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   --  Get some access on the blog as anonymous users.
   procedure Verify_Anonymous (T    : in out Test;
                               Post : in String);

   --  Test access to the blog as anonymous user.
   procedure Test_Anonymous_Access (T : in out Test);

   --  Test creation of blog by simulating web requests.
   procedure Test_Create_Blog (T : in out Test);

   --  Test updating a post by simulating web requests.
   procedure Test_Update_Post (T : in out Test);

   --  Test listing the blog posts.
   procedure Test_Admin_List_Posts (T : in out Test);

   --  Test listing the blog comments.
   procedure Test_Admin_List_Comments (T : in out Test);

   --  Test getting the JSON blog stats (for graphs).
   procedure Test_Admin_Blog_Stats (T : in out Test);

end AWA.Blogs.Tests;

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

with Util.Tests;
with AWA.Tests;
with Ada.Strings.Unbounded;

package AWA.Blogs.Tests is

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

   type Test is new AWA.Tests.Test with record
      Blog_Ident : Ada.Strings.Unbounded.Unbounded_String;
      Post_Ident : Ada.Strings.Unbounded.Unbounded_String;
      Post_Uri   : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   --  Get some access on the blog as anonymous users.
   procedure Verify_Anonymous (T    : in out Test;
                               Post : in String);

   --  Test access to the blog as anonymous user.
   procedure Test_Anonymous_Access (T : in out Test);

   --  Test creation of blog by simulating web requests.
   procedure Test_Create_Blog (T : in out Test);

   --  Test updating a post by simulating web requests.
   procedure Test_Update_Post (T : in out Test);

   --  Test updating the publication date by simulating web requests.
   procedure Test_Update_Publish_Date (T : in out Test);

   --  Test listing the blog posts.
   procedure Test_Admin_List_Posts (T : in out Test);

   --  Test listing the blog comments.
   procedure Test_Admin_List_Comments (T : in out Test);

   --  Test getting the JSON blog stats (for graphs).
   procedure Test_Admin_Blog_Stats (T : in out Test);

end AWA.Blogs.Tests;

Declare the Test_Update_Publish_Date procedure


-----------------------------------------------------------------------
--  mat-symbols-targets - Symbol files management
--  Copyright (C) 2014, 2015, 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 Bfd.Sections;
with ELF;
with Util.Strings;
with Util.Files;
with Util.Log.Loggers;
with Ada.Directories;
with MAT.Formats;
package body MAT.Symbols.Targets is

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

   procedure Find_Nearest_Line (Symbols : in Region_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info);

   --  ------------------------------
   --  Open the binary and load the symbols from that file.
   --  ------------------------------
   procedure Open (Symbols : in out Target_Symbols;
                   Path    : in String) is
   begin
      Log.Info ("Loading symbols from {0}", Path);
--
--        Bfd.Files.Open (Symbols.File, Path, "");
--        if Bfd.Files.Check_Format (Symbols.File, Bfd.Files.OBJECT) then
--           Bfd.Symbols.Read_Symbols (Symbols.File, Symbols.Symbols);
--        end if;
   end Open;

   --  ------------------------------
   --  Load the symbol table for the associated region.
   --  ------------------------------
   procedure Open (Symbols     : in out Region_Symbols;
                   Path        : in String;
                   Search_Path : in String) is
      Pos : Natural;
   begin
      Log.Info ("Loading symbols from {0}", Path);

      if Ada.Directories.Exists (Path) then
         Bfd.Files.Open (Symbols.File, Path, "");
      else
         Pos := Util.Strings.Rindex (Path, '/');
         if Pos > 0 then
            Bfd.Files.Open (Symbols.File,
              Util.Files.Find_File_Path (Path (Pos + 1 .. Path'Last), Search_Path));
         end if;
      end if;
      if Bfd.Files.Check_Format (Symbols.File, Bfd.Files.OBJECT) then
         Bfd.Symbols.Read_Symbols (Symbols.File, Symbols.Symbols);
      end if;
   end Open;

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

      Pos  : constant Symbols_Cursor := Symbols.Libraries.Find (Region.Start_Addr);
      Syms : Region_Symbols_Ref;
   begin
      if not Symbols_Maps.Has_Element (Pos) then
         Syms := Region_Symbols_Refs.Create;
         Syms.Value.Region := Region;
         Syms.Value.Offset := Offset_Addr;
         Symbols.Libraries.Insert (Region.Start_Addr, Syms);
      else
         Syms := Symbols_Maps.Element (Pos);
      end if;
      if Ada.Strings.Unbounded.Length (Region.Path) > 0 then
         Open (Syms.Value, Ada.Strings.Unbounded.To_String (Region.Path),
               Ada.Strings.Unbounded.To_String (Symbols.Search_Path));
         if (Bfd.Files.Get_File_Flags (Syms.Value.File) and Bfd.Files.EXEC_P) /= 0 then
            Syms.Value.Offset := 0;
         end if;
      end if;
   end Load_Symbols;

   --  ------------------------------
   --  Load the symbols associated with all the shared libraries described by
   --  the memory region map.
   --  ------------------------------
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Regions     : in MAT.Memory.Region_Info_Map) is
      use type ELF.Elf32_Word;

      Iter    : MAT.Memory.Region_Info_Cursor := Regions.First;
   begin
      while MAT.Memory.Region_Info_Maps.Has_Element (Iter) loop
         declare
            Region : MAT.Memory.Region_Info := MAT.Memory.Region_Info_Maps.Element (Iter);
            Offset : MAT.Types.Target_Addr;
         begin
            if (Region.Flags and ELF.PF_X) /= 0 then
               if Ada.Strings.Unbounded.Length (Region.Path) = 0 then
                  Region.Path := Symbols.Path;
                  Offset := 0;
               else
                  Offset := Region.Start_Addr;
               end if;
               MAT.Symbols.Targets.Load_Symbols (Symbols, Region, Offset);
            end if;

         exception
            when Bfd.OPEN_ERROR =>
               Symbols.Console.Error ("Cannot open symbol library file '"
                                      & Ada.Strings.Unbounded.To_String (Region.Path) & "'");
         end;
         MAT.Memory.Region_Info_Maps.Next (Iter);
      end loop;
   end Load_Symbols;

   --  ------------------------------
   --  Demangle the symbol.
   --  ------------------------------
   procedure Demangle (Symbols : in Target_Symbols;
                       Symbol  : in out Symbol_Info) is
      use type Bfd.Demangle_Flags;
      use Ada.Strings.Unbounded;

      Pos : constant Natural := Index (Symbol.File, ".", Ada.Strings.Backward);
   begin
      if Symbol.Line = 0 or else Pos = 0 or else Symbol.Symbols.Is_Null then
         return;
      end if;
      declare
         Mode : Bfd.Demangle_Flags := Symbols.Demangle;
         Len  : constant Positive := Length (Symbol.File);
         Ext  : constant String := Slice (Symbol.File, Pos, Len);
         Sym  : constant String := To_String (Symbol.Name);
      begin
         if Mode = Bfd.Constants.DMGL_AUTO and then Ext = ".adb" then
            Mode := Bfd.Constants.DMGL_GNAT;
         end if;
         declare
            Name : constant String := Bfd.Symbols.Demangle (Symbol.Symbols.Value.File, Sym, Mode);
         begin
            if Name'Length > 0 then
               Symbol.Name := To_Unbounded_String (Name);
            end if;
         end;
      end;
   end Demangle;

   procedure Find_Nearest_Line (Symbols : in Region_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info) is
      Text_Section : Bfd.Sections.Section;
      Pc : constant Bfd.Vma_Type := Bfd.Vma_Type (Addr);
   begin
      if not Bfd.Files.Is_Open (Symbols.File) then
         Symbol.File := Symbols.Region.Path;
         return;
      end if;
      Text_Section := Bfd.Sections.Find_Section (Symbols.File, ".text");
      Bfd.Symbols.Find_Nearest_Line (File    => Symbols.File,
                                     Sec     => Text_Section,
                                     Symbols => Symbols.Symbols,
                                     Addr    => Pc,
                                     Name    => Symbol.File,
                                     Func    => Symbol.Name,
                                     Line    => Symbol.Line);
   end Find_Nearest_Line;

   --  ------------------------------
   --  Find the nearest source file and line for the given address.
   --  ------------------------------
   procedure Find_Nearest_Line (Symbols : in Target_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info) is
      Pos  : constant Symbols_Cursor := Symbols.Libraries.Floor (Addr);
   begin
      Symbol.Line := 0;
      if Symbols_Maps.Has_Element (Pos) then
         declare
            Syms : constant Region_Symbols_Ref := Symbols_Maps.Element (Pos);
         begin
            if Syms.Value.Region.End_Addr > Addr then
               Symbol.Symbols := Syms;
               Find_Nearest_Line (Symbols => Syms.Value,
                                  Addr    => Addr - Syms.Value.Offset,
                                  Symbol  => Symbol);
               Demangle (Symbols, Symbol);
               return;
            end if;
         end;
      end if;
      Symbol.Line := 0;
      Symbol.File := Ada.Strings.Unbounded.To_Unbounded_String ("");
      Symbol.Name := Ada.Strings.Unbounded.To_Unbounded_String (MAT.Formats.Addr (Addr));

   exception
      when Bfd.NOT_FOUND =>
         Symbol.Line := 0;
         Symbol.File := Ada.Strings.Unbounded.To_Unbounded_String ("");
         Symbol.Name := Ada.Strings.Unbounded.To_Unbounded_String (MAT.Formats.Addr (Addr));
   end Find_Nearest_Line;

   --  ------------------------------
   --  Find the symbol in the symbol table and return the start and end address.
   --  ------------------------------
   procedure Find_Symbol_Range (Symbols : in Target_Symbols;
                                Name    : in String;
                                From    : out MAT.Types.Target_Addr;
                                To      : out MAT.Types.Target_Addr) is
      use type Bfd.Symbols.Symbol;

      Iter  : Symbols_Cursor := Symbols.Libraries.First;
   begin
      while Symbols_Maps.Has_Element (Iter) loop
         declare
            Syms : constant Region_Symbols_Ref := Symbols_Maps.Element (Iter);
            Sym  : Bfd.Symbols.Symbol;
            Sec  : Bfd.Sections.Section;
         begin
            if not Syms.Is_Null and then Bfd.Files.Is_Open (Syms.Value.File) then
               Sym := Bfd.Symbols.Get_Symbol (Syms.Value.Symbols, Name);
               if Sym /= Bfd.Symbols.Null_Symbol then
                  Sec := Bfd.Symbols.Get_Section (Sym);
                  if not Bfd.Sections.Is_Undefined_Section (Sec) then
                     From := MAT.Types.Target_Addr (Bfd.Symbols.Get_Value (Sym));
                     From := From + Syms.Value.Offset;
                     To := From + MAT.Types.Target_Addr (Bfd.Symbols.Get_Symbol_Size (Sym));
                     return;
                  end if;
               end if;
            end if;
         end;
         Symbols_Maps.Next (Iter);
      end loop;
   end Find_Symbol_Range;

end MAT.Symbols.Targets;

-----------------------------------------------------------------------
--  mat-symbols-targets - Symbol files management
--  Copyright (C) 2014, 2015, 2019, 2021 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 Bfd.Sections;
with ELF;
with Util.Strings;
with Util.Files;
with Util.Log.Loggers;
with Ada.Directories;
with MAT.Formats;
package body MAT.Symbols.Targets is

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

   procedure Find_Nearest_Line (Symbols : in Region_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info);

   --  ------------------------------
   --  Open the binary and load the symbols from that file.
   --  ------------------------------
   procedure Open (Symbols : in out Target_Symbols;
                   Path    : in String) is
   begin
      Log.Info ("Loading symbols from {0}", Path);
--
--        Bfd.Files.Open (Symbols.File, Path, "");
--        if Bfd.Files.Check_Format (Symbols.File, Bfd.Files.OBJECT) then
--           Bfd.Symbols.Read_Symbols (Symbols.File, Symbols.Symbols);
--        end if;
   end Open;

   --  ------------------------------
   --  Load the symbol table for the associated region.
   --  ------------------------------
   procedure Open (Symbols     : in out Region_Symbols;
                   Path        : in String;
                   Search_Path : in String) is
      Pos : Natural;
   begin
      Log.Info ("Loading symbols from {0}", Path);

      if Ada.Directories.Exists (Path) then
         Bfd.Files.Open (Symbols.File, Path, "");
      else
         Pos := Util.Strings.Rindex (Path, '/');
         if Pos > 0 then
            Bfd.Files.Open (Symbols.File,
              Util.Files.Find_File_Path (Path (Pos + 1 .. Path'Last), Search_Path));
         end if;
      end if;
      if Bfd.Files.Check_Format (Symbols.File, Bfd.Files.OBJECT) then
         Bfd.Symbols.Read_Symbols (Symbols.File, Symbols.Symbols);
      end if;
   end Open;

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

      Pos  : constant Symbols_Cursor := Symbols.Libraries.Find (Region.Start_Addr);
      Syms : Region_Symbols_Ref;
   begin
      if not Symbols_Maps.Has_Element (Pos) then
         Syms := Region_Symbols_Refs.Create;
         Syms.Value.Region := Region;
         Syms.Value.Offset := Offset_Addr;
         Symbols.Libraries.Insert (Region.Start_Addr, Syms);
      else
         Syms := Symbols_Maps.Element (Pos);
      end if;
      if Ada.Strings.Unbounded.Length (Region.Path) > 0 then
         Open (Syms.Value, Ada.Strings.Unbounded.To_String (Region.Path),
               Ada.Strings.Unbounded.To_String (Symbols.Search_Path));
         if Bfd.Files.Is_Open (Syms.Value.File) and
         then (Bfd.Files.Get_File_Flags (Syms.Value.File) and Bfd.Files.EXEC_P) /= 0
         then
            Syms.Value.Offset := 0;
         end if;
      end if;
   end Load_Symbols;

   --  ------------------------------
   --  Load the symbols associated with all the shared libraries described by
   --  the memory region map.
   --  ------------------------------
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Regions     : in MAT.Memory.Region_Info_Map) is
      use type ELF.Elf32_Word;

      Iter    : MAT.Memory.Region_Info_Cursor := Regions.First;
   begin
      while MAT.Memory.Region_Info_Maps.Has_Element (Iter) loop
         declare
            Region : MAT.Memory.Region_Info := MAT.Memory.Region_Info_Maps.Element (Iter);
            Offset : MAT.Types.Target_Addr;
         begin
            if (Region.Flags and ELF.PF_X) /= 0 then
               if Ada.Strings.Unbounded.Length (Region.Path) = 0 then
                  Region.Path := Symbols.Path;
                  Offset := 0;
               else
                  Offset := Region.Start_Addr;
               end if;
               MAT.Symbols.Targets.Load_Symbols (Symbols, Region, Offset);
            end if;

         exception
            when Bfd.OPEN_ERROR =>
               Symbols.Console.Error ("Cannot open symbol library file '"
                                      & Ada.Strings.Unbounded.To_String (Region.Path) & "'");
         end;
         MAT.Memory.Region_Info_Maps.Next (Iter);
      end loop;
   end Load_Symbols;

   --  ------------------------------
   --  Demangle the symbol.
   --  ------------------------------
   procedure Demangle (Symbols : in Target_Symbols;
                       Symbol  : in out Symbol_Info) is
      use type Bfd.Demangle_Flags;
      use Ada.Strings.Unbounded;

      Pos : constant Natural := Index (Symbol.File, ".", Ada.Strings.Backward);
   begin
      if Symbol.Line = 0 or else Pos = 0 or else Symbol.Symbols.Is_Null then
         return;
      end if;
      declare
         Mode : Bfd.Demangle_Flags := Symbols.Demangle;
         Len  : constant Positive := Length (Symbol.File);
         Ext  : constant String := Slice (Symbol.File, Pos, Len);
         Sym  : constant String := To_String (Symbol.Name);
      begin
         if Mode = Bfd.Constants.DMGL_AUTO and then Ext = ".adb" then
            Mode := Bfd.Constants.DMGL_GNAT;
         end if;
         declare
            Name : constant String := Bfd.Symbols.Demangle (Symbol.Symbols.Value.File, Sym, Mode);
         begin
            if Name'Length > 0 then
               Symbol.Name := To_Unbounded_String (Name);
            end if;
         end;
      end;
   end Demangle;

   procedure Find_Nearest_Line (Symbols : in Region_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info) is
      Text_Section : Bfd.Sections.Section;
      Pc : constant Bfd.Vma_Type := Bfd.Vma_Type (Addr);
   begin
      if not Bfd.Files.Is_Open (Symbols.File) then
         Symbol.File := Symbols.Region.Path;
         return;
      end if;
      Text_Section := Bfd.Sections.Find_Section (Symbols.File, ".text");
      Bfd.Symbols.Find_Nearest_Line (File    => Symbols.File,
                                     Sec     => Text_Section,
                                     Symbols => Symbols.Symbols,
                                     Addr    => Pc,
                                     Name    => Symbol.File,
                                     Func    => Symbol.Name,
                                     Line    => Symbol.Line);
   end Find_Nearest_Line;

   --  ------------------------------
   --  Find the nearest source file and line for the given address.
   --  ------------------------------
   procedure Find_Nearest_Line (Symbols : in Target_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info) is
      Pos  : constant Symbols_Cursor := Symbols.Libraries.Floor (Addr);
   begin
      Symbol.Line := 0;
      if Symbols_Maps.Has_Element (Pos) then
         declare
            Syms : constant Region_Symbols_Ref := Symbols_Maps.Element (Pos);
         begin
            if Syms.Value.Region.End_Addr > Addr then
               Symbol.Symbols := Syms;
               Find_Nearest_Line (Symbols => Syms.Value,
                                  Addr    => Addr - Syms.Value.Offset,
                                  Symbol  => Symbol);
               Demangle (Symbols, Symbol);
               return;
            end if;

         exception
            when Bfd.NOT_FOUND =>
               Symbol.Line := 0;
               Symbol.File := Syms.Value.Region.Path;
               Symbol.Name := Ada.Strings.Unbounded.To_Unbounded_String (MAT.Formats.Addr (Addr));
               return;
         end;
      end if;
      Symbol.Line := 0;
      Symbol.File := Ada.Strings.Unbounded.To_Unbounded_String ("");
      Symbol.Name := Ada.Strings.Unbounded.To_Unbounded_String (MAT.Formats.Addr (Addr));
   end Find_Nearest_Line;

   --  ------------------------------
   --  Find the symbol in the symbol table and return the start and end address.
   --  ------------------------------
   procedure Find_Symbol_Range (Symbols : in Target_Symbols;
                                Name    : in String;
                                From    : out MAT.Types.Target_Addr;
                                To      : out MAT.Types.Target_Addr) is
      use type Bfd.Symbols.Symbol;

      Iter  : Symbols_Cursor := Symbols.Libraries.First;
   begin
      while Symbols_Maps.Has_Element (Iter) loop
         declare
            Syms : constant Region_Symbols_Ref := Symbols_Maps.Element (Iter);
            Sym  : Bfd.Symbols.Symbol;
            Sec  : Bfd.Sections.Section;
         begin
            if not Syms.Is_Null and then Bfd.Files.Is_Open (Syms.Value.File) then
               Sym := Bfd.Symbols.Get_Symbol (Syms.Value.Symbols, Name);
               if Sym /= Bfd.Symbols.Null_Symbol then
                  Sec := Bfd.Symbols.Get_Section (Sym);
                  if not Bfd.Sections.Is_Undefined_Section (Sec) then
                     From := MAT.Types.Target_Addr (Bfd.Symbols.Get_Value (Sym));
                     From := From + Syms.Value.Offset;
                     To := From + MAT.Types.Target_Addr (Bfd.Symbols.Get_Symbol_Size (Sym));
                     return;
                  end if;
               end if;
            end if;
         end;
         Symbols_Maps.Next (Iter);
      end loop;
   end Find_Symbol_Range;

   --  ------------------------------
   --  Find the symbol region in the symbol table which contains the given address
   --  and return the start and end address.
   --  ------------------------------
   procedure Find_Symbol_Range (Symbols : in Target_Symbols;
                                Addr    : in Mat.Types.Target_Addr;
                                From    : out MAT.Types.Target_Addr;
                                To      : out MAT.Types.Target_Addr) is
      use type Bfd.Symbols.Symbol;

      Pos  : constant Symbols_Cursor := Symbols.Libraries.Floor (Addr);
   begin
      if Symbols_Maps.Has_Element (Pos) then
         declare
            Syms   : constant Region_Symbols_Ref := Symbols_Maps.Element (Pos);
            Symbol : Symbol_Info;
            Sym    : Bfd.Symbols.Symbol;
            Sec    : Bfd.Sections.Section;
         begin
            if Syms.Value.Region.End_Addr > Addr then
               Symbol.Line := 0;
               Symbol.Symbols := Syms;
               Find_Nearest_Line (Symbols => Syms.Value,
                                  Addr    => Addr - Syms.Value.Offset,
                                  Symbol  => Symbol);

               Sym := Bfd.Symbols.Get_Symbol (Syms.Value.Symbols, Ada.Strings.Unbounded.To_String (Symbol.Name));
               if Sym /= Bfd.Symbols.Null_Symbol then
                  Sec := Bfd.Symbols.Get_Section (Sym);
                  if not Bfd.Sections.Is_Undefined_Section (Sec) then
                     From := MAT.Types.Target_Addr (Bfd.Symbols.Get_Value (Sym));
                     From := From + Syms.Value.Offset;
                     To := From + MAT.Types.Target_Addr (Bfd.Symbols.Get_Symbol_Size (Sym));
                     return;
                  end if;
               end if;
            end if;
         end;
      end if;
      From := Addr;
      To := Addr;

   exception
      when Bfd.NOT_FOUND =>
         From := Addr;
         To := Addr;
   end Find_Symbol_Range;

end MAT.Symbols.Targets;

Implement new Find_Symbol_Range Improvement of Find_Nearest_Line to return the region name when we don't have a symbol