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

   --  ------------------------------
   --  Read a complete file into a string.
   --  The Max_Size parameter indicates the maximum size that is read.
   --  ------------------------------
   procedure Read_File (Path     : in String;
                        Into     : out Unbounded_String;
                        Max_Size : in Natural := 0) is
      use Ada.Streams;
      use Ada.Streams.Stream_IO;

      F      : File_Type;
      Buffer : Stream_Element_Array (1 .. 10_000);
      Pos    : Positive_Count := 1;
      Last   : Stream_Element_Offset;
      Space  : Natural;
   begin
      if Max_Size = 0 then
         Space := Natural'Last;
      else
         Space := Max_Size;
      end if;
      Open (Name => Path, File => F, Mode => In_File);
      loop
         Read (File => F, Item => Buffer, From => Pos, Last => Last);
         if Natural (Last) > Space then
            Last := Stream_Element_Offset (Space);
         end if;
         for I in 1 .. Last loop
            Append (Into, Character'Val (Buffer (I)));
         end loop;
         exit when Last < Buffer'Length;
         Pos := Pos + Positive_Count (Last);
      end loop;
      Close (F);

   exception
      when others =>
         if Is_Open (F) then
            Close (F);
         end if;
         raise;
   end Read_File;

   --  ------------------------------
   --  Read the file with the given path, one line at a time and execute the Process
   --  procedure with each line as argument.
   --  ------------------------------
   procedure Read_File (Path     : in String;
                        Process  : not null access procedure (Line : in String)) is
      File : Ada.Text_IO.File_Type;
   begin
      Ada.Text_IO.Open (File => File,
                        Mode => Ada.Text_IO.In_File,
                        Name => Path);
      while not Ada.Text_IO.End_Of_File (File) loop
         Process (Ada.Text_IO.Get_Line (File));
      end loop;
      Ada.Text_IO.Close (File);
   end Read_File;

   --  ------------------------------
   --  Save the string into a file creating the file if necessary
   --  ------------------------------
   procedure Write_File (Path    : in String;
                         Content : in String) is
      use Ada.Streams;
      use Ada.Streams.Stream_IO;
      use Ada.Directories;

      F : File_Type;
      Buffer : Stream_Element_Array (Stream_Element_Offset (Content'First)
                                     .. Stream_Element_Offset (Content'Last));

      Dir : constant String := Containing_Directory (Path);
   begin
      if not Exists (Dir) then
         Create_Path (Dir);
      end if;
      Create (File => F, Name => Path);
      for I in Content'Range loop
         Buffer (Stream_Element_Offset (I))
           := Stream_Element (Character'Pos (Content (I)));
      end loop;
      Write (F, Buffer);
      Close (F);

   exception
      when others =>
         if Is_Open (F) then
            Close (F);
         end if;
         raise;
   end Write_File;

   --  ------------------------------
   --  Save the string into a file creating the file if necessary
   --  ------------------------------
   procedure Write_File (Path    : in String;
                         Content : in Unbounded_String) is
   begin
      Write_File (Path, Ada.Strings.Unbounded.To_String (Content));
   end Write_File;

   --  ------------------------------
   --  Iterate over the search directories defined in Paths and execute
   --  Process with each directory until it returns True in Done
   --  or the last search directory is found.  Each search directory
   --  is separated by ';' (yes, even on Unix).  When Going is set to Backward, the
   --  directories are searched in reverse order.
   --  ------------------------------
   procedure Iterate_Path (Path     : in String;
                           Process  : not null access procedure (Dir  : in String;
                                                                 Done : out Boolean);
                           Going    : in Direction := Ada.Strings.Forward) is
      use Ada.Directories;
      use Ada.Strings;
      use Ada.Strings.Fixed;

      Sep_Pos : Natural;
      Pos     : Natural;
      Last    : constant Natural := Path'Last;
   begin
      case Going is
         when Forward =>
            Pos := Path'First;
            while Pos <= Last loop
               Sep_Pos := Index (Path, ";", Pos);
               if Sep_Pos = 0 then
                  Sep_Pos := Last;
               else
                  Sep_Pos := Sep_Pos - 1;
               end if;
               declare
                  Dir  : constant String := Path (Pos .. Sep_Pos);
                  Done : Boolean;
               begin
                  Process (Dir => Dir, Done => Done);
                  exit when Done;
               end;
               Pos := Sep_Pos + 2;
            end loop;

         when Backward =>
            Pos := Path'Last;
            while Pos >= Path'First loop
               Sep_Pos := Index (Path, ";", Pos, Backward);
               if Sep_Pos = 0 then
                  Sep_Pos := Path'First;
               else
                  Sep_Pos := Sep_Pos + 1;
               end if;
               declare
                  Dir  : constant String := Path (Sep_Pos .. Pos);
                  Done : Boolean;
               begin
                  Process (Dir => Dir, Done => Done);
                  exit when Done or Sep_Pos = Path'First;
               end;
               Pos := Sep_Pos - 2;
            end loop;

      end case;
   end Iterate_Path;

   --  ------------------------------
   --  Find the file in one of the search directories.  Each search directory
   --  is separated by ';' (yes, even on Unix).
   --  Returns the path to be used for reading the file.
   --  ------------------------------
   function Find_File_Path (Name  : String;
                            Paths : String) return String is
      use Ada.Directories;
      use Ada.Strings.Fixed;

      Sep_Pos : Natural;
      Pos     : Positive := Paths'First;
      Last    : constant Natural := Paths'Last;

   begin
      while Pos <= Last loop
         Sep_Pos := Index (Paths, ";", Pos);
         if Sep_Pos = 0 then
            Sep_Pos := Last;
         else
            Sep_Pos := Sep_Pos - 1;
         end if;
         declare
            Path : constant String := Util.Files.Compose (Paths (Pos .. Sep_Pos), Name);
         begin
            if Exists (Path) and then Kind (Path) = Ordinary_File then
               return Path;
            end if;
         exception
            when Name_Error =>
               null;
         end;
         Pos := Sep_Pos + 2;
      end loop;
      return Name;
   end Find_File_Path;

   --  ------------------------------
   --  Iterate over the search directories defined in Path and search
   --  for files matching the pattern defined by Pattern.  For each file,
   --  execute Process with the file basename and the full file path.
   --  Stop iterating when the Process procedure returns True.
   --  Each search directory is separated by ';'.  When Going is set to Backward, the
   --  directories are searched in reverse order.
   --  ------------------------------
   procedure Iterate_Files_Path (Pattern  : in String;
                                 Path     : in String;
                                 Process  : not null access procedure (Name : in String;
                                                                       File : in String;
                                                                       Done : out Boolean);
                                 Going    : in Direction := Ada.Strings.Forward) is

      procedure Find_Files (Dir  : in String;
                            Done : out Boolean);

      --  ------------------------------
      --  Find the files matching the pattern in Dir.
      --  ------------------------------
      procedure Find_Files (Dir  : in String;
                            Done : out Boolean) is
         use Ada.Directories;

         Filter  : constant Filter_Type := (Ordinary_File => True, others => False);
         Ent     : Directory_Entry_Type;
         Search  : Search_Type;
      begin
         Done := False;
         Start_Search (Search, Directory => Dir,
                       Pattern => Pattern, Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Name      : constant String := Simple_Name (Ent);
               File_Path : constant String := Full_Name (Ent);
            begin
               Process (Name, File_Path, Done);
               exit when Done;
            end;
         end loop;
      end Find_Files;

   begin
      Iterate_Path (Path => Path, Process => Find_Files'Access, Going => Going);
   end Iterate_Files_Path;

   --  ------------------------------
   --  Find the files which match the pattern in the directories specified in the
   --  search path Path.  Each search directory is separated by ';'.
   --  File names are added to the string set in Into.
   --  ------------------------------
   procedure Find_Files_Path (Pattern : in String;
                              Path    : in String;
                              Into    : in out Util.Strings.Maps.Map) is

      procedure Add_File (Name : in String;
                          File_Path : in String;
                          Done : out Boolean);

      --  ------------------------------
      --  Find the files matching the pattern in Dir.
      --  ------------------------------
      procedure Add_File (Name : in String;
                          File_Path : in String;
                          Done      : out Boolean) is
      begin
         if not Into.Contains (Name) then
            Into.Insert (Name, File_Path);
         end if;
         Done := False;
      end Add_File;

   begin
      Iterate_Files_Path (Pattern => Pattern, Path => Path, Process => Add_File'Access);
   end Find_Files_Path;

   --  ------------------------------
   --  Compose an existing path by adding the specified name to each path component
   --  and return a new paths having only existing directories.  Each directory is
   --  separated by ';'.
   --  If the composed path exists, it is added to the result path.
   --  Example:
   --    paths = 'web;regtests'  name = 'info'
   --    result = 'web/info;regtests/info'
   --  Returns the composed path.
   --  ------------------------------
   function Compose_Path (Paths : in String;
                          Name  : in String) return String is

      procedure Compose (Dir : in String;
                         Done : out Boolean);

      Result  : Unbounded_String;

      --  ------------------------------
      --  Build the new path by checking if Name exists in Dir
      --  and appending the new path in the Result.
      --  ------------------------------
      procedure Compose (Dir : in String;
                         Done : out Boolean) is
         use Ada.Directories;
         use Ada.Strings.Fixed;

         Path : constant String := Util.Files.Compose (Dir, Name);
      begin
         Done := False;
         if Exists (Path) and then Kind (Path) = Directory then
            if Length (Result) > 0 then
               Append (Result, ';');
            end if;
            Append (Result, Path);
         end if;
      exception
         when Name_Error =>
            null;
      end Compose;

   begin
      Iterate_Path (Path => Paths, Process => Compose'Access);
      return To_String (Result);
   end Compose_Path;

   --  ------------------------------
   --  Returns the name of the external file with the specified directory
   --  and the name.  Unlike the Ada.Directories.Compose, the name can represent
   --  a relative path and thus include directory separators.
   --  ------------------------------
   function Compose (Directory : in String;
                     Name      : in String) return String is
   begin
      if Name'Length = 0 then
         return Directory;
      elsif Directory'Length = 0 or Directory = "." or Directory = "./" then
         return Name;
      elsif Directory (Directory'Last) = '/' and Name (Name'First) = '/' then
         return Directory & Name (Name'First + 1 .. Name'Last);
      elsif Directory (Directory'Last) = '/' or Name (Name'First) = '/' then
         return Directory & Name;
      else
         return Directory & "/" & Name;
      end if;
   end Compose;

   --  ------------------------------
   --  Returns a relative path whose origin is defined by From and which refers
   --  to the absolute path referenced by To.  Both From and To are
   --  assumed to be absolute pathes.  Returns the absolute path To if the relative
   --  path could not be found.  Both paths must have at least one root component in common.
   --  ------------------------------
   function Get_Relative_Path (From : in String;
                               To   : in String) return String is
      Result : Unbounded_String;
      Last   : Natural := 0;
   begin
      for I in From'Range loop
         if I > To'Last or else From (I) /= To (I) then
            --  Nothing in common, return the absolute path To.
            if Last <= From'First + 1 then
               return To;
            end if;

            for J in Last .. From'Last - 1 loop
               if From (J) = '/' or From (J) = '\' then
                  Append (Result, "../");
               end if;
            end loop;
            if Last <= To'Last and From (I) /= '/' and From (I) /= '\' then
               Append (Result, "../");
               Append (Result, To (Last .. To'Last));
            end if;
            return To_String (Result);

         elsif I < From'Last and then (From (I) = '/' or From (I) = '\') then
            Last := I + 1;

         end if;
      end loop;
      if To'Last = From'Last or (To'Last = From'Last + 1
                                 and (To (To'Last) = '/' or To (To'Last) = '\')) then
         return ".";
      elsif Last = 0 then
         return To;
      elsif To (From'Last + 1) = '/' or To (From'Last + 1) = '\' then
         return To (From'Last + 2 .. To'Last);
      else
         return To (Last .. To'Last);
      end if;
   end Get_Relative_Path;

end Util.Files;

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

   --  ------------------------------
   --  Read a complete file into a string.
   --  The Max_Size parameter indicates the maximum size that is read.
   --  ------------------------------
   procedure Read_File (Path     : in String;
                        Into     : out Unbounded_String;
                        Max_Size : in Natural := 0) is
      use Ada.Streams;
      use Ada.Streams.Stream_IO;

      F      : File_Type;
      Buffer : Stream_Element_Array (1 .. 10_000);
      Pos    : Positive_Count := 1;
      Last   : Stream_Element_Offset;
      Space  : Natural;
   begin
      if Max_Size = 0 then
         Space := Natural'Last;
      else
         Space := Max_Size;
      end if;
      Open (Name => Path, File => F, Mode => In_File);
      loop
         Read (File => F, Item => Buffer, From => Pos, Last => Last);
         if Natural (Last) > Space then
            Last := Stream_Element_Offset (Space);
         end if;
         for I in 1 .. Last loop
            Append (Into, Character'Val (Buffer (I)));
         end loop;
         exit when Last < Buffer'Length;
         Pos := Pos + Positive_Count (Last);
      end loop;
      Close (F);

   exception
      when others =>
         if Is_Open (F) then
            Close (F);
         end if;
         raise;
   end Read_File;

   --  ------------------------------
   --  Read the file with the given path, one line at a time and execute the Process
   --  procedure with each line as argument.
   --  ------------------------------
   procedure Read_File (Path     : in String;
                        Process  : not null access procedure (Line : in String)) is
      File : Ada.Text_IO.File_Type;
   begin
      Ada.Text_IO.Open (File => File,
                        Mode => Ada.Text_IO.In_File,
                        Name => Path);
      while not Ada.Text_IO.End_Of_File (File) loop
         Process (Ada.Text_IO.Get_Line (File));
      end loop;
      Ada.Text_IO.Close (File);
   end Read_File;

   --  ------------------------------
   --  Save the string into a file creating the file if necessary
   --  ------------------------------
   procedure Write_File (Path    : in String;
                         Content : in String) is
      use Ada.Streams;
      use Ada.Streams.Stream_IO;
      use Ada.Directories;

      F : File_Type;
      Buffer : Stream_Element_Array (Stream_Element_Offset (Content'First)
                                     .. Stream_Element_Offset (Content'Last));

      Dir : constant String := Containing_Directory (Path);
   begin
      if not Exists (Dir) then
         Create_Path (Dir);
      end if;
      Create (File => F, Name => Path);
      for I in Content'Range loop
         Buffer (Stream_Element_Offset (I))
           := Stream_Element (Character'Pos (Content (I)));
      end loop;
      Write (F, Buffer);
      Close (F);

   exception
      when others =>
         if Is_Open (F) then
            Close (F);
         end if;
         raise;
   end Write_File;

   --  ------------------------------
   --  Save the string into a file creating the file if necessary
   --  ------------------------------
   procedure Write_File (Path    : in String;
                         Content : in Unbounded_String) is
   begin
      Write_File (Path, Ada.Strings.Unbounded.To_String (Content));
   end Write_File;

   --  ------------------------------
   --  Iterate over the search directories defined in Paths and execute
   --  Process with each directory until it returns True in Done
   --  or the last search directory is found.  Each search directory
   --  is separated by ';' (yes, even on Unix).  When Going is set to Backward, the
   --  directories are searched in reverse order.
   --  ------------------------------
   procedure Iterate_Path (Path     : in String;
                           Process  : not null access procedure (Dir  : in String;
                                                                 Done : out Boolean);
                           Going    : in Direction := Ada.Strings.Forward) is
   begin
      Util.Strings.Tokenizers.Iterate_Tokens (Content => Path,
                                              Pattern => ";",
                                              Process => Process,
                                              Going   => Going);
   end Iterate_Path;

   --  ------------------------------
   --  Find the file in one of the search directories.  Each search directory
   --  is separated by ';' (yes, even on Unix).
   --  Returns the path to be used for reading the file.
   --  ------------------------------
   function Find_File_Path (Name  : String;
                            Paths : String) return String is
      use Ada.Directories;
      use Ada.Strings.Fixed;

      Sep_Pos : Natural;
      Pos     : Positive := Paths'First;
      Last    : constant Natural := Paths'Last;

   begin
      while Pos <= Last loop
         Sep_Pos := Index (Paths, ";", Pos);
         if Sep_Pos = 0 then
            Sep_Pos := Last;
         else
            Sep_Pos := Sep_Pos - 1;
         end if;
         declare
            Path : constant String := Util.Files.Compose (Paths (Pos .. Sep_Pos), Name);
         begin
            if Exists (Path) and then Kind (Path) = Ordinary_File then
               return Path;
            end if;
         exception
            when Name_Error =>
               null;
         end;
         Pos := Sep_Pos + 2;
      end loop;
      return Name;
   end Find_File_Path;

   --  ------------------------------
   --  Iterate over the search directories defined in Path and search
   --  for files matching the pattern defined by Pattern.  For each file,
   --  execute Process with the file basename and the full file path.
   --  Stop iterating when the Process procedure returns True.
   --  Each search directory is separated by ';'.  When Going is set to Backward, the
   --  directories are searched in reverse order.
   --  ------------------------------
   procedure Iterate_Files_Path (Pattern  : in String;
                                 Path     : in String;
                                 Process  : not null access procedure (Name : in String;
                                                                       File : in String;
                                                                       Done : out Boolean);
                                 Going    : in Direction := Ada.Strings.Forward) is

      procedure Find_Files (Dir  : in String;
                            Done : out Boolean);

      --  ------------------------------
      --  Find the files matching the pattern in Dir.
      --  ------------------------------
      procedure Find_Files (Dir  : in String;
                            Done : out Boolean) is
         use Ada.Directories;

         Filter  : constant Filter_Type := (Ordinary_File => True, others => False);
         Ent     : Directory_Entry_Type;
         Search  : Search_Type;
      begin
         Done := False;
         Start_Search (Search, Directory => Dir,
                       Pattern => Pattern, Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Name      : constant String := Simple_Name (Ent);
               File_Path : constant String := Full_Name (Ent);
            begin
               Process (Name, File_Path, Done);
               exit when Done;
            end;
         end loop;
      end Find_Files;

   begin
      Iterate_Path (Path => Path, Process => Find_Files'Access, Going => Going);
   end Iterate_Files_Path;

   --  ------------------------------
   --  Find the files which match the pattern in the directories specified in the
   --  search path Path.  Each search directory is separated by ';'.
   --  File names are added to the string set in Into.
   --  ------------------------------
   procedure Find_Files_Path (Pattern : in String;
                              Path    : in String;
                              Into    : in out Util.Strings.Maps.Map) is

      procedure Add_File (Name : in String;
                          File_Path : in String;
                          Done : out Boolean);

      --  ------------------------------
      --  Find the files matching the pattern in Dir.
      --  ------------------------------
      procedure Add_File (Name : in String;
                          File_Path : in String;
                          Done      : out Boolean) is
      begin
         if not Into.Contains (Name) then
            Into.Insert (Name, File_Path);
         end if;
         Done := False;
      end Add_File;

   begin
      Iterate_Files_Path (Pattern => Pattern, Path => Path, Process => Add_File'Access);
   end Find_Files_Path;

   --  ------------------------------
   --  Compose an existing path by adding the specified name to each path component
   --  and return a new paths having only existing directories.  Each directory is
   --  separated by ';'.
   --  If the composed path exists, it is added to the result path.
   --  Example:
   --    paths = 'web;regtests'  name = 'info'
   --    result = 'web/info;regtests/info'
   --  Returns the composed path.
   --  ------------------------------
   function Compose_Path (Paths : in String;
                          Name  : in String) return String is

      procedure Compose (Dir : in String;
                         Done : out Boolean);

      Result  : Unbounded_String;

      --  ------------------------------
      --  Build the new path by checking if Name exists in Dir
      --  and appending the new path in the Result.
      --  ------------------------------
      procedure Compose (Dir : in String;
                         Done : out Boolean) is
         use Ada.Directories;
         use Ada.Strings.Fixed;

         Path : constant String := Util.Files.Compose (Dir, Name);
      begin
         Done := False;
         if Exists (Path) and then Kind (Path) = Directory then
            if Length (Result) > 0 then
               Append (Result, ';');
            end if;
            Append (Result, Path);
         end if;
      exception
         when Name_Error =>
            null;
      end Compose;

   begin
      Iterate_Path (Path => Paths, Process => Compose'Access);
      return To_String (Result);
   end Compose_Path;

   --  ------------------------------
   --  Returns the name of the external file with the specified directory
   --  and the name.  Unlike the Ada.Directories.Compose, the name can represent
   --  a relative path and thus include directory separators.
   --  ------------------------------
   function Compose (Directory : in String;
                     Name      : in String) return String is
   begin
      if Name'Length = 0 then
         return Directory;
      elsif Directory'Length = 0 or Directory = "." or Directory = "./" then
         return Name;
      elsif Directory (Directory'Last) = '/' and Name (Name'First) = '/' then
         return Directory & Name (Name'First + 1 .. Name'Last);
      elsif Directory (Directory'Last) = '/' or Name (Name'First) = '/' then
         return Directory & Name;
      else
         return Directory & "/" & Name;
      end if;
   end Compose;

   --  ------------------------------
   --  Returns a relative path whose origin is defined by From and which refers
   --  to the absolute path referenced by To.  Both From and To are
   --  assumed to be absolute pathes.  Returns the absolute path To if the relative
   --  path could not be found.  Both paths must have at least one root component in common.
   --  ------------------------------
   function Get_Relative_Path (From : in String;
                               To   : in String) return String is
      Result : Unbounded_String;
      Last   : Natural := 0;
   begin
      for I in From'Range loop
         if I > To'Last or else From (I) /= To (I) then
            --  Nothing in common, return the absolute path To.
            if Last <= From'First + 1 then
               return To;
            end if;

            for J in Last .. From'Last - 1 loop
               if From (J) = '/' or From (J) = '\' then
                  Append (Result, "../");
               end if;
            end loop;
            if Last <= To'Last and From (I) /= '/' and From (I) /= '\' then
               Append (Result, "../");
               Append (Result, To (Last .. To'Last));
            end if;
            return To_String (Result);

         elsif I < From'Last and then (From (I) = '/' or From (I) = '\') then
            Last := I + 1;

         end if;
      end loop;
      if To'Last = From'Last or (To'Last = From'Last + 1
                                 and (To (To'Last) = '/' or To (To'Last) = '\')) then
         return ".";
      elsif Last = 0 then
         return To;
      elsif To (From'Last + 1) = '/' or To (From'Last + 1) = '\' then
         return To (From'Last + 2 .. To'Last);
      else
         return To (Last .. To'Last);
      end if;
   end Get_Relative_Path;

end Util.Files;

Use the string tokenizer to iterate over the search paths


-----------------------------------------------------------------------
--  wiki-utils -- Wiki utility operations
--  Copyright (C) 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Wiki.Parsers;
with Wiki.Render.Text;
with Wiki.Render.Html;
with Wiki.Filters.Html;
with Wiki.Filters.TOC;
with Wiki.Streams.Builders;
with Wiki.Streams.Html.Builders;
with Wiki.Documents;
package body Wiki.Utils is

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in HTML into a string.
   --  ------------------------------
   function To_Html (Text   : in Wiki.Strings.WString;
                     Syntax : in Wiki.Wiki_Syntax) return String is
      Stream   : aliased Wiki.Streams.Html.Builders.Html_Output_Builder_Stream;
      Renderer : aliased Wiki.Render.Html.Html_Renderer;
      Doc      : Wiki.Documents.Document;
      Filter   : aliased Wiki.Filters.Html.Html_Filter_Type;
      TOC      : aliased Wiki.Filters.TOC.TOC_Filter;
      Engine   : Wiki.Parsers.Parser;
   begin
      Renderer.Set_Output_Stream (Stream'Unchecked_Access);
      Engine.Add_Filter (TOC'Unchecked_Access);
      Engine.Add_Filter (Filter'Unchecked_Access);
      Engine.Set_Syntax (Syntax);
      Engine.Parse (Text, Doc);
      Renderer.Render (Doc);
      return Stream.To_String;
   end To_Html;

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in text into a string.
   --  Wiki formatting and decoration are removed.
   --  ------------------------------
   function To_Text (Text   : in Wiki.Strings.WString;
                     Syntax : in Wiki.Wiki_Syntax) return String is
      Stream   : aliased Wiki.Streams.Builders.Output_Builder_Stream;
      Doc      : Wiki.Documents.Document;
      Renderer : aliased Wiki.Render.Text.Text_Renderer;
      Engine   : Wiki.Parsers.Parser;
   begin
      Renderer.Set_Output_Stream (Stream'Unchecked_Access);
      Engine.Set_Syntax (Syntax);
      Engine.Parse (Text, Doc);
      Renderer.Render (Doc);
      return Stream.To_String;
   end To_Text;

end Wiki.Utils;

-----------------------------------------------------------------------
--  wiki-utils -- Wiki utility operations
--  Copyright (C) 2015, 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Wiki.Parsers;
with Wiki.Render.Text;
with Wiki.Render.Html;
with Wiki.Filters.Html;
with Wiki.Filters.TOC;
with Wiki.Streams.Builders;
with Wiki.Streams.Html.Builders;
with Wiki.Documents;
package body Wiki.Utils is

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in HTML into a string.
   --  ------------------------------
   function To_Html (Text   : in Wiki.Strings.WString;
                     Syntax : in Wiki.Wiki_Syntax) return String is
      Stream   : aliased Wiki.Streams.Html.Builders.Html_Output_Builder_Stream;
      Renderer : aliased Wiki.Render.Html.Html_Renderer;
      Doc      : Wiki.Documents.Document;
      Filter   : aliased Wiki.Filters.Html.Html_Filter_Type;
      TOC      : aliased Wiki.Filters.TOC.TOC_Filter;
      Engine   : Wiki.Parsers.Parser;
   begin
      Renderer.Set_Output_Stream (Stream'Unchecked_Access);
      Renderer.Set_Render_TOC (True);
      Engine.Add_Filter (TOC'Unchecked_Access);
      Engine.Add_Filter (Filter'Unchecked_Access);
      Engine.Set_Syntax (Syntax);
      Engine.Parse (Text, Doc);
      Renderer.Render (Doc);
      return Stream.To_String;
   end To_Html;

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in text into a string.
   --  Wiki formatting and decoration are removed.
   --  ------------------------------
   function To_Text (Text   : in Wiki.Strings.WString;
                     Syntax : in Wiki.Wiki_Syntax) return String is
      Stream   : aliased Wiki.Streams.Builders.Output_Builder_Stream;
      Doc      : Wiki.Documents.Document;
      Renderer : aliased Wiki.Render.Text.Text_Renderer;
      Engine   : Wiki.Parsers.Parser;
   begin
      Renderer.Set_Output_Stream (Stream'Unchecked_Access);
      Engine.Set_Syntax (Syntax);
      Engine.Parse (Text, Doc);
      Renderer.Render (Doc);
      return Stream.To_String;
   end To_Text;

end Wiki.Utils;

Set the TOC rendering

Set the TOC rendering


------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Streams.Stream_IO;
with Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;

with Natools.S_Expressions.Atom_Buffers;
with Natools.S_Expressions.Atom_Refs;
with Natools.S_Expressions.File_Readers;
with Natools.S_Expressions.File_Writers;
with Natools.S_Expressions.Test_Tools;

with GNAT.Debug_Pools;

package body Natools.S_Expressions.File_RW_Tests is

   package Stream_IO renames Ada.Streams.Stream_IO;

   subtype String_Holder is Ada.Strings.Unbounded.Unbounded_String;

   function Hold (S : String) return String_Holder
     renames Ada.Strings.Unbounded.To_Unbounded_String;

   function To_String (H : String_Holder) return String
     renames Ada.Strings.Unbounded.To_String;

   -------------------------
   -- Complete Test Suite --
   -------------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Atom_IO (Report);
      S_Expression_IO (Report);
   end All_Tests;

   -----------------------
   -- Inidividual Tests --
   -----------------------

   procedure Atom_IO (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Atom-based reading");
      Payload : Atom (0 .. 255);
      Temporary_File_Name : String_Holder;
   begin
      for I in Payload'Range loop
         Payload (I) := Octet (I);
      end loop;

      Build_File :
      declare
         File : Stream_IO.File_Type;
      begin
         Stream_IO.Create (File, Stream_IO.Out_File, "");
         Stream_IO.Write (File, Payload);
         Temporary_File_Name := Hold (Stream_IO.Name (File));
         Stream_IO.Close (File);
      end Build_File;

      Read_Test :
      declare
         Reader : File_Readers.Atom_Reader
           := File_Readers.Reader (To_String (Temporary_File_Name));
      begin
         Test_Tools.Test_Atom (Test, Payload, Reader.Read);

         Small_Read :
         declare
            Buffer : Atom (1 .. 100) := (others => 0);
            Length : Count;
         begin
            Reader.Read (Buffer, Length);
            Test_Tools.Test_Atom
              (Test, Payload (0 .. Buffer'Length - 1), Buffer);

            if Length /= Payload'Length then
               Test.Fail ("Expected total length"
                 & Count'Image (Payload'Length)
                 & " in small read, found"
                 & Count'Image (Length));
            end if;
         end Small_Read;

         Large_Read :
         declare
            Buffer : Atom (1 .. 512) := (others => 0);
            Length : Count;
         begin
            Reader.Read (Buffer, Length);

            Test_Tools.Test_Atom
              (Test, Payload, Buffer (Buffer'First .. Length));
            Test_Tools.Test_Atom
              (Test,
               (1 .. Buffer'Length - Length => 0),
               Buffer (Length + 1 .. Buffer'Last));
         end Large_Read;

         Reader.Set_Filename (To_String (Temporary_File_Name));

         Buffer_Read :
         declare
            Buffer : Atom_Buffers.Atom_Buffer;
         begin
            Reader.Read (Buffer, 100);
            Test_Tools.Test_Atom (Test, Payload, Buffer.Data);
         end Buffer_Read;

         Reference_Read :
         declare
            Buffer : Atom_Refs.Reference;
         begin
            Buffer := Reader.Read;
            Test_Tools.Test_Atom (Test, Payload, Buffer.Query.Data.all);
         end Reference_Read;

         Block_Read :
         declare
            procedure Process (Block : in Atom);

            Offset : Count := 0;

            procedure Process (Block : in Atom) is
               Next : constant Count := Offset + Block'Length;
            begin
               Test_Tools.Test_Atom
                 (Test, Payload (Offset .. Next - 1), Block);
               Offset := Next;
            end Process;
         begin
            Reader.Block_Query (100, Process'Access);

            if Offset /= Payload'Last + 1 then
               Test.Fail ("Expected final offset"
                 & Count'Image (Payload'Last + 1)
                 & ", found"
                 & Count'Image (Offset));
            end if;

            Offset := 0;
            Reader.Block_Query (350, Process'Access);

            if Offset /= Payload'Last + 1 then
               Test.Fail ("Expected second final offset"
                 & Count'Image (Payload'Last + 1)
                 & ", found"
                 & Count'Image (Offset));
            end if;
         end Block_Read;

         Heap_Read :
         declare
            procedure Tester (Data : in Atom);
            procedure Raiser (Data : in Atom);

            Local_Exception : exception;

            procedure Tester (Data : in Atom) is
            begin
               Test_Tools.Test_Atom (Test, Payload, Data);
            end Tester;

            procedure Raiser (Data : in Atom) is
            begin
               raise Local_Exception;
            end Raiser;

            Pool : GNAT.Debug_Pools.Debug_Pool;

            type Local_Atom_Access is access Atom;
            for Local_Atom_Access'Storage_Pool use Pool;

            procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
              (Atom, Local_Atom_Access);

            procedure Query is new File_Readers.Query
              (Local_Atom_Access, Unchecked_Deallocation);
         begin
            Query (Reader, Tester'Access);

            begin
               Query (Reader, Raiser'Access);
            exception
               when Local_Exception => null;
            end;
         end Heap_Read;
      end Read_Test;

   exception
      when Error : others => Test.Report_Exception (Error);
   end Atom_IO;

   procedure S_Expression_IO (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("S-expression writing and re-reading");
      Temporary_File_Name, Secondary_File_Name : String_Holder;
   begin
      First_Write :
      declare
         Writer : File_Writers.Writer := File_Writers.Create ("");
      begin
         Temporary_File_Name := Hold (Writer.Name);
         Writer.Append_Atom (To_Atom ("begin"));
         Writer.Open_List;
         Writer.Open_List;
         Writer.Close_List;
         Writer.Open_List;
         Writer.Append_Atom (To_Atom ("head"));
         Writer.Append_Atom (To_Atom ("tail"));
         Writer.Close_List;
         Writer.Close_List;
         Writer.Append_Atom (To_Atom ("end"));

         Writer.Create ("");
         Secondary_File_Name := Hold (Writer.Name);
         Writer.Open_List;
         Writer.Append_Atom (To_Atom ("first"));
         Writer.Append_Atom (To_Atom ("last"));
         Writer.Close_List;
      end First_Write;

      First_Read :
      declare
         Reader : File_Readers.S_Reader
           := File_Readers.Reader (To_String (Temporary_File_Name));
      begin
         Test_Tools.Test_Atom_Accessors (Test, Reader, To_Atom ("begin"), 0);
         Test_Tools.Next_And_Check (Test, Reader, Events.Open_List, 1);
         Test_Tools.Next_And_Check (Test, Reader, Events.Open_List, 2);
         Test_Tools.Next_And_Check (Test, Reader, Events.Close_List, 1);
         Test_Tools.Next_And_Check (Test, Reader, Events.Open_List, 2);
         Test_Tools.Next_And_Check (Test, Reader, To_Atom ("head"), 2);
         Test_Tools.Next_And_Check (Test, Reader, To_Atom ("tail"), 2);
         Test_Tools.Next_And_Check (Test, Reader, Events.Close_List, 1);
         Test_Tools.Next_And_Check (Test, Reader, Events.Close_List, 0);
         Test_Tools.Next_And_Check (Test, Reader, To_Atom ("end"), 0);
         Test_Tools.Next_And_Check (Test, Reader, Events.End_Of_Input, 0);

         Reader.Rewind;
         Test_Tools.Test_Atom_Accessors (Test, Reader, To_Atom ("begin"), 0);

         Reader.Set_Filename (To_String (Secondary_File_Name));
         Test_Tools.Next_And_Check (Test, Reader, To_Atom ("first"), 1);
         Test_Tools.Next_And_Check (Test, Reader, To_Atom ("last"), 1);
         Test_Tools.Next_And_Check (Test, Reader, Events.Close_List, 0);
         Test_Tools.Next_And_Check (Test, Reader, Events.End_Of_Input, 0);
      end First_Read;

      Second_Write :
      declare
         Writer : File_Writers.Writer
           := File_Writers.Open (To_String (Temporary_File_Name));
      begin
         Writer.Open_List;
         Writer.Append_Atom (To_Atom ("foo"));
         Writer.Append_Atom (To_Atom ("bar"));
         Writer.Open_List;
         Writer.Close_List;
         Writer.Close_List;

         Writer.Open (To_String (Secondary_File_Name));
         Writer.Open_List;
         Writer.Append_Atom (To_Atom ("unfinished"));
      end Second_Write;

      Raw_Read :
      begin
         Test_Tools.Test_Atom
           (Test,
            To_Atom ("5:begin(()(4:head4:tail))3:end(3:foo3:bar())"),
            File_Readers.Reader (To_String (Temporary_File_Name)).Read);
         Test_Tools.Test_Atom
           (Test,
            To_Atom ("(5:first4:last)(10:unfinished"),
            File_Readers.Reader (To_String (Secondary_File_Name)).Read);
      end Raw_Read;
   exception
      when Error : others => Test.Report_Exception (Error);
   end S_Expression_IO;

end Natools.S_Expressions.File_RW_Tests;

------------------------------------------------------------------------------
-- Copyright (c) 2014-2017, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Streams.Stream_IO;
with Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;

with Natools.S_Expressions.Atom_Buffers;
with Natools.S_Expressions.Atom_Refs;
with Natools.S_Expressions.File_Readers;
with Natools.S_Expressions.File_Writers;
with Natools.S_Expressions.Test_Tools;

with GNAT.Debug_Pools;

package body Natools.S_Expressions.File_RW_Tests is

   package Stream_IO renames Ada.Streams.Stream_IO;

   subtype String_Holder is Ada.Strings.Unbounded.Unbounded_String;

   function Hold (S : String) return String_Holder
     renames Ada.Strings.Unbounded.To_Unbounded_String;

   function To_String (H : String_Holder) return String
     renames Ada.Strings.Unbounded.To_String;

   -------------------------
   -- Complete Test Suite --
   -------------------------

   procedure All_Tests (Report : in out NT.Reporter'Class) is
   begin
      Atom_IO (Report);
      S_Expression_IO (Report);
   end All_Tests;

   -----------------------
   -- Inidividual Tests --
   -----------------------

   procedure Atom_IO (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("Atom-based reading");
      Payload : Atom (0 .. 255);
      Temporary_File_Name : String_Holder;
   begin
      for I in Payload'Range loop
         Payload (I) := Octet (I);
      end loop;

      Build_File :
      declare
         File : Stream_IO.File_Type;
      begin
         Stream_IO.Create (File, Stream_IO.Out_File, "");
         Stream_IO.Write (File, Payload);
         Temporary_File_Name := Hold (Stream_IO.Name (File));
         Stream_IO.Close (File);
      end Build_File;

      Read_Test :
      declare
         Reader : File_Readers.Atom_Reader
           := File_Readers.Reader (To_String (Temporary_File_Name));
      begin
         Test_Tools.Test_Atom (Test, Payload, Reader.Read);

         Small_Read :
         declare
            Buffer : Atom (1 .. 100) := (others => 0);
            Length : Count;
         begin
            Reader.Read (Buffer, Length);
            Test_Tools.Test_Atom
              (Test, Payload (0 .. Buffer'Length - 1), Buffer);

            if Length /= Payload'Length then
               Test.Fail ("Expected total length"
                 & Count'Image (Payload'Length)
                 & " in small read, found"
                 & Count'Image (Length));
            end if;
         end Small_Read;

         Large_Read :
         declare
            Buffer : Atom (1 .. 512) := (others => 0);
            Length : Count;
         begin
            Reader.Read (Buffer, Length);

            Test_Tools.Test_Atom
              (Test, Payload, Buffer (Buffer'First .. Length));
            Test_Tools.Test_Atom
              (Test,
               (1 .. Buffer'Length - Length => 0),
               Buffer (Length + 1 .. Buffer'Last));
         end Large_Read;

         Reader.Set_Filename (To_String (Temporary_File_Name));

         Buffer_Read :
         declare
            Buffer : Atom_Buffers.Atom_Buffer;
         begin
            Reader.Read (Buffer, 100);
            Test_Tools.Test_Atom (Test, Payload, Buffer.Data);
         end Buffer_Read;

         Reference_Read :
         declare
            Buffer : Atom_Refs.Reference;
         begin
            Buffer := Reader.Read;
            Test_Tools.Test_Atom (Test, Payload, Buffer.Query.Data.all);
         end Reference_Read;

         Block_Read :
         declare
            procedure Process (Block : in Atom);

            Offset : Count := 0;

            procedure Process (Block : in Atom) is
               Next : constant Count := Offset + Block'Length;
            begin
               Test_Tools.Test_Atom
                 (Test, Payload (Offset .. Next - 1), Block);
               Offset := Next;
            end Process;
         begin
            Reader.Block_Query (100, Process'Access);

            if Offset /= Payload'Last + 1 then
               Test.Fail ("Expected final offset"
                 & Count'Image (Payload'Last + 1)
                 & ", found"
                 & Count'Image (Offset));
            end if;

            Offset := 0;
            Reader.Block_Query (350, Process'Access);

            if Offset /= Payload'Last + 1 then
               Test.Fail ("Expected second final offset"
                 & Count'Image (Payload'Last + 1)
                 & ", found"
                 & Count'Image (Offset));
            end if;
         end Block_Read;

         Heap_Read :
         declare
            procedure Tester (Data : in Atom);
            procedure Raiser (Data : in Atom);

            Local_Exception : exception;

            procedure Tester (Data : in Atom) is
            begin
               Test_Tools.Test_Atom (Test, Payload, Data);
            end Tester;

            procedure Raiser (Data : in Atom) is
            begin
               raise Local_Exception;
            end Raiser;

            Pool : GNAT.Debug_Pools.Debug_Pool;

            type Local_Atom_Access is access Atom;
            for Local_Atom_Access'Storage_Pool use Pool;

            procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
              (Atom, Local_Atom_Access);

            procedure Query is new File_Readers.Query
              (Local_Atom_Access, Unchecked_Deallocation);
         begin
            Query (Reader, Tester'Access);

            begin
               Query (Reader, Raiser'Access);
            exception
               when Local_Exception => null;
            end;
         end Heap_Read;
      end Read_Test;

   exception
      when Error : others => Test.Report_Exception (Error);
   end Atom_IO;

   procedure S_Expression_IO (Report : in out NT.Reporter'Class) is
      Test : NT.Test := Report.Item ("S-expression writing and re-reading");
      Temporary_File_Name, Secondary_File_Name : String_Holder;
   begin
      First_Write :
      declare
         Writer : File_Writers.Writer := File_Writers.Create ("");
      begin
         Temporary_File_Name := Hold (Writer.Name);
         Writer.Append_Atom (To_Atom ("begin"));
         Writer.Open_List;
         Writer.Open_List;
         Writer.Close_List;
         Writer.Open_List;
         Writer.Append_Atom (To_Atom ("head"));
         Writer.Append_Atom (To_Atom ("tail"));
         Writer.Close_List;
         Writer.Close_List;
         Writer.Append_Atom (To_Atom ("end"));

         Writer.Create ("");
         Secondary_File_Name := Hold (Writer.Name);
         Writer.Open_List;
         Writer.Append_Atom (To_Atom ("first"));
         Writer.Append_Atom (To_Atom ("last"));
         Writer.Close_List;
      end First_Write;

      First_Read :
      declare
         Reader : File_Readers.S_Reader
           := File_Readers.Reader (To_String (Temporary_File_Name));
      begin
         Test_Tools.Test_Atom_Accessors (Test, Reader, To_Atom ("begin"), 0);
         Test_Tools.Next_And_Check (Test, Reader, Events.Open_List, 1);
         Test_Tools.Next_And_Check (Test, Reader, Events.Open_List, 2);
         Test_Tools.Next_And_Check (Test, Reader, Events.Close_List, 1);
         Test_Tools.Next_And_Check (Test, Reader, Events.Open_List, 2);
         Test_Tools.Next_And_Check (Test, Reader, To_Atom ("head"), 2);
         Test_Tools.Next_And_Check (Test, Reader, To_Atom ("tail"), 2);
         Test_Tools.Next_And_Check (Test, Reader, Events.Close_List, 1);
         Test_Tools.Next_And_Check (Test, Reader, Events.Close_List, 0);
         Test_Tools.Next_And_Check (Test, Reader, To_Atom ("end"), 0);
         Test_Tools.Next_And_Check (Test, Reader, Events.End_Of_Input, 0);

         Reader.Rewind;
         Test_Tools.Test_Atom_Accessors (Test, Reader, To_Atom ("begin"), 0);

         Reader.Set_Filename (To_String (Secondary_File_Name));
         Test_Tools.Next_And_Check (Test, Reader, To_Atom ("first"), 1);
         Test_Tools.Next_And_Check (Test, Reader, To_Atom ("last"), 1);
         Test_Tools.Next_And_Check (Test, Reader, Events.Close_List, 0);
         Test_Tools.Next_And_Check (Test, Reader, Events.End_Of_Input, 0);
      end First_Read;

      Second_Write :
      declare
         Writer : File_Writers.Writer
           := File_Writers.Open (To_String (Temporary_File_Name));
      begin
         Writer.Open_List;
         Writer.Append_Atom (To_Atom ("foo"));
         Writer.Append_Atom (To_Atom ("bar"));
         Writer.Open_List;
         Writer.Close_List;
         Writer.Close_List;

         Writer.Open (To_String (Secondary_File_Name));
         Writer.Open_List;
         Writer.Append_Atom (To_Atom ("unfinished"));
      end Second_Write;

      Raw_Read :
      begin
         Test_Tools.Test_Atom
           (Test,
            To_Atom ("5:begin(()(4:head4:tail))3:end(3:foo3:bar())"),
            File_Readers.Reader (To_String (Temporary_File_Name)).Read);
         Test_Tools.Test_Atom
           (Test,
            To_Atom ("(5:first4:last)(10:unfinished"),
            File_Readers.Reader (To_String (Secondary_File_Name)).Read);
      end Raw_Read;

      Clear_Secondary :
      declare
         File : Stream_IO.File_Type;
      begin
         Stream_IO.Open
           (File, Stream_IO.Out_File, To_String (Secondary_File_Name));
         Stream_IO.Delete (File);

         Check_Removal :
         begin
            Stream_IO.Open
              (File, Stream_IO.Out_File, To_String (Secondary_File_Name));
            Test.Error ("Expected exception wasn't triggered.");
            return;
         exception
            when Stream_IO.Name_Error => null;
         end Check_Removal;
      end Clear_Secondary;

      Run_Open_Or_Create :
      declare
         Writer : File_Writers.Writer
           := File_Writers.Open_Or_Create (To_String (Temporary_File_Name));
      begin
         Writer.Open_List;
         Writer.Append_String ("");
         Writer.Close_List;

         Writer.Open_Or_Create (To_String (Secondary_File_Name));
         Writer.Open_List;
         Writer.Append_String ("solo");
         Writer.Close_List;
      end Run_Open_Or_Create;

      Check_Open_Or_Create :
      begin
         Test_Tools.Test_Atom
           (Test,
            To_Atom ("5:begin(()(4:head4:tail))3:end(3:foo3:bar())(0:)"),
            File_Readers.Reader (To_String (Temporary_File_Name)).Read);
         Test_Tools.Test_Atom
           (Test,
            To_Atom ("(4:solo)"),
            File_Readers.Reader (To_String (Secondary_File_Name)).Read);
      end Check_Open_Or_Create;
   exception
      when Error : others => Test.Report_Exception (Error);
   end S_Expression_IO;

end Natools.S_Expressions.File_RW_Tests;

s_expressions-file_rw_tests: update to test Open_Or_Create primitives


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

with AWA.Users.Services.Tests;
with AWA.Users.Tests;
with AWA.Blogs.Modules.Tests;
with AWA.Wikis.Parsers.Tests;
with AWA.Wikis.Writers.Tests;
with AWA.Helpers.Selectors.Tests;
with AWA.Storages.Services.Tests;
with AWA.Events.Services.Tests;
with AWA.Mail.Clients.Tests;
with AWA.Mail.Modules.Tests;
with AWA.Images.Services.Tests;
with AWA.Votes.Modules.Tests;
with AWA.Questions.Modules.Tests;
with AWA.Modules.Tests;

with ASF.Converters.Dates;

with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;
with AWA.Images.Modules;
with AWA.Questions.Modules;
with AWA.Votes.Modules;

with AWA.Converters.Dates;
with AWA.Tests;
with AWA.Services.Contexts;
with AWA.Jobs.Services.Tests;
with AWA.Jobs.Modules.Tests;

with ASF.Server.Web;
with ASF.Server.Tests;
package body AWA.Testsuite is
   Users          : aliased AWA.Users.Modules.User_Module;

   Workspaces     : aliased AWA.Workspaces.Modules.Workspace_Module;

   Mail           : aliased AWA.Mail.Modules.Mail_Module;

   Jobs           : aliased AWA.Jobs.Modules.Job_Module;

   Blogs          : aliased AWA.Blogs.Modules.Blog_Module;

   Storages       : aliased AWA.Storages.Modules.Storage_Module;

   Images         : aliased AWA.Images.Modules.Image_Module;

   Questions      : aliased AWA.Questions.Modules.Question_Module;

   Votes          : aliased AWA.Votes.Modules.Vote_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      AWA.Modules.Tests.Add_Tests (Ret);
      AWA.Events.Services.Tests.Add_Tests (Ret);
      AWA.Mail.Clients.Tests.Add_Tests (Ret);
      AWA.Mail.Modules.Tests.Add_Tests (Ret);
      AWA.Users.Services.Tests.Add_Tests (Ret);
      AWA.Users.Tests.Add_Tests (Ret);
      AWA.Wikis.Parsers.Tests.Add_Tests (Ret);
      AWA.Wikis.Writers.Tests.Add_Tests (Ret);
      AWA.Helpers.Selectors.Tests.Add_Tests (Ret);
      AWA.Jobs.Modules.Tests.Add_Tests (Ret);
      AWA.Jobs.Services.Tests.Add_Tests (Ret);
      AWA.Blogs.Modules.Tests.Add_Tests (Ret);
      AWA.Storages.Services.Tests.Add_Tests (Ret);
      AWA.Images.Services.Tests.Add_Tests (Ret);
      AWA.Votes.Modules.Tests.Add_Tests (Ret);
      AWA.Questions.Modules.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

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

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      AWA.Tests.Initialize (App, Props, Add_Modules);

      if Add_Modules then
         declare
            Application : constant Applications.Application_Access := AWA.Tests.Get_Application;
            Ctx         : AWA.Services.Contexts.Service_Context;
            Users  : constant AWA.Users.Modules.User_Module_Access := AWA.Testsuite.Users'Access;
         begin
            Ctx.Set_Context (Application, null);
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Modules.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Storages.Modules.NAME,
                      URI    => "storages",
                      Module => Storages'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Images.Modules.NAME,
                      URI    => "images",
                      Module => Images'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Jobs.Modules.NAME,
                      URI    => "jobs",
                      Module => Jobs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Votes.Modules.NAME,
                      URI    => "votes",
                      Module => Votes'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Modules.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Questions.Modules.NAME,
                      URI    => "questions",
                      Module => Questions'Access);

            Application.Start;
            if Props.Exists ("test.server") then
               declare
                  WS : ASF.Server.Web.AWS_Container;
               begin
                  Application.Add_Converter (Name      => "dateConverter",
                                             Converter => Date_Converter'Access);
                  Application.Add_Converter (Name      => "smartDateConverter",
                                             Converter => Rel_Date_Converter'Access);

                  WS.Register_Application ("/asfunit", Application.all'Access);

                  WS.Start;
                  delay 6000.0;
               end;
            end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

end AWA.Testsuite;

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

with AWA.Users.Services.Tests;
with AWA.Users.Tests;
with AWA.Blogs.Modules.Tests;
with AWA.Wikis.Parsers.Tests;
with AWA.Wikis.Writers.Tests;
with AWA.Helpers.Selectors.Tests;
with AWA.Storages.Services.Tests;
with AWA.Events.Services.Tests;
with AWA.Mail.Clients.Tests;
with AWA.Mail.Modules.Tests;
with AWA.Images.Services.Tests;
with AWA.Votes.Modules.Tests;
with AWA.Tags.Modules.Tests;
with AWA.Questions.Modules.Tests;
with AWA.Modules.Tests;

with ASF.Converters.Dates;

with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;
with AWA.Images.Modules;
with AWA.Questions.Modules;
with AWA.Votes.Modules;
with AWA.Tags.Modules;

with AWA.Converters.Dates;
with AWA.Tests;
with AWA.Services.Contexts;
with AWA.Jobs.Services.Tests;
with AWA.Jobs.Modules.Tests;
with AWA.Settings.Modules.Tests;

with ASF.Server.Web;
with ASF.Server.Tests;
package body AWA.Testsuite is
   Users          : aliased AWA.Users.Modules.User_Module;

   Workspaces     : aliased AWA.Workspaces.Modules.Workspace_Module;

   Mail           : aliased AWA.Mail.Modules.Mail_Module;

   Jobs           : aliased AWA.Jobs.Modules.Job_Module;

   Blogs          : aliased AWA.Blogs.Modules.Blog_Module;

   Storages       : aliased AWA.Storages.Modules.Storage_Module;

   Images         : aliased AWA.Images.Modules.Image_Module;

   Questions      : aliased AWA.Questions.Modules.Question_Module;

   Votes          : aliased AWA.Votes.Modules.Vote_Module;

   Tags           : aliased AWA.Tags.Modules.Tag_Module;

   Settings       : aliased AWA.Settings.Modules.Setting_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      AWA.Modules.Tests.Add_Tests (Ret);
      AWA.Events.Services.Tests.Add_Tests (Ret);
      AWA.Mail.Clients.Tests.Add_Tests (Ret);
      AWA.Mail.Modules.Tests.Add_Tests (Ret);
      AWA.Users.Services.Tests.Add_Tests (Ret);
      AWA.Users.Tests.Add_Tests (Ret);
      AWA.Wikis.Parsers.Tests.Add_Tests (Ret);
      AWA.Wikis.Writers.Tests.Add_Tests (Ret);
      AWA.Helpers.Selectors.Tests.Add_Tests (Ret);
      AWA.Jobs.Modules.Tests.Add_Tests (Ret);
      AWA.Jobs.Services.Tests.Add_Tests (Ret);
      AWA.Settings.Modules.Tests.Add_Tests (Ret);
      AWA.Blogs.Modules.Tests.Add_Tests (Ret);
      AWA.Storages.Services.Tests.Add_Tests (Ret);
      AWA.Images.Services.Tests.Add_Tests (Ret);
      AWA.Votes.Modules.Tests.Add_Tests (Ret);
      AWA.Tags.Modules.Tests.Add_Tests (Ret);
      AWA.Questions.Modules.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

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

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      AWA.Tests.Initialize (App, Props, Add_Modules);

      if Add_Modules then
         declare
            Application : constant Applications.Application_Access := AWA.Tests.Get_Application;
            Ctx         : AWA.Services.Contexts.Service_Context;
            Users  : constant AWA.Users.Modules.User_Module_Access := AWA.Testsuite.Users'Access;
         begin
            Ctx.Set_Context (Application, null);
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Modules.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Storages.Modules.NAME,
                      URI    => "storages",
                      Module => Storages'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Images.Modules.NAME,
                      URI    => "images",
                      Module => Images'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Jobs.Modules.NAME,
                      URI    => "jobs",
                      Module => Jobs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Settings.Modules.NAME,
                      URI    => "settings",
                      Module => Settings'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Votes.Modules.NAME,
                      URI    => "votes",
                      Module => Votes'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Tags.Modules.NAME,
                      URI    => "tags",
                      Module => Tags'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Modules.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Questions.Modules.NAME,
                      URI    => "questions",
                      Module => Questions'Access);

            Application.Start;
            if Props.Exists ("test.server") then
               declare
                  WS : ASF.Server.Web.AWS_Container;
               begin
                  Application.Add_Converter (Name      => "dateConverter",
                                             Converter => Date_Converter'Access);
                  Application.Add_Converter (Name      => "smartDateConverter",
                                             Converter => Rel_Date_Converter'Access);

                  WS.Register_Application ("/asfunit", Application.all'Access);

                  WS.Start;
                  delay 6000.0;
               end;
            end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

end AWA.Testsuite;

Build the new unit tests

Build the new unit tests


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

package body Util.Concurrent.Counters is

   function Sync_Sub_And_Fetch (Ptr   : access Interfaces.Unsigned_32;
                                Value : in Interfaces.Unsigned_32) return Interfaces.Unsigned_32;
   pragma Import (Intrinsic, Sync_Sub_And_Fetch,
                  External_Name => "__sync_sub_and_fetch_4");

   function Sync_Fetch_And_Add (Ptr   : access Interfaces.Unsigned_32;
                                Value : in Interfaces.Unsigned_32) return Interfaces.Unsigned_32;
   pragma Import (Intrinsic, Sync_Fetch_And_Add,
                  External_Name => "__sync_fetch_and_add_4");

   procedure Sync_Add (Ptr   : access Interfaces.Unsigned_32;
                       Value : in Interfaces.Unsigned_32);
   pragma Import (Intrinsic, Sync_Add,
                  External_Name => "__sync_add_and_fetch_4");

   procedure Sync_Sub (Ptr   : access Interfaces.Unsigned_32;
                       Value : in Interfaces.Unsigned_32);
   pragma Import (Intrinsic, Sync_Sub,
                  External_Name => "__sync_sub_and_fetch_4");

   --  ------------------------------
   --  Increment the counter atomically.
   --  ------------------------------
   procedure Increment (C : in out Counter) is
   begin
      Sync_Add (C.Value'Unrestricted_Access, 1);
   end Increment;

   --  ------------------------------
   --  Increment the counter atomically and return the value before increment.
   --  ------------------------------
   procedure Increment (C     : in out Counter;
                        Value : out Integer) is
   begin
      Value := Integer (Sync_Fetch_And_Add (C.Value'Unrestricted_Access, 1));
   end Increment;

   --  ------------------------------
   --  Decrement the counter atomically.
   --  ------------------------------
   procedure Decrement (C : in out Counter) is
      use type Interfaces.Unsigned_32;
   begin
      Sync_Sub (C.Value'Unrestricted_Access, 1);
   end Decrement;

   --  ------------------------------
   --  Decrement the counter atomically and return a status.
   --  ------------------------------
   procedure Decrement (C : in out Counter;
                        Is_Zero : out Boolean) is
      use type Interfaces.Unsigned_32;

      Value : Interfaces.Unsigned_32;
   begin
      Value := Sync_Sub_And_Fetch (C.Value'Unrestricted_Access, 1);
      Is_Zero := Value = 0;
   end Decrement;

   --  ------------------------------
   --  Get the counter value
   --  ------------------------------
   function Value (C : in Counter) return Integer is
   begin
      return Integer (C.Value);
   end Value;

end Util.Concurrent.Counters;

-----------------------------------------------------------------------
--  util-concurrent -- Concurrent Counters
--  Copyright (C) 2009, 2010, 2015, 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.
-----------------------------------------------------------------------

package body Util.Concurrent.Counters is

   function Sync_Sub_And_Fetch (Ptr   : access Interfaces.Unsigned_32;
                                Value : in Interfaces.Unsigned_32) return Interfaces.Unsigned_32;
   pragma Import (Intrinsic, Sync_Sub_And_Fetch,
                  External_Name => "__sync_sub_and_fetch_4");

   function Sync_Fetch_And_Add (Ptr   : access Interfaces.Unsigned_32;
                                Value : in Interfaces.Unsigned_32) return Interfaces.Unsigned_32;
   pragma Import (Intrinsic, Sync_Fetch_And_Add,
                  External_Name => "__sync_fetch_and_add_4");

   procedure Sync_Add (Ptr   : access Interfaces.Unsigned_32;
                       Value : in Interfaces.Unsigned_32);
   pragma Import (Intrinsic, Sync_Add,
                  External_Name => "__sync_add_and_fetch_4");

   procedure Sync_Sub (Ptr   : access Interfaces.Unsigned_32;
                       Value : in Interfaces.Unsigned_32);
   pragma Import (Intrinsic, Sync_Sub,
                  External_Name => "__sync_sub_and_fetch_4");

   --  ------------------------------
   --  Increment the counter atomically.
   --  ------------------------------
   procedure Increment (C : in out Counter) is
   begin
      Sync_Add (C.Value'Unrestricted_Access, 1);
   end Increment;

   --  ------------------------------
   --  Increment the counter atomically and return the value before increment.
   --  ------------------------------
   procedure Increment (C     : in out Counter;
                        Value : out Integer) is
   begin
      Value := Integer (Sync_Fetch_And_Add (C.Value'Unrestricted_Access, 1));
   end Increment;

   --  ------------------------------
   --  Decrement the counter atomically.
   --  ------------------------------
   procedure Decrement (C : in out Counter) is
      use type Interfaces.Unsigned_32;
   begin
      Sync_Sub (C.Value'Unrestricted_Access, 1);
   end Decrement;

   --  ------------------------------
   --  Decrement the counter atomically and return a status.
   --  ------------------------------
   procedure Decrement (C : in out Counter;
                        Is_Zero : out Boolean) is
      use type Interfaces.Unsigned_32;

      Value : Interfaces.Unsigned_32;
   begin
      Value := Sync_Sub_And_Fetch (C.Value'Unrestricted_Access, 1);
      Is_Zero := Value = 0;
   end Decrement;

   --  ------------------------------
   --  Get the counter value
   --  ------------------------------
   function Value (C : in Counter) return Integer is
   begin
      return Integer (C.Value);
   end Value;

end Util.Concurrent.Counters;

Update the header

Update the header


--  This spec has been automatically generated from FE310.svd

pragma Restrictions (No_Elaboration_Code);
pragma Ada_2012;
pragma Style_Checks (Off);

with HAL;
with System;

package FE310_SVD.PWM is
   pragma Preelaborate;

   ---------------
   -- Registers --
   ---------------

   subtype CONFIG_SCALE_Field is HAL.UInt4;

   --  PWM Configuration Register.
   type CONFIG_Register is record
      SCALE          : CONFIG_SCALE_Field := 16#0#;
      --  unspecified
      Reserved_4_7   : HAL.UInt4 := 16#0#;
      STICKY         : Boolean := False;
      ZEROCMP        : Boolean := False;
      DEGLITCH       : Boolean := False;
      --  unspecified
      Reserved_11_11 : HAL.Bit := 16#0#;
      ENALWAYS       : Boolean := False;
      ENONESHOT      : Boolean := False;
      --  unspecified
      Reserved_14_15 : HAL.UInt2 := 16#0#;
      CMP_CENTER_0   : Boolean := False;
      CMP_CENTER_1   : Boolean := False;
      CMP_CENTER_2   : Boolean := False;
      CMP_CENTER_3   : Boolean := False;
      --  unspecified
      Reserved_20_23 : HAL.UInt4 := 16#0#;
      CMP_GANG_0     : Boolean := False;
      CMP_GANG_1     : Boolean := False;
      CMP_GANG_2     : Boolean := False;
      CMP_GANG_3     : Boolean := False;
      CMP_IP_0       : Boolean := False;
      CMP_IP_1       : Boolean := False;
      CMP_IP_2       : Boolean := False;
      CMP_IP_3       : Boolean := False;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for CONFIG_Register use record
      SCALE          at 0 range 0 .. 3;
      Reserved_4_7   at 0 range 4 .. 7;
      STICKY         at 0 range 8 .. 8;
      ZEROCMP        at 0 range 9 .. 9;
      DEGLITCH       at 0 range 10 .. 10;
      Reserved_11_11 at 0 range 11 .. 11;
      ENALWAYS       at 0 range 12 .. 12;
      ENONESHOT      at 0 range 13 .. 13;
      Reserved_14_15 at 0 range 14 .. 15;
      CMP_CENTER_0   at 0 range 16 .. 16;
      CMP_CENTER_1   at 0 range 17 .. 17;
      CMP_CENTER_2   at 0 range 18 .. 18;
      CMP_CENTER_3   at 0 range 19 .. 19;
      Reserved_20_23 at 0 range 20 .. 23;
      CMP_GANG_0     at 0 range 24 .. 24;
      CMP_GANG_1     at 0 range 25 .. 25;
      CMP_GANG_2     at 0 range 26 .. 26;
      CMP_GANG_3     at 0 range 27 .. 27;
      CMP_IP_0       at 0 range 28 .. 28;
      CMP_IP_1       at 0 range 29 .. 29;
      CMP_IP_2       at 0 range 30 .. 30;
      CMP_IP_3       at 0 range 31 .. 31;
   end record;

   subtype COUNT_16_CNT_Field is HAL.UInt31;

   --  PWM Count Register.
   type COUNT_16_Register is record
      CNT            : COUNT_16_CNT_Field := 16#0#;
      --  unspecified
      Reserved_31_31 : HAL.Bit := 16#0#;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for COUNT_16_Register use record
      CNT            at 0 range 0 .. 30;
      Reserved_31_31 at 0 range 31 .. 31;
   end record;

   subtype COUNT_8_CNT_Field is HAL.UInt23;

   --  PWM Count Register.
   type COUNT_8_Register is record
      CNT            : COUNT_8_CNT_Field := 16#0#;
      --  unspecified
      Reserved_23_31 : HAL.UInt9 := 16#0#;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for COUNT_8_Register use record
      CNT            at 0 range 0 .. 22;
      Reserved_23_31 at 0 range 23 .. 31;
   end record;

   subtype SCALE_COUNT_16_CNT_Field is HAL.UInt16;

   --  PWM Scaled Conunter Register.
   type SCALE_COUNT_16_Register is record
      CNT            : SCALE_COUNT_16_CNT_Field := 16#0#;
      --  unspecified
      Reserved_16_31 : HAL.UInt16 := 16#0#;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for SCALE_COUNT_16_Register use record
      CNT            at 0 range 0 .. 15;
      Reserved_16_31 at 0 range 16 .. 31;
   end record;

   subtype SCALE_COUNT_8_CNT_Field is HAL.UInt9;

   --  PWM Scaled Conunter Register.
   type SCALE_COUNT_8_Register is record
      CNT           : SCALE_COUNT_8_CNT_Field := 16#0#;
      --  unspecified
      Reserved_9_31 : HAL.UInt23 := 16#0#;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for SCALE_COUNT_8_Register use record
      CNT           at 0 range 0 .. 8;
      Reserved_9_31 at 0 range 9 .. 31;
   end record;

   subtype COMPARE_0_16_COMPARE_Field is HAL.UInt16;

   --  PWM Compare Register.
   type COMPARE_0_16_Register is record
      COMPARE        : COMPARE_0_16_COMPARE_Field := 16#0#;
      --  unspecified
      Reserved_16_31 : HAL.UInt16 := 16#0#;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for COMPARE_0_16_Register use record
      COMPARE        at 0 range 0 .. 15;
      Reserved_16_31 at 0 range 16 .. 31;
   end record;

   subtype COMPARE_0_8_COMPARE_Field is HAL.UInt16;

   --  PWM Compare Register.
   type COMPARE_0_8_Register is record
      COMPARE        : COMPARE_0_8_COMPARE_Field := 16#0#;
      --  unspecified
      Reserved_16_31 : HAL.UInt16 := 16#0#;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for COMPARE_0_8_Register use record
      COMPARE        at 0 range 0 .. 15;
      Reserved_16_31 at 0 range 16 .. 31;
   end record;

   subtype COMPARE_1_16_COMPARE_Field is HAL.UInt16;

   --  PWM Compare Register.
   type COMPARE_1_16_Register is record
      COMPARE        : COMPARE_1_16_COMPARE_Field := 16#0#;
      --  unspecified
      Reserved_16_31 : HAL.UInt16 := 16#0#;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for COMPARE_1_16_Register use record
      COMPARE        at 0 range 0 .. 15;
      Reserved_16_31 at 0 range 16 .. 31;
   end record;

   subtype COMPARE_1_8_COMPARE_Field is HAL.UInt16;

   --  PWM Compare Register.
   type COMPARE_1_8_Register is record
      COMPARE        : COMPARE_1_8_COMPARE_Field := 16#0#;
      --  unspecified
      Reserved_16_31 : HAL.UInt16 := 16#0#;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for COMPARE_1_8_Register use record
      COMPARE        at 0 range 0 .. 15;
      Reserved_16_31 at 0 range 16 .. 31;
   end record;

   subtype COMPARE_2_16_COMPARE_Field is HAL.UInt16;

   --  PWM Compare Register.
   type COMPARE_2_16_Register is record
      COMPARE        : COMPARE_2_16_COMPARE_Field := 16#0#;
      --  unspecified
      Reserved_16_31 : HAL.UInt16 := 16#0#;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for COMPARE_2_16_Register use record
      COMPARE        at 0 range 0 .. 15;
      Reserved_16_31 at 0 range 16 .. 31;
   end record;

   subtype COMPARE_2_8_COMPARE_Field is HAL.UInt16;

   --  PWM Compare Register.
   type COMPARE_2_8_Register is record
      COMPARE        : COMPARE_2_8_COMPARE_Field := 16#0#;
      --  unspecified
      Reserved_16_31 : HAL.UInt16 := 16#0#;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for COMPARE_2_8_Register use record
      COMPARE        at 0 range 0 .. 15;
      Reserved_16_31 at 0 range 16 .. 31;
   end record;

   subtype COMPARE_3_16_COMPARE_Field is HAL.UInt16;

   --  PWM Compare Register.
   type COMPARE_3_16_Register is record
      COMPARE        : COMPARE_3_16_COMPARE_Field := 16#0#;
      --  unspecified
      Reserved_16_31 : HAL.UInt16 := 16#0#;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for COMPARE_3_16_Register use record
      COMPARE        at 0 range 0 .. 15;
      Reserved_16_31 at 0 range 16 .. 31;
   end record;

   subtype COMPARE_3_8_COMPARE_Field is HAL.UInt16;

   --  PWM Compare Register.
   type COMPARE_3_8_Register is record
      COMPARE        : COMPARE_3_8_COMPARE_Field := 16#0#;
      --  unspecified
      Reserved_16_31 : HAL.UInt16 := 16#0#;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for COMPARE_3_8_Register use record
      COMPARE        at 0 range 0 .. 15;
      Reserved_16_31 at 0 range 16 .. 31;
   end record;

   -----------------
   -- Peripherals --
   -----------------

   type PWM0_Disc is
     (
      PWM0_Disc_16,
      PWM0_Disc_8);

   --  Pulse-Width Modulation.
   type PWM_Peripheral
     (Discriminent : PWM0_Disc := PWM0_Disc_16)
   is record
      --  PWM Configuration Register.
      CONFIG         : aliased CONFIG_Register;
      case Discriminent is
         when PWM0_Disc_16 =>
            --  PWM Count Register.
            COUNT_16 : aliased COUNT_16_Register;
            --  PWM Scaled Conunter Register.
            SCALE_COUNT_16 : aliased SCALE_COUNT_16_Register;
            --  PWM Compare Register.
            COMPARE_0_16 : aliased COMPARE_0_16_Register;
            --  PWM Compare Register.
            COMPARE_1_16 : aliased COMPARE_1_16_Register;
            --  PWM Compare Register.
            COMPARE_2_16 : aliased COMPARE_2_16_Register;
            --  PWM Compare Register.
            COMPARE_3_16 : aliased COMPARE_3_16_Register;
         when PWM0_Disc_8 =>
            --  PWM Count Register.
            COUNT_8 : aliased COUNT_8_Register;
            --  PWM Scaled Conunter Register.
            SCALE_COUNT_8 : aliased SCALE_COUNT_8_Register;
            --  PWM Compare Register.
            COMPARE_0_8 : aliased COMPARE_0_8_Register;
            --  PWM Compare Register.
            COMPARE_1_8 : aliased COMPARE_1_8_Register;
            --  PWM Compare Register.
            COMPARE_2_8 : aliased COMPARE_2_8_Register;
            --  PWM Compare Register.
            COMPARE_3_8 : aliased COMPARE_3_8_Register;
      end case;
   end record
     with Unchecked_Union, Volatile;

   for PWM_Peripheral use record
      CONFIG         at 16#0# range 0 .. 31;
      COUNT_16       at 16#8# range 0 .. 31;
      SCALE_COUNT_16 at 16#10# range 0 .. 31;
      COMPARE_0_16   at 16#20# range 0 .. 31;
      COMPARE_1_16   at 16#24# range 0 .. 31;
      COMPARE_2_16   at 16#28# range 0 .. 31;
      COMPARE_3_16   at 16#2C# range 0 .. 31;
      COUNT_8        at 16#8# range 0 .. 31;
      SCALE_COUNT_8  at 16#10# range 0 .. 31;
      COMPARE_0_8    at 16#20# range 0 .. 31;
      COMPARE_1_8    at 16#24# range 0 .. 31;
      COMPARE_2_8    at 16#28# range 0 .. 31;
      COMPARE_3_8    at 16#2C# range 0 .. 31;
   end record;

   --  Pulse-Width Modulation.
   PWM0_Periph : aliased PWM_Peripheral
     with Import, Address => System'To_Address (16#10015000#);

   --  Pulse-Width Modulation.
   PWM1_Periph : aliased PWM_Peripheral
     with Import, Address => System'To_Address (16#10025000#);

   --  Pulse-Width Modulation.
   PWM2_Periph : aliased PWM_Peripheral
     with Import, Address => System'To_Address (16#10035000#);

end FE310_SVD.PWM;

--  This spec has been automatically generated from FE310.svd

pragma Restrictions (No_Elaboration_Code);
pragma Ada_2012;
pragma Style_Checks (Off);

with HAL;
with System;

package FE310_SVD.PWM is
   pragma Preelaborate;

   ---------------
   -- Registers --
   ---------------

   subtype CONFIG_SCALE_Field is HAL.UInt4;

   --  CONFIG_CMP_CENTER array
   type CONFIG_CMP_CENTER_Field_Array is array (0 .. 3) of Boolean
     with Component_Size => 1, Size => 4;

   --  Type definition for CONFIG_CMP_CENTER
   type CONFIG_CMP_CENTER_Field
     (As_Array : Boolean := False)
   is record
      case As_Array is
         when False =>
            --  CMP_CENTER as a value
            Val : HAL.UInt4;
         when True =>
            --  CMP_CENTER as an array
            Arr : CONFIG_CMP_CENTER_Field_Array;
      end case;
   end record
     with Unchecked_Union, Size => 4;

   for CONFIG_CMP_CENTER_Field use record
      Val at 0 range 0 .. 3;
      Arr at 0 range 0 .. 3;
   end record;

   --  CONFIG_CMP_GANG array
   type CONFIG_CMP_GANG_Field_Array is array (0 .. 3) of Boolean
     with Component_Size => 1, Size => 4;

   --  Type definition for CONFIG_CMP_GANG
   type CONFIG_CMP_GANG_Field
     (As_Array : Boolean := False)
   is record
      case As_Array is
         when False =>
            --  CMP_GANG as a value
            Val : HAL.UInt4;
         when True =>
            --  CMP_GANG as an array
            Arr : CONFIG_CMP_GANG_Field_Array;
      end case;
   end record
     with Unchecked_Union, Size => 4;

   for CONFIG_CMP_GANG_Field use record
      Val at 0 range 0 .. 3;
      Arr at 0 range 0 .. 3;
   end record;

   --  CONFIG_CMP_IP array
   type CONFIG_CMP_IP_Field_Array is array (0 .. 3) of Boolean
     with Component_Size => 1, Size => 4;

   --  Type definition for CONFIG_CMP_IP
   type CONFIG_CMP_IP_Field
     (As_Array : Boolean := False)
   is record
      case As_Array is
         when False =>
            --  CMP_IP as a value
            Val : HAL.UInt4;
         when True =>
            --  CMP_IP as an array
            Arr : CONFIG_CMP_IP_Field_Array;
      end case;
   end record
     with Unchecked_Union, Size => 4;

   for CONFIG_CMP_IP_Field use record
      Val at 0 range 0 .. 3;
      Arr at 0 range 0 .. 3;
   end record;

   --  PWM Configuration Register.
   type CONFIG_Register is record
      SCALE          : CONFIG_SCALE_Field := 16#0#;
      --  unspecified
      Reserved_4_7   : HAL.UInt4 := 16#0#;
      STICKY         : Boolean := False;
      ZEROCMP        : Boolean := False;
      DEGLITCH       : Boolean := False;
      --  unspecified
      Reserved_11_11 : HAL.Bit := 16#0#;
      ENALWAYS       : Boolean := False;
      ENONESHOT      : Boolean := False;
      --  unspecified
      Reserved_14_15 : HAL.UInt2 := 16#0#;
      CMP_CENTER     : CONFIG_CMP_CENTER_Field :=
                        (As_Array => False, Val => 16#0#);
      --  unspecified
      Reserved_20_23 : HAL.UInt4 := 16#0#;
      CMP_GANG       : CONFIG_CMP_GANG_Field :=
                        (As_Array => False, Val => 16#0#);
      CMP_IP         : CONFIG_CMP_IP_Field :=
                        (As_Array => False, Val => 16#0#);
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for CONFIG_Register use record
      SCALE          at 0 range 0 .. 3;
      Reserved_4_7   at 0 range 4 .. 7;
      STICKY         at 0 range 8 .. 8;
      ZEROCMP        at 0 range 9 .. 9;
      DEGLITCH       at 0 range 10 .. 10;
      Reserved_11_11 at 0 range 11 .. 11;
      ENALWAYS       at 0 range 12 .. 12;
      ENONESHOT      at 0 range 13 .. 13;
      Reserved_14_15 at 0 range 14 .. 15;
      CMP_CENTER     at 0 range 16 .. 19;
      Reserved_20_23 at 0 range 20 .. 23;
      CMP_GANG       at 0 range 24 .. 27;
      CMP_IP         at 0 range 28 .. 31;
   end record;

   subtype COUNT_CNT_Field is HAL.UInt31;

   --  PWM Count Register.
   type COUNT_Register is record
      CNT            : COUNT_CNT_Field := 16#0#;
      --  unspecified
      Reserved_31_31 : HAL.Bit := 16#0#;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for COUNT_Register use record
      CNT            at 0 range 0 .. 30;
      Reserved_31_31 at 0 range 31 .. 31;
   end record;

   subtype SCALE_COUNT_CNT_Field is HAL.UInt16;

   --  PWM Scaled Conunter Register.
   type SCALE_COUNT_Register is record
      CNT            : SCALE_COUNT_CNT_Field := 16#0#;
      --  unspecified
      Reserved_16_31 : HAL.UInt16 := 16#0#;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for SCALE_COUNT_Register use record
      CNT            at 0 range 0 .. 15;
      Reserved_16_31 at 0 range 16 .. 31;
   end record;

   subtype COMPARE_COMPARE_Field is HAL.UInt16;

   --  PWM Compare Register.
   type COMPARE_Register is record
      COMPARE        : COMPARE_COMPARE_Field := 16#0#;
      --  unspecified
      Reserved_16_31 : HAL.UInt16 := 16#0#;
   end record
     with Volatile_Full_Access, Size => 32,
          Bit_Order => System.Low_Order_First;

   for COMPARE_Register use record
      COMPARE        at 0 range 0 .. 15;
      Reserved_16_31 at 0 range 16 .. 31;
   end record;

   -----------------
   -- Peripherals --
   -----------------

   --  Pulse-Width Modulation.
   type PWM_Peripheral is record
      --  PWM Configuration Register.
      CONFIG      : aliased CONFIG_Register;
      --  PWM Count Register.
      COUNT       : aliased COUNT_Register;
      --  PWM Scaled Conunter Register.
      SCALE_COUNT : aliased SCALE_COUNT_Register;
      --  PWM Compare Register.
      COMPARE0    : aliased COMPARE_Register;
      --  PWM Compare Register.
      COMPARE1    : aliased COMPARE_Register;
      --  PWM Compare Register.
      COMPARE2    : aliased COMPARE_Register;
      --  PWM Compare Register.
      COMPARE3    : aliased COMPARE_Register;
   end record
     with Volatile;

   for PWM_Peripheral use record
      CONFIG      at 16#0# range 0 .. 31;
      COUNT       at 16#8# range 0 .. 31;
      SCALE_COUNT at 16#10# range 0 .. 31;
      COMPARE0    at 16#20# range 0 .. 31;
      COMPARE1    at 16#24# range 0 .. 31;
      COMPARE2    at 16#28# range 0 .. 31;
      COMPARE3    at 16#2C# range 0 .. 31;
   end record;

   --  Pulse-Width Modulation.
   PWM0_Periph : aliased PWM_Peripheral
     with Import, Address => System'To_Address (16#10015000#);

   --  Pulse-Width Modulation.
   PWM1_Periph : aliased PWM_Peripheral
     with Import, Address => System'To_Address (16#10025000#);

   --  Pulse-Width Modulation.
   PWM2_Periph : aliased PWM_Peripheral
     with Import, Address => System'To_Address (16#10035000#);

end FE310_SVD.PWM;

FE310_SVD: Update generated code with better description of PWM


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

with Util.Tests;

package Babel.Base.Users.Tests is

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

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

   --  Test the Find function resolving some existing user.
   procedure Test_Find (T : in out Test);

   --  Test the Get_Name operation.
   procedure Test_Get_Name (T : in out Test);

end Babel.Base.Users.Tests;

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

with Util.Tests;

package Babel.Base.Users.Tests is

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

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

   --  Test the Find function resolving some existing user.
   procedure Test_Find (T : in out Test);

   --  Test the Get_Name operation.
   procedure Test_Get_Name (T : in out Test);

   --  Test the Get_Uid operation.
   procedure Test_Get_Uid (T : in out Test);

end Babel.Base.Users.Tests;

Declare the Test_Get_Uid procedure

Declare the Test_Get_Uid procedure