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

   type String_Ptr is access all String;

   subtype Uint8 is Interfaces.Unsigned_8;

   subtype Uint16 is Interfaces.Unsigned_16;

   subtype Uint32 is Interfaces.Unsigned_32;

   subtype Uint64 is Interfaces.Unsigned_64;

   subtype Target_Addr is Interfaces.Unsigned_32;

   subtype Target_Size is Interfaces.Unsigned_32;

   subtype Target_Offset is Interfaces.Unsigned_32;

   type Target_Tick_Ref is new Uint64;

   type Target_Thread_Ref is new Uint32;

   subtype Target_Process_Ref is Uint32;

   subtype Target_Time is Target_Tick_Ref;

   --  Return an hexadecimal string representation of the value.
   function Hex_Image (Value : in Uint32;
                       Length : in Positive := 8) return String;

   --  Format the target time to a printable representation.
   function Tick_Image (Value : in Target_Tick_Ref) return String;

   function "-" (Left, Right : in Target_Tick_Ref) return Target_Tick_Ref;

end MAT.Types;

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

   type String_Ptr is access all String;

   subtype Uint8 is Interfaces.Unsigned_8;

   subtype Uint16 is Interfaces.Unsigned_16;

   subtype Uint32 is Interfaces.Unsigned_32;

   subtype Uint64 is Interfaces.Unsigned_64;

   subtype Target_Addr is Interfaces.Unsigned_64;

   subtype Target_Size is Interfaces.Unsigned_64;

   subtype Target_Offset is Interfaces.Unsigned_64;

   type Target_Tick_Ref is new Uint64;

   type Target_Thread_Ref is new Uint32;

   subtype Target_Process_Ref is Uint32;

   subtype Target_Time is Target_Tick_Ref;

   --  Return an hexadecimal string representation of the value.
   function Hex_Image (Value : in Uint32;
                       Length : in Positive := 8) return String;

   --  Return an hexadecimal string representation of the value.
   function Hex_Image (Value  : in Uint64;
                       Length : in Positive := 16) return String;

   --  Format the target time to a printable representation.
   function Tick_Image (Value : in Target_Tick_Ref) return String;

   function "-" (Left, Right : in Target_Tick_Ref) return Target_Tick_Ref;

end MAT.Types;

Change the Target_Addr to a 64-bit value Declare an Hex_Image function for 64-bit values


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

