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

with GNAT.Sockets;

with MAT.Types;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Readers.Streams.Sockets;
with MAT.Readers;
with MAT.Consoles;
package MAT.Targets is

   --  Exception raised if some option is invalid.
   Usage_Error : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      --  Enable and enter in the interactive TTY console mode.
      Interactive  : Boolean := True;

      --  Try to load the symbol file automatically when a new process is recieved.
      Load_Symbols : Boolean := True;

      --  Enable the graphical mode (when available).
      Graphical    : Boolean := False;

      --  Define the server listening address.
      Address      : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   type Target_Process_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Path    : Ada.Strings.Unbounded.Unbounded_String;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols_Ref;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   type Target_Type is tagged limited private;

   type Target_Type_Access is access all Target_Type'Class;

   --  Get the console instance.
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access;

   --  Set the console instance.
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access);

   --  Get the current process instance.
   function Process (Target : in Target_Type) return Target_Process_Type_Access;

   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access);

   --  Find the process instance from the process ID.
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access;

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out MAT.Targets.Target_Type);

   --  Start the server to listen to MAT event socket streams.
   procedure Start (Target : in out Target_Type);

   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type;

   --  Print the application usage.
   procedure Usage;

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

   subtype Process_Map is Process_Maps.Map;
   subtype Process_Cursor is Process_Maps.Cursor;

   type Target_Type is tagged limited record
      Current   : Target_Process_Type_Access;
      Processes : Process_Map;
      Console   : MAT.Consoles.Console_Access;
      Options   : Options_Type;
      Server    : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
   end record;

end MAT.Targets;

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

with GNAT.Sockets;

with MAT.Types;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Readers.Streams.Sockets;
with MAT.Readers;
with MAT.Consoles;
package MAT.Targets is

   --  Exception raised if some option is invalid.
   Usage_Error : exception;

   --  The options that can be configured through the command line.
   type Options_Type is record
      --  Enable and enter in the interactive TTY console mode.
      Interactive  : Boolean := True;

      --  Try to load the symbol file automatically when a new process is recieved.
      Load_Symbols : Boolean := True;

      --  Enable the graphical mode (when available).
      Graphical    : Boolean := False;

      --  Define the server listening address.
      Address      : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   type Target_Process_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Path    : Ada.Strings.Unbounded.Unbounded_String;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols_Ref;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   type Target_Type is tagged limited private;

   type Target_Type_Access is access all Target_Type'Class;

   --  Get the console instance.
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access;

   --  Set the console instance.
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access);

   --  Get the current process instance.
   function Process (Target : in Target_Type) return Target_Process_Type_Access;

   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access);

   --  Find the process instance from the process ID.
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access;

   --  Parse the command line arguments and configure the target instance.
   procedure Initialize_Options (Target  : in out Target_Type);

   --  Start the server to listen to MAT event socket streams.
   procedure Start (Target : in out Target_Type);

   --  Stop the server thread.
   procedure Stop (Target : in out Target_Type);

   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type;

   --  Print the application usage.
   procedure Usage;

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

   subtype Process_Map is Process_Maps.Map;
   subtype Process_Cursor is Process_Maps.Cursor;

   type Target_Type is tagged limited record
      Current   : Target_Process_Type_Access;
      Processes : Process_Map;
      Console   : MAT.Consoles.Console_Access;
      Options   : Options_Type;
      Server    : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
   end record;

end MAT.Targets;

Declare the Stop procedure

Declare the Stop procedure


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

end Util.Properties.Basic;

-----------------------------------------------------------------------
--  util-properties-basic -- Basic types properties
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 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.
-----------------------------------------------------------------------
package body Util.Properties.Basic is

end Util.Properties.Basic;

Fix header style

Fix header style


