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

with Ada.Directories;

package body Orka.Resources.Locations.Directories is

   use Ada.Streams;

   function Open_File (File_Name : String) return Byte_Array_File is
   begin
      return Result : Byte_Array_File
        := (Ada.Finalization.Limited_Controlled with File => <>, Finalized => False) do
         Stream_IO.Open (Result.File, Stream_IO.In_File, File_Name);
      end return;
   end Open_File;

   overriding
   procedure Finalize (Object : in out Byte_Array_File) is
   begin
      if not Object.Finalized then
         if Stream_IO.Is_Open (Object.File) then
            Stream_IO.Close (Object.File);
         end if;
         Object.Finalized := True;
      end if;
   end Finalize;

   function Read_File (Object : in out Byte_Array_File) return Byte_Array_Access is
      File_Stream : Stream_IO.Stream_Access;
      File_Size   : constant Integer := Integer (Stream_IO.Size (Object.File));

      subtype File_Byte_Array is Byte_Array (1 .. Stream_Element_Offset (File_Size));
      Raw_Contents : Byte_Array_Access := new File_Byte_Array;
   begin
      File_Stream := Stream_IO.Stream (Object.File);
      File_Byte_Array'Read (File_Stream, Raw_Contents.all);
      return Raw_Contents;
   exception
      when others =>
         Free_Byte_Array (Raw_Contents);
         raise;
   end Read_File;

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

   function Create_File (File_Name : String) return Byte_Array_File is
   begin
      return Result : Byte_Array_File
        := (Ada.Finalization.Limited_Controlled with File => <>, Finalized => False) do
         Stream_IO.Create (Result.File, Stream_IO.Out_File, File_Name);
      end return;
   end Create_File;

   procedure Write_Data (Object : in out Byte_Array_File; Data : Byte_Array_Access) is
      File_Stream : Stream_IO.Stream_Access;
      File_Size   : constant Integer := Data'Length;

      subtype File_Byte_Array is Byte_Array (1 .. Stream_Element_Offset (File_Size));
   begin
      File_Stream := Stream_IO.Stream (Object.File);
      File_Byte_Array'Write (File_Stream, Data.all);
   end Write_Data;

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

   overriding
   function Exists (Object : Directory_Location; Path : String) return Boolean is
      Directory : String renames SU.To_String (Object.Full_Path);
      Full_Path : constant String := Directory & Path_Separator & Path;
   begin
      return Ada.Directories.Exists (Full_Path);
   end Exists;

   overriding
   function Read_Data
     (Object : Directory_Location;
      Path   : String) return not null Byte_Array_Access
   is
      Directory : String renames SU.To_String (Object.Full_Path);
      Full_Path : constant String := Directory & Path_Separator & Path;

      use Ada.Directories;
   begin
      if not Exists (Full_Path) then
         raise Name_Error with "File '" & Full_Path & "' not found";
      end if;

      if Kind (Full_Path) /= Ordinary_File then
         raise Name_Error with "Path '" & Full_Path & "' is not a regular file";
      end if;

      declare
         File : constant Byte_Array_File'Class := Open_File (Full_Path);
      begin
         return File.Read_File;
      end;
   end Read_Data;

   overriding
   procedure Write_Data
     (Object : Writable_Directory_Location;
      Path   : String;
      Data   : Byte_Array_Access)
   is
      Directory : String renames SU.To_String (Object.Full_Path);
      Full_Path : constant String := Directory & Path_Separator & Path;

      use Ada.Directories;
   begin
      if Exists (Full_Path) then
         raise Name_Error with "File '" & Full_Path & "' already exists";
      end if;

      declare
         File : constant Byte_Array_File'Class := Create_File (Full_Path);
      begin
         File.Write_Data (Data);
      end;
   end Write_Data;

   function Create_Location (Path : String) return Location_Ptr is
      use Ada.Directories;

      Full_Path : constant String := Full_Name (Path);
   begin
      if not Exists (Full_Path) then
         raise Name_Error with "Directory '" & Full_Path & "' not found";
      end if;

      if Kind (Full_Path) /= Directory then
         raise Name_Error with "Path '" & Full_Path & "' is not a directory";
      end if;

      return new Directory_Location'(Full_Path => SU.To_Unbounded_String (Full_Path));
   end Create_Location;

   function Create_Location (Path : String) return Writable_Location_Ptr is
      use Ada.Directories;

      Full_Path : constant String := Full_Name (Path);
   begin
      if not Exists (Full_Path) then
         raise Name_Error with "Directory '" & Full_Path & "' not found";
      end if;

      if Kind (Full_Path) /= Directory then
         raise Name_Error with "Path '" & Full_Path & "' is not a directory";
      end if;

      --  The pointer is stored in a variable to make the compiler happy
      return Result : constant Writable_Location_Ptr
        := new Writable_Directory_Location'(Full_Path => SU.To_Unbounded_String (Full_Path)) do
         null;
      end return;
   end Create_Location;

end Orka.Resources.Locations.Directories;

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

with Ada.Directories;

package body Orka.Resources.Locations.Directories is

   use Ada.Streams;

   function Open_File (File_Name : String) return Byte_Array_File is
   begin
      return Result : Byte_Array_File
        := (Ada.Finalization.Limited_Controlled with File => <>, Finalized => False) do
         Stream_IO.Open (Result.File, Stream_IO.In_File, File_Name);
      end return;
   end Open_File;

   overriding
   procedure Finalize (Object : in out Byte_Array_File) is
   begin
      if not Object.Finalized then
         if Stream_IO.Is_Open (Object.File) then
            Stream_IO.Close (Object.File);
         end if;
         Object.Finalized := True;
      end if;
   end Finalize;

   function Read_File (Object : Byte_Array_File) return Byte_Array_Access is
      File_Stream : Stream_IO.Stream_Access;
      File_Size   : constant Integer := Integer (Stream_IO.Size (Object.File));

      subtype File_Byte_Array is Byte_Array (1 .. Stream_Element_Offset (File_Size));
      Raw_Contents : Byte_Array_Access := new File_Byte_Array;
   begin
      File_Stream := Stream_IO.Stream (Object.File);
      File_Byte_Array'Read (File_Stream, Raw_Contents.all);
      return Raw_Contents;
   exception
      when others =>
         Free_Byte_Array (Raw_Contents);
         raise;
   end Read_File;

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

   function Create_File (File_Name : String) return Byte_Array_File is
   begin
      return Result : Byte_Array_File
        := (Ada.Finalization.Limited_Controlled with File => <>, Finalized => False) do
         Stream_IO.Create (Result.File, Stream_IO.Out_File, File_Name);
      end return;
   end Create_File;

   procedure Write_Data (Object : Byte_Array_File; Data : Byte_Array_Access) is
      File_Stream : Stream_IO.Stream_Access;
      File_Size   : constant Integer := Data'Length;

      subtype File_Byte_Array is Byte_Array (1 .. Stream_Element_Offset (File_Size));
   begin
      File_Stream := Stream_IO.Stream (Object.File);
      File_Byte_Array'Write (File_Stream, Data.all);
   end Write_Data;

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

   overriding
   function Exists (Object : Directory_Location; Path : String) return Boolean is
      Directory : String renames SU.To_String (Object.Full_Path);
      Full_Path : constant String := Directory & Path_Separator & Path;
   begin
      return Ada.Directories.Exists (Full_Path);
   end Exists;

   overriding
   function Read_Data
     (Object : Directory_Location;
      Path   : String) return not null Byte_Array_Access
   is
      Directory : String renames SU.To_String (Object.Full_Path);
      Full_Path : constant String := Directory & Path_Separator & Path;

      use Ada.Directories;
   begin
      if not Exists (Full_Path) then
         raise Name_Error with "File '" & Full_Path & "' not found";
      end if;

      if Kind (Full_Path) /= Ordinary_File then
         raise Name_Error with "Path '" & Full_Path & "' is not a regular file";
      end if;

      declare
         File : constant Byte_Array_File := Open_File (Full_Path);
      begin
         return File.Read_File;
      end;
   end Read_Data;

   overriding
   procedure Write_Data
     (Object : Writable_Directory_Location;
      Path   : String;
      Data   : Byte_Array_Access)
   is
      Directory : String renames SU.To_String (Object.Full_Path);
      Full_Path : constant String := Directory & Path_Separator & Path;

      use Ada.Directories;
   begin
      if Exists (Full_Path) then
         raise Name_Error with "File '" & Full_Path & "' already exists";
      end if;

      declare
         File : constant Byte_Array_File := Create_File (Full_Path);
      begin
         File.Write_Data (Data);
      end;
   end Write_Data;

   function Create_Location (Path : String) return Location_Ptr is
      use Ada.Directories;

      Full_Path : constant String := Full_Name (Path);
   begin
      if not Exists (Full_Path) then
         raise Name_Error with "Directory '" & Full_Path & "' not found";
      end if;

      if Kind (Full_Path) /= Directory then
         raise Name_Error with "Path '" & Full_Path & "' is not a directory";
      end if;

      return new Directory_Location'(Full_Path => SU.To_Unbounded_String (Full_Path));
   end Create_Location;

   function Create_Location (Path : String) return Writable_Location_Ptr is
      use Ada.Directories;

      Full_Path : constant String := Full_Name (Path);
   begin
      if not Exists (Full_Path) then
         raise Name_Error with "Directory '" & Full_Path & "' not found";
      end if;

      if Kind (Full_Path) /= Directory then
         raise Name_Error with "Path '" & Full_Path & "' is not a directory";
      end if;

      --  The pointer is stored in a variable to make the compiler happy
      return Result : constant Writable_Location_Ptr
        := new Writable_Directory_Location'(Full_Path => SU.To_Unbounded_String (Full_Path)) do
         null;
      end return;
   end Create_Location;

