------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                           A 4 G . D D A _ A U X                          --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--                            $Revision: 14154 $
--                                                                          --
--           Copyright (C) 1999-2001 Ada Core Technologies, Inc.            --
--                                                                          --
-- 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 Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- 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 GNAT;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
--                                                                          --
------------------------------------------------------------------------------

--  This package contains auxiliary routines used to support the data
--  decomposition annex. At the level of this package, types and components
--  are represented by their normal Entity_Id values. The corresponding
--  entities have the necessary representation information stored in them.

--  DDA_Aux acts as an interface between the main ASIS routines and all
--  representation issues.

with Asis.Data_Decomposition;

with Repinfo; use Repinfo;
with Types;   use Types;
with Uintp;   use Uintp;

package A4G.DDA_Aux is

   --------------------------------
   -- Portable_Data Declarations --
   --------------------------------

   --  Asis.Data_Decomposition.Portable_Value;

   --    Portable values are simply bytes, i.e. defined as mod 256. This is
   --    fine for all the byte addressable architectures that GNAT runs on
   --    now, and we will worry later about exotic cases (which may well
   --    never arise).

   --  Portable_Positive is Asis.Data_Decomposition.Portable_Positive;

   --    This is simply a synonym for Asis.ASIS_Positive

   --  Asis.Data_Decomposition.Portable_Data;

   --    This is array (Portable_Positive range <>) of Portable_Data. Thus
   --    it is simply an array of bytes. The representation of data in this
   --    format is as follows:
   --
   --      For non-scalar values, the data value is stored at the start of
   --      the value, occupying as many bits as needed. If there are padding
   --      bits (on the right), they are stored as zero bits when a value is
   --      retrieved, and ignored when a value is stored.
   --
   --      For scalar values, the data value is of length 1, 2, 4, or 8 bytes
   --      in proper little-endian or big-endian format with sign or zero
   --      bits filling the unused high order bits. For enumeration values,
   --      this is the Enum_Rep value, i.e. the actual stored value, not the
   --      Pos value. For biased types, the value is unsigned and biased.

   ---------------------------------
   -- Basic Interface Definiitons --
   ---------------------------------

   Variable_Rep_Info : exception;
   --  This exception is raised if an attempt is made to access representation
   --  information that depends on the value of a variable other than a
   --  discriminant for the current record. For example, if the length of
   --  a component of subtype String (1 .. N) is requested, and N is not a
   --  discriminant or a static constant.

   Invalid_Data : exception;
   --  Exception raised if an invalid data value is detected. There is no
   --  systematic checking for invalid values, but there are some situations
   --  in which bad values are detected, and this exception is raised.

   No_Component : exception;
   --  Exception raised if a request is made to access a component in a
   --  variant part of a record when the component does not exist for the
   --  particular set of discriminant values present. Also raised if a
   --  request is made to access an out of bounds subscript value for an
   --  array element.

   Null_Discrims : Repinfo.Discrim_List (1 .. 0) := (others => Uint_0);
   --  Used as default if no discriminants given

   ----------------------
   -- Utility Routines --
   ----------------------

   function Build_Discrim_List
     (Rec  : Entity_Id;
      Data : Asis.Data_Decomposition.Portable_Data)
      return Repinfo.Discrim_List;
   --  Given a record entity, and a value of this record type, builds a
   --  list of discriminants from the given value and returns it. The
   --  portable data value must include at least all the discriminants
   --  if the type is for a discriminated record. If Rec is other than
   --  a discriminated record type, then Data is ignored and Null_Discrims
   --  is returned.

   function Eval_Scalar_Node
     (N     : Node_Id;
      Discs : Repinfo.Discrim_List := Null_Discrims)
      return  Uint;
   --  This function is used to get the value of a node representing a value
   --  of a scalar type. Evaluation is possible for static expressions and
   --  for discriminant values (in the latter case, Discs must be provided
   --  and must contain the appropriate list of discriminants). Note that
   --  in the case of enumeration values, the result is the Pos value, not
   --  the Enum_Rep value for the given enumeration literal.
   --
   --    Raises Variable_Rep_Info is raised if the expression is other than
   --    a discriminant or a static expression, or if it is a discriminant
   --    and no discriminant list is provided.
   --
   --  Note that this functionality is related to that provided by
   --  Sem_Eval.Expr_Value, but this unit is not available in ASIS.

   function Linear_Index
     (Typ   : Entity_Id;
      Subs  : Asis.Data_Decomposition.Dimension_Indexes;
      Discs : Repinfo.Discrim_List := Null_Discrims)
      return  Asis.ASIS_Natural;
   --  Given Typ, the entity for a definite array type or subtype, and Subs,
   --  a list of 1's origin subscripts (that is, as usual Dimension_Indexes
   --  has subscripts that are 1's origin with respect to the declared lower
   --  bound), this routine computes the corresponding zero-origin linear
   --  index from the start of the array data. The case of Fortran convention
   --  (with row major order) is properly handled.
   --
   --  Raises No_Component if any of the subscripts is out of range (i.e.
   --  exceeds the length of the corresponding subscript position).

   function UI_From_Aint (A : Asis.ASIS_Integer) return Uint;
   --  Converts ASIS_Integer value to Uint

   function UI_Is_In_Aint_Range (U : Uint) return Boolean;
   --  Determine if a universal integer value U is in range of ASIS_Integer.
   --  Returns True iff in range (meaning that UI_To_Aint can be safely used).

   function UI_To_Aint (U : Uint) return Asis.ASIS_Integer;
   --  Converts Uint value to ASIS_Integer, the result must be in range
   --  of ASIS_Integer, or otherwise the exception Invalid_Data is raised.

   --------------------------------
   -- Universal Integer Encoding --
   --------------------------------

   --  These routines deal with decoding and encoding scalar values from
   --  Uint to portable data format.

   function Encode_Scalar_Value
     (Typ  : Entity_Id;
      Val  : Uint)
      return Asis.Data_Decomposition.Portable_Data;
   --  Given Typ, the entity for a scalar type or subtype, this function
   --  constructs a portable data valuethat represents a value of this
   --  type given by Val. The value of the Uint may not exceed the largest
   --  scalar value supported by the implementation. The result will be 1,
   --  2, 4 or 8 bytes long depending on the value of the input, positioned
   --  to be intepreted as an integer, and sign or zero extended as needed.
   --  For enumeration types, the value is the Enum_Rep value, not the Pos
   --  value. For biased types, the bias is NOT present in the Uint value
   --  (part of the job of Encode_Scalar_Value is to introduce the bias).
   --
   --    Raises Invalid_Data if value is out of range of the base type of Typ

   function Encode_Scalar_Value
     (Typ  : Entity_Id;
      Val  : Asis.ASIS_Integer)
      return Asis.Data_Decomposition.Portable_Data;
   --  Similar to above function except input is ASIS_Integer instead of Uint

   function Decode_Scalar_Value
     (Typ  : Entity_Id;
      Data : Asis.Data_Decomposition.Portable_Data)
      return Uint;
   --  Given Typ, the entity for a scalar type or subtype, this function
   --  takes the portable data value Data, that represents a value of
   --  this type, and returns the equivalent Uint value. For enumeration
   --  types the value is the Enum_Rep value, not the Pos value. For biased
   --  types, the result is unbiased (part of the job of Decode_Scalar_Value
   --  is to remove the bias).

   --------------------------------
   -- Record Discriminant Access --
   --------------------------------

   function Extract_Discriminant
     (Data : Asis.Data_Decomposition.Portable_Data;
      Disc : Entity_Id)
      return Uint;
   --  This function can be used to extract a discriminant value from a
   --  record. Data is the portable data value representing the record
   --  value, and Disc is the E_Discriminant entity for the discriminant.

   function Set_Discriminant
     (Data : Asis.Data_Decomposition.Portable_Data;
      Disc : Entity_Id;
      Val  : Uint)
      return Asis.Data_Decomposition.Portable_Data;
   --  Given Data, a portable data value representing the prefix of a record
   --  value which may already have some other discriminant values set, this
   --  function creates a new Portable_Data value, increased in length
   --  if necessary, in which the discriminant represented by E_Discriminant
   --  entity Disc is set to the given value.
   --
   --    Raises Invalid_Data if the value does not fit in the field

   procedure Set_Discriminant
     (Data : in out Asis.Data_Decomposition.Portable_Data;
      Disc : Entity_Id;
      Val  : Uint);
   --  Similar to the function above, except that the modification is done
   --  in place on the given portable data value. In this case, the Data
   --  value must be long enough to contain the given discriminant field.

   function Set_Discriminant
     (Data : Asis.Data_Decomposition.Portable_Data;
      Disc : Entity_Id;
      Val  : Asis.ASIS_Integer)
      return Asis.Data_Decomposition.Portable_Data;
   --  Similar to function above, but takes argument in ASIS_Integer form

   procedure Set_Discriminant
     (Data : in out Asis.Data_Decomposition.Portable_Data;
      Disc : Entity_Id;
      Val  : Asis.ASIS_Integer);
   --  Similar to function above, but takes argument in ASIS_Integer form

   -----------------------------
   -- Record Component Access --
   -----------------------------

   function Component_Present
     (Comp  : Entity_Id;
      Discs : Repinfo.Discrim_List)
      return  Boolean;
   --  Determines if the given component is present or not. For the case
   --  where the component is part of a variant of a discriminated record,
   --  Discs must contain the full list of discriminants for the record,
   --  and the result is True or False depending on whether the variant
   --  containing the field is present or not for the given discriminant
   --  values. If the component is not part of a variant, including the
   --  case where the record is non-discriminated, then Discs is ignored
   --  and the result is always True.

   function Extract_Record_Component
     (Data  : Asis.Data_Decomposition.Portable_Data;
      Comp  : Entity_Id;
      Discs : Repinfo.Discrim_List := Null_Discrims)
      return  Asis.Data_Decomposition.Portable_Data;
   --  Given Data, a portable data value representing a record value, this
   --  routine extracts the component value corresponding to E_Component
   --  entity Comp, and returns a new portable data value corresponding to
   --  this component. The Discs parameter supplies the discriminants and
   --  must be present in the discriminated record case if the component
   --  may depend on discriminants. For scalar types, the result value
   --  is 1,2,4, or 8 bytes, properly positioned to be interpreted as an
   --  integer, and sign/zero extended as required. For all other types,
   --  the value is extended if necessary to be an integral number of
   --  bytes by adding zero bits.
   --
   --    Raises No_Component if an attempt is made to set a component in a
   --    non-existent variant.
   --
   --    Raises No_Component if the specified component is part of a variant
   --    that does not exist for the given discriminant values
   --
   --    Raises Variable_Rep_Info if the size or position of the component
   --    depends on a variable other than a discriminant

   function Set_Record_Component
     (Data  : Asis.Data_Decomposition.Portable_Data;
      Comp  : Entity_Id;
      Val   : Asis.Data_Decomposition.Portable_Data;
      Discs : Repinfo.Discrim_List := Null_Discrims)
      return  Asis.Data_Decomposition.Portable_Data;
   --  Given Data, a portable data value that represents a record value,
   --  or a prefix of such a record, sets the component represented by the
   --  E_Component entity Comp is set to the value represented by the portable
   --  data value Val, and the result is returned as a portable data value,
   --  extended in length if necessary to accomodate the newly added entry.
   --  The Discs parameter supplies the discriminants and must be present
   --  in the discriminated record case if the component may depend on
   --  the values of discriminants.
   --
   --    Raises No_Component if an attempt is made to set a component in a
   --    non-existent variant.
   --
   --    Raises No_Component if the specified component is part of a variant
   --    that does not exist for the given discriminant values
   --
   --    Raises Variable_Rep_Info if the size or position of the component
   --    depends on a variable other than a discriminant
   --
   --    Raises Invalid_Data if the data value is too large to fit.

   procedure Set_Record_Component
     (Data  : in out Asis.Data_Decomposition.Portable_Data;
      Comp  : Entity_Id;
      Val   : Asis.Data_Decomposition.Portable_Data;
      Discs : Repinfo.Discrim_List := Null_Discrims);
   --   Same as the above, but operates in place on the given data value,
   --   which must in this case be long enough to contain the component.

   ----------------------------
   -- Array Component Access --
   ----------------------------

   function Extract_Array_Component
     (Typ   : Entity_Id;
      Data  : Asis.Data_Decomposition.Portable_Data;
      Subs  : Asis.Data_Decomposition.Dimension_Indexes;
      Discs : Repinfo.Discrim_List := Null_Discrims)
      return  Asis.Data_Decomposition.Portable_Data;
   --  Given Typ, the entity for an array type, and Data, a portable data
   --  value representing a value of this array type, this function extracts
   --  the array element corresponding to the given list of subscript values.
   --  The parameter Discs must be given if any of the bounds of the array
   --  may depend on discriminant values, and supplies the corresponding
   --  discriminants. For scalar component types, the value is 1,2,4, or 8,
   --  properly positioned to be interpreted as an integer, and sign/zero
   --  extended as required. For all other types, the value is extended if
   --  necessary to be an integral number of bytes by adding zero bits.
   --
   --    Raises No_Component if any of the subscripts is out of bounds
   --    (that is, exceeds the length of the corresponding index).
   --
   --    Raises Variable_Rep_Info if length of any index depends on a
   --    variable other than a discriminant.
   --
   function Set_Array_Component
     (Typ   : Entity_Id;
      Data  : Asis.Data_Decomposition.Portable_Data;
      Subs  : Asis.Data_Decomposition.Dimension_Indexes;
      Val   : Asis.Data_Decomposition.Portable_Data;
      Discs : Repinfo.Discrim_List := Null_Discrims)
      return  Asis.Data_Decomposition.Portable_Data;
   --  Given a portable data value representing either a value of the array
   --  type Typ, or a prefix of such a value, sets the element referenced by
   --  the given subscript values in Subs, to the given value Val. The
   --  parameter Discs must be given if any of the bounds of the array
   --  may depend on discriminant values, and supplies the corresponding
   --  discriminants. The returned result is the original portable data
   --  value, extended if necessary to include the new element, with the
   --  new element value in place.
   --
   --    Raises No_Component if any of the subscripts is out of bounds
   --    (that is, exceeds the length of the corresponding index).
   --
   --    Raises Variable_Rep_Info if length of any index depends on a
   --    variable other than a discriminant.
   --
   --    Raises Invalid_Data if the data value is too large to fit.

   procedure Set_Array_Component
     (Typ   : Entity_Id;
      Data  : in out Asis.Data_Decomposition.Portable_Data;
      Subs  : Asis.Data_Decomposition.Dimension_Indexes;
      Val   : Asis.Data_Decomposition.Portable_Data;
      Discs : Repinfo.Discrim_List := Null_Discrims);
   --  Same as above, but operates in place on the given stream. The stream
   --  must be long enough to contain the given element in this case.

   -------------------------------
   -- Representation Parameters --
   -------------------------------

   --  These routines give direct access to the values of the
   --  representation fields stored in the tree, including the
   --  proper interpretation of variable values that depend on
   --  the values of discriminants.

   function Get_Esize
     (Comp  : Entity_Id;
      Discs : Repinfo.Discrim_List := Null_Discrims)
      return  Uint;
   --  Obtains the size (actually the object size, Esize) of any subtype
   --  or record component or discriminant. The function can be used for
   --  components of discriminanted or non-discriminated records. In the
   --  case of components of a discriminated record where the value depends
   --  on discriminants, Discs provides the necessary discriminant values.
   --  In all other cases, Discs is ignored and can be defaulted.
   --
   --    Raises Variable_Rep_Info if the size depends on a variable other
   --    than a discriminant.
   --
   --    Raises No_Component if the component is in a variant that does not
   --    exist for the given set of discriminant values.

   function Get_Component_Bit_Offset
     (Comp  : Entity_Id;
      Discs : Repinfo.Discrim_List := Null_Discrims)
      return  Uint;
   --  Obtains the component first bit value for the specified component or
   --  discriminant. This function can be used for discriminanted or non-
   --  discriminanted records. In the case of components of a discriminated
   --  record where the value depends on discriminants, Discs provides the
   --  necessary discriminant values. Otherwise (and in particular in the case
   --  of discriminants themselves), Discs is ignored and can be defaulted.
   --
   --    Raises Variable_Rep_Info if the size depends on a variable other
   --    than a discriminant.
   --
   --    Raises No_Component if the component is in a variant that does not
   --    exist for the given set of discriminant values.

   function Get_Component_Size
      (Typ  : Entity_Id)
       return Uint;
   --  Given an array type or subtype, returns the component size value

   function Get_Length
     (Typ   : Entity_Id;
      Sub   : Asis.ASIS_Positive;
      Discs : Repinfo.Discrim_List := Null_Discrims)
      return  Asis.ASIS_Natural;
   --  Given Typ, the entity for a definite array type or subtype, returns
   --  the Length of the subscript designated by Sub (1 = first subscript
   --  as in Length attribute). If the bounds of the array may depend on
   --  discriminants, then Discs contains the list of discriminant values
   --  (e.g. if we have an array field A.B, then the discriminants of A
   --  may be needed).
   --
   --    Raises Variable_Rep_Info if the size depends on a variable other
   --    than a discriminant.

   -------------------------------
   -- Computation of Attributes --
   -------------------------------

   --  The DDA_Aux package simply provides access to the representation
   --  information stored in the tree, as described in Einfo, as refined
   --  by the description in Repinfo with regard to the case where some
   --  of the values depend on discriminants.

   --  The ASIS spec requires that ASIS be able to compute the values of
   --  the attributes Position, First_Bit, and Last_Bit.

   --  This is done as follows. First compute the Size (with Get_Esize)
   --  and the Component_Bit_Offset (with Get_Component_Bit_Offset). In the
   --  case of a nested reference, e.g.

   --     A.B.C

   --       You need to extract the value A.B, and then ask for the
   --       size of its component C, and also the component first bit
   --       value of this component C.

   --       This value gets added to the Component_Bit_Offset value for
   --       the B field in A.

   --  For arrays, the equivalent of Component_Bit_Offset is computed simply
   --  as the zero origin linearized subscript multiplied by the value of
   --  Component_Size for the array. As another example, consider:

   --     A.B(15)

   --  In this case you get the component first bit of the field B in A,
   --  using the discriminants of A if there are any. Then you get the
   --  component first bit of the 15th element of B, using the discriminants
   --  of A (since the bounds of B may depend on them). You then add these
   --  two component first bit values.

   --  Once you have the aggregated value of the first bit offset (i.e. the
   --  sum of the Component_Bit_Offset values and corresponding array offsets
   --  for all levels of the access), then the formula is simply:

   --     X'Position = First_Bit_Offset / Storage_Unit_Size

   --     X'First    = First_Bit_Offset mod Storage_Unit_Size

   --     X'Last     = X'First + component_size - 1