-----------------------------------------------------------------------
--  Util.Streams.Buffered -- Buffered streams Stream utilities
--  Copyright (C) 2010, 2011, 2013, 2014, 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 Interfaces;
with Ada.IO_Exceptions;
with Ada.Unchecked_Deallocation;
package body Util.Streams.Buffered is

   procedure Free_Buffer is
     new Ada.Unchecked_Deallocation (Object => Stream_Element_Array,
                                     Name   => Buffer_Access);

   --  ------------------------------
   --  Initialize the stream to read or write on the given streams.
   --  An internal buffer is allocated for writing the stream.
   --  ------------------------------
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Output  : in Output_Stream_Access;
                         Input   : in Input_Stream_Access;
                         Size    : in Positive) is
   begin
      Free_Buffer (Stream.Buffer);
      Stream.Last      := Stream_Element_Offset (Size);
      Stream.Buffer    := new Stream_Element_Array (1 .. Stream.Last);
      Stream.Output    := Output;
      Stream.Input     := Input;
      Stream.Write_Pos := 1;
      Stream.Read_Pos  := 1;
      Stream.No_Flush  := False;
   end Initialize;

   --  ------------------------------
   --  Initialize the stream to read from the string.
   --  ------------------------------
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Content : in String) is
   begin
      Free_Buffer (Stream.Buffer);
      Stream.Last      := Stream_Element_Offset (Content'Length);
      Stream.Buffer    := new Stream_Element_Array (1 .. Content'Length);
      Stream.Output    := null;
      Stream.Input     := null;
      Stream.Write_Pos := Stream.Last + 1;
      Stream.Read_Pos  := 1;
      Stream.No_Flush  := False;
      for I in Content'Range loop
         Stream.Buffer (Stream_Element_Offset (I - Content'First + 1))
           := Character'Pos (Content (I));
      end loop;
   end Initialize;

   --  ------------------------------
   --  Initialize the stream with a buffer of Size bytes.
   --  ------------------------------
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Size    : in Positive) is
   begin
      Stream.Initialize (Output => null, Input => null, Size => Size);
      Stream.No_Flush := True;
      Stream.Read_Pos := 1;
   end Initialize;

   --  ------------------------------
   --  Close the sink.
   --  ------------------------------
   overriding
   procedure Close (Stream : in out Buffered_Stream) is
   begin
      if Stream.Output /= null then
         Buffered_Stream'Class (Stream).Flush;
         Stream.Output.Close;
      end if;
   end Close;

   --  ------------------------------
   --  Get the direct access to the buffer.
   --  ------------------------------
   function Get_Buffer (Stream : in Buffered_Stream) return Buffer_Access is
   begin
      return Stream.Buffer;
   end Get_Buffer;

   --  ------------------------------
   --  Get the number of element in the stream.
   --  ------------------------------
   function Get_Size (Stream : in Buffered_Stream) return Natural is
   begin
      return Natural (Stream.Write_Pos - Stream.Read_Pos);
   end Get_Size;

   --  ------------------------------
   --  Write a raw character on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Buffered_Stream;
                    Char   : in Character) is
   begin
      if Stream.Write_Pos > Stream.Last then
         Stream.Flush;
         if Stream.Write_Pos > Stream.Last then
            raise Ada.IO_Exceptions.End_Error with "Buffer is full";
         end if;
      end if;
      Stream.Buffer (Stream.Write_Pos) := Stream_Element (Character'Pos (Char));
      Stream.Write_Pos := Stream.Write_Pos + 1;
   end Write;

   --  ------------------------------
   --  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 Buffered_Stream;
                         Item   : in Wide_Wide_Character) is
      use Interfaces;

      Val : Unsigned_32;
   begin
      --  UTF-8 conversion
      --  7  U+0000   U+007F   1  0xxxxxxx
      --  11 U+0080   U+07FF   2  110xxxxx 10xxxxxx
      --  16 U+0800   U+FFFF   3  1110xxxx 10xxxxxx 10xxxxxx
      --  21 U+10000  U+1FFFFF 4  11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
      Val := Wide_Wide_Character'Pos (Item);
      if Val <= 16#7f# then
         Stream.Write (Character'Val (Val));
      elsif Val <= 16#07FF# then
         Stream.Write (Character'Val (16#C0# or Shift_Right (Val, 6)));
         Stream.Write (Character'Val (16#80# or (Val and 16#03F#)));
      elsif Val <= 16#0FFFF# then
         Stream.Write (Character'Val (16#E0# or Shift_Right (Val, 12)));
         Val := Val and 16#0FFF#;
         Stream.Write (Character'Val (16#80# or Shift_Right (Val, 6)));
         Stream.Write (Character'Val (16#80# or (Val and 16#03F#)));
      else
         Val := Val and 16#1FFFFF#;
         Stream.Write (Character'Val (16#F0# or Shift_Right (Val, 18)));
         Val := Val and 16#3FFFF#;
         Stream.Write (Character'Val (16#80# or Shift_Right (Val, 12)));
         Val := Val and 16#0FFF#;
         Stream.Write (Character'Val (16#80# or Shift_Right (Val, 6)));
         Stream.Write (Character'Val (16#80# or (Val and 16#03F#)));
      end if;
   end Write_Wide;

   --  ------------------------------
   --  Write a raw string on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Buffered_Stream;
                    Item   : in String) is
      Start : Positive := Item'First;
      Pos   : Stream_Element_Offset := Stream.Write_Pos;
      Avail : Natural;
      Size  : Natural;
      Char  : Character;
   begin
      while Start <= Item'Last loop
         Size := Item'Last - Start + 1;
         Avail := Natural (Stream.Last - Pos + 1);
         if Avail = 0 then
            Stream.Flush;
            Pos := Stream.Write_Pos;
            Avail := Natural (Stream.Last - Pos + 1);
            if Avail = 0 then
               raise Ada.IO_Exceptions.End_Error with "Buffer is full";
            end if;
         end if;
         if Avail < Size then
            Size := Avail;
         end if;
         while Size > 0 loop
            Char := Item (Start);
            Stream.Buffer (Pos) := Stream_Element (Character'Pos (Char));
            Pos := Pos + 1;
            Start := Start + 1;
            Size := Size - 1;
         end loop;
         Stream.Write_Pos := Pos;
      end loop;
   end Write;

   --  ------------------------------
   --  Write a raw string on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Buffered_Stream;
                    Item   : in Ada.Strings.Unbounded.Unbounded_String) is
      Count : constant Natural := Ada.Strings.Unbounded.Length (Item);
   begin
      if Count > 0 then
         for I in 1 .. Count loop
            Stream.Write (Char => Ada.Strings.Unbounded.Element (Item, I));
         end loop;
      end if;
   end Write;

   --  ------------------------------
   --  Write a raw string on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Buffered_Stream;
                    Item   : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String) is
      Count : constant Natural := Ada.Strings.Wide_Wide_Unbounded.Length (Item);
      C     : Wide_Wide_Character;
   begin
      if Count > 0 then
         for I in 1 .. Count loop
            C := Ada.Strings.Wide_Wide_Unbounded.Element (Item, I);
            Stream.Write (Char => Character'Val (Wide_Wide_Character'Pos (C)));
         end loop;
      end if;
   end Write;

   --  ------------------------------
   --  Write the buffer array to the output stream.
   --  ------------------------------
   overriding
   procedure Write (Stream : in out Buffered_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
      Start : Stream_Element_Offset := Buffer'First;
      Pos   : Stream_Element_Offset := Stream.Write_Pos;
      Avail : Stream_Element_Offset;
      Size  : Stream_Element_Offset;
   begin
      while Start <= Buffer'Last loop
         Size := Buffer'Last - Start + 1;
         Avail := Stream.Last - Pos + 1;
         if Avail = 0 then
            Stream.Flush;
            Pos := Stream.Write_Pos;
            Avail := Stream.Last - Pos + 1;
            if Avail = 0 then
               raise Ada.IO_Exceptions.End_Error with "Buffer is full";
            end if;
         end if;
         if Avail < Size then
            Size := Avail;
         end if;
         Stream.Buffer (Pos .. Pos + Size - 1) := Buffer (Start .. Start + Size - 1);
         Start := Start + Size;
         Pos   := Pos + Size;
         Stream.Write_Pos := Pos;

         --  If we have still more data that the buffer size, flush and write
         --  the buffer directly.
         if Start < Buffer'Last and then Buffer'Last - Start > Stream.Buffer'Length then
            Stream.Flush;
            Stream.Output.Write (Buffer (Start .. Buffer'Last));
            return;
         end if;
      end loop;
   end Write;

   --  ------------------------------
   --  Flush the stream.
   --  ------------------------------
   overriding
   procedure Flush (Stream : in out Buffered_Stream) is
   begin
      if Stream.Write_Pos > 1 and not Stream.No_Flush then
         if Stream.Output = null then
            raise Ada.IO_Exceptions.Data_Error with "Output buffer is full";
         else
            Stream.Output.Write (Stream.Buffer (1 .. Stream.Write_Pos - 1));
            Stream.Output.Flush;
         end if;
         Stream.Write_Pos := 1;
      end if;
   end Flush;

   --  ------------------------------
   --  Fill the buffer by reading the input stream.
   --  Raises Data_Error if there is no input stream;
   --  ------------------------------
   procedure Fill (Stream : in out Buffered_Stream) is
   begin
      if Stream.Input = null then
         Stream.Eof := True;
      else
         Stream.Input.Read (Stream.Buffer (1 .. Stream.Last - 1), Stream.Write_Pos);
         Stream.Eof := Stream.Write_Pos < 1;
         if not Stream.Eof then
            Stream.Write_Pos := Stream.Write_Pos + 1;
         end if;
         Stream.Read_Pos := 1;
      end if;
   end Fill;

   --  ------------------------------
   --  Read one character from the input stream.
   --  ------------------------------
   procedure Read (Stream : in out Buffered_Stream;
                   Char   : out Character) is
   begin
      if Stream.Read_Pos >= Stream.Write_Pos then
         Stream.Fill;
         if Stream.Eof then
            raise Ada.IO_Exceptions.Data_Error with "End of buffer";
         end if;
      end if;
      Char := Character'Val (Stream.Buffer (Stream.Read_Pos));
      Stream.Read_Pos := Stream.Read_Pos + 1;
   end Read;

   --  ------------------------------
   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   --  ------------------------------
   overriding
   procedure Read (Stream : in out Buffered_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is
      Start : Stream_Element_Offset := Into'First;
      Pos   : Stream_Element_Offset := Stream.Read_Pos;
      Avail : Stream_Element_Offset;
      Size  : Stream_Element_Offset;
      Total : Stream_Element_Offset := 0;
   begin
      while Start <= Into'Last loop
         Size := Into'Last - Start + 1;
         Avail := Stream.Write_Pos - Pos;
         if Avail = 0 then
            Stream.Fill;
            Pos := Stream.Read_Pos;
            Avail := Stream.Write_Pos - Pos;
            exit when Avail <= 0;
         end if;
         if Avail < Size then
            Size := Avail;
         end if;
         Into (Start .. Start + Size - 1) := Stream.Buffer (Pos .. Pos + Size - 1);
         Start := Start + Size;
         Pos   := Pos + Size;
         Total := Total + Size;
         Stream.Read_Pos := Pos;
      end loop;
      Last := Total;
   end Read;

   --  ------------------------------
   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   --  ------------------------------
   procedure Read (Stream : in out Buffered_Stream;
                   Into   : in out Ada.Strings.Unbounded.Unbounded_String) is
      Pos   : Stream_Element_Offset := Stream.Read_Pos;
      Avail : Stream_Element_Offset;
   begin
      loop
         Avail := Stream.Write_Pos - Pos;
         if Avail = 0 then
            Stream.Fill;
            if Stream.Eof then
               return;
            end if;
            Pos   := Stream.Read_Pos;
            Avail := Stream.Write_Pos - Pos;
         end if;
         for I in 1 .. Avail loop
            Ada.Strings.Unbounded.Append (Into, Character'Val (Stream.Buffer (Pos)));
            Pos := Pos + 1;
         end loop;
         Stream.Read_Pos := Pos;
      end loop;
   end Read;

   --  ------------------------------
   --  Flush the stream and release the buffer.
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out Buffered_Stream) is
   begin
      if Object.Buffer /= null then
         if Object.Output /= null then
            Object.Flush;
         end if;
         Free_Buffer (Object.Buffer);
      end if;
   end Finalize;

   --  ------------------------------
   --  Returns True if the end of the stream is reached.
   --  ------------------------------
   function Is_Eof (Stream : in Buffered_Stream) return Boolean is
   begin
      return Stream.Eof;
   end Is_Eof;

end Util.Streams.Buffered;

-----------------------------------------------------------------------
--  util-streams-buffered -- Buffered streams Stream utilities
--  Copyright (C) 2010, 2011, 2013, 2014, 2016, 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 Interfaces;
with Ada.IO_Exceptions;
with Ada.Unchecked_Deallocation;
package body Util.Streams.Buffered is

   procedure Free_Buffer is
     new Ada.Unchecked_Deallocation (Object => Stream_Element_Array,
                                     Name   => Buffer_Access);

   --  ------------------------------
   --  Initialize the stream to read or write on the given streams.
   --  An internal buffer is allocated for writing the stream.
   --  ------------------------------
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Output  : in Output_Stream_Access;
                         Input   : in Input_Stream_Access;
                         Size    : in Positive) is
   begin
      Free_Buffer (Stream.Buffer);
      Stream.Last      := Stream_Element_Offset (Size);
      Stream.Buffer    := new Stream_Element_Array (1 .. Stream.Last);
      Stream.Output    := Output;
      Stream.Input     := Input;
      Stream.Write_Pos := 1;
      Stream.Read_Pos  := 1;
      Stream.No_Flush  := False;
   end Initialize;

   --  ------------------------------
   --  Initialize the stream to read from the string.
   --  ------------------------------
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Content : in String) is
   begin
      Free_Buffer (Stream.Buffer);
      Stream.Last      := Stream_Element_Offset (Content'Length);
      Stream.Buffer    := new Stream_Element_Array (1 .. Content'Length);
      Stream.Output    := null;
      Stream.Input     := null;
      Stream.Write_Pos := Stream.Last + 1;
      Stream.Read_Pos  := 1;
      Stream.No_Flush  := False;
      for I in Content'Range loop
         Stream.Buffer (Stream_Element_Offset (I - Content'First + 1))
           := Character'Pos (Content (I));
      end loop;
   end Initialize;

   --  ------------------------------
   --  Initialize the stream with a buffer of Size bytes.
   --  ------------------------------
   procedure Initialize (Stream  : in out Buffered_Stream;
                         Size    : in Positive) is
   begin
      Stream.Initialize (Output => null, Input => null, Size => Size);
      Stream.No_Flush := True;
      Stream.Read_Pos := 1;
   end Initialize;

   --  ------------------------------
   --  Close the sink.
   --  ------------------------------
   overriding
   procedure Close (Stream : in out Buffered_Stream) is
   begin
      if Stream.Output /= null then
         Buffered_Stream'Class (Stream).Flush;
         Stream.Output.Close;
      end if;
   end Close;

   --  ------------------------------
   --  Get the direct access to the buffer.
   --  ------------------------------
   function Get_Buffer (Stream : in Buffered_Stream) return Buffer_Access is
   begin
      return Stream.Buffer;
   end Get_Buffer;

   --  ------------------------------
   --  Get the number of element in the stream.
   --  ------------------------------
   function Get_Size (Stream : in Buffered_Stream) return Natural is
   begin
      return Natural (Stream.Write_Pos - Stream.Read_Pos);
   end Get_Size;

   --  ------------------------------
   --  Write the buffer array to the output stream.
   --  ------------------------------
   overriding
   procedure Write (Stream : in out Buffered_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
      Start : Stream_Element_Offset := Buffer'First;
      Pos   : Stream_Element_Offset := Stream.Write_Pos;
      Avail : Stream_Element_Offset;
      Size  : Stream_Element_Offset;
   begin
      while Start <= Buffer'Last loop
         Size := Buffer'Last - Start + 1;
         Avail := Stream.Last - Pos + 1;
         if Avail = 0 then
            Stream.Flush;
            Pos := Stream.Write_Pos;
            Avail := Stream.Last - Pos + 1;
            if Avail = 0 then
               raise Ada.IO_Exceptions.End_Error with "Buffer is full";
            end if;
         end if;
         if Avail < Size then
            Size := Avail;
         end if;
         Stream.Buffer (Pos .. Pos + Size - 1) := Buffer (Start .. Start + Size - 1);
         Start := Start + Size;
         Pos   := Pos + Size;
         Stream.Write_Pos := Pos;

         --  If we have still more data that the buffer size, flush and write
         --  the buffer directly.
         if Start < Buffer'Last and then Buffer'Last - Start > Stream.Buffer'Length then
            Stream.Flush;
            Stream.Output.Write (Buffer (Start .. Buffer'Last));
            return;
         end if;
      end loop;
   end Write;

   --  ------------------------------
   --  Flush the stream.
   --  ------------------------------
   overriding
   procedure Flush (Stream : in out Buffered_Stream) is
   begin
      if Stream.Write_Pos > 1 and not Stream.No_Flush then
         if Stream.Output = null then
            raise Ada.IO_Exceptions.Data_Error with "Output buffer is full";
         else
            Stream.Output.Write (Stream.Buffer (1 .. Stream.Write_Pos - 1));
            Stream.Output.Flush;
         end if;
         Stream.Write_Pos := 1;
      end if;
   end Flush;

   --  ------------------------------
   --  Fill the buffer by reading the input stream.
   --  Raises Data_Error if there is no input stream;
   --  ------------------------------
   procedure Fill (Stream : in out Buffered_Stream) is
   begin
      if Stream.Input = null then
         Stream.Eof := True;
      else
         Stream.Input.Read (Stream.Buffer (1 .. Stream.Last - 1), Stream.Write_Pos);
         Stream.Eof := Stream.Write_Pos < 1;
         if not Stream.Eof then
            Stream.Write_Pos := Stream.Write_Pos + 1;
         end if;
         Stream.Read_Pos := 1;
      end if;
   end Fill;

   --  ------------------------------
   --  Read one character from the input stream.
   --  ------------------------------
   procedure Read (Stream : in out Buffered_Stream;
                   Char   : out Character) is
   begin
      if Stream.Read_Pos >= Stream.Write_Pos then
         Stream.Fill;
         if Stream.Eof then
            raise Ada.IO_Exceptions.Data_Error with "End of buffer";
         end if;
      end if;
      Char := Character'Val (Stream.Buffer (Stream.Read_Pos));
      Stream.Read_Pos := Stream.Read_Pos + 1;
   end Read;

   --  ------------------------------
   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   --  ------------------------------
   overriding
   procedure Read (Stream : in out Buffered_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is
      Start : Stream_Element_Offset := Into'First;
      Pos   : Stream_Element_Offset := Stream.Read_Pos;
      Avail : Stream_Element_Offset;
      Size  : Stream_Element_Offset;
      Total : Stream_Element_Offset := 0;
   begin
      while Start <= Into'Last loop
         Size := Into'Last - Start + 1;
         Avail := Stream.Write_Pos - Pos;
         if Avail = 0 then
            Stream.Fill;
            Pos := Stream.Read_Pos;
            Avail := Stream.Write_Pos - Pos;
            exit when Avail <= 0;
         end if;
         if Avail < Size then
            Size := Avail;
         end if;
         Into (Start .. Start + Size - 1) := Stream.Buffer (Pos .. Pos + Size - 1);
         Start := Start + Size;
         Pos   := Pos + Size;
         Total := Total + Size;
         Stream.Read_Pos := Pos;
      end loop;
      Last := Total;
   end Read;

   --  ------------------------------
   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   --  ------------------------------
   procedure Read (Stream : in out Buffered_Stream;
                   Into   : in out Ada.Strings.Unbounded.Unbounded_String) is
      Pos   : Stream_Element_Offset := Stream.Read_Pos;
      Avail : Stream_Element_Offset;
   begin
      loop
         Avail := Stream.Write_Pos - Pos;
         if Avail = 0 then
            Stream.Fill;
            if Stream.Eof then
               return;
            end if;
            Pos   := Stream.Read_Pos;
            Avail := Stream.Write_Pos - Pos;
         end if;
         for I in 1 .. Avail loop
            Ada.Strings.Unbounded.Append (Into, Character'Val (Stream.Buffer (Pos)));
            Pos := Pos + 1;
         end loop;
         Stream.Read_Pos := Pos;
      end loop;
   end Read;

   --  ------------------------------
   --  Flush the stream and release the buffer.
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out Buffered_Stream) is
   begin
      if Object.Buffer /= null then
         if Object.Output /= null then
            Object.Flush;
         end if;
         Free_Buffer (Object.Buffer);
      end if;
   end Finalize;

   --  ------------------------------
   --  Returns True if the end of the stream is reached.
   --  ------------------------------
   function Is_Eof (Stream : in Buffered_Stream) return Boolean is
   begin
      return Stream.Eof;
   end Is_Eof;

end Util.Streams.Buffered;

Refactor Buffered_Stream and Print_Stream - move character related Write operation to the Texts package (Print_Stream)


-----------------------------------------------------------------------
--  json -- JSON Reader
--  Copyright (C) 2010, 2011, 2014, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with Ada.Command_Line;
with Util.Serialize.IO.JSON;
with Ada.Containers;
with Mapping;
with Util.Serialize.Mappers.Vector_Mapper;
with Util.Streams.Texts;
with Util.Streams.Buffered;
procedure Json is

   use Util.Streams.Buffered;
   use Ada.Strings.Unbounded;
   use type Mapping.Person_Access;
   use type Ada.Containers.Count_Type;
   use Mapping;

   Reader : Util.Serialize.IO.JSON.Parser;
   Mapper : Util.Serialize.Mappers.Processing;

   Count  : constant Natural := Ada.Command_Line.Argument_Count;

   package Person_Vector_Mapper is
     new Util.Serialize.Mappers.Vector_Mapper (Vectors        => Person_Vector,
                                               Element_Mapper => Person_Mapper);

   subtype Person_Vector_Context is Person_Vector_Mapper.Vector_Data;

   --  Mapping for a list of Person records (stored as a Vector).
   Person_Vector_Mapping : aliased Person_Vector_Mapper.Mapper;

   procedure Print (P : in Mapping.Person_Vector.Cursor);
   procedure Print (P : in Mapping.Person);

   procedure Print (P : in Mapping.Person) is
   begin
      Ada.Text_IO.Put_Line ("Name       : " & To_String (P.Name));
      Ada.Text_IO.Put_Line ("first_name : " & To_String (P.First_Name));
      Ada.Text_IO.Put_Line ("last_name  : " & To_String (P.Last_Name));
      Ada.Text_IO.Put_Line ("Age        : " & Natural'Image (P.Age));
      Ada.Text_IO.Put_Line ("Street     : " & To_String (P.Addr.Street));
      Ada.Text_IO.Put_Line ("City       : " & To_String (P.Addr.City));
      Ada.Text_IO.Put_Line ("Zip        : " & Natural'Image (P.Addr.Zip));
      Ada.Text_IO.Put_Line ("Country    : " & To_String (P.Addr.Country));
      Ada.Text_IO.Put_Line ("Info       : " & To_String (P.Addr.Info.Name)
                            & "=" & To_String (P.Addr.Info.Value));
   end Print;

   procedure Print (P : in Mapping.Person_Vector.Cursor) is
   begin
      Print (Mapping.Person_Vector.Element (P));
   end Print;

begin
   if Count = 0 then
      Ada.Text_IO.Put_Line ("Usage: json file...");
      return;
   end if;

   Person_Vector_Mapping.Set_Mapping (Mapping.Get_Person_Mapper);
   Mapper.Add_Mapping ("/list", Person_Vector_Mapping'Unchecked_Access);
   Mapper.Add_Mapping ("/person", Mapping.Get_Person_Mapper.all'Access);
   for I in 1 .. Count loop
      declare
         S    : constant String := Ada.Command_Line.Argument (I);

         List : aliased Mapping.Person_Vector.Vector;
         P    : aliased Mapping.Person;
      begin
         Person_Vector_Mapper.Set_Context (Mapper, List'Unchecked_Access);
         Mapping.Person_Mapper.Set_Context (Mapper, P'Unchecked_Access);
         Reader.Parse (S, Mapper);

         --  The list now contains our elements.
         List.Iterate (Process => Print'Access);
         if List.Length = 0 then
            Print (P);
         end if;

         declare
            Buffer : aliased Util.Streams.Buffered.Buffered_Stream;
            Print  : aliased Util.Streams.Texts.Print_Stream;
            Output : Util.Serialize.IO.JSON.Output_Stream;
         begin
            Buffer.Initialize (Size => 10000);
            Print.Initialize (Buffer'Unchecked_Access);
            Output.Initialize (Print'Unchecked_Access);
            Mapping.Get_Person_Mapper.Write (Output, P);
            Ada.Text_IO.Put_Line ("Person: "
                                  & Util.Streams.Texts.To_String (Print));
         end;

         declare
            Buffer : aliased Util.Streams.Buffered.Buffered_Stream;
            Print  : aliased Util.Streams.Texts.Print_Stream;
            Output : Util.Serialize.IO.JSON.Output_Stream;
         begin
            Buffer.Initialize (Size => 10000);
            Print.Initialize (Buffer'Unchecked_Access);
            Output.Initialize (Print'Unchecked_Access);
            Output.Write ("{""list"":");
            Person_Vector_Mapping.Write (Output, List);
            Output.Write ("}");

            Ada.Text_IO.Put_Line ("IO:");
            Ada.Text_IO.Put_Line (Util.Streams.Texts.To_String (Buffered_Stream (Print)));
         end;
      end;
   end loop;
end Json;

-----------------------------------------------------------------------
--  json -- JSON Reader
--  Copyright (C) 2010, 2011, 2014, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with Ada.Command_Line;
with Util.Serialize.IO.JSON;
with Ada.Containers;
with Mapping;
with Util.Serialize.Mappers.Vector_Mapper;
with Util.Streams.Texts;
with Util.Streams.Buffered;
procedure Json is

   use Util.Streams.Buffered;
   use Ada.Strings.Unbounded;
   use type Mapping.Person_Access;
   use type Ada.Containers.Count_Type;
   use Mapping;

   Reader : Util.Serialize.IO.JSON.Parser;
   Mapper : Util.Serialize.Mappers.Processing;

   Count  : constant Natural := Ada.Command_Line.Argument_Count;

   package Person_Vector_Mapper is
     new Util.Serialize.Mappers.Vector_Mapper (Vectors        => Person_Vector,
                                               Element_Mapper => Person_Mapper);

   subtype Person_Vector_Context is Person_Vector_Mapper.Vector_Data;

   --  Mapping for a list of Person records (stored as a Vector).
   Person_Vector_Mapping : aliased Person_Vector_Mapper.Mapper;

   procedure Print (P : in Mapping.Person_Vector.Cursor);
   procedure Print (P : in Mapping.Person);

   procedure Print (P : in Mapping.Person) is
   begin
      Ada.Text_IO.Put_Line ("Name       : " & To_String (P.Name));
      Ada.Text_IO.Put_Line ("first_name : " & To_String (P.First_Name));
      Ada.Text_IO.Put_Line ("last_name  : " & To_String (P.Last_Name));
      Ada.Text_IO.Put_Line ("Age        : " & Natural'Image (P.Age));
      Ada.Text_IO.Put_Line ("Street     : " & To_String (P.Addr.Street));
      Ada.Text_IO.Put_Line ("City       : " & To_String (P.Addr.City));
      Ada.Text_IO.Put_Line ("Zip        : " & Natural'Image (P.Addr.Zip));
      Ada.Text_IO.Put_Line ("Country    : " & To_String (P.Addr.Country));
      Ada.Text_IO.Put_Line ("Info       : " & To_String (P.Addr.Info.Name)
                            & "=" & To_String (P.Addr.Info.Value));
   end Print;

   procedure Print (P : in Mapping.Person_Vector.Cursor) is
   begin
      Print (Mapping.Person_Vector.Element (P));
   end Print;

begin
   if Count = 0 then
      Ada.Text_IO.Put_Line ("Usage: json file...");
      return;
   end if;

   Person_Vector_Mapping.Set_Mapping (Mapping.Get_Person_Mapper);
   Mapper.Add_Mapping ("/list", Person_Vector_Mapping'Unchecked_Access);
   Mapper.Add_Mapping ("/person", Mapping.Get_Person_Mapper.all'Access);
   for I in 1 .. Count loop
      declare
         S    : constant String := Ada.Command_Line.Argument (I);

         List : aliased Mapping.Person_Vector.Vector;
         P    : aliased Mapping.Person;
      begin
         Person_Vector_Mapper.Set_Context (Mapper, List'Unchecked_Access);
         Mapping.Person_Mapper.Set_Context (Mapper, P'Unchecked_Access);
         Reader.Parse (S, Mapper);

         --  The list now contains our elements.
         List.Iterate (Process => Print'Access);
         if List.Length = 0 then
            Print (P);
         end if;

         declare
            Buffer : aliased Util.Streams.Buffered.Output_Buffer_Stream;
            Print  : aliased Util.Streams.Texts.Print_Stream;
            Output : Util.Serialize.IO.JSON.Output_Stream;
         begin
            Buffer.Initialize (Size => 10000);
            Print.Initialize (Buffer'Unchecked_Access);
            Output.Initialize (Print'Unchecked_Access);
            Mapping.Get_Person_Mapper.Write (Output, P);
            Ada.Text_IO.Put_Line ("Person: "
                                  & Util.Streams.Texts.To_String (Print));
         end;

         declare
            Buffer : aliased Util.Streams.Buffered.Output_Buffer_Stream;
            Print  : aliased Util.Streams.Texts.Print_Stream;
            Output : Util.Serialize.IO.JSON.Output_Stream;
         begin
            Buffer.Initialize (Size => 10000);
            Print.Initialize (Buffer'Unchecked_Access);
            Output.Initialize (Print'Unchecked_Access);
            Output.Write ("{""list"":");
            Person_Vector_Mapping.Write (Output, List);
            Output.Write ("}");

            Ada.Text_IO.Put_Line ("IO:");
            Ada.Text_IO.Put_Line (Util.Streams.Texts.To_String (Print));
         end;
      end;
   end loop;
end Json;

Use the Output_Buffer_Stream

Use the Output_Buffer_Stream


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

   type Reader is limited new Util.Serialize.IO.Reader with private;

   --  Start a document.
   overriding
   procedure Start_Document (Handler : in out Reader);

   --  Start a new object associated with the given name.  This is called when
   --  the '{' is reached.  The reader must be updated so that the next
   --  <b>Set_Member</b> procedure will associate the name/value pair on the
   --  new object.
   overriding
   procedure Start_Object (Handler : in out Reader;
                           Name    : in String;
                           Logger  : in out Util.Log.Logging'Class);

   --  Finish an object associated with the given name.  The reader must be
   --  updated to be associated with the previous object.
   overriding
   procedure Finish_Object (Handler : in out Reader;
                            Name    : in String;
                            Logger  : in out Util.Log.Logging'Class);

   overriding
   procedure Start_Array (Handler : in out Reader;
                          Name    : in String;
                          Logger  : in out Util.Log.Logging'Class);

   overriding
   procedure Finish_Array (Handler : in out Reader;
                           Name    : in String;
                           Count   : in Natural;
                           Logger  : in out Util.Log.Logging'Class);

   --  Set the name/value pair on the current object.  For each active mapping,
   --  find whether a rule matches our name and execute it.
   overriding
   procedure Set_Member (Handler   : in out Reader;
                         Name      : in String;
                         Value     : in Util.Beans.Objects.Object;
                         Logger    : in out Util.Log.Logging'Class;
                         Attribute : in Boolean := False);

private

   type Object_Context is record
      Map  : Util.Beans.Objects.Maps.Map_Bean_Access;
      List : Util.Beans.Objects.Vectors.Vector_Bean_Access;
   end record;
   type Object_Context_Access is access all Object_Context;

   package Object_Stack is new Util.Stacks (Element_Type        => Object_Context,
                                            Element_Type_Access => Object_Context_Access);

   type Reader is limited new Util.Serialize.IO.Reader with record
      Context  : Object_Stack.Stack;
   end record;

end Util.Beans.Objects.Readers;

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

   type Reader is limited new Util.Serialize.IO.Reader with private;

   --  Start a document.
   overriding
   procedure Start_Document (Handler : in out Reader);

   --  Start a new object associated with the given name.  This is called when
   --  the '{' is reached.  The reader must be updated so that the next
   --  <b>Set_Member</b> procedure will associate the name/value pair on the
   --  new object.
   overriding
   procedure Start_Object (Handler : in out Reader;
                           Name    : in String;
                           Logger  : in out Util.Log.Logging'Class);

   --  Finish an object associated with the given name.  The reader must be
   --  updated to be associated with the previous object.
   overriding
   procedure Finish_Object (Handler : in out Reader;
                            Name    : in String;
                            Logger  : in out Util.Log.Logging'Class);

   overriding
   procedure Start_Array (Handler : in out Reader;
                          Name    : in String;
                          Logger  : in out Util.Log.Logging'Class);

   overriding
   procedure Finish_Array (Handler : in out Reader;
                           Name    : in String;
                           Count   : in Natural;
                           Logger  : in out Util.Log.Logging'Class);

   --  Set the name/value pair on the current object.  For each active mapping,
   --  find whether a rule matches our name and execute it.
   overriding
   procedure Set_Member (Handler   : in out Reader;
                         Name      : in String;
                         Value     : in Util.Beans.Objects.Object;
                         Logger    : in out Util.Log.Logging'Class;
                         Attribute : in Boolean := False);

   --  Get the root object.
   function Get_Root (Handler : in Reader) return Object;

private

   type Object_Context is record
      Map  : Util.Beans.Objects.Maps.Map_Bean_Access;
      List : Util.Beans.Objects.Vectors.Vector_Bean_Access;
   end record;
   type Object_Context_Access is access all Object_Context;

   package Object_Stack is new Util.Stacks (Element_Type        => Object_Context,
                                            Element_Type_Access => Object_Context_Access);

   type Reader is limited new Util.Serialize.IO.Reader with record
      Context  : Object_Stack.Stack;
      Root     : Util.Beans.Objects.Object;
   end record;

end Util.Beans.Objects.Readers;

Declare the Get_Root function and add a Root member to the Reader type


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

   use Interfaces;

   type Attribute_Type is (T_UINT8,
                           T_UINT16,
                           T_UINT32,
                           T_UINT64,
                           T_POINTER,
                           T_PROBE,
                           T_FRAME,
                           T_THREAD,
                           T_TIME,
                           T_SIZE_T);

   type Event_Type is (EVENT_BEGIN, EVENT_END, EVENT_MALLOC, EVENT_FREE, EVENT_REALLOC);

   subtype Internal_Reference is Natural;

   type Attribute is record
      Name : Util.Strings.Name_Access;
      Size : Natural            := 0;
      Kind : Attribute_Type     := T_UINT8;
      Ref  : Internal_Reference := 0;
   end record;
   --  Logical description of an event attribute.

   type Attribute_Table is array (Natural range <>) of Attribute;
   type Attribute_Table_Ptr is access all Attribute_Table;
   type Const_Attribute_Table_Access is access constant Attribute_Table;

   type Event_Description (Nb_Attributes : Natural) is record
      Name : Ada.Strings.Unbounded.Unbounded_String;
      Id   : Unsigned_32;
      Kind : Event_Type;
      Def  : Attribute_Table (1 .. Nb_Attributes);
   end record;
   type Event_Description_Access is access all Event_Description;

   subtype Addr is MAT.Types.Uint32;
   type Frame_Table is array (Natural range <>) of Addr;

   type Rusage_Info is record
      Minflt : Unsigned_32;
      Majflt : Unsigned_32;
      Nswap  : Unsigned_32;
   end record;

   type Frame_Info (Depth : Natural) is record
      Time      : MAT.Types.Target_Time;
      Thread    : MAT.Types.Target_Thread_Ref;
      Stack     : MAT.Types.Target_Addr;
      Rusage    : Rusage_Info;
      Cur_Depth : Natural;
      Frame     : Frame_Table (1 .. Depth);
   end record;

   type Event_Data is record
      Kind  : Attribute_Type;
      U8    : MAT.Types.Uint8;
      U16   : MAT.Types.Uint16;
      U32   : MAT.Types.Uint32;
      U64   : MAT.Types.Uint64;
      Probe : Frame_Info (Depth => 10);
   end record;

   type Event_Data_Table is array (Natural range <>) of Event_Data;

   procedure Dump (Table : in Event_Data_Table;
                   Def   : in Event_Description);

end MAT.Events;

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

   use Interfaces;

   type Attribute_Type is (T_UINT8,
                           T_UINT16,
                           T_UINT32,
                           T_UINT64,
                           T_POINTER,
                           T_PROBE,
                           T_FRAME,
                           T_THREAD,
                           T_TIME,
                           T_SIZE_T);

   type Event_Type is (EVENT_BEGIN, EVENT_END, EVENT_MALLOC, EVENT_FREE, EVENT_REALLOC);

   subtype Internal_Reference is Natural;

   type Attribute is record
      Name : Util.Strings.Name_Access;
      Size : Natural            := 0;
      Kind : Attribute_Type     := T_UINT8;
      Ref  : Internal_Reference := 0;
   end record;
   --  Logical description of an event attribute.

   type Attribute_Table is array (Natural range <>) of Attribute;
   type Attribute_Table_Ptr is access all Attribute_Table;
   type Const_Attribute_Table_Access is access constant Attribute_Table;

   type Event_Description (Nb_Attributes : Natural) is record
      Name : Ada.Strings.Unbounded.Unbounded_String;
      Id   : Unsigned_32;
      Kind : Event_Type;
      Def  : Attribute_Table (1 .. Nb_Attributes);
   end record;
   type Event_Description_Access is access all Event_Description;

--     subtype Addr is MAT.Types.Uint32;
   type Frame_Table is array (Natural range <>) of MAT.Types.Target_Addr;

   type Rusage_Info is record
      Minflt : Unsigned_32;
      Majflt : Unsigned_32;
      Nswap  : Unsigned_32;
   end record;

   type Frame_Info (Depth : Natural) is record
      Time      : MAT.Types.Target_Time;
      Thread    : MAT.Types.Target_Thread_Ref;
      Stack     : MAT.Types.Target_Addr;
      Rusage    : Rusage_Info;
      Cur_Depth : Natural;
      Frame     : Frame_Table (1 .. Depth);
   end record;

   type Event_Data is record
      Kind  : Attribute_Type;
      U8    : MAT.Types.Uint8;
      U16   : MAT.Types.Uint16;
      U32   : MAT.Types.Uint32;
      U64   : MAT.Types.Uint64;
      Probe : Frame_Info (Depth => 10);
   end record;

   type Event_Data_Table is array (Natural range <>) of Event_Data;

   procedure Dump (Table : in Event_Data_Table;
                   Def   : in Event_Description);

end MAT.Events;

Use MAT.Types.Target_Addr for the frame address


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

package body MAT.Consoles.Text is

   --  ------------------------------
   --  Report an error message.
   --  ------------------------------
   overriding
   procedure Error (Console : in out Console_Type;
                    Message : in String) is
      pragma Unreferenced (Console);
   begin
      Ada.Text_IO.Put_Line (Message);
   end Error;

   --  ------------------------------
   --  Report a notice message.
   --  ------------------------------
   overriding
   procedure Notice (Console : in out Console_Type;
                     Kind    : in Notice_Type;
                     Message : in String) is
      pragma Unreferenced (Console, Kind);
   begin
      Ada.Text_IO.Put_Line (Message);
   end Notice;

   --  ------------------------------
   --  Print the field value for the given field.
   --  ------------------------------
   overriding
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in String) is
      use type Ada.Text_IO.Count;

      Pos : Ada.Text_IO.Count := Ada.Text_IO.Count (Console.Cols (Field));
   begin
      if Pos > 1 then
         Pos := Pos + Ada.Text_IO.Count (Console.Sizes (Field));
         if Pos > Value'Length then
            Ada.Text_IO.Set_Col (Pos - Value'Length);
         else
            Ada.Text_IO.Set_Col (Ada.Text_IO.Count (Console.Cols (Field)));
            Ada.Text_IO.Put (Value (Value'Last - Console.Sizes (Field) .. Value'Last));
            return;
         end if;
      end if;
      Ada.Text_IO.Put (Value);
   end Print_Field;

   --  ------------------------------
   --  Print the title for the given field.
   --  ------------------------------
   overriding
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String) is
      use type Ada.Text_IO.Count;

      Pos : constant Ada.Text_IO.Count := Ada.Text_IO.Count (Console.Cols (Field));
   begin
      if Pos > 1 then
         Ada.Text_IO.Set_Col (Pos + Ada.Text_IO.Count (Console.Sizes (Field)) - Title'Length);
      end if;
      Ada.Text_IO.Put (Title);
   end Print_Title;

   --  ------------------------------
   --  Start a new title in a report.
   --  ------------------------------
   overriding
   procedure Start_Title (Console : in out Console_Type) is
   begin
      Console.Field_Count := 0;
      Console.Sizes := (others => 0);
      Console.Cols := (others => 1);
   end Start_Title;

   --  ------------------------------
   --  Finish a new title in a report.
   --  ------------------------------
   procedure End_Title (Console : in out Console_Type) is
      pragma Unreferenced (Console);
   begin
      Ada.Text_IO.New_Line;
   end End_Title;

   --  ------------------------------
   --  Start a new row in a report.
   --  ------------------------------
   overriding
   procedure Start_Row (Console : in out Console_Type) is
      pragma Unreferenced (Console);
   begin
      null;
   end Start_Row;

   --  ------------------------------
   --  Finish a new row in a report.
   --  ------------------------------
   overriding
   procedure End_Row (Console : in out Console_Type) is
      pragma Unreferenced (Console);
   begin
      Ada.Text_IO.New_Line;
   end End_Row;

end MAT.Consoles.Text;

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

package body MAT.Consoles.Text is

   --  ------------------------------
   --  Report an error message.
   --  ------------------------------
   overriding
   procedure Error (Console : in out Console_Type;
                    Message : in String) is
      pragma Unreferenced (Console);
   begin
      Ada.Text_IO.Put_Line (Message);
   end Error;

   --  ------------------------------
   --  Report a notice message.
   --  ------------------------------
   overriding
   procedure Notice (Console : in out Console_Type;
                     Kind    : in Notice_Type;
                     Message : in String) is
      pragma Unreferenced (Console, Kind);
   begin
      Ada.Text_IO.Put_Line (Message);
   end Notice;

   --  ------------------------------
   --  Print the field value for the given field.
   --  ------------------------------
   overriding
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Value   : in String;
                          Justify : in Justify_Type := J_LEFT) is
      use type Ada.Text_IO.Count;

      Pos   : Ada.Text_IO.Count := Ada.Text_IO.Count (Console.Cols (Field));
      Size  : constant Natural := Console.Sizes (Field);
      Start : Natural := Value'First;
      Last  : Natural := Value'Last;
      Pad   : Natural := 0;
      Fill  : Natural := 0;
   begin
      case Justify is
         when J_LEFT =>
            if Value'Length < Size then
               Pad := Size - Value'Length;
            else
               Start := Last - Size + 1;
            end if;

         when J_RIGHT =>
            if Value'Length < Size then
               Fill := Size - Value'Length;
            else
               Start := Last - Size + 1;
            end if;

         when J_CENTER =>
            if Value'Length < Size then
               Pad  := (Size - Value'Length) / 2;
               Fill := Size - Value'Length - Pad;
            else
               Start := Last - Size + 1;
            end if;

         when J_RIGHT_NO_FILL =>
            if Value'Length >= Size then
               Start := Last - Size + 1;
            end if;

      end case;
      if Pad > 0 then
         Ada.Text_IO.Set_Col (Pos + Ada.Text_IO.Count (Pad));
      end if;
      Ada.Text_IO.Put (Value (Start .. Last));
      if Fill > 0 then
         Ada.Text_IO.Set_Col (Pos + Ada.Text_IO.Count (Pad + Fill + Last - Start));
      end if;
   end Print_Field;

   --  ------------------------------
   --  Print the title for the given field.
   --  ------------------------------
   overriding
   procedure Print_Title (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Title   : in String) is
      use type Ada.Text_IO.Count;

      Pos : constant Ada.Text_IO.Count := Ada.Text_IO.Count (Console.Cols (Field));
   begin
      if Pos > 1 then
         Ada.Text_IO.Set_Col (Pos + Ada.Text_IO.Count (Console.Sizes (Field)) - Title'Length);
      end if;
      Ada.Text_IO.Put (Title);
   end Print_Title;

   --  ------------------------------
   --  Start a new title in a report.
   --  ------------------------------
   overriding
   procedure Start_Title (Console : in out Console_Type) is
   begin
      Console.Field_Count := 0;
      Console.Sizes := (others => 0);
      Console.Cols := (others => 1);
   end Start_Title;

   --  ------------------------------
   --  Finish a new title in a report.
   --  ------------------------------
   procedure End_Title (Console : in out Console_Type) is
      pragma Unreferenced (Console);
   begin
      Ada.Text_IO.New_Line;
   end End_Title;

   --  ------------------------------
   --  Start a new row in a report.
   --  ------------------------------
   overriding
   procedure Start_Row (Console : in out Console_Type) is
      pragma Unreferenced (Console);
   begin
      null;
   end Start_Row;

   --  ------------------------------
   --  Finish a new row in a report.
   --  ------------------------------
   overriding
   procedure End_Row (Console : in out Console_Type) is
      pragma Unreferenced (Console);
   begin
      Ada.Text_IO.New_Line;
   end End_Row;

end MAT.Consoles.Text;

Use the Justify parameter to format the column


-----------------------------------------------------------------------
--  EL.Contexts -- Contexts for evaluating an expression
--  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.
-----------------------------------------------------------------------

--  The expression context provides information to resolve runtime
--  information when evaluating an expression.  The context provides
--  a resolver whose role is to find variables given their name.

with EL.Objects;
with Util.Beans.Basic;
with Ada.Strings.Unbounded;
with Ada.Exceptions;
with EL.Functions;
limited with EL.Variables;
package EL.Contexts is

   pragma Preelaborate;

   use Ada.Strings.Unbounded;

   type ELContext;

   --  ------------------------------
   --  Expression Resolver
   --  ------------------------------
   --  Enables customization of variable and property resolution
   --  behavior for EL expression evaluation.
   type ELResolver is limited interface;
   type ELResolver_Access is access all ELResolver'Class;

   --  Get the value associated with a base object and a given property.
   function Get_Value (Resolver : ELResolver;
                       Context  : ELContext'Class;
                       Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                       Name     : Unbounded_String) return EL.Objects.Object is abstract;

   --  Set the value associated with a base object and a given property.
   procedure Set_Value (Resolver : in out ELResolver;
                        Context  : in ELContext'Class;
                        Base     : access Util.Beans.Basic.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in EL.Objects.Object) is abstract;

   --  ------------------------------
   --  Expression Context
   --  ------------------------------
   --  Context information for expression evaluation.
   type ELContext is limited interface;
   type ELContext_Access is access all ELContext'Class;

   --  Retrieves the ELResolver associated with this ELcontext.
   function Get_Resolver (Context : ELContext) return ELResolver_Access is abstract;

   --  Retrieves the VariableMapper associated with this ELContext.
   function Get_Variable_Mapper (Context : ELContext)
                            return access EL.Variables.Variable_Mapper'Class is abstract;

   --  Set the variable mapper associated with this ELContext.
   procedure Set_Variable_Mapper (Context : in out ELContext;
                                  Mapper  : access EL.Variables.Variable_Mapper'Class)
     is abstract;

   --  Retrieves the FunctionMapper associated with this ELContext.
   --  The FunctionMapper is only used when parsing an expression.
   function Get_Function_Mapper (Context : ELContext)
                                 return EL.Functions.Function_Mapper_Access is abstract;

   --  Set the function mapper associated with this ELContext.
   procedure Set_Function_Mapper (Context : in out ELContext;
                                  Mapper  : access EL.Functions.Function_Mapper'Class)
     is abstract;

   --  Handle the exception during expression evaluation.  The handler can ignore the
   --  exception or raise it.
   procedure Handle_Exception (Context : in ELContext;
                               Ex      : in Ada.Exceptions.Exception_Occurrence) is abstract;

end EL.Contexts;

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

--  The expression context provides information to resolve runtime
--  information when evaluating an expression.  The context provides
--  a resolver whose role is to find variables given their name.

with EL.Objects;
with Util.Beans.Basic;
with Ada.Strings.Unbounded;
with Ada.Exceptions;
with EL.Functions;
limited with EL.Variables;
package EL.Contexts is

   pragma Preelaborate;

   use Ada.Strings.Unbounded;

   type ELContext is limited interface;

   --  ------------------------------
   --  Expression Resolver
   --  ------------------------------
   --  Enables customization of variable and property resolution
   --  behavior for EL expression evaluation.
   type ELResolver is limited interface;
   type ELResolver_Access is access all ELResolver'Class;

   --  Get the value associated with a base object and a given property.
   function Get_Value (Resolver : ELResolver;
                       Context  : ELContext'Class;
                       Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                       Name     : Unbounded_String) return EL.Objects.Object is abstract;

   --  Set the value associated with a base object and a given property.
   procedure Set_Value (Resolver : in out ELResolver;
                        Context  : in ELContext'Class;
                        Base     : access Util.Beans.Basic.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in EL.Objects.Object) is abstract;

   --  ------------------------------
   --  Expression Context
   --  ------------------------------
   --  Context information for expression evaluation.
   type ELContext_Access is access all ELContext'Class;

   --  Retrieves the ELResolver associated with this ELcontext.
   function Get_Resolver (Context : ELContext) return ELResolver_Access is abstract;

   --  Retrieves the VariableMapper associated with this ELContext.
   function Get_Variable_Mapper (Context : ELContext)
                            return access EL.Variables.Variable_Mapper'Class is abstract;

   --  Set the variable mapper associated with this ELContext.
   procedure Set_Variable_Mapper (Context : in out ELContext;
                                  Mapper  : access EL.Variables.Variable_Mapper'Class)
     is abstract;

   --  Retrieves the FunctionMapper associated with this ELContext.
   --  The FunctionMapper is only used when parsing an expression.
   function Get_Function_Mapper (Context : ELContext)
                                 return EL.Functions.Function_Mapper_Access is abstract;

   --  Set the function mapper associated with this ELContext.
   procedure Set_Function_Mapper (Context : in out ELContext;
                                  Mapper  : access EL.Functions.Function_Mapper'Class)
     is abstract;

   --  Handle the exception during expression evaluation.  The handler can ignore the
   --  exception or raise it.
   procedure Handle_Exception (Context : in ELContext;
                               Ex      : in Ada.Exceptions.Exception_Occurrence) is abstract;

end EL.Contexts;

Fix compilation warning with GNAT 2021

Fix compilation warning with GNAT 2021


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

package HAL.I2C is

   type I2C_Status is
     (Ok,
      Err_Error,
      Err_Timeout,
      Busy);

   type I2C_Data is array (Natural range <>) of Byte;

   type I2C_Memory_Address_Size is
     (Memory_Size_8b,
      Memory_Size_16b);

   subtype I2C_Address is UInt10;

   type I2C_Port is limited interface;

   type Any_I2C_Port is access all I2C_Port'Class;

   procedure Master_Transmit
     (This    : in out I2C_Port;
      Addr    : I2C_Address;
      Data    : I2C_Data;
      Status  : out I2C_Status;
      Timeout : Natural := 1000) is abstract;

   procedure Master_Receive
     (This    : in out I2C_Port;
      Addr    : I2C_Address;
      Data    : out I2C_Data;
      Status  : out I2C_Status;
      Timeout : Natural := 1000) is abstract;

   procedure Mem_Write
     (This          : in out I2C_Port;
      Addr          : I2C_Address;
      Mem_Addr      : UInt16;
      Mem_Addr_Size : I2C_Memory_Address_Size;
      Data          : I2C_Data;
      Status        : out I2C_Status;
      Timeout       : Natural := 1000) is abstract;

   procedure Mem_Read
     (This          : in out I2C_Port;
      Addr          : I2C_Address;
      Mem_Addr      : UInt16;
      Mem_Addr_Size : I2C_Memory_Address_Size;
      Data          : out I2C_Data;
      Status        : out I2C_Status;
      Timeout       : Natural := 1000) is abstract;

end HAL.I2C;

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

package HAL.I2C is

   type I2C_Status is
     (Ok,
      Err_Error,
      Err_Timeout,
      Busy);

   subtype I2C_Data is Byte_Array;

   type I2C_Memory_Address_Size is
     (Memory_Size_8b,
      Memory_Size_16b);

   subtype I2C_Address is UInt10;

   type I2C_Port is limited interface;

   type Any_I2C_Port is access all I2C_Port'Class;

   procedure Master_Transmit
     (This    : in out I2C_Port;
      Addr    : I2C_Address;
      Data    : I2C_Data;
      Status  : out I2C_Status;
      Timeout : Natural := 1000) is abstract;

   procedure Master_Receive
     (This    : in out I2C_Port;
      Addr    : I2C_Address;
      Data    : out I2C_Data;
      Status  : out I2C_Status;
      Timeout : Natural := 1000) is abstract;

   procedure Mem_Write
     (This          : in out I2C_Port;
      Addr          : I2C_Address;
      Mem_Addr      : UInt16;
      Mem_Addr_Size : I2C_Memory_Address_Size;
      Data          : I2C_Data;
      Status        : out I2C_Status;
      Timeout       : Natural := 1000) is abstract;

   procedure Mem_Read
     (This          : in out I2C_Port;
      Addr          : I2C_Address;
      Mem_Addr      : UInt16;
      Mem_Addr_Size : I2C_Memory_Address_Size;
      Data          : out I2C_Data;
      Status        : out I2C_Status;
      Timeout       : Natural := 1000) is abstract;

end HAL.I2C;

Make the HAL.I2C.I2C_Data a subtype of Byte_Array.

This makes the API more consistent with the rest of the HAL.