end Orka.Resources.Locations.Directories;

Fix compile errors with GCC 8

Fix compile errors with GCC 8

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  wiki-filters -- Wiki filters
--  Copyright (C) 2015, 2016, 2020, 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.
-----------------------------------------------------------------------

package body Wiki.Filters is

   --  ------------------------------
   --  Add a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH to the document.
   --  ------------------------------
   procedure Add_Node (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Documents.Document;
                       Kind      : in Wiki.Nodes.Simple_Node_Kind) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Node (Document, Kind);
      else
         Document.Append (Kind);
      end if;
   end Add_Node;

   --  ------------------------------
   --  Add a text content with the given format to the document.
   --  ------------------------------
   procedure Add_Text (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Documents.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Format_Map) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Text (Document, Text, Format);
      else
         Wiki.Documents.Append (Document, Text, Format);
      end if;
   end Add_Text;

   --  ------------------------------
   --  Add a section header with the given level in the document.
   --  ------------------------------
   procedure Add_Header (Filter    : in out Filter_Type;
                         Document  : in out Wiki.Documents.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Header (Document, Header, Level);
      else
         Wiki.Documents.Append (Document, Header, Level);
      end if;
   end Add_Header;

   --  ------------------------------
   --  Add a definition item at end of the document.
   --  ------------------------------
   procedure Add_Definition (Filter     : in out Filter_Type;
                             Document   : in out Wiki.Documents.Document;
                             Definition : in Wiki.Strings.WString) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Definition (Document, Definition);
      else
         Wiki.Documents.Add_Definition (Document, Definition);
      end if;
   end Add_Definition;

   --  ------------------------------
   --  Push a HTML node with the given tag to the document.
   --  ------------------------------
   procedure Push_Node (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Tag        : in Wiki.Html_Tag;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Filter.Next /= null then
         Filter.Next.Push_Node (Document, Tag, Attributes);
      else
         Document.Push_Node (Tag, Attributes);
      end if;
   end Push_Node;

   --  ------------------------------
   --  Pop a HTML node with the given tag.
   --  ------------------------------
   procedure Pop_Node (Filter   : in out Filter_Type;
                       Document : in out Wiki.Documents.Document;
                       Tag      : in Wiki.Html_Tag) is
   begin
      if Filter.Next /= null then
         Filter.Next.Pop_Node (Document, Tag);
      else
         Document.Pop_Node (Tag);
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Filter   : in out Filter_Type;
                             Document : in out Wiki.Documents.Document;
                             Level    : in Natural) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Blockquote (Document, Level);
      else
         Document.Add_Blockquote (Level);
      end if;
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list (<ul> or <ol>) starting at the given number.
   --  ------------------------------
   procedure Add_List (Filter   : in out Filter_Type;
                       Document : in out Wiki.Documents.Document;
                       Level    : in Positive;
                       Ordered  : in Boolean) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_List (Document, Level, Ordered);
      else
         Document.Add_List (Level, Ordered);
      end if;
   end Add_List;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Filter     : in out Filter_Type;
                       Document   : in out Wiki.Documents.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Link (Document, Name, Attributes);
      else
         Document.Add_Link (Name, Attributes);
      end if;
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Image (Document, Name, Attributes);
      else
         Document.Add_Image (Name, Attributes);
      end if;
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Quote (Document, Name, Attributes);
      else
         Document.Add_Quote (Name, Attributes);
      end if;
   end Add_Quote;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Filter   : in out Filter_Type;
                               Document : in out Wiki.Documents.Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Preformatted (Document, Text, Format);
      else
         Document.Add_Preformatted (Text, Format);
      end if;
   end Add_Preformatted;

   --  ------------------------------
   --  Add a new row to the current table.
   --  ------------------------------
   procedure Add_Row (Filter   : in out Filter_Type;
                      Document : in out Wiki.Documents.Document) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Row (Document);
      else
         Document.Add_Row;
      end if;
   end Add_Row;

   --  ------------------------------
   --  Add a column to the current table row.  The column is configured with the
   --  given attributes.  The column content is provided through calls to Append.
   --  ------------------------------
   procedure Add_Column (Filter     : in out Filter_Type;
                         Document   : in out Wiki.Documents.Document;
                         Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Column (Document, Attributes);
      else
         Document.Add_Column (Attributes);
      end if;
   end Add_Column;

   --  ------------------------------
   --  Finish the creation of the table.
   --  ------------------------------
   procedure Finish_Table (Filter   : in out Filter_Type;
                           Document : in out Wiki.Documents.Document) is
   begin
      if Filter.Next /= null then
         Filter.Next.Finish_Table (Document);
      else
         Document.Finish_Table;
      end if;
   end Finish_Table;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   procedure Finish (Filter   : in out Filter_Type;
                     Document : in out Wiki.Documents.Document) is
   begin
      if Filter.Next /= null then
         Filter.Next.Finish (Document);
      end if;
   end Finish;

   --  ------------------------------
   --  Add the filter at beginning of the filter chain.
   --  ------------------------------
   procedure Add_Filter (Chain  : in out Filter_Chain;
                         Filter : in Filter_Type_Access) is
   begin
      Filter.Next := Chain.Next;
      Chain.Next := Filter;
   end Add_Filter;

   --  ------------------------------
   --  Internal operation to copy the filter chain.
   --  ------------------------------
   procedure Set_Chain (Chain : in out Filter_Chain;
                        From  : in Filter_Chain'Class) is
   begin
      Chain.Next := From.Next;
   end Set_Chain;

end Wiki.Filters;

-----------------------------------------------------------------------
--  wiki-filters -- Wiki filters
--  Copyright (C) 2015, 2016, 2020, 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.
-----------------------------------------------------------------------

package body Wiki.Filters is

   --  ------------------------------
   --  Add a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH to the document.
   --  ------------------------------
   procedure Add_Node (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Documents.Document;
                       Kind      : in Wiki.Nodes.Simple_Node_Kind) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Node (Document, Kind);
      else
         Document.Append (Kind);
      end if;
   end Add_Node;

   --  ------------------------------
   --  Add a text content with the given format to the document.
   --  ------------------------------
   procedure Add_Text (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Documents.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Format_Map) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Text (Document, Text, Format);
      else
         Wiki.Documents.Append (Document, Text, Format);
      end if;
   end Add_Text;

   --  ------------------------------
   --  Add a section header with the given level in the document.
   --  ------------------------------
   procedure Add_Header (Filter    : in out Filter_Type;
                         Document  : in out Wiki.Documents.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural) is
   begin
   --   if Filter.Next /= null then
   --      Filter.Next.Add_Header (Document, Header, Level);
   --   else
   --      Wiki.Documents.Append (Document, Header, Level);
   --   end if;
      null;
   end Add_Header;

   --  ------------------------------
   --  Add a definition item at end of the document.
   --  ------------------------------
   procedure Add_Definition (Filter     : in out Filter_Type;
                             Document   : in out Wiki.Documents.Document;
                             Definition : in Wiki.Strings.WString) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Definition (Document, Definition);
      else
         Wiki.Documents.Add_Definition (Document, Definition);
      end if;
   end Add_Definition;

   procedure Start_Block (Filter   : in out Filter_Type;
                          Document : in out Wiki.Documents.Document;
                          Kind     : in Wiki.Nodes.Node_Kind;
                          Level    : in Natural) is
   begin
      if Filter.Next /= null then
         Filter.Next.Start_Block (Document, Kind, Level);
      else
         Document.Start_Block (Kind, Level);
      end if;
   end Start_Block;

   procedure End_Block (Filter   : in out Filter_Type;
                        Document : in out Wiki.Documents.Document;
                        Kind     : in Wiki.Nodes.Node_Kind) is
   begin
      if Filter.Next /= null then
         Filter.Next.End_Block (Document, Kind);
      else
         Document.End_Block (Kind);
      end if;
   end End_Block;

   --  ------------------------------
   --  Push a HTML node with the given tag to the document.
   --  ------------------------------
   procedure Push_Node (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Tag        : in Wiki.Html_Tag;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Filter.Next /= null then
         Filter.Next.Push_Node (Document, Tag, Attributes);
      else
         Document.Push_Node (Tag, Attributes);
      end if;
   end Push_Node;

   --  ------------------------------
   --  Pop a HTML node with the given tag.
   --  ------------------------------
   procedure Pop_Node (Filter   : in out Filter_Type;
                       Document : in out Wiki.Documents.Document;
                       Tag      : in Wiki.Html_Tag) is
   begin
      if Filter.Next /= null then
         Filter.Next.Pop_Node (Document, Tag);
      else
         Document.Pop_Node (Tag);
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Filter   : in out Filter_Type;
                             Document : in out Wiki.Documents.Document;
                             Level    : in Natural) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Blockquote (Document, Level);
      else
         Document.Add_Blockquote (Level);
      end if;
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list (<ul> or <ol>) starting at the given number.
   --  ------------------------------
   procedure Add_List (Filter   : in out Filter_Type;
                       Document : in out Wiki.Documents.Document;
                       Level    : in Natural;
                       Ordered  : in Boolean) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_List (Document, Level, Ordered);
      else
         Document.Add_List (Level, Ordered);
      end if;
   end Add_List;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Filter     : in out Filter_Type;
                       Document   : in out Wiki.Documents.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Link (Document, Name, Attributes);
      else
         Document.Add_Link (Name, Attributes);
      end if;
   end Add_Link;

   --  ------------------------------
   --  Add a link reference with the given label.
   --  ------------------------------
   procedure Add_Link_Ref (Filter     : in out Filter_Type;
                           Document   : in out Wiki.Documents.Document;
                           Label      : in Wiki.Strings.WString) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Link_Ref (Document, Label);
      else
         Document.Add_Link_Ref (Label);
      end if;
   end Add_Link_Ref;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Image (Document, Name, Attributes);
      else
         Document.Add_Image (Name, Attributes);
      end if;
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Documents.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Quote (Document, Name, Attributes);
      else
         Document.Add_Quote (Name, Attributes);
      end if;
   end Add_Quote;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Filter   : in out Filter_Type;
                               Document : in out Wiki.Documents.Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Preformatted (Document, Text, Format);
      else
         Document.Add_Preformatted (Text, Format);
      end if;
   end Add_Preformatted;

   --  ------------------------------
   --  Add a new row to the current table.
   --  ------------------------------
   procedure Add_Row (Filter   : in out Filter_Type;
                      Document : in out Wiki.Documents.Document) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Row (Document);
      else
         Document.Add_Row;
      end if;
   end Add_Row;

   --  ------------------------------
   --  Add a column to the current table row.  The column is configured with the
   --  given attributes.  The column content is provided through calls to Append.
   --  ------------------------------
   procedure Add_Column (Filter     : in out Filter_Type;
                         Document   : in out Wiki.Documents.Document;
                         Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Column (Document, Attributes);
      else
         Document.Add_Column (Attributes);
      end if;
   end Add_Column;

   --  ------------------------------
   --  Finish the creation of the table.
   --  ------------------------------
   procedure Finish_Table (Filter   : in out Filter_Type;
                           Document : in out Wiki.Documents.Document) is
   begin
      if Filter.Next /= null then
         Filter.Next.Finish_Table (Document);
      else
         Document.Finish_Table;
      end if;
   end Finish_Table;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   procedure Finish (Filter   : in out Filter_Type;
                     Document : in out Wiki.Documents.Document) is
   begin
      if Filter.Next /= null then
         Filter.Next.Finish (Document);
      end if;
   end Finish;

   --  ------------------------------
   --  Add the filter at beginning of the filter chain.
   --  ------------------------------
   procedure Add_Filter (Chain  : in out Filter_Chain;
                         Filter : in Filter_Type_Access) is
   begin
      Filter.Next := Chain.Next;
      Chain.Next := Filter;
   end Add_Filter;

   --  ------------------------------
   --  Internal operation to copy the filter chain.
   --  ------------------------------
   procedure Set_Chain (Chain : in out Filter_Chain;
                        From  : in Filter_Chain'Class) is
   begin
      Chain.Next := From.Next;
   end Set_Chain;

end Wiki.Filters;

Add Start_Block, End_Block, Add_Link_Ref


-----------------------------------------------------------------------
--  Frames - Representation of stack frames
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
with MAT.Types;
with System.Address_Image;
with Interfaces;
procedure MAT.Frames.Print (File : in File_Type;
                                  F : in Frame_Type) is

   use MAT.Types;
   use Interfaces;

   Depth : Natural := F.Depth - F.Local_Depth + 1;
   Child : Frame_Type;

   procedure Print_Address (File : in File_Type;
                            Addr : in Target_Addr);

   function Hex_Image (Val : Target_Addr; Len : Positive) return String;

   function Hex_Image (Val : Target_Addr; Len : Positive) return String is
      Conversion : constant String (1 .. 16) := "0123456789ABCDEF";
      S : String (1 .. Len) := (others => '0');
      P : Target_Addr := Val;
      N : Target_Addr;
      I : Positive := Len;
   begin
      while P /= 0 loop
         N := P mod 16;
         P := P / 16;
         S (I) := Conversion (Natural (N + 1));
         exit when I = 1;
         I := I - 1;
      end loop;
      return S;
   end Hex_Image;

   procedure Print_Address (File : in File_Type;
                            Addr : in Target_Addr) is
   begin
      Put (File, Hex_Image (Addr, 20));
   end Print_Address;

begin
   Set_Col (File, Positive_Count (Depth));
   if F.Parent = null then
      Put_Line (File, "R " & Natural'Image (F.Used) & " - " & System.Address_Image (F.all'Address));
   else
      Put_Line (File, "F " & Natural'Image (F.Used) & " - " & System.Address_Image (F.all'Address)
                & " - P=" & System.Address_Image (F.Parent.all'Address));
   end if;
   for I in 1 .. F.Local_Depth loop
      Set_Col (File, Positive_Count (Depth));
      Print_Address (File, F.Calls (I));
      Put_Line (File, " D " & Natural'Image (Depth));
      Depth := Depth + 1;
   end loop;
   Child := F.Children;
   while Child /= null loop
      Print (File, Child);
      Child := Child.Next;
   end loop;
end MAT.Frames.Print;

-----------------------------------------------------------------------
--  Frames - Representation of stack frames
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
with MAT.Types;
with System.Address_Image;
with Interfaces;
procedure MAT.Frames.Print (File : in File_Type;
                                  F : in Frame_Type) is

   use MAT.Types;
   use Interfaces;

   Depth : Natural := F.Depth;
   Child : Frame_Type;

   procedure Print_Address (File : in File_Type;
                            Addr : in Target_Addr);

   function Hex_Image (Val : Target_Addr; Len : Positive) return String;

   function Hex_Image (Val : Target_Addr; Len : Positive) return String is
      Conversion : constant String (1 .. 16) := "0123456789ABCDEF";
      S : String (1 .. Len) := (others => '0');
      P : Target_Addr := Val;
      N : Target_Addr;
      I : Positive := Len;
   begin
      while P /= 0 loop
         N := P mod 16;
         P := P / 16;
         S (I) := Conversion (Natural (N + 1));
         exit when I = 1;
         I := I - 1;
      end loop;
      return S;
   end Hex_Image;

   procedure Print_Address (File : in File_Type;
                            Addr : in Target_Addr) is
   begin
      Put (File, Hex_Image (Addr, 20));
   end Print_Address;

begin
   Set_Col (File, Positive_Count (Depth));
   if F.Parent = null then
      Put_Line (File, "R " & Natural'Image (F.Used) & " - " & System.Address_Image (F.all'Address));
   else
      Put_Line (File, "F " & Natural'Image (F.Used) & " - " & System.Address_Image (F.all'Address)
                & " - P=" & System.Address_Image (F.Parent.all'Address));
   end if;
   Set_Col (File, Positive_Count (Depth));
   Print_Address (File, F.Pc);
   Put_Line (File, " D " & Natural'Image (Depth));
   Child := F.Children;
   while Child /= null loop
      Print (File, Child);
      Child := Child.Next;
   end loop;
end MAT.Frames.Print;

Update the Print of stack frame

Update the Print of stack frame


-----------------------------------------------------------------------
--  util-encoders-base64 -- Encode/Decode a stream in base64adecimal
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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 Util.Streams;
package body Util.Encoders.Base64 is

   use Interfaces;
   use Ada;

   use type Ada.Streams.Stream_Element_Offset;

   --  ------------------------------
   --  Encode the 64-bit value to LEB128 and then base64url.
   --  ------------------------------
   function Encode (Value : in Interfaces.Unsigned_64) return String is
      E       : Encoder;
      Data    : Ada.Streams.Stream_Element_Array (1 .. 10);
      Last    : Ada.Streams.Stream_Element_Offset;
      Encoded : Ada.Streams.Stream_Element_Offset;
      Result  : String (1 .. 16);
      Buf     : Ada.Streams.Stream_Element_Array (1 .. Result'Length);
      for Buf'Address use Result'Address;
      pragma Import (Ada, Buf);
   begin
      --  Encode the integer to LEB128 in the data buffer.
      Encode_LEB128 (Into => Data,
                     Pos  => Data'First,
                     Val  => Value,
                     Last => Last);

      --  Encode the data buffer in base64url.
      E.Set_URL_Mode (True);
      E.Transform (Data    => Data (Data'First .. Last),
                   Into    => Buf,
                   Last    => Last,
                   Encoded => Encoded);
      E.Finish (Into => Buf (Last + 1 .. Buf'Last),
                Last => Last);

      --  Strip the '=' or '==' at end of base64url.
      if Result (Positive (Last)) /= '=' then
         return Result (Result'First .. Positive (Last));
      elsif Result (Positive (Last) - 1) /= '=' then
         return Result (Result'First .. Positive (Last) - 1);
      else
         return Result (Result'First .. Positive (Last) - 2);
      end if;
   end Encode;

   --  ------------------------------
   --  Decode the base64url string and then the LEB128 integer.
   --  Raise the Encoding_Error if the string is invalid and cannot be decoded.
   --  ------------------------------
   function Decode (Value : in String) return Interfaces.Unsigned_64 is
      D       : Decoder;
      Buf     : Ada.Streams.Stream_Element_Array (1 .. Value'Length + 2);
      R       : Ada.Streams.Stream_Element_Array (1 .. Value'Length + 2);
      Last    : Ada.Streams.Stream_Element_Offset;
      Encoded : Ada.Streams.Stream_Element_Offset;
      Result  : Interfaces.Unsigned_64;
      End_Pos : constant Ada.Streams.Stream_Element_Offset
        := Value'Length + ((4 - (Value'Length mod 4)) mod 4);
   begin
      if Buf'Length < End_Pos then
         raise Encoding_Error with "Input string is too short";
      end if;
      Util.Streams.Copy (Into => Buf (1 .. Value'Length), From => Value);

      --  Set back the '=' for the base64url (pad to multiple of 4.
      Buf (Value'Length + 1) := Character'Pos ('=');
      Buf (Value'Length + 2) := Character'Pos ('=');

      --  Decode using base64url
      D.Set_URL_Mode (True);
      D.Transform (Data    => Buf (Buf'First .. End_Pos),
                   Into    => R,
                   Last    => Last,
                   Encoded => Encoded);
      if Encoded /= End_Pos then
         raise Encoding_Error with "Input string is too short";
      end if;

      --  Decode the LEB128 number.
      Decode_LEB128 (From => R (R'First .. Last),
                     Pos  => R'First,
                     Val  => Result,
                     Last => Encoded);

      --  Check that everything was decoded.
      if Last + 1 /= Encoded then
         raise Encoding_Error with "Input string contains garbage at the end";
      end if;
      return Result;
   end Decode;

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

      Pos      : Ada.Streams.Stream_Element_Offset := Into'First;
      I        : Ada.Streams.Stream_Element_Offset := Data'First;
      C1, C2   : Unsigned_8;

      Alphabet : constant Alphabet_Access := E.Alphabet;

   begin
      while E.Count /= 0 and I <= Data'Last loop
         if E.Count = 2 then
            C1 := E.Value;
            C2 := Unsigned_8 (Data (I));
            Into (Pos) := Alphabet (Shift_Left (C1 and 16#03#, 4) or Shift_Right (C2, 4));
            Pos := Pos + 1;
            I := I + 1;
            E.Count := 1;
            E.Value := C2;
         else
            C2 := E.Value;
            C1 := Unsigned_8 (Data (I));
            Into (Pos) := Alphabet (Shift_Left (C2 and 16#0F#, 2) or Shift_Right (C1, 6));
            Into (Pos + 1) := Alphabet (C1 and 16#03F#);
            Pos := Pos + 2;
            I := I + 1;
            E.Count := 0;
         end if;
      end loop;
      while I <= Data'Last loop
         if Pos + 4 > Into'Last + 1 then
            Last    := Pos - 1;
            Encoded := I - 1;
            E.Count := 0;
            return;
         end if;

         --  Encode the first byte, add padding if necessary.
         C1 := Unsigned_8 (Data (I));
         Into (Pos) := Alphabet (Shift_Right (C1, 2));
         if I = Data'Last then
            E.Value := C1;
            E.Count := 2;
            Last := Pos;
            Encoded := Data'Last;
            return;
         end if;

         --  Encode the second byte, add padding if necessary.
         C2 := Unsigned_8 (Data (I + 1));
         Into (Pos + 1) := Alphabet (Shift_Left (C1 and 16#03#, 4) or Shift_Right (C2, 4));
         if I = Data'Last - 1 then
            E.Value := C2;
            E.Count := 1;
            Last := Pos + 1;
            Encoded := Data'Last;
            return;
         end if;

         --  Encode the third byte
         C1 := Unsigned_8 (Data (I + 2));
         Into (Pos + 2) := Alphabet (Shift_Left (C2 and 16#0F#, 2) or Shift_Right (C1, 6));
         Into (Pos + 3) := Alphabet (C1 and 16#03F#);
         Pos := Pos + 4;
         I   := I + 3;
      end loop;
      E.Count := 0;
      Last    := Pos - 1;
      Encoded := Data'Last;
   end Transform;

   --  ------------------------------
   --  Finish encoding the input array.
   --  ------------------------------
   overriding
   procedure Finish (E    : in out Encoder;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset) is
      Pos : constant Ada.Streams.Stream_Element_Offset := Into'First;
   begin
      if E.Count = 2 then
         Into (Pos) := E.Alphabet (Shift_Left (E.Value and 3, 4));
         Into (Pos + 1) := Character'Pos ('=');
         Into (Pos + 2) := Character'Pos ('=');
         Last := Pos + 2;
         E.Count := 0;
      elsif E.Count = 1 then
         Into (Pos) := E.Alphabet (Shift_Left (E.Value and 16#0F#, 2));
         Into (Pos + 1) := Character'Pos ('=');
         Last := Pos + 1;
         E.Count := 0;
      else
         Last := Pos - 1;
      end if;
   end Finish;

   --  ------------------------------
   --  Set the encoder to use the base64 URL alphabet when Mode is True.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   procedure Set_URL_Mode (E    : in out Encoder;
                           Mode : in Boolean) is
   begin
      if Mode then
         E.Alphabet := BASE64_URL_ALPHABET'Access;
      else
         E.Alphabet := BASE64_ALPHABET'Access;
      end if;
   end Set_URL_Mode;

   --  ------------------------------
   --  Create a base64 encoder using the URL alphabet.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   function Create_URL_Encoder return Transformer_Access is
   begin
      return new Encoder '(Alphabet => BASE64_URL_ALPHABET'Access, others => <>);
   end Create_URL_Encoder;

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

      use Ada.Streams;

      Pos      : Ada.Streams.Stream_Element_Offset := Into'First;
      I        : Ada.Streams.Stream_Element_Offset := Data'First;
      C1, C2   : Ada.Streams.Stream_Element;
      Val1, Val2 : Unsigned_8;

      Values : constant Alphabet_Values_Access := E.Values;

   begin
      while I <= Data'Last loop
         if Pos + 3 > Into'Last + 1 then
            Last    := Pos - 1;
            Encoded := I - 1;
            return;
         end if;

         --  Decode the first two bytes to produce the first output byte
         C1 := Data (I);
         Val1 := Values (C1);
         if (Val1 and 16#C0#) /= 0 then
            raise Encoding_Error with "Invalid character '" & Character'Val (C1) & "'";
         end if;

         C2 := Data (I + 1);
         Val2 := Values (C2);
         if (Val2 and 16#C0#) /= 0 then
            raise Encoding_Error with "Invalid character '" & Character'Val (C2) & "'";
         end if;

         Into (Pos) := Stream_Element (Shift_Left (Val1, 2) or Shift_Right (Val2, 4));

         if I + 2 > Data'Last then
            Encoded := I + 1;
            Last    := Pos;
            return;
         end if;

         --  Decode the next byte
         C1 := Data (I + 2);
         Val1 := Values (C1);
         if (Val1 and 16#C0#) /= 0 then
            if C1 /= Character'Pos ('=') then
               raise Encoding_Error with "Invalid character '" & Character'Val (C1) & "'";
            end if;
            Encoded := I + 3;
            Last    := Pos;
            return;
         end if;

         Into (Pos + 1) := Stream_Element (Shift_Left (Val2, 4) or Shift_Right (Val1, 2));

         if I + 3 > Data'Last then
            Encoded := I + 2;
            Last    := Pos + 1;
            return;
         end if;

         C2 := Data (I + 3);
         Val2 := Values (C2);
         if (Val2 and 16#C0#) /= 0 then
            if C2 /= Character'Pos ('=') then
               raise Encoding_Error with "Invalid character '" & Character'Val (C2) & "'";
            end if;
            Encoded := I + 3;
            Last    := Pos + 1;
            return;
         end if;

         Into (Pos + 2) := Stream_Element (Shift_Left (Val1, 6) or Val2);
         Pos := Pos + 3;
         I   := I + 4;
      end loop;
      Last    := Pos - 1;
      Encoded := Data'Last;
   end Transform;

   --  ------------------------------
   --  Set the decoder to use the base64 URL alphabet when Mode is True.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   procedure Set_URL_Mode (E    : in out Decoder;
                           Mode : in Boolean) is
   begin
      if Mode then
         E.Values := BASE64_URL_VALUES'Access;
      else
         E.Values := BASE64_VALUES'Access;
      end if;
   end Set_URL_Mode;

   --  ------------------------------
   --  Create a base64 decoder using the URL alphabet.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   function Create_URL_Decoder return Transformer_Access is
   begin
      return new Decoder '(Values => BASE64_URL_VALUES'Access);
   end Create_URL_Decoder;

end Util.Encoders.Base64;

-----------------------------------------------------------------------
--  util-encoders-base64 -- Encode/Decode a stream in base64
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 2016, 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.Streams;
package body Util.Encoders.Base64 is

   use Interfaces;

   --  ------------------------------
   --  Encode the 64-bit value to LEB128 and then base64url.
   --  ------------------------------
   function Encode (Value : in Interfaces.Unsigned_64) return String is
      E       : Encoder;
      Data    : Ada.Streams.Stream_Element_Array (1 .. 10);
      Last    : Ada.Streams.Stream_Element_Offset;
      Encoded : Ada.Streams.Stream_Element_Offset;
      Result  : String (1 .. 16);
      Buf     : Ada.Streams.Stream_Element_Array (1 .. Result'Length);
      for Buf'Address use Result'Address;
      pragma Import (Ada, Buf);
   begin
      --  Encode the integer to LEB128 in the data buffer.
      Encode_LEB128 (Into => Data,
                     Pos  => Data'First,
                     Val  => Value,
                     Last => Last);

      --  Encode the data buffer in base64url.
      E.Set_URL_Mode (True);
      E.Transform (Data    => Data (Data'First .. Last),
                   Into    => Buf,
                   Last    => Last,
                   Encoded => Encoded);
      E.Finish (Into => Buf (Last + 1 .. Buf'Last),
                Last => Last);

      --  Strip the '=' or '==' at end of base64url.
      if Result (Positive (Last)) /= '=' then
         return Result (Result'First .. Positive (Last));
      elsif Result (Positive (Last) - 1) /= '=' then
         return Result (Result'First .. Positive (Last) - 1);
      else
         return Result (Result'First .. Positive (Last) - 2);
      end if;
   end Encode;

   --  ------------------------------
   --  Decode the base64url string and then the LEB128 integer.
   --  Raise the Encoding_Error if the string is invalid and cannot be decoded.
   --  ------------------------------
   function Decode (Value : in String) return Interfaces.Unsigned_64 is
      D       : Decoder;
      Buf     : Ada.Streams.Stream_Element_Array (1 .. Value'Length + 2);
      R       : Ada.Streams.Stream_Element_Array (1 .. Value'Length + 2);
      Last    : Ada.Streams.Stream_Element_Offset;
      Encoded : Ada.Streams.Stream_Element_Offset;
      Result  : Interfaces.Unsigned_64;
      End_Pos : constant Ada.Streams.Stream_Element_Offset
        := Value'Length + ((4 - (Value'Length mod 4)) mod 4);
   begin
      if Buf'Length < End_Pos then
         raise Encoding_Error with "Input string is too short";
      end if;
      Util.Streams.Copy (Into => Buf (1 .. Value'Length), From => Value);

      --  Set back the '=' for the base64url (pad to multiple of 4.
      Buf (Value'Length + 1) := Character'Pos ('=');
      Buf (Value'Length + 2) := Character'Pos ('=');

      --  Decode using base64url
      D.Set_URL_Mode (True);
      D.Transform (Data    => Buf (Buf'First .. End_Pos),
                   Into    => R,
                   Last    => Last,
                   Encoded => Encoded);
      if Encoded /= End_Pos then
         raise Encoding_Error with "Input string is too short";
      end if;

      --  Decode the LEB128 number.
      Decode_LEB128 (From => R (R'First .. Last),
                     Pos  => R'First,
                     Val  => Result,
                     Last => Encoded);

      --  Check that everything was decoded.
      if Last + 1 /= Encoded then
         raise Encoding_Error with "Input string contains garbage at the end";
      end if;
      return Result;
   end Decode;

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

      Pos      : Ada.Streams.Stream_Element_Offset := Into'First;
      I        : Ada.Streams.Stream_Element_Offset := Data'First;
      C1, C2   : Unsigned_8;

      Alphabet : constant Alphabet_Access := E.Alphabet;

   begin
      while E.Count /= 0 and I <= Data'Last loop
         if E.Count = 2 then
            C1 := E.Value;
            C2 := Unsigned_8 (Data (I));
            Into (Pos) := Alphabet (Shift_Left (C1 and 16#03#, 4) or Shift_Right (C2, 4));
            Pos := Pos + 1;
            I := I + 1;
            E.Count := 1;
            E.Value := C2;
         else
            C2 := E.Value;
            C1 := Unsigned_8 (Data (I));
            Into (Pos) := Alphabet (Shift_Left (C2 and 16#0F#, 2) or Shift_Right (C1, 6));
            Into (Pos + 1) := Alphabet (C1 and 16#03F#);
            Pos := Pos + 2;
            I := I + 1;
            E.Count := 0;
         end if;
      end loop;
      while I <= Data'Last loop
         if Pos + 4 > Into'Last + 1 then
            Last    := Pos - 1;
            Encoded := I - 1;
            E.Count := 0;
            return;
         end if;

         --  Encode the first byte, add padding if necessary.
         C1 := Unsigned_8 (Data (I));
         Into (Pos) := Alphabet (Shift_Right (C1, 2));
         if I = Data'Last then
            E.Value := C1;
            E.Count := 2;
            Last := Pos;
            Encoded := Data'Last;
            return;
         end if;

         --  Encode the second byte, add padding if necessary.
         C2 := Unsigned_8 (Data (I + 1));
         Into (Pos + 1) := Alphabet (Shift_Left (C1 and 16#03#, 4) or Shift_Right (C2, 4));
         if I = Data'Last - 1 then
            E.Value := C2;
            E.Count := 1;
            Last := Pos + 1;
            Encoded := Data'Last;
            return;
         end if;

         --  Encode the third byte
         C1 := Unsigned_8 (Data (I + 2));
         Into (Pos + 2) := Alphabet (Shift_Left (C2 and 16#0F#, 2) or Shift_Right (C1, 6));
         Into (Pos + 3) := Alphabet (C1 and 16#03F#);
         Pos := Pos + 4;
         I   := I + 3;
      end loop;
      E.Count := 0;
      Last    := Pos - 1;
      Encoded := Data'Last;
   end Transform;

   --  ------------------------------
   --  Finish encoding the input array.
   --  ------------------------------
   overriding
   procedure Finish (E    : in out Encoder;
                     Into : in out Ada.Streams.Stream_Element_Array;
                     Last : in out Ada.Streams.Stream_Element_Offset) is
      Pos : constant Ada.Streams.Stream_Element_Offset := Into'First;
   begin
      if E.Count = 2 then
         Into (Pos) := E.Alphabet (Shift_Left (E.Value and 3, 4));
         Into (Pos + 1) := Character'Pos ('=');
         Into (Pos + 2) := Character'Pos ('=');
         Last := Pos + 2;
         E.Count := 0;
      elsif E.Count = 1 then
         Into (Pos) := E.Alphabet (Shift_Left (E.Value and 16#0F#, 2));
         Into (Pos + 1) := Character'Pos ('=');
         Last := Pos + 1;
         E.Count := 0;
      else
         Last := Pos - 1;
      end if;
   end Finish;

   --  ------------------------------
   --  Set the encoder to use the base64 URL alphabet when Mode is True.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   procedure Set_URL_Mode (E    : in out Encoder;
                           Mode : in Boolean) is
   begin
      if Mode then
         E.Alphabet := BASE64_URL_ALPHABET'Access;
      else
         E.Alphabet := BASE64_ALPHABET'Access;
      end if;
   end Set_URL_Mode;

   --  ------------------------------
   --  Create a base64 encoder using the URL alphabet.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   function Create_URL_Encoder return Transformer_Access is
   begin
      return new Encoder '(Alphabet => BASE64_URL_ALPHABET'Access, others => <>);
   end Create_URL_Encoder;

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

      Pos      : Ada.Streams.Stream_Element_Offset := Into'First;
      I        : Ada.Streams.Stream_Element_Offset := Data'First;
      C1, C2   : Ada.Streams.Stream_Element;
      Val1, Val2 : Unsigned_8;

      Values : constant Alphabet_Values_Access := E.Values;

   begin
      while I <= Data'Last loop
         if Pos + 3 > Into'Last + 1 then
            Last    := Pos - 1;
            Encoded := I - 1;
            return;
         end if;

         --  Decode the first two bytes to produce the first output byte
         C1 := Data (I);
         Val1 := Values (C1);
         if (Val1 and 16#C0#) /= 0 then
            raise Encoding_Error with "Invalid character '" & Character'Val (C1) & "'";
         end if;

         C2 := Data (I + 1);
         Val2 := Values (C2);
         if (Val2 and 16#C0#) /= 0 then
            raise Encoding_Error with "Invalid character '" & Character'Val (C2) & "'";
         end if;

         Into (Pos) := Stream_Element (Shift_Left (Val1, 2) or Shift_Right (Val2, 4));

         if I + 2 > Data'Last then
            Encoded := I + 1;
            Last    := Pos;
            return;
         end if;

         --  Decode the next byte
         C1 := Data (I + 2);
         Val1 := Values (C1);
         if (Val1 and 16#C0#) /= 0 then
            if C1 /= Character'Pos ('=') then
               raise Encoding_Error with "Invalid character '" & Character'Val (C1) & "'";
            end if;
            Encoded := I + 3;
            Last    := Pos;
            return;
         end if;

         Into (Pos + 1) := Stream_Element (Shift_Left (Val2, 4) or Shift_Right (Val1, 2));

         if I + 3 > Data'Last then
            Encoded := I + 2;
            Last    := Pos + 1;
            return;
         end if;

         C2 := Data (I + 3);
         Val2 := Values (C2);
         if (Val2 and 16#C0#) /= 0 then
            if C2 /= Character'Pos ('=') then
               raise Encoding_Error with "Invalid character '" & Character'Val (C2) & "'";
            end if;
            Encoded := I + 3;
            Last    := Pos + 1;
            return;
         end if;

         Into (Pos + 2) := Stream_Element (Shift_Left (Val1, 6) or Val2);
         Pos := Pos + 3;
         I   := I + 4;
      end loop;
      Last    := Pos - 1;
      Encoded := Data'Last;
   end Transform;

   --  ------------------------------
   --  Set the decoder to use the base64 URL alphabet when Mode is True.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   procedure Set_URL_Mode (E    : in out Decoder;
                           Mode : in Boolean) is
   begin
      if Mode then
         E.Values := BASE64_URL_VALUES'Access;
      else
         E.Values := BASE64_VALUES'Access;
      end if;
   end Set_URL_Mode;

   --  ------------------------------
   --  Create a base64 decoder using the URL alphabet.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   function Create_URL_Decoder return Transformer_Access is
   begin
      return new Decoder '(Values => BASE64_URL_VALUES'Access);
   end Create_URL_Decoder;

end Util.Encoders.Base64;

Fix compilation warning

Fix compilation warning


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

with ASF.Server.Tests;

with Util.Log.Loggers;

with ASF.Tests;

with AWA.Applications.Factory;
with AWA.Tests.Helpers.Users;
package body AWA.Tests is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Tests");

   protected Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence);
   end Shutdown;

   Application_Created : Boolean := False;
   Application    : AWA.Applications.Application_Access := null;

   Factory        : AWA.Applications.Factory.Application_Factory;

   Service_Filter : aliased AWA.Services.Filters.Service_Filter;

   protected body Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence) is
         pragma Unreferenced (Cause, Id, Ex);

         procedure Free is
            new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                            Name   => AWA.Applications.Application_Access);
      begin
         Free (Application);
      end Termination;
   end Shutdown;

   --  ------------------------------
   --  Setup the service context before executing the test.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
      pragma Unreferenced (T);
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Up;

   --  ------------------------------
   --  Cleanup after the test execution.
   --  ------------------------------
   overriding
   procedure Tear_Down (T : in out Test) is
      pragma Unreferenced (T);
   begin
      AWA.Tests.Helpers.Users.Tear_Down;
   end Tear_Down;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Called when the testsuite execution has finished.
   --  ------------------------------
   procedure Finish (Status : in Util.XUnit.Status) is
      pragma Unreferenced (Status);

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                        Name   => AWA.Applications.Application_Access);

   begin
      if Application_Created then
         Free (Application);
      end if;
   end Finish;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      pragma Unreferenced (Add_Modules);
      use AWA.Applications;
   begin
      --  Create the application unless it is specified as argument.
      --  Install a shutdown hook to delete the application when the primary task exits.
      --  This allows to stop the event threads if any.
      if App = null then
         Application_Created := True;
         Application := new Test_Application;
         Ada.Task_Termination.Set_Specific_Handler (Ada.Task_Identification.Current_Task,
                                                    Shutdown.Termination'Access);
      else
         Application := App;
      end if;

      ASF.Tests.Initialize (Props, Application.all'Access, Factory);
      Application.Add_Filter ("service", Service_Filter'Access);
      Application.Add_Filter_Mapping (Name => "service", Pattern => "*.html");
      Application.Start;
   end Initialize;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return AWA.Applications.Application_Access is
   begin
      return Application;
   end Get_Application;

   --  ------------------------------
   --  Set the application context to simulate a web request context.
   --  ------------------------------
   procedure Set_Application_Context is
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Application_Context;

   --  ------------------------------
   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   --  ------------------------------
   overriding
   procedure Initialize_Servlets (App : in out Test_Application) is
   begin
      Log.Info ("Initializing application servlets...");

      AWA.Applications.Application (App).Initialize_Servlets;
      App.Add_Servlet (Name => "faces", Server => App.Faces'Unchecked_Access);
      App.Add_Servlet (Name => "files", Server => App.Files'Unchecked_Access);
      App.Add_Servlet (Name => "ajax", Server => App.Ajax'Unchecked_Access);
      App.Add_Servlet (Name => "measures", Server => App.Measures'Unchecked_Access);
--        App.Add_Servlet (Name => "auth", Server => App.Auth'Unchecked_Access);
--        App.Add_Servlet (Name => "verify-auth", Server => App.Self.Verify_Auth'Access);
   end Initialize_Servlets;

   --  ------------------------------
   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   --  ------------------------------
   overriding
   procedure Initialize_Filters (App : in out Test_Application) is
   begin
      Log.Info ("Initializing application filters...");

      AWA.Applications.Application (App).Initialize_Filters;
      App.Add_Filter (Name => "dump", Filter => App.Dump'Unchecked_Access);
      App.Add_Filter (Name => "measures", Filter => App.Measures'Unchecked_Access);
      App.Add_Filter (Name => "service", Filter => App.Service_Filter'Unchecked_Access);
   end Initialize_Filters;

end AWA.Tests;

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

with ASF.Server.Tests;

with Util.Log.Loggers;

with ASF.Tests;

with AWA.Applications.Factory;
with AWA.Tests.Helpers.Users;
package body AWA.Tests is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Tests");

   protected Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence);
   end Shutdown;

   Application_Created : Boolean := False;
   Application    : AWA.Applications.Application_Access := null;

   Factory        : AWA.Applications.Factory.Application_Factory;

   Service_Filter : aliased AWA.Services.Filters.Service_Filter;

   protected body Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence) is
         pragma Unreferenced (Cause, Id, Ex);

         procedure Free is
            new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                            Name   => AWA.Applications.Application_Access);
      begin
         Free (Application);
      end Termination;
   end Shutdown;

   --  ------------------------------
   --  Setup the service context before executing the test.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
      pragma Unreferenced (T);
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Up;

   --  ------------------------------
   --  Cleanup after the test execution.
   --  ------------------------------
   overriding
   procedure Tear_Down (T : in out Test) is
      pragma Unreferenced (T);
   begin
      AWA.Tests.Helpers.Users.Tear_Down;
   end Tear_Down;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Called when the testsuite execution has finished.
   --  ------------------------------
   procedure Finish (Status : in Util.XUnit.Status) is
      pragma Unreferenced (Status);

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                        Name   => AWA.Applications.Application_Access);

   begin
      if Application_Created then
         Application.Close;
         Free (Application);
      end if;
   end Finish;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      pragma Unreferenced (Add_Modules);
      use AWA.Applications;
   begin
      --  Create the application unless it is specified as argument.
      --  Install a shutdown hook to delete the application when the primary task exits.
      --  This allows to stop the event threads if any.
      if App = null then
         Application_Created := True;
         Application := new Test_Application;
         Ada.Task_Termination.Set_Specific_Handler (Ada.Task_Identification.Current_Task,
                                                    Shutdown.Termination'Access);
      else
         Application := App;
      end if;

      ASF.Tests.Initialize (Props, Application.all'Access, Factory);
      Application.Add_Filter ("service", Service_Filter'Access);
      Application.Add_Filter_Mapping (Name => "service", Pattern => "*.html");
      Application.Start;
   end Initialize;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return AWA.Applications.Application_Access is
   begin
      return Application;
   end Get_Application;

   --  ------------------------------
   --  Set the application context to simulate a web request context.
   --  ------------------------------
   procedure Set_Application_Context is
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Application_Context;

   --  ------------------------------
   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   --  ------------------------------
   overriding
   procedure Initialize_Servlets (App : in out Test_Application) is
   begin
      Log.Info ("Initializing application servlets...");

      AWA.Applications.Application (App).Initialize_Servlets;
      App.Add_Servlet (Name => "faces", Server => App.Faces'Unchecked_Access);
      App.Add_Servlet (Name => "files", Server => App.Files'Unchecked_Access);
      App.Add_Servlet (Name => "ajax", Server => App.Ajax'Unchecked_Access);
      App.Add_Servlet (Name => "measures", Server => App.Measures'Unchecked_Access);
--        App.Add_Servlet (Name => "auth", Server => App.Auth'Unchecked_Access);
--        App.Add_Servlet (Name => "verify-auth", Server => App.Self.Verify_Auth'Access);
   end Initialize_Servlets;

   --  ------------------------------
   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   --  ------------------------------
   overriding
   procedure Initialize_Filters (App : in out Test_Application) is
   begin
      Log.Info ("Initializing application filters...");

      AWA.Applications.Application (App).Initialize_Filters;
      App.Add_Filter (Name => "dump", Filter => App.Dump'Unchecked_Access);
      App.Add_Filter (Name => "measures", Filter => App.Measures'Unchecked_Access);
      App.Add_Filter (Name => "service", Filter => App.Service_Filter'Unchecked_Access);
   end Initialize_Filters;

end AWA.Tests;

Call the application Close procedure when tests are finished


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

package GL.Enums.Getter is
   pragma Preelaborate;

   type Parameter is
     (Point_Size,
      Point_Size_Range,
      Point_Size_Granularity,
      Line_Smooth,
      Line_Width,
      Smooth_Line_Width_Range,
      Smooth_Line_Width_Granularity,
      Polygon_Mode,
      Polygon_Smooth,
      Edge_Flag,
      Cull_Face,
      Cull_Face_Mode,
      Front_Face,
      Shade_Model,
      Depth_Range,
      Depth_Test,
      Depth_Writemask,
      Depth_Clear_Value,
      Depth_Func,
      Stencil_Test,
      Stencil_Clear_Value,
      Stencil_Func,
      Stencil_Value_Mask,
      Stencil_Fail,
      Stencil_Pass_Depth_Fail,
      Stencil_Pass_Depth_Pass,
      Stencil_Ref,
      Stencil_Writemask,
      Viewport,
      Dither,
      Blend_Dst,
      Blend_Src,
      Blend,
      Logic_Op_Mode,
      Index_Logic_Op,
      Color_Logic_Op,
      Aux_Buffers,
      Draw_Buffer,
      Read_Buffer,
      Scissor_Box,
      Scissor_Test,
      Color_Clear_Value,
      Color_Writemask,
      Index_Mode,
      Rgba_Mode,
      Doublebuffer,
      Stereo,
      Render_Mode,
      Line_Smooth_Hint,
      Polygon_Smooth_Hint,
      Unpack_Swap_Bytes,
      Unpack_Lsb_First,
      Unpack_Row_Length,
      Unpack_Skip_Rows,
      Unpack_Skip_Pixels,
      Unpack_Alignment,
      Pack_Swap_Bytes,
      Pack_Lsb_First,
      Pack_Row_Length,
      Pack_Skip_Rows,
      Pack_Skip_Pixels,
      Pack_Alignment,
      Max_Clip_Distances,
      Max_Texture_Size,
      Max_Pixel_Map_Table,
      Max_Viewport_Dims,
      Subpixel_Bits,
      Texture_1D,
      Texture_2D,
      Feedback_Buffer_Pointer,
      Feedback_Buffer_Size,
      Feedback_Buffer_Type,
      Selection_Buffer_Pointer,
      Selection_Buffer_Size,
      Blend_Color,
      Blend_Equation_RGB,
      Pack_Skip_Images,
      Pack_Image_Height,
      Unpack_Skip_Images,
      Unpack_Image_Height,
      Blend_Dst_RGB,
      Blend_Src_RGB,
      Blend_Dst_Alpha,
      Blend_Src_Alpha,
      Major_Version,
      Minor_Version,
      Num_Extensions,
      Num_Shading_Language_Versions,
      Aliased_Line_Width_Range,
      Active_Texture,
      Max_Texture_Max_Anisotropy,
      Stencil_Back_Func,
      Stencil_Back_Fail,
      Stencil_Back_Pass_Depth_Fail,
      Stencil_Back_Pass_Depth_Pass,
      Blend_Equation_Alpha,
      Max_Combined_Texture_Image_Units,
      Min_Sample_Shading_Value,
      Stencil_Back_Ref,
      Stencil_Back_Value_Mask,
      Stencil_Back_Writemask,
      Timestamp,
      Max_Debug_Message_Length,
      Debug_Logged_Messages,
      Max_Framebuffer_Width,
      Max_Framebuffer_Height,
      Max_Framebuffer_Layers,
      Max_Framebuffer_Samples);

   type String_Parameter is
     (Vendor, Renderer, Version, Extensions, Shading_Language_Version);

   type Renderbuffer_Parameter is (Width, Height, Internal_Format, Red_Size,
                                   Green_Size, Blue_Size, Alpha_Size,
                                   Depth_Size, Stencil_Size);

private

   for Parameter use
     (Point_Size                    => 16#0B11#,
      Point_Size_Range              => 16#0B12#,
      Point_Size_Granularity        => 16#0B13#,
      Line_Smooth                   => 16#0B20#,
      Line_Width                    => 16#0B21#,
      Smooth_Line_Width_Range       => 16#0B22#,
      Smooth_Line_Width_Granularity => 16#0B23#,
      Polygon_Mode                  => 16#0B40#,
      Polygon_Smooth                => 16#0B41#,
      Edge_Flag                     => 16#0B43#,
      Cull_Face                     => 16#0B44#,
      Cull_Face_Mode                => 16#0B45#,
      Front_Face                    => 16#0B46#,
      Shade_Model                   => 16#0B54#,
      Depth_Range                   => 16#0B70#,
      Depth_Test                    => 16#0B71#,
      Depth_Writemask               => 16#0B72#,
      Depth_Clear_Value             => 16#0B73#,
      Depth_Func                    => 16#0B74#,
      Stencil_Test                  => 16#0B90#,
      Stencil_Clear_Value           => 16#0B91#,
      Stencil_Func                  => 16#0B92#,
      Stencil_Value_Mask            => 16#0B93#,
      Stencil_Fail                  => 16#0B94#,
      Stencil_Pass_Depth_Fail       => 16#0B95#,
      Stencil_Pass_Depth_Pass       => 16#0B96#,
      Stencil_Ref                   => 16#0B97#,
      Stencil_Writemask             => 16#0B98#,
      Viewport                      => 16#0BA2#,
      Dither                        => 16#0BD0#,
      Blend_Dst                     => 16#0BE0#,
      Blend_Src                     => 16#0BE1#,
      Blend                         => 16#0BE2#,
      Logic_Op_Mode                 => 16#0BF0#,
      Index_Logic_Op                => 16#0BF1#,
      Color_Logic_Op                => 16#0BF2#,
      Aux_Buffers                   => 16#0C00#,
      Draw_Buffer                   => 16#0C01#,
      Read_Buffer                   => 16#0C02#,
      Scissor_Box                   => 16#0C10#,
      Scissor_Test                  => 16#0C11#,
      Color_Clear_Value             => 16#0C22#,
      Color_Writemask               => 16#0C23#,
      Index_Mode                    => 16#0C30#,
      Rgba_Mode                     => 16#0C31#,
      Doublebuffer                  => 16#0C32#,
      Stereo                        => 16#0C33#,
      Render_Mode                   => 16#0C40#,
      Line_Smooth_Hint              => 16#0C52#,
      Polygon_Smooth_Hint           => 16#0C53#,
      Unpack_Swap_Bytes             => 16#0CF0#,
      Unpack_Lsb_First              => 16#0CF1#,
      Unpack_Row_Length             => 16#0CF2#,
      Unpack_Skip_Rows              => 16#0CF3#,
      Unpack_Skip_Pixels            => 16#0CF4#,
      Unpack_Alignment              => 16#0CF5#,
      Pack_Swap_Bytes               => 16#0D00#,
      Pack_Lsb_First                => 16#0D01#,
      Pack_Row_Length               => 16#0D02#,
      Pack_Skip_Rows                => 16#0D03#,
      Pack_Skip_Pixels              => 16#0D04#,
      Pack_Alignment                => 16#0D05#,
      Max_Clip_Distances            => 16#0D32#,
      Max_Texture_Size              => 16#0D33#,
      Max_Pixel_Map_Table           => 16#0D34#,
      Max_Viewport_Dims             => 16#0D3A#,
      Subpixel_Bits                 => 16#0D50#,
      Texture_1D                    => 16#0DE0#,
      Texture_2D                    => 16#0DE1#,
      Feedback_Buffer_Pointer       => 16#0DF0#,
      Feedback_Buffer_Size          => 16#0DF1#,
      Feedback_Buffer_Type          => 16#0DF2#,
      Selection_Buffer_Pointer      => 16#0DF3#,
      Selection_Buffer_Size         => 16#0DF4#,
      Blend_Color                   => 16#8005#,
      Blend_Equation_RGB            => 16#8009#,
      Pack_Skip_Images              => 16#806B#,
      Pack_Image_Height             => 16#806C#,
      Unpack_Skip_Images            => 16#806D#,
      Unpack_Image_Height           => 16#806E#,
      Blend_Dst_RGB                 => 16#80C8#,
      Blend_Src_RGB                 => 16#80C9#,
      Blend_Dst_Alpha               => 16#80CA#,
      Blend_Src_Alpha               => 16#80CB#,
      Major_Version                 => 16#821B#,
      Minor_Version                 => 16#821C#,
      Num_Extensions                => 16#821D#,
      Num_Shading_Language_Versions => 16#82E9#,
      Aliased_Line_Width_Range      => 16#846E#,
      Active_Texture                => 16#84E0#,
      Max_Texture_Max_Anisotropy    => 16#84FF#,
      Stencil_Back_Func             => 16#8800#,
      Stencil_Back_Fail             => 16#8801#,
      Stencil_Back_Pass_Depth_Fail  => 16#8802#,
      Stencil_Back_Pass_Depth_Pass  => 16#8803#,
      Blend_Equation_Alpha          => 16#883D#,
      Max_Combined_Texture_Image_Units => 16#8B4D#,
      Min_Sample_Shading_Value      => 16#8C37#,
      Stencil_Back_Ref              => 16#8CA3#,
      Stencil_Back_Value_Mask       => 16#8CA4#,
      Stencil_Back_Writemask        => 16#8CA5#,
      Timestamp                     => 16#8E28#,
      Max_Debug_Message_Length      => 16#9143#,
      Debug_Logged_Messages         => 16#9145#,
      Max_Framebuffer_Width         => 16#9315#,
      Max_Framebuffer_Height        => 16#9316#,
      Max_Framebuffer_Layers        => 16#9317#,
      Max_Framebuffer_Samples       => 16#9318#);
   for Parameter'Size use Low_Level.Enum'Size;

   for String_Parameter use
     (Vendor                   => 16#1F00#,
      Renderer                 => 16#1F01#,
      Version                  => 16#1F02#,
      Extensions               => 16#1F03#,
      Shading_Language_Version => 16#8B8C#);
   for String_Parameter'Size use Low_Level.Enum'Size;

   for Renderbuffer_Parameter use (Width           => 16#8D42#,
                                   Height          => 16#8D43#,
                                   Internal_Format => 16#8D44#,
                                   Red_Size        => 16#8D50#,
                                   Green_Size      => 16#8D51#,
                                   Blue_Size       => 16#8D52#,
                                   Alpha_Size      => 16#8D53#,
                                   Depth_Size      => 16#8D54#,
                                   Stencil_Size    => 16#8D55#);
   for Renderbuffer_Parameter'Size use Low_Level.Enum'Size;

end GL.Enums.Getter;

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

package GL.Enums.Getter is
   pragma Preelaborate;

   type Parameter is
     (Point_Size,
      Point_Size_Range,
      Point_Size_Granularity,
      Line_Smooth,
      Line_Width,
      Smooth_Line_Width_Range,
      Smooth_Line_Width_Granularity,
      Polygon_Mode,
      Polygon_Smooth,
      Cull_Face,
      Cull_Face_Mode,
      Front_Face,
      Depth_Range,
      Depth_Test,
      Depth_Writemask,
      Depth_Clear_Value,
      Depth_Func,
      Stencil_Test,
      Stencil_Clear_Value,
      Stencil_Func,
      Stencil_Value_Mask,
      Stencil_Fail,
      Stencil_Pass_Depth_Fail,
      Stencil_Pass_Depth_Pass,
      Stencil_Ref,
      Stencil_Writemask,
      Viewport,
      Dither,
      Blend_Dst,
      Blend_Src,
      Blend,
      Logic_Op_Mode,
      Color_Logic_Op,
      Draw_Buffer,
      Read_Buffer,
      Scissor_Box,
      Scissor_Test,
      Color_Clear_Value,
      Color_Writemask,
      Doublebuffer,
      Stereo,
      Line_Smooth_Hint,
      Polygon_Smooth_Hint,
      Unpack_Swap_Bytes,
      Unpack_Lsb_First,
      Unpack_Row_Length,
      Unpack_Skip_Rows,
      Unpack_Skip_Pixels,
      Unpack_Alignment,
      Pack_Swap_Bytes,
      Pack_Lsb_First,
      Pack_Row_Length,
      Pack_Skip_Rows,
      Pack_Skip_Pixels,
      Pack_Alignment,
      Max_Clip_Distances,
      Max_Texture_Size,
      Max_Viewport_Dims,
      Subpixel_Bits,
      Texture_1D,
      Texture_2D,
      Blend_Color,
      Blend_Equation_RGB,
      Pack_Skip_Images,
      Pack_Image_Height,
      Unpack_Skip_Images,
      Unpack_Image_Height,
      Blend_Dst_RGB,
      Blend_Src_RGB,
      Blend_Dst_Alpha,
      Blend_Src_Alpha,
      Major_Version,
      Minor_Version,
      Num_Extensions,
      Num_Shading_Language_Versions,
      Aliased_Line_Width_Range,
      Active_Texture,
      Max_Texture_Max_Anisotropy,  --  Part of EXT_texture_filter_anisotropic
      Stencil_Back_Func,
      Stencil_Back_Fail,
      Stencil_Back_Pass_Depth_Fail,
      Stencil_Back_Pass_Depth_Pass,
      Blend_Equation_Alpha,
      Max_Combined_Texture_Image_Units,
      Min_Sample_Shading_Value,
      Stencil_Back_Ref,
      Stencil_Back_Value_Mask,
      Stencil_Back_Writemask,
      Timestamp,
      Max_Debug_Message_Length,
      Debug_Logged_Messages,
      Max_Framebuffer_Width,
      Max_Framebuffer_Height,
      Max_Framebuffer_Layers,
      Max_Framebuffer_Samples);

   type String_Parameter is
     (Vendor, Renderer, Version, Extensions, Shading_Language_Version);

   type Renderbuffer_Parameter is (Width, Height, Internal_Format, Red_Size,
                                   Green_Size, Blue_Size, Alpha_Size,
                                   Depth_Size, Stencil_Size);

private

   for Parameter use
     (Point_Size                    => 16#0B11#,
      Point_Size_Range              => 16#0B12#,
      Point_Size_Granularity        => 16#0B13#,
      Line_Smooth                   => 16#0B20#,
      Line_Width                    => 16#0B21#,
      Smooth_Line_Width_Range       => 16#0B22#,
      Smooth_Line_Width_Granularity => 16#0B23#,
      Polygon_Mode                  => 16#0B40#,
      Polygon_Smooth                => 16#0B41#,
      Cull_Face                     => 16#0B44#,
      Cull_Face_Mode                => 16#0B45#,
      Front_Face                    => 16#0B46#,
      Depth_Range                   => 16#0B70#,
      Depth_Test                    => 16#0B71#,
      Depth_Writemask               => 16#0B72#,
      Depth_Clear_Value             => 16#0B73#,
      Depth_Func                    => 16#0B74#,
      Stencil_Test                  => 16#0B90#,
      Stencil_Clear_Value           => 16#0B91#,
      Stencil_Func                  => 16#0B92#,
      Stencil_Value_Mask            => 16#0B93#,
      Stencil_Fail                  => 16#0B94#,
      Stencil_Pass_Depth_Fail       => 16#0B95#,
      Stencil_Pass_Depth_Pass       => 16#0B96#,
      Stencil_Ref                   => 16#0B97#,
      Stencil_Writemask             => 16#0B98#,
      Viewport                      => 16#0BA2#,
      Dither                        => 16#0BD0#,
      Blend_Dst                     => 16#0BE0#,
      Blend_Src                     => 16#0BE1#,
      Blend                         => 16#0BE2#,
      Logic_Op_Mode                 => 16#0BF0#,
      Color_Logic_Op                => 16#0BF2#,
      Draw_Buffer                   => 16#0C01#,
      Read_Buffer                   => 16#0C02#,
      Scissor_Box                   => 16#0C10#,
      Scissor_Test                  => 16#0C11#,
      Color_Clear_Value             => 16#0C22#,
      Color_Writemask               => 16#0C23#,
      Doublebuffer                  => 16#0C32#,
      Stereo                        => 16#0C33#,
      Line_Smooth_Hint              => 16#0C52#,
      Polygon_Smooth_Hint           => 16#0C53#,
      Unpack_Swap_Bytes             => 16#0CF0#,
      Unpack_Lsb_First              => 16#0CF1#,
      Unpack_Row_Length             => 16#0CF2#,
      Unpack_Skip_Rows              => 16#0CF3#,
      Unpack_Skip_Pixels            => 16#0CF4#,
      Unpack_Alignment              => 16#0CF5#,
      Pack_Swap_Bytes               => 16#0D00#,
      Pack_Lsb_First                => 16#0D01#,
      Pack_Row_Length               => 16#0D02#,
      Pack_Skip_Rows                => 16#0D03#,
      Pack_Skip_Pixels              => 16#0D04#,
      Pack_Alignment                => 16#0D05#,
      Max_Clip_Distances            => 16#0D32#,
      Max_Texture_Size              => 16#0D33#,
      Max_Viewport_Dims             => 16#0D3A#,
      Subpixel_Bits                 => 16#0D50#,
      Texture_1D                    => 16#0DE0#,
      Texture_2D                    => 16#0DE1#,
      Blend_Color                   => 16#8005#,
      Blend_Equation_RGB            => 16#8009#,
      Pack_Skip_Images              => 16#806B#,
      Pack_Image_Height             => 16#806C#,
      Unpack_Skip_Images            => 16#806D#,
      Unpack_Image_Height           => 16#806E#,
      Blend_Dst_RGB                 => 16#80C8#,
      Blend_Src_RGB                 => 16#80C9#,
      Blend_Dst_Alpha               => 16#80CA#,
      Blend_Src_Alpha               => 16#80CB#,
      Major_Version                 => 16#821B#,
      Minor_Version                 => 16#821C#,
      Num_Extensions                => 16#821D#,
      Num_Shading_Language_Versions => 16#82E9#,
      Aliased_Line_Width_Range      => 16#846E#,
      Active_Texture                => 16#84E0#,
      Max_Texture_Max_Anisotropy    => 16#84FF#,
      Stencil_Back_Func             => 16#8800#,
      Stencil_Back_Fail             => 16#8801#,
      Stencil_Back_Pass_Depth_Fail  => 16#8802#,
      Stencil_Back_Pass_Depth_Pass  => 16#8803#,
      Blend_Equation_Alpha          => 16#883D#,
      Max_Combined_Texture_Image_Units => 16#8B4D#,
      Min_Sample_Shading_Value      => 16#8C37#,
      Stencil_Back_Ref              => 16#8CA3#,
      Stencil_Back_Value_Mask       => 16#8CA4#,
      Stencil_Back_Writemask        => 16#8CA5#,
      Timestamp                     => 16#8E28#,
      Max_Debug_Message_Length      => 16#9143#,
      Debug_Logged_Messages         => 16#9145#,
      Max_Framebuffer_Width         => 16#9315#,
      Max_Framebuffer_Height        => 16#9316#,
      Max_Framebuffer_Layers        => 16#9317#,
      Max_Framebuffer_Samples       => 16#9318#);
   for Parameter'Size use Low_Level.Enum'Size;

   for String_Parameter use
     (Vendor                   => 16#1F00#,
      Renderer                 => 16#1F01#,
      Version                  => 16#1F02#,
      Extensions               => 16#1F03#,
      Shading_Language_Version => 16#8B8C#);
   for String_Parameter'Size use Low_Level.Enum'Size;

   for Renderbuffer_Parameter use (Width           => 16#8D42#,
                                   Height          => 16#8D43#,
                                   Internal_Format => 16#8D44#,
                                   Red_Size        => 16#8D50#,
                                   Green_Size      => 16#8D51#,
                                   Blue_Size       => 16#8D52#,
                                   Alpha_Size      => 16#8D53#,
                                   Depth_Size      => 16#8D54#,
                                   Stencil_Size    => 16#8D55#);
   for Renderbuffer_Parameter'Size use Low_Level.Enum'Size;

end GL.Enums.Getter;

gl: Remove some enums in GL.Enums.Getter deprecated since OpenGL 3

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>