------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                        A S I S . T E X T . S E T _ G E T                 --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--            Copyright (c) 1995-2006, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY or  FITNESS FOR A PARTICULAR  PURPOSE.  See the GNU General --
-- Public License for more details.  You should have received a copy of the --
-- GNU  General  Public  License  distributed with ASIS-for-GNAT;  see file --
-- COPYING.  If not,  write  to the  Free Software Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  AdaCore                   --
-- (http://www.adacore.com).                                                --
--                                                                          --
------------------------------------------------------------------------------

package Asis.Text.Set_Get is

   ---------
   -- Get --
   ---------

   function Line_Length (L : Line) return Character_Position;
   --  Returns line length. Note, that this is the length in the original
   --  source, counted in wide characters, but not the length in the internal
   --  representation counted in one-byte characters

   function Line_Location (L : Line) return Source_Ptr;
   --  when Line Location is obtained, the tree is resetted if needed

   function Valid (L : Line) return Boolean;
   --  chechs, if the argument is valid, that is, if the Context
   --  from which this line was obtained is still opened

   function Line_Wide_Image (L : Line) return Wide_String;
   --  Returns the line image as the line is represented in the original
   --  source text

   function Debug_Image (The_Span : Span) return String;
   --  Produces the debug output for its argument

   ---------
   -- Set --
   ---------

   procedure Set_Line_Length   (L : in out Line; N : Character_Position);
   procedure Set_Line_Location (L : in out Line; S : Source_Ptr);
   --  this procedure is intended to correct the Sloc field in
   --  the first line from a line list covering a given Span.
   --  This means, that all the fields of the Line to be corrected
   --  have been already set as pointing to the beginning of
   --  a given line. Together with setting the Sloc field, this
   --  procedure adjust the Rel_Sloc field.

   procedure Set_Lines (LList : in out Line_List; El : Element);
   --  This procedure creates LList as a list of lines
   --  accessable through El. It gets LList as a list
   --  of Nil_Lines and makes the proper settings for
   --  the components of each line, making them non-nil
   --  It takes all the characteristics of these lines from El,
   --  that is, from the tree on which El is based. This is
   --  "tree-swapping-safe" procedure.
   --  The only call to this procedure is in the third
   --  Asis.Text.Lines function, which explicitly specifies
   --  the bounds of the Line_List to be returned (that is, LList).
   --  The caller makes all the checks needed to make sure, that
   --  the compilation enclosing El really contains lines with numbers
   --  LList'First and LList'Last
end Asis.Text.Set_Get;

Add the ASIS file $i

Add the ASIS file $i


-----------------------------------------------------------------------
--  asf-security -- ASF Security
--  Copyright (C) 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.
-----------------------------------------------------------------------
package ASF.Security is

end ASF.Security;

Define an ASF Security package

Define an ASF Security package


-----------------------------------------------------------------------
--  babel-stores -- Storage management
--  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 Babel.Files;
with Babel.Files.Buffers;
with Babel.Filters;
package Babel.Stores is

   type Store_Type is limited interface;
   type Store_Type_Access is access all Store_Type'Class;

   procedure Read (Store : in out Store_Type;
                   Path  : in String;
                   Into  : in out Babel.Files.Buffers.Buffer) is abstract;

   procedure Write (Store : in out Store_Type;
                    Path  : in String;
                    Into  : in Babel.Files.Buffers.Buffer) is abstract;

   procedure Scan (Store  : in out Store_Type;
                   Path   : in String;
                   Into   : in out Babel.Files.File_Container'Class;
                   Filter : in Babel.Filters.Filter_Type'Class) is abstract;

end Babel.Stores;

Backup store to access files (local, remote, ...)


-----------------------------------------------------------------------
--  gen-artifacts-docs-googlecode -- Artifact for Googlecode documentation format
--  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.
-----------------------------------------------------------------------

package body Gen.Artifacts.Docs.Googlecode is

   --  ------------------------------
   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   --  ------------------------------
   overriding
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Document.Name) & ".wiki";
   end Get_Document_Name;

end Gen.Artifacts.Docs.Googlecode;

Implement the Get_Document_Name function for the Google Code wiki syntax


-----------------------------------------------------------------------
--  security-permissions -- Definition of permissions
--  Copyright (C) 2010, 2011 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.Unchecked_Deallocation;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;

with Util.Log.Loggers;
with Util.Serialize.Mappers.Record_Mapper;

with Security.Contexts;
with Security.Controllers;
with Security.Controllers.Roles;

--  The Security.Permissions package defines the different permissions that can be
--  checked by the access control manager.
package body Security.Policies.Roles is

   use Util.Log;

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("Security.Permissions");

   --  ------------------------------
   --  Get the role name.
   --  ------------------------------
   function Get_Role_Name (Manager : in Role_Policy;
                           Role    : in Role_Type) return String is
      use type Ada.Strings.Unbounded.String_Access;
   begin
      if Manager.Names (Role) = null then
         return "";
      else
         return Manager.Names (Role).all;
      end if;
   end Get_Role_Name;

   --  ------------------------------
   --  Find the role type associated with the role name identified by Name.
   --  Raises Invalid_Name if there is no role type.
   --  ------------------------------
   function Find_Role (Manager : in Role_Policy;
                       Name    : in String) return Role_Type is
      use type Ada.Strings.Unbounded.String_Access;
   begin
      Log.Debug ("Searching role {0}", Name);

      for I in Role_Type'First .. Manager.Next_Role loop
         exit when Manager.Names (I) = null;
         if Name = Manager.Names (I).all then
            return I;
         end if;
      end loop;

      Log.Debug ("Role {0} not found", Name);
      raise Invalid_Name;
   end Find_Role;

   --  ------------------------------
   --  Create a role
   --  ------------------------------
   procedure Create_Role (Manager : in out Role_Policy;
                          Name    : in String;
                          Role    : out Role_Type) is
   begin
      Role := Manager.Next_Role;
      Log.Info ("Role {0} is {1}", Name, Role_Type'Image (Role));

      if Manager.Next_Role = Role_Type'Last then
         Log.Error ("Too many roles allocated.  Number of roles is {0}",
                    Role_Type'Image (Role_Type'Last));
      else
         Manager.Next_Role := Manager.Next_Role + 1;
      end if;
      Manager.Names (Role) := new String '(Name);
   end Create_Role;

   --  ------------------------------
   --  Get or build a permission type for the given name.
   --  ------------------------------
   procedure Add_Role_Type (Manager   : in out Role_Policy;
                            Name      : in String;
                            Result    : out Role_Type) is
   begin
      Result := Manager.Find_Role (Name);

   exception
      when Invalid_Name =>
         Manager.Create_Role (Name, Result);
   end Add_Role_Type;

end Security.Policies.Roles;

Move the role based operation from Security.Permissions to the role based polcies


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

package body ADO.Utils.Streams is

   use type Ada.Streams.Stream_Element_Offset;
   subtype Offset is Ada.Streams.Stream_Element_Offset;

   --  ------------------------------
   --  Initialize the blob stream to read the content of the blob.
   --  ------------------------------
   procedure Initialize (Stream : in out Blob_Stream;
                         Blob   : in ADO.Blob_Ref) is
   begin
      Stream.Data := Blob;
      Stream.Pos  := 1;
   end Initialize;

   --  ------------------------------
   --  Read into the buffer as many bytes as possible and return in
   --  <b>last</b> the position of the last byte read.
   --  ------------------------------
   overriding
   procedure Read (Stream : in out Blob_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is
      Blob  : constant Blob_Access := Stream.Data.Value;
      Avail : Offset;
   begin
      if Blob = null then
         Last := Into'First - 1;
      else
         Avail := Blob.Data'Last - Stream.Pos + 1;
         if Avail > Into'Length then
            Avail := Into'Length;
         end if;
         Last := Into'First + Avail - 1;
         if Avail > 0 then
            Into (Into'First .. Last) := Blob.Data (Stream.Pos .. Stream.Pos + Avail - 1);
            Stream.Pos := Stream.Pos + Avail;
         end if;
      end if;
   end Read;

   function Get_Blob (Stream : in Blob_Output_Stream) return Blob_Ref is
      Size   : constant Offset := Offset (Stream.Get_Size);
      Buffer : constant Util.Streams.Buffered.Buffer_Access := Stream.Get_Buffer;
   begin
      return Create_Blob (Data => Buffer (Buffer'First .. Buffer'First + Size - 1));
   end Get_Blob;

end ADO.Utils.Streams;

Implement operations for blob streams

Implement operations for blob streams


-----------------------------------------------------------------------
--  security-openid -- OpenID 2.0 Support
--  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 Util.Log.Loggers;

with Security.Auth.OpenID;
with Security.Auth.OAuth.Facebook;
package body Security.Auth is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Security.Auth");

   --  ------------------------------
   --  Get the provider.
   --  ------------------------------
   function Get_Provider (Assoc : in Association) return String is
   begin
      return To_String (Assoc.Provider);
   end Get_Provider;

   --  ------------------------------
   --  Get the email address
   --  ------------------------------
   function Get_Email (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Email);
   end Get_Email;

   --  ------------------------------
   --  Get the user first name.
   --  ------------------------------
   function Get_First_Name (Auth : in Authentication) return String is
   begin
      return To_String (Auth.First_Name);
   end Get_First_Name;

   --  ------------------------------
   --  Get the user last name.
   --  ------------------------------
   function Get_Last_Name (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Last_Name);
   end Get_Last_Name;

   --  ------------------------------
   --  Get the user full name.
   --  ------------------------------
   function Get_Full_Name (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Full_Name);
   end Get_Full_Name;

   --  ------------------------------
   --  Get the user identity.
   --  ------------------------------
   function Get_Identity (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Identity);
   end Get_Identity;

   --  ------------------------------
   --  Get the user claimed identity.
   --  ------------------------------
   function Get_Claimed_Id (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Claimed_Id);
   end Get_Claimed_Id;

   --  ------------------------------
   --  Get the user language.
   --  ------------------------------
   function Get_Language (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Language);
   end Get_Language;

   --  ------------------------------
   --  Get the user country.
   --  ------------------------------
   function Get_Country (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Country);
   end Get_Country;

   --  ------------------------------
   --  Get the result of the authentication.
   --  ------------------------------
   function Get_Status (Auth : in Authentication) return Auth_Result is
   begin
      return Auth.Status;
   end Get_Status;

   --  ------------------------------
   --  Default principal
   --  ------------------------------

   --  ------------------------------
   --  Get the principal name.
   --  ------------------------------
   function Get_Name (From : in Principal) return String is
   begin
      return Get_First_Name (From.Auth) & " " & Get_Last_Name (From.Auth);
   end Get_Name;

   --  ------------------------------
   --  Get the user email address.
   --  ------------------------------
   function Get_Email (From : in Principal) return String is
   begin
      return Get_Email (From.Auth);
   end Get_Email;

   --  ------------------------------
   --  Get the authentication data.
   --  ------------------------------
   function Get_Authentication (From : in Principal) return Authentication is
   begin
      return From.Auth;
   end Get_Authentication;

   --  ------------------------------
   --  Create a principal with the given authentication results.
   --  ------------------------------
   function Create_Principal (Auth : in Authentication) return Principal_Access is
      P : constant Principal_Access := new Principal;
   begin
      P.Auth := Auth;
      return P;
   end Create_Principal;

   --  ------------------------------
   --  Initialize the OpenID realm.
   --  ------------------------------
   procedure Initialize (Realm     : in out Manager;
                         Params    : in Parameters'Class;
                         Provider  : in String := PROVIDER_OPENID) is
      Impl : Manager_Access;
   begin
      if Provider = PROVIDER_OPENID then
         Impl := new Security.Auth.OpenID.Manager;

      elsif Provider = PROVIDER_FACEBOOK then
         Impl := new Security.Auth.OAuth.Facebook.Manager;

      else
         Log.Error ("Authentication provider {0} not recognized", Provider);
         raise Service_Error with "Authentication provider not supported";
      end if;
      Impl.Initialize (Params, Provider);
      Realm.Delegate := Impl;
      Realm.Provider := To_Unbounded_String (Provider);
   end Initialize;

   --  ------------------------------
   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The <b>Name</b> can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  (See OpenID Section 7.3 Discovery)
   --  ------------------------------
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point) is
   begin
      if Realm.Delegate /= null then
         Realm.Delegate.Discover (Name, Result);
      else
--           Result.URL := Realm.Realm;
         Result.Alias := To_Unbounded_String ("");
      end if;
   end Discover;

   --  ------------------------------
   --  Associate the application (relying party) with the OpenID provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   --  ------------------------------
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association) is
   begin
      Result.Provider := Realm.Provider;
      if Realm.Delegate /= null then
         Realm.Delegate.Associate (OP, Result);
      end if;
   end Associate;

   --  ------------------------------
   --  Get the authentication URL to which the user must be redirected for authentication
   --  by the authentication server.
   --  ------------------------------
   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String is
   begin
      if Realm.Delegate /= null then
         return Realm.Delegate.Get_Authentication_URL (OP, Assoc);
      else
         return To_String (OP.URL);
      end if;
   end Get_Authentication_URL;

   procedure Set_Result (Result  : in out Authentication;
                         Status  : in Auth_Result;
                         Message : in String) is
   begin
      if Status /= AUTHENTICATED then
         Log.Error ("OpenID verification failed: {0}", Message);
      else
         Log.Info ("OpenID verification: {0}", Message);
      end if;
      Result.Status := Status;
   end Set_Result;

   --  ------------------------------
   --  Verify the authentication result
   --  ------------------------------
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication) is
   begin
      if Realm.Delegate /= null then
         Realm.Delegate.Verify (Assoc, Request, Result);
      else
         Set_Result (Result, SETUP_NEEDED, "Setup is needed");
      end if;
   end Verify;

   function To_String (OP : End_Point) return String is
   begin
      return "openid://" & To_String (OP.URL);
   end To_String;

   function To_String (Assoc : Association) return String is
   begin
      return "session_type=" & To_String (Assoc.Session_Type)
        & "&assoc_type=" & To_String (Assoc.Assoc_Type)
        & "&assoc_handle=" & To_String (Assoc.Assoc_Handle)
        & "&mac_key=" & To_String (Assoc.Mac_Key);
   end To_String;

