-----------------------------------------------------------------------
--  util-streams-texts -- Text stream utilities
--  Copyright (C) 2010, 2011, 2012, 2015, 2016, 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 Ada.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;
with Util.Streams.Buffered;
with Ada.Calendar;
with GNAT.Calendar.Time_IO;
package Util.Streams.Texts is

   --  -----------------------
   --  Print stream
   --  -----------------------
   --  The Print_Stream is an output stream which provides helper methods
   --  for writing text streams.
   type Print_Stream is new Buffered.Output_Buffer_Stream with private;
   type Print_Stream_Access is access all Print_Stream'Class;

   procedure Initialize (Stream : in out Print_Stream;
                         To     : in Output_Stream_Access);

   --  Write a raw character on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Char   : in Character);

   --  Write a wide character on the stream doing some conversion if necessary.
   --  The default implementation translates the wide character to a UTF-8 sequence.
   procedure Write_Wide (Stream : in out Print_Stream;
                         Item   : in Wide_Wide_Character);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in String);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

   --  Write an integer on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Integer);

   --  Write an integer on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Long_Long_Integer);

   --  Write a date on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Calendar.Time;
                    Format : in GNAT.Calendar.Time_IO.Picture_String
                    := GNAT.Calendar.Time_IO.ISO_Date);

   --  Get the output stream content as a string.
   function To_String (Stream : in Buffered.Output_Buffer_Stream'Class) return String;

   --  Write a character on the stream.
   procedure Write_Char (Stream : in out Print_Stream'Class;
                         Item   : in Character);

   --  Write a character on the stream.
   procedure Write_Char (Stream : in out Print_Stream'Class;
                         Item   : in Wide_Wide_Character);

   --  -----------------------
   --  Reader stream
   --  -----------------------
   --  The Reader_Stream is an input stream which provides helper methods
   --  for reading text streams.
   type Reader_Stream is new Buffered.Input_Buffer_Stream with private;
   type Reader_Stream_Access is access all Reader_Stream'Class;

   --  Initialize the reader to read the input from the input stream given in From.
   procedure Initialize (Stream : in out Reader_Stream;
                         From   : in Input_Stream_Access);

   --  Read an input line from the input stream.  The line is terminated by ASCII.LF.
   --  When Strip is set, the line terminators (ASCII.CR, ASCII.LF) are removed.
   procedure Read_Line (Stream : in out Reader_Stream;
                        Into   : out Ada.Strings.Unbounded.Unbounded_String;
                        Strip  : in Boolean := False);

private

   type Print_Stream is new Buffered.Output_Buffer_Stream with null record;

   type Reader_Stream is new Buffered.Input_Buffer_Stream with null record;

end Util.Streams.Texts;

-----------------------------------------------------------------------
--  util-streams-texts -- Text stream utilities
--  Copyright (C) 2010, 2011, 2012, 2015, 2016, 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 Ada.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;
with Util.Streams.Buffered;
with Ada.Calendar;
with GNAT.Calendar.Time_IO;

--  === Texts ===
--  The <tt>Util.Streams.Texts</tt> package implements text oriented input and output streams.
--  The <tt>Print_Stream</tt> type extends the <tt>Output_Buffer_Stream</tt> to allow writing
--  text content.
--
--  The <tt>Reader_Stream</tt> package extends the <tt>Input_Buffer_Stream</tt> and allows to
--  read text content.
package Util.Streams.Texts is

   --  -----------------------
   --  Print stream
   --  -----------------------
   --  The Print_Stream is an output stream which provides helper methods
   --  for writing text streams.
   type Print_Stream is new Buffered.Output_Buffer_Stream with private;
   type Print_Stream_Access is access all Print_Stream'Class;

   procedure Initialize (Stream : in out Print_Stream;
                         To     : in Output_Stream_Access);

   --  Write a raw character on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Char   : in Character);

   --  Write a wide character on the stream doing some conversion if necessary.
   --  The default implementation translates the wide character to a UTF-8 sequence.
   procedure Write_Wide (Stream : in out Print_Stream;
                         Item   : in Wide_Wide_Character);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in String);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);

   --  Write an integer on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Integer);

   --  Write an integer on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Long_Long_Integer);

   --  Write a date on the stream.
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Ada.Calendar.Time;
                    Format : in GNAT.Calendar.Time_IO.Picture_String
                    := GNAT.Calendar.Time_IO.ISO_Date);

   --  Get the output stream content as a string.
   function To_String (Stream : in Buffered.Output_Buffer_Stream'Class) return String;

   --  Write a character on the stream.
   procedure Write_Char (Stream : in out Print_Stream'Class;
                         Item   : in Character);

   --  Write a character on the stream.
   procedure Write_Char (Stream : in out Print_Stream'Class;
                         Item   : in Wide_Wide_Character);

   --  -----------------------
   --  Reader stream
   --  -----------------------
   --  The Reader_Stream is an input stream which provides helper methods
   --  for reading text streams.
   type Reader_Stream is new Buffered.Input_Buffer_Stream with private;
   type Reader_Stream_Access is access all Reader_Stream'Class;

   --  Initialize the reader to read the input from the input stream given in From.
   procedure Initialize (Stream : in out Reader_Stream;
                         From   : in Input_Stream_Access);

   --  Read an input line from the input stream.  The line is terminated by ASCII.LF.
   --  When Strip is set, the line terminators (ASCII.CR, ASCII.LF) are removed.
   procedure Read_Line (Stream : in out Reader_Stream;
                        Into   : out Ada.Strings.Unbounded.Unbounded_String;
                        Strip  : in Boolean := False);

private

   type Print_Stream is new Buffered.Output_Buffer_Stream with null record;

   type Reader_Stream is new Buffered.Input_Buffer_Stream with null record;

end Util.Streams.Texts;

Document the streams framework

Document the streams framework


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

with Ada.Directories;
with Ada.Strings.Unbounded;

with Gen.Artifacts.XMI.Tests;
with Gen.Integration.Tests;
package body Gen.Testsuite is

   Tests : aliased Util.Tests.Test_Suite;

   Dir   : Ada.Strings.Unbounded.Unbounded_String;

   function Suite return Util.Tests.Access_Test_Suite is
      Result : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      Gen.Artifacts.XMI.Tests.Add_Tests (Result);
      Gen.Integration.Tests.Add_Tests (Result);
      return Result;
   end Suite;

   --  ------------------------------
   --  Get the test root directory.
   --  ------------------------------
   function Get_Test_Directory return String is
   begin
      return Ada.Strings.Unbounded.To_String (Dir);
   end Get_Test_Directory;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Dir := Ada.Strings.Unbounded.To_Unbounded_String (Ada.Directories.Current_Directory);
   end Initialize;

end Gen.Testsuite;

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

with Ada.Directories;
with Ada.Strings.Unbounded;

with Gen.Artifacts.XMI.Tests;
with Gen.Integration.Tests;
package body Gen.Testsuite is

   Tests : aliased Util.Tests.Test_Suite;

   Dir   : Ada.Strings.Unbounded.Unbounded_String;

   function Suite return Util.Tests.Access_Test_Suite is
      Result : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      Gen.Artifacts.XMI.Tests.Add_Tests (Result);
      Gen.Integration.Tests.Add_Tests (Result);
      return Result;
   end Suite;

   --  ------------------------------
   --  Get the test root directory.
   --  ------------------------------
   function Get_Test_Directory return String is
   begin
      return Ada.Strings.Unbounded.To_String (Dir);
   end Get_Test_Directory;

   procedure Initialize (Props : in Util.Properties.Manager) is
      pragma Unreferenced (Props);
   begin
      Dir := Ada.Strings.Unbounded.To_Unbounded_String (Ada.Directories.Current_Directory);
   end Initialize;

end Gen.Testsuite;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  gen-artifacts-docs-markdown -- Artifact for GitHub Markdown documentation format
--  Copyright (C) 2015, 2017, 2018, 2019 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Util.Strings;
with Util.Log.Loggers;
package body Gen.Artifacts.Docs.Markdown is

   use type Ada.Strings.Maps.Character_Set;

   function Has_Scheme (Link : in String) return Boolean;
   function Is_Image (Link : in String) return Boolean;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Artifacts.Docs.Mark");

   Marker : constant Ada.Strings.Maps.Character_Set
     := Ada.Strings.Maps.To_Set (" .,;:!?)")
     or Ada.Strings.Maps.To_Set (ASCII.HT)
     or Ada.Strings.Maps.To_Set (ASCII.VT)
     or Ada.Strings.Maps.To_Set (ASCII.CR)
     or Ada.Strings.Maps.To_Set (ASCII.LF);

   --  ------------------------------
   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   --  ------------------------------
   overriding
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is
      pragma Unreferenced (Formatter);
   begin
      return Ada.Strings.Unbounded.To_String (Document.Name) & ".md";
   end Get_Document_Name;

   --  ------------------------------
   --  Start a new document.
   --  ------------------------------
   overriding
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type) is
      pragma Unreferenced (Formatter);
   begin
      if Document.Print_Footer then
         Ada.Text_IO.Put_Line (File, "# " & Ada.Strings.Unbounded.To_String (Document.Title));
         Ada.Text_IO.New_Line (File);
      end if;
   end Start_Document;

   --  ------------------------------
   --  Return True if the link has either a http:// or a https:// scheme.
   --  ------------------------------
   function Has_Scheme (Link : in String) return Boolean is
   begin
      if Link'Length < 8 then
         return False;
      elsif Link (Link'First .. Link'First + 6) = "http://" then
         return True;
      elsif Link (Link'First .. Link'First + 7) = "https://" then
         return True;
      else
         return False;
      end if;
   end Has_Scheme;

   function Is_Image (Link : in String) return Boolean is
   begin
      if Link'Length < 4 then
         return False;
      elsif Link (Link'Last - 3 .. Link'Last) = ".png" then
         return True;
      elsif Link (Link'Last - 3 .. Link'Last) = ".jpg" then
         return True;
      elsif Link (Link'Last - 3 .. Link'Last) = ".gif" then
         return True;
      else
         Log.Info ("Link {0} not an image", Link);
         return False;
      end if;
   end Is_Image;

   procedure Write_Text_Auto_Links (Formatter : in out Document_Formatter;
                                    File      : in Ada.Text_IO.File_Type;
                                    Text      : in String) is
      Start : Natural := Text'First;
      Last  : Natural := Text'Last;
      Link  : Util.Strings.Maps.Cursor;
      Pos   : Natural;
   begin
      Log.Debug ("Auto link |{0}|", Text);
      loop
         --  Emit spaces at beginning of line or words.
         while Start <= Text'Last and then Ada.Strings.Maps.Is_In (Text (Start), Marker) loop
            Ada.Text_IO.Put (File, Text (Start));
            Start := Start + 1;
         end loop;
         exit when Start > Text'Last;

         --  Find a possible link.
         Link := Formatter.Links.Find (Text (Start .. Last));
         if Util.Strings.Maps.Has_Element (Link) then
            Ada.Text_IO.Put (File, "[");
            Ada.Text_IO.Put (File, Text (Start .. Last));
            Ada.Text_IO.Put (File, "](");
            Ada.Text_IO.Put (File, Util.Strings.Maps.Element (Link));
            Ada.Text_IO.Put (File, ")");
            Start := Last + 1;
            Last := Text'Last;
         else
            Pos := Ada.Strings.Fixed.Index (Text (Start .. Last), Marker,
                                            Going => Ada.Strings.Backward);
            if Pos = 0 then
               Ada.Text_IO.Put (File, Text (Start .. Last));
               Start := Last + 1;
               Last := Text'Last;
            else
               Last := Pos - 1;

               --  Skip spaces at end of words for the search.
               while Last > Start and then Ada.Strings.Maps.Is_In (Text (Last), Marker) loop
                  Last := Last - 1;
               end loop;
            end if;
         end if;
      end loop;
   end Write_Text_Auto_Links;

   --  ------------------------------
   --  Write a line doing some link transformation for Markdown.
   --  ------------------------------
   procedure Write_Text (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Text      : in String) is
      Pos      : Natural;
      Start    : Natural := Text'First;
      End_Pos  : Natural;
      Last_Pos : Natural;
   begin
      --  Transform links
      --  [Link]   -> [[Link]]
      --  [Link Title] -> [[Title|Link]]
      --
      --  Do not change the following links:
      --  [[Link|Title]]
      loop
         Pos := Util.Strings.Index (Text, '[', Start);
         if Pos = 0 or else Pos = Text'Last then
            Formatter.Write_Text_Auto_Links (File, Text (Start .. Text'Last));
            return;
         end if;
         Formatter.Write_Text_Auto_Links (File, Text (Start .. Pos - 1));

         if Pos - 1 >= Text'First and then (Text (Pos - 1) = '\' or Text (Pos - 1) = '`') then
            Ada.Text_IO.Put (File, "[");
            Start := Pos + 1;

         --  Parse a markdown link format.
         elsif Text (Pos + 1) = '[' then
            Start := Pos + 2;
            Pos := Util.Strings.Index (Text, ']', Pos + 2);
            if Pos = 0 then
               if Is_Image (Text (Start .. Text'Last)) then
                  Ada.Text_IO.Put (File, Text (Start - 2 .. Text'Last));
               else
                  Ada.Text_IO.Put (File, Text (Start - 2 .. Text'Last));
               end if;
               return;
            end if;
            if Is_Image (Text (Start .. Pos - 1)) then
               Ada.Text_IO.Put (File, "![](");
               Ada.Text_IO.Put (File, Text (Start .. Pos - 1));
               Ada.Text_IO.Put (File, ")");
               Start := Pos + 2;
            else
               Ada.Text_IO.Put (File, Text (Start .. Pos));
               Start := Pos + 1;
            end if;
         else
            Pos := Pos + 1;
            End_Pos := Pos;
            while End_Pos < Text'Last and Text (End_Pos) /= ' ' and Text (End_Pos) /= ']' loop
               End_Pos := End_Pos + 1;
            end loop;
            Last_Pos := End_Pos;
            while Last_Pos < Text'Last and Text (Last_Pos) /= ']' loop
               Last_Pos := Last_Pos + 1;
            end loop;
            if Is_Image (Text (Pos .. Last_Pos - 1)) then
               Ada.Text_IO.Put (File, "![");
               --  Ada.Text_IO.Put (File, Text (Pos .. End_Pos));
               Ada.Text_IO.Put (File, "](");
               Ada.Text_IO.Put (File, Text (Pos .. Last_Pos - 1));
               Ada.Text_IO.Put (File, ")");
            elsif Is_Image (Text (Pos .. End_Pos)) then
               Last_Pos := Last_Pos - 1;
               Ada.Text_IO.Put (File, "![");
               Ada.Text_IO.Put (File, Text (Pos .. End_Pos));
               Ada.Text_IO.Put (File, "](");
               Ada.Text_IO.Put (File, Text (Pos .. End_Pos));
               Ada.Text_IO.Put (File, ")");
            elsif Has_Scheme (Text (Pos .. End_Pos)) then
               Ada.Text_IO.Put (File, "[");
               Ada.Text_IO.Put (File, Text (End_Pos + 1 .. Last_Pos));
               Ada.Text_IO.Put (File, "(");
               Ada.Text_IO.Put (File,
                                Ada.Strings.Fixed.Trim (Text (Pos .. End_Pos), Ada.Strings.Both));
               Ada.Text_IO.Put (File, ")");
            else
               Last_Pos := Last_Pos - 1;
               Ada.Text_IO.Put (File, "[[");
               Ada.Text_IO.Put (File, Text (End_Pos + 1 .. Last_Pos));
               Ada.Text_IO.Put (File, "|");
               Ada.Text_IO.Put (File, Text (Pos .. End_Pos));
               Ada.Text_IO.Put (File, "]");
            end if;
            Start := Last_Pos + 1;
         end if;
      end loop;
   end Write_Text;

   --  ------------------------------
   --  Write a line in the document.
   --  ------------------------------
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in String) is
   begin
      if Formatter.Need_Newline then
         Ada.Text_IO.New_Line (File);
         Formatter.Need_Newline := False;
      end if;
      if Formatter.Mode = L_START_CODE and then Line'Length > 2
        and then Line (Line'First .. Line'First + 1) = "  "
      then
         Ada.Text_IO.Put_Line (File, Line (Line'First + 2 .. Line'Last));
      elsif Formatter.Mode = L_TEXT then
         Formatter.Write_Text (File, Line);
         Ada.Text_IO.New_Line (File);
      else
         Ada.Text_IO.Put_Line (File, Line);
      end if;
   end Write_Line;

   --  ------------------------------
   --  Write a line in the target document formatting the line if necessary.
   --  ------------------------------
   overriding
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type) is
   begin
      case Line.Kind is
         when L_LIST =>
            Ada.Text_IO.New_Line (File);
            Ada.Text_IO.Put (File, Line.Content);
            Formatter.Need_Newline := True;
            Formatter.Mode := Line.Kind;

         when L_LIST_ITEM =>
            Ada.Text_IO.Put (File, Line.Content);
            Formatter.Need_Newline := True;

         when L_START_CODE =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "```Ada");

         when L_END_CODE =>
            Formatter.Mode := L_TEXT;
            Formatter.Write_Line (File, "```");

         when L_TEXT =>
            if Formatter.Mode /= L_START_CODE then
               Formatter.Mode := L_TEXT;
            end if;
            Formatter.Write_Line (File, Line.Content);

         when L_HEADER_1 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "# " & Line.Content);
            Formatter.Mode := L_TEXT;

         when L_HEADER_2 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "## " & Line.Content);
            Formatter.Mode := L_TEXT;

         when L_HEADER_3 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "### " & Line.Content);
            Formatter.Mode := L_TEXT;

         when L_HEADER_4 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "#### " & Line.Content);
            Formatter.Mode := L_TEXT;

         when others =>
            null;

      end case;
   end Write_Line;

   --  ------------------------------
   --  Finish the document.
   --  ------------------------------
   overriding
   procedure Finish_Document (Formatter : in out Document_Formatter;
                              Document  : in File_Document;
                              File      : in Ada.Text_IO.File_Type;
                              Source    : in String) is
      pragma Unreferenced (Formatter);
   begin
      Ada.Text_IO.New_Line (File);
      if Document.Print_Footer then
         Ada.Text_IO.Put_Line (File, "----");
         Ada.Text_IO.Put_Line (File,
                               "[Generated by Dynamo](https://github.com/stcarrez/dynamo) from *"
                               & Source & "*");
      end if;
   end Finish_Document;