end A4G.DDA_Aux;

Add the ASIS file $i

Add the ASIS file $i


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                   A U N I T . R E P O R T E R . X M L                    --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--                                                                          --
--                       Copyright (C) 2000-2008, AdaCore                   --
--                                                                          --
-- 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 Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- 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 GNAT;  see file COPYING.  If not, write --
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
-- Boston, MA 02110-1301, USA.                                              --
--                                                                          --
-- GNAT is maintained by AdaCore (http://www.adacore.com)                   --
--                                                                          --
------------------------------------------------------------------------------

with AUnit.Reporter;
with AUnit.Test_Results;

with Ada.Text_IO;
with Ada.Strings.Unbounded;

--  XML reporter (fix AUnit issues and generate in a separate file instead of stdout).
package Util.Tests.Reporter is

   type XML_Reporter is new AUnit.Reporter.Reporter with record
      File : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   procedure Report (Engine : XML_Reporter;
                     R      : in out AUnit.Test_Results.Result'Class);

   procedure Report (Engine : XML_Reporter;
                     File   : in out Ada.Text_IO.File_Type;
                     R      : in out AUnit.Test_Results.Result'Class);

end Util.Tests.Reporter;

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                   A U N I T . R E P O R T E R . X M L                    --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--                                                                          --
--                       Copyright (C) 2000-2008, AdaCore                   --
--                                                                          --
-- 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 Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- 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 GNAT;  see file COPYING.  If not, write --
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
-- Boston, MA 02110-1301, USA.                                              --
--                                                                          --
-- GNAT is maintained by AdaCore (http://www.adacore.com)                   --
--                                                                          --
------------------------------------------------------------------------------

with AUnit.Reporter;
with AUnit.Test_Results;
with AUnit.Options;

with Ada.Text_IO;
with Ada.Strings.Unbounded;

--  XML reporter (fix AUnit issues and generate in a separate file instead of stdout).
package Util.Tests.Reporter is

   type XML_Reporter is new AUnit.Reporter.Reporter with record
      File : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   overriding
   procedure Report (Engine  : in XML_Reporter;
                     R       : in out AUnit.Test_Results.Result'Class;
                     Options : in AUnit.Options.AUnit_Options := AUnit.Options.Default_Options);

   procedure Report (Engine : XML_Reporter;
                     File   : in out Ada.Text_IO.File_Type;
                     R      : in out AUnit.Test_Results.Result'Class);

end Util.Tests.Reporter;

Fix compilation with AUnit 2014

Fix compilation with AUnit 2014


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             L I B . L I S T                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
--                                                                          --
-- 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 Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

separate (Lib)
procedure List (File_Names_Only : Boolean := False) is

   Num_Units : constant Nat := Int (Units.Last) - Int (Units.First) + 1;
   --  Number of units in file table

   Sorted_Units : Unit_Ref_Table (1 .. Num_Units);
   --  Table of unit numbers that we will sort

   Unit_Hed : constant String := "Unit name                        ";
   Unit_Und : constant String := "---------                        ";
   Unit_Bln : constant String := "                                 ";
   File_Hed : constant String := "File name                     ";
   File_Und : constant String := "---------                     ";
   File_Bln : constant String := "                              ";
   Time_Hed : constant String := "Time stamp";
   Time_Und : constant String := "----------";

   Unit_Length : constant Natural := Unit_Hed'Length;
   File_Length : constant Natural := File_Hed'Length;

begin
   --  First step is to make a sorted table of units

   for J in 1 .. Num_Units loop
      Sorted_Units (J) := Unit_Number_Type (Int (Units.First) + J - 1);
   end loop;

   Sort (Sorted_Units);

   --  Now we can generate the unit table listing

   Write_Eol;

   if not File_Names_Only then
      Write_Str (Unit_Hed);
      Write_Str (File_Hed);
      Write_Str (Time_Hed);
      Write_Eol;

      Write_Str (Unit_Und);
      Write_Str (File_Und);
      Write_Str (Time_Und);
      Write_Eol;
      Write_Eol;
   end if;

   for R in Sorted_Units'Range loop
      if File_Names_Only then
         if not Is_Internal_File_Name
                  (File_Name (Source_Index (Sorted_Units (R))))
         then
            Write_Name (Full_File_Name (Source_Index (Sorted_Units (R))));
            Write_Eol;
         end if;

      else
         Write_Unit_Name (Unit_Name (Sorted_Units (R)));

         if Name_Len > (Unit_Length - 1) then
            Write_Eol;
            Write_Str (Unit_Bln);
         else
            for J in Name_Len + 1 .. Unit_Length loop
               Write_Char (' ');
            end loop;
         end if;

         Write_Name (Full_File_Name (Source_Index (Sorted_Units (R))));

         if Name_Len > (File_Length - 1) then
            Write_Eol;
            Write_Str (Unit_Bln);
            Write_Str (File_Bln);
         else
            for J in Name_Len + 1 .. File_Length loop
               Write_Char (' ');
            end loop;
         end if;

         Write_Str (String (Time_Stamp (Source_Index (Sorted_Units (R)))));
         Write_Eol;
      end if;
   end loop;

   Write_Eol;
end List;

Add GNAT files for ASIS

Add GNAT files for ASIS


-----------------------------------------------------------------------
--  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.Render.Text;
with Wiki.Render.Html;
with Wiki.Writers.Builders;
package body 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 is
      Writer   : aliased Wiki.Writers.Builders.Html_Writer_Type;
      Renderer : aliased Wiki.Render.Html.Html_Writer;
   begin
      Renderer.Set_Writer (Writer'Unchecked_Access);
      Wiki.Parsers.Parse (Renderer'Unchecked_Access, Text, Syntax);
      return Writer.To_String;
   end To_Html;

   --  ------------------------------
   --  Render the wiki text according to the wiki syntax in text into a string.
   --  Wiki formatting and decoration are removed.
   --  ------------------------------
   function To_Text (Text   : in Wide_Wide_String;
                     Syntax : in Wiki.Parsers.Wiki_Syntax_Type) return String is
      Writer   : aliased Wiki.Writers.Builders.Writer_Builder_Type;
      Renderer : aliased Wiki.Render.Text.Text_Renderer;
   begin
      Renderer.Set_Writer (Writer'Unchecked_Access);
      Wiki.Parsers.Parse (Renderer'Unchecked_Access, Text, Syntax);
      return Writer.To_String;
   end To_Text;

end Wiki.Utils;

Implement the To_Html and To_Text functions


-----------------------------------------------------------------------
--  util-processes-os -- System specific and low level operations
--  Copyright (C) 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.
-----------------------------------------------------------------------

private package Util.Processes.Os is

   --  Wait for the process <b>Pid</b> to finish and return the process exit status.
   procedure Waitpid (Pid    : in Process_Identifier;
                      Status : out Integer);

   --  Spawn a process
   procedure Spawn (Proc : in out Process;
                    Mode : in Pipe_Mode := NONE);

end Util.Processes.Os;

-----------------------------------------------------------------------
--  util-processes-os -- Dummy system specific and low level operations
--  Copyright (C) 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.
-----------------------------------------------------------------------

private package Util.Processes.Os is

   --  Wait for the process <b>Pid</b> to finish and return the process exit status.
   procedure Waitpid (Pid    : in Process_Identifier;
                      Status : out Integer);

   --  Spawn a process
   procedure Spawn (Proc : in out Process;
                    Mode : in Pipe_Mode := NONE);

end Util.Processes.Os;

Update comment title

Update comment title


-----------------------------------------------------------------------
--  widgets-factory -- Factory for widget Components
--  Copyright (C) 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 ASF.Factory;

package ASF.Components.Widgets.Factory is

   --  Get the widget component factory.
   function Definition return ASF.Factory.Factory_Bindings_Access;

end ASF.Components.Widgets.Factory;

Define the factory for the creation of widget components


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

package Wiki.Nodes.Lists is

   pragma Preelaborate;

   package Node_List_Refs is new Util.Refs.General_References (Node_List, Finalize);

   type Node_List_Ref is new Node_List_Refs.Ref with null record;

   --  Append a node to the node list.
   procedure Append (Into : in out Node_List_Ref;
                     Node : in Node_Type_Access);

   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   procedure Iterate (List    : in Node_List_Access;
                      Process : not null access procedure (Node : in Node_Type));

   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   procedure Iterate (List    : in Node_List_Ref;
                      Process : not null access procedure (Node : in Node_Type));

   --  Returns True if the list reference is empty.
   function Is_Empty (List : in Node_List_Ref) return Boolean;

   --  Get the number of nodes in the list.
   function Length (List : in Node_List_Ref) return Natural;

private

   subtype Node_List_Accessor is Node_List_Refs.Element_Accessor;

   procedure Iterate (List    : in Node_List_Accessor;
                      Process : not null access procedure (Node : in Node_Type));

end Wiki.Nodes.Lists;

Refactor Node_List and references to use Ada Util general references


-----------------------------------------------------------------------
--  wiki-filters-toc -- Filter for the creation of Table Of Contents
--  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.
-----------------------------------------------------------------------
with Wiki.Nodes;
package body Wiki.Filters.TOC is

   --  ------------------------------
   --  Add a section header with the given level in the document.
   --  ------------------------------
   overriding
   procedure Add_Header (Filter    : in out TOC_Filter;
                         Document  : in out Wiki.Documents.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural) is
      T : Wiki.Nodes.Node_List_Ref;
   begin
      Document.Get_TOC (T);
      Wiki.Nodes.Append (T, new Wiki.Nodes.Node_Type '(Kind   => Wiki.Nodes.N_TOC_ENTRY,
                                                       Len    => Header'Length,
                                                       Header => Header,
                                                       Level  => Level));
      Filter_Type (Filter).Add_Header (Document, Header, Level);
   end Add_Header;

end Wiki.Filters.TOC;

Implement the TOC filter to collect the table of content


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

package body Util.Mail is

   --  ------------------------------
   --  Parse the email address and separate the name from the address.
   --  ------------------------------
   function Parse_Address (E_Mail : in String) return Email_Address is
      use Ada.Strings.Unbounded;
      use Ada.Strings.Fixed;
      use Ada.Strings;

      Result    : Email_Address;
      First_Pos : constant Natural := Index (E_Mail, "<");
      Last_Pos  : constant Natural := Index (E_Mail, ">");
   begin
      if First_Pos > 0 and Last_Pos > 0 then
         Result.Name := To_Unbounded_String (Trim (E_Mail (E_Mail'First .. First_Pos - 1),
                                             Both));
         Result.Address := To_Unbounded_String (Trim (E_Mail (First_Pos + 1 .. Last_Pos - 1),
                                                Both));
      else
         Result.Address := To_Unbounded_String (Trim (E_Mail, Both));
      end if;
      return Result;
   end Parse_Address;

end Util.Mail;

Implement the Parse_Address function

Implement the Parse_Address function


-----------------------------------------------------------------------
--  Security-oauth-clients-tests - Unit tests for OAuth
--  Copyright (C) 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.Test_Caller;
with Util.Measures;
with Util.Strings.Sets;

package body Security.OAuth.Clients.Tests is

   package Caller is new Util.Test_Caller (Test, "Security.OAuth.Clients");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Security.OAuth.Clients.Create_Nonce",
                       Test_Create_Nonce'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test Create_Nonce operation.
   --  ------------------------------
   procedure Test_Create_Nonce (T : in out Test) is
      Nonces : Util.Strings.Sets.Set;
   begin
      for I in 1 .. 1_000 loop
         for I in 32 .. 734 loop
            declare
               S : constant String := Create_Nonce (I * 3);
            begin
               T.Assert (not Nonces.Contains (S), "Nonce was not unique: " & S);
               Nonces.Include (S);
            end;
         end loop;
      end loop;
      declare
         S : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            declare
               Nonce : constant String := Create_Nonce (128);
               pragma Unreferenced (Nonce);
            begin
               null;
            end;
         end loop;
         Util.Measures.Report (S, "128 bits nonce generation (1000 calls)");
      end;
   end Test_Create_Nonce;

end Security.OAuth.Clients.Tests;

Add unit tests for OAuth package and Create_Nonce operation


-----------------------------------------------------------------------
--  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


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--          A S I S . C O M P I L A T I O N _ U N I T S . T I M E S         --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            Copyright (C) 1995-2008, 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).                                                   --
--                                                                          --
------------------------------------------------------------------------------

with Asis.Exceptions; use Asis.Exceptions;
with Asis.Errors;     use Asis.Errors;

with Asis.Set_Get;    use Asis.Set_Get;

with A4G.Vcheck;      use A4G.Vcheck;

package body Asis.Compilation_Units.Times is

   Package_Name : constant String := "Asis.Compilation_Units.Times.";

   Standard_Time : constant Ada.Calendar.Time :=
      Ada.Calendar.Time_Of (1994, 12, 21, 0.0);
   --  used as Time_Of_Last_Update for the predefined Standard package

   --------------------
   -- Attribute_Time --
   --------------------

   function Attribute_Time
     (Compilation_Unit : Asis.Compilation_Unit;
      Attribute        : Wide_String)
      return             Ada.Calendar.Time
   is
   begin
      pragma Unreferenced (Attribute);

      Check_Validity (Compilation_Unit, Package_Name & "Attribute_Time");

      return Nil_ASIS_Time;
   end Attribute_Time;

   ------------------------------
   -- Compilation_CPU_Duration --
   ------------------------------

   function Compilation_CPU_Duration
     (Compilation_Unit : Asis.Compilation_Unit)
      return             Standard.Duration
   is
   begin
      Check_Validity
        (Compilation_Unit, Package_Name & "Compilation_CPU_Duration");

      return 0.0;
   end Compilation_CPU_Duration;

   -------------------------
   -- Time_Of_Last_Update --
   -------------------------

   function Time_Of_Last_Update
     (Compilation_Unit : Asis.Compilation_Unit)
      return             Ada.Calendar.Time
   is
   begin
      Check_Validity (Compilation_Unit, Package_Name & "Time_Of_Last_Update");

      if Get_Unit_Id (Compilation_Unit) = Standard_Id then

         return Standard_Time;
      else

         return Time_Stamp (Compilation_Unit);
      end if;

   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>

         if Status_Indicator = Unhandled_Exception_Error then
            Add_Call_Information
              (Outer_Call => Package_Name & "Time_Of_Last_Update");
         end if;

         raise;
      when Ex : others =>
         Report_ASIS_Bug
           (Query_Name => Package_Name & "Time_Of_Last_Update",
            Ex         => Ex,
            Arg_CU     => Compilation_Unit);
   end Time_Of_Last_Update;

end Asis.Compilation_Units.Times;

Add the ASIS file $i

Add the ASIS file $i


-----------------------------------------------------------------------
--  awa-votes-modules-tests -- Unit tests for vote service
--  Copyright (C) 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.Tests;
with AWA.Tests;

package AWA.Votes.Modules.Tests is

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

   type Test is new AWA.Tests.Test with record
      Manager : AWA.Votes.Modules.Vote_Module_Access;
   end record;

   --  Test vote.
   procedure Test_Vote_Up (T : in out Test);

end AWA.Votes.Modules.Tests;

Update the unit tests

Update the unit tests


-----------------------------------------------------------------------
--  wget -- A simple wget command to fetch a page
--  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.
-----------------------------------------------------------------------
with Ada.Text_IO;
with Ada.Command_Line;
with Util.Strings;
with Util.Strings.Tokenizers;
with Util.Http.Clients;
with Util.Http.Clients.Curl;
procedure Wget is

   procedure Print_Token (Token : in String;
                          Done  : out Boolean) is
   begin
      Ada.Text_IO.Put_Line (Token);
      Done := False;
   end Print_Token;

   Count : constant Natural := Ada.Command_Line.Argument_Count;
begin
   if Count = 0 then
      Ada.Text_IO.Put_Line ("Usage: wget url ...");
      Ada.Text_IO.Put_Line ("Example: wget http://www.adacore.com");
      return;
   end if;
   Util.Http.Clients.Curl.Register;
   for I in 1 .. Count loop
      declare
         Http     : Util.Http.Clients.Client;
         URI      : constant String := Ada.Command_Line.Argument (1);
         Response : Util.Http.Clients.Response;
      begin
         Http.Add_Header ("X-Requested-By", "wget");
         Http.Get (URI, Response);
         Ada.Text_IO.Put_Line ("Code: " & Natural'Image (Response.Get_Status));
         Ada.Text_IO.Put_Line (Response.Get_Body);
      end;
   end loop;
end Wget;

-----------------------------------------------------------------------
--  wget -- A simple wget command to fetch a page
--  Copyright (C) 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 Ada.Text_IO;
with Ada.Command_Line;
with Util.Http.Clients;
with Util.Http.Clients.Curl;
procedure Wget is
   Count : constant Natural := Ada.Command_Line.Argument_Count;
begin
   if Count = 0 then
      Ada.Text_IO.Put_Line ("Usage: wget url ...");
      Ada.Text_IO.Put_Line ("Example: wget http://www.adacore.com");
      return;
   end if;
   Util.Http.Clients.Curl.Register;
   for I in 1 .. Count loop
      declare
         Http     : Util.Http.Clients.Client;
         URI      : constant String := Ada.Command_Line.Argument (1);
         Response : Util.Http.Clients.Response;
      begin
         Http.Add_Header ("X-Requested-By", "wget");
         Http.Get (URI, Response);
         Ada.Text_IO.Put_Line ("Code: " & Natural'Image (Response.Get_Status));
         Ada.Text_IO.Put_Line (Response.Get_Body);
      end;
   end loop;
end Wget;

Remove unused Print_Token operation

Remove unused Print_Token operation


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                   A 4 G . S P A N _ B E G I N N I N 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,  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).                                                --
--                                                                          --
------------------------------------------------------------------------------

with Asis;

with A4G.Int_Knds; use A4G.Int_Knds;

with Types;        use Types;

package A4G.Span_Beginning is

   function Set_Image_Beginning (E : Asis.Element) return Source_Ptr;
   --  The driver function for computing the beginning of the element image
   --  in the GNAT source text buffer. In case if the argument is a labeled
   --  statement returns the baginning of the first attachecd label. Otherwise
   --  calls the element-kind-specific function for computing the image
   --  beginning

   --  The functions below compute the beginning of the text image for some
   --  specific set of ELement kinds/

   function Subunit_Beginning (E : Asis.Element) return Source_Ptr;
   function Private_Unit_Beginning (E : Asis.Element) return Source_Ptr;
   --  Assuming that E is an element representing the top Unit element of a
   --  subunit or of a library item representing a private unit, returns the
   --  source pointer to the beginning of the keyword SEPARATE or PRIVATE
   --  accordingly.

   function No_Search (E : Asis.Element) return Source_Ptr;
   --  That is, we can just use Sloc from the node the Element is based upon.

   function Search_Identifier_Beginning
     (E : Asis.Element)
      return Source_Ptr;
   --  A special processing is needed for an identifier representing the
   --  attribute designator in pseudo-attribute-reference in an attribute
   --  definition clause and for 'Class attribute in aspect indication

   function Search_Subtype_Indication_Beginning
     (E : Asis.Element)
      return Source_Ptr;
   --  If the subtype mark is an expanded name, we have to look for its prefix

   function Defining_Identifier_Beginning
     (E :    Asis.Element)
      return Source_Ptr;
   --  Returns the beginning of A_Defining_Identifier elements. In case of
   --  labels we have to get rid of '<<'

   function Short_Circuit_Beginning (E : Asis.Element) return Source_Ptr;
   --  Returns the beginning of short circuit expression

   function Membership_Test_Beginning (E : Asis.Element) return Source_Ptr;
   --  Returns the beginning of membership test expression

   function Null_Component_Beginning (E : Asis.Element) return Source_Ptr;
   --  In case of A_Nil_Component element Sloc of its Node points to
   --  "record" (it's easy) or to variant (it's a pain)

   function Search_Prefix_Beginning (E : Asis.Element) return Source_Ptr;
   --  Is needed when the Argument has a "prefix" in its structure, but Sloc
   --  points somewhere inside the elemen structure

--  --|A2005 start
   function Possible_Null_Exclusion_Beginning
     (E    : Asis.Element)
      return Source_Ptr;
   --  Should be used for constructs that can contain null_exclusion

   function Possible_Overriding_Indicator_Beginning
     (E    : Asis.Element)
      return Source_Ptr;
   --  Is supposed to be used for some of the constructs that can contain
   --  overriding_indicator
--  --|A2005 end

   function Component_And_Parameter_Declaration_Beginning
     (E :    Asis.Element)
      return Source_Ptr;

   function Exception_Declaration_Beginning
     (E :    Asis.Element)
      return Source_Ptr;

   function Derived_Definition_Beginning (E : Asis.Element) return Source_Ptr;

   function Type_Definition_Beginning (E : Asis.Element) return Source_Ptr;

   function Interface_Definition_Beginning
     (E    : Asis.Element)
      return Source_Ptr;

   function Tagged_Type_Definition_Beginning
     (E :    Asis.Element)
      return Source_Ptr;

   function Simple_Expression_Range_Beginning
     (E :    Asis.Element)
      return Source_Ptr;

   function Component_Definition_Beginning
     (E :    Asis.Element)
      return Source_Ptr;

   function Search_Left_Parenthesis_After (E : Asis.Element) return Source_Ptr;
   --  Is needed when the Element does not have its "own" node (in particular,
   --  for A_Known_Discriminant_Part Element)

   function Private_Extension_Definition_Beginning
     (E :    Asis.Element)
      return Source_Ptr;

   function Private_Type_Definition_Beginning
     (E :    Asis.Element)
      return Source_Ptr;

   function Explicit_Dereference_Beginning
     (E :    Asis.Element)
      return Source_Ptr;

   function Function_Call_Beginning (E : Asis.Element) return Source_Ptr;

   function Indexed_Component_Beginning (E : Asis.Element) return Source_Ptr;

   function Component_Association_Beginning
     (E :    Asis.Element)
      return Source_Ptr;

   function Association_Beginning
     (E :    Asis.Element)
      return Source_Ptr;

   function Parenthesized_Expression_Beginning
     (E :    Asis.Element)
      return Source_Ptr;

   function Assignment_Statement_Beginning
     (E :    Asis.Element)
      return Source_Ptr;

   function Named_Statement_Beginning
     (E :    Asis.Element)
      return Source_Ptr;
   --  Takes care of loop and block names

   function Call_Statement_Beginning (E : Asis.Element) return Source_Ptr;

   function While_Loop_Statement_Beginning
     (E :    Asis.Element)
      return Source_Ptr;

   function For_Loop_Statement_Beginning (E : Asis.Element) return Source_Ptr;

   function Else_Path_Beginning (E : Asis.Element) return Source_Ptr;

   function With_Clause_Beginning (E : Asis.Element) return Source_Ptr;

   function Component_Clause_Beginning (E : Asis.Element) return Source_Ptr;

   function Subprogram_Spec_Beginning (E : Asis.Element) return Source_Ptr;

   function Formal_Object_Declaration_Beginning
     (E : Asis.Element)
      return Source_Ptr;

   function A_Then_Abort_Path_Beginning (E : Asis.Element) return Source_Ptr;

   function Select_Alternative_Beginning (E : Asis.Element) return Source_Ptr;

--  --|A2015 start
   function Case_Expression_Path_Beginning
     (E    : Asis.Element)
      return Source_Ptr;

   function If_Expression_Beginning
     (E    : Asis.Element)
      return Source_Ptr;

   function Conditional_Expression_Path_Beginning
     (E    : Asis.Element)
      return Source_Ptr;

   function An_Else_Expression_Path_Beginning
     (E    : Asis.Element)
      return Source_Ptr;
--  --|A2015 end

   --  The look-up table below defines the mapping from Element kinds onto
   --  specific routines for computing the Element image beginning

   type Set_Source_Location_type is
      access function (E : Asis.Element) return Source_Ptr;

   Switch : array (Internal_Element_Kinds) of Set_Source_Location_type := (

      An_All_Calls_Remote_Pragma ..
      --  An_Asynchronous_Pragma
      --  An_Atomic_Pragma
      --  An_Atomic_Components_Pragma
      --  An_Attach_Handler_Pragma
      --  A_Controlled_Pragma
      --  A_Convention_Pragma
      --  An_Elaborate_All_Pragma
      --  An_Elaborate_Body_Pragma
      --  An_Export_Pragma
      --  An_Import_Pragma
      --  An_Inline_Pragma
      --  An_Inspection_Point_Pragma
      --  An_Interrupt_Handler_Pragma
      --  An_Interrupt_Priority_Pragma
      --  A_List_Pragma
      --  A_Locking_Policy_Pragma
      --  A_Normalize_Scalars_Pragma
      --  An_Optimize_Pragma
      --  A_Pack_Pragma
      --  A_Page_Pragma
      --  A_Preelaborate_Pragma
      --  A_Priority_Pragma
      --  A_Pure_Pragma
      --  A_Queuing_Policy_Pragma
      --  A_Remote_Call_Interface_Pragma
      --  A_Remote_Types_Pragma
      --  A_Restrictions_Pragma
      --  A_Reviewable_Pragma
      --  A_Shared_Passive_Pragma
      --  A_Suppress_Pragma
      --  A_Task_Dispatching_Policy_Pragma
      --  A_Volatile_Pragma
      --  A_Volatile_Components_Pragma
      --  An_Implementation_Defined_Pragma
      An_Unknown_Pragma       =>         No_Search'Access,

      A_Defining_Identifier => Defining_Identifier_Beginning'Access,

      A_Defining_Character_Literal ..
      --  A_Defining_Enumeration_Literal
      --  A_Defining_Or_Operator
      --  A_Defining_Xor_Operator
      --  A_Defining_Equal_Operator
      --  A_Defining_Not_Equal_Operator
      --  A_Defining_Less_Than_Operator
      --  A_Defining_Less_Than_Or_Equal_Operator
      --  A_Defining_Greater_Than_Operator
      --  A_Defining_Greater_Than_Or_Equal_Operator
      --  A_Defining_Plus_Operator
      --  A_Defining_Minus_Operator
      --  A_Defining_Concatenate_Operator
      --  A_Defining_Unary_Plus_Operator
      --  A_Defining_Unary_Minus_Operator
      --  A_Defining_Multiply_Operator
      --  A_Defining_Divide_Operator
      --  A_Defining_Mod_Operator
      --  A_Defining_Rem_Operator
      --  A_Defining_Exponentiate_Operator
      --  A_Defining_Abs_Operator
      A_Defining_Not_Operator =>         No_Search'Access,

      A_Defining_Expanded_Name =>        Search_Prefix_Beginning'Access,

      An_Ordinary_Type_Declaration ..
      --  A_Task_Type_Declaration
      --  A_Protected_Type_Declaration
      --  An_Incomplete_Type_Declaration
      --  A_Private_Type_Declaration
      --  A_Private_Extension_Declaration
      --  A_Subtype_Declaration
      --  A_Variable_Declaration
      --  A_Constant_Declaration
      --  A_Deferred_Constant_Declaration
      --  A_Single_Task_Declaration
      --  A_Single_Protected_Declaration
      --  An_Integer_Number_Decl
      --  A_Real_Number_Declaration
      --  An_Enumeration_Literal_Specification
      A_Discriminant_Specification =>    No_Search'Access,

      A_Component_Declaration =>
                         Component_And_Parameter_Declaration_Beginning'Access,

      A_Loop_Parameter_Specification => No_Search'Access,

--  --|A2012 start
      A_Generalized_Iterator_Specification => No_Search'Access,  --  ???
      An_Element_Iterator_Specification    => No_Search'Access,  --  ???
--  --|A2012 end

      A_Procedure_Declaration ..
      A_Function_Declaration =>          Subprogram_Spec_Beginning'Access,

--  --|A2005 start
      A_Null_Procedure_Declaration =>        Subprogram_Spec_Beginning'Access,
--  --|A2005 end

--  --|A2012 start
      An_Expression_Function_Declaration => Subprogram_Spec_Beginning'Access,
--  --|A2012 end

      A_Parameter_Specification =>
                         Component_And_Parameter_Declaration_Beginning'Access,

      A_Procedure_Body_Declaration ..
      A_Function_Body_Declaration => Subprogram_Spec_Beginning'Access,

      A_Package_Declaration ..
      --  A_Package_Body_Declaration
      --  An_Object_Renaming_Declaration
      --  An_Exception_Renaming_Declaration
      A_Package_Renaming_Declaration =>  No_Search'Access,

      A_Procedure_Renaming_Declaration => Subprogram_Spec_Beginning'Access,
      A_Function_Renaming_Declaration  => Subprogram_Spec_Beginning'Access,

      A_Generic_Package_Renaming_Declaration ..
      --  A_Generic_Procedure_Renaming_Declaration
      --  A_Generic_Function_Renaming_Declaration
      --  A_Task_Body_Declaration
      A_Protected_Body_Declaration =>  No_Search'Access,

      An_Entry_Declaration => Possible_Overriding_Indicator_Beginning'Access,

      An_Entry_Body_Declaration ..
      An_Entry_Index_Specification => No_Search'Access,

      A_Procedure_Body_Stub ..
      A_Function_Body_Stub    => Subprogram_Spec_Beginning'Access,

      A_Package_Body_Stub ..
      --  A_Task_Body_Stub
      A_Protected_Body_Stub =>           No_Search'Access,

      An_Exception_Declaration =>
                         Exception_Declaration_Beginning'Access,

      A_Choice_Parameter_Specification ..
      --  A_Generic_Procedure_Declaration
      --  A_Generic_Function_Declaration
      --  A_Generic_Package_Declaration
      A_Package_Instantiation => No_Search'Access,

      A_Procedure_Instantiation ..
      A_Function_Instantiation =>
        Possible_Overriding_Indicator_Beginning'Access,

      A_Formal_Object_Declaration =>
         Formal_Object_Declaration_Beginning'Access,

      A_Formal_Type_Declaration ..
      --  A_Formal_Procedure_Declaration
      --  A_Formal_Function_Declaration
      --  A_Formal_Package_Declaration
      A_Formal_Package_Declaration_With_Box =>   No_Search'Access,

      A_Derived_Type_Definition =>       Derived_Definition_Beginning'Access,

      A_Derived_Record_Extension_Definition =>
                         Derived_Definition_Beginning'Access,

      An_Enumeration_Type_Definition ..
      --  A_Signed_Integer_Type_Definition
      --  A_Modular_Type_Definition

      ---------------------------------------------------------
      --  !!! They all are implicit and cannot have image
      --  |
      --  |->  A_Root_Integer_Definition
      --  |->  A_Root_Real_Definition
      --  |->  A_Root_Fixed_Definition
      --  |->  A_Universal_Integer_Definition
      --  |->  A_Universal_Real_Definition
      --  +->  A_Universal_Fixed_Definition
      ---------------------------------------------------------

      --  A_Floating_Point_Definition
      --  An_Ordinary_Fixed_Point_Definition
      --  A_Decimal_Fixed_Point_Definition
      --  An_Unconstrained_Array_Definition
      A_Constrained_Array_Definition =>  No_Search'Access,

      A_Record_Type_Definition => Type_Definition_Beginning'Access,

      A_Tagged_Record_Type_Definition =>
         Tagged_Type_Definition_Beginning'Access,

--  --|A2005 start

      An_Ordinary_Interface ..
      --  A_Limited_Interface,
      --  A_Task_Interface,
      --  A_Protected_Interface,
      A_Synchronized_Interface => Interface_Definition_Beginning'Access,
--  --|A2005 end

      A_Pool_Specific_Access_To_Variable ..
      --  An_Access_To_Variable
      --  An_Access_To_Constant
      --  An_Access_To_Procedure
      --  An_Access_To_Protected_Procedure
      --  An_Access_To_Function
      An_Access_To_Protected_Function =>  No_Search'Access,
      A_Subtype_Indication      =>  Search_Subtype_Indication_Beginning'Access,

      A_Range_Attribute_Reference =>     Search_Prefix_Beginning'Access,

      A_Simple_Expression_Range => Simple_Expression_Range_Beginning'Access,

      A_Digits_Constraint ..
      --  A_Delta_Constraint
      --  An_Index_Constraint
      A_Discriminant_Constraint =>       No_Search'Access,

      A_Component_Definition =>          Component_Definition_Beginning'Access,

      A_Discrete_Subtype_Indication_As_Subtype_Definition =>
        Search_Subtype_Indication_Beginning'Access,

      A_Discrete_Range_Attribute_Reference_As_Subtype_Definition =>
         Search_Prefix_Beginning'Access,

      A_Discrete_Simple_Expression_Range_As_Subtype_Definition =>
         Simple_Expression_Range_Beginning'Access,

      A_Discrete_Subtype_Indication =>
        Search_Subtype_Indication_Beginning'Access,

      A_Discrete_Range_Attribute_Reference => Search_Prefix_Beginning'Access,

      A_Discrete_Simple_Expression_Range =>
         Simple_Expression_Range_Beginning'Access,

      An_Unknown_Discriminant_Part ..
      A_Known_Discriminant_Part =>       Search_Left_Parenthesis_After'Access,

      A_Record_Definition ..
      A_Null_Record_Definition =>                No_Search'Access,

      A_Null_Component => Null_Component_Beginning'Access,

      A_Variant_Part ..
      --  A_Variant
      An_Others_Choice =>                No_Search'Access,

--  --|A2005 start
      An_Anonymous_Access_To_Variable ..
      --  An_Anonymous_Access_To_Constant,
      --  An_Anonymous_Access_To_Procedure,
      --  An_Anonymous_Access_To_Protected_Procedure,
      --  An_Anonymous_Access_To_Function,
      An_Anonymous_Access_To_Protected_Function =>
        Possible_Null_Exclusion_Beginning'Access,
--  --|A2005 end

      A_Private_Type_Definition =>   Private_Type_Definition_Beginning'Access,

      A_Tagged_Private_Type_Definition =>
         Private_Type_Definition_Beginning'Access,

      A_Private_Extension_Definition =>
         Private_Extension_Definition_Beginning'Access,

      A_Task_Definition =>               No_Search'Access,

      A_Protected_Definition =>          No_Search'Access,

      A_Formal_Private_Type_Definition =>
         Private_Type_Definition_Beginning'Access,

      A_Formal_Tagged_Private_Type_Definition =>
         Private_Type_Definition_Beginning'Access,

      A_Formal_Derived_Type_Definition => Derived_Definition_Beginning'Access,

      A_Formal_Discrete_Type_Definition => No_Search'Access,

      A_Formal_Signed_Integer_Type_Definition ..
      --  A_Formal_Modular_Type_Definition
      --  A_Formal_Floating_Point_Definition
      --  A_Formal_Ordinary_Fixed_Point_Definition
      A_Formal_Decimal_Fixed_Point_Definition => No_Search'Access,

      A_Formal_Ordinary_Interface ..
--      A_Formal_Limited_Interface
--      A_Formal_Task_Interface
--      A_Formal_Protected_Interface
      A_Formal_Synchronized_Interface => Interface_Definition_Beginning'Access,

      A_Formal_Unconstrained_Array_Definition ..
      --  A_Formal_Constrained_Array_Definition
      --  A_Formal_Pool_Specific_Access_To_Variable
      --  A_Formal_Access_To_Variable
      --  A_Formal_Access_To_Constant
      --  A_Formal_Access_To_Procedure
      --  A_Formal_Access_To_Protected_Procedure
      --  A_Formal_Access_To_Function
      A_Formal_Access_To_Protected_Function => No_Search'Access,

      An_Aspect_Specification => No_Search'Access,

      An_Integer_Literal ..
      --  A_Real_Literal
      A_String_Literal =>   No_Search'Access,

      An_Identifier    =>  Search_Identifier_Beginning'Access,

      An_And_Operator ..
      --  An_Or_Operator
      --  An_Xor_Operator
      --  An_Equal_Operator
      --  A_Not_Equal_Operator
      --  A_Less_Than_Operator
      --  A_Less_Than_Or_Equal_Operator
      --  A_Greater_Than_Operator
      --  A_Greater_Than_Or_Equal_Operator
      --  A_Plus_Operator
      --  A_Minus_Operator
      --  A_Concatenate_Operator
      --  A_Unary_Plus_Operator
      --  A_Unary_Minus_Operator
      --  A_Multiply_Operator
      --  A_Divide_Operator
      --  A_Mod_Operator
      --  A_Rem_Operator
      --  An_Exponentiate_Operator
      --  An_Abs_Operator
      --  A_Not_Operator
      --  A_Character_Literal
      An_Enumeration_Literal =>          No_Search'Access,

      An_Explicit_Dereference =>         Explicit_Dereference_Beginning'Access,

      A_Function_Call =>                 Function_Call_Beginning'Access,

      An_Indexed_Component =>            Indexed_Component_Beginning'Access,
      A_Slice              =>            Indexed_Component_Beginning'Access,

      A_Selected_Component ..
      --  An_Access_Attribute
      --  An_Address_Attribute
      --  An_Adjacent_Attribute
      --  An_Aft_Attribute
      --  An_Alignment_Attribute
      --  A_Base_Attribute
      --  A_Bit_Order_Attribute
      --  A_Body_Version_Attribute
      --  A_Callable_Attribute
      --  A_Caller_Attribute
      --  A_Ceiling_Attribute
      --  A_Class_Attribute
      --  A_Component_Size_Attribute
      --  A_Compose_Attribute
      --  A_Constrained_Attribute
      --  A_Copy_Sign_Attribute
      --  A_Count_Attribute
      --  A_Definite_Attribute
      --  A_Delta_Attribute
      --  A_Denorm_Attribute
      --  A_Digits_Attribute
      --  An_Exponent_Attribute
      --  An_External_Tag_Attribute
      --  A_First_Attribute
      --  A_First_Bit_Attribute
      --  A_Floor_Attribute
      --  A_Fore_Attribute
      --  A_Fraction_Attribute
      --  An_Identity_Attribute
      --  An_Image_Attribute
      --  An_Input_Attribute
      --  A_Last_Attribute
      --  A_Last_Bit_Attribute
      --  A_Leading_Part_Attribute
      --  A_Length_Attribute
      --  A_Machine_Attribute
      --  A_Machine_Emax_Attribute
      --  A_Machine_Emin_Attribute
      --  A_Machine_Mantissa_Attribute
      --  A_Machine_Overflows_Attribute
      --  A_Machine_Radix_Attribute
      --  A_Machine_Rounds_Attribute
      --  A_Max_Attribute
      --  A_Max_Size_In_Storage_Elements_Attribute
      --  A_Min_Attribute
      --  A_Model_Attribute
      --  A_Model_Emin_Attribute
      --  A_Model_Epsilon_Attribute
      --  A_Model_Mantissa_Attribute
      --  A_Model_Small_Attribute
      --  A_Modulus_Attribute
      --  An_Output_Attribute
      --  A_Partition_ID_Attribute
      --  A_Pos_Attribute
      --  A_Position_Attribute
      --  A_Pred_Attribute
      --  A_Range_Attribute
      --  A_Read_Attribute
      --  A_Remainder_Attribute
      --  A_Round_Attribute
      --  A_Rounding_Attribute
      --  A_Safe_First_Attribute
      --  A_Safe_Last_Attribute
      --  A_Scale_Attribute
      --  A_Scaling_Attribute
      --  A_Signed_Zeros_Attribute
      --  A_Size_Attribute
      --  A_Small_Attribute
      --  A_Storage_Pool_Attribute
      --  A_Storage_Size_Attribute
      --  A_Succ_Attribute
      --  A_Tag_Attribute
      --  A_Terminated_Attribute
      --  A_Truncation_Attribute
      --  An_Unbiased_Rounding_Attribute
      --  An_Unchecked_Access_Attribute
      --  A_Val_Attribute
      --  A_Valid_Attribute
      --  A_Value_Attribute
      --  A_Version_Attribute
      --  A_Wide_Image_Attribute
      --  A_Wide_Value_Attribute
      --  A_Wide_Width_Attribute
      --  A_Width_Attribute
      --  A_Write_Attribute
      --  An_Implementation_Defined_Attribute
      An_Unknown_Attribute =>            Search_Prefix_Beginning'Access,

      A_Record_Aggregate ..
      --  An_Extension_Aggregate
      --  An_Positional_Array_Aggregate
      A_Named_Array_Aggregate  =>                  No_Search'Access,

      An_And_Then_Short_Circuit ..
      An_Or_Else_Short_Circuit => Short_Circuit_Beginning'Access,

      An_In_Membership_Test ..
      A_Not_In_Membership_Test  => Membership_Test_Beginning'Access,

      A_Null_Literal =>                  No_Search'Access,

      A_Parenthesized_Expression =>
         Parenthesized_Expression_Beginning'Access,

      A_Type_Conversion =>               Search_Prefix_Beginning'Access,

      A_Qualified_Expression =>          Search_Prefix_Beginning'Access,

      An_Allocation_From_Subtype     => No_Search'Access,
      An_Allocation_From_Qualified_Expression => No_Search'Access,
--  --|A2012 start
      A_Case_Expression              => No_Search'Access,
      An_If_Expression               => If_Expression_Beginning'Access,
--  --|A2012 end
      A_Pragma_Argument_Association  => Association_Beginning'Access,
      A_Discriminant_Association     => Association_Beginning'Access,
      A_Record_Component_Association => Component_Association_Beginning'Access,

      An_Array_Component_Association => Component_Association_Beginning'Access,

      A_Parameter_Association       =>  Association_Beginning'Access,
      A_Generic_Association         =>  No_Search'Access,
      A_Null_Statement =>                No_Search'Access,

      An_Assignment_Statement =>         Assignment_Statement_Beginning'Access,

      An_If_Statement =>                 No_Search'Access,

      A_Case_Statement =>                No_Search'Access,

      A_Loop_Statement =>                Named_Statement_Beginning'Access,

      A_While_Loop_Statement =>          While_Loop_Statement_Beginning'Access,

      A_For_Loop_Statement =>            For_Loop_Statement_Beginning'Access,

      A_Block_Statement =>               Named_Statement_Beginning'Access,

      An_Exit_Statement =>   No_Search'Access,
      A_Goto_Statement  =>   No_Search'Access,

      A_Procedure_Call_Statement => Call_Statement_Beginning'Access,

      A_Return_Statement  => No_Search'Access,
      An_Accept_Statement => No_Search'Access,

      An_Entry_Call_Statement =>  Call_Statement_Beginning'Access,

      A_Requeue_Statement ..
      --  A_Requeue_Statement_With_Abort
      --  A_Delay_Until_Statement
      --  A_Delay_Relative_Statement
      --  A_Terminate_Alternative_Statement
      --  A_Selective_Accept_Statement
      --  A_Timed_Entry_Call_Statement
      --  A_Conditional_Entry_Call_Statement
      --  An_Asynchronous_Select_Statement
      --  An_Abort_Statement
      --  A_Raise_Statement
      --  A_Code_Statement

      --  An_If_Path
      --  NOTE: There is no explicit node in GNAT AST tree corresponding to
      --  this Internal_Element_Kind's. It's supposed that corresponding
      --  Element's record field contains Source_Ptr type value that points to
      --  word IF.
      --  If it isn't so, we should change this part.
      --  I believe it's more correct to have A_Then_Path in spite of
      --  An_If_Path which should point to the word THEN.

      An_Elsif_Path => No_Search'Access,
      An_Else_Path  => Else_Path_Beginning'Access,
      A_Case_Path   => No_Search'Access,

      A_Select_Path ..
      --  NOTE: There is no explicit node in GNAT AST tree corresponding to
      --        this Internal_Element_Kind's. It's supposed that corresponding
      --        Element's record field contains Source_Ptr type value that
      --        points to word SELECT.
      --       If it isn't so, we should change this part.

      An_Or_Path => Select_Alternative_Beginning'Access,
      --  NOTE: There is no explicit node in GNAT AST tree corresponding to
      --  this Internal_Element_Kind's. It's supposed that corresponding
      --  Element's record field contains Source_Ptr type value that points to
      --  word OR. If it isn't so, we should change this part.

      A_Then_Abort_Path => A_Then_Abort_Path_Beginning'Access,

--  --|A2015 start
      A_Case_Expression_Path   => Case_Expression_Path_Beginning'Access,

      An_If_Expression_Path ..
      An_Elsif_Expression_Path => Conditional_Expression_Path_Beginning'Access,

      An_Else_Expression_Path => An_Else_Expression_Path_Beginning'Access,
--  --|A2015 end

      A_Use_Package_Clause ..
      --  A_Use_Type_Clause
      A_Use_All_Type_Clause =>  No_Search'Access,  --  Ada 2012

      A_With_Clause =>                   With_Clause_Beginning'Access,

      An_Attribute_Definition_Clause ..
      --  An_Enumeration_Representation_Clause
      --  A_Record_Representation_Clause
      An_At_Clause =>                    No_Search'Access,

      A_Component_Clause =>              Component_Clause_Beginning'Access,

      An_Exception_Handler =>            No_Search'Access,

      others => No_Search'Access);

end A4G.Span_Beginning;

Add the ASIS file $i

Add the ASIS file $i