end Security.Auth;

Implement the new authentication framework based on the OpenID implementation


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

   --  use Util.Log;
   use type Util.Log.Loggers.Logger_Access;

   --  The logger
   Log : aliased constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Serialize.IO",
                                                            Util.Log.WARN_LEVEL);

   --  ------------------------------
   --  Read the file and parse it using the JSON parser.
   --  ------------------------------
   procedure Parse (Handler : in out Parser;
                    File    : in String) is
      Stream     : aliased Util.Streams.Files.File_Stream;
      Buffer     : Util.Streams.Buffered.Buffered_Stream;
   begin
      if Handler.Error_Logger = null then
         Handler.Error_Logger := Log'Access;
      end if;
      Buffer.Initialize (Output => null,
                         Input  => Stream'Unchecked_Access,
                         Size   => 1024);
      Stream.Open (Mode => Ada.Streams.Stream_IO.In_File, Name => File);
      Context_Stack.Clear (Handler.Stack);
      Parser'Class (Handler).Parse (Buffer);

   exception
      when Util.Serialize.Mappers.Field_Fatal_Error =>
         null;

      when E : others =>
         Parser'Class (Handler).Error ("Exception " & Ada.Exceptions.Exception_Name (E));
   end Parse;

   --  ------------------------------
   --  Parse the content string.
   --  ------------------------------
   procedure Parse_String (Handler : in out Parser;
                           Content : in String) is
      Stream : aliased Util.Streams.Buffered.Buffered_Stream;
   begin
      if Handler.Error_Logger = null then
         Handler.Error_Logger := Log'Access;
      end if;
      Stream.Initialize (Content  => Content);
      Context_Stack.Clear (Handler.Stack);
      Parser'Class (Handler).Parse (Stream);

   exception
      when Util.Serialize.Mappers.Field_Fatal_Error =>
         null;

      when E : others =>
         Handler.Error_Logger.Error ("Exception " & Ada.Exceptions.Exception_Name (E), E);
   end Parse_String;

   --  ------------------------------
   --  Returns true if the Parse operation detected at least one error.
   --  ------------------------------
   function Has_Error (Handler : in Parser) return Boolean is
   begin
      return Handler.Error_Flag;
   end Has_Error;

   --  ------------------------------
   --  Set the error logger to report messages while parsing and reading the input file.
   --  ------------------------------
   procedure Set_Logger (Handler : in out Parser;
                         Logger  : in Util.Log.Loggers.Logger_Access) is
   begin
      Handler.Error_Logger := Logger;
   end Set_Logger;

   --  ------------------------------
   --  Push the current context when entering in an element.
   --  ------------------------------
   procedure Push (Handler : in out Parser) is
      use type Util.Serialize.Mappers.Mapper_Access;
   begin
      Context_Stack.Push (Handler.Stack);
   end Push;

   --  ------------------------------
   --  Pop the context and restore the previous context when leaving an element
   --  ------------------------------
   procedure Pop (Handler  : in out Parser) is
   begin
      Context_Stack.Pop (Handler.Stack);
   end Pop;

   function Find_Mapper (Handler : in Parser;
                         Name    : in String) return Util.Serialize.Mappers.Mapper_Access is
      pragma Unreferenced (Handler, Name);
   begin
      return null;
   end Find_Mapper;

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

      use type Util.Serialize.Mappers.Mapper_Access;

      Current : constant Element_Context_Access := Context_Stack.Current (Handler.Stack);
      Next    : Element_Context_Access;
      Pos     : Positive;
   begin
      Context_Stack.Push (Handler.Stack);
      Next := Context_Stack.Current (Handler.Stack);
      if Current /= null then
         Pos := 1;

         --  Notify we are entering in the given node for each active mapping.
         for I in Current.Active_Nodes'Range loop
            declare
               Node  : constant Mappers.Mapper_Access := Current.Active_Nodes (I);
               Child : Mappers.Mapper_Access;
            begin
               exit when Node = null;
               Child := Node.Find_Mapper (Name => Name);
               if Child /= null then
                  Child.Start_Object (Handler, Name);
                  Next.Active_Nodes (Pos) := Child;
                  Pos := Pos + 1;
               end if;
            end;
         end loop;
         while Pos <= Next.Active_Nodes'Last loop
            Next.Active_Nodes (Pos) := null;
            Pos := Pos + 1;
         end loop;
      else
         Next.Active_Nodes (1) := Handler.Mapping_Tree.Find_Mapper (Name);
      end if;
   end Start_Object;

   --  ------------------------------
   --  Finish an object associated with the given name.  The reader must be
   --  updated to be associated with the previous object.
   --  ------------------------------
   procedure Finish_Object (Handler : in out Parser;
                            Name    : in String) is

      use type Util.Serialize.Mappers.Mapper_Access;
   begin

      declare
         Current : constant Element_Context_Access := Context_Stack.Current (Handler.Stack);
      begin
         if Current /= null then
            --  Notify we are leaving the given node for each active mapping.
            for I in Current.Active_Nodes'Range loop
               declare
                  Node : constant Mappers.Mapper_Access := Current.Active_Nodes (I);
               begin
                  exit when Node = null;
                  Node.Finish_Object (Handler, Name);
               end;
            end loop;
         end if;
      end;
      Handler.Pop;
   end Finish_Object;

   procedure Start_Array (Handler : in out Parser;
                          Name    : in String) is
      pragma Unreferenced (Name);
   begin
      Handler.Push;
   end Start_Array;

   procedure Finish_Array (Handler : in out Parser;
                           Name    : in String) is
      pragma Unreferenced (Name);
   begin
      Handler.Pop;
   end Finish_Array;

   --  -----------------------
   --  Set the name/value pair on the current object.  For each active mapping,
   --  find whether a rule matches our name and execute it.
   --  -----------------------
   procedure Set_Member (Handler   : in out Parser;
                         Name      : in String;
                         Value     : in Util.Beans.Objects.Object;
                         Attribute : in Boolean := False) is
      use Util.Serialize.Mappers;

      Current : constant Element_Context_Access := Context_Stack.Current (Handler.Stack);
   begin
      if Current /= null then

         --  Look each active mapping node.
         for I in Current.Active_Nodes'Range loop
            declare
               Node : constant Mapper_Access := Current.Active_Nodes (I);
            begin
               exit when Node = null;
               Node.Set_Member (Name      => Name,
                                Value     => Value,
                                Attribute => Attribute,
                                Context   => Handler);

            exception
               when E : Util.Serialize.Mappers.Field_Error =>
                  Handler.Error (Message => Ada.Exceptions.Exception_Message (E));

               when E : Util.Serialize.Mappers.Field_Fatal_Error =>
                  Handler.Error (Message => Ada.Exceptions.Exception_Message (E));
                  raise;

                  --  For other exception, report an error with the field name and value.
               when E : others =>
                  Handler.Error (Message => "Cannot set field '" & Name & "' to '"
                                 & Util.Beans.Objects.To_String (Value) & "': "
                                 & Ada.Exceptions.Exception_Message (E));
                  raise;
            end;
         end loop;
      end if;
   end Set_Member;

   --  ------------------------------
   --  Get the current location (file and line) to report an error message.
   --  ------------------------------
   function Get_Location (Handler : in Parser) return String is
      pragma Unreferenced (Handler);
   begin
      return "";
   end Get_Location;

   --  ------------------------------
   --  Report an error while parsing the input stream.  The error message will be reported
   --  on the logger associated with the parser.  The parser will be set as in error so that
   --  the Has_Error function will return True after parsing the whole file.
   --  ------------------------------
   procedure Error (Handler : in out Parser;
                    Message : in String) is
   begin
      Handler.Error_Logger.Error ("{0}: {1}",
                                  Parser'Class (Handler).Get_Location,
                                  Message);
      Handler.Error_Flag := True;
   end Error;

   procedure Add_Mapping (Handler : in out Parser;
                          Path    : in String;
                          Mapper  : in Util.Serialize.Mappers.Mapper_Access) is
   begin
      Handler.Mapping_Tree.Add_Mapping (Path, Mapper);
   end Add_Mapping;

   --  ------------------------------
   --  Dump the mapping tree on the logger using the INFO log level.
   --  ------------------------------
   procedure Dump (Handler : in Parser'Class;
                   Logger  : in Util.Log.Loggers.Logger'Class) is
   begin
      Util.Serialize.Mappers.Dump (Handler.Mapping_Tree, Logger, "Mapping ");
   end Dump;

end Util.Serialize.IO;

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

   --  use Util.Log;
   use type Util.Log.Loggers.Logger_Access;

   --  The logger
   Log : aliased constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Serialize.IO",
                                                            Util.Log.WARN_LEVEL);

   --  ------------------------------
   --  Read the file and parse it using the JSON parser.
   --  ------------------------------
   procedure Parse (Handler : in out Parser;
                    File    : in String) is
      Stream     : aliased Util.Streams.Files.File_Stream;
      Buffer     : Util.Streams.Buffered.Buffered_Stream;
   begin
      if Handler.Error_Logger = null then
         Handler.Error_Logger := Log'Access;
      end if;
      Handler.Error_Logger.Info ("Reading file {0}", File);

      Buffer.Initialize (Output => null,
                         Input  => Stream'Unchecked_Access,
                         Size   => 1024);
      Stream.Open (Mode => Ada.Streams.Stream_IO.In_File, Name => File);
      Context_Stack.Clear (Handler.Stack);
      Parser'Class (Handler).Parse (Buffer);

   exception
      when Util.Serialize.Mappers.Field_Fatal_Error =>
         null;

      when E : others =>
         Parser'Class (Handler).Error ("Exception " & Ada.Exceptions.Exception_Name (E));
   end Parse;

   --  ------------------------------
   --  Parse the content string.
   --  ------------------------------
   procedure Parse_String (Handler : in out Parser;
                           Content : in String) is
      Stream : aliased Util.Streams.Buffered.Buffered_Stream;
   begin
      if Handler.Error_Logger = null then
         Handler.Error_Logger := Log'Access;
      end if;
      Stream.Initialize (Content  => Content);
      Context_Stack.Clear (Handler.Stack);
      Parser'Class (Handler).Parse (Stream);

   exception
      when Util.Serialize.Mappers.Field_Fatal_Error =>
         null;

      when E : others =>
         Handler.Error_Logger.Error ("Exception " & Ada.Exceptions.Exception_Name (E), E);
   end Parse_String;

   --  ------------------------------
   --  Returns true if the Parse operation detected at least one error.
   --  ------------------------------
   function Has_Error (Handler : in Parser) return Boolean is
   begin
      return Handler.Error_Flag;
   end Has_Error;

   --  ------------------------------
   --  Set the error logger to report messages while parsing and reading the input file.
   --  ------------------------------
   procedure Set_Logger (Handler : in out Parser;
                         Logger  : in Util.Log.Loggers.Logger_Access) is
   begin
      Handler.Error_Logger := Logger;
   end Set_Logger;

   --  ------------------------------
   --  Push the current context when entering in an element.
   --  ------------------------------
   procedure Push (Handler : in out Parser) is
      use type Util.Serialize.Mappers.Mapper_Access;
   begin
      Context_Stack.Push (Handler.Stack);
   end Push;

   --  ------------------------------
   --  Pop the context and restore the previous context when leaving an element
   --  ------------------------------
   procedure Pop (Handler  : in out Parser) is
   begin
      Context_Stack.Pop (Handler.Stack);
   end Pop;

   function Find_Mapper (Handler : in Parser;
                         Name    : in String) return Util.Serialize.Mappers.Mapper_Access is
      pragma Unreferenced (Handler, Name);
   begin
      return null;
   end Find_Mapper;

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

      use type Util.Serialize.Mappers.Mapper_Access;

      Current : constant Element_Context_Access := Context_Stack.Current (Handler.Stack);
      Next    : Element_Context_Access;
      Pos     : Positive;
   begin
      Context_Stack.Push (Handler.Stack);
      Next := Context_Stack.Current (Handler.Stack);
      if Current /= null then
         Pos := 1;

         --  Notify we are entering in the given node for each active mapping.
         for I in Current.Active_Nodes'Range loop
            declare
               Node  : constant Mappers.Mapper_Access := Current.Active_Nodes (I);
               Child : Mappers.Mapper_Access;
            begin
               exit when Node = null;
               Child := Node.Find_Mapper (Name => Name);
               if Child /= null then
                  Child.Start_Object (Handler, Name);
                  Next.Active_Nodes (Pos) := Child;
                  Pos := Pos + 1;
               end if;
            end;
         end loop;
         while Pos <= Next.Active_Nodes'Last loop
            Next.Active_Nodes (Pos) := null;
            Pos := Pos + 1;
         end loop;
      else
         Next.Active_Nodes (1) := Handler.Mapping_Tree.Find_Mapper (Name);
      end if;
   end Start_Object;

   --  ------------------------------
   --  Finish an object associated with the given name.  The reader must be
   --  updated to be associated with the previous object.
   --  ------------------------------
   procedure Finish_Object (Handler : in out Parser;
                            Name    : in String) is

      use type Util.Serialize.Mappers.Mapper_Access;
   begin

      declare
         Current : constant Element_Context_Access := Context_Stack.Current (Handler.Stack);
      begin
         if Current /= null then
            --  Notify we are leaving the given node for each active mapping.
            for I in Current.Active_Nodes'Range loop
               declare
                  Node : constant Mappers.Mapper_Access := Current.Active_Nodes (I);
               begin
                  exit when Node = null;
                  Node.Finish_Object (Handler, Name);
               end;
            end loop;
         end if;
      end;
      Handler.Pop;
   end Finish_Object;

   procedure Start_Array (Handler : in out Parser;
                          Name    : in String) is
      pragma Unreferenced (Name);
   begin
      Handler.Push;
   end Start_Array;

   procedure Finish_Array (Handler : in out Parser;
                           Name    : in String) is
      pragma Unreferenced (Name);
   begin
      Handler.Pop;
   end Finish_Array;

   --  -----------------------
   --  Set the name/value pair on the current object.  For each active mapping,
   --  find whether a rule matches our name and execute it.
   --  -----------------------
   procedure Set_Member (Handler   : in out Parser;
                         Name      : in String;
                         Value     : in Util.Beans.Objects.Object;
                         Attribute : in Boolean := False) is
      use Util.Serialize.Mappers;

      Current : constant Element_Context_Access := Context_Stack.Current (Handler.Stack);
   begin
      if Current /= null then

         --  Look each active mapping node.
         for I in Current.Active_Nodes'Range loop
            declare
               Node : constant Mapper_Access := Current.Active_Nodes (I);
            begin
               exit when Node = null;
               Node.Set_Member (Name      => Name,
                                Value     => Value,
                                Attribute => Attribute,
                                Context   => Handler);

            exception
               when E : Util.Serialize.Mappers.Field_Error =>
                  Handler.Error (Message => Ada.Exceptions.Exception_Message (E));

               when E : Util.Serialize.Mappers.Field_Fatal_Error =>
                  Handler.Error (Message => Ada.Exceptions.Exception_Message (E));
                  raise;

                  --  For other exception, report an error with the field name and value.
               when E : others =>
                  Handler.Error (Message => "Cannot set field '" & Name & "' to '"
                                 & Util.Beans.Objects.To_String (Value) & "': "
                                 & Ada.Exceptions.Exception_Message (E));
                  raise;
            end;
         end loop;
      end if;
   end Set_Member;

   --  ------------------------------
   --  Get the current location (file and line) to report an error message.
   --  ------------------------------
   function Get_Location (Handler : in Parser) return String is
      pragma Unreferenced (Handler);
   begin
      return "";
   end Get_Location;

   --  ------------------------------
   --  Report an error while parsing the input stream.  The error message will be reported
   --  on the logger associated with the parser.  The parser will be set as in error so that
   --  the Has_Error function will return True after parsing the whole file.
   --  ------------------------------
   procedure Error (Handler : in out Parser;
                    Message : in String) is
   begin
      Handler.Error_Logger.Error ("{0}: {1}",
                                  Parser'Class (Handler).Get_Location,
                                  Message);
      Handler.Error_Flag := True;
   end Error;

   procedure Add_Mapping (Handler : in out Parser;
                          Path    : in String;
                          Mapper  : in Util.Serialize.Mappers.Mapper_Access) is
   begin
      Handler.Mapping_Tree.Add_Mapping (Path, Mapper);
   end Add_Mapping;

   --  ------------------------------
   --  Dump the mapping tree on the logger using the INFO log level.
   --  ------------------------------
   procedure Dump (Handler : in Parser'Class;
                   Logger  : in Util.Log.Loggers.Logger'Class) is
   begin
      Util.Serialize.Mappers.Dump (Handler.Mapping_Tree, Logger, "Mapping ");
   end Dump;

end Util.Serialize.IO;

Add an info log when reading a file

Add an info log when reading a file


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

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

   type Test_Context_Type is record
      Number  : Integer;
      Success : Boolean := False;
   end record;

   package Test_Command is new
     Util.Commands.Drivers (Context_Type => Test_Context_Type,
                            Config_Parser => Util.Commands.Parsers.GNAT_Parser.Config_Parser,
                            Driver_Name  => "test");

   type Test_Command_Type is new Test_Command.Command_Type with record
      Opt_Count : aliased Integer := 0;
      Opt_V     : aliased Boolean := False;
      Opt_N     : aliased Boolean := False;
      Expect_V  : Boolean := False;
      Expect_N  : Boolean := False;
      Expect_C  : Integer := 0;
      Expect_A  : Integer := 0;
      Expect_Help : Boolean := False;
   end record;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type);

   --  Setup the command before parsing the arguments and executing it.
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Test_Context_Type);

   --  Write the help associated with the command.
   procedure Help (Command   : in out Test_Command_Type;
                   Context   : in out Test_Context_Type);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Execute",
                       Test_Execute'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Help",
                       Test_Help'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Usage",
                       Test_Usage'Access);
   end Add_Tests;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type) is
      pragma Unreferenced (Name);
   begin
      Context.Success := Command.Opt_Count = Command.Expect_C and
        Command.Opt_V = Command.Expect_V and
        Command.Opt_N = Command.Expect_N and
        Args.Get_Count = Command.Expect_A and
        not Command.Expect_Help;
   end Execute;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Test_Context_Type) is
      pragma Unreferenced (Context);
   begin
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-c:",
                                       Long_Switch => "--count=",
                                       Help        => "Number option",
                                       Section     => "",
                                       Initial     => Integer (0),
                                       Default     => Integer (10),
                                       Output      => Command.Opt_Count'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-v",
                                       Long_Switch => "--verbose",
                                       Help        => "Verbose option",
                                       Section     => "",
                                       Output      => Command.Opt_V'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-n",
                                       Long_Switch => "--not",
                                       Help        => "Not option",
                                       Section     => "",
                                       Output      => Command.Opt_N'Access);
   end Setup;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Command   : in out Test_Command_Type;
                   Context   : in out Test_Context_Type) is

   begin
      Context.Success := Command.Expect_Help;
   end Help;

   --  ------------------------------
   --  Tests when the execution of commands.
   --  ------------------------------
   procedure Test_Execute (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := True;
         C1.Expect_N := True;
         C1.Expect_C := 4;
         C1.Expect_A := 2;
         Initialize (Args, "list --count=4 -v -n test titi");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := False;
         C1.Expect_N := True;
         C1.Expect_C := 8;
         C1.Expect_A := 3;
         Initialize (Args, "list -c 8 -n test titi last");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

   end Test_Execute;

   --  ------------------------------
   --  Test execution of help.
   --  ------------------------------
   procedure Test_Help (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C2.Expect_Help := True;
         Initialize (Args, "help print");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;
   end Test_Help;

   --  ------------------------------
   --  Test usage operation.
   --  ------------------------------
   procedure Test_Usage (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      Args.Initialize (Line => "cmd list");
      declare
         Ctx   : Test_Context_Type;
      begin
         D.Usage (Args, Ctx);
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;
   end Test_Usage;

end Util.Commands.Tests;

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

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

   type Test_Context_Type is record
      Number  : Integer;
      Success : Boolean := False;
   end record;

   package Test_Command is new
     Util.Commands.Drivers (Context_Type => Test_Context_Type,
                            Config_Parser => Util.Commands.Parsers.GNAT_Parser.Config_Parser,
                            Driver_Name  => "test");

   type Test_Command_Type is new Test_Command.Command_Type with record
      Opt_Count : aliased Integer := 0;
      Opt_V     : aliased Boolean := False;
      Opt_N     : aliased Boolean := False;
      Expect_V  : Boolean := False;
      Expect_N  : Boolean := False;
      Expect_C  : Integer := 0;
      Expect_A  : Integer := 0;
      Expect_Help : Boolean := False;
   end record;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type);

   --  Setup the command before parsing the arguments and executing it.
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Test_Context_Type);

   --  Write the help associated with the command.
   procedure Help (Command   : in out Test_Command_Type;
                   Name      : in String;
                   Context   : in out Test_Context_Type);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Execute",
                       Test_Execute'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Help",
                       Test_Help'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Usage",
                       Test_Usage'Access);
   end Add_Tests;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type) is
      pragma Unreferenced (Name);
   begin
      Context.Success := Command.Opt_Count = Command.Expect_C and
        Command.Opt_V = Command.Expect_V and
        Command.Opt_N = Command.Expect_N and
        Args.Get_Count = Command.Expect_A and
        not Command.Expect_Help;
   end Execute;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Test_Context_Type) is
      pragma Unreferenced (Context);
   begin
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-c:",
                                       Long_Switch => "--count=",
                                       Help        => "Number option",
                                       Section     => "",
                                       Initial     => Integer (0),
                                       Default     => Integer (10),
                                       Output      => Command.Opt_Count'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-v",
                                       Long_Switch => "--verbose",
                                       Help        => "Verbose option",
                                       Section     => "",
                                       Output      => Command.Opt_V'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-n",
                                       Long_Switch => "--not",
                                       Help        => "Not option",
                                       Section     => "",
                                       Output      => Command.Opt_N'Access);
   end Setup;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Command   : in out Test_Command_Type;
                   Name      : in String;
                   Context   : in out Test_Context_Type) is
      pragma Unreferenced (Name);
   begin
      Context.Success := Command.Expect_Help;
   end Help;

   --  ------------------------------
   --  Tests when the execution of commands.
   --  ------------------------------
   procedure Test_Execute (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := True;
         C1.Expect_N := True;
         C1.Expect_C := 4;
         C1.Expect_A := 2;
         Initialize (Args, "list --count=4 -v -n test titi");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := False;
         C1.Expect_N := True;
         C1.Expect_C := 8;
         C1.Expect_A := 3;
         Initialize (Args, "list -c 8 -n test titi last");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

   end Test_Execute;

   --  ------------------------------
   --  Test execution of help.
   --  ------------------------------
   procedure Test_Help (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C2.Expect_Help := True;
         Initialize (Args, "help print");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;
   end Test_Help;

   --  ------------------------------
   --  Test usage operation.
   --  ------------------------------
   procedure Test_Usage (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      Args.Initialize (Line => "cmd list");
      declare
         Ctx   : Test_Context_Type;
      begin
         D.Usage (Args, Ctx);
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;
   end Test_Usage;

end Util.Commands.Tests;

Add Name parameter to the Help procedure


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

with Util.Test_Caller;
with Util.Log.Loggers;
with Util.Streams.Files;
with Util.Beans.Objects.Readers;

package body Util.Serialize.IO.Form.Tests is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Util.Serialize.IO.Form");

   package Caller is new Util.Test_Caller (Test, "Serialize.IO.Form");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.Form.Parse (parse errors)",
                       Test_Parse_Error'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.Form.Parse (parse Ok)",
                       Test_Parser'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.Form.Write",
                       Test_Output'Access);
      Caller.Add_Test (Suite, "Test Util.Serialize.IO.Form.Read",
                       Test_Read'Access);
   end Add_Tests;

   --  ------------------------------
   --  Check various form parsing errors.
   --  ------------------------------
   procedure Test_Parse_Error (T : in out Test) is

      procedure Check_Parse_Error (Content : in String);

      procedure Check_Parse_Error (Content : in String) is
         P : Parser;
         R : Util.Beans.Objects.Readers.Reader;
      begin
         P.Parse_String (Content, R);
         Log.Error ("No exception raised for: {0}", Content);
         --  T.Fail ("No exception for " & Content);

      exception
         when Parse_Error =>
            null;
      end Check_Parse_Error;

   begin
      Check_Parse_Error ("bad");
      Check_Parse_Error ("bad=%rw%ad");
   end Test_Parse_Error;

   --  ------------------------------
   --  Check various (basic) JSformON valid strings (no mapper).
   --  ------------------------------
   procedure Test_Parser (T : in out Test) is

      procedure Check_Parse (Content : in String);

      procedure Check_Parse (Content : in String) is
         P : Parser;
         R : Util.Beans.Objects.Readers.Reader;
      begin
         P.Parse_String (Content, R);

      exception
         when Parse_Error =>
            Log.Error ("Parse error for: " & Content);
            T.Fail ("Parse error for: " & Content);
      end Check_Parse;

   begin
      Check_Parse ("name=value");
      Check_Parse ("name=value&param=value");
      Check_Parse ("name+name=value+value");
      Check_Parse ("name%20%30=value%23%ce");
   end Test_Parser;

   --  ------------------------------
   --  Generate some output stream for the test.
   --  ------------------------------
   procedure Write_Stream (Stream : in out Util.Serialize.IO.Output_Stream'Class) is
      Name : Ada.Strings.Unbounded.Unbounded_String;
      Wide : constant Wide_Wide_String :=
        Ada.Characters.Wide_Wide_Latin_1.CR &
        Ada.Characters.Wide_Wide_Latin_1.LF &
        Ada.Characters.Wide_Wide_Latin_1.HT &
        Wide_Wide_Character'Val (16#080#) &
        Wide_Wide_Character'Val (16#1fC#) &
        Wide_Wide_Character'Val (16#20AC#) & -- Euro sign
        Wide_Wide_Character'Val (16#2acbf#);
      T : constant Ada.Calendar.Time := Ada.Calendar.Formatting.Time_Of (2011, 11, 19, 23, 0, 0);
   begin
      Ada.Strings.Unbounded.Append (Name, "Katniss Everdeen");
      Stream.Start_Document;
      Stream.Start_Entity ("root");
      Stream.Start_Entity ("person");
      Stream.Write_Attribute ("id", 1);
      Stream.Write_Attribute ("name", Name);
      Stream.Write_Entity ("name", Name);
      Stream.Write_Entity ("gender", "female");
      Stream.Write_Entity ("volunteer", True);
      Stream.Write_Entity ("age", 17);
      Stream.Write_Entity ("date", T);
      Stream.Write_Wide_Entity ("skin", "olive skin");
      Stream.Start_Array ("badges");

      Stream.Start_Entity ("badge");
      Stream.Write_Entity ("level", "gold");
      Stream.Write_Entity ("name", "hunter");
      Stream.End_Entity ("badge");

      Stream.Start_Entity ("badge");
      Stream.Write_Entity ("level", "gold");
      Stream.Write_Entity ("name", "archery");
      Stream.End_Entity ("badge");
      Stream.End_Array ("badges");

      Stream.Start_Entity ("district");
      Stream.Write_Attribute ("id", 12);
      Stream.Write_Wide_Attribute ("industry", "Coal mining");
      Stream.Write_Attribute ("state", "<destroyed>");
      Stream.Write_Long_Entity ("members", 10_000);
      Stream.Write_Entity ("description", "<TBW>&""");
      Stream.Write_Wide_Entity ("wescape", "'""<>&;,@!`~[]{}^%*()-+=");
      Stream.Write_Entity ("escape", "'""<>&;,@!`~\[]{}^%*()-+=");
      Stream.Write_Wide_Entity ("wide", Wide);
      Stream.End_Entity ("district");

      Stream.End_Entity ("person");
      Stream.End_Entity ("root");
      Stream.End_Document;
   end Write_Stream;

   --  ------------------------------
   --  Test the JSON output stream generation.
   --  ------------------------------
   procedure Test_Output (T : in out Test) is
      File   : aliased Util.Streams.Files.File_Stream;
      Buffer : aliased Util.Streams.Texts.Print_Stream;
      Stream : Util.Serialize.IO.Form.Output_Stream;
      Expect : constant String := Util.Tests.Get_Path ("regtests/expect/test-stream.form");
      Path   : constant String := Util.Tests.Get_Test_Path ("regtests/result/test-stream.form");
   begin
      File.Create (Mode => Ada.Streams.Stream_IO.Out_File, Name => Path);
      Buffer.Initialize (Output => File'Unchecked_Access, Size => 10000);
      Stream.Initialize (Output => Buffer'Unchecked_Access);
      Write_Stream (Stream);
      Stream.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "Form output serialization");
   end Test_Output;

   --  ------------------------------
   --  Test reading a form content into an Object tree.
   --  ------------------------------
   procedure Test_Read (T : in out Test) is
      use Util.Beans.Objects;
      Path  : constant String := Util.Tests.Get_Test_Path ("regtests/files/pass-01.form");
      Root  : Util.Beans.Objects.Object;
      Value : Util.Beans.Objects.Object;
   begin
      Root := Read (Path);
      T.Assert (not Util.Beans.Objects.Is_Null (Root), "Read should not return null object");
      T.Assert (not Util.Beans.Objects.Is_Array (Root), "Root object is not an array");

      Value := Util.Beans.Objects.Get_Value (Root, "home");
      Util.Tests.Assert_Equals (T, "Cosby",
                                Util.Beans.Objects.To_String (Value),
                                "Invalid first parameter");
      Value := Util.Beans.Objects.Get_Value (Root, "favorite flavor");
      Util.Tests.Assert_Equals (T, "flies",
                                Util.Beans.Objects.To_String (Value),
                                "Invalid second parameter");
   end Test_Read;

end Util.Serialize.IO.Form.Tests;

Implement new tests for form serialization and deserialization


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

   --  ------------------------------
   --  Get the line information where the component is defined.
   --  ------------------------------
   function Get_Line_Info (UI : in UIComponent'Class) return Views.Nodes.Line_Info is
   begin
      if UI.Tag /= null then
         return UI.Tag.Get_Line_Info;
      else
         return UI.Tag.Get_Line_Info;
      end if;
   end Get_Line_Info;

   --  ------------------------------
   --  Get the line information where the component is defined.
   --  ------------------------------
   function Get_Line_Info (UI : in UIComponent'Class) return String is
   begin
      if UI.Tag /= null then
         return UI.Tag.Get_Line_Info;
      else
         return UI.Tag.Get_Line_Info;
      end if;
   end Get_Line_Info;

end ASF.Components.Utils;

Implement the Get_Line_Info function

Implement the Get_Line_Info function


-----------------------------------------------------------------------
--  wiki-filters-html-tests -- Unit tests for wiki HTML filters
--  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.Test_Caller;
with Util.Assertions;
with Util.Strings;
with Util.Log.Loggers;

package body Wiki.Filters.Html.Tests is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Wiki.Filters");

   package Caller is new Util.Test_Caller (Test, "Wikis.Filters.Html");

   procedure Assert_Equals is
      new Util.Assertions.Assert_Equals_T (Html_Tag_Type);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Wiki.Filters.Html.Find_Tag",
                       Test_Find_Tag'Access);
   end Add_Tests;

   --  Test Find_Tag operation.
   procedure Test_Find_Tag (T : in out Test) is
   begin
      for I in Html_Tag_Type'Range loop
         declare
            Name : constant String := Html_Tag_Type'Image (I);
            Wname : constant Wide_Wide_String := Html_Tag_Type'Wide_Wide_Image (I);
            Pos  : constant Natural := Util.Strings.Index (Name, '_');
            Tag  : constant Html_Tag_Type := Find_Tag (WName (WName'First .. Pos - 1));
         begin
            Log.Info ("Checking tag {0}", Name);
            Assert_Equals (T, I, Tag, "Find_Tag failed");
         end;
      end loop;
   end Test_Find_Tag;

end Wiki.Filters.Html.Tests;

Implement a new test for the HTML filters internal operations


-----------------------------------------------------------------------
--  wiki-utils -- Wiki utility operations
--  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 Wiki.Parsers;

package Wiki.Utils is

   --  Render the wiki text according to the wiki syntax in HTML into a string.
   function To_Html (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Parsers.Wiki_Syntax_Type) return String;

   --  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 Wide_Wide_String;
                     Syntax : in Wiki.Parsers.Wiki_Syntax_Type) return String;

end Wiki.Utils;

Define the Wiki.Utils package with To_Html and To_Text functions


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                            A 4 G . A _ D E B U G                         --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--            Copyright (C) 1995-2012, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General  --
-- Public License for more details. You should have received a copy of the  --
-- GNU General Public License  distributed with ASIS-for-GNAT; see file     --
-- COPYING. If not, write to the Free Software Foundation,  59 Temple Place --
-- - Suite 330,  Boston, MA 02111-1307, USA.                                --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  Ada Core Technologies Inc --
-- (http://www.gnat.com).                                                   --
--                                                                          --
------------------------------------------------------------------------------

package A4G.A_Debug is

--  This package contains global flags used to control the inclusion
--  of debugging code in various phases of the ASIS-for-GNAT. It is
--  an almost complete analog of the GNAT Debug package

   -------------------------
   -- Dynamic Debug Flags --
   -------------------------

   --  Thirty six flags that can be used to activate various specialized
   --  debugging output information. The flags are preset to False, which
   --  corresponds to the given output being suppressed. The individual
   --  flags can be turned on using the undocumented switch /dxxx where
   --  xxx is a string of letters for flags to be turned on. Documentation
   --  on the current usage of these flags is contained in the body of Debug
   --  rather than the spec, so that we don't have to recompile the world
   --  when a new debug flag is added

   Debug_Flag_A : Boolean := False;
   Debug_Flag_B : Boolean := False;
   Debug_Flag_C : Boolean := False;
   Debug_Flag_D : Boolean := False;
   Debug_Flag_E : Boolean := False;
   Debug_Flag_F : Boolean := False;
   Debug_Flag_G : Boolean := False;
   Debug_Flag_H : Boolean := False;
   Debug_Flag_I : Boolean := False;
   Debug_Flag_J : Boolean := False;
   Debug_Flag_K : Boolean := False;
   Debug_Flag_L : Boolean := False;
   Debug_Flag_M : Boolean := False;
   Debug_Flag_N : Boolean := False;
   Debug_Flag_O : Boolean := False;
   Debug_Flag_P : Boolean := False;
   Debug_Flag_Q : Boolean := False;
   Debug_Flag_R : Boolean := False;
   Debug_Flag_S : Boolean := False;
   Debug_Flag_T : Boolean := False;
   Debug_Flag_U : Boolean := False;
   Debug_Flag_V : Boolean := False;
   Debug_Flag_W : Boolean := False;
   Debug_Flag_X : Boolean := False;
   Debug_Flag_Y : Boolean := False;
   Debug_Flag_Z : Boolean := False;

   Debug_Flag_1 : Boolean := False;
   Debug_Flag_2 : Boolean := False;
   Debug_Flag_3 : Boolean := False;
   Debug_Flag_4 : Boolean := False;
   Debug_Flag_5 : Boolean := False;
   Debug_Flag_6 : Boolean := False;
   Debug_Flag_7 : Boolean := False;
   Debug_Flag_8 : Boolean := False;
   Debug_Flag_9 : Boolean := False;

   procedure Set_Debug_Flag (C : Character; Val : Boolean := True);
   --  Where C is 0-9 or a-z, sets the corresponding debug flag to the
   --  given value. In the checks off version of debug, the call to
   --  Set_Debug_Flag is always a null operation.

   procedure Set_Off;
   --  Sets all the debug flags OFF (except Debug_Lib_Model for now),
   --  is to be called by Asis_Environment.Finalize

   procedure Set_On;  -- TEMPORARY SOLUTION!!!
   --  Sets all the debug flags ON.

   ------------------------
   -- TEMPORARY SOLUTION --
   ------------------------

   Debug_Mode      : Boolean := False;
   --  Flag indicating if the debugging information should be output by the
   --  routines from the A4G.A_Output package

   Debug_Lib_Model : Boolean := False;
   --  Flag forcing the debug output of the tables implementing the ASIS
   --  Context Model to be performed when finalizing the ASIS Environment.
   --  Currently should be set by hand. The debug output is produced only if
   --  Debug_Mode is set ON.

end A4G.A_Debug;

Add the ASIS file $i

Add the ASIS file $i


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

------------------------------------------------------------------------------
-- Natools.Static_Maps.S_Expressions.Conditionals is a common parent to     --
-- generated static hash maps related to S-expression conditionals system.  --
------------------------------------------------------------------------------

package Natools.Static_Maps.S_Expressions.Conditionals is
   pragma Pure;

end Natools.Static_Maps.S_Expressions.Conditionals;

add missing package in previous commits

static_maps-s_expressions-conditionals: add missing package in previous commits