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

package body Gen.Commands.Page is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use GNAT.Command_Line;
      use Ada.Strings.Unbounded;

      function Get_Layout return String;
      function Get_Name return String;

      Dir    : constant String := Generator.Get_Result_Directory & "web/";

      function Get_Name return String is
         Name : constant String := Get_Argument;
         Pos  : constant Natural := Util.Strings.Rindex (Name, '.');
      begin
         if Pos = 0 then
            return Name;
         elsif Name (Pos .. Name'Last) = ".xhtml" then
            return Name (Name'First .. Pos - 1);
         elsif Name (Pos .. Name'Last) = ".html" then
            return Name (Name'First .. Pos - 1);
         else
            return Name;
         end if;
      end Get_Name;

      function Get_Layout return String is
         Layout : constant String := Get_Argument;
      begin
         if Layout'Length = 0 then
            return "layout";
         end if;
         if Ada.Directories.Exists (Dir & "WEB-INF/layouts/" & Layout & ".xhtml") then
            return Layout;
         end if;

         Generator.Info ("Layout file {0} not found.", Layout);
         return Layout;
      end Get_Layout;

      Name   : constant String := Get_Name;
      Layout : constant String := Get_Layout;
   begin
      if Name'Length = 0 then
         Gen.Commands.Usage;
         return;
      end if;

      Generator.Set_Force_Save (False);
      Generator.Set_Result_Directory (Dir);
      Generator.Set_Global ("pageName", Name);
      Generator.Set_Global ("layout", Layout);
      Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "page");
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use Ada.Text_IO;
      use Ada.Directories;

      Path    : constant String := Generator.Get_Result_Directory & "web/WEB-INF/layouts";
      Filter  : constant Filter_Type := (Ordinary_File => True, others => False);
      Search  : Search_Type;
      Ent     : Directory_Entry_Type;
   begin
      Put_Line ("add-page: Add a new web page to the application");
      Put_Line ("Usage: add-page NAME [LAYOUT]");
      New_Line;
      Put_Line ("  The web page is an XHTML file created under the 'web' directory.");
      Put_Line ("  The NAME can contain a directory that will be created if necessary.");
      Put_Line ("  The new web page can be configured to use the given layout.");
      Put_Line ("  The layout file must exist to be used.  The default layout is 'layout'.");
      Put_Line ("  You can create a new layout with 'add-layout' command.");
      Put_Line ("  You can also write your layout by adding an XHTML file in the directory:");
      Put_Line ("     " & Path);
      if Exists (Path) then
         New_Line;
         Put_Line ("  Available layouts:");

         Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Name   : constant String := Simple_Name (Ent);
               Layout : constant String := Base_Name (Name);
            begin
               Put_Line ("      " & Layout);
            end;
         end loop;
      end if;
      New_Line;
      Put_Line ("  The following files are generated:");
      Put_Line ("    web/<name>.xhtml");
   end Help;

end Gen.Commands.Page;

-----------------------------------------------------------------------
--  gen-commands-page -- Page creation command for dynamo
--  Copyright (C) 2011, 2012, 2013, 2014, 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.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with GNAT.Command_Line;
with Util.Strings;

package body Gen.Commands.Page is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use Ada.Strings.Unbounded;

      function Get_Layout return String;
      function Get_Name return String;

      Dir    : constant String := Generator.Get_Result_Directory & "web/";

      function Get_Name return String is
         Name : constant String := Args.Get_Argument (1);
         Pos  : constant Natural := Util.Strings.Rindex (Name, '.');
      begin
         if Pos = 0 then
            return Name;
         elsif Name (Pos .. Name'Last) = ".xhtml" then
            return Name (Name'First .. Pos - 1);
         elsif Name (Pos .. Name'Last) = ".html" then
            return Name (Name'First .. Pos - 1);
         else
            return Name;
         end if;
      end Get_Name;

      function Get_Layout return String is
      begin
         if Args.Get_Count = 1 then
            return "layout";
         end if;
         declare
            Layout : constant String := Args.Get_Argument (2);
         begin
            if Ada.Directories.Exists (Dir & "WEB-INF/layouts/" & Layout & ".xhtml") then
               return Layout;
            end if;

            Generator.Info ("Layout file {0} not found.", Layout);
            return Layout;
         end;
      end Get_Layout;

   begin
      if Args.Get_Count = 0 or Args.Get_Count > 2 then
         Gen.Commands.Usage;
         return;
      end if;

      Generator.Set_Force_Save (False);
      Generator.Set_Result_Directory (Dir);
      Generator.Set_Global ("pageName", Get_Name);
      Generator.Set_Global ("layout", Get_Layout);
      Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "page");
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use Ada.Text_IO;
      use Ada.Directories;

      Path    : constant String := Generator.Get_Result_Directory & "web/WEB-INF/layouts";
      Filter  : constant Filter_Type := (Ordinary_File => True, others => False);
      Search  : Search_Type;
      Ent     : Directory_Entry_Type;
   begin
      Put_Line ("add-page: Add a new web page to the application");
      Put_Line ("Usage: add-page NAME [LAYOUT]");
      New_Line;
      Put_Line ("  The web page is an XHTML file created under the 'web' directory.");
      Put_Line ("  The NAME can contain a directory that will be created if necessary.");
      Put_Line ("  The new web page can be configured to use the given layout.");
      Put_Line ("  The layout file must exist to be used.  The default layout is 'layout'.");
      Put_Line ("  You can create a new layout with 'add-layout' command.");
      Put_Line ("  You can also write your layout by adding an XHTML file in the directory:");
      Put_Line ("     " & Path);
      if Exists (Path) then
         New_Line;
         Put_Line ("  Available layouts:");

         Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Name   : constant String := Simple_Name (Ent);
               Layout : constant String := Base_Name (Name);
            begin
               Put_Line ("      " & Layout);
            end;
         end loop;
      end if;
      New_Line;
      Put_Line ("  The following files are generated:");
      Put_Line ("    web/<name>.xhtml");
   end Help;

end Gen.Commands.Page;

Update to use the new command implementation


-----------------------------------------------------------------------
--  render -- XHTML Rendering example
--  Copyright (C) 2010 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.Text_IO;
with Ada.Exceptions;
with Ada.IO_Exceptions;
with Ada.Strings.Unbounded;
with Ada.Strings.Fixed;

with GNAT.Command_Line;

with ASF.Applications.Views;
with ASF.Components.Core;
with ASF.Contexts.Faces;
with ASF.Contexts.Writer.String;

with EL.Objects;
with EL.Contexts;
with EL.Contexts.Default;
with EL.Variables;
with EL.Variables.Default;

--  This example reads an XHTML file and renders the result.
procedure Render is

   use GNAT.Command_Line;
   use Ada.Strings.Fixed;

   use ASF;
   use ASF.Contexts.Faces;

   use EL.Contexts.Default;
   use EL.Variables;
   use EL.Variables.Default;
   use EL.Contexts;
   use EL.Objects;

   H        : Applications.Views.View_Handler;
   Writer   : aliased Contexts.Writer.String.String_Writer;
   Context  : aliased Faces_Context;
   View     : Components.Core.UIViewRoot;
   ELContext : aliased EL.Contexts.Default.Default_Context;
   Variables : aliased Default_Variable_Mapper;
   Resolver  : aliased Default_ELResolver;
   Conf      : Applications.Config;

begin
   loop
      case Getopt ("D:") is
         when 'D' =>
            declare
               Value : constant String := Parameter;
               Pos   : constant Natural := Index (Value, "=");
            begin
--                 if Pos > 0 then
--                    Variables.Set_Variable (Value (1 .. Pos - 1),
--                                            To_Object (Value (Pos + 1 .. Value'Last)));
--                 else
--                    Variables.Set_Variable (Value, To_Object(True));
--                 end if;
               null;
            end;

         when others =>
            exit;
      end case;
   end loop;

   Conf.Set ("view.ignore_white_spaces", "false");
   Conf.Set ("view.escape_unknown_tags", "false");
   Conf.Set ("view.ignore_empty_lines", "true");
   declare
      View_Name : constant String := Get_Argument;
   begin
      H.Initialize (Conf);

      Context.Set_Response_Writer (Writer'Unchecked_Access);
      Context.Set_ELContext (ELContext'Unchecked_Access);
      ELContext.Set_Variable_Mapper (Variables'Unchecked_Access);
      ELContext.Set_Resolver (Resolver'Unchecked_Access);
      Writer.Initialize ("text/xml", "UTF-8", 8192);

      Set_Current (Context'Unchecked_Access);
      H.Restore_View (View_Name, Context, View);

      H.Render_View (Context, View);
      Writer.Flush;

      Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Writer.Get_Response));
      H.Close;

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Ada.Text_IO.Put_Line ("Cannot read file '" & View_Name & "'");
   end;
end Render;

-----------------------------------------------------------------------
--  render -- XHTML Rendering example
--  Copyright (C) 2010 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.Text_IO;
with Ada.Exceptions;
with Ada.IO_Exceptions;
with Ada.Strings.Unbounded;
with Ada.Strings.Fixed;

with GNAT.Command_Line;

with ASF.Applications.Views;
with ASF.Components.Core;
with ASF.Contexts.Faces;
with ASF.Contexts.Writer.String;

with EL.Objects;
with EL.Contexts;
with EL.Contexts.Default;
with EL.Variables;
with EL.Variables.Default;
with ASF.Streams;
--  This example reads an XHTML file and renders the result.
procedure Render is

   use GNAT.Command_Line;
   use Ada.Strings.Fixed;

   use ASF;
   use ASF.Contexts.Faces;

   use EL.Contexts.Default;
   use EL.Variables;
   use EL.Variables.Default;
   use EL.Contexts;
   use EL.Objects;

   H        : Applications.Views.View_Handler;
   Writer   : aliased Contexts.Writer.String.String_Writer;
   Context  : aliased Faces_Context;
   View     : Components.Core.UIViewRoot;
   ELContext : aliased EL.Contexts.Default.Default_Context;
   Variables : aliased Default_Variable_Mapper;
   Resolver  : aliased Default_ELResolver;
   Conf      : Applications.Config;
   Output    : ASF.Streams.Print_Stream;
begin
   loop
      case Getopt ("D:") is
         when 'D' =>
            declare
               Value : constant String := Parameter;
               Pos   : constant Natural := Index (Value, "=");
            begin
--                 if Pos > 0 then
--                    Variables.Set_Variable (Value (1 .. Pos - 1),
--                                            To_Object (Value (Pos + 1 .. Value'Last)));
--                 else
--                    Variables.Set_Variable (Value, To_Object(True));
--                 end if;
               null;
            end;

         when others =>
            exit;
      end case;
   end loop;

   Conf.Set ("view.ignore_white_spaces", "false");
   Conf.Set ("view.escape_unknown_tags", "false");
   Conf.Set ("view.ignore_empty_lines", "true");
   declare
      View_Name : constant String := Get_Argument;
   begin
      H.Initialize (Conf);

      Context.Set_Response_Writer (Writer'Unchecked_Access);
      Context.Set_ELContext (ELContext'Unchecked_Access);
      ELContext.Set_Variable_Mapper (Variables'Unchecked_Access);
      ELContext.Set_Resolver (Resolver'Unchecked_Access);
      Writer.Initialize ("text/xml", "UTF-8", Output);

      Set_Current (Context'Unchecked_Access);
      H.Restore_View (View_Name, Context, View);

      H.Render_View (Context, View);
      Writer.Flush;

      Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Writer.Get_Response));
      H.Close;

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Ada.Text_IO.Put_Line ("Cannot read file '" & View_Name & "'");
   end;
end Render;

Fix compilation

Fix compilation


-----------------------------------------------------------------------
--  render -- Wiki rendering example
--  Copyright (C) 2015, 2016, 2020, 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 Ada.Text_IO;
with Ada.IO_Exceptions;
with Ada.Strings.Unbounded;
with Ada.Directories;

with GNAT.Command_Line;

with Wiki.Documents;
with Wiki.Parsers;
with Wiki.Filters.TOC;
with Wiki.Filters.Html;
with Wiki.Filters.Autolink;
with Wiki.Plugins.Templates;
with Wiki.Render.Html;
with Wiki.Render.Text;
with Wiki.Streams.Text_IO;
with Wiki.Streams.Html.Text_IO;

procedure Render is

   use GNAT.Command_Line;
   use Ada.Strings.Unbounded;

   procedure Usage;
   procedure Render_Html (Doc   : in out Wiki.Documents.Document;
                          Style : in Unbounded_String);
   procedure Render_Text (Doc : in out Wiki.Documents.Document);

   procedure Usage is
   begin
      Ada.Text_IO.Put_Line ("Render a wiki text file into HTML (default) or text");
      Ada.Text_IO.Put_Line ("Usage: render [-t] [-m] [-M] [-H] [-d] [-c] [-s style] {wiki-file}");
      Ada.Text_IO.Put_Line ("  -t        Render to text only");
      Ada.Text_IO.Put_Line ("  -m        Render a Markdown wiki content");
      Ada.Text_IO.Put_Line ("  -M        Render a Mediawiki wiki content");
      Ada.Text_IO.Put_Line ("  -T        Render a Textile wiki content");
      Ada.Text_IO.Put_Line ("  -H        Render a HTML wiki content");
      Ada.Text_IO.Put_Line ("  -d        Render a Dotclear wiki content");
      Ada.Text_IO.Put_Line ("  -g        Render a Google wiki content");
      Ada.Text_IO.Put_Line ("  -c        Render a Creole wiki content");
      Ada.Text_IO.Put_Line ("  -s style  Use the CSS style file");
   end Usage;

   procedure Render_Html (Doc   : in out Wiki.Documents.Document;
                          Style : in Unbounded_String) is
      Output   : aliased Wiki.Streams.Html.Text_IO.Html_Output_Stream;
      Renderer : aliased Wiki.Render.Html.Html_Renderer;
   begin
      if Length (Style) > 0 then
         Output.Start_Element ("html");
         Output.Start_Element ("head");
         Output.Start_Element ("link");
         Output.Write_Attribute ("type", "text/css");
         Output.Write_Attribute ("rel", "stylesheet");
         Output.Write_Attribute ("href", To_String (Style));
         Output.End_Element ("link");
         Output.End_Element ("head");
         Output.Start_Element ("body");
      end if;
      Renderer.Set_Output_Stream (Output'Unchecked_Access);
      Renderer.Set_Render_TOC (True);
      Renderer.Render (Doc);
      if Length (Style) > 0 then
         Output.End_Element ("body");
         Output.End_Element ("html");
      end if;
   end Render_Html;

   procedure Render_Text (Doc : in out Wiki.Documents.Document) is
      Output   : aliased Wiki.Streams.Text_IO.File_Output_Stream;
      Renderer : aliased Wiki.Render.Text.Text_Renderer;
   begin
      Renderer.Set_Output_Stream (Output'Unchecked_Access);
      Renderer.Render (Doc);
   end Render_Text;

   Count     : Natural := 0;
   Html_Mode : Boolean := True;
   Syntax    : Wiki.Wiki_Syntax := Wiki.SYNTAX_MARKDOWN;
   Style     : Unbounded_String;
begin
   loop
      case Getopt ("m M d c g t T H s:") is
         when 'm' =>
            Syntax := Wiki.SYNTAX_MARKDOWN;

         when 'M' =>
            Syntax := Wiki.SYNTAX_MEDIA_WIKI;

         when 'c' =>
            Syntax := Wiki.SYNTAX_CREOLE;

         when 'd' =>
            Syntax := Wiki.SYNTAX_DOTCLEAR;

         when 'H' =>
            Syntax := Wiki.SYNTAX_HTML;

         when 'T' =>
            Syntax := Wiki.SYNTAX_TEXTILE;

         when 'g' =>
            Syntax := Wiki.SYNTAX_GOOGLE;

         when 't' =>
            Html_Mode := False;

         when 's' =>
            Style := To_Unbounded_String (Parameter);

         when others =>
            exit;
      end case;
   end loop;

   loop
      declare
         Name     : constant String := GNAT.Command_Line.Get_Argument;
         Input    : aliased Wiki.Streams.Text_IO.File_Input_Stream;
         Filter   : aliased Wiki.Filters.Html.Html_Filter_Type;
         Autolink : aliased Wiki.Filters.Autolink.Autolink_Filter;
         Template : aliased Wiki.Plugins.Templates.File_Template_Plugin;
         TOC      : aliased Wiki.Filters.TOC.TOC_Filter;
         Doc      : Wiki.Documents.Document;
         Engine   : Wiki.Parsers.Parser;
      begin
         if Name = "" then
            if Count = 0 then
               Usage;
            end if;
            return;
         end if;
         Count := Count + 1;

         Template.Set_Template_Path (Ada.Directories.Containing_Directory (Name));

         --  Open the file and parse it (assume UTF-8).
         Input.Open (Name, "WCEM=8");
         Engine.Set_Plugin_Factory (Template'Unchecked_Access);
         Engine.Add_Filter (TOC'Unchecked_Access);
         Engine.Add_Filter (Autolink'Unchecked_Access);
         Engine.Add_Filter (Filter'Unchecked_Access);
         Engine.Set_Syntax (Syntax);
         Engine.Parse (Input'Unchecked_Access, Doc);

         --  Render the document in text or HTML.
         if Html_Mode then
            Render_Html (Doc, Style);
         else
            Render_Text (Doc);
         end if;

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Ada.Text_IO.Put_Line ("Cannot read file '" & Name & "'");

      end;
   end loop;

exception
   when Invalid_Switch =>
      Ada.Text_IO.Put_Line ("Invalid option.");
      Usage;
end Render;

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

with Wiki.Documents;
with Wiki.Parsers;
with Wiki.Filters.TOC;
with Wiki.Filters.Html;
with Wiki.Filters.Autolink;
with Wiki.Plugins.Templates;
with Wiki.Render.Html;
with Wiki.Render.Text;
with Wiki.Streams.Text_IO;
with Wiki.Streams.Html.Text_IO;

procedure Render is

   use Ada.Strings.Unbounded;

   procedure Usage;
   procedure Render_Html (Doc   : in out Wiki.Documents.Document;
                          Style : in Unbounded_String);
   procedure Render_Text (Doc : in out Wiki.Documents.Document);

   Arg_Count : constant Natural := Ada.Command_Line.Argument_Count;
   Count     : Natural := 0;
   Html_Mode : Boolean := True;
   Html_Toc  : Boolean := False;
   Syntax    : Wiki.Wiki_Syntax := Wiki.SYNTAX_MARKDOWN;
   Style     : Unbounded_String;
   Indent    : Natural := 3;

   procedure Usage is
   begin
      Ada.Text_IO.Put_Line ("Render a wiki text file into HTML (default) or text");
      Ada.Text_IO.Put_Line ("Usage: render [-t] [-m] [-M] [-H] [-d] [-c] [-s style] {wiki-file}");
      Ada.Text_IO.Put_Line ("  -t        Render to text only");
      Ada.Text_IO.Put_Line ("  -m        Render a Markdown wiki content");
      Ada.Text_IO.Put_Line ("  -M        Render a Mediawiki wiki content");
      Ada.Text_IO.Put_Line ("  -T        Render a Textile wiki content");
      Ada.Text_IO.Put_Line ("  -H        Render a HTML wiki content");
      Ada.Text_IO.Put_Line ("  -d        Render a Dotclear wiki content");
      Ada.Text_IO.Put_Line ("  -g        Render a Google wiki content");
      Ada.Text_IO.Put_Line ("  -c        Render a Creole wiki content");
      Ada.Text_IO.Put_Line ("  -s style  Use the CSS style file");
      Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
   end Usage;

   procedure Render_Html (Doc   : in out Wiki.Documents.Document;
                          Style : in Unbounded_String) is
      Output   : aliased Wiki.Streams.Html.Text_IO.Html_Output_Stream;
      Renderer : aliased Wiki.Render.Html.Html_Renderer;
   begin
      Output.Set_Indent_Level (Indent);
      if Length (Style) > 0 then
         Output.Start_Element ("html");
         Output.Start_Element ("head");
         Output.Start_Element ("link");
         Output.Write_Attribute ("type", "text/css");
         Output.Write_Attribute ("rel", "stylesheet");
         Output.Write_Attribute ("href", To_String (Style));
         Output.End_Element ("link");
         Output.End_Element ("head");
         Output.Start_Element ("body");
      end if;
      Renderer.Set_Output_Stream (Output'Unchecked_Access);
      Renderer.Set_Render_TOC (Html_Toc);
      Renderer.Render (Doc);
      if Length (Style) > 0 then
         Output.End_Element ("body");
         Output.End_Element ("html");
      end if;
   end Render_Html;

   procedure Render_Text (Doc : in out Wiki.Documents.Document) is
      Output   : aliased Wiki.Streams.Text_IO.File_Output_Stream;
      Renderer : aliased Wiki.Render.Text.Text_Renderer;
   begin
      Renderer.Set_Output_Stream (Output'Unchecked_Access);
      Renderer.Render (Doc);
   end Render_Text;

   procedure Render_File (Name : in String) is
      Input    : aliased Wiki.Streams.Text_IO.File_Input_Stream;
      Filter   : aliased Wiki.Filters.Html.Html_Filter_Type;
      Autolink : aliased Wiki.Filters.Autolink.Autolink_Filter;
      Template : aliased Wiki.Plugins.Templates.File_Template_Plugin;
      TOC      : aliased Wiki.Filters.TOC.TOC_Filter;
      Doc      : Wiki.Documents.Document;
      Engine   : Wiki.Parsers.Parser;
   begin
      Count := Count + 1;

      Template.Set_Template_Path (Ada.Directories.Containing_Directory (Name));

      --  Open the file and parse it (assume UTF-8).
      if Name /= "--" then
         Input.Open (Name, "WCEM=8");
      end if;
      Engine.Set_Plugin_Factory (Template'Unchecked_Access);
      Engine.Add_Filter (TOC'Unchecked_Access);
      Engine.Add_Filter (Autolink'Unchecked_Access);
      Engine.Add_Filter (Filter'Unchecked_Access);
      Engine.Set_Syntax (Syntax);
      Engine.Parse (Input'Unchecked_Access, Doc);

      --  Render the document in text or HTML.
      if Html_Mode then
         Render_Html (Doc, Style);
      else
         Render_Text (Doc);
      end if;

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Ada.Text_IO.Put_Line ("Cannot read file '" & Name & "'");
         Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);

   end Render_File;

begin
   for I in 1 .. Arg_Count loop
      declare
         Param : constant String := Ada.Command_Line.Argument (I);
      begin
         if Param = "-m" then
            Syntax := Wiki.SYNTAX_MARKDOWN;
         elsif Param = "-M" then
            Syntax := Wiki.SYNTAX_MEDIA_WIKI;
         elsif Param = "-c" then
            Syntax := Wiki.SYNTAX_CREOLE;
         elsif Param = "-d" then
            Syntax := Wiki.SYNTAX_DOTCLEAR;
         elsif Param = "-H" then
            Syntax := Wiki.SYNTAX_HTML;
         elsif Param = "-T" then
            Syntax := Wiki.SYNTAX_TEXTILE;
         elsif Param = "-g" then
            Syntax := Wiki.SYNTAX_GOOGLE;
         elsif Param = "-t" then
            Html_Mode := False;
         elsif Param = "-z" then
            Html_Toc := True;
         elsif Param = "-s" then
            Style := To_Unbounded_String (Param);
         elsif Param = "--" then
            Render_File (Param);
         elsif Param = "-0" then
            Indent := 0;
         elsif Param = "-1" then
            Indent := 1;
         elsif Param = "-2" then
            Indent := 2;
         elsif Param (Param'First) = '-' then
            Usage;
            return;
         else
            Render_File (Param);
         end if;
      end;
   end loop;

   if Count = 0 then
      Usage;
   end if;

end Render;

Update the render example to allow reading the standard input and configure the html indentation level


-----------------------------------------------------------------------
--  ado-queries-tests -- Test loading of database queries
--  Copyright (C) 2011 - 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 Util.Test_Caller;

with ADO.Connections;
with ADO.Queries.Loaders;
package body ADO.Queries.Tests is

   use Util.Tests;

   function Loader (Name : in String) return access constant String;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Queries.Read_Query",
                       Test_Load_Queries'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Find_Query",
                       Test_Find_Query'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Initialize",
                       Test_Initialize'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Read_Query (reload)",
                       Test_Reload_Queries'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Set_Query",
                       Test_Set_Query'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Set_Limit",
                       Test_Set_Limit'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Get_SQL (raise Query_Error)",
                       Test_Missing_Query'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Set_Query_Loader",
                       Test_Query_Loader'Access);
   end Add_Tests;

   package Simple_Query_File is
     new ADO.Queries.Loaders.File (Path => "regtests/files/simple-query.xml",
                                   Sha1 => "");

   package Multi_Query_File is
     new ADO.Queries.Loaders.File (Path => "regtests/files/multi-query.xml",
                                   Sha1 => "");

   package Missing_Query_File is
     new ADO.Queries.Loaders.File (Path => "regtests/files/missing-query.xml",
                                   Sha1 => "");

   package Internal_Query_File is
     new ADO.Queries.Loaders.File (Path => "regtests/files/internal-query.xml",
                                   Sha1 => "");

   package Simple_Query is
     new ADO.Queries.Loaders.Query (Name => "simple-query",
                                    File => Simple_Query_File.File'Access);

   package Simple_Query_2 is
     new ADO.Queries.Loaders.Query (Name => "simple-query",
                                    File => Multi_Query_File.File'Access);

   package Index_Query is
     new ADO.Queries.Loaders.Query (Name => "index",
                                    File => Multi_Query_File.File'Access);

   package Value_Query is
     new ADO.Queries.Loaders.Query (Name => "value",
                                    File => Multi_Query_File.File'Access);

   package Internal_Query is
     new ADO.Queries.Loaders.Query (Name => "internal-query",
                                    File => Internal_Query_File.File'Access);

   package Missing_Query_SQLite is
     new ADO.Queries.Loaders.Query (Name => "missing-query-sqlite",
                                    File => Missing_Query_File.File'Access);

   package Missing_Query_MySQL is
     new ADO.Queries.Loaders.Query (Name => "missing-query-mysql",
                                    File => Missing_Query_File.File'Access);

   package Missing_Query_Postgresql is
     new ADO.Queries.Loaders.Query (Name => "missing-query-postgresql",
                                    File => Missing_Query_File.File'Access);

   package Missing_Query is
     new ADO.Queries.Loaders.Query (Name => "missing-query",
                                    File => Missing_Query_File.File'Access);

   pragma Warnings (Off, Simple_Query_2);
   pragma Warnings (Off, Value_Query);
   pragma Warnings (Off, Missing_Query);
   pragma Warnings (Off, Missing_Query_SQLite);
   pragma Warnings (Off, Missing_Query_MySQL);
   pragma Warnings (Off, Missing_Query_Postgresql);
   pragma Warnings (Off, Internal_Query);

   procedure Test_Load_Queries (T : in out Test) is
      use ADO.Connections;
      use type ADO.Configs.Driver_Index;

      Mysql_Driver      : constant Driver_Access := ADO.Connections.Get_Driver ("mysql");
      Sqlite_Driver     : constant Driver_Access := ADO.Connections.Get_Driver ("sqlite");
      Psql_Driver       : constant Driver_Access := ADO.Connections.Get_Driver ("postgresql");
      Config            : ADO.Connections.Configuration;
      Manager           : Query_Manager;
      Config_URL        : constant String := Util.Tests.Get_Parameter ("test.database",
                                                                       "sqlite:///regtests.db");
   begin
      --  Configure the XML query loader.
      Config.Set_Connection (Config_URL);
      ADO.Queries.Loaders.Initialize (Manager, Config);

      declare
         SQL : constant String := ADO.Queries.Get_SQL (Simple_Query.Query'Access, Manager, False);
      begin
         Assert_Equals (T, "select count(*) from user", SQL, "Invalid query for 'simple-query'");
      end;

      declare
         SQL : constant String := ADO.Queries.Get_SQL (Index_Query.Query'Access, Manager, False);
      begin
         if Mysql_Driver /= null and then Manager.Driver = Mysql_Driver.Get_Driver_Index then
            Assert_Equals (T, "select 1", SQL, "Invalid query for 'index'");
         elsif Psql_Driver /= null and then Manager.Driver = Psql_Driver.Get_Driver_Index then
            Assert_Equals (T, "select 3", SQL, "Invalid query for 'index'");
         else
            Assert_Equals (T, "select 0", SQL, "Invalid query for 'index'");
         end if;
      end;

      if Mysql_Driver /= null and then Manager.Driver = Mysql_Driver.Get_Driver_Index then
         declare
            SQL : constant String := ADO.Queries.Get_SQL (Index_Query.Query'Access,
                                                          Manager,
                                                          False);
         begin
            Assert_Equals (T, "select 1", SQL, "Invalid query for 'index' (MySQL driver)");
         end;
      end if;
      if Sqlite_Driver /= null and then Manager.Driver = Sqlite_Driver.Get_Driver_Index then
         declare
            SQL : constant String := ADO.Queries.Get_SQL (Index_Query.Query'Access,
                                                          Manager, False);
         begin
            Assert_Equals (T, "select 0", SQL, "Invalid query for 'index' (SQLite driver)");
         end;
      end if;
      if Psql_Driver /= null and then Manager.Driver = Psql_Driver.Get_Driver_Index
      then
         declare
            SQL : constant String := ADO.Queries.Get_SQL (Index_Query.Query'Access,
                                                          Manager,
                                                          False);
         begin
            Assert_Equals (T, "select 3", SQL, "Invalid query for 'index' (PostgreSQL driver)");
         end;
      end if;
   end Test_Load_Queries;

   --  ------------------------------
   --  Test re-loading queries.
   --  ------------------------------
   procedure Test_Reload_Queries (T : in out Test) is
      Config  : ADO.Connections.Configuration;
      Manager : Query_Manager;
      Query   : ADO.Queries.Context;
      Config_URL : constant String := Util.Tests.Get_Parameter ("test.database",
                                                                "sqlite:///regtests.db");
   begin
      --  Configure the XML query loader.
      Config.Set_Connection (Config_URL);
      ADO.Queries.Loaders.Initialize (Manager, Config);
      for I in 1 .. 10 loop
         Query.Set_Query ("simple-query");

         declare
            SQL : constant String := Query.Get_SQL (Manager);
         begin
            Assert_Equals (T, "select count(*) from user", SQL,
                           "Invalid query for 'simple-query'");
         end;
         for J in Manager.Files'Range loop
            Manager.Files (J).Next_Check := 0;
         end loop;
      end loop;
   end Test_Reload_Queries;

   --  ------------------------------
   --  Test the Initialize operation called several times
   --  ------------------------------
   procedure Test_Initialize (T : in out Test) is
      Config  : ADO.Connections.Configuration;
      Manager : Query_Manager;
      Pos     : Query_Index;
      Config_URL : constant String := Util.Tests.Get_Parameter ("test.database",
                                                                "sqlite:///regtests.db");
   begin
      Config.Set_Connection (Config_URL);

      --  Configure and load the XML queries.
      for Pass in 1 .. 10 loop
         Config.Set_Property ("ado.queries.load", (if Pass = 1 then "false" else "true"));
         ADO.Queries.Loaders.Initialize (Manager, Config);
         T.Assert (Manager.Queries /= null, "The queries table is allocated");
         T.Assert (Manager.Files /= null, "The files table is allocated");
         Pos := 1;
         for Query of Manager.Queries.all loop
            if Pass = 1 then
               T.Assert (Query.Is_Null, "Query must not be loaded");
            elsif Missing_Query.Query.Query /= Pos
              and Internal_Query.Query.Query /= Pos
            then
               T.Assert (not Query.Is_Null, "Query must have been loaded");
            else
               T.Assert (Query.Is_Null, "Query must not be loaded (not found)");
            end if;
            Pos := Pos + 1;
         end loop;
      end loop;

   end Test_Initialize;

   --  ------------------------------
   --  Test the Set_Query operation.
   --  ------------------------------
   procedure Test_Set_Query (T : in out Test) is
      Query   : ADO.Queries.Context;
      Manager : Query_Manager;
      Config  : ADO.Connections.Configuration;
      Config_URL : constant String := Util.Tests.Get_Parameter ("test.database",
                                                                "sqlite:///regtests.db");
   begin
      Config.Set_Connection (Config_URL);
      ADO.Queries.Loaders.Initialize (Manager, Config);
      Query.Set_Query ("simple-query");

      declare
         SQL : constant String := Query.Get_SQL (Manager);
      begin
         Assert_Equals (T, "select count(*) from user", SQL, "Invalid query for 'simple-query'");
      end;
   end Test_Set_Query;

   --  ------------------------------
   --  Test the Set_Limit operation.
   --  ------------------------------
   procedure Test_Set_Limit (T : in out Test) is
      Query : ADO.Queries.Context;
   begin
      Query.Set_Query ("index");
      Query.Set_Limit (0, 10);
      Assert_Equals (T, 0, Query.Get_First_Row_Index, "Invalid first row index");
      Assert_Equals (T, 10, Query.Get_Last_Row_Index, "Invalid last row index");
   end Test_Set_Limit;

   --  ------------------------------
   --  Test the Find_Query operation.
   --  ------------------------------
   procedure Test_Find_Query (T : in out Test) is
      Q : Query_Definition_Access;
   begin
      Q := ADO.Queries.Loaders.Find_Query ("this query does not exist");
      T.Assert (Q = null, "Find_Query should return null for unkown query");
   end Test_Find_Query;

   --  ------------------------------
   --  Test the missing query.
   --  ------------------------------
   procedure Test_Missing_Query (T : in out Test) is
      Query   : ADO.Queries.Context;
      Manager : Query_Manager;
      Config  : ADO.Connections.Configuration;
      Count   : Natural := 0;
      Config_URL : constant String := Util.Tests.Get_Parameter ("test.database",
                                                                "sqlite:///regtests.db");
   begin
      Config.Set_Connection (Config_URL);
      ADO.Queries.Loaders.Initialize (Manager, Config);
      Query.Set_Query ("missing-query");

      begin
         Assert_Equals (T, "?", Query.Get_SQL (Manager));
         T.Fail ("No ADO.Queries.Query_Error exception was raised");

      exception
         when ADO.Queries.Query_Error =>
            null;
      end;

      begin
         Query.Set_Query ("missing-query-sqlite");
         Assert_Equals (T, "select count(*) from user", Query.Get_SQL (Manager));

      exception
         when ADO.Queries.Query_Error =>
            Count := Count + 1;
      end;

      begin
         Query.Set_Query ("missing-query-mysql");
         Assert_Equals (T, "select count(*) from user", Query.Get_SQL (Manager));

      exception
         when ADO.Queries.Query_Error =>
            Count := Count + 1;
      end;

      begin
         Query.Set_Query ("missing-query-postgresql");
         Assert_Equals (T, "select count(*) from user", Query.Get_SQL (Manager));

      exception
         when ADO.Queries.Query_Error =>
            Count := Count + 1;
      end;
      T.Assert (Count > 0, "No Query_Error exception was raised");
   end Test_Missing_Query;

   Q1 : aliased constant String := "<query-mapping><query name='internal-query'>"
     & "<sql>SELECT 'internal-query'</sql></query></query-mapping>";

   function Loader (Name : in String) return access constant String is
   begin
      if Name = "regtests/files/internal-query.xml" then
         return Q1'Access;
      end if;

      return null;
   end Loader;

   --  ------------------------------
   --  Test the static query loader.
   --  ------------------------------
   procedure Test_Query_Loader (T : in out Test) is
      Query   : ADO.Queries.Context;
      Manager : Query_Manager;
      Config  : ADO.Connections.Configuration;
      Config_URL : constant String := Util.Tests.Get_Parameter ("test.database",
                                                                "sqlite:///regtests.db");
   begin
      Config.Set_Connection (Config_URL);
      Manager.Set_Query_Loader (Loader'Access);
      ADO.Queries.Loaders.Initialize (Manager, Config);
      Query.Set_Query ("internal-query");

      Assert_Equals (T, "SELECT 'internal-query'", Query.Get_SQL (Manager));

   end Test_Query_Loader;

end ADO.Queries.Tests;

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

with Util.Test_Caller;

with ADO.Connections;
with ADO.Queries.Loaders;
package body ADO.Queries.Tests is

   use Util.Tests;

   Init_Time : constant Ada.Calendar.Time
     := Ada.Calendar.Time_Of (Year  => Ada.Calendar.Year_Number'First,
                              Month => 1,
                              Day   => 1);

   function Loader (Name : in String) return access constant String;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Queries.Read_Query",
                       Test_Load_Queries'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Find_Query",
                       Test_Find_Query'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Initialize",
                       Test_Initialize'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Read_Query (reload)",
                       Test_Reload_Queries'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Set_Query",
                       Test_Set_Query'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Set_Limit",
                       Test_Set_Limit'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Get_SQL (raise Query_Error)",
                       Test_Missing_Query'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Set_Query_Loader",
                       Test_Query_Loader'Access);
   end Add_Tests;

   package Simple_Query_File is
     new ADO.Queries.Loaders.File (Path => "regtests/files/simple-query.xml",
                                   Sha1 => "");

   package Multi_Query_File is
     new ADO.Queries.Loaders.File (Path => "regtests/files/multi-query.xml",
                                   Sha1 => "");

   package Missing_Query_File is
     new ADO.Queries.Loaders.File (Path => "regtests/files/missing-query.xml",
                                   Sha1 => "");

   package Internal_Query_File is
     new ADO.Queries.Loaders.File (Path => "regtests/files/internal-query.xml",
                                   Sha1 => "");

   package Simple_Query is
     new ADO.Queries.Loaders.Query (Name => "simple-query",
                                    File => Simple_Query_File.File'Access);

   package Simple_Query_2 is
     new ADO.Queries.Loaders.Query (Name => "simple-query",
                                    File => Multi_Query_File.File'Access);

   package Index_Query is
     new ADO.Queries.Loaders.Query (Name => "index",
                                    File => Multi_Query_File.File'Access);

   package Value_Query is
     new ADO.Queries.Loaders.Query (Name => "value",
                                    File => Multi_Query_File.File'Access);

   package Internal_Query is
     new ADO.Queries.Loaders.Query (Name => "internal-query",
                                    File => Internal_Query_File.File'Access);

   package Missing_Query_SQLite is
     new ADO.Queries.Loaders.Query (Name => "missing-query-sqlite",
                                    File => Missing_Query_File.File'Access);

   package Missing_Query_MySQL is
     new ADO.Queries.Loaders.Query (Name => "missing-query-mysql",
                                    File => Missing_Query_File.File'Access);

   package Missing_Query_Postgresql is
     new ADO.Queries.Loaders.Query (Name => "missing-query-postgresql",
                                    File => Missing_Query_File.File'Access);

   package Missing_Query is
     new ADO.Queries.Loaders.Query (Name => "missing-query",
                                    File => Missing_Query_File.File'Access);

   pragma Warnings (Off, Simple_Query_2);
   pragma Warnings (Off, Value_Query);
   pragma Warnings (Off, Missing_Query);
   pragma Warnings (Off, Missing_Query_SQLite);
   pragma Warnings (Off, Missing_Query_MySQL);
   pragma Warnings (Off, Missing_Query_Postgresql);
   pragma Warnings (Off, Internal_Query);

   procedure Test_Load_Queries (T : in out Test) is
      use ADO.Connections;
      use type ADO.Configs.Driver_Index;

      Mysql_Driver      : constant Driver_Access := ADO.Connections.Get_Driver ("mysql");
      Sqlite_Driver     : constant Driver_Access := ADO.Connections.Get_Driver ("sqlite");
      Psql_Driver       : constant Driver_Access := ADO.Connections.Get_Driver ("postgresql");
      Config            : ADO.Connections.Configuration;
      Manager           : Query_Manager;
      Config_URL        : constant String := Util.Tests.Get_Parameter ("test.database",
                                                                       "sqlite:///regtests.db");
   begin
      --  Configure the XML query loader.
      Config.Set_Connection (Config_URL);
      ADO.Queries.Loaders.Initialize (Manager, Config);

      declare
         SQL : constant String := ADO.Queries.Get_SQL (Simple_Query.Query'Access, Manager, False);
      begin
         Assert_Equals (T, "select count(*) from user", SQL, "Invalid query for 'simple-query'");
      end;

      declare
         SQL : constant String := ADO.Queries.Get_SQL (Index_Query.Query'Access, Manager, False);
      begin
         if Mysql_Driver /= null and then Manager.Driver = Mysql_Driver.Get_Driver_Index then
            Assert_Equals (T, "select 1", SQL, "Invalid query for 'index'");
         elsif Psql_Driver /= null and then Manager.Driver = Psql_Driver.Get_Driver_Index then
            Assert_Equals (T, "select 3", SQL, "Invalid query for 'index'");
         else
            Assert_Equals (T, "select 0", SQL, "Invalid query for 'index'");
         end if;
      end;

      if Mysql_Driver /= null and then Manager.Driver = Mysql_Driver.Get_Driver_Index then
         declare
            SQL : constant String := ADO.Queries.Get_SQL (Index_Query.Query'Access,
                                                          Manager,
                                                          False);
         begin
            Assert_Equals (T, "select 1", SQL, "Invalid query for 'index' (MySQL driver)");
         end;
      end if;
      if Sqlite_Driver /= null and then Manager.Driver = Sqlite_Driver.Get_Driver_Index then
         declare
            SQL : constant String := ADO.Queries.Get_SQL (Index_Query.Query'Access,
                                                          Manager, False);
         begin
            Assert_Equals (T, "select 0", SQL, "Invalid query for 'index' (SQLite driver)");
         end;
      end if;
      if Psql_Driver /= null and then Manager.Driver = Psql_Driver.Get_Driver_Index
      then
         declare
            SQL : constant String := ADO.Queries.Get_SQL (Index_Query.Query'Access,
                                                          Manager,
                                                          False);
         begin
            Assert_Equals (T, "select 3", SQL, "Invalid query for 'index' (PostgreSQL driver)");
         end;
      end if;
   end Test_Load_Queries;

   --  ------------------------------
   --  Test re-loading queries.
   --  ------------------------------
   procedure Test_Reload_Queries (T : in out Test) is
      Config  : ADO.Connections.Configuration;
      Manager : Query_Manager;
      Query   : ADO.Queries.Context;
      Config_URL : constant String := Util.Tests.Get_Parameter ("test.database",
                                                                "sqlite:///regtests.db");
   begin
      --  Configure the XML query loader.
      Config.Set_Connection (Config_URL);
      ADO.Queries.Loaders.Initialize (Manager, Config);
      for I in 1 .. 10 loop
         Query.Set_Query ("simple-query");

         declare
            SQL : constant String := Query.Get_SQL (Manager);
         begin
            Assert_Equals (T, "select count(*) from user", SQL,
                           "Invalid query for 'simple-query'");
         end;
         for J in Manager.Files'Range loop
            Manager.Files (J).Next_Check := Init_Time;
         end loop;
      end loop;
   end Test_Reload_Queries;

   --  ------------------------------
   --  Test the Initialize operation called several times
   --  ------------------------------
   procedure Test_Initialize (T : in out Test) is
      Config  : ADO.Connections.Configuration;
      Manager : Query_Manager;
      Pos     : Query_Index;
      Config_URL : constant String := Util.Tests.Get_Parameter ("test.database",
                                                                "sqlite:///regtests.db");
   begin
      Config.Set_Connection (Config_URL);

      --  Configure and load the XML queries.
      for Pass in 1 .. 10 loop
         Config.Set_Property ("ado.queries.load", (if Pass = 1 then "false" else "true"));
         ADO.Queries.Loaders.Initialize (Manager, Config);
         T.Assert (Manager.Queries /= null, "The queries table is allocated");
         T.Assert (Manager.Files /= null, "The files table is allocated");
         Pos := 1;
         for Query of Manager.Queries.all loop
            if Pass = 1 then
               T.Assert (Query.Is_Null, "Query must not be loaded");
            elsif Missing_Query.Query.Query /= Pos
              and Internal_Query.Query.Query /= Pos
            then
               T.Assert (not Query.Is_Null, "Query must have been loaded");
            else
               T.Assert (Query.Is_Null, "Query must not be loaded (not found)");
            end if;
            Pos := Pos + 1;
         end loop;
      end loop;

   end Test_Initialize;

   --  ------------------------------
   --  Test the Set_Query operation.
   --  ------------------------------
   procedure Test_Set_Query (T : in out Test) is
      Query   : ADO.Queries.Context;
      Manager : Query_Manager;
      Config  : ADO.Connections.Configuration;
      Config_URL : constant String := Util.Tests.Get_Parameter ("test.database",
                                                                "sqlite:///regtests.db");
   begin
      Config.Set_Connection (Config_URL);
      ADO.Queries.Loaders.Initialize (Manager, Config);
      Query.Set_Query ("simple-query");

      declare
         SQL : constant String := Query.Get_SQL (Manager);
      begin
         Assert_Equals (T, "select count(*) from user", SQL, "Invalid query for 'simple-query'");
      end;
   end Test_Set_Query;

   --  ------------------------------
   --  Test the Set_Limit operation.
   --  ------------------------------
   procedure Test_Set_Limit (T : in out Test) is
      Query : ADO.Queries.Context;
   begin
      Query.Set_Query ("index");
      Query.Set_Limit (0, 10);
      Assert_Equals (T, 0, Query.Get_First_Row_Index, "Invalid first row index");
      Assert_Equals (T, 10, Query.Get_Last_Row_Index, "Invalid last row index");
   end Test_Set_Limit;

   --  ------------------------------
   --  Test the Find_Query operation.
   --  ------------------------------
   procedure Test_Find_Query (T : in out Test) is
      Q : Query_Definition_Access;
   begin
      Q := ADO.Queries.Loaders.Find_Query ("this query does not exist");
      T.Assert (Q = null, "Find_Query should return null for unkown query");
   end Test_Find_Query;

   --  ------------------------------
   --  Test the missing query.
   --  ------------------------------
   procedure Test_Missing_Query (T : in out Test) is
      Query   : ADO.Queries.Context;
      Manager : Query_Manager;
      Config  : ADO.Connections.Configuration;
      Count   : Natural := 0;
      Config_URL : constant String := Util.Tests.Get_Parameter ("test.database",
                                                                "sqlite:///regtests.db");
   begin
      Config.Set_Connection (Config_URL);
      ADO.Queries.Loaders.Initialize (Manager, Config);
      Query.Set_Query ("missing-query");

      begin
         Assert_Equals (T, "?", Query.Get_SQL (Manager));
         T.Fail ("No ADO.Queries.Query_Error exception was raised");

      exception
         when ADO.Queries.Query_Error =>
            null;
      end;

      begin
         Query.Set_Query ("missing-query-sqlite");
         Assert_Equals (T, "select count(*) from user", Query.Get_SQL (Manager));

      exception
         when ADO.Queries.Query_Error =>
            Count := Count + 1;
      end;

      begin
         Query.Set_Query ("missing-query-mysql");
         Assert_Equals (T, "select count(*) from user", Query.Get_SQL (Manager));

      exception
         when ADO.Queries.Query_Error =>
            Count := Count + 1;
      end;

      begin
         Query.Set_Query ("missing-query-postgresql");
         Assert_Equals (T, "select count(*) from user", Query.Get_SQL (Manager));

      exception
         when ADO.Queries.Query_Error =>
            Count := Count + 1;
      end;
      T.Assert (Count > 0, "No Query_Error exception was raised");
   end Test_Missing_Query;

   Q1 : aliased constant String := "<query-mapping><query name='internal-query'>"
     & "<sql>SELECT 'internal-query'</sql></query></query-mapping>";

   function Loader (Name : in String) return access constant String is
   begin
      if Name = "regtests/files/internal-query.xml" then
         return Q1'Access;
      end if;

      return null;
   end Loader;

   --  ------------------------------
   --  Test the static query loader.
   --  ------------------------------
   procedure Test_Query_Loader (T : in out Test) is
      Query   : ADO.Queries.Context;
      Manager : Query_Manager;
      Config  : ADO.Connections.Configuration;
      Config_URL : constant String := Util.Tests.Get_Parameter ("test.database",
                                                                "sqlite:///regtests.db");
   begin
      Config.Set_Connection (Config_URL);
      Manager.Set_Query_Loader (Loader'Access);
      ADO.Queries.Loaders.Initialize (Manager, Config);
      Query.Set_Query ("internal-query");

      Assert_Equals (T, "SELECT 'internal-query'", Query.Get_SQL (Manager));

   end Test_Query_Loader;

end ADO.Queries.Tests;

Update unit test to use a Ada.Calendar.Time


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

   --  ------------------------------
   --  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.all, 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
      use type Bfd.Vma_Type;

      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
      use Ada.Strings.Unbounded;

      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.all,
                                  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 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.all, 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.all,
                                  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;

Fix compilation warning with GNAT 2018

Fix compilation warning with GNAT 2018


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

with nRF51.Device;
with nRF51.TWI;

package body MicroBit.I2C is

   Init_Done : Boolean := False;

   -----------------
   -- Initialized --
   -----------------

   function Initialized return Boolean
   is (Init_Done);

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize (S : Speed := S400kbps) is
   begin
      nRF51.Device.TWI_0.Configure
        (SCL   => MB_SCL.Pin,
         SDA   => MB_SDA.Pin,
         Speed => (case S is
                      when S100kbps => nRF51.TWI.TWI_100kbps,
                      when S250kbps => nRF51.TWI.TWI_250kbps,
                      when S400kbps => nRF51.TWI.TWI_400kbps)
        );

      nRF51.Device.TWI_0.Enable;
      Init_Done := True;
   end Initialize;

   ----------------
   -- Controller --
   ----------------

   function Controller return not null Any_I2C_Port
   is (nRF51.Device.TWI_0'Access);

end MicroBit.I2C;

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

with nRF51.Device;
with nRF51.TWI;

package body MicroBit.I2C is

   Init_Done : Boolean := False;

   Device : nRF51.TWI.TWI_Master renames nRF51.Device.TWI_0;
   --  This device should not conflict with the device used in MicroBit.SPI.
   --  See nRF51 Series Reference Manual, chapter Memory.Instantiation.

   -----------------
   -- Initialized --
   -----------------

   function Initialized return Boolean
   is (Init_Done);

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize (S : Speed := S400kbps) is
   begin
      Device.Configure
        (SCL   => MB_SCL.Pin,
         SDA   => MB_SDA.Pin,
         Speed => (case S is
                      when S100kbps => nRF51.TWI.TWI_100kbps,
                      when S250kbps => nRF51.TWI.TWI_250kbps,
                      when S400kbps => nRF51.TWI.TWI_400kbps)
        );

      Device.Enable;
      Init_Done := True;
   end Initialize;

   ----------------
   -- Controller --
   ----------------

   function Controller return not null Any_I2C_Port
   is (Device'Access);

end MicroBit.I2C;

clean up device definition

MicroBit.I2C: clean up device definition