end Gen.Artifacts.Docs.Markdown;

-----------------------------------------------------------------------
--  gen-artifacts-docs-markdown -- Artifact for GitHub Markdown documentation format
--  Copyright (C) 2015, 2017, 2018, 2019, 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 Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Util.Strings;
with Util.Log.Loggers;
package body Gen.Artifacts.Docs.Markdown is

   use type Ada.Strings.Maps.Character_Set;

   function Has_Scheme (Link : in String) return Boolean;
   function Is_Image (Link : in String) return Boolean;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Artifacts.Docs.Mark");

   Marker : constant Ada.Strings.Maps.Character_Set
     := Ada.Strings.Maps.To_Set (" .,;:!?)")
     or Ada.Strings.Maps.To_Set (ASCII.HT)
     or Ada.Strings.Maps.To_Set (ASCII.VT)
     or Ada.Strings.Maps.To_Set (ASCII.CR)
     or Ada.Strings.Maps.To_Set (ASCII.LF);

   --  ------------------------------
   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   --  ------------------------------
   overriding
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is
      pragma Unreferenced (Formatter);
   begin
      return Ada.Strings.Unbounded.To_String (Document.Name) & ".md";
   end Get_Document_Name;

   --  ------------------------------
   --  Start a new document.
   --  ------------------------------
   overriding
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type) is
      pragma Unreferenced (Formatter);
   begin
      if Document.Print_Footer then
         Ada.Text_IO.Put_Line (File, "# " & Ada.Strings.Unbounded.To_String (Document.Title));
         Ada.Text_IO.New_Line (File);
      end if;
   end Start_Document;

   --  ------------------------------
   --  Return True if the link has either a http:// or a https:// scheme.
   --  ------------------------------
   function Has_Scheme (Link : in String) return Boolean is
   begin
      if Link'Length < 8 then
         return False;
      elsif Link (Link'First .. Link'First + 6) = "http://" then
         return True;
      elsif Link (Link'First .. Link'First + 7) = "https://" then
         return True;
      else
         return False;
      end if;
   end Has_Scheme;

   function Is_Image (Link : in String) return Boolean is
   begin
      if Link'Length < 4 then
         return False;
      elsif Link (Link'Last - 3 .. Link'Last) = ".png" then
         return True;
      elsif Link (Link'Last - 3 .. Link'Last) = ".jpg" then
         return True;
      elsif Link (Link'Last - 3 .. Link'Last) = ".gif" then
         return True;
      else
         Log.Info ("Link {0} not an image", Link);
         return False;
      end if;
   end Is_Image;

   procedure Write_Text_Auto_Links (Formatter : in out Document_Formatter;
                                    File      : in Ada.Text_IO.File_Type;
                                    Text      : in String) is
      Start : Natural := Text'First;
      Last  : Natural := Text'Last;
      Link  : Util.Strings.Maps.Cursor;
      Pos   : Natural;
   begin
      Log.Debug ("Auto link |{0}|", Text);
      loop
         --  Emit spaces at beginning of line or words.
         while Start <= Text'Last and then Ada.Strings.Maps.Is_In (Text (Start), Marker) loop
            Ada.Text_IO.Put (File, Text (Start));
            Start := Start + 1;
         end loop;
         exit when Start > Text'Last;

         --  Find a possible link.
         Link := Formatter.Links.Find (Text (Start .. Last));
         if Util.Strings.Maps.Has_Element (Link) then
            Ada.Text_IO.Put (File, "[");
            Ada.Text_IO.Put (File, Text (Start .. Last));
            Ada.Text_IO.Put (File, "](");
            Ada.Text_IO.Put (File, Util.Strings.Maps.Element (Link));
            Ada.Text_IO.Put (File, ")");
            Start := Last + 1;
            Last := Text'Last;
         else
            Pos := Ada.Strings.Fixed.Index (Text (Start .. Last), Marker,
                                            Going => Ada.Strings.Backward);
            if Pos = 0 then
               Ada.Text_IO.Put (File, Text (Start .. Last));
               Start := Last + 1;
               Last := Text'Last;
            else
               Last := Pos - 1;

               --  Skip spaces at end of words for the search.
               while Last > Start and then Ada.Strings.Maps.Is_In (Text (Last), Marker) loop
                  Last := Last - 1;
               end loop;
            end if;
         end if;
      end loop;
   end Write_Text_Auto_Links;

   --  ------------------------------
   --  Write a line doing some link transformation for Markdown.
   --  ------------------------------
   procedure Write_Text (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Text      : in String) is
      Pos      : Natural;
      Start    : Natural := Text'First;
      End_Pos  : Natural;
      Last_Pos : Natural;
      Link     : Util.Strings.Maps.Cursor;
   begin
      --  Transform links
      --  [Link]   -> [[Link]]
      --  [Link Title] -> [[Title|Link]]
      --
      --  Do not change the following links:
      --  [[Link|Title]]
      loop
         Pos := Util.Strings.Index (Text, '[', Start);
         if Pos = 0 or else Pos = Text'Last then
            Formatter.Write_Text_Auto_Links (File, Text (Start .. Text'Last));
            return;
         end if;
         Formatter.Write_Text_Auto_Links (File, Text (Start .. Pos - 1));

         if Pos - 1 >= Text'First and then (Text (Pos - 1) = '\' or Text (Pos - 1) = '`') then
            Ada.Text_IO.Put (File, "[");
            Start := Pos + 1;

         --  Parse a markdown link format.
         elsif Text (Pos + 1) = '[' then
            Start := Pos + 2;
            Pos := Util.Strings.Index (Text, ']', Pos + 2);
            if Pos = 0 then
               if Is_Image (Text (Start .. Text'Last)) then
                  Ada.Text_IO.Put (File, Text (Start - 2 .. Text'Last));
               else
                  Ada.Text_IO.Put (File, Text (Start - 2 .. Text'Last));
               end if;
               return;
            end if;
            if Is_Image (Text (Start .. Pos - 1)) then
               Ada.Text_IO.Put (File, "![](");
               Ada.Text_IO.Put (File, Text (Start .. Pos - 1));
               Ada.Text_IO.Put (File, ")");
               Start := Pos + 2;
            else
               Ada.Text_IO.Put (File, Text (Start .. Pos));
               Start := Pos + 1;
            end if;
         else
            Pos := Pos + 1;
            End_Pos := Pos;
            while End_Pos < Text'Last and Text (End_Pos) /= ' ' and Text (End_Pos) /= ']' loop
               End_Pos := End_Pos + 1;
            end loop;
            Last_Pos := End_Pos;
            while Last_Pos < Text'Last and Text (Last_Pos) /= ']' loop
               Last_Pos := Last_Pos + 1;
            end loop;
            if Is_Image (Text (Pos .. Last_Pos - 1)) then
               Ada.Text_IO.Put (File, "![");
               --  Ada.Text_IO.Put (File, Text (Pos .. End_Pos));
               Ada.Text_IO.Put (File, "](");
               Ada.Text_IO.Put (File, Text (Pos .. Last_Pos - 1));
               Ada.Text_IO.Put (File, ")");
            elsif Is_Image (Text (Pos .. End_Pos)) then
               Last_Pos := Last_Pos - 1;
               Ada.Text_IO.Put (File, "![");
               Ada.Text_IO.Put (File, Text (Pos .. End_Pos));
               Ada.Text_IO.Put (File, "](");
               Ada.Text_IO.Put (File, Text (Pos .. End_Pos));
               Ada.Text_IO.Put (File, ")");
            elsif Has_Scheme (Text (Pos .. End_Pos)) then
               Ada.Text_IO.Put (File, "[");
               Ada.Text_IO.Put (File, Text (End_Pos + 1 .. Last_Pos));
               Ada.Text_IO.Put (File, "(");
               Ada.Text_IO.Put (File,
                                Ada.Strings.Fixed.Trim (Text (Pos .. End_Pos), Ada.Strings.Both));
               Ada.Text_IO.Put (File, ")");
            else
               Last_Pos := Last_Pos - 1;
               Link := Formatter.Links.Find (Text (Pos .. Last_Pos));
               if Util.Strings.Maps.Has_Element (Link) then
                  Ada.Text_IO.Put (File, "[");
                  Ada.Text_IO.Put (File, Util.Strings.Maps.Element (Link));
                  Ada.Text_IO.Put (File, "]");
               else
                  Ada.Text_IO.Put (File, "[");
                  Ada.Text_IO.Put (File, Text (Pos .. Last_Pos));
               end if;
            end if;
            Start := Last_Pos + 1;
         end if;
      end loop;
   end Write_Text;

   --  ------------------------------
   --  Write a line in the document.
   --  ------------------------------
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in String) is
   begin
      if Formatter.Need_Newline then
         Ada.Text_IO.New_Line (File);
         Formatter.Need_Newline := False;
      end if;
      if Formatter.Mode = L_START_CODE and then Line'Length > 2
        and then Line (Line'First .. Line'First + 1) = "  "
      then
         Ada.Text_IO.Put_Line (File, Line (Line'First + 2 .. Line'Last));
      elsif Formatter.Mode = L_TEXT then
         Formatter.Write_Text (File, Line);
         Ada.Text_IO.New_Line (File);
      else
         Ada.Text_IO.Put_Line (File, Line);
      end if;
   end Write_Line;

   --  ------------------------------
   --  Write a line in the target document formatting the line if necessary.
   --  ------------------------------
   overriding
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type) is
   begin
      case Line.Kind is
         when L_LIST =>
            Ada.Text_IO.New_Line (File);
            Ada.Text_IO.Put (File, Line.Content);
            Formatter.Need_Newline := True;
            Formatter.Mode := Line.Kind;

         when L_LIST_ITEM =>
            Ada.Text_IO.Put (File, Line.Content);
            Formatter.Need_Newline := True;

         when L_START_CODE =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "```Ada");

         when L_END_CODE =>
            Formatter.Mode := L_TEXT;
            Formatter.Write_Line (File, "```");

         when L_TEXT =>
            if Formatter.Mode /= L_START_CODE then
               Formatter.Mode := L_TEXT;
            end if;
            Formatter.Write_Line (File, Line.Content);

         when L_HEADER_1 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "# " & Line.Content);
            Formatter.Mode := L_TEXT;

         when L_HEADER_2 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "## " & Line.Content);
            Formatter.Mode := L_TEXT;

         when L_HEADER_3 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "### " & Line.Content);
            Formatter.Mode := L_TEXT;

         when L_HEADER_4 =>
            Formatter.Mode := Line.Kind;
            Formatter.Write_Line (File, "#### " & Line.Content);
            Formatter.Mode := L_TEXT;

         when others =>
            null;

      end case;
   end Write_Line;

   --  ------------------------------
   --  Finish the document.
   --  ------------------------------
   overriding
   procedure Finish_Document (Formatter : in out Document_Formatter;
                              Document  : in File_Document;
                              File      : in Ada.Text_IO.File_Type;
                              Source    : in String) is
      pragma Unreferenced (Formatter);
   begin
      Ada.Text_IO.New_Line (File);
      if Document.Print_Footer then
         Ada.Text_IO.Put_Line (File, "----");
         Ada.Text_IO.Put_Line (File,
                               "[Generated by Dynamo](https://github.com/stcarrez/dynamo) from *"
                               & Source & "*");
      end if;
   end Finish_Document;

