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

with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with Ada.IO_Exceptions;
with Ada.Text_IO;

with MAT.Types;
with MAT.Readers.Files;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Frames;
with MAT.Frames.Print;
package body MAT.Commands is

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

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

   Commands : Command_Map.Map;

   --  ------------------------------
   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   --  ------------------------------
   procedure Slot_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
      Iter : MAT.Memory.Allocation_Cursor := Target.Memory.Memory_Slots.First;

      procedure Print (Addr : in MAT.Types.Target_Addr;
                       Slot : in MAT.Memory.Allocation) is
         use type MAT.Frames.Frame_Ptr;
         Backtrace : MAT.Frames.PC_Table := MAT.Frames.Backtrace (Slot.Frame);
      begin
         Ada.Text_IO.Put (MAT.Types.Hex_Image (Addr));
         Ada.Text_IO.Set_Col (14);
         Ada.Text_IO.Put (MAT.Types.Target_Size'Image (Slot.Size));
         Ada.Text_IO.New_Line;
         for I in Backtrace'Range loop
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (Natural'Image (I));
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put_Line (MAT.Types.Hex_Image (Backtrace (I)));
         end loop;
      end Print;

   begin
      while MAT.Memory.Allocation_Maps.Has_Element (Iter) loop
         MAT.Memory.Allocation_Maps.Query_Element (Iter, Print'Access);
         MAT.Memory.Allocation_Maps.Next (Iter);
      end loop;
   end Slot_Command;

   --  ------------------------------
   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   --  ------------------------------
   procedure Sizes_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String) is
      Sizes : MAT.Memory.Targets.Size_Info_Map;
      Iter  : MAT.Memory.Targets.Size_Info_Cursor;
   begin
      MAT.Memory.Targets.Size_Information (Memory => Target.Memory,
                                           Sizes  => Sizes);
      Iter := Sizes.First;
      while MAT.Memory.Targets.Size_Info_Maps.Has_Element (Iter) loop
         declare
            use type MAT.Types.Target_Size;

            Size  : MAT.Types.Target_Size := MAT.Memory.Targets.Size_Info_Maps.Key (Iter);
            Info  : MAT.Memory.Targets.Size_Info_Type := MAT.Memory.Targets.Size_Info_Maps.Element (Iter);
            Total : MAT.Types.Target_Size := Size * MAT.Types.Target_Size (Info.Count);
         begin
            Ada.Text_IO.Put (MAT.Types.Target_Size'Image (Size));
            Ada.Text_IO.Set_Col (20);
            Ada.Text_IO.Put (Natural'Image (Info.Count));
            Ada.Text_IO.Set_Col (30);
            Ada.Text_IO.Put_Line (MAT.Types.Target_Size'Image (Total));
         end;
         MAT.Memory.Targets.Size_Info_Maps.Next (Iter);
      end loop;
   end Sizes_Command;

   --  ------------------------------
   --  Symbol command.
   --  Load the symbols from the binary file.
   --  ------------------------------
   procedure Symbol_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String) is
   begin
      MAT.Symbols.Targets.Open (Target.Symbols, Args);
   end Symbol_Command;

   --  ------------------------------
   --  Exit command.
   --  ------------------------------
   procedure Exit_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
   begin
      raise Stop_Interp;
   end Exit_Command;

   --  ------------------------------
   --  Open a MAT file and read the events.
   --  ------------------------------
   procedure Open_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
      Reader : MAT.Readers.Files.File_Reader_Type;
   begin
      Target.Initialize (Reader);
      Reader.Open (Args);
      Reader.Read_All;

   exception
      when E : Ada.IO_Exceptions.Name_Error =>
         Log.Error ("Cannot open {0}", Args);
   end Open_Command;

   function Get_Command (Line : in String) return String is
      Pos : Natural := Util.Strings.Index (Line, ' ');
   begin
      if Pos <= 0 then
         return Line;
      else
         return Line (Line'First .. Pos - 1);
      end if;
   end Get_Command;

   --  ------------------------------
   --  Execute the command given in the line.
   --  ------------------------------
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String) is
      Command : constant String := Get_Command (Line);
      Index   : constant Natural := Util.Strings.Index (Line, ' ');
      Pos     : constant Command_Map.Cursor := Commands.Find (Command);
   begin
      if Command_Map.Has_Element (Pos) then
         Command_Map.Element (Pos) (Target, Line (Index + 1 .. Line'Last));
      end if;
   end Execute;

begin
   Commands.Insert ("exit", Exit_Command'Access);
   Commands.Insert ("quit", Exit_Command'Access);
   Commands.Insert ("open", Open_Command'Access);
   Commands.Insert ("sizes", Sizes_Command'Access);
   Commands.Insert ("symbol", Symbol_Command'Access);
   Commands.Insert ("slots", Slot_Command'Access);
end MAT.Commands;

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

with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with Ada.IO_Exceptions;
with Ada.Text_IO;
with Ada.Strings.Unbounded;

with MAT.Types;
with MAT.Readers.Files;
with MAT.Memory.Targets;
with MAT.Symbols.Targets;
with MAT.Frames;
with MAT.Frames.Print;
package body MAT.Commands is

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

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

   Commands : Command_Map.Map;

   --  ------------------------------
   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   --  ------------------------------
   procedure Slot_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
      Iter : MAT.Memory.Allocation_Cursor := Target.Memory.Memory_Slots.First;

      procedure Print (Addr : in MAT.Types.Target_Addr;
                       Slot : in MAT.Memory.Allocation) is
         use type MAT.Frames.Frame_Ptr;
         Backtrace : MAT.Frames.PC_Table := MAT.Frames.Backtrace (Slot.Frame);

         Name : Ada.Strings.Unbounded.Unbounded_String;
         Func : Ada.Strings.Unbounded.Unbounded_String;
         Line : Natural;
      begin
         Ada.Text_IO.Put (MAT.Types.Hex_Image (Addr));
         Ada.Text_IO.Set_Col (14);
         Ada.Text_IO.Put (MAT.Types.Target_Size'Image (Slot.Size));
         Ada.Text_IO.New_Line;
         for I in Backtrace'Range loop
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (Natural'Image (I));
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (MAT.Types.Hex_Image (Backtrace (I)));
            MAT.Symbols.Targets.Find_Nearest_Line (Symbols => Target.Symbols,
                                                   Addr    => Backtrace (I),
                                                   Name    => Name,
                                                   Func    => Func,
                                                   Line    => Line);
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (Ada.Strings.Unbounded.To_String (Func));
            Ada.Text_IO.Put (" ");
            Ada.Text_IO.Put (Ada.Strings.Unbounded.To_String (Name));
            if Line /= 0 then
               Ada.Text_IO.Put (":");
               Ada.Text_IO.Put (Util.Strings.Image (Line));
            end if;
            Ada.Text_IO.New_Line;
         end loop;
      end Print;

   begin
      while MAT.Memory.Allocation_Maps.Has_Element (Iter) loop
         MAT.Memory.Allocation_Maps.Query_Element (Iter, Print'Access);
         MAT.Memory.Allocation_Maps.Next (Iter);
      end loop;
   end Slot_Command;

   --  ------------------------------
   --  Sizes command.
   --  Collect statistics about the used memory slots and report the different slot
   --  sizes with count.
   --  ------------------------------
   procedure Sizes_Command (Target : in out MAT.Targets.Target_Type'Class;
                            Args   : in String) is
      Sizes : MAT.Memory.Targets.Size_Info_Map;
      Iter  : MAT.Memory.Targets.Size_Info_Cursor;
   begin
      MAT.Memory.Targets.Size_Information (Memory => Target.Memory,
                                           Sizes  => Sizes);
      Iter := Sizes.First;
      while MAT.Memory.Targets.Size_Info_Maps.Has_Element (Iter) loop
         declare
            use type MAT.Types.Target_Size;

            Size  : MAT.Types.Target_Size := MAT.Memory.Targets.Size_Info_Maps.Key (Iter);
            Info  : MAT.Memory.Targets.Size_Info_Type := MAT.Memory.Targets.Size_Info_Maps.Element (Iter);
            Total : MAT.Types.Target_Size := Size * MAT.Types.Target_Size (Info.Count);
         begin
            Ada.Text_IO.Put (MAT.Types.Target_Size'Image (Size));
            Ada.Text_IO.Set_Col (20);
            Ada.Text_IO.Put (Natural'Image (Info.Count));
            Ada.Text_IO.Set_Col (30);
            Ada.Text_IO.Put_Line (MAT.Types.Target_Size'Image (Total));
         end;
         MAT.Memory.Targets.Size_Info_Maps.Next (Iter);
      end loop;
   end Sizes_Command;

   --  ------------------------------
   --  Symbol command.
   --  Load the symbols from the binary file.
   --  ------------------------------
   procedure Symbol_Command (Target : in out MAT.Targets.Target_Type'Class;
                             Args   : in String) is
   begin
      MAT.Symbols.Targets.Open (Target.Symbols, Args);
   end Symbol_Command;

   --  ------------------------------
   --  Exit command.
   --  ------------------------------
   procedure Exit_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
   begin
      raise Stop_Interp;
   end Exit_Command;

   --  ------------------------------
   --  Open a MAT file and read the events.
   --  ------------------------------
   procedure Open_Command (Target : in out MAT.Targets.Target_Type'Class;
                           Args   : in String) is
      Reader : MAT.Readers.Files.File_Reader_Type;
   begin
      Target.Initialize (Reader);
      Reader.Open (Args);
      Reader.Read_All;

   exception
      when E : Ada.IO_Exceptions.Name_Error =>
         Log.Error ("Cannot open {0}", Args);
   end Open_Command;

   function Get_Command (Line : in String) return String is
      Pos : Natural := Util.Strings.Index (Line, ' ');
   begin
      if Pos <= 0 then
         return Line;
      else
         return Line (Line'First .. Pos - 1);
      end if;
   end Get_Command;

   --  ------------------------------
   --  Execute the command given in the line.
   --  ------------------------------
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String) is
      Command : constant String := Get_Command (Line);
      Index   : constant Natural := Util.Strings.Index (Line, ' ');
      Pos     : constant Command_Map.Cursor := Commands.Find (Command);
   begin
      if Command_Map.Has_Element (Pos) then
         Command_Map.Element (Pos) (Target, Line (Index + 1 .. Line'Last));
      end if;
   end Execute;

begin
   Commands.Insert ("exit", Exit_Command'Access);
   Commands.Insert ("quit", Exit_Command'Access);
   Commands.Insert ("open", Open_Command'Access);
   Commands.Insert ("sizes", Sizes_Command'Access);
   Commands.Insert ("symbol", Symbol_Command'Access);
   Commands.Insert ("slots", Slot_Command'Access);
end MAT.Commands;

Use the symbol table to find the file, function and line when printing the backtrace


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

with Wiki.Nodes.Lists;
with Wiki.Strings;
with Wiki.Attributes;
procedure Wiki.Nodes.Dump (Node : in Wiki.Nodes.Node_Type) is

   procedure Dump_Node (Node : in Wiki.Nodes.Node_Type);

   Level : Positive := 1;

   procedure Dump_Node (Node : in Wiki.Nodes.Node_Type) is
      procedure Print_Length (Len : Natural);
      procedure Print (Name  : in String;
                       Value : in Wiki.Strings.WString);

      Kind   : constant Wiki.Strings.WString := Node_Kind'Wide_Wide_Image (Node.Kind);
      Result : Wiki.Strings.BString (256);

      procedure Print (Name  : in String;
                       Value : in Wiki.Strings.WString) is
      begin
         Strings.Append_String (Result, " ");
         Strings.Append_String (Result, Strings.To_WString (Name));
         Strings.Append_String (Result, "=");
         Strings.Append_String (Result, Value);
      end Print;

      procedure Print_Length (Len : Natural) is
         S : constant Wide_Wide_String := Natural'Wide_Wide_Image (Len);
      begin
         Strings.Append_String (Result, " (");
         Strings.Append_String (Result, S (S'First + 1 .. S'Last));
         Strings.Append_String (Result, ")");
      end Print_Length;

   begin
      if Node.Kind = N_TAG_START then
         Strings.Append_String (Result, Html_Tag'Wide_Wide_Image (Node.Tag_Start));
      else
         Strings.Append_String (Result, Kind);
      end if;
      Print_Length (Node.Len);
      case Node.Kind is
         when N_HEADER | N_BLOCKQUOTE | N_INDENT | N_TOC_ENTRY | N_NUM_LIST_START
          | N_LIST_START | N_DEFINITION =>
            Strings.Append_String (Result, Natural'Wide_Wide_Image (Node.Level));
            Strings.Append_String (Result, " ");
            --  Strings.Append_String (Result, Node.Header);
            if Node.Content /= null then
               Level := Level + 1;
               Lists.Iterate (Node.Content, Dump_Node'Access);
               Level := Level - 1;
            end if;

         when N_TEXT =>
            for Format in Format_Type'Range loop
               if Node.Format (Format) then
                  Strings.Append_String (Result, " ");
                  Strings.Append_String (Result, Format_Type'Wide_Wide_Image (Format));
               end if;
            end loop;
            Strings.Append_String (Result, " ");
            Strings.Append_String (Result, Node.Text);

         when N_IMAGE | N_LINK | N_QUOTE =>
            Strings.Append_String (Result, " ");
            Strings.Append_String (Result, Node.Title);
            Attributes.Iterate (Node.Link_Attr, Print'Access);

         when N_TAG_START | N_TABLE | N_ROW | N_COLUMN =>
            Attributes.Iterate (Node.Attributes, Print'Access);
            Write (Level, Wiki.Strings.To_WString (Result));
            if Node.Children /= null then
               Level := Level + 1;
               Lists.Iterate (Node.Children, Dump_Node'Access);
               Level := Level - 1;
            end if;
            return;

         when N_PREFORMAT =>
            Strings.Append_String (Result, " ");
            Strings.Append_String (Result, Strings.To_WString (Node.Language));
            Strings.Append_String (Result, " ");
            Strings.Append_String (Result, Node.Preformatted);

         when others =>
            null;

      end case;
      Write (Level, Wiki.Strings.To_WString (Result));
   end Dump_Node;

begin
   Dump_Node (Node);
end Wiki.Nodes.Dump;

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

with Wiki.Nodes.Lists;
with Wiki.Strings;
with Wiki.Attributes;
procedure Wiki.Nodes.Dump (Node : in Wiki.Nodes.Node_Type) is

   procedure Dump_Node (Node : in Wiki.Nodes.Node_Type);

   Level : Positive := 1;

   procedure Dump_Node (Node : in Wiki.Nodes.Node_Type) is
      procedure Print_Length (Len : Natural);
      procedure Print (Name  : in String;
                       Value : in Wiki.Strings.WString);

      Kind   : constant Wiki.Strings.WString := Node_Kind'Wide_Wide_Image (Node.Kind);
      Result : Wiki.Strings.BString (256);

      procedure Print (Name  : in String;
                       Value : in Wiki.Strings.WString) is
      begin
         Strings.Append_String (Result, " ");
         Strings.Append_String (Result, Strings.To_WString (Name));
         Strings.Append_String (Result, "=");
         Strings.Append_String (Result, Value);
      end Print;

      procedure Print_Length (Len : Natural) is
         S : constant Wide_Wide_String := Natural'Wide_Wide_Image (Len);
      begin
         Strings.Append_String (Result, " (");
         Strings.Append_String (Result, S (S'First + 1 .. S'Last));
         Strings.Append_String (Result, ")");
      end Print_Length;

   begin
      if Node.Kind = N_TAG_START then
         Strings.Append_String (Result, Html_Tag'Wide_Wide_Image (Node.Tag_Start));
      else
         Strings.Append_String (Result, Kind);
      end if;
      Print_Length (Node.Len);
      case Node.Kind is
         when N_HEADER | N_BLOCKQUOTE | N_INDENT | N_TOC_ENTRY | N_NUM_LIST_START
          | N_LIST_START | N_DEFINITION =>
            Strings.Append_String (Result, Natural'Wide_Wide_Image (Node.Level));
            Strings.Append_String (Result, " ");
            Write (Level, Wiki.Strings.To_WString (Result));
            if Node.Content /= null then
               Level := Level + 1;
               Lists.Iterate (Node.Content, Dump_Node'Access);
               Level := Level - 1;
            end if;
            return;

         when N_TEXT =>
            for Format in Format_Type'Range loop
               if Node.Format (Format) then
                  Strings.Append_String (Result, " ");
                  Strings.Append_String (Result, Format_Type'Wide_Wide_Image (Format));
               end if;
            end loop;
            Strings.Append_String (Result, " ");
            Strings.Append_String (Result, Node.Text);

         when N_IMAGE | N_LINK | N_QUOTE =>
            Strings.Append_String (Result, " ");
            Strings.Append_String (Result, Node.Title);
            Attributes.Iterate (Node.Link_Attr, Print'Access);

         when N_TAG_START | N_TABLE | N_ROW | N_COLUMN =>
            Attributes.Iterate (Node.Attributes, Print'Access);
            Write (Level, Wiki.Strings.To_WString (Result));
            if Node.Children /= null then
               Level := Level + 1;
               Lists.Iterate (Node.Children, Dump_Node'Access);
               Level := Level - 1;
            end if;
            return;

         when N_PREFORMAT =>
            Strings.Append_String (Result, " ");
            Strings.Append_String (Result, Strings.To_WString (Node.Language));
            Strings.Append_String (Result, " ");
            Strings.Append_String (Result, Node.Preformatted);

         when others =>
            null;

      end case;
      Write (Level, Wiki.Strings.To_WString (Result));
   end Dump_Node;

begin
   Dump_Node (Node);
end Wiki.Nodes.Dump;

Fix dumping new header nodes

Fix dumping new header nodes


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

package body ADO.SQL.Tests is

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.SQL.Read_File",
                       Test_Read_File'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test Read_SQL file and spliting a file in SQL statements.
   --  ------------------------------
   procedure Test_Read_File (T : in out Test) is
      Count : Natural := 0;

      procedure Process (SQL : in String) is
      begin
         T.Assert_Equals (")", SQL (SQL'Last .. SQL'Last));
         if SQL (SQL'First) = 'I' then
            Util.Tests.Assert_Matches (T, "INSERT .*", SQL,
                                       "invalid SQL");
         else
            Util.Tests.Assert_Matches (T, ".*CREATE TABLE.*", SQL,
                                       "invalid SQL");
         end if;
         Count := Count + 1;
      end Process;
   begin
      ADO.SQL.Read_File ("regtests/files/read-1.sql", Process'Access);
      Util.Tests.Assert_Equals (T, 6, Count, "Invalid number of SQL statements");

      Count := 0;
      ADO.SQL.Read_File ("regtests/files/read-2.sql", Process'Access);
      Util.Tests.Assert_Equals (T, 3, Count, "Invalid number of SQL statements");
   end Test_Read_File;

end ADO.SQL.Tests;

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

package body ADO.SQL.Tests is

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.SQL.Read_File",
                       Test_Read_File'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test Read_SQL file and spliting a file in SQL statements.
   --  ------------------------------
   procedure Test_Read_File (T : in out Test) is
      procedure Process (SQL : in String);

      Count : Natural := 0;

      procedure Process (SQL : in String) is
      begin
         T.Assert_Equals (")", SQL (SQL'Last .. SQL'Last));
         if SQL (SQL'First) = 'I' then
            Util.Tests.Assert_Matches (T, "INSERT .*", SQL,
                                       "invalid SQL");
         else
            Util.Tests.Assert_Matches (T, ".*CREATE TABLE.*", SQL,
                                       "invalid SQL");
         end if;
         Count := Count + 1;
      end Process;
   begin
      ADO.SQL.Read_File ("regtests/files/read-1.sql", Process'Access);
      Util.Tests.Assert_Equals (T, 6, Count, "Invalid number of SQL statements");

      Count := 0;
      ADO.SQL.Read_File ("regtests/files/read-2.sql", Process'Access);
      Util.Tests.Assert_Equals (T, 3, Count, "Invalid number of SQL statements");
   end Test_Read_File;

end ADO.SQL.Tests;

Fix compilation warning

Fix compilation warning


-----------------------------------------------------------------------
--  asf.servlets.files -- Static file servlet
--  Copyright (C) 2010, 2011, 2013, 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 Util.Files;
with Util.Strings;
with Util.Streams;
with Util.Streams.Files;
with Ada.Streams;
with Ada.Streams.Stream_IO;

with Ada.Directories;

with ASF.Streams;
with ASF.Applications;
package body ASF.Servlets.Files is

   use Ada.Streams;
   use Ada.Streams.Stream_IO;
   use Ada.Directories;

   --  ------------------------------
   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  ------------------------------
   procedure Initialize (Server  : in out File_Servlet;
                         Context : in Servlet_Registry'Class) is
      Dir      : constant String := Context.Get_Init_Parameter (ASF.Applications.VIEW_DIR);
      Def_Type : constant String := Context.Get_Init_Parameter ("content-type.default");
   begin
      Server.Dir := new String '(Dir);
      Server.Default_Content_Type := new String '(Def_Type);
   end Initialize;

   --  ------------------------------
   --  Returns the time the Request object was last modified, in milliseconds since
   --  midnight January 1, 1970 GMT.  If the time is unknown, this method returns
   --  a negative number (the default).
   --
   --  Servlets that support HTTP GET requests and can quickly determine their
   --  last modification time should override this method. This makes browser and
   --  proxy caches work more effectively, reducing the load on server and network
   --  resources.
   --  ------------------------------
   function Get_Last_Modified (Server  : in File_Servlet;
                               Request : in Requests.Request'Class)
                               return Ada.Calendar.Time is
      pragma Unreferenced (Server, Request);
   begin
      return Ada.Calendar.Clock;
   end Get_Last_Modified;

   --  ------------------------------
   --  Set the content type associated with the given file
   --  ------------------------------
   procedure Set_Content_Type (Server   : in File_Servlet;
                               Path     : in String;
                               Response : in out Responses.Response'Class) is
      Pos : constant Natural := Util.Strings.Rindex (Path, '.');
   begin
      if Pos = 0 then
         Response.Set_Content_Type (Server.Default_Content_Type.all);
         return;
      end if;
      if Path (Pos .. Path'Last) = ".css" then
         Response.Set_Content_Type ("text/css");
         return;
      end if;
      if Path (Pos .. Path'Last) = ".js" then
         Response.Set_Content_Type ("text/javascript");
         return;
      end if;
      if Path (Pos .. Path'Last) = ".html" then
         Response.Set_Content_Type ("text/html");
         return;
      end if;
      if Path (Pos .. Path'Last) = ".txt" then
         Response.Set_Content_Type ("text/plain");
         return;
      end if;
      if Path (Pos .. Path'Last) = ".png" then
         Response.Set_Content_Type ("image/png");
         return;
      end if;
      if Path (Pos .. Path'Last) = ".jpg" then
         Response.Set_Content_Type ("image/jpg");
         return;
      end if;
      Response.Set_Content_Type (Server.Default_Content_Type.all);
   end Set_Content_Type;

   --  ------------------------------
   --  Called by the server (via the service method) to allow a servlet to handle
   --  a GET request.
   --
   --  Overriding this method to support a GET request also automatically supports
   --  an HTTP HEAD request. A HEAD request is a GET request that returns no body
   --  in the response, only the request header fields.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding.
   --  When using a PrintWriter object to return the response, set the content type
   --  before accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container
   --  to use a persistent connection to return its response to the client,
   --  improving performance. The content length is automatically set if the entire
   --  response fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  The GET method should be safe, that is, without any side effects for which
   --  users are held responsible. For example, most form queries have no side effects.
   --  If a client request is intended to change stored data, the request should use
   --  some other HTTP method.
   --
   --  The GET method should also be idempotent, meaning that it can be safely repeated.
   --  Sometimes making a method safe also makes it idempotent. For example, repeating
   --  queries is both safe and idempotent, but buying a product online or modifying
   --  data is neither safe nor idempotent.
   --
   --  If the request is incorrectly formatted, Do_Get  returns an HTTP "Bad Request"
   --  ------------------------------
   procedure Do_Get (Server   : in File_Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class) is

      use Util.Files;

      URI  : constant String := Request.Get_Path_Info;
      Path : constant String := Find_File_Path (Name => URI, Paths => Server.Dir.all);
   begin
      if not Ada.Directories.Exists (Path)
        or else Ada.Directories.Kind (Path) /= Ada.Directories.Ordinary_File
      then
         Response.Send_Error (Responses.SC_NOT_FOUND);
         return;
      end if;

      File_Servlet'Class (Server).Set_Content_Type (Path, Response);
      declare
         Output : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
         Input  : Util.Streams.Files.File_Stream;
      begin
         Input.Open (Name => Path, Mode => In_File);
         Util.Streams.Copy (From => Input, Into => Output);
      end;
   end Do_Get;

end ASF.Servlets.Files;

-----------------------------------------------------------------------
--  asf.servlets.files -- Static file servlet
--  Copyright (C) 2010, 2011, 2013, 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 Util.Files;
with Util.Strings;
with Util.Streams;
with Util.Streams.Files;
with Ada.Streams;
with Ada.Streams.Stream_IO;

with Ada.Directories;

with ASF.Streams;
with ASF.Applications;
package body ASF.Servlets.Files is

   use Ada.Streams;
   use Ada.Streams.Stream_IO;
   use Ada.Directories;

   --  ------------------------------
   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  ------------------------------
   procedure Initialize (Server  : in out File_Servlet;
                         Context : in Servlet_Registry'Class) is
      Dir      : constant String := Context.Get_Init_Parameter (ASF.Applications.VIEW_DIR);
      Def_Type : constant String := Context.Get_Init_Parameter ("content-type.default");
   begin
      Server.Dir := new String '(Dir);
      Server.Default_Content_Type := new String '(Def_Type);
   end Initialize;

   --  ------------------------------
   --  Returns the time the Request object was last modified, in milliseconds since
   --  midnight January 1, 1970 GMT.  If the time is unknown, this method returns
   --  a negative number (the default).
   --
   --  Servlets that support HTTP GET requests and can quickly determine their
   --  last modification time should override this method. This makes browser and
   --  proxy caches work more effectively, reducing the load on server and network
   --  resources.
   --  ------------------------------
   function Get_Last_Modified (Server  : in File_Servlet;
                               Request : in Requests.Request'Class)
                               return Ada.Calendar.Time is
      pragma Unreferenced (Server, Request);
   begin
      return Ada.Calendar.Clock;
   end Get_Last_Modified;

   --  ------------------------------
   --  Set the content type associated with the given file
   --  ------------------------------
   procedure Set_Content_Type (Server   : in File_Servlet;
                               Path     : in String;
                               Response : in out Responses.Response'Class) is
      Pos : constant Natural := Util.Strings.Rindex (Path, '.');
   begin
      if Pos = 0 then
         Response.Set_Content_Type (Server.Default_Content_Type.all);
         return;
      end if;
      if Path (Pos .. Path'Last) = ".css" then
         Response.Set_Content_Type ("text/css");
         return;
      end if;
      if Path (Pos .. Path'Last) = ".js" then
         Response.Set_Content_Type ("text/javascript");
         return;
      end if;
      if Path (Pos .. Path'Last) = ".html" then
         Response.Set_Content_Type ("text/html");
         return;
      end if;
      if Path (Pos .. Path'Last) = ".txt" then
         Response.Set_Content_Type ("text/plain");
         return;
      end if;
      if Path (Pos .. Path'Last) = ".png" then
         Response.Set_Content_Type ("image/png");
         return;
      end if;
      if Path (Pos .. Path'Last) = ".jpg" then
         Response.Set_Content_Type ("image/jpg");
         return;
      end if;
      Response.Set_Content_Type (Server.Default_Content_Type.all);
   end Set_Content_Type;

   --  ------------------------------
   --  Called by the server (via the service method) to allow a servlet to handle
   --  a GET request.
   --
   --  Overriding this method to support a GET request also automatically supports
   --  an HTTP HEAD request. A HEAD request is a GET request that returns no body
   --  in the response, only the request header fields.
   --
   --  When overriding this method, read the request data, write the response headers,
   --  get the response's writer or output stream object, and finally, write the
   --  response data. It's best to include content type and encoding.
   --  When using a PrintWriter object to return the response, set the content type
   --  before accessing the PrintWriter object.
   --
   --  The servlet container must write the headers before committing the response,
   --  because in HTTP the headers must be sent before the response body.
   --
   --  Where possible, set the Content-Length header (with the
   --  Response.Set_Content_Length method), to allow the servlet container
   --  to use a persistent connection to return its response to the client,
   --  improving performance. The content length is automatically set if the entire
   --  response fits inside the response buffer.
   --
   --  When using HTTP 1.1 chunked encoding (which means that the response has a
   --  Transfer-Encoding header), do not set the Content-Length header.
   --
   --  The GET method should be safe, that is, without any side effects for which
   --  users are held responsible. For example, most form queries have no side effects.
   --  If a client request is intended to change stored data, the request should use
   --  some other HTTP method.
   --
   --  The GET method should also be idempotent, meaning that it can be safely repeated.
   --  Sometimes making a method safe also makes it idempotent. For example, repeating
   --  queries is both safe and idempotent, but buying a product online or modifying
   --  data is neither safe nor idempotent.
   --
   --  If the request is incorrectly formatted, Do_Get  returns an HTTP "Bad Request"
   --  ------------------------------
   procedure Do_Get (Server   : in File_Servlet;
                     Request  : in out Requests.Request'Class;
                     Response : in out Responses.Response'Class) is

      use Util.Files;

      URI  : constant String := Request.Get_Servlet_Path;
      Path : constant String := Find_File_Path (Name => URI, Paths => Server.Dir.all);
   begin
      if not Ada.Directories.Exists (Path)
        or else Ada.Directories.Kind (Path) /= Ada.Directories.Ordinary_File
      then
         Response.Send_Error (Responses.SC_NOT_FOUND);
         return;
      end if;

      File_Servlet'Class (Server).Set_Content_Type (Path, Response);
      declare
         Output : ASF.Streams.Print_Stream := Response.Get_Output_Stream;
         Input  : Util.Streams.Files.File_Stream;
      begin
         Input.Open (Name => Path, Mode => In_File);
         Util.Streams.Copy (From => Input, Into => Output);
      end;
   end Do_Get;

end ASF.Servlets.Files;

Use Get_Servlet_Path instead of Get_Path_Info


-----------------------------------------------------------------------
--  gen-model-packages -- Packages holding model, query representation
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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.Containers.Hashed_Maps;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;

with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Strings.Sets;

with Gen.Model.List;
with Gen.Model.Mappings;
limited with Gen.Model.Enums;
limited with Gen.Model.Tables;
limited with Gen.Model.Queries;
limited with Gen.Model.Beans;
package Gen.Model.Packages is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Model Definition
   --  ------------------------------
   --  The Model_Definition contains the complete model from one or
   --  several files.  It maintains a list of Ada packages that must be generated.
   type Model_Definition is new Definition with private;
   type Model_Definition_Access is access all Model_Definition'Class;

   --  Validate the definition by checking and reporting problems to the logger interface.
   overriding
   procedure Validate (Def : in out Model_Definition;
                       Log : in out Util.Log.Logging'Class);

   --  ------------------------------
   --  Package Definition
   --  ------------------------------
   --  The Package_Definition holds the tables, queries and other information
   --  that must be generated for a given Ada package.
   type Package_Definition is new Definition with private;
   type Package_Definition_Access is access all Package_Definition'Class;

   --  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 : in Package_Definition;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   overriding
   procedure Prepare (O : in out Package_Definition);

   --  Validate the definition by checking and reporting problems to the logger interface.
   overriding
   procedure Validate (Def : in out Package_Definition;
                       Log : in out Util.Log.Logging'Class);

   --  Initialize the package instance
   overriding
   procedure Initialize (O : in out Package_Definition);

   --  Find the type identified by the name.
   function Find_Type (From : in Package_Definition;
                       Name : in Unbounded_String)
                       return Gen.Model.Mappings.Mapping_Definition_Access;

   --  Get the model which contains all the package definitions.
   function Get_Model (From : in Package_Definition)
                       return Model_Definition_Access;

   --  Returns True if the package is a pre-defined package and must not be generated.
   function Is_Predefined (From : in Package_Definition) return Boolean;

   --  Set the package as a pre-defined package.
   procedure Set_Predefined (From : in out Package_Definition);

   --  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 : Model_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Initialize the model definition instance.
   overriding
   procedure Initialize (O : in out Model_Definition);

   --  Returns True if the model contains at least one package.
   function Has_Packages (O : in Model_Definition) return Boolean;

   --  Register or find the package knowing its name
   procedure Register_Package (O      : in out Model_Definition;
                               Name   : in Unbounded_String;
                               Result : out Package_Definition_Access);

   --  Register the declaration of the given enum in the model.
   procedure Register_Enum (O    : in out Model_Definition;
                            Enum : access Gen.Model.Enums.Enum_Definition'Class);

   --  Register the declaration of the given table in the model.
   procedure Register_Table (O     : in out Model_Definition;
                             Table : access Gen.Model.Tables.Table_Definition'Class);

   --  Register the declaration of the given query in the model.
   procedure Register_Query (O     : in out Model_Definition;
                             Table : access Gen.Model.Queries.Query_File_Definition'Class);

   --  Register the declaration of the given bean in the model.
   procedure Register_Bean (O     : in out Model_Definition;
                            Bean  : access Gen.Model.Beans.Bean_Definition'Class);

   --  Register a type mapping.  The From type describes a type in the XML
   --  configuration files (hibernate, query, ...) and the To represents the
   --  corresponding Ada type.
   procedure Register_Type (O    : in out Model_Definition;
                            From : in String;
                            To   : in String);

   --  Find the type identified by the name.
   function Find_Type (From : in Model_Definition;
                       Name : in Unbounded_String)
                       return Gen.Model.Mappings.Mapping_Definition_Access;

   --  Set the directory name associated with the model. This directory name allows to
   --  save and build a model in separate directories for the application, the unit tests
   --  and others.
   procedure Set_Dirname (O : in out Model_Definition;
                          Target_Dir : in String;
                          Model_Dir  : in String);

   --  Get the directory name associated with the model.
   function Get_Dirname (O : in Model_Definition) return String;

   --  Get the directory name which contains the model.
   function Get_Model_Directory (O : in Model_Definition) return String;

   --  Enable the generation of the Ada package given by the name.  By default all the Ada
   --  packages found in the model are generated.  When called, this enables the generation
   --  only for the Ada packages registered here.
   procedure Enable_Package_Generation (Model : in out Model_Definition;
                                        Name  : in String);

   --  Returns True if the generation is enabled for the given package name.
   function Is_Generation_Enabled (Model : in Model_Definition;
                                   Name  : in String) return Boolean;

   --  Iterate over the model tables.
   procedure Iterate_Tables (Model   : in Model_Definition;
                             Process : not null access
                               procedure (Item : in out Tables.Table_Definition));

   --  Iterate over the model enums.
   procedure Iterate_Enums (Model   : in Model_Definition;
                             Process : not null access
                               procedure (Item : in out Enums.Enum_Definition));

   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   overriding
   procedure Prepare (O : in out Model_Definition);

   package Package_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                     Element_Type    => Package_Definition_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   subtype Package_Cursor is Package_Map.Cursor;

   --  Get the first package of the model definition.
   function First (From : Model_Definition) return Package_Cursor;

   --  Returns true if the package cursor contains a valid package
   function Has_Element (Position : Package_Cursor) return Boolean
                         renames Package_Map.Has_Element;

   --  Returns the package definition.
   function Element (Position : Package_Cursor) return Package_Definition_Access
                     renames Package_Map.Element;

   --  Move the iterator to the next package definition.
   procedure Next (Position : in out Package_Cursor)
                   renames Package_Map.Next;

private

   package Table_List is new Gen.Model.List (T        => Definition,
                                             T_Access => Definition_Access);

   --  Returns False if the <tt>Left</tt> table does not depend on <tt>Right</tt>.
   --  Returns True if the <tt>Left</tt> table depends on the <tt>Right</tt> table.
   function Dependency_Compare (Left, Right : in Definition_Access) return Boolean;

   --  Sort the tables on their dependency.
   procedure Dependency_Sort is new Table_List.Sort_On ("<" => Dependency_Compare);

   subtype Table_List_Definition is Table_List.List_Definition;
   subtype Enum_List_Definition is Table_List.List_Definition;

   type List_Object is new Util.Beans.Basic.List_Bean with record
      Values     : Util.Beans.Objects.Vectors.Vector;
      Row        : Natural;
      Value_Bean : Util.Beans.Objects.Object;
   end record;

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

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

   --  Get the element at the current row index.
   overriding
   function Get_Row (From  : in List_Object) 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 : in List_Object;
                       Name : in String) return Util.Beans.Objects.Object;

   type Package_Definition is new Definition with record
      --  Enums defined in the package.
      Enums        : aliased Enum_List_Definition;
      Enums_Bean   : Util.Beans.Objects.Object;

      --  Hibernate tables
      Tables       : aliased Table_List_Definition;
      Tables_Bean  : Util.Beans.Objects.Object;

      --  Custom queries
      Queries      : aliased Table_List_Definition;
      Queries_Bean : Util.Beans.Objects.Object;

      --  Ada Beans
      Beans        : aliased Table_List_Definition;
      Beans_Bean   : Util.Beans.Objects.Object;

      --  A list of external packages which are used (used for with clause generation).
      Used_Spec_Types    : aliased List_Object;
      Used_Spec          : Util.Beans.Objects.Object;

      --  A list of external packages which are used (used for with clause generation).
      Used_Body_Types    : aliased List_Object;
      Used_Body          : Util.Beans.Objects.Object;

      --  A map of all types defined in this package.
      Types        : Gen.Model.Mappings.Mapping_Maps.Map;

      --  The base name for the package (ex: gen-model-users)
      Base_Name    : Unbounded_String;

      --  The global model (used to resolve types from other packages).
      Model              : Model_Definition_Access;

      --  True if the package uses Ada.Calendar.Time
      Uses_Calendar_Time : Boolean := False;

      --  True if the package is a pre-defined package (ie, defined by a UML profile).
      Is_Predefined      : Boolean := False;
   end record;

   type Model_Definition is new Definition with record
      --  List of all enums.
      Enums        : aliased Enum_List_Definition;
      Enums_Bean   : Util.Beans.Objects.Object;

      --  List of all tables.
      Tables       : aliased Table_List_Definition;
      Tables_Bean  : Util.Beans.Objects.Object;

      --  List of all queries.
      Queries      : aliased Table_List_Definition;
      Queries_Bean : Util.Beans.Objects.Object;

      --  Ada Beans
      Beans        : aliased Table_List_Definition;
      Beans_Bean   : Util.Beans.Objects.Object;

      --  Map of all packages.
      Packages     : Package_Map.Map;

      --  Directory associated with the model ('src', 'samples', 'regtests', ...).
      Dir_Name     : Unbounded_String;

      --  Directory that contains the SQL and model files.
      DB_Name      : Unbounded_String;

      --  When not empty, a list of packages that must be taken into account for the generation.
      --  By default all packages and tables defined in the model are generated.
      Gen_Packages : Util.Strings.Sets.Set;
   end record;

end Gen.Model.Packages;

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

with Ada.Containers.Hashed_Maps;
with Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Hash;

with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Strings.Sets;

with Gen.Model.List;
with Gen.Model.Mappings;
limited with Gen.Model.Enums;
limited with Gen.Model.Tables;
limited with Gen.Model.Queries;
limited with Gen.Model.Beans;
limited with Gen.Model.Stypes;
package Gen.Model.Packages is

   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Model Definition
   --  ------------------------------
   --  The Model_Definition contains the complete model from one or
   --  several files.  It maintains a list of Ada packages that must be generated.
   type Model_Definition is new Definition with private;
   type Model_Definition_Access is access all Model_Definition'Class;

   --  Validate the definition by checking and reporting problems to the logger interface.
   overriding
   procedure Validate (Def : in out Model_Definition;
                       Log : in out Util.Log.Logging'Class);

   --  ------------------------------
   --  Package Definition
   --  ------------------------------
   --  The Package_Definition holds the tables, queries and other information
   --  that must be generated for a given Ada package.
   type Package_Definition is new Definition with private;
   type Package_Definition_Access is access all Package_Definition'Class;

   --  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 : in Package_Definition;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   overriding
   procedure Prepare (O : in out Package_Definition);

   --  Validate the definition by checking and reporting problems to the logger interface.
   overriding
   procedure Validate (Def : in out Package_Definition;
                       Log : in out Util.Log.Logging'Class);

   --  Initialize the package instance
   overriding
   procedure Initialize (O : in out Package_Definition);

   --  Find the type identified by the name.
   function Find_Type (From : in Package_Definition;
                       Name : in Unbounded_String)
                       return Gen.Model.Mappings.Mapping_Definition_Access;

   --  Get the model which contains all the package definitions.
   function Get_Model (From : in Package_Definition)
                       return Model_Definition_Access;

   --  Returns True if the package is a pre-defined package and must not be generated.
   function Is_Predefined (From : in Package_Definition) return Boolean;

   --  Set the package as a pre-defined package.
   procedure Set_Predefined (From : in out Package_Definition);

   --  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 : Model_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Initialize the model definition instance.
   overriding
   procedure Initialize (O : in out Model_Definition);

   --  Returns True if the model contains at least one package.
   function Has_Packages (O : in Model_Definition) return Boolean;

   --  Register or find the package knowing its name
   procedure Register_Package (O      : in out Model_Definition;
                               Name   : in Unbounded_String;
                               Result : out Package_Definition_Access);

   --  Register the declaration of the given enum in the model.
   procedure Register_Enum (O    : in out Model_Definition;
                            Enum : access Gen.Model.Enums.Enum_Definition'Class);

   --  Register the declaration of the given data type in the model.
   procedure Register_Stype (O     : in out Model_Definition;
                             Stype : access Gen.Model.Stypes.Stype_Definition'Class);

   --  Register the declaration of the given table in the model.
   procedure Register_Table (O     : in out Model_Definition;
                             Table : access Gen.Model.Tables.Table_Definition'Class);

   --  Register the declaration of the given query in the model.
   procedure Register_Query (O     : in out Model_Definition;
                             Table : access Gen.Model.Queries.Query_File_Definition'Class);

   --  Register the declaration of the given bean in the model.
   procedure Register_Bean (O     : in out Model_Definition;
                            Bean  : access Gen.Model.Beans.Bean_Definition'Class);

   --  Register a type mapping.  The From type describes a type in the XML
   --  configuration files (hibernate, query, ...) and the To represents the
   --  corresponding Ada type.
   procedure Register_Type (O    : in out Model_Definition;
                            From : in String;
                            To   : in String);

   --  Find the type identified by the name.
   function Find_Type (From : in Model_Definition;
                       Name : in Unbounded_String)
                       return Gen.Model.Mappings.Mapping_Definition_Access;

   --  Set the directory name associated with the model. This directory name allows to
   --  save and build a model in separate directories for the application, the unit tests
   --  and others.
   procedure Set_Dirname (O : in out Model_Definition;
                          Target_Dir : in String;
                          Model_Dir  : in String);

   --  Get the directory name associated with the model.
   function Get_Dirname (O : in Model_Definition) return String;

   --  Get the directory name which contains the model.
   function Get_Model_Directory (O : in Model_Definition) return String;

   --  Enable the generation of the Ada package given by the name.  By default all the Ada
   --  packages found in the model are generated.  When called, this enables the generation
   --  only for the Ada packages registered here.
   procedure Enable_Package_Generation (Model : in out Model_Definition;
                                        Name  : in String);

   --  Returns True if the generation is enabled for the given package name.
   function Is_Generation_Enabled (Model : in Model_Definition;
                                   Name  : in String) return Boolean;

   --  Iterate over the model tables.
   procedure Iterate_Tables (Model   : in Model_Definition;
                             Process : not null access
                               procedure (Item : in out Tables.Table_Definition));

   --  Iterate over the model enums.
   procedure Iterate_Enums (Model   : in Model_Definition;
                             Process : not null access
                               procedure (Item : in out Enums.Enum_Definition));

   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   overriding
   procedure Prepare (O : in out Model_Definition);

   package Package_Map is
     new Ada.Containers.Hashed_Maps (Key_Type        => Unbounded_String,
                                     Element_Type    => Package_Definition_Access,
                                     Hash            => Ada.Strings.Unbounded.Hash,
                                     Equivalent_Keys => "=");

   subtype Package_Cursor is Package_Map.Cursor;

   --  Get the first package of the model definition.
   function First (From : Model_Definition) return Package_Cursor;

   --  Returns true if the package cursor contains a valid package
   function Has_Element (Position : Package_Cursor) return Boolean
                         renames Package_Map.Has_Element;

   --  Returns the package definition.
   function Element (Position : Package_Cursor) return Package_Definition_Access
                     renames Package_Map.Element;

   --  Move the iterator to the next package definition.
   procedure Next (Position : in out Package_Cursor)
                   renames Package_Map.Next;

private

   package Table_List is new Gen.Model.List (T        => Definition,
                                             T_Access => Definition_Access);

   --  Returns False if the <tt>Left</tt> table does not depend on <tt>Right</tt>.
   --  Returns True if the <tt>Left</tt> table depends on the <tt>Right</tt> table.
   function Dependency_Compare (Left, Right : in Definition_Access) return Boolean;

   --  Sort the tables on their dependency.
   procedure Dependency_Sort is new Table_List.Sort_On ("<" => Dependency_Compare);

   subtype Table_List_Definition is Table_List.List_Definition;
   subtype Enum_List_Definition is Table_List.List_Definition;
   subtype Types_List_Definition is Table_List.List_Definition;
   subtype Stype_List_Definition is Table_List.List_Definition;

   type List_Object is new Util.Beans.Basic.List_Bean with record
      Values     : Util.Beans.Objects.Vectors.Vector;
      Row        : Natural;
      Value_Bean : Util.Beans.Objects.Object;
   end record;

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

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

   --  Get the element at the current row index.
   overriding
   function Get_Row (From  : in List_Object) 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 : in List_Object;
                       Name : in String) return Util.Beans.Objects.Object;

   type Package_Definition is new Definition with record
      --  Enums defined in the package.
      Enums        : aliased Enum_List_Definition;
      Enums_Bean   : Util.Beans.Objects.Object;

      --  Simple data types defined in the package.
      Stypes       : aliased Stype_List_Definition;
      Stypes_Bean  : Util.Beans.Objects.Object;

      --  Hibernate tables
      Tables       : aliased Table_List_Definition;
      Tables_Bean  : Util.Beans.Objects.Object;

      --  Custom queries
      Queries      : aliased Table_List_Definition;
      Queries_Bean : Util.Beans.Objects.Object;

      --  Ada Beans
      Beans        : aliased Table_List_Definition;
      Beans_Bean   : Util.Beans.Objects.Object;

      --  A list of external packages which are used (used for with clause generation).
      Used_Spec_Types    : aliased List_Object;
      Used_Spec          : Util.Beans.Objects.Object;

      --  A list of external packages which are used (used for with clause generation).
      Used_Body_Types    : aliased List_Object;
      Used_Body          : Util.Beans.Objects.Object;

      --  A map of all types defined in this package.
      Types        : Gen.Model.Mappings.Mapping_Maps.Map;

      --  The base name for the package (ex: gen-model-users)
      Base_Name    : Unbounded_String;

      --  The global model (used to resolve types from other packages).
      Model              : Model_Definition_Access;

      --  True if the package uses Ada.Calendar.Time
      Uses_Calendar_Time : Boolean := False;

      --  True if the package is a pre-defined package (ie, defined by a UML profile).
      Is_Predefined      : Boolean := False;
   end record;

   type Model_Definition is new Definition with record
      --  List of all enums.
      Enums        : aliased Enum_List_Definition;
      Enums_Bean   : Util.Beans.Objects.Object;

      --  Simple data types defined in the package.
      Stypes       : aliased Stype_List_Definition;
      Stypes_Bean  : Util.Beans.Objects.Object;

      --  List of all tables.
      Tables       : aliased Table_List_Definition;
      Tables_Bean  : Util.Beans.Objects.Object;

      --  List of all queries.
      Queries      : aliased Table_List_Definition;
      Queries_Bean : Util.Beans.Objects.Object;

      --  Ada Beans
      Beans        : aliased Table_List_Definition;
      Beans_Bean   : Util.Beans.Objects.Object;

      --  Map of all packages.
      Packages     : Package_Map.Map;

      --  Directory associated with the model ('src', 'samples', 'regtests', ...).
      Dir_Name     : Unbounded_String;

      --  Directory that contains the SQL and model files.
      DB_Name      : Unbounded_String;

      --  When not empty, a list of packages that must be taken into account for the generation.
      --  By default all packages and tables defined in the model are generated.
      Gen_Packages : Util.Strings.Sets.Set;
   end record;

end Gen.Model.Packages;

Add Register_Stype to register and keep the simple types defined by a model


------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2015, 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 STMicroelectronics nor the names of its       --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with STM32F4;                     use STM32F4;
with STM32F4.GPIO;                use STM32F4.GPIO;
with STM32F4_Discovery;           use STM32F4_Discovery;
with STM32F4.Reset_Clock_Control; use STM32F4.Reset_Clock_Control;

with Serial_IO.Blocking;  use Serial_IO.Blocking;

use Serial_IO;

package Peripherals_Blocking is

   --  the specific port, pins, and USART selections are arbitrary.
   Hardware : aliased Peripheral_Descriptor :=
                (Port               => GPIO_B'Access,
                 Transceiver        => USART_1'Access,
                 Enable_Port_Clock  => GPIOB_Clock_Enable'Access,
                 Enable_USART_Clock => USART1_Clock_Enable'Access,
                 Transceiver_AF     => GPIO_AF_USART1,
                 Tx_Pin             => Pin_6,
                 Rx_Pin             => Pin_7);

   COM : Serial_Port (Hardware'Access);

end Peripherals_Blocking;

------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2015, 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 STMicroelectronics nor the names of its       --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with STM32F4_Discovery;   use STM32F4_Discovery;

with STM32F4;             use STM32F4;
with STM32F4.GPIO;        use STM32F4.GPIO;
with STM32F4.RCC;         use STM32F4.RCC;

with Serial_IO.Blocking;  use Serial_IO.Blocking;

use Serial_IO;

package Peripherals_Blocking is

   --  the specific port, pins, and USART selections are arbitrary.
   Hardware : aliased Peripheral_Descriptor :=
                (Port               => GPIO_B'Access,
                 Transceiver        => USART_1'Access,
                 Enable_Port_Clock  => GPIOB_Clock_Enable'Access,
                 Enable_USART_Clock => USART1_Clock_Enable'Access,
                 Transceiver_AF     => GPIO_AF_USART1,
                 Tx_Pin             => Pin_6,
                 Rx_Pin             => Pin_7);

   COM : Serial_Port (Hardware'Access);

end Peripherals_Blocking;

use new name for RCC package

use new name for RCC package


-----------------------------------------------------------------------
--  Util.Streams.Files -- File Stream utilities
--  Copyright (C) 2010, 2011, 2012, 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.IO_Exceptions;
package body Util.Streams.Texts is

   procedure Initialize (Stream : in out Print_Stream;
                         To     : in Output_Stream_Access) is
   begin
      Stream.Initialize (Output => To, Input => null, Size => 4096);
   end Initialize;

   --  ------------------------------
   --  Write an integer on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Integer) is
      S : constant String := Integer'Image (Item);
   begin
      if Item > 0 then
         Stream.Write (S (S'First + 1 .. S'Last));
      else
         Stream.Write (S);
      end if;
   end Write;

   --  ------------------------------
   --  Write an integer on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Long_Long_Integer) is
      S : constant String := Long_Long_Integer'Image (Item);
   begin
      if Item > 0 then
         Stream.Write (S (S'First + 1 .. S'Last));
      else
         Stream.Write (S);
      end if;
   end Write;

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

   --  ------------------------------
   --  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) is
   begin
      Stream.Write (GNAT.Calendar.Time_IO.Image (Item, Format));
   end Write;

   --  ------------------------------
   --  Get the output stream content as a string.
   --  ------------------------------
   function To_String (Stream : in Buffered.Buffered_Stream) return String is
      use Ada.Streams;

      Size   : constant Natural := Stream.Get_Size;
      Buffer : constant Streams.Buffered.Buffer_Access := Stream.Get_Buffer;
      Result : String (1 .. Size);
   begin
      for I in Result'Range loop
         Result (I) := Character'Val (Buffer (Stream_Element_Offset (I)));
      end loop;
      return Result;
   end To_String;

   --  ------------------------------
   --  Write a character on the stream.
   --  ------------------------------
   procedure Write_Char (Stream : in out Buffered.Buffered_Stream'Class;
                         Item   : in Character) is
   begin
      Stream.Write (Item);
   end Write_Char;

   --  ------------------------------
   --  Write a character on the stream.
   --  ------------------------------
   procedure Write_Char (Stream : in out Buffered.Buffered_Stream'Class;
                         Item   : in Wide_Wide_Character) is
   begin
      Stream.Write_Wide (Item);
   end Write_Char;

   --  ------------------------------
   --  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) is
   begin
      Stream.Initialize (Output => null, Input => From, Size => 4096);
   end Initialize;

   --  ------------------------------
   --  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) is
      C : Character;
   begin
      while not Stream.Is_Eof loop
         Stream.Read (C);
         if C = ASCII.LF then
            if not Strip then
               Ada.Strings.Unbounded.Append (Into, C);
            end if;
            return;
         elsif C /= ASCII.CR or not Strip then
            Ada.Strings.Unbounded.Append (Into, C);
         end if;
      end loop;

   exception
      when Ada.IO_Exceptions.Data_Error =>
         return;
   end Read_Line;

end Util.Streams.Texts;

-----------------------------------------------------------------------
--  Util.Streams.Files -- File Stream utilities
--  Copyright (C) 2010, 2011, 2012, 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 Ada.IO_Exceptions;
package body Util.Streams.Texts is

   procedure Initialize (Stream : in out Print_Stream;
                         To     : in Output_Stream_Access) is
   begin
      Stream.Initialize (Output => To, Input => null, Size => 4096);
   end Initialize;

   --  ------------------------------
   --  Write an integer on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Integer) is
      S : constant String := Integer'Image (Item);
   begin
      if Item > 0 then
         Stream.Write (S (S'First + 1 .. S'Last));
      else
         Stream.Write (S);
      end if;
   end Write;

   --  ------------------------------
   --  Write an integer on the stream.
   --  ------------------------------
   procedure Write (Stream : in out Print_Stream;
                    Item   : in Long_Long_Integer) is
      S : constant String := Long_Long_Integer'Image (Item);
   begin
      if Item > 0 then
         Stream.Write (S (S'First + 1 .. S'Last));
      else
         Stream.Write (S);
      end if;
   end Write;

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

   --  ------------------------------
   --  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) is
   begin
      Stream.Write (GNAT.Calendar.Time_IO.Image (Item, Format));
   end Write;

   --  ------------------------------
   --  Get the output stream content as a string.
   --  ------------------------------
   function To_String (Stream : in Buffered.Buffered_Stream'Class) return String is
      use Ada.Streams;

      Size   : constant Natural := Stream.Get_Size;
      Buffer : constant Streams.Buffered.Buffer_Access := Stream.Get_Buffer;
      Result : String (1 .. Size);
   begin
      for I in Result'Range loop
         Result (I) := Character'Val (Buffer (Stream_Element_Offset (I)));
      end loop;
      return Result;
   end To_String;

   --  ------------------------------
   --  Write a character on the stream.
   --  ------------------------------
   procedure Write_Char (Stream : in out Buffered.Buffered_Stream'Class;
                         Item   : in Character) is
   begin
      Stream.Write (Item);
   end Write_Char;

   --  ------------------------------
   --  Write a character on the stream.
   --  ------------------------------
   procedure Write_Char (Stream : in out Buffered.Buffered_Stream'Class;
                         Item   : in Wide_Wide_Character) is
   begin
      Stream.Write_Wide (Item);
   end Write_Char;

   --  ------------------------------
   --  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) is
   begin
      Stream.Initialize (Output => null, Input => From, Size => 4096);
   end Initialize;

   --  ------------------------------
   --  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) is
      C : Character;
   begin
      while not Stream.Is_Eof loop
         Stream.Read (C);
         if C = ASCII.LF then
            if not Strip then
               Ada.Strings.Unbounded.Append (Into, C);
            end if;
            return;
         elsif C /= ASCII.CR or not Strip then
            Ada.Strings.Unbounded.Append (Into, C);
         end if;
      end loop;

   exception
      when Ada.IO_Exceptions.Data_Error =>
         return;
   end Read_Line;

end Util.Streams.Texts;

Change To_String function to accept class wide buffer stream objects


-----------------------------------------------------------------------
--  Util.beans.factory -- Bean Registration and Factory
--  Copyright (C) 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.
-----------------------------------------------------------------------

with Util.Log.Loggers;
package body Util.Beans.Factory is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("EL.Beans.Factory");

   --  ------------------------------
   --  Register under the given name a function to create the bean instance when
   --  it is accessed for a first time.  The scope defines the scope of the bean.
   --  bean
   --  ------------------------------
   procedure Register (Factory    : in out Bean_Factory;
                       Name       : in String;
                       Definition : in Bean_Definition_Access;
                       Scope      : in Scope_Type := REQUEST_SCOPE) is
      B : constant Simple_Binding_Access := new Simple_Binding '(Def   => Definition,
                                                                 Scope => Scope);
   begin
      Log.Info ("Register bean '{0}' in scope {1}", Name, Scope_Type'Image (Scope));

      Register (Factory, Name, B.all'Access);
   end Register;

   --  ------------------------------
   --  Register under the given name a function to create the bean instance when
   --  it is accessed for a first time.  The scope defines the scope of the bean.
   --  bean
   --  ------------------------------
   procedure Register (Factory : in out Bean_Factory;
                       Name    : in String;
                       Bind    : in Binding_Access) is
   begin
      Log.Info ("Register bean binding '{0}'", Name);

      Factory.Map.Include (Key => To_Unbounded_String (Name),
                           New_Item => Bind);
   end Register;

   --  ------------------------------
   --  Register all the definitions from a factory to a main factory.
   --  ------------------------------
   procedure Register (Factory : in out Bean_Factory;
                       From    : in Bean_Factory) is
      Pos : Bean_Maps.Cursor := Bean_Maps.First (From.Map);
   begin
      while Bean_Maps.Has_Element (Pos) loop
         Factory.Map.Include (Key      => Bean_Maps.Key (Pos),
                              New_Item => Bean_Maps.Element (Pos));
         Bean_Maps.Next (Pos);
      end loop;
   end Register;

   --  ------------------------------
   --  Create a bean by using the create operation registered for the name
   --  ------------------------------
   procedure Create (Factory    : in Bean_Factory;
                     Name       : in Unbounded_String;
                     Result     : out Util.Beans.Basic.Readonly_Bean_Access;
                     Definition : out Bean_Definition_Access;
                     Scope      : out Scope_Type) is
      Pos : constant Bean_Maps.Cursor := Factory.Map.Find (Name);
   begin
      if Bean_Maps.Has_Element (Pos) then
         declare
            B : constant Binding_Access := Bean_Maps.Element (Pos);
         begin
            B.Create (Name, Result, Definition, Scope);
         end;
      end if;
   end Create;

   procedure Create (Factory    : in Simple_Binding;
                     Name       : in Ada.Strings.Unbounded.Unbounded_String;
                     Result     : out Util.Beans.Basic.Readonly_Bean_Access;
                     Definition : out Bean_Definition_Access;
                     Scope      : out Scope_Type) is
      pragma Unreferenced (Name);
   begin
      Result     := Factory.Def.Create;
      Definition := Factory.Def;
      Scope      := Factory.Scope;
   end Create;

end Util.Beans.Factory;

-----------------------------------------------------------------------
--  Util.beans.factory -- Bean Registration and Factory
--  Copyright (C) 2009, 2010, 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 Util.Log.Loggers;
package body Util.Beans.Factory is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Beans.Factory");

   --  ------------------------------
   --  Register under the given name a function to create the bean instance when
   --  it is accessed for a first time.  The scope defines the scope of the bean.
   --  bean
   --  ------------------------------
   procedure Register (Factory    : in out Bean_Factory;
                       Name       : in String;
                       Definition : in Bean_Definition_Access;
                       Scope      : in Scope_Type := REQUEST_SCOPE) is
      B : constant Simple_Binding_Access := new Simple_Binding '(Def   => Definition,
                                                                 Scope => Scope);
   begin
      Log.Info ("Register bean '{0}' in scope {1}", Name, Scope_Type'Image (Scope));

      Register (Factory, Name, B.all'Access);
   end Register;

   --  ------------------------------
   --  Register under the given name a function to create the bean instance when
   --  it is accessed for a first time.  The scope defines the scope of the bean.
   --  bean
   --  ------------------------------
   procedure Register (Factory : in out Bean_Factory;
                       Name    : in String;
                       Bind    : in Binding_Access) is
   begin
      Log.Info ("Register bean binding '{0}'", Name);

      Factory.Map.Include (Key => To_Unbounded_String (Name),
                           New_Item => Bind);
   end Register;

   --  ------------------------------
   --  Register all the definitions from a factory to a main factory.
   --  ------------------------------
   procedure Register (Factory : in out Bean_Factory;
                       From    : in Bean_Factory) is
      Pos : Bean_Maps.Cursor := Bean_Maps.First (From.Map);
   begin
      while Bean_Maps.Has_Element (Pos) loop
         Factory.Map.Include (Key      => Bean_Maps.Key (Pos),
                              New_Item => Bean_Maps.Element (Pos));
         Bean_Maps.Next (Pos);
      end loop;
   end Register;

   --  ------------------------------
   --  Create a bean by using the create operation registered for the name
   --  ------------------------------
   procedure Create (Factory    : in Bean_Factory;
                     Name       : in Unbounded_String;
                     Result     : out Util.Beans.Basic.Readonly_Bean_Access;
                     Definition : out Bean_Definition_Access;
                     Scope      : out Scope_Type) is
      Pos : constant Bean_Maps.Cursor := Factory.Map.Find (Name);
   begin
      if Bean_Maps.Has_Element (Pos) then
         declare
            B : constant Binding_Access := Bean_Maps.Element (Pos);
         begin
            B.Create (Name, Result, Definition, Scope);
         end;
      end if;
   end Create;

   procedure Create (Factory    : in Simple_Binding;
                     Name       : in Ada.Strings.Unbounded.Unbounded_String;
                     Result     : out Util.Beans.Basic.Readonly_Bean_Access;
                     Definition : out Bean_Definition_Access;
                     Scope      : out Scope_Type) is
      pragma Unreferenced (Name);
   begin
      Result     := Factory.Def.Create;
      Definition := Factory.Def;
      Scope      := Factory.Scope;
   end Create;

end Util.Beans.Factory;

Rename the logger into Util.Beans.Factory to match the package name


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

with Util.Tests;

package Util.Streams.Tests is

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

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

   procedure Test_Base64_Stream (T : in out Test);

end Util.Streams.Tests;

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

with Util.Tests;

package Util.Streams.Tests is

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

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

   procedure Test_Base64_Stream (T : in out Test);

   procedure Test_AES_Stream (T : in out Test);

end Util.Streams.Tests;

Declare Test_AES_Stream test

Declare Test_AES_Stream test