with MAT.Targets;
package MAT.Commands is

   Stop_Interp : exception;

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

   --  The options that can be configured through the command line.
   type Options_Type is record
      Interactive : Boolean := True;
      Graphical   : Boolean := False;
      Address     : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   --  Procedure that defines a command handler.
   type Command_Handler is access procedure (Target : in out MAT.Targets.Target_Type'Class;
                                             Args   : in String);

   --  Execute the command given in the line.
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String);

   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   procedure Interactive (Target : in out MAT.Targets.Target_Type'Class);

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

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

   --  Print the application usage.
   procedure Usage;

end MAT.Commands;

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

with MAT.Targets;
package MAT.Commands is

   Stop_Interp : exception;

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

   --  The options that can be configured through the command line.
   type Options_Type is record
      Interactive : Boolean := True;
      Graphical   : Boolean := False;
      Address     : GNAT.Sockets.Sock_Addr_Type := (Port => 4096, others => <>);
   end record;

   --  Procedure that defines a command handler.
   type Command_Handler is access procedure (Target : in out MAT.Targets.Target_Type'Class;
                                             Args   : in String);

   --  Execute the command given in the line.
   procedure Execute (Target : in out MAT.Targets.Target_Type'Class;
                      Line   : in String);

   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   procedure Interactive (Target : in out MAT.Targets.Target_Type'Class);

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

   --  Initialize the process targets by loading the MAT files.
   procedure Initialize_Files (Target  : in out MAT.Targets.Target_Type'Class);

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

   --  Print the application usage.
   procedure Usage;

end MAT.Commands;

Declare the Initialize_Files procedure

Declare the Initialize_Files procedure


-----------------------------------------------------------------------
--  asf-rest -- REST Support
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body ASF.Rest.Definition is

   overriding
   procedure Dispatch (Handler : in Descriptor;
                       Req     : in out ASF.Rest.Request'Class;
                       Reply   : in out ASF.Rest.Response'Class) is
      Object : Object_Type;
   begin
      Handler.Handler (Object, Req, Reply);
   end Dispatch;

   package body Definition is
      P : aliased String := Pattern;
   begin
      Instance.Method     := Method;
      Instance.Permission := Permission;
      Instance.Handler    := Handler;
      Instance.Pattern    := P'Access;
      ASF.Rest.Register (Entries, Instance'Access);
   end Definition;

end ASF.Rest.Definition;

-----------------------------------------------------------------------
--  asf-rest -- REST Support
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body ASF.Rest.Definition is

   --  ------------------------------
   --  Register the list of APIs that have been created by instantiating the <tt>Definition</tt>
   --  package.  The REST servlet identified by <tt>Name</tt> is searched in the servlet registry
   --  and used as the servlet for processing the API requests.
   --  ------------------------------
   procedure Register (Registry  : in out ASF.Servlets.Servlet_Registry;
                       Name      : in String;
                       ELContext : in EL.Contexts.ELContext'Class) is
   begin
      ASF.Rest.Register (Registry => Registry,
                         Name     => Name,
                         URI      => URI,
                         ELContext => ELContext,
                         List     => Entries);
   end Register;

   overriding
   procedure Dispatch (Handler : in Descriptor;
                       Req     : in out ASF.Rest.Request'Class;
                       Reply   : in out ASF.Rest.Response'Class;
                       Stream  : in out ASF.Rest.Output_Stream'Class) is
      Object : Object_Type;
   begin
      Handler.Handler (Object, Req, Reply, Stream);
   end Dispatch;

   package body Definition is
      P : aliased String := Pattern;
   begin
      Instance.Method     := Method;
      Instance.Permission := Permission;
      Instance.Handler    := Handler;
      Instance.Pattern    := P'Access;
      ASF.Rest.Register (Entries, Instance'Access);
   end Definition;

end ASF.Rest.Definition;

Implement the Register procedure to register all the APIs that have been instantiated to the servlet registry


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

with Ada.Streams;
with Ada.IO_Exceptions;

with Util.Systems.Os;
with Util.Systems.Constants;
package body Babel.Streams.Files is

   use type Interfaces.C.int;

   --  ------------------------------
   --  Open the local file for reading and use the given buffer for the Read operation.
   --  ------------------------------
   procedure Open (Stream : in out Stream_Type;
                   Path   : in String;
                   Buffer : in Babel.Files.Buffers.Buffer_Access) is
      Name : Interfaces.C.Strings.chars_ptr := Interfaces.C.Strings.New_String (Path);
      Fd   : Util.Systems.Os.File_Type;
   begin
      Fd := Util.Systems.Os.Sys_Open (Path  => Name,
                                      Flags => Util.Systems.Constants.O_RDONLY,
                                      Mode  => 0);
      Interfaces.C.Strings.Free (Name);
      Stream.Buffer := Buffer;
      Stream.File.Initialize (File => Fd);
   end Open;

   --  ------------------------------
   --  Create a file and prepare for the Write operation.
   --  ------------------------------
   procedure Create (Stream : in out Stream_Type;
                     Path   : in String;
                     Mode   : in Util.Systems.Types.mode_t) is
      use type Util.Systems.Os.File_Type;

      Name : Interfaces.C.Strings.chars_ptr := Interfaces.C.Strings.New_String (Path);
      Fd   : Util.Systems.Os.File_Type;
   begin
      Fd := Util.Systems.Os.Sys_Open (Path  => Name,
                                      Flags => Util.Systems.Constants.O_WRONLY
                                      + Util.Systems.Constants.O_CREAT
                                      + Util.Systems.Constants.O_TRUNC,
                                      Mode  => Interfaces.C.int (Mode));
      Interfaces.C.Strings.Free (Name);
      Stream.Buffer := null;
      Stream.File.Initialize (File => Fd);
      if Fd < 0 then
         raise Ada.IO_Exceptions.Name_Error with "Cannot create '" & Path & "'";
      end if;
    end Create;

   --  ------------------------------
   --  Read the data stream as much as possible and return the result in a buffer.
   --  The buffer is owned by the stream and need not be released.  The same buffer may
   --  or may not be returned by the next <tt>Read</tt> operation.
   --  A null buffer is returned when the end of the data stream is reached.
   --  ------------------------------
   overriding
   procedure Read (Stream : in out Stream_Type;
                   Buffer : out Babel.Files.Buffers.Buffer_Access) is
      use type Ada.Streams.Stream_Element_Offset;
   begin
      if Stream.Eof then
         Buffer := null;
      else
         Stream.File.Read (Stream.Buffer.Data, Stream.Buffer.Last);
         if Stream.Buffer.Last < Stream.Buffer.Data'First then
            Buffer := null;
         else
            Buffer := Stream.Buffer;
         end if;
         Stream.Eof := Stream.Buffer.Last < Stream.Buffer.Data'Last;
      end if;
   end Read;

   --  ------------------------------
   --  Write the buffer in the data stream.
   --  ------------------------------
   overriding
   procedure Write (Stream : in out Stream_Type;
                    Buffer : in Babel.Files.Buffers.Buffer_Access) is
   begin
      Stream.File.Write (Buffer.Data (Buffer.Data'First .. Buffer.Last));
   end Write;

   --  ------------------------------
   --  Close the data stream.
   --  ------------------------------
   overriding
   procedure Close (Stream : in out Stream_Type) is
   begin
      Stream.File.Close;
   end Close;

   --  ------------------------------
   --  Prepare to read again the data stream from the beginning.
   --  ------------------------------
   overriding
   procedure Rewind (Stream : in out Stream_Type) is
   begin
      Stream.File.Seek (0, Util.Systems.Types.SEEK_SET);
      Stream.Eof := False;
   end Rewind;

end Babel.Streams.Files;

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

with Util.Systems.Os;
with Util.Systems.Constants;
package body Babel.Streams.Files is

   use type Interfaces.C.int;

   function Errno return Integer;
   pragma Import (C, errno, "__get_errno");

   --  ------------------------------
   --  Open the local file for reading and use the given buffer for the Read operation.
   --  ------------------------------
   procedure Open (Stream : in out Stream_Type;
                   Path   : in String;
                   Buffer : in Babel.Files.Buffers.Buffer_Access) is
      Name : Interfaces.C.Strings.chars_ptr := Interfaces.C.Strings.New_String (Path);
      Fd   : Util.Systems.Os.File_Type;
   begin
      Fd := Util.Systems.Os.Sys_Open (Path  => Name,
                                      Flags => Util.Systems.Constants.O_RDONLY,
                                      Mode  => 0);
      Interfaces.C.Strings.Free (Name);
      Stream.Buffer := Buffer;
      Stream.File.Initialize (File => Fd);
   end Open;

   --  ------------------------------
   --  Create a file and prepare for the Write operation.
   --  ------------------------------
   procedure Create (Stream : in out Stream_Type;
                     Path   : in String;
                     Mode   : in Util.Systems.Types.mode_t) is
      use type Util.Systems.Os.File_Type;
      use Util.Systems.Os;
      use type Interfaces.C.int;

      Name : Interfaces.C.Strings.chars_ptr := Interfaces.C.Strings.New_String (Path);
      File : Util.Systems.Os.File_Type;
   begin
      File := Util.Systems.Os.Sys_Open (Path  => Name,
                                        Flags => Util.Systems.Constants.O_WRONLY
                                        + Util.Systems.Constants.O_CREAT
                                        + Util.Systems.Constants.O_TRUNC,
                                        Mode  => Mode);
      if File < 0 then
         if Errno = System.OS_Constants.ENOENT then
            declare
               Dir : constant String := Ada.Directories.Containing_Directory (Path);
            begin
               Ada.Directories.Create_Path (Dir);
            end;
            File := Util.Systems.Os.Sys_Open (Name, O_CREAT + O_WRONLY, Mode);
         end if;
      end if;
      Interfaces.C.Strings.Free (Name);
      Stream.Buffer := null;
      Stream.File.Initialize (File => File);
      if File < 0 then
         raise Ada.IO_Exceptions.Name_Error with "Cannot create '" & Path & "'";
      end if;
    end Create;

   --  ------------------------------
   --  Read the data stream as much as possible and return the result in a buffer.
   --  The buffer is owned by the stream and need not be released.  The same buffer may
   --  or may not be returned by the next <tt>Read</tt> operation.
   --  A null buffer is returned when the end of the data stream is reached.
   --  ------------------------------
   overriding
   procedure Read (Stream : in out Stream_Type;
                   Buffer : out Babel.Files.Buffers.Buffer_Access) is
      use type Ada.Streams.Stream_Element_Offset;
   begin
      if Stream.Eof then
         Buffer := null;
      else
         Stream.File.Read (Stream.Buffer.Data, Stream.Buffer.Last);
         if Stream.Buffer.Last < Stream.Buffer.Data'First then
            Buffer := null;
         else
            Buffer := Stream.Buffer;
         end if;
         Stream.Eof := Stream.Buffer.Last < Stream.Buffer.Data'Last;
      end if;
   end Read;

   --  ------------------------------
   --  Write the buffer in the data stream.
   --  ------------------------------
   overriding
   procedure Write (Stream : in out Stream_Type;
                    Buffer : in Babel.Files.Buffers.Buffer_Access) is
   begin
      Stream.File.Write (Buffer.Data (Buffer.Data'First .. Buffer.Last));
   end Write;

   --  ------------------------------
   --  Close the data stream.
   --  ------------------------------
   overriding
   procedure Close (Stream : in out Stream_Type) is
   begin
      Stream.File.Close;
   end Close;

   --  ------------------------------
   --  Prepare to read again the data stream from the beginning.
   --  ------------------------------
   overriding
   procedure Rewind (Stream : in out Stream_Type) is
   begin
      Stream.File.Seek (0, Util.Systems.Types.SEEK_SET);
      Stream.Eof := False;
   end Rewind;

end Babel.Streams.Files;

Fix the creation of path directories when writing a file


-------------------------------------------------------------------------------
--
--                                WAVEFILES
--
--                             Test application
--
-- The MIT License (MIT)
--
-- Copyright (c) 2015 Gustavo A. Hoffmann
--
-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to
-- deal in the Software without restriction, including without limitation the
-- rights to use, copy, modify, merge, publish, distribute, sublicense, and /
-- or sell copies of the Software, and to permit persons to whom the Software
-- is furnished to do so, subject to the following conditions:
--
-- The above copyright notice and this permission notice shall be included in
-- all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-- FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
-- IN THE SOFTWARE.
-------------------------------------------------------------------------------

with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_IO; use Ada.Text_IO;

with Wavefiles;
with Wavefiles.Read;
with Wavefiles.Write;
with Wavefiles.PCM_Buffers.IO;
with Wavefiles.PCM_Buffers.Operators;
with RIFF;

procedure Wavefiles_Test is
   Command_Line_OK : Boolean := False;

   Fixed_Depth : constant Positive := 32;

   pragma Warnings (Off, "declared high bound of type");

   type Fixed_Long is delta 1.0 / 2.0 ** (Fixed_Depth - 1) range -1.0 .. 1.0
     with Size => Fixed_Depth;

   pragma Warnings (On, "declared high bound of type");

   Channels    : constant Positive := 6;
   Samples     : constant Positive := 2048;

   package PCM_Buf is new Wavefiles.PCM_Buffers (Samples, Fixed_Long);
   package PCM_IO  is new PCM_Buf.IO;
   package PCM_Op  is new PCM_Buf.Operators;

   package Wav_Read  renames  Wavefiles.Read;
   package Wav_Write renames  Wavefiles.Write;

   Verbose     : constant Boolean := False;

   procedure Display_Info_File (File_In : String);

   procedure Copy_File (File_In         : String;
                        File_Out        : String);

   procedure Compare_Files (File_Ref    : String;
                            File_DUT    : String);

   procedure Diff_Files (File_Ref       : String;
                         File_DUT       : String;
                         File_Diff      : String);

   procedure Mix_Files (File_Ref        : String;
                        File_DUT        : String;
                        File_Mix        : String);

   procedure Print_Usage;

   --  Nested procedures

   procedure Display_Info_File (File_In  : String) is
      WF_In       : Wavefiles.Wavefile;
   begin
      Wav_Read.Open (WF_In, File_In);
      Wav_Read.Display_Info (WF_In);
      Wav_Read.Close (WF_In);
   end Display_Info_File;

   procedure Copy_File (File_In  : String;
                        File_Out : String) is
      WF_In       : Wavefiles.Wavefile;
      WF_Out      : Wavefiles.Wavefile;
      PCM         : PCM_Buf.PCM_Buffer (Channels);
      Wave_Format : RIFF.Wave_Format_Extensible;
      EOF         : Boolean;
      Frame       : Integer := 0;
   begin
      Wav_Read.Open (WF_In, File_In);

      Wave_Format := Wavefiles.Get_Wave_Format (WF_In);

      Wav_Write.Open (WF_Out, File_Out, Wave_Format);

      if Verbose then
         Put_Line ("Input File:");
         Wav_Read.Display_Info (WF_In);
         Put_Line ("Output File:");
         Wav_Read.Display_Info (WF_Out);
      end if;

      loop
         Frame := Frame + 1;
         if Verbose then
            Put ("[" & Integer'Image (Frame) & "]");
         end if;
         PCM_IO.Read (WF_In, PCM, EOF);
         PCM_IO.Write (WF_Out, PCM);
         exit when EOF;
      end loop;
      Wav_Read.Close (WF_In);
      Wav_Write.Close (WF_Out);

   end Copy_File;

   procedure Compare_Files (File_Ref  : String;
                            File_DUT  : String) is
      WF_Ref           : Wavefiles.Wavefile;
      WF_DUT           : Wavefiles.Wavefile;
      PCM_Ref          : PCM_Buf.PCM_Buffer (Channels);
      PCM_DUT          : PCM_Buf.PCM_Buffer (Channels);
      Wave_Format      : RIFF.Wave_Format_Extensible;
      EOF_Ref, EOF_DUT : Boolean;
      Diff_Frames      : Natural := 0;
      Frame            : Integer := 0;
   begin
      Wave_Format.Set_Default;

      Wav_Read.Open (WF_Ref, File_Ref);
      Wav_Read.Open (WF_DUT, File_DUT);
      loop
         Frame := Frame + 1;
         PCM_IO.Read (WF_Ref, PCM_Ref, EOF_Ref);
         PCM_IO.Read (WF_DUT, PCM_DUT, EOF_DUT);
         if not PCM_Buf."=" (PCM_Ref, PCM_DUT) then
            Diff_Frames := Diff_Frames + 1;
            Put_Line ("Difference found at frame " & Integer'Image (Frame));
         end if;
         exit when EOF_Ref or EOF_DUT;
      end loop;
      Wav_Read.Close (WF_Ref);
      Wav_Read.Close (WF_DUT);
      if Diff_Frames > 0 then
         Put_Line ("Differences have been found in "
                   & Natural'Image (Diff_Frames)
                   & " frames");
      else
         Put_Line ("No differences have been found");
      end if;
   end Compare_Files;

   procedure Diff_Files (File_Ref  : String;
                         File_DUT  : String;
                         File_Diff : String) is
      WF_Ref           : Wavefiles.Wavefile;
      WF_DUT           : Wavefiles.Wavefile;
      WF_Diff          : Wavefiles.Wavefile;
      PCM_Ref          : PCM_Buf.PCM_Buffer (Channels);
      PCM_DUT          : PCM_Buf.PCM_Buffer (Channels);
      PCM_Diff         : PCM_Buf.PCM_Buffer (Channels);
      Wave_Format      : RIFF.Wave_Format_Extensible;
      EOF_Ref, EOF_DUT : Boolean;
   begin
      RIFF.Set_Default (Wave_Format);

      Wav_Read.Open (WF_Ref, File_Ref);
      Wav_Read.Open (WF_DUT, File_DUT);
      Wav_Write.Open (WF_Diff, File_Diff, Wave_Format);
      loop
         PCM_IO.Read (WF_Ref, PCM_Ref, EOF_Ref);
         PCM_IO.Read (WF_DUT, PCM_DUT, EOF_DUT);
         PCM_Diff := PCM_Op."-" (PCM_Ref, PCM_DUT);
         PCM_IO.Write (WF_Diff, PCM_Diff);
         exit when EOF_Ref or EOF_DUT;
      end loop;
      Wav_Read.Close (WF_Ref);
      Wav_Read.Close (WF_DUT);
      Wav_Write.Close (WF_Diff);
   end Diff_Files;

   procedure Mix_Files (File_Ref  : String;
                        File_DUT  : String;
                        File_Mix  : String) is
      WF_Ref           : Wavefiles.Wavefile;
      WF_DUT           : Wavefiles.Wavefile;
      WF_Mix           : Wavefiles.Wavefile;
      PCM_Ref          : PCM_Buf.PCM_Buffer (Channels);
      PCM_DUT          : PCM_Buf.PCM_Buffer (Channels);
      PCM_Mix          : PCM_Buf.PCM_Buffer (Channels);
      Wave_Format      : RIFF.Wave_Format_Extensible;
      EOF_Ref, EOF_DUT : Boolean;
   begin
      RIFF.Set_Default (Wave_Format);

      Wav_Read.Open (WF_Ref, File_Ref);
      Wav_Read.Open (WF_DUT, File_DUT);
      Wav_Write.Open (WF_Mix, File_Mix, Wave_Format);
      loop
         PCM_IO.Read (WF_Ref, PCM_Ref, EOF_Ref);
         PCM_IO.Read (WF_DUT, PCM_DUT, EOF_DUT);
         PCM_Mix := PCM_Op."+" (PCM_Ref, PCM_DUT);
         PCM_IO.Write (WF_Mix, PCM_Mix);
         exit when EOF_Ref or EOF_DUT;
      end loop;
      Wav_Read.Close (WF_Ref);
      Wav_Read.Close (WF_DUT);
      Wav_Write.Close (WF_Mix);
   end Mix_Files;

   procedure Print_Usage is
   begin
      Put_Line ("Usage: " & Command_Name & " <command>");
      New_Line;
      Put_Line ("   info    <input_wavefile>");
      Put_Line ("   copy    <input_wavefile> <output_wavefile>");
      Put_Line ("   compare <ref_wavefile>   <dut_wavefile>");
      Put_Line ("   diff    <ref_wavefile>   <dut_wavefile>     "
                & "<diff_wavefile>");
      Put_Line ("   mix     <wavefile_1>     <wavefile_1>       "
                & "<mix_wavefile>");
   end Print_Usage;

begin

   if Argument_Count >= 1 then
      if Argument (1) = "info" and then Argument_Count = 2 then
         Command_Line_OK := True;
         Put_Line ("Information from: " & Argument (2));
         Display_Info_File (Argument (2));
      elsif Argument (1) = "copy" and then Argument_Count = 3 then
         Command_Line_OK := True;
         Put_Line ("Copying from: " & Argument (2));
         Put_Line ("Copying to:   " & Argument (3));
         Copy_File (Argument (2), Argument (3));
      elsif Argument (1) = "compare" and then Argument_Count = 3 then
         Command_Line_OK := True;
         Put_Line ("Reference: " & Argument (2));
         Put_Line ("DUT:       " & Argument (3));
         Compare_Files (Argument (2), Argument (3));
      elsif Argument (1) = "diff" and then Argument_Count = 4 then
         Command_Line_OK := True;
         Put_Line ("Reference: " & Argument (2));
         Put_Line ("DUT:       " & Argument (3));
         Put_Line ("Diff:      " & Argument (4));
         Diff_Files (Argument (2), Argument (3), Argument (4));
      elsif Argument (1) = "mix" and then Argument_Count = 4 then
         Command_Line_OK := True;
         Put_Line ("Wavefile #1: " & Argument (2));
         Put_Line ("Wavefile #2: " & Argument (3));
         Put_Line ("Mix file:    " & Argument (4));
         Mix_Files (Argument (2), Argument (3), Argument (4));
      end if;
   end if;

   if not Command_Line_OK then
      Print_Usage;
   end if;

end Wavefiles_Test;

-------------------------------------------------------------------------------
--
--                                WAVEFILES
--
--                             Test application
--
-- The MIT License (MIT)
--
-- Copyright (c) 2015 Gustavo A. Hoffmann
--
-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to
-- deal in the Software without restriction, including without limitation the
-- rights to use, copy, modify, merge, publish, distribute, sublicense, and /
-- or sell copies of the Software, and to permit persons to whom the Software
-- is furnished to do so, subject to the following conditions:
--
-- The above copyright notice and this permission notice shall be included in
-- all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-- FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
-- IN THE SOFTWARE.
-------------------------------------------------------------------------------

with Ada.Command_Line; use Ada.Command_Line;
with Ada.Text_IO; use Ada.Text_IO;

with Wavefiles;
with Wavefiles.Read;
with Wavefiles.Write;
with Wavefiles.PCM_Buffers.IO;
with Wavefiles.PCM_Buffers.Operators;
with RIFF;

procedure Wavefiles_Test is
   Command_Line_OK : Boolean := False;

   package Wave_Test is
      procedure Display_Info_File
        (File_In : String);

      procedure Copy_File
        (File_In         : String;
         File_Out        : String);

      procedure Compare_Files
        (File_Ref    : String;
         File_DUT    : String);

      procedure Diff_Files
        (File_Ref       : String;
         File_DUT       : String;
         File_Diff      : String);

      procedure Mix_Files
        (File_Ref        : String;
         File_DUT        : String;
         File_Mix        : String);
   end Wave_Test;

   procedure Print_Usage;

   --  Nested package & procedures

   package body Wave_Test is

      Fixed_Depth : constant Positive := 32;

      pragma Warnings (Off, "declared high bound of type");

      type Fixed_Long is delta 1.0 / 2.0 ** (Fixed_Depth - 1) range -1.0 .. 1.0
        with Size => Fixed_Depth;

      pragma Warnings (On, "declared high bound of type");

      Channels    : constant Positive := 6;
      Samples     : constant Positive := 2048;

      package PCM_Buf is new Wavefiles.PCM_Buffers (Samples, Fixed_Long);
      package PCM_IO  is new PCM_Buf.IO;
      package PCM_Op  is new PCM_Buf.Operators;

      package Wav_Read  renames  Wavefiles.Read;
      package Wav_Write renames  Wavefiles.Write;

      Verbose     : constant Boolean := False;

      procedure Display_Info_File (File_In  : String) is
         WF_In       : Wavefiles.Wavefile;
      begin
         Wav_Read.Open (WF_In, File_In);
         Wav_Read.Display_Info (WF_In);
         Wav_Read.Close (WF_In);
      end Display_Info_File;

      procedure Copy_File (File_In  : String;
                           File_Out : String) is
         WF_In       : Wavefiles.Wavefile;
         WF_Out      : Wavefiles.Wavefile;
         PCM         : PCM_Buf.PCM_Buffer (Channels);
         Wave_Format : RIFF.Wave_Format_Extensible;
         EOF         : Boolean;
         Frame       : Integer := 0;
      begin
         Wav_Read.Open (WF_In, File_In);

         Wave_Format := Wavefiles.Get_Wave_Format (WF_In);

         Wav_Write.Open (WF_Out, File_Out, Wave_Format);

         if Verbose then
            Put_Line ("Input File:");
            Wav_Read.Display_Info (WF_In);
            Put_Line ("Output File:");
            Wav_Read.Display_Info (WF_Out);
         end if;

         loop
            Frame := Frame + 1;
            if Verbose then
               Put ("[" & Integer'Image (Frame) & "]");
            end if;
            PCM_IO.Read (WF_In, PCM, EOF);
            PCM_IO.Write (WF_Out, PCM);
            exit when EOF;
         end loop;
         Wav_Read.Close (WF_In);
         Wav_Write.Close (WF_Out);

      end Copy_File;

      procedure Compare_Files (File_Ref  : String;
                               File_DUT  : String) is
         WF_Ref           : Wavefiles.Wavefile;
         WF_DUT           : Wavefiles.Wavefile;
         PCM_Ref          : PCM_Buf.PCM_Buffer (Channels);
         PCM_DUT          : PCM_Buf.PCM_Buffer (Channels);
         Wave_Format      : RIFF.Wave_Format_Extensible;
         EOF_Ref, EOF_DUT : Boolean;
         Diff_Frames      : Natural := 0;
         Frame            : Integer := 0;
      begin
         Wave_Format.Set_Default;

         Wav_Read.Open (WF_Ref, File_Ref);
         Wav_Read.Open (WF_DUT, File_DUT);
         loop
            Frame := Frame + 1;
            PCM_IO.Read (WF_Ref, PCM_Ref, EOF_Ref);
            PCM_IO.Read (WF_DUT, PCM_DUT, EOF_DUT);
            if not PCM_Buf."=" (PCM_Ref, PCM_DUT) then
               Diff_Frames := Diff_Frames + 1;
               Put_Line ("Difference found at frame " & Integer'Image (Frame));
            end if;
            exit when EOF_Ref or EOF_DUT;
         end loop;
         Wav_Read.Close (WF_Ref);
         Wav_Read.Close (WF_DUT);
         if Diff_Frames > 0 then
            Put_Line ("Differences have been found in "
                      & Natural'Image (Diff_Frames)
                      & " frames");
         else
            Put_Line ("No differences have been found");
         end if;
      end Compare_Files;

      procedure Diff_Files (File_Ref  : String;
                            File_DUT  : String;
                            File_Diff : String) is
         WF_Ref           : Wavefiles.Wavefile;
         WF_DUT           : Wavefiles.Wavefile;
         WF_Diff          : Wavefiles.Wavefile;
         PCM_Ref          : PCM_Buf.PCM_Buffer (Channels);
         PCM_DUT          : PCM_Buf.PCM_Buffer (Channels);
         PCM_Diff         : PCM_Buf.PCM_Buffer (Channels);
         Wave_Format      : RIFF.Wave_Format_Extensible;
         EOF_Ref, EOF_DUT : Boolean;
      begin
         RIFF.Set_Default (Wave_Format);

         Wav_Read.Open (WF_Ref, File_Ref);
         Wav_Read.Open (WF_DUT, File_DUT);
         Wav_Write.Open (WF_Diff, File_Diff, Wave_Format);
         loop
            PCM_IO.Read (WF_Ref, PCM_Ref, EOF_Ref);
            PCM_IO.Read (WF_DUT, PCM_DUT, EOF_DUT);
            PCM_Diff := PCM_Op."-" (PCM_Ref, PCM_DUT);
            PCM_IO.Write (WF_Diff, PCM_Diff);
            exit when EOF_Ref or EOF_DUT;
         end loop;
         Wav_Read.Close (WF_Ref);
         Wav_Read.Close (WF_DUT);
         Wav_Write.Close (WF_Diff);
      end Diff_Files;

      procedure Mix_Files (File_Ref  : String;
                           File_DUT  : String;
                           File_Mix  : String) is
         WF_Ref           : Wavefiles.Wavefile;
         WF_DUT           : Wavefiles.Wavefile;
         WF_Mix           : Wavefiles.Wavefile;
         PCM_Ref          : PCM_Buf.PCM_Buffer (Channels);
         PCM_DUT          : PCM_Buf.PCM_Buffer (Channels);
         PCM_Mix          : PCM_Buf.PCM_Buffer (Channels);
         Wave_Format      : RIFF.Wave_Format_Extensible;
         EOF_Ref, EOF_DUT : Boolean;
      begin
         RIFF.Set_Default (Wave_Format);

         Wav_Read.Open (WF_Ref, File_Ref);
         Wav_Read.Open (WF_DUT, File_DUT);
         Wav_Write.Open (WF_Mix, File_Mix, Wave_Format);
         loop
            PCM_IO.Read (WF_Ref, PCM_Ref, EOF_Ref);
            PCM_IO.Read (WF_DUT, PCM_DUT, EOF_DUT);
            PCM_Mix := PCM_Op."+" (PCM_Ref, PCM_DUT);
            PCM_IO.Write (WF_Mix, PCM_Mix);
            exit when EOF_Ref or EOF_DUT;
         end loop;
         Wav_Read.Close (WF_Ref);
         Wav_Read.Close (WF_DUT);
         Wav_Write.Close (WF_Mix);
      end Mix_Files;

   end Wave_Test;

   procedure Print_Usage is
   begin
      Put_Line ("Usage: " & Command_Name & " <command>");
      New_Line;
      Put_Line ("   info    <input_wavefile>");
      Put_Line ("   copy    <input_wavefile> <output_wavefile>");
      Put_Line ("   compare <ref_wavefile>   <dut_wavefile>");
      Put_Line ("   diff    <ref_wavefile>   <dut_wavefile>     "
                & "<diff_wavefile>");
      Put_Line ("   mix     <wavefile_1>     <wavefile_1>       "
                & "<mix_wavefile>");
   end Print_Usage;

begin

   if Argument_Count >= 1 then
      if Argument (1) = "info" and then Argument_Count = 2 then
         Command_Line_OK := True;
         Put_Line ("Information from: " & Argument (2));
         Wave_Test.Display_Info_File (Argument (2));
      elsif Argument (1) = "copy" and then Argument_Count = 3 then
         Command_Line_OK := True;
         Put_Line ("Copying from: " & Argument (2));
         Put_Line ("Copying to:   " & Argument (3));
         Wave_Test.Copy_File (Argument (2), Argument (3));
      elsif Argument (1) = "compare" and then Argument_Count = 3 then
         Command_Line_OK := True;
         Put_Line ("Reference: " & Argument (2));
         Put_Line ("DUT:       " & Argument (3));
         Wave_Test.Compare_Files (Argument (2), Argument (3));
      elsif Argument (1) = "diff" and then Argument_Count = 4 then
         Command_Line_OK := True;
         Put_Line ("Reference: " & Argument (2));
         Put_Line ("DUT:       " & Argument (3));
         Put_Line ("Diff:      " & Argument (4));
         Wave_Test.Diff_Files (Argument (2), Argument (3), Argument (4));
      elsif Argument (1) = "mix" and then Argument_Count = 4 then
         Command_Line_OK := True;
         Put_Line ("Wavefile #1: " & Argument (2));
         Put_Line ("Wavefile #2: " & Argument (3));
         Put_Line ("Mix file:    " & Argument (4));
         Wave_Test.Mix_Files (Argument (2), Argument (3), Argument (4));
      end if;
   end if;

   if not Command_Line_OK then
      Print_Usage;
   end if;

end Wavefiles_Test;

Test application: added nested package (Wave_Test)


with AdaBase;
with Connect;
with Ada.Text_IO;

procedure Fruit2 is

   package CON renames Connect;
   package TIO renames Ada.Text_IO;

   numrows : AdaBase.AffectedRows;

   --  Intentionally broken UPDATE command (calories misspelling)
   cmd : constant String := "UPDATE fruits set caloriesx = 14 " &
                            "WHERE fruit = 'strawberry'";

begin

   declare
   begin
      CON.connect_database;
      CON.DR.set_trait_error_mode (trait => AdaBase.raise_exception);
   exception
      when others =>
         TIO.Put_Line ("database connect failed.");
         return;
   end;

   TIO.Put_Line ("SQL: " & cmd);
   declare
   begin
      numrows := CON.DR.execute (sql => cmd);
      TIO.Put_Line ("Result: Updated" & numrows'Img & " rows");
      CON.DR.rollback;
   exception
      when others =>
         TIO.Put_Line ("Error!");
         TIO.Put_Line ("Driver message: " & CON.DR.last_driver_message);
         TIO.Put_Line ("   Driver code: " & CON.DR.last_driver_code'Img);
         TIO.Put_Line ("     SQL State: " & CON.DR.last_sql_state);
   end;
   CON.DR.disconnect;

end Fruit2;

with AdaBase;
with Connect;
with Ada.Text_IO;

procedure Fruit2 is

   package CON renames Connect;
   package TIO renames Ada.Text_IO;

   numrows : AdaBase.AffectedRows;

   --  Intentionally broken UPDATE command (calories misspelled)
   cmd : constant String := "UPDATE fruits set caloriesx = 14 " &
                            "WHERE fruit = 'strawberry'";

begin

   declare
   begin
      CON.connect_database;
      CON.DR.set_trait_error_mode (trait => AdaBase.raise_exception);
   exception
      when others =>
         TIO.Put_Line ("database connect failed.");
         return;
   end;

   TIO.Put_Line ("SQL: " & cmd);
   declare
   begin
      numrows := CON.DR.execute (sql => cmd);
      TIO.Put_Line ("Result: Updated" & numrows'Img & " rows");
      CON.DR.rollback;
   exception
      when others =>
         TIO.Put_Line ("Error!");
         TIO.Put_Line ("Driver message: " & CON.DR.last_driver_message);
         TIO.Put_Line ("   Driver code: " & CON.DR.last_driver_code'Img);
         TIO.Put_Line ("     SQL State: " & CON.DR.last_sql_state);
   end;
   CON.DR.disconnect;

end Fruit2;

Fix typo in fruit2 testcase comment

Fix typo in fruit2 testcase comment


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

--  The Util.Encoders package defines the Encoder object
--  which represents a mechanism to transform a stream from one format into
--  another format.
package Util.Encoders is

   pragma Preelaborate;

   Not_Supported  : exception;
   Encoding_Error : exception;

   --  Encoder/decoder for Base64 (RFC 4648)
   BASE_64     : constant String := "base64";

   --  Encoder/decoder for Base64 (RFC 4648) using the URL alphabet
   --  (+ and / are replaced by - and _)
   BASE_64_URL : constant String := "base64url";

   --  Encoder/decoder for Base16 (RFC 4648)
   BASE_16     : constant String := "base16";
   HEX         : constant String := "hex";

   --  Encoder for SHA1 (RFC 3174)
   HASH_SHA1   : constant String := "sha1";

   --  ------------------------------
   --  Encoder context object
   --  ------------------------------
   --  The Encoder provides operations to encode and decode
   --  strings or stream of data from one format to another.
   --  The Encoded contains two Transformer
   --  which either encodes or decodes the stream.
   type Encoder is tagged limited private;

   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   function Encode (E    : in Encoder;
                    Data : in String) return String;

   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   function Decode (E    : in Encoder;
                    Data : in String) return String;

   --  Create the encoder object for the specified encoding format.
   function Create (Name : String) return Encoder;

   --  ------------------------------
   --  Stream Transformation interface
   --  ------------------------------
   --  The Transformer interface defines the operation to transform
   --  a stream from one data format to another.
   type Transformer is limited interface;
   type Transformer_Access is access all Transformer'Class;

   --  Transform the input stream represented by Data into
   --  the output stream Into.  The transformation made by
   --  the object can be of any nature (Hex encoding, Base64 encoding,
   --  Hex decoding, Base64 decoding, ...).
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   procedure Transform (E       : in Transformer;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) is abstract;

   procedure Transform (E    : in Transformer;
                        Data : in String;
                        Result : out Ada.Strings.Unbounded.Unbounded_String) is null;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in Transformer'Class;
                       Data : in String) return String;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in Transformer'Class;
                       Data : in Ada.Streams.Stream_Element_Array) return String;

   --  Encode the value represented by <tt>Val</tt> in the stream array <tt>Into</tt> starting
   --  at position <tt>Pos</tt> in that array.  The value is encoded using LEB128 format, 7-bits
   --  at a time until all non zero bits are written.  The <tt>Last</tt> parameter is updated
   --  to indicate the position of the last valid byte written in <tt>Into</tt>.
   procedure Encode_LEB128 (Into  : in out Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : in Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

   --  Decode from the byte array <tt>From</tt> the value represented as LEB128 format starting
   --  at position <tt>Pos</tt> in that array.  After decoding, the <tt>Last</tt> index is updated
   --  to indicate the last position in the byte array.
   procedure Decode_LEB128 (From  : in Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : out Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

private

   type Encoder is new Ada.Finalization.Limited_Controlled with record
      Encode : Transformer_Access := null;
      Decode : Transformer_Access := null;
   end record;

   --  Delete the transformers
   overriding
   procedure Finalize (E : in out Encoder);

end Util.Encoders;

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

--  The Util.Encoders package defines the Encoder object
--  which represents a mechanism to transform a stream from one format into
--  another format.
package Util.Encoders is

   pragma Preelaborate;

   Not_Supported  : exception;
   Encoding_Error : exception;

   --  Encoder/decoder for Base64 (RFC 4648)
   BASE_64     : constant String := "base64";

   --  Encoder/decoder for Base64 (RFC 4648) using the URL alphabet
   --  (+ and / are replaced by - and _)
   BASE_64_URL : constant String := "base64url";

   --  Encoder/decoder for Base16 (RFC 4648)
   BASE_16     : constant String := "base16";
   HEX         : constant String := "hex";

   --  Encoder for SHA1 (RFC 3174)
   HASH_SHA1   : constant String := "sha1";

   --  ------------------------------
   --  Encoder context object
   --  ------------------------------
   --  The Encoder provides operations to encode and decode
   --  strings or stream of data from one format to another.
   --  The Encoded contains two Transformer
   --  which either encodes or decodes the stream.
   type Encoder is tagged limited private;

   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   function Encode (E    : in Encoder;
                    Data : in String) return String;

   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   function Decode (E    : in Encoder;
                    Data : in String) return String;

   --  Create the encoder object for the specified encoding format.
   function Create (Name : String) return Encoder;

   --  ------------------------------
   --  Stream Transformation interface
   --  ------------------------------
   --  The Transformer interface defines the operation to transform
   --  a stream from one data format to another.
   type Transformer is limited interface;
   type Transformer_Access is access all Transformer'Class;

   --  Transform the input stream represented by Data into
   --  the output stream Into.  The transformation made by
   --  the object can be of any nature (Hex encoding, Base64 encoding,
   --  Hex decoding, Base64 decoding, ...).
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   procedure Transform (E       : in Transformer;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) is abstract;

   procedure Transform (E    : in Transformer;
                        Data : in String;
                        Result : out Ada.Strings.Unbounded.Unbounded_String) is null;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in Transformer'Class;
                       Data : in String) return String;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   function Transform (E    : in Transformer'Class;
                       Data : in Ada.Streams.Stream_Element_Array) return String;

   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer and return the data in
   --  the Into array, setting Last to the last index.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   procedure Transform (E    : in Transformer'Class;
                        Data : in String;
                        Into : out Ada.Streams.Stream_Element_Array;
                        Last : out Ada.Streams.Stream_Element_Offset);

   --  Encode the value represented by <tt>Val</tt> in the stream array <tt>Into</tt> starting
   --  at position <tt>Pos</tt> in that array.  The value is encoded using LEB128 format, 7-bits
   --  at a time until all non zero bits are written.  The <tt>Last</tt> parameter is updated
   --  to indicate the position of the last valid byte written in <tt>Into</tt>.
   procedure Encode_LEB128 (Into  : in out Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : in Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

   --  Decode from the byte array <tt>From</tt> the value represented as LEB128 format starting
   --  at position <tt>Pos</tt> in that array.  After decoding, the <tt>Last</tt> index is updated
   --  to indicate the last position in the byte array.
   procedure Decode_LEB128 (From  : in Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : out Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset);

private

   type Encoder is new Ada.Finalization.Limited_Controlled with record
      Encode : Transformer_Access := null;
      Decode : Transformer_Access := null;
   end record;

   --  Delete the transformers
   overriding
   procedure Finalize (E : in out Encoder);

end Util.Encoders;

Declare new Transform procedure to transform a string using the encoder and produce a stream element array


-----------------------------------------------------------------------
--  wiki-writers-builders -- Wiki writer to a string builder
--  Copyright (C) 2011, 2012, 2013, 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 GNAT.Encode_UTF8_String;
package body Wiki.Streams.Builders is

   use Wiki.Strings;

   package WBS renames Wiki.Strings.Wide_Wide_Builders;

   --  ------------------------------
   --  Write the content to the string builder.
   --  ------------------------------
   overriding
   procedure Write (Stream  : in out Output_Builder_Stream;
                    Content : in Wide_Wide_String) is
   begin
      WBS.Append (Stream.Content, Content);
   end Write;

   --  ------------------------------
   --  Write the content to the string builder.
   --  ------------------------------
   overriding
   procedure Write (Stream  : in out Output_Builder_Stream;
                    Content : in Wide_Wide_Character) is
   begin
      WBS.Append (Stream.Content, Content);
   end Write;

   --  Write the string to the string builder.
   procedure Write_String (Stream  : in out Output_Builder_Stream;
                           Content : in String) is
   begin
      for I in Content'Range loop
         WBS.Append (Stream.Content, Wiki.Strings.To_WChar (Content (I)));
      end loop;
   end Write_String;

   --  ------------------------------
   --  Iterate over the buffer content calling the <tt>Process</tt> procedure with each
   --  chunk.
   --  ------------------------------
   procedure Iterate (Source  : in Output_Builder_Stream;
                      Process : not null access procedure (Chunk : in Wide_Wide_String)) is
   begin
      Wide_Wide_Builders.Iterate (Source.Content, Process);
   end Iterate;

   --  ------------------------------
   --  Convert what was collected in the writer builder to a string and return it.
   --  ------------------------------
   function To_String (Source : in Output_Builder_Stream) return String is
      procedure Convert (Chunk : in Wide_Wide_String);

      Pos    : Natural := 1;
      Result : String (1 .. 5 * Wide_Wide_Builders.Length (Source.Content));

      procedure Convert (Chunk : in Wide_Wide_String) is
      begin
         for I in Chunk'Range loop
            GNAT.Encode_UTF8_String.Encode_Wide_Wide_Character (Char   => Chunk (I),
                                                                Result => Result,
                                                                Ptr    => Pos);
         end loop;
      end Convert;

   begin
      Wide_Wide_Builders.Iterate (Source.Content, Convert'Access);
      return Result (1 .. Pos - 1);
   end To_String;

end Wiki.Streams.Builders;

-----------------------------------------------------------------------
--  wiki-writers-builders -- Wiki writer to a string builder
--  Copyright (C) 2011, 2012, 2013, 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 GNAT.Encode_UTF8_String;
package body Wiki.Streams.Builders is

--   use Wiki.Strings;

   package WBS renames Wiki.Strings.Wide_Wide_Builders;

   --  ------------------------------
   --  Write the content to the string builder.
   --  ------------------------------
   overriding
   procedure Write (Stream  : in out Output_Builder_Stream;
                    Content : in Wiki.Strings.WString) is
   begin
      WBS.Append (Stream.Content, Content);
   end Write;

   --  ------------------------------
   --  Write the content to the string builder.
   --  ------------------------------
   overriding
   procedure Write (Stream  : in out Output_Builder_Stream;
                    Content : in Wiki.Strings.WChar) is
   begin
      WBS.Append (Stream.Content, Content);
   end Write;

   --  Write the string to the string builder.
   procedure Write_String (Stream  : in out Output_Builder_Stream;
                           Content : in String) is
   begin
      for I in Content'Range loop
         WBS.Append (Stream.Content, Wiki.Strings.To_WChar (Content (I)));
      end loop;
   end Write_String;

   --  ------------------------------
   --  Iterate over the buffer content calling the <tt>Process</tt> procedure with each
   --  chunk.
   --  ------------------------------
   procedure Iterate (Source  : in Output_Builder_Stream;
                      Process : not null access procedure (Chunk : in Wiki.Strings.WString)) is
   begin
      Strings.Wide_Wide_Builders.Iterate (Source.Content, Process);
   end Iterate;

   --  ------------------------------
   --  Convert what was collected in the writer builder to a string and return it.
   --  ------------------------------
   function To_String (Source : in Output_Builder_Stream) return String is
      procedure Convert (Chunk : in Wiki.Strings.WString);

      Pos    : Natural := 1;
      Result : String (1 .. 5 * Strings.Wide_Wide_Builders.Length (Source.Content));

      procedure Convert (Chunk : in Wiki.Strings.WString) is
      begin
         for I in Chunk'Range loop
            GNAT.Encode_UTF8_String.Encode_Wide_Wide_Character (Char   => Chunk (I),
                                                                Result => Result,
                                                                Ptr    => Pos);
         end loop;
      end Convert;

   begin
      Strings.Wide_Wide_Builders.Iterate (Source.Content, Convert'Access);
      return Result (1 .. Pos - 1);
   end To_String;

end Wiki.Streams.Builders;

Use Wiki.Strings.WChar type

Use Wiki.Strings.WChar type


------------------------------------------------------------------------------
-- Copyright (c) 2016, 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.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Command Line Interface for primitives in Natools.Smaz.Tools.             --
------------------------------------------------------------------------------

with Ada.Command_Line;
with Ada.Streams;
with Ada.Strings.Unbounded;
with Ada.Text_IO.Text_Streams;
with Natools.Getopt_Long;
with Natools.S_Expressions.Parsers;
with Natools.Smaz.Tools;

procedure Smaz is
   package Options is
      type Id is
        (Help,
         Output_Ada_Dictionary);
   end Options;

   package Getopt is new Natools.Getopt_Long (Options.Id);

   type Callback is new Getopt.Handlers.Callback with record
      Display_Help : Boolean := False;
      Need_Dictionary : Boolean := False;
      Ada_Dictionary : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   overriding procedure Option
     (Handler  : in out Callback;
      Id       : in Options.Id;
      Argument : in String);

   overriding procedure Argument
     (Handler  : in out Callback;
      Argument : in String)
     is null;

   function Getopt_Config return Getopt.Configuration;
      --  Build the configuration object

   procedure Print_Dictionary
     (Filename : in String;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "");
   procedure Print_Dictionary
     (Output : in Ada.Text_IO.File_Type;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "");
      --  print the given dictionary in the given file

   procedure Print_Help
     (Opt : in Getopt.Configuration;
      Output : in Ada.Text_IO.File_Type);
      --  Print the help text to the given file

   overriding procedure Option
     (Handler  : in out Callback;
      Id       : in Options.Id;
      Argument : in String) is
   begin
      case Id is
         when Options.Help =>
            Handler.Display_Help := True;

         when Options.Output_Ada_Dictionary =>
            Handler.Need_Dictionary := True;

            if Argument'Length > 0 then
               Handler.Ada_Dictionary
                 := Ada.Strings.Unbounded.To_Unbounded_String (Argument);
            else
               Handler.Ada_Dictionary
                 := Ada.Strings.Unbounded.To_Unbounded_String ("-");
            end if;
      end case;
   end Option;

   function Getopt_Config return Getopt.Configuration is
      use Getopt;
      use Options;
      R : Getopt.Configuration;
   begin
      R.Add_Option ("ada-dict", 'A', Optional_Argument, Output_Ada_Dictionary);
      R.Add_Option ("help",     'h', No_Argument,       Help);

      return R;
   end Getopt_Config;

   procedure Print_Dictionary
     (Filename : in String;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "") is
   begin
      if Filename = "-" then
         Print_Dictionary
           (Ada.Text_IO.Current_Output, Dictionary, Hash_Package_Name);
      elsif Filename'Length > 0 then
         declare
            File : Ada.Text_IO.File_Type;
         begin
            Ada.Text_IO.Create (File, Name => Filename);
            Print_Dictionary (File, Dictionary, Hash_Package_Name);
            Ada.Text_IO.Close (File);
         end;
      end if;
   end Print_Dictionary;

   procedure Print_Dictionary
     (Output : in Ada.Text_IO.File_Type;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "")
   is
      procedure Put_Line (Line : in String);

      procedure Put_Line (Line : in String) is
      begin
         Ada.Text_IO.Put_Line (Output, Line);
      end Put_Line;

      procedure Print_Dictionary_In_Ada is
        new Natools.Smaz.Tools.Print_Dictionary_In_Ada (Put_Line);
   begin
      if Hash_Package_Name'Length > 0 then
         Print_Dictionary_In_Ada
           (Dictionary,
            Hash_Image => Hash_Package_Name & ".Hash'Access");
      else
         Print_Dictionary_In_Ada (Dictionary);
      end if;
   end Print_Dictionary;

   procedure Print_Help
     (Opt : in Getopt.Configuration;
      Output : in Ada.Text_IO.File_Type)
   is
      use Ada.Text_IO;
      Indent : constant String := "    ";
   begin
      Put_Line (Output, "Usage:");

      for Id in Options.Id loop
         Put (Output, Indent & Opt.Format_Names (Id));

         case Id is
            when Options.Help =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Display this help text");

            when Options.Output_Ada_Dictionary =>
               Put_Line (Output, "=[filename]");
               Put_Line (Output, Indent & Indent
                 & "Output the current dictionary as Ada code in the given");
               Put_Line (Output, Indent & Indent
                 & "file, or standard output if filename is ""-""");
         end case;
      end loop;
   end Print_Help;

   Opt_Config : constant Getopt.Configuration := Getopt_Config;
   Handler : Callback;
   Input_List : Natools.Smaz.Tools.String_Lists.List;
begin
   Process_Command_Line :
   begin
      Opt_Config.Process (Handler);
   exception
      when Getopt.Option_Error =>
         Print_Help (Opt_Config, Ada.Text_IO.Current_Error);
         Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
         return;
   end Process_Command_Line;

   if Handler.Display_Help then
      Print_Help (Opt_Config, Ada.Text_IO.Current_Output);
   end if;

   if not Handler.Need_Dictionary then
      return;
   end if;

   Read_Input_List :
   declare
      Input : constant access Ada.Streams.Root_Stream_Type'Class
        := Ada.Text_IO.Text_Streams.Stream (Ada.Text_IO.Current_Input);
      Parser : Natools.S_Expressions.Parsers.Stream_Parser (Input);
   begin
      Parser.Next;
      Natools.Smaz.Tools.Read_List (Input_List, Parser);
   end Read_Input_List;

   Build_Dictionary :
   declare
      Dictionary : constant Natools.Smaz.Dictionary
        := Natools.Smaz.Tools.To_Dictionary (Input_List, True);
      Ada_Dictionary : constant String
        := Ada.Strings.Unbounded.To_String (Handler.Ada_Dictionary);
   begin
      if Ada_Dictionary'Length > 0 then
         Print_Dictionary (Ada_Dictionary, Dictionary);
      end if;
   end Build_Dictionary;
end Smaz;

------------------------------------------------------------------------------
-- Copyright (c) 2016, 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.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Command Line Interface for primitives in Natools.Smaz.Tools.             --
------------------------------------------------------------------------------

with Ada.Command_Line;
with Ada.Streams;
with Ada.Strings.Unbounded;
with Ada.Text_IO.Text_Streams;
with Natools.Getopt_Long;
with Natools.S_Expressions.Parsers;
with Natools.Smaz.Tools;
with Natools.Smaz.Tools.GNAT;

procedure Smaz is
   package Options is
      type Id is
        (Help,
         Output_Ada_Dictionary,
         Output_Hash);
   end Options;

   package Getopt is new Natools.Getopt_Long (Options.Id);

   type Callback is new Getopt.Handlers.Callback with record
      Display_Help : Boolean := False;
      Need_Dictionary : Boolean := False;
      Ada_Dictionary : Ada.Strings.Unbounded.Unbounded_String;
      Hash_Package : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   overriding procedure Option
     (Handler  : in out Callback;
      Id       : in Options.Id;
      Argument : in String);

   overriding procedure Argument
     (Handler  : in out Callback;
      Argument : in String)
     is null;

   function Getopt_Config return Getopt.Configuration;
      --  Build the configuration object

   procedure Print_Dictionary
     (Filename : in String;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "");
   procedure Print_Dictionary
     (Output : in Ada.Text_IO.File_Type;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "");
      --  print the given dictionary in the given file

   procedure Print_Help
     (Opt : in Getopt.Configuration;
      Output : in Ada.Text_IO.File_Type);
      --  Print the help text to the given file

   overriding procedure Option
     (Handler  : in out Callback;
      Id       : in Options.Id;
      Argument : in String) is
   begin
      case Id is
         when Options.Help =>
            Handler.Display_Help := True;

         when Options.Output_Ada_Dictionary =>
            Handler.Need_Dictionary := True;

            if Argument'Length > 0 then
               Handler.Ada_Dictionary
                 := Ada.Strings.Unbounded.To_Unbounded_String (Argument);
            else
               Handler.Ada_Dictionary
                 := Ada.Strings.Unbounded.To_Unbounded_String ("-");
            end if;

         when Options.Output_Hash =>
            Handler.Need_Dictionary := True;
            Handler.Hash_Package
              := Ada.Strings.Unbounded.To_Unbounded_String (Argument);
      end case;
   end Option;

   function Getopt_Config return Getopt.Configuration is
      use Getopt;
      use Options;
      R : Getopt.Configuration;
   begin
      R.Add_Option ("ada-dict", 'A', Optional_Argument, Output_Ada_Dictionary);
      R.Add_Option ("hash-pkg", 'H', Required_Argument, Output_Hash);
      R.Add_Option ("help",     'h', No_Argument,       Help);

      return R;
   end Getopt_Config;

   procedure Print_Dictionary
     (Filename : in String;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "") is
   begin
      if Filename = "-" then
         Print_Dictionary
           (Ada.Text_IO.Current_Output, Dictionary, Hash_Package_Name);
      elsif Filename'Length > 0 then
         declare
            File : Ada.Text_IO.File_Type;
         begin
            Ada.Text_IO.Create (File, Name => Filename);
            Print_Dictionary (File, Dictionary, Hash_Package_Name);
            Ada.Text_IO.Close (File);
         end;
      end if;
   end Print_Dictionary;

   procedure Print_Dictionary
     (Output : in Ada.Text_IO.File_Type;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "")
   is
      procedure Put_Line (Line : in String);

      procedure Put_Line (Line : in String) is
      begin
         Ada.Text_IO.Put_Line (Output, Line);
      end Put_Line;

      procedure Print_Dictionary_In_Ada is
        new Natools.Smaz.Tools.Print_Dictionary_In_Ada (Put_Line);
   begin
      if Hash_Package_Name'Length > 0 then
         Print_Dictionary_In_Ada
           (Dictionary,
            Hash_Image => Hash_Package_Name & ".Hash'Access");
      else
         Print_Dictionary_In_Ada (Dictionary);
      end if;
   end Print_Dictionary;

   procedure Print_Help
     (Opt : in Getopt.Configuration;
      Output : in Ada.Text_IO.File_Type)
   is
      use Ada.Text_IO;
      Indent : constant String := "    ";
   begin
      Put_Line (Output, "Usage:");

      for Id in Options.Id loop
         Put (Output, Indent & Opt.Format_Names (Id));

         case Id is
            when Options.Help =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Display this help text");

            when Options.Output_Ada_Dictionary =>
               Put_Line (Output, "=[filename]");
               Put_Line (Output, Indent & Indent
                 & "Output the current dictionary as Ada code in the given");
               Put_Line (Output, Indent & Indent
                 & "file, or standard output if filename is ""-""");

            when Options.Output_Hash =>
               Put_Line (Output, " <Hash Package Name>");
               Put_Line (Output, Indent & Indent
                 & "Build a package with a perfect hash function for the");
               Put_Line (Output, Indent & Indent
                 & "current dictionary.");
         end case;
      end loop;
   end Print_Help;

   Opt_Config : constant Getopt.Configuration := Getopt_Config;
   Handler : Callback;
   Input_List : Natools.Smaz.Tools.String_Lists.List;
begin
   Process_Command_Line :
   begin
      Opt_Config.Process (Handler);
   exception
      when Getopt.Option_Error =>
         Print_Help (Opt_Config, Ada.Text_IO.Current_Error);
         Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
         return;
   end Process_Command_Line;

   if Handler.Display_Help then
      Print_Help (Opt_Config, Ada.Text_IO.Current_Output);
   end if;

   if not Handler.Need_Dictionary then
      return;
   end if;

   Read_Input_List :
   declare
      Input : constant access Ada.Streams.Root_Stream_Type'Class
        := Ada.Text_IO.Text_Streams.Stream (Ada.Text_IO.Current_Input);
      Parser : Natools.S_Expressions.Parsers.Stream_Parser (Input);
   begin
      Parser.Next;
      Natools.Smaz.Tools.Read_List (Input_List, Parser);
   end Read_Input_List;

   Build_Dictionary :
   declare
      Dictionary : constant Natools.Smaz.Dictionary
        := Natools.Smaz.Tools.To_Dictionary (Input_List, True);
      Ada_Dictionary : constant String
        := Ada.Strings.Unbounded.To_String (Handler.Ada_Dictionary);
      Hash_Package : constant String
        := Ada.Strings.Unbounded.To_String (Handler.Hash_Package);
   begin
      if Ada_Dictionary'Length > 0 then
         Print_Dictionary (Ada_Dictionary, Dictionary, Hash_Package);
      end if;

      if Hash_Package'Length > 0 then
         Natools.Smaz.Tools.GNAT.Build_Perfect_Hash (Input_List, Hash_Package);
      end if;
   end Build_Dictionary;
end Smaz;

tools/smaz: add support for hash function generation