end Gen.Artifacts.Docs.Markdown;

Fix generation of markdown links

Fix generation of markdown links


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

with Util.Test_Caller;

with Util.Strings;
with Util.Beans.Basic;
with Util.Beans.Objects.Vectors;
with Util.Beans.Objects.Records;
package body Util.Beans.Objects.Record_Tests is

   use Util.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Beans.Objects.Records",
                       Test_Record'Access);
      Caller.Add_Test (Suite, "Test Util.Beans.Basic",
                       Test_Bean'Access);
   end Add_Tests;

   type Data is record
      Name  : Unbounded_String;
      Value : Util.Beans.Objects.Object;
   end record;

   package Data_Bean is new Util.Beans.Objects.Records (Data);
   use type Data_Bean.Element_Type_Access;
   subtype Data_Access is Data_Bean.Element_Type_Access;

   procedure Test_Record (T : in out Test) is
      D : Data;
   begin
      D.Name  := To_Unbounded_String ("testing");
      D.Value := To_Object (Integer (23));

      declare
         V  : Object := Data_Bean.To_Object (D);
         P  : constant Data_Access := Data_Bean.To_Element_Access (V);
         V2 : constant Object := V;
      begin
         T.Assert (not Is_Empty (V), "Object with data record should not be empty");
         T.Assert (not Is_Null (V), "Object with data record should not be null");
         T.Assert (P /= null, "To_Element_Access returned null");
         Assert_Equals (T, "testing", To_String (P.Name), "Data name is not the same");
         Assert_Equals (T, 23, To_Integer (P.Value), "Data value is not the same");

         V := Data_Bean.Create;

         declare
            D2 : constant Data_Access := Data_Bean.To_Element_Access (V);
         begin
            T.Assert (D2 /= null, "Null element");
            D2.Name  := To_Unbounded_String ("second test");
            D2.Value := V2;
         end;

         V := Data_Bean.To_Object (D);
      end;
   end Test_Record;

   type Bean_Type is new Util.Beans.Basic.Readonly_Bean with record
      Name : Unbounded_String;
   end record;
   type Bean_Type_Access is access all Bean_Type'Class;

   overriding
   function Get_Value (Bean : in Bean_Type;
                       Name : in String) return Util.Beans.Objects.Object;

   overriding
   function Get_Value (Bean : in Bean_Type;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "name" then
         return Util.Beans.Objects.To_Object (Bean.Name);
      elsif Name = "length" then
         return Util.Beans.Objects.To_Object (Length (Bean.Name));
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   procedure Test_Bean (T : in out Test) is
      use Basic;
      Static : aliased Bean_Type;
   begin
      Static.Name := To_Unbounded_String ("Static");

      --  Allocate dynamically several Bean_Type objects and drop the list.
      --  The memory held by internal proxy as well as the Bean_Type must be freed.
      --  The static bean should never be freed!
      for I in 1 .. 10 loop
         declare
            List  : Util.Beans.Objects.Vectors.Vector;
            Value : Util.Beans.Objects.Object;
            Bean  : Bean_Type_Access;
            P     : access Readonly_Bean'Class;
         begin
            for J in 1 .. 1_000 loop
               if I = J then
                  Value := To_Object (Static'Unchecked_Access, Objects.STATIC);
                  List.Append (Value);
               end if;
               Bean := new Bean_Type;
               Bean.Name := To_Unbounded_String ("B" & Util.Strings.Image (J));
               Value := To_Object (Bean);
               List.Append (Value);
            end loop;

            --  Verify each bean of the list
            for J in 1 .. 1_000 + 1 loop
               Value := List.Element (J - 1);

               --  Check some common status.
               T.Assert (not Is_Null (Value), "The value should hold a bean");
               T.Assert (Get_Type (Value) = TYPE_BEAN, "The value should hold a bean");
               T.Assert (not Is_Empty (Value), "The value should not be empty");

               --  Check the bean access.
               P := To_Bean (Value);
               T.Assert (P /= null, "To_Bean returned null");
               Bean := Bean_Type'Class (P.all)'Access;

               --  Check we have the good bean object.
               if I = J then
                  Assert_Equals (T, "Static", To_String (Bean.Name),
                                 "Bean at" & Integer'Image (J) & " is invalid");
               elsif J > I then
                  Assert_Equals (T, "B" & Util.Strings.Image (J - 1), To_String (Bean.Name),
                                 "Bean at" & Integer'Image (J) & " is invalid");
               else
                  Assert_Equals (T, "B" & Util.Strings.Image (J), To_String (Bean.Name),
                                 "Bean at" & Integer'Image (J) & " is invalid");
               end if;
            end loop;
         end;
      end loop;
   end Test_Bean;

end Util.Beans.Objects.Record_Tests;

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

with Util.Test_Caller;

with Util.Strings;
with Util.Beans.Basic;
with Util.Beans.Objects.Vectors;
with Util.Beans.Objects.Records;
package body Util.Beans.Objects.Record_Tests is

   use Util.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Beans.Objects.Records",
                       Test_Record'Access);
      Caller.Add_Test (Suite, "Test Util.Beans.Basic",
                       Test_Bean'Access);
   end Add_Tests;

   type Data is record
      Name  : Unbounded_String;
      Value : Util.Beans.Objects.Object;
   end record;

   package Data_Bean is new Util.Beans.Objects.Records (Data);
   use type Data_Bean.Element_Type_Access;
   subtype Data_Access is Data_Bean.Element_Type_Access;

   procedure Test_Record (T : in out Test) is
      D : Data;
   begin
      D.Name  := To_Unbounded_String ("testing");
      D.Value := To_Object (Integer (23));

      declare
         V  : Object := Data_Bean.To_Object (D);
         P  : constant Data_Access := Data_Bean.To_Element_Access (V);
         V2 : constant Object := V;
      begin
         T.Assert (not Is_Empty (V), "Object with data record should not be empty");
         T.Assert (not Is_Null (V), "Object with data record should not be null");
         T.Assert (P /= null, "To_Element_Access returned null");
         Assert_Equals (T, "testing", To_String (P.Name), "Data name is not the same");
         Assert_Equals (T, 23, To_Integer (P.Value), "Data value is not the same");

         V := Data_Bean.Create;

         declare
            D2 : constant Data_Access := Data_Bean.To_Element_Access (V);
         begin
            T.Assert (D2 /= null, "Null element");
            D2.Name  := To_Unbounded_String ("second test");
            D2.Value := V2;
         end;

         V := Data_Bean.To_Object (D);
      end;
   end Test_Record;

   type Bean_Type is new Util.Beans.Basic.Readonly_Bean with record
      Name : Unbounded_String;
   end record;
   type Bean_Type_Access is access all Bean_Type'Class;

   overriding
   function Get_Value (Bean : in Bean_Type;
                       Name : in String) return Util.Beans.Objects.Object;

   overriding
   function Get_Value (Bean : in Bean_Type;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "name" then
         return Util.Beans.Objects.To_Object (Bean.Name);
      elsif Name = "length" then
         return Util.Beans.Objects.To_Object (Length (Bean.Name));
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   procedure Test_Bean (T : in out Test) is
      use Basic;
      Static : aliased Bean_Type;
   begin
      Static.Name := To_Unbounded_String ("Static");

      --  Allocate dynamically several Bean_Type objects and drop the list.
      --  The memory held by internal proxy as well as the Bean_Type must be freed.
      --  The static bean should never be freed!
      for I in 1 .. 10 loop
         declare
            List  : Util.Beans.Objects.Vectors.Vector;
            Value : Util.Beans.Objects.Object;
            Bean  : Bean_Type_Access;
            P     : access Readonly_Bean'Class;
         begin
            for J in 1 .. 1_000 loop
               if I = J then
                  Value := To_Object (Static'Unchecked_Access, Objects.STATIC);
                  List.Append (Value);
               end if;
               Bean := new Bean_Type;
               Bean.Name := To_Unbounded_String ("B" & Util.Strings.Image (J));
               Value := To_Object (Bean);
               List.Append (Value);
            end loop;

            --  Verify each bean of the list
            for J in 1 .. 1_000 + 1 loop
               Value := List.Element (J - 1);

               --  Check some common status.
               T.Assert (not Is_Null (Value), "The value should hold a bean");
               T.Assert (Get_Type (Value) = TYPE_BEAN, "The value should hold a bean");
               T.Assert (not Is_Empty (Value), "The value should not be empty");

               --  Check the bean access.
               P := To_Bean (Value);
               T.Assert (P /= null, "To_Bean returned null");
               Bean := Bean_Type'Class (P.all)'Unchecked_Access;

               --  Check we have the good bean object.
               if I = J then
                  Assert_Equals (T, "Static", To_String (Bean.Name),
                                 "Bean at" & Integer'Image (J) & " is invalid");
               elsif J > I then
                  Assert_Equals (T, "B" & Util.Strings.Image (J - 1), To_String (Bean.Name),
                                 "Bean at" & Integer'Image (J) & " is invalid");
               else
                  Assert_Equals (T, "B" & Util.Strings.Image (J), To_String (Bean.Name),
                                 "Bean at" & Integer'Image (J) & " is invalid");
               end if;
            end loop;
         end;
      end loop;
   end Test_Bean;

end Util.Beans.Objects.Record_Tests;

Fix compilation error

Fix compilation error


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

with System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Processes;
with Util.Systems.Constants;

--  The Util.Systems.Os package defines various types and operations which are specific
--  to the OS (Unix).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '/';

   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype Ptr_Array is Interfaces.C.Strings.chars_ptr_array;
   type Ptr_Ptr_Array is access all Ptr_Array;

   type File_Type is new Integer;

   --  Standard file streams Posix, X/Open standard values.
   STDIN_FILENO  : constant File_Type := 0;
   STDOUT_FILENO : constant File_Type := 1;
   STDERR_FILENO : constant File_Type := 2;

   --  File is not opened
   NO_FILE       : constant File_Type := -1;

   --  The following values should be externalized.  They are valid for GNU/Linux.
   F_SETFL    : constant Interfaces.C.int := Util.Systems.Constants.F_SETFL;
   FD_CLOEXEC : constant Interfaces.C.int := Util.Systems.Constants.FD_CLOEXEC;

   --  These values are specific to Linux.
   O_RDONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_RDONLY;
   O_WRONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_WRONLY;
   O_RDWR     : constant Interfaces.C.int := Util.Systems.Constants.O_RDWR;
   O_CREAT    : constant Interfaces.C.int := Util.Systems.Constants.O_CREAT;
   O_EXCL     : constant Interfaces.C.int := Util.Systems.Constants.O_EXCL;
   O_TRUNC    : constant Interfaces.C.int := Util.Systems.Constants.O_TRUNC;
   O_APPEND   : constant Interfaces.C.int := Util.Systems.Constants.O_APPEND;

   type Size_T is mod 2 ** Standard'Address_Size;

   type Ssize_T is range -(2 ** (Standard'Address_Size - 1))
     .. +(2 ** (Standard'Address_Size - 1)) - 1;

   function Close (Fd : in File_Type) return Integer;
   pragma Import (C, Close, "close");

   function Read (Fd   : in File_Type;
                  Buf  : in System.Address;
                  Size : in Size_T) return Ssize_T;
   pragma Import (C, Read, "read");

   function Write (Fd   : in File_Type;
                   Buf  : in System.Address;
                   Size : in Size_T) return Ssize_T;
   pragma Import (C, Write, "write");

   --  System exit without any process cleaning.
   --  (destructors, finalizers, atexit are not called)
   procedure Sys_Exit (Code : in Integer);
   pragma Import (C, Sys_Exit, "_exit");

   --  Fork a new process
   function Sys_Fork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_Fork, "fork");

   --  Fork a new process (vfork implementation)
   function Sys_VFork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_VFork, "fork");

   --  Execute a process with the given arguments.
   function Sys_Execvp (File : in Ptr;
                        Args : in Ptr_Array) return Integer;
   pragma Import (C, Sys_Execvp, "execvp");

   --  Wait for the process Pid to finish and return
   function Sys_Waitpid (Pid     : in Integer;
                         Status  : in System.Address;
                         Options : in Integer) return Integer;
   pragma Import (C, Sys_Waitpid, "waitpid");

   --  Create a bi-directional pipe
   function Sys_Pipe (Fds : in System.Address) return Integer;
   pragma Import (C, Sys_Pipe, "pipe");

   --  Make fd2 the copy of fd1
   function Sys_Dup2 (Fd1, Fd2 : in File_Type) return Integer;
   pragma Import (C, Sys_Dup2, "dup2");

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer;
   pragma Import (C, Sys_Close, "close");

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Interfaces.C.int) return File_Type;
   pragma Import (C, Sys_Open, "open");

   --  Change the file settings
   function Sys_Fcntl (Fd    : in File_Type;
                       Cmd   : in Interfaces.C.int;
                       Flags : in Interfaces.C.int) return Integer;
   pragma Import (C, Sys_Fcntl, "fcntl");

   function Sys_Kill (Pid : in Integer;
                      Signal : in Integer) return Integer;
   pragma Import (C, Sys_Kill, "kill");

end Util.Systems.Os;

-----------------------------------------------------------------------
--  util-system-os -- Unix system operations
--  Copyright (C) 2011, 2012, 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 System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Processes;
with Util.Systems.Constants;
with Util.Systems.Types;

--  The Util.Systems.Os package defines various types and operations which are specific
--  to the OS (Unix).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '/';

   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype Ptr_Array is Interfaces.C.Strings.chars_ptr_array;
   type Ptr_Ptr_Array is access all Ptr_Array;

   type File_Type is new Integer;

   --  Standard file streams Posix, X/Open standard values.
   STDIN_FILENO  : constant File_Type := 0;
   STDOUT_FILENO : constant File_Type := 1;
   STDERR_FILENO : constant File_Type := 2;

   --  File is not opened
   NO_FILE       : constant File_Type := -1;

   --  The following values should be externalized.  They are valid for GNU/Linux.
   F_SETFL    : constant Interfaces.C.int := Util.Systems.Constants.F_SETFL;
   FD_CLOEXEC : constant Interfaces.C.int := Util.Systems.Constants.FD_CLOEXEC;

   --  These values are specific to Linux.
   O_RDONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_RDONLY;
   O_WRONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_WRONLY;
   O_RDWR     : constant Interfaces.C.int := Util.Systems.Constants.O_RDWR;
   O_CREAT    : constant Interfaces.C.int := Util.Systems.Constants.O_CREAT;
   O_EXCL     : constant Interfaces.C.int := Util.Systems.Constants.O_EXCL;
   O_TRUNC    : constant Interfaces.C.int := Util.Systems.Constants.O_TRUNC;
   O_APPEND   : constant Interfaces.C.int := Util.Systems.Constants.O_APPEND;

   type Size_T is mod 2 ** Standard'Address_Size;

   type Ssize_T is range -(2 ** (Standard'Address_Size - 1))
     .. +(2 ** (Standard'Address_Size - 1)) - 1;

   function Close (Fd : in File_Type) return Integer;
   pragma Import (C, Close, "close");

   function Read (Fd   : in File_Type;
                  Buf  : in System.Address;
                  Size : in Size_T) return Ssize_T;
   pragma Import (C, Read, "read");

   function Write (Fd   : in File_Type;
                   Buf  : in System.Address;
                   Size : in Size_T) return Ssize_T;
   pragma Import (C, Write, "write");

   --  System exit without any process cleaning.
   --  (destructors, finalizers, atexit are not called)
   procedure Sys_Exit (Code : in Integer);
   pragma Import (C, Sys_Exit, "_exit");

   --  Fork a new process
   function Sys_Fork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_Fork, "fork");

   --  Fork a new process (vfork implementation)
   function Sys_VFork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_VFork, "fork");

   --  Execute a process with the given arguments.
   function Sys_Execvp (File : in Ptr;
                        Args : in Ptr_Array) return Integer;
   pragma Import (C, Sys_Execvp, "execvp");

   --  Wait for the process Pid to finish and return
   function Sys_Waitpid (Pid     : in Integer;
                         Status  : in System.Address;
                         Options : in Integer) return Integer;
   pragma Import (C, Sys_Waitpid, "waitpid");

   --  Create a bi-directional pipe
   function Sys_Pipe (Fds : in System.Address) return Integer;
   pragma Import (C, Sys_Pipe, "pipe");

   --  Make fd2 the copy of fd1
   function Sys_Dup2 (Fd1, Fd2 : in File_Type) return Integer;
   pragma Import (C, Sys_Dup2, "dup2");

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer;
   pragma Import (C, Sys_Close, "close");

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Interfaces.C.int) return File_Type;
   pragma Import (C, Sys_Open, "open");

   --  Change the file settings
   function Sys_Fcntl (Fd    : in File_Type;
                       Cmd   : in Interfaces.C.int;
                       Flags : in Interfaces.C.int) return Integer;
   pragma Import (C, Sys_Fcntl, "fcntl");

   function Sys_Kill (Pid : in Integer;
                      Signal : in Integer) return Integer;
   pragma Import (C, Sys_Kill, "kill");

   function Sys_Stat (Path : in Ptr;
                      Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Stat, "stat");

   function Sys_Fstat (Fs : in File_Type;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Fstat, "fstat");

end Util.Systems.Os;

Define the Sys_Stat and Sys_Fstat operations


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

with Util.Beans.Objects;
with Util.Beans.Basic;
with Gen.Model;
with Ada.Containers.Vectors;

generic
   type T is new Gen.Model.Definition with private;
   type T_Access is access all T'Class;
package Gen.Model.List is

   --  Compare the two definitions.
   function "<" (Left, Right : in T_Access) return Boolean;

   package Vectors is
      new Ada.Containers.Vectors (Index_Type   => Natural,
                                  Element_Type => T_Access,
                                  "="          => "=");

   package Sorting is new Vectors.Generic_Sorting;

   subtype Cursor is Vectors.Cursor;
   subtype Vector is Vectors.Vector;

   function Has_Element (Position : Cursor) return Boolean
     renames Vectors.Has_Element;

   function Element (Position : Cursor) return T_Access
     renames Vectors.Element;

   procedure Next (Position : in out Cursor)
     renames Vectors.Next;

   type List_Definition is limited new Util.Beans.Basic.List_Bean with private;

   --  Get the first item of the list
   function First (Def : List_Definition) return Cursor;

   --  Get the number of elements in the list.
   overriding
   function Get_Count (From : List_Definition) return Natural;

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

   --  Get the element at the current row index.
   overriding
   function Get_Row (From  : List_Definition) return Util.Beans.Objects.Object;

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

   --  Append the item in the list
   procedure Append (Def  : in out List_Definition;
                     Item : in T_Access);

   --  Sort the list of items on their names.
   procedure Sort (List : in out List_Definition);

   generic
      with function "<" (Left, Right : T_Access) return Boolean is <>;
   procedure Sort_On (List : in out List_Definition);

   --  Find a definition given the name.
   --  Returns the definition object or null.
   function Find (Def  : in List_Definition;
                  Name : in String) return T_Access;

   --  Iterate over the elements of the list executing the <tt>Process</tt> procedure.
   procedure Iterate (Def     : in List_Definition;
                      Process : not null access procedure (Item : in T_Access));

private
   type List_Definition is limited new Util.Beans.Basic.List_Bean with record
      Nodes      : Vectors.Vector;
      Row        : Natural := 0;
      Value_Bean : Util.Beans.Objects.Object;
   end record;

end Gen.Model.List;

-----------------------------------------------------------------------
--  gen-model-list -- List bean interface for model objects
--  Copyright (C) 2009, 2010, 2011, 2012, 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.Beans.Objects;
with Util.Beans.Basic;
with Gen.Model;
with Ada.Containers.Vectors;
with Ada.Iterator_Interfaces;

generic
   type T is new Gen.Model.Definition with private;
   type T_Access is access all T'Class;
package Gen.Model.List is

   --  Compare the two definitions.
   function "<" (Left, Right : in T_Access) return Boolean;

   package Vectors is
      new Ada.Containers.Vectors (Index_Type   => Natural,
                                  Element_Type => T_Access,
                                  "="          => "=");

   package Sorting is new Vectors.Generic_Sorting;

   subtype Cursor is Vectors.Cursor;
   subtype Vector is Vectors.Vector;

   function Has_Element (Position : Cursor) return Boolean
     renames Vectors.Has_Element;

   function Element (Position : Cursor) return T_Access
     renames Vectors.Element;

   procedure Next (Position : in out Cursor)
     renames Vectors.Next;

   type List_Definition is limited new Util.Beans.Basic.List_Bean with private
     with Default_Iterator  => Iterate,
     Iterator_Element  => T_Access,
     Constant_Indexing => Element_Value;

   package List_Iterator is
     new Ada.Iterator_Interfaces (Cursor, Has_Element);

   --  Make an iterator for the list.
   function Iterate (Container : in List_Definition)
      return List_Iterator.Forward_Iterator'Class;

   --  Get the iterator element.
   function Element_Value (Container : in List_Definition;
                           Pos       : in Cursor) return T_Access;

   --  Get the first item of the list
   function First (Def : List_Definition) return Cursor;

   --  Get the number of elements in the list.
   overriding
   function Get_Count (From : List_Definition) return Natural;

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

   --  Get the element at the current row index.
   overriding
   function Get_Row (From  : List_Definition) return Util.Beans.Objects.Object;

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

   --  Append the item in the list
   procedure Append (Def  : in out List_Definition;
                     Item : in T_Access);

   --  Sort the list of items on their names.
   procedure Sort (List : in out List_Definition);

   generic
      with function "<" (Left, Right : T_Access) return Boolean is <>;
   procedure Sort_On (List : in out List_Definition);

   --  Find a definition given the name.
   --  Returns the definition object or null.
   function Find (Def  : in List_Definition;
                  Name : in String) return T_Access;

   --  Iterate over the elements of the list executing the <tt>Process</tt> procedure.
   procedure Iterate (Def     : in List_Definition;
                      Process : not null access procedure (Item : in T_Access));

private

   type List_Definition_Access is access all List_Definition;

   type List_Definition is limited new Util.Beans.Basic.List_Bean with record
      Self       : List_Definition_Access := List_Definition'Unchecked_Access;
      Nodes      : Vectors.Vector;
      Row        : Natural := 0;
      Value_Bean : Util.Beans.Objects.Object;
   end record;

   type Iterator is limited new List_Iterator.Forward_Iterator with record
      List : List_Definition_Access;
   end record;

   overriding
   function First (Object : Iterator) return Cursor;

   overriding
   function Next (Object : Iterator;
                  Pos    : Cursor) return Cursor;

end Gen.Model.List;

Change List_Definition to allow using the Ada 2012 iterators - Add necessary aspect definitions, - Instantiate List_Iterator package, - Define Iterate and Element_Value function - Declare private Iterator type with First and Next functions


-----------------------------------------------------------------------
--  mat-formats - Format various types for the console or GUI interface
--  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.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;

with MAT.Types;
with MAT.Events.Tools;
package MAT.Formats is

   type Format_Type is (BRIEF, NORMAL);

   --  Format the PID into a string.
   function Pid (Value : in MAT.Types.Target_Process_Ref) return String;

   --  Format the address into a string.
   function Addr (Value : in MAT.Types.Target_Addr) return String;

   --  Format the size into a string.
   function Size (Value : in MAT.Types.Target_Size) return String;

   --  Format the time relative to the start time.
   function Time (Value : in MAT.Types.Target_Tick_Ref;
                  Start : in MAT.Types.Target_Tick_Ref) return String;

   --  Format the duration in seconds, milliseconds or microseconds.
   function Duration (Value : in MAT.Types.Target_Tick_Ref) return String;

   --  Format a file, line, function information into a string.
   function Location (File : in Ada.Strings.Unbounded.Unbounded_String;
                      Line : in Natural;
                      Func : in Ada.Strings.Unbounded.Unbounded_String) return String;

   --  Format an event range description.
   function Event (First : in MAT.Events.Target_Event_Type;
                   Last  : in MAT.Events.Target_Event_Type) return String;

   --  Format a short description of the event.
   function Event (Item : in MAT.Events.Target_Event_Type;
                   Mode : in Format_Type := NORMAL) return String;

   --  Format a short description of the event.
   function Event (Item       : in MAT.Events.Target_Event_Type;
                   Related    : in MAT.Events.Tools.Target_Event_Vector;
                   Start_Time : in MAT.Types.Target_Tick_Ref) return String;

end MAT.Formats;

-----------------------------------------------------------------------
--  mat-formats - Format various types for the console or GUI interface
--  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.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;

with MAT.Types;
with MAT.Events.Tools;
package MAT.Formats is

   type Format_Type is (BRIEF, NORMAL);

   --  Format the PID into a string.
   function Pid (Value : in MAT.Types.Target_Process_Ref) return String;

   --  Format the address into a string.
   function Addr (Value : in MAT.Types.Target_Addr) return String;

   --  Format the size into a string.
   function Size (Value : in MAT.Types.Target_Size) return String;

   --  Format the memory growth size into a string.
   function Size (Alloced : in MAT.Types.Target_Size;
                  Freed   : in MAT.Types.Target_Size) return String;

   --  Format the time relative to the start time.
   function Time (Value : in MAT.Types.Target_Tick_Ref;
                  Start : in MAT.Types.Target_Tick_Ref) return String;

   --  Format the duration in seconds, milliseconds or microseconds.
   function Duration (Value : in MAT.Types.Target_Tick_Ref) return String;

   --  Format a file, line, function information into a string.
   function Location (File : in Ada.Strings.Unbounded.Unbounded_String;
                      Line : in Natural;
                      Func : in Ada.Strings.Unbounded.Unbounded_String) return String;

   --  Format an event range description.
   function Event (First : in MAT.Events.Target_Event_Type;
                   Last  : in MAT.Events.Target_Event_Type) return String;

   --  Format a short description of the event.
   function Event (Item : in MAT.Events.Target_Event_Type;
                   Mode : in Format_Type := NORMAL) return String;

   --  Format a short description of the event.
   function Event (Item       : in MAT.Events.Target_Event_Type;
                   Related    : in MAT.Events.Tools.Target_Event_Vector;
                   Start_Time : in MAT.Types.Target_Tick_Ref) return String;

end MAT.Formats;

Declare the Size function to format a memory growth information (alloced/freed)


   type errno_t is new int_t;
   type fcntl_t is new int_t;
   type whence_t is new int_t;
   type mntflags_t is new int_t;
   type amode_t is new uint_t;
   type ptrace_t is new int_t;
   type rlimkind_t is new int_t;
   type rwho_t is new int_t;
   type mprot_t is new uint_t;
   type mmap_t is new uint_t;
   type sysc_t is new int_t;
   type logopt_t is new uint_t;
   type logfac_t is new uint_t;
   type itim_t is new uint_t;
   type ipccmd_t is new int_t;

   type short_array is array(Natural range <>) of short_t;
   type int_array is array(Natural range <>) of int_t;
   type long_array is array(Natural range <>) of long_t;
   type llong_array is array(Natural range <>) of llong_t;

   type ushort_array is array(Natural range <>) of ushort_t;
   type uint_array is array(Natural range <>) of uint_t;
   type ulong_array is array(Natural range <>) of ulong_t;
   type ullong_array is array(Natural range <>) of ullong_t;

   type DIR is new System.Address;
   Null_DIR : constant DIR := DIR(System.Null_Address);
   function "="(L,R : DIR) return Boolean;

   type errno_t is new int_t;
   type fcntl_t is new int_t;
   type whence_t is new int_t;
   type mntflags_t is new int_t;
   type amode_t is new uint_t;
   type ptrace_t is new int_t;
   type rlimkind_t is new int_t;
   type rwho_t is new int_t;
   type mprot_t is new uint_t;
   type mmap_t is new uint_t;
   type sysc_t is new int_t;
   type logopt_t is new uint_t;
   type logfac_t is new uint_t;
   type itim_t is new uint_t;
   type ipccmd_t is new int_t;
   type sigpmop_t is new int_t;

   type short_array is array(Natural range <>) of short_t;
   type int_array is array(Natural range <>) of int_t;
   type long_array is array(Natural range <>) of long_t;
   type llong_array is array(Natural range <>) of llong_t;

   type ushort_array is array(Natural range <>) of ushort_t;
   type uint_array is array(Natural range <>) of uint_t;
   type ulong_array is array(Natural range <>) of ulong_t;
   type ullong_array is array(Natural range <>) of ullong_t;

   type DIR is new System.Address;
   Null_DIR : constant DIR := DIR(System.Null_Address);
   function "="(L,R : DIR) return Boolean;

Add new type sigpmop_t

Add new type sigpmop_t


-----------------------------------------------------------------------
--  gen-commands-propset -- Set a property on dynamo project
--  Copyright (C) 2011, 2012, 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.Text_IO;

package body Gen.Commands.Propset 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;

   begin
      if Args.Get_Count /= 2 then
         Gen.Commands.Usage;
         return;
      end if;

      Generator.Read_Project ("dynamo.xml", True);
      Generator.Set_Project_Property (Args.Get_Argument (1), Args.Get_Argument (2));
      Generator.Save_Project;
   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, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("propset: Set the value of a property in the dynamo project file");
      Put_Line ("Usage: propset NAME VALUEE");
      New_Line;
   end Help;

end Gen.Commands.Propset;

-----------------------------------------------------------------------
--  gen-commands-propset -- Set a property on dynamo project
--  Copyright (C) 2011, 2012, 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.Text_IO;

package body Gen.Commands.Propset 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, Name);
      use Ada.Strings.Unbounded;

   begin
      if Args.Get_Count /= 2 then
         Gen.Commands.Usage;
         return;
      end if;

      Generator.Read_Project ("dynamo.xml", True);
      Generator.Set_Project_Property (Args.Get_Argument (1), Args.Get_Argument (2));
      Generator.Save_Project;
   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, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("propset: Set the value of a property in the dynamo project file");
      Put_Line ("Usage: propset NAME VALUEE");
      New_Line;
   end Help;

end Gen.Commands.Propset;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  awa-counters-beans -- Counter bean definition
--  Copyright (C) 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Calendar;
with Util.Dates.ISO8601;
with ADO.Queries.Loaders;
with ADO.Sessions.Entities;
with AWA.Services.Contexts;
package body AWA.Counters.Beans is

   package ASC renames AWA.Services.Contexts;

   function Parse_Date (Date : in String;
                        Now  : in Ada.Calendar.Time) return Ada.Calendar.Time;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Counter_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (Name);
   begin
      return Util.Beans.Objects.To_Object (From.Value);
   end Get_Value;

   overriding
   function Get_Value (List : in Counter_Stat_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "stats" then
         return Util.Beans.Objects.To_Object (Value   => List.Stats_Bean,
                                              Storage => Util.Beans.Objects.STATIC);
      else
         return AWA.Counters.Models.Stat_List_Bean (List).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Counter_Stat_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if not Util.Beans.Objects.Is_Empty (Value) then
         AWA.Counters.Models.Stat_List_Bean (From).Set_Value (Name, Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Get the query definition to collect the counter statistics.
   --  ------------------------------
   function Get_Query (From : in Counter_Stat_Bean) return ADO.Queries.Query_Definition_Access is
      Name : constant String := Ada.Strings.Unbounded.To_String (From.Query_Name);
   begin
      return ADO.Queries.Loaders.Find_Query (Name);
   end Get_Query;

   function Parse_Date (Date : in String;
                        Now  : in Ada.Calendar.Time) return Ada.Calendar.Time is
      use type Ada.Calendar.Time;

      Day : Natural;
   begin
      if Date'Length = 0 or Date = "now" then
         return Now;
      elsif Date'Length > 5 and then Date (Date'First .. Date'First + 3) = "now-" then
         Day := Natural'Value (Date (Date'First + 4 .. Date'Last));
         return Now - Duration (Day * 86400);
      else
         return Util.Dates.ISO8601.Value (Date);
      end if;
   end Parse_Date;

   --  ------------------------------
   --  Load the statistics information.
   --  ------------------------------
   overriding
   procedure Load (List    : in out Counter_Stat_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
      use type ADO.Identifier;
      use type ADO.Queries.Query_Definition_Access;

      Ctx         : constant ASC.Service_Context_Access := ASC.Current;
      User        : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Now         : constant Ada.Calendar.Time := Ada.Calendar.Clock;
      Def         : constant ADO.Queries.Query_Definition_Access := List.Get_Query;
      Entity_Type : constant String := Ada.Strings.Unbounded.To_String (List.Entity_Type);
      Session     : ADO.Sessions.Session := List.Module.Get_Session;
      Kind        : ADO.Entity_Type;
      First_Date  : Ada.Calendar.Time;
      Last_Date   : Ada.Calendar.Time;
      Query       : ADO.Queries.Context;
   begin
      Kind := ADO.Sessions.Entities.Find_Entity_Type (Session, Entity_Type);
      First_Date := Parse_Date (Ada.Strings.Unbounded.To_String (List.First_Date), Now);
      Last_Date := Parse_Date (Ada.Strings.Unbounded.To_String (List.Last_Date), Now);
      if List.Entity_Id /= ADO.NO_IDENTIFIER and Def /= null then
         Query.Set_Query (Def);
         Query.Bind_Param ("entity_type", Kind);
         Query.Bind_Param ("entity_id", List.Entity_Id);
         Query.Bind_Param ("user_id", User);
         Query.Bind_Param ("first_date", First_Date);
         Query.Bind_Param ("last_date", Last_Date);
         Query.Bind_Param ("counter_name", List.Counter_Name);

         AWA.Counters.Models.List (List.Stats, Session, Query);
      end if;
   end Load;

   --  ------------------------------
   --  Create the Blog_Stat_Bean bean instance.
   --  ------------------------------
   function Create_Counter_Stat_Bean (Module : in AWA.Counters.Modules.Counter_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Counter_Stat_Bean_Access := new Counter_Stat_Bean;
   begin
      Object.Module     := Module;
      Object.Stats_Bean := Object.Stats'Access;
      return Object.all'Access;
   end Create_Counter_Stat_Bean;

end AWA.Counters.Beans;

-----------------------------------------------------------------------
--  awa-counters-beans -- Counter bean definition
--  Copyright (C) 2015, 2016, 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 Ada.Calendar;
with Util.Dates.ISO8601;
with ADO.Queries.Loaders;
with ADO.Sessions.Entities;
with AWA.Services.Contexts;
package body AWA.Counters.Beans is

   package ASC renames AWA.Services.Contexts;

   function Parse_Date (Date : in String;
                        Now  : in Ada.Calendar.Time) return Ada.Calendar.Time;

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Counter_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (Name);
   begin
      return Util.Beans.Objects.To_Object (From.Value);
   end Get_Value;

   overriding
   function Get_Value (List : in Counter_Stat_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "stats" then
         return Util.Beans.Objects.To_Object (Value   => List.Stats_Bean,
                                              Storage => Util.Beans.Objects.STATIC);
      else
         return AWA.Counters.Models.Stat_List_Bean (List).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Counter_Stat_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if not Util.Beans.Objects.Is_Empty (Value) then
         AWA.Counters.Models.Stat_List_Bean (From).Set_Value (Name, Value);
      end if;
   end Set_Value;

   --  ------------------------------
   --  Get the query definition to collect the counter statistics.
   --  ------------------------------
   function Get_Query (From : in Counter_Stat_Bean) return ADO.Queries.Query_Definition_Access is
      Name : constant String := Ada.Strings.Unbounded.To_String (From.Query_Name);
   begin
      return ADO.Queries.Loaders.Find_Query (Name);
   end Get_Query;

   function Parse_Date (Date : in String;
                        Now  : in Ada.Calendar.Time) return Ada.Calendar.Time is
      use type Ada.Calendar.Time;

      Day : Natural;
   begin
      if Date'Length = 0 or Date = "now" then
         return Now;
      elsif Date'Length > 5 and then Date (Date'First .. Date'First + 3) = "now-" then
         Day := Natural'Value (Date (Date'First + 4 .. Date'Last));
         return Now - Duration (Day * 86400);
      else
         return Util.Dates.ISO8601.Value (Date);
      end if;
   end Parse_Date;

   --  ------------------------------
   --  Load the statistics information.
   --  ------------------------------
   overriding
   procedure Load (List    : in out Counter_Stat_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (Outcome);
      use type ADO.Identifier;
      use type ADO.Queries.Query_Definition_Access;

      Ctx         : constant ASC.Service_Context_Access := ASC.Current;
      User        : constant ADO.Identifier := Ctx.Get_User_Identifier;
      Now         : constant Ada.Calendar.Time := Ada.Calendar.Clock;
      Def         : constant ADO.Queries.Query_Definition_Access := List.Get_Query;
      Entity_Type : constant String := Ada.Strings.Unbounded.To_String (List.Entity_Type);
      Session     : ADO.Sessions.Session := ASC.Get_Session (Ctx);
      Kind        : ADO.Entity_Type;
      First_Date  : Ada.Calendar.Time;
      Last_Date   : Ada.Calendar.Time;
      Query       : ADO.Queries.Context;
   begin
      Kind := ADO.Sessions.Entities.Find_Entity_Type (Session, Entity_Type);
      First_Date := Parse_Date (Ada.Strings.Unbounded.To_String (List.First_Date), Now);
      Last_Date := Parse_Date (Ada.Strings.Unbounded.To_String (List.Last_Date), Now);
      if List.Entity_Id /= ADO.NO_IDENTIFIER and Def /= null then
         Query.Set_Query (Def);
         Query.Bind_Param ("entity_type", Kind);
         Query.Bind_Param ("entity_id", List.Entity_Id);
         Query.Bind_Param ("user_id", User);
         Query.Bind_Param ("first_date", First_Date);
         Query.Bind_Param ("last_date", Last_Date);
         Query.Bind_Param ("counter_name", List.Counter_Name);

         AWA.Counters.Models.List (List.Stats, Session, Query);
      end if;
   end Load;

   --  ------------------------------
   --  Create the Blog_Stat_Bean bean instance.
   --  ------------------------------
   function Create_Counter_Stat_Bean (Module : in AWA.Counters.Modules.Counter_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Counter_Stat_Bean_Access := new Counter_Stat_Bean;
   begin
      Object.Module     := Module;
      Object.Stats_Bean := Object.Stats'Access;
      return Object.all'Access;
   end Create_Counter_Stat_Bean;

end AWA.Counters.Beans;

Use the service context to get the database session object


-----------------------------------------------------------------------
--  awa-counters --
--  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.
-----------------------------------------------------------------------

with AWA.Counters.Modules;
package body AWA.Counters is

   package body Definition is

      package Def is new Counter_Arrays.Definition (Table.Table.all);

      function Kind return Counter_Index_Type is
      begin
         return Def.Kind;
      end Kind;

   end Definition;

   --  Increment the counter identified by <tt>Counter</tt> and associated with the
   --  database object <tt>Object</tt>.
   procedure Increment (Counter : in Counter_Index_Type;
                        Object  : in ADO.Objects.Object_Ref'Class) is
      Module : constant AWA.Counters.Modules.Counter_Module_Access
        := AWA.Counters.Modules.Get_Counter_Module;
   begin
      Module.Increment (Counter, Object);
   end Increment;

end AWA.Counters;

-----------------------------------------------------------------------
--  awa-counters --
--  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.
-----------------------------------------------------------------------

with AWA.Counters.Modules;
package body AWA.Counters is

   use type Util.Strings.Name_Access;
   use type ADO.Schemas.Class_Mapping_Access;

   function "&" (Left  : in String;
                 Right : in Counter_Def) return String is
   begin
      return Left & "[" & Right.Table.Table.all & ", " & Right.Field.all & "]";
   end "&";

   function "=" (Left, Right : in Counter_Def) return Boolean is
   begin
      return Left.Table = Right.Table and Left.Field = Right.Field;
   end "=";

   function "<" (Left, Right : in Counter_Def) return Boolean is
   begin
      return Left.Table.Table.all < Right.Table.Table.all
        or (Left.Table = Right.Table and Left.Field.all < Right.Field.all);
   end "<";

   --  ------------------------------
   --  Increment the counter identified by <tt>Counter</tt> and associated with the
   --  database object <tt>Object</tt>.
   --  ------------------------------
   procedure Increment (Counter : in Counter_Index_Type;
                        Object  : in ADO.Objects.Object_Ref'Class) is
      Module : constant AWA.Counters.Modules.Counter_Module_Access
        := AWA.Counters.Modules.Get_Counter_Module;
   begin
      Module.Increment (Counter, Object);
   end Increment;

end AWA.Counters;

Implement the &, < and = functions for the Counter_Def type