------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--          A S I S . D A T A _ D E C O M P O S I T I O N . A U X           --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            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).                                                --
--                                                                          --
------------------------------------------------------------------------------

with Asis.Declarations; use Asis.Declarations;
with Asis.Definitions;  use Asis.Definitions;
with Asis.Elements;     use Asis.Elements;
with Asis.Expressions;  use Asis.Expressions;
with Asis.Extensions;   use Asis.Extensions;
with Asis.Iterator;     use Asis.Iterator;

with Asis.Set_Get;      use Asis.Set_Get;

with A4G.DDA_Aux;       use A4G.DDA_Aux;

with Atree;             use Atree;
with Einfo;             use Einfo;
with Elists;            use Elists;
with Sinfo;             use Sinfo;
with Uintp;             use Uintp;

package body Asis.Data_Decomposition.Aux is

   -----------------------
   -- Local subprograms --
   -----------------------

   function Build_Discrim_List_From_Constraint
     (Rec :  Entity_Id)
      return Discrim_List;
   --  Given a record entiti which has discriminants, returns a list
   --  of discriminant values obtained from teh discriminant constraint or,
   --  if there is no constraint, from default discriminant values.
   --  Null_Discrims is returned in case if there is no constraint and no
   --  default values for discriminants. Raises Variable_Rep_Info
   --  if there is a default value which is not a static expression.

   function Elist_Len (List : Elist_Id) return Int;
   --  Computes the length of Entity list. 0 i sreturned in case if No (List).

   function Is_Static_Constraint (Discr_Constr : Elist_Id) return Boolean;
   --  Provided that Discr_Constr is obtained as Discriminant_Constraint
   --  attribute of some type entity, checks if all the constraints are static

   function Is_Empty_Record (Rec_Type_Def : Element) return Boolean;
   --  Supposes Rec_Type_Def to be of A_Record_Type_Definition kind. Checks
   --  if it defines a record type with no non-discriminant components

   ----------------------------------------
   -- Build_Discrim_List_From_Constraint --
   ----------------------------------------

   function Build_Discrim_List_From_Constraint
     (Rec :  Entity_Id)
      return Discrim_List
   is
      Constraint  : constant Elist_Id := Discriminant_Constraint (Rec);
      Res_Len     : constant Int      := Elist_Len (Constraint);
      Result      : Discrim_List (1 .. Res_Len);
      Next_Constr : Elmt_Id;
      Next_Expr   : Node_Id;
   begin

      Next_Constr := First_Elmt (Constraint);

      for J in 1 .. Res_Len loop
         Next_Expr := Node (Next_Constr);

         if Nkind (Next_Expr) = N_Discriminant_Association then
            Next_Expr := Sinfo.Expression (Next_Expr);
         end if;

         Result (J) := Eval_Scalar_Node (Next_Expr);
         Next_Constr := Next_Elmt (Next_Constr);
      end loop;

      return Result;

   end Build_Discrim_List_From_Constraint;

   ------------------------------------------
   -- Build_Discrim_List_If_Data_Presented --
   ------------------------------------------

   function Build_Discrim_List_If_Data_Presented
     (Rec          : Entity_Id;
      Data         : Asis.Data_Decomposition.Portable_Data;
      Ignore_Discs : Boolean := False)
      return         Discrim_List
   is
   begin
      if Data /= Nil_Portable_Data then
         return Build_Discrim_List (Rec, Data);

      elsif not Ignore_Discs and then
            Has_Discriminants (Rec)
      then
         --  Here we have the situation when the record type has
         --  discriminants, but no data stream is provided. Thit means, that
         --  we have to use the default values for discriminants

         return Build_Discrim_List_From_Constraint (Rec);
      else
         return Null_Discrims;
      end if;

   end Build_Discrim_List_If_Data_Presented;

   -------------------------------
   -- Component_Type_Definition --
   -------------------------------

   function Component_Type_Definition (E : Element) return Element is
      Result : Element := Nil_Element;
   begin
      case Int_Kind (E) is
         when A_Component_Declaration =>
            Result := Object_Declaration_View (E);
            Result := Component_Subtype_Indication (Result);
         when A_Subtype_Indication =>
            Result := E;
         when others =>
            pragma Assert (False);
            null;
      end case;

      Result := Asis.Definitions.Subtype_Mark (Result);

      if Int_Kind (Result) = A_Selected_Component then
         Result := Selector (Result);
      end if;

      Result := Corresponding_Name_Declaration (Result);

      Result := Corresponding_First_Subtype (Result);

      Result := Type_Declaration_View (Result);

      return Result;

   end Component_Type_Definition;

   ---------------------------
   -- Constraint_Model_Kind --
   ---------------------------

   function Constraint_Model_Kind
     (C    : Element)
      return Constraint_Model_Kinds
   is
      Arg_Kind : constant Internal_Element_Kinds := Int_Kind (C);
      Result   : Constraint_Model_Kinds := Static_Constraint;
      --  We start from the most optimistic assumption

      Control : Traverse_Control := Continue;

      procedure Analyze_Constraint
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Constraint_Model_Kinds);
      --  Checks the individual constraint and its components. Used as
      --  Pre-Operation

      procedure No_Op
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Constraint_Model_Kinds);
      --  Placeholder for Post-Operation

      procedure Traverse_Constraint is new Traverse_Element (
         State_Information => Constraint_Model_Kinds,
         Pre_Operation     => Analyze_Constraint,
         Post_Operation    => No_Op);

      ------------------------
      -- Analyze_Constraint --
      -------------------------

      procedure Analyze_Constraint
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Constraint_Model_Kinds)
      is
         Arg_Kind : constant Internal_Element_Kinds := Int_Kind (Element);
         Tmp_El   : Asis.Element;
         Tmp_Node : Node_Id;
      begin

         if Arg_Kind = An_Identifier
           and then
            Int_Kind (Enclosing_Element (Element)) =
               A_Discriminant_Association
           and then
            not Is_Equal (Element,
                          Discriminant_Expression
                            (Enclosing_Element (Element)))
         then
            --  If we are here, Element is from discriminant selector names
            return;
         end if;

         case Arg_Kind is

            when A_Discrete_Subtype_Indication =>

               if Is_Nil (Subtype_Constraint (Element)) then
                  --  If we are here then we have a range constraint. Let's try
                  --  to get the information directly from the tree (starting
                  --  from the overpessimistic assumption).

                  State  := External;
                  Tmp_El := Asis.Definitions.Subtype_Mark (Element);

                  if Expression_Kind (Tmp_El) = An_Attribute_Reference then
                     --  We are overpessimistic in this rather unusial case:
                     Control := Terminate_Immediately;
                     return;
                  end if;

                  Tmp_Node := R_Node (Tmp_El);
                  Tmp_Node := Entity (Tmp_Node);

                  if Present (Tmp_Node) then
                     Tmp_Node := Scalar_Range (Tmp_Node);

                     if Is_Static_Expression (Low_Bound (Tmp_Node))
                       and then
                        Is_Static_Expression (High_Bound (Tmp_Node))
                     then
                        State := Static_Constraint;
                     end if;

                  end if;

                  Control := Terminate_Immediately;
               end if;

            when A_Discrete_Range_Attribute_Reference =>

               if Is_Static (Element) then
                  Control := Abandon_Children;
               else
                  State   := External;
                  Control := Terminate_Immediately;
               end if;

            when Internal_Expression_Kinds =>
               if Is_True_Expression (Element) then

                  if Is_Static (Element) then
                     --  Nothing to do, no need to change State
                     Control := Abandon_Children;
                  else

                     if Arg_Kind = An_Identifier and then
                        Int_Kind (Corresponding_Name_Declaration (Element)) =
                           A_Discriminant_Specification
                     then
                        --  See RM 95 3.8(12)
                        State   := Discriminated;
                        Control := Abandon_Children;
                     else
                        --  Completely dinamic situation for sure
                        State   := External;
                        Control := Terminate_Immediately;
                     end if;

                  end if;

               else
                  --  The only possibility for those Elements which are in
                  --  Internal_Expression_Kinds, but are not
                  --  Is_True_Expression is a type mark, and we do not have to
                  --  analyze it
                  Control := Abandon_Children;
               end if;

            when An_Index_Constraint                |
                 A_Discriminant_Constraint          |
                 A_Discrete_Simple_Expression_Range |
                 A_Discriminant_Association         |
                 A_Simple_Expression_Range =>

               --  Just go down:
               null;

            when others =>
               pragma Assert (False);
               null;
         end case;

      end Analyze_Constraint;

      -----------
      -- No_Op --
      -----------

      procedure No_Op
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Constraint_Model_Kinds)
      is
      begin
         pragma Unreferenced (Element);
         pragma Unreferenced (Control);
         pragma Unreferenced (State);

         null;
      end No_Op;

   begin

      if Arg_Kind = An_Index_Constraint or else
         Arg_Kind = A_Discriminant_Constraint
      then
         Traverse_Constraint
           (Element => C,
            Control => Control,
            State   => Result);
      end if;

      return Result;

   end Constraint_Model_Kind;

   ---------------------
   -- De_Linear_Index --
   ---------------------

   function De_Linear_Index
     (Index       : Asis.ASIS_Natural;
      D           : ASIS_Natural;
      Ind_Lengths : Dimention_Length;
      Conv        : Convention_Id := Convention_Ada)
      return        Dimension_Indexes
   is
      Len     : Asis.ASIS_Natural := 1;
      Tmp_Ind : Asis.ASIS_Natural := Index;
      Tmp_Res : Asis.ASIS_Natural;
      Result  : Dimension_Indexes (1 .. D);
   begin

      for J in 1 .. D loop
         Len := Len * Ind_Lengths (J);
      end loop;

      --   Len can never be 0, because this function can never be called
      --   for an empty array

      --  For the normal case, we are row major

      if Conv /= Convention_Fortran then

         for J in Result'Range loop
            Len := Len / Ind_Lengths (J);

            Tmp_Res := Tmp_Ind / Len;

            if Tmp_Res * Len < Tmp_Ind then
               Tmp_Res := Tmp_Res + 1;
            end if;

            Result (J) := Tmp_Res;

            Tmp_Ind := Tmp_Ind - Len * (Result (J) - 1);
         end loop;

      --  For Fortran, we are column major

      else

         for J in reverse Result'Range loop
            Len := Len / Ind_Lengths (J);

            Tmp_Res := Tmp_Ind / Len;

            if Tmp_Res * Len < Tmp_Ind then
               Tmp_Res := Tmp_Res + 1;
            end if;

            Result (J) := Tmp_Res;

            Tmp_Ind := Tmp_Ind - Len * (Result (J) - 1);
         end loop;

      end if;

      return Result;
   end De_Linear_Index;

   --------------------------------------------
   -- Discriminant_Part_From_Type_Definition --
   --------------------------------------------

   function Discriminant_Part_From_Type_Definition
     (T    : Element)
      return Element
   is
      Type_Entity   : Node_Id;
      Tmp_Element   : Element;
      Result        : Element := Nil_Element;
   begin

      Type_Entity := R_Node (T);

      if Nkind (Type_Entity) /= N_Private_Type_Declaration then
         Type_Entity := Parent (Type_Entity);
      end if;

      Type_Entity := Sinfo.Defining_Identifier (Type_Entity);

      if Einfo.Has_Discriminants (Type_Entity) then

         Result := Enclosing_Element (T);

         Result := Discriminant_Part (Result);

         if Is_Nil (Result) then
            --  Here we already know, that the type defined by T has
            --  discriminants. The only possibility is that it is derived
            --  from a type with known discriminant part. So we have to
            --  traverse backward the derivation chain and return the first
            --  known discriminant part found
            Tmp_Element := Corresponding_Parent_Subtype (T);
            Tmp_Element := Corresponding_First_Subtype (Tmp_Element);

            loop
               Result := Discriminant_Part (Tmp_Element);

               exit when not Is_Nil (Result);

               Tmp_Element := Type_Declaration_View (Tmp_Element);
               Tmp_Element := Corresponding_Parent_Subtype (Tmp_Element);
               Tmp_Element := Corresponding_First_Subtype (Tmp_Element);

            end loop;

         end if;

      end if;

      return Result;

   end Discriminant_Part_From_Type_Definition;

   ---------------
   -- Elist_Len --
   ---------------

   function Elist_Len (List : Elist_Id) return Int is
      Result  : Int := 0;
      Next_El : Elmt_Id;
   begin

      if Present (List) then
         Next_El := First_Elmt (List);

         while Present (Next_El) loop
            Result  := Result + 1;
            Next_El := Next_Elmt (Next_El);
         end loop;

      end if;

      return Result;
   end Elist_Len;

   ----------------------------
   -- Is_Derived_From_Record --
   ----------------------------

   function Is_Derived_From_Record (TD : Element) return Boolean is
      Result           : Boolean := False;
      Type_Entity_Node : Node_Id;
   begin

      if Int_Kind (TD) = A_Derived_Type_Definition then
         Type_Entity_Node := R_Node (TD);
         Type_Entity_Node := Defining_Identifier (Parent (Type_Entity_Node));
         Result := Is_Record_Type (Type_Entity_Node);
      end if;

      return Result;
   end Is_Derived_From_Record;

   ---------------------------
   -- Is_Derived_From_Array --
   ---------------------------

   function Is_Derived_From_Array (TD : Element) return Boolean is
      Result           : Boolean := False;
      Type_Entity_Node : Node_Id;
   begin

      if Int_Kind (TD) = A_Derived_Type_Definition then
         Type_Entity_Node := R_Node (TD);
         Type_Entity_Node := Defining_Identifier (Parent (Type_Entity_Node));
         Result := Is_Array_Type (Type_Entity_Node);
      end if;

      return Result;
   end Is_Derived_From_Array;

   ---------------------
   -- Is_Empty_Record --
   ---------------------

   function Is_Empty_Record (Rec_Type_Def : Element) return Boolean is
      Result   : Boolean          := False;
      Arg_Node : constant Node_Id := R_Node (Rec_Type_Def);

   begin
      if Null_Present (Arg_Node) or else
         Null_Present (Component_List (Arg_Node))
      then
         Result := True;
      end if;

      return Result;
   end Is_Empty_Record;

   --------------------------
   -- Is_Static_Constraint --
   --------------------------

   function Is_Static_Constraint (Discr_Constr : Elist_Id) return Boolean is
      Result  : Boolean := True;
      Next_DA : Elmt_Id;
   begin
      Next_DA := First_Elmt (Discr_Constr);

      while Present (Next_DA) loop

         if not Is_Static_Expression (Node (Next_DA)) then
            Result := False;
            exit;
         end if;

         Next_DA := Next_Elmt (Next_DA);
      end loop;

      return Result;

   end Is_Static_Constraint;

   ------------------
   -- Linear_Index --
   ------------------

   function Linear_Index
     (Inds        : Dimension_Indexes;
      Ind_Lengths : Dimention_Length;
      Conv        : Convention_Id := Convention_Ada)
      return        Asis.ASIS_Natural
   is
      Indx : Asis.ASIS_Natural := 0;
   begin
      --  For the normal case, we are row major

      if Conv /= Convention_Fortran then
         for J in Inds'Range loop
            Indx := Indx * Ind_Lengths (J) + Inds (J) - 1;
         end loop;

      --  For Fortran, we are column major

      else
         for J in reverse Inds'Range loop
            Indx := Indx * Ind_Lengths (J) + Inds (J) - 1;
         end loop;
      end if;

      return Indx + 1;
   end Linear_Index;

   -------------
   -- Max_Len --
   -------------

   function Max_Len (Component : Array_Component) return Asis.ASIS_Natural is
      Result : Asis.ASIS_Natural;
   begin
      if Component.Length (1) = 0 then
         --  the case of an empty array
         return 0;
      else
         Result := 1;
      end if;

      for J in Component.Length'Range loop
         exit when Component.Length (J) = 0;
         Result := Result * Component.Length (J);
      end loop;

      return Result;

   end Max_Len;

   -----------------------
   -- Record_Model_Kind --
   -----------------------

   function Record_Model_Kind (R : Element) return Type_Model_Kinds is
      Type_Entity : Node_Id;
      Result      : Type_Model_Kinds := Not_A_Type_Model;

      Control : Traverse_Control := Continue;

      procedure Analyze_Component_Definition
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Type_Model_Kinds);
      --  Checks the individual component definition. Used as Pre-Operation.

      procedure No_Op
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Type_Model_Kinds);
      --  Placeholder for Post-Operation

      procedure Traverse_Record_Definition is new Traverse_Element (
         State_Information => Type_Model_Kinds,
         Pre_Operation     => Analyze_Component_Definition,
         Post_Operation    => No_Op);

      ----------------------------------
      -- Analyze_Component_Definition --
      ----------------------------------

      procedure Analyze_Component_Definition
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Type_Model_Kinds)
      is
      begin

         pragma Unreferenced (State);

         if Int_Kind (Element) = A_Component_Declaration then

            case Subtype_Model_Kind
                   (Component_Subtype_Indication
                      (Object_Declaration_View (Element)))
            is

               when A_Simple_Static_Model | A_Simple_Dynamic_Model =>
                  Control := Abandon_Children;

               when A_Complex_Dynamic_Model =>
                  Result  := A_Complex_Dynamic_Model;
                  Control := Terminate_Immediately;

               when Not_A_Type_Model =>
                  Result  := Not_A_Type_Model;
                  Control := Terminate_Immediately;

            end case;

         end if;

      end Analyze_Component_Definition;

      -----------
      -- No_Op --
      -----------

      procedure No_Op
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out Type_Model_Kinds)
      is
      begin
         pragma Unreferenced (Element);
         pragma Unreferenced (Control);
         pragma Unreferenced (State);

         null;
      end No_Op;

   begin
      Type_Entity := R_Node (Enclosing_Element (R));
      Type_Entity := Sinfo.Defining_Identifier (Type_Entity);

      if Is_Empty_Record (R)
        or else
         (not (Has_Discriminants (Type_Entity)
            and then
             not Is_Constrained (Type_Entity))
        and then
          (RM_Size (Type_Entity) > 0))
      then
         Result := A_Simple_Static_Model;

      elsif RM_Size (Type_Entity) = Uint_0 or else
            RM_Size (Type_Entity) = No_Uint
      then
         --  This is the case when the front-end consider the type to be
         --  essentially dynamic and therefore it can not set Esize field
         --  at all
         Result := A_Complex_Dynamic_Model;

      else
         --  We start from the most optimistic assumption
         Result := A_Simple_Dynamic_Model;

         Traverse_Record_Definition
           (Element => R,
            Control => Control,
            State   => Result);

      end if;

      return Result;
   end Record_Model_Kind;

   ---------------------------
   -- Root_Array_Definition --
   ---------------------------

   function Root_Array_Definition  (Type_Def : Element) return Element is
      Result : Element := Type_Def;
   begin

      if Is_Derived_From_Array (Type_Def) then
         Result := Corresponding_Root_Type (Type_Def);
         Result := Type_Declaration_View (Result);
      end if;

      return Result;

   end Root_Array_Definition;

   ----------------------------
   -- Root_Record_Definition --
   ----------------------------

   function Root_Record_Definition (Type_Def : Element) return Element is
      Result : Element := Type_Def;
   begin

      if Is_Derived_From_Record (Type_Def) then
         Result := Corresponding_Root_Type (Type_Def);
         Result := Type_Declaration_View (Result);
      end if;

      return Result;

   end Root_Record_Definition;

   --------------------
   -- Subtype_Entity --
   --------------------

   function Subtype_Entity (E : Element) return Entity_Id is
      Result   : Node_Id   := Node (E);
      Res_Kind : Node_Kind := Nkind (Result);
   begin

      while Present (Result) and then
            not (Res_Kind = N_Subtype_Declaration     or else
                 Res_Kind = N_Object_Declaration      or else
                 Res_Kind = N_Derived_Type_Definition or else
                 Res_Kind = N_Full_Type_Declaration   or else
                 Res_Kind = N_Component_Declaration)
      loop
         Result   := Parent (Result);
         Res_Kind := Nkind (Result);
      end loop;

      pragma Assert (Present (Result));

      case Res_Kind is
         when N_Subtype_Declaration =>
            Result := Defining_Identifier (Result);

         when N_Object_Declaration | N_Component_Declaration =>
            Result := Etype (Defining_Identifier (Result));

         when N_Derived_Type_Definition =>
            Result := Defining_Identifier (Parent (Result));

         when N_Full_Type_Declaration =>
            --  Here we are expecting the component subtype definition from
            --  array type declaration as the only possible case
            Result := Defining_Identifier (Result);

            pragma Assert (Is_Array_Type (Result));

            Result := Component_Type (Result);

         when others =>
            null;
      end case;

      return Result;

   end Subtype_Entity;

   ------------------------
   -- Subtype_Model_Kind --
   ------------------------

   function Subtype_Model_Kind (S : Element) return Type_Model_Kinds is
      Result         : Type_Model_Kinds := Not_A_Type_Model;

      Type_Mark_Elem : Element;
      Type_Mark_Def  : Element;
      Constr_Elem    : Element;

      Constraint_Model : Constraint_Model_Kinds := Not_A_Constraint_Model;

      Type_Entity    : Entity_Id;

   begin

      pragma Assert (Int_Kind (S) = A_Subtype_Indication);

      Type_Mark_Elem := Asis.Definitions.Subtype_Mark (S);
      Constr_Elem    := Subtype_Constraint (S);

      if Int_Kind (Type_Mark_Elem) = A_Selected_Component then
         Type_Mark_Elem := Selector (Type_Mark_Elem);
      end if;

      Type_Mark_Def := Corresponding_Name_Declaration (Type_Mark_Elem);

      if Int_Kind (Type_Mark_Def) = A_Private_Type_Declaration then
         Type_Mark_Def := Corresponding_Type_Declaration (Type_Mark_Def);
      end if;

      Type_Entity   := Sinfo.Defining_Identifier (R_Node (Type_Mark_Def));

      --  Type_Mark_Def can only be either type or subtype declaration

      Type_Mark_Def := Type_Declaration_View (Type_Mark_Def);

      case Int_Kind (Type_Mark_Def) is
         when Internal_Type_Kinds =>
            Result := Type_Model_Kind (Type_Mark_Def);

         when A_Subtype_Indication =>
            Result := Subtype_Model_Kind (Type_Mark_Def);

         when others =>
            Result := A_Complex_Dynamic_Model;
      end case;

      if Result in A_Simple_Static_Model .. A_Simple_Dynamic_Model then
         --  Here we have to chech if the constraint (if any) affects the
         --  result
         case Int_Kind (Constr_Elem) is

            when An_Index_Constraint |
                 A_Discriminant_Constraint =>
               Constraint_Model := Constraint_Model_Kind (Constr_Elem);

            when Not_An_Element =>

               if Has_Discriminants (Type_Entity)
                 and then
                 not Is_Empty_Elmt_List (Discriminant_Constraint (Type_Entity))
               then
                  --  This is the case, when a subtype indication to analyze
                  --  does not contain any explicit constraint, but
                  --  the corresponding discriminanted subtype might be
                  --  constrained by explicit constraint or default values
                  --  somewhere before in subtyping and/or derivation chain

                  if Is_Static_Constraint
                       (Discriminant_Constraint (Type_Entity))
                  then
                     Constraint_Model := Static_Constraint;
                  end if;

               end if;

            when others =>
               --  We consider, that other kinds of the constraint can not
               --  affect the result
               null;
         end case;

         case Constraint_Model is
            when External =>
               Result := A_Complex_Dynamic_Model;

            when Discriminated =>
               Result := A_Simple_Dynamic_Model;

            when Static_Constraint =>
               Result := A_Simple_Static_Model;

            when others =>
               null;
         end case;

      end if;

      return Result;

   end Subtype_Model_Kind;

   ---------------------------------------
   -- Type_Definition_From_Subtype_Mark --
   ---------------------------------------

   function Type_Definition_From_Subtype_Mark (S : Element) return Element is
      Result : Element;
   begin

      if Int_Kind (S) = A_Selected_Component then
         Result := Selector (S);
      else
         Result := S;
      end if;

      Result := Corresponding_Name_Declaration (Result);
      Result := Corresponding_First_Subtype    (Result);
      Result := Type_Declaration_View          (Result);

      return Result;
   end Type_Definition_From_Subtype_Mark;

   -------------------
   -- Wrong_Indexes --
   -------------------

   function Wrong_Indexes
     (Component : Array_Component;
      Indexes   : Dimension_Indexes)
      return Boolean
   is
      D      : constant ASIS_Natural := Component.Dimension;
      Result : Boolean               := True;
   begin

      if D = Indexes'Length then
         Result := False;

         for J in 1 .. D loop
            if Indexes (J) > Component.Length (J) then
               Result := True;
               exit;
            end if;
         end loop;
      end if;

      return Result;
   end Wrong_Indexes;

end Asis.Data_Decomposition.Aux;

Add the ASIS file $i

Add the ASIS file $i


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

--  This package contains definitions of tables and related auxilary resources
--  needed in more than one ASIS implementation package

with Asis;

with Sinfo; use Sinfo;
with Table;
with Types; use Types;

package A4G.Asis_Tables is

   package Internal_Asis_Element_Table is new Table.Table (
     Table_Component_Type => Asis.Element,
     Table_Index_Type     => Asis.ASIS_Natural,
     Table_Low_Bound      => 1,
     Table_Initial        => 10,
     Table_Increment      => 100,
     Table_Name           => "Internal Element_List");

   --  This table contains ASIS Elements. It is supposed to be used only for
   --  creating the result Element lists in ASIS structural queries. Note that
   --  many ASIS queries use instantiations of Traverse_Elements to create
   --  result lists, so we have to make sure that ASIS structural queries
   --  used in the implementation of Traverse_Element use another table to
   --  create result lists

   package Asis_Element_Table is new Table.Table (
     Table_Component_Type => Asis.Element,
     Table_Index_Type     => Asis.ASIS_Natural,
     Table_Low_Bound      => 1,
     Table_Initial        => 10,
     Table_Increment      => 100,
     Table_Name           => "Element_List");
   --  This table contains ASIS Elements. It is supposed to be used for any
   --  purpose except creating the result Element lists in ASIS structural
   --  queries.

   procedure Add_New_Element (Element : Asis.Element);
   --  Differs from Asis_Element_Table.Append that checks if the argument
   --  Element already is in the table, and appends the new element only if the
   --  check fails. Note that the implementation is based on a simple array
   --  search, so it can result in performance penalties if there are too
   --  many elements in the table.

   type Node_Trace_Rec is record
      Kind          : Node_Kind;
      Node_Line     : Physical_Line_Number;
      Node_Col      : Column_Number;
   end record;
   --  This record represents a Node in the node trace used to find the same
   --  construct in another tree

   package Node_Trace is new Table.Table (
     Table_Component_Type => Node_Trace_Rec,
     Table_Index_Type     => Int,
     Table_Low_Bound      => 0,
     Table_Initial        => 10,
     Table_Increment      => 100,
     Table_Name           => "Node_Trace");
   --  This table is used to create the node trace needed to compare elements
   --  from nested instances

   function Is_Equal
     (N         : Node_Id;
      Trace_Rec : Node_Trace_Rec)
      return      Boolean;
   --  Checks if N (in the currently accessed tree corresponds to the node
   --  for which Trace_Rec was created

   procedure Create_Node_Trace (N : Node_Id);
   --  Creates the Node trace which is supposed to be used to find the node
   --  representing the same construct in another tree. The trace is also used
   --  to check is two nodes from different trees, each belonging to expanded
   --  generics both denote the same thing. This trace contains the record
   --  about N itself and all the enclosing constructs such as package bodies
   --  and package specs. For the package which is an expanded generic, the
   --  next element in the trace is the corresponding instantiation node.

   function Enclosing_Scope (N : Node_Id) return Node_Id;
   --  Given a node somewhere from expanded generic, returnes its enclosing
   --  "scope" which can be N_Package_Declaration, N_Package_Body or
   --  N_Generic_Declaration node. The idea is to use this function to create
   --  the node trace either for storing it in the Note Trace table or for
   --  creating the trace on the fly to compare it with the stored trace.

end A4G.Asis_Tables;

Add the ASIS file $i

Add the ASIS file $i


-----------------------------------------------------------------------
--  wiki-streams-html-stream -- Generic Wiki HTML output stream
--  Copyright (C) 2016, 2020 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.Strings;

generic
   type Output_Stream is limited new Wiki.Streams.Output_Stream with private;
package Wiki.Streams.Html.Stream is

   type Html_Output_Stream is limited new Output_Stream
     and Html.Html_Output_Stream with private;

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   overriding
   procedure Write_Wide_Attribute (Stream  : in out Html_Output_Stream;
                                   Name    : in String;
                                   Content : in Wiki.Strings.UString);

   --  Write an XML attribute within an XML element.
   --  The attribute value is escaped according to the XML escape rules.
   overriding
   procedure Write_Wide_Attribute (Stream  : in out Html_Output_Stream;
                                   Name    : in String;
                                   Content : in Wide_Wide_String);

   --  Start an XML element with the given name.
   overriding
   procedure Start_Element (Stream : in out Html_Output_Stream;
                            Name   : in String);

   --  Closes an XML element of the given name.
   overriding
   procedure End_Element (Stream : in out Html_Output_Stream;
                          Name   : in String);

   --  Write a text escaping any character as necessary.
   overriding
   procedure Write_Wide_Text (Stream  : in out Html_Output_Stream;
                              Content : in Wiki.Strings.WString);

private

   type Html_Output_Stream is limited new Output_Stream
     and Html.Html_Output_Stream with record
      --  Whether an XML element must be closed (that is a '>' is necessary)
      Close_Start : Boolean := False;
   end record;

end Wiki.Streams.Html.Stream;

Refactor the HTML Text_IO stream into a generic package


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

   --  Print the prompt and a read a line from the terminal.
   --  Raise the Ada.IO_Exceptions.End_Error when the EOF is reached.
   function Get_Line (Prompt : in String) return String;

end Readline;

Define the Readline package with the Get_Line operation


Add the ASIS file $i

Add the ASIS file $i


-----------------------------------------------------------------------
--  mat-interrupts - SIGINT management to stop long running commands
--  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 Ada.Interrupts;
with Ada.Interrupts.Names;

with Util.Log.Loggers;
package body MAT.Interrupts is

   pragma Interrupt_State (Name  => Ada.Interrupts.Names.SIGINT,
                           State => USER);

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Interrupts");

   protected Interrupts is
      procedure Interrupt;
      pragma Interrupt_Handler (Interrupt);

      function Is_Interrupted return Boolean;

      procedure Clear;

   private
      Interrupted : Boolean;
   end Interrupts;

   protected body Interrupts is

      function Is_Interrupted return Boolean is
      begin
         return Interrupted;
      end Is_Interrupted;

      procedure Clear is
      begin
         Interrupted := False;
      end Clear;

      procedure Interrupt is
      begin
         Interrupted := True;
         Log.Info ("SIGINT signal received");
      end Interrupt;

   end Interrupts;

   --  ------------------------------
   --  Install the SIGINT handler.
   --  ------------------------------
   procedure Install is
   begin
      Ada.Interrupts.Attach_Handler (Interrupts.Interrupt'Access,
                                     Ada.Interrupts.Names.SIGINT);
      Log.Info ("Interrupt handler for SIGINT is installed");
   end Install;

   --  ------------------------------
   --  Reset the interrupted flag.
   --  ------------------------------
   procedure Clear is
   begin
      Interrupts.Clear;
   end Clear;

   --  ------------------------------
   --  Check if we have been interrupted.
   --  ------------------------------
   function Is_Interrupted return Boolean is
   begin
      return Interrupts.Is_Interrupted;
   end Is_Interrupted;

end MAT.Interrupts;

Implement the SIGINT interrupt handler with operations to install, check and clear the interrupt flag


-----------------------------------------------------------------------
--  security-auth-oauth -- OAuth based authentication
--  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.Log.Loggers;
with Security.OAuth.Clients;
package body Security.Auth.OAuth is

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

   --  ------------------------------
   --  OAuth Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OAuth authorization process.

   --  Initialize the authentication realm.
   overriding
   procedure Initialize (Realm     : in out Manager;
                         Params    : in Parameters'Class;
                         Provider  : in String := PROVIDER_OPENID) is
   begin
      Realm.App.Set_Application_Identifier (Params.Get_Parameter (Provider & ".client_id"));
      Realm.App.Set_Application_Secret (Params.Get_Parameter (Provider & ".secret"));
      Realm.App.Set_Application_Callback (Params.Get_Parameter (Provider & ".callback_url"));
      Realm.App.Set_Provider_URI (Params.Get_Parameter (Provider & ".request_url"));
      Realm.Realm := To_Unbounded_String (Params.Get_Parameter (Provider & ".realm"));
      Realm.Scope := To_Unbounded_String (Params.Get_Parameter (Provider & ".scope"));
   end Initialize;

   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The Name can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   --  (See OpenID Section 7.3 Discovery)
   overriding
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point) is
   begin
      Result.URL := To_Unbounded_String (Name);
   end Discover;

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

   overriding
   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String is
      Result : Unbounded_String := OP.URL;
      State  : constant String := Realm.App.Get_State (To_String (Assoc.Assoc_Handle));
      Params : constant String := Realm.App.Get_Auth_Params (State, To_String (Realm.Scope));
   begin
      if Index (Result, "?") > 0 then
         Append (Result, "&");
      else
         Append (Result, "?");
      end if;
      Append (Result, Params);

      Log.Debug ("Params = {0}", Params);
      return To_String (Result);
   end Get_Authentication_URL;

   --  Verify the authentication result
   overriding
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication) is
      State : constant String := Request.Get_Parameter (Security.OAuth.State);
      Code  : constant String := Request.Get_Parameter (Security.OAuth.Code);
      Error : constant String := Request.Get_Parameter (Security.OAuth.Error_Description);
   begin
      if Error'Length /= 0 then
         Set_Result (Result, CANCEL, "Authentication refused: " & Error);
         return;
      end if;

      --  First, verify that the state parameter matches our internal state.
      if not Realm.App.Is_Valid_State (To_String (Assoc.Assoc_Handle), State) then
         Set_Result (Result, INVALID_SIGNATURE, "invalid OAuth state parameter");
         return;
      end if;

      --  Get the access token from the authorization code.
      declare
         use type Security.OAuth.Clients.Access_Token_Access;

         Acc : constant Security.OAuth.Clients.Access_Token_Access
           := Realm.App.Request_Access_Token (Code);
      begin
         if Acc = null then
            Set_Result (Result, INVALID_SIGNATURE, "cannot change the code to an access_token");
            return;
         end if;

         --  Last step, verify the access token and get the user identity.
         Manager'Class (Realm).Verify_Access_Token (Assoc, Request, Acc, Result);
      end;

   end Verify;

end Security.Auth.OAuth;

Implement the OAuth authorization by using the OAuth Clients


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                      A 4 G . A S I S _ T A B L E S                       --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            Copyright (C) 1995-2009, 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.Elements; use Asis.Elements;

with Atree;         use Atree;
with Sinput;        use Sinput;
with Einfo;         use Einfo;
with Nlists;        use Nlists;

package body A4G.Asis_Tables is

   ---------------------
   -- Add_New_Element --
   ---------------------

   procedure Add_New_Element (Element : Asis.Element) is
      Found : Boolean := False;
   begin
      for J in 1 .. Asis_Element_Table.Last loop
         if Is_Equal (Element, Asis_Element_Table.Table (J)) then
            Found := True;
            exit;
         end if;
      end loop;

      if not Found then
         Asis_Element_Table.Append (Element);
      end if;
   end Add_New_Element;

   -----------------------
   -- Create_Node_Trace --
   -----------------------

   procedure Create_Node_Trace (N : Node_Id) is
      Next_Node     : Node_Id;
      Next_Sloc     : Source_Ptr;
      Next_Node_Rec : Node_Trace_Rec;
   begin
      Node_Trace.Init;

      Next_Node := N;

      while Present (Next_Node) loop
         Next_Sloc := Sloc (Next_Node);

         Next_Node_Rec.Kind      := Nkind                    (Next_Node);
         Next_Node_Rec.Node_Line := Get_Physical_Line_Number (Next_Sloc);
         Next_Node_Rec.Node_Col  := Get_Column_Number        (Next_Sloc);

         Node_Trace.Append (Next_Node_Rec);

         Next_Node := Enclosing_Scope (Next_Node);
      end loop;

   end Create_Node_Trace;

   ---------------------
   -- Enclosing_Scope --
   ---------------------

   function Enclosing_Scope (N : Node_Id) return Node_Id is
      Result      : Node_Id := N;
      Entity_Node : Entity_Id := Empty;
   begin

      if Nkind (Result) = N_Package_Declaration then
         Entity_Node := Defining_Unit_Name (Sinfo.Specification (Result));
      elsif Nkind (Result) = N_Package_Body then
         Entity_Node := Defining_Unit_Name (Result);
      end if;

      if Nkind (Entity_Node) = N_Defining_Program_Unit_Name then
         Entity_Node := Sinfo.Defining_Identifier (Entity_Node);
      end if;

      if Present (Entity_Node) and then
         Is_Generic_Instance (Entity_Node)
      then
         --  going to the corresponding instantiation

         if Nkind (Parent (Result)) = N_Compilation_Unit then
            --  We are at the top/ and we do not need a library-level
            --  instantiation - it is always unique in the compilation
            --  unit
            Result := Empty;
         else
            --  "local" instantiation, therefore - one or two steps down the
            --  declaration list to get in the instantiation node:
            Result := Next_Non_Pragma (Result);

            if Nkind (Result) = N_Package_Body then
               --  This is an expanded generic body
               Result := Next_Non_Pragma (Result);
            end if;

         end if;

      else
         --  One step up to the enclosing scope
         Result := Parent (Result);

         while not (Nkind (Result) = N_Package_Specification or else
                    Nkind (Result) = N_Package_Body          or else
                    Nkind (Result) = N_Compilation_Unit      or else
                    Nkind (Result) = N_Subprogram_Body       or else
                    Nkind (Result) = N_Block_Statement)
         loop
            Result := Parent (Result);
         end loop;

         if Nkind (Result) = N_Package_Specification then
            Result := Parent (Result);

         elsif Nkind (Result) = N_Compilation_Unit then
            Result := Empty;
         end if;

      end if;

      return Result;
   end Enclosing_Scope;

   --------------
   -- Is_Equal --
   --------------

   function Is_Equal
     (N         : Node_Id;
      Trace_Rec : Node_Trace_Rec)
      return      Boolean
   is
   begin

      return Nkind (N)                           = Trace_Rec.Kind      and then
             Get_Physical_Line_Number (Sloc (N)) = Trace_Rec.Node_Line and then
             Get_Column_Number (Sloc (N))        = Trace_Rec.Node_Col;

   end Is_Equal;

end A4G.Asis_Tables;

Add the ASIS file $i

Add the ASIS file $i


-----------------------------------------------------------------------
--  util-serialize-mappers -- Serialize objects in various formats
--  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.Strings;
with Ada.Unchecked_Deallocation;
package body Util.Serialize.Mappers is

   use Util.Log;

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

   --  -----------------------
   --  Execute the mapping operation on the object associated with the current context.
   --  The object is extracted from the context and the Execute operation is called.
   --  -----------------------
   procedure Execute (Handler : in Mapper;
                      Map     : in Mapping'Class;
                      Ctx     : in out Util.Serialize.Contexts.Context'Class;
                      Value   : in Util.Beans.Objects.Object) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.all.Execute (Map, Ctx, Value);
      end if;
   end Execute;

   function Is_Proxy (Controller : in Mapper) return Boolean is
   begin
      return Controller.Is_Proxy_Mapper;
   end Is_Proxy;

   --  -----------------------
   --  Returns true if the mapper is a wildcard node (matches any element).
   --  -----------------------
   function Is_Wildcard (Controller : in Mapper) return Boolean is
   begin
      return Controller.Is_Wildcard;
   end Is_Wildcard;

   --  -----------------------
   --  Returns the mapping name.
   --  -----------------------
   function Get_Name (Controller : in Mapper) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Controller.Name);
   end Get_Name;

   --  -----------------------
   --  Find the mapper associated with the given name.
   --  Returns null if there is no mapper.
   --  -----------------------
   function Find_Mapper (Controller : in Mapper;
                         Name       : in String;
                         Attribute  : in Boolean := False) return Mapper_Access is
      use type Ada.Strings.Unbounded.Unbounded_String;
      Node : Mapper_Access := Controller.First_Child;
   begin
      if Node = null and Controller.Mapper /= null then
         return Controller.Mapper.Find_Mapper (Name, Attribute);
      end if;
      while Node /= null loop
         if Node.Is_Wildcard then
            declare
               Result : constant Mapper_Access := Node.Find_Mapper (Name, Attribute);
            begin
               if Result /= null then
                  return Result;
               else
                  return Node;
               end if;
            end;
         end if;
         if Node.Name = Name then
            if (Attribute = False and Node.Mapping = null)
              or else not Node.Mapping.Is_Attribute then
               return Node;
            end if;
            if Attribute and Node.Mapping.Is_Attribute then
               return Node;
            end if;
         end if;
         Node := Node.Next_Mapping;
      end loop;
      return null;
   end Find_Mapper;

   --  -----------------------
   --  Find a path component representing a child mapper under From and
   --  identified by the given Name.  If the mapper is not found, a new
   --  Mapper_Node is created.
   --  -----------------------
   procedure Find_Path_Component (From   : in out Mapper'Class;
                                  Name   : in String;
                                  Result : out Mapper_Access) is
      use Ada.Strings.Unbounded;

      Node     : Mapper_Access := From.First_Child;
      Previous : Mapper_Access := null;
      Wildcard : constant Boolean := Name = "*";
   begin
      if Node = null then
         Result := new Mapper;
         Result.Name := To_Unbounded_String (Name);
         Result.Is_Wildcard := Wildcard;
         From.First_Child := Result;
         return;
      end if;
      loop
         if Node.Name = Name then
            Result := Node;
            return;
         end if;
         if Node.Next_Mapping = null then
            Result := new Mapper;
            Result.Name := To_Unbounded_String (Name);
            Result.Is_Wildcard := Wildcard;
            if Node.Is_Wildcard then
               Result.Next_Mapping := Node;
               if Previous = null then
                  From.First_Child := Result;
               else
                  Previous.Next_Mapping := Result;
               end if;
            else
               Node.Next_Mapping := Result;
            end if;
            return;
         end if;
         Previous := Node;
         Node := Node.Next_Mapping;
      end loop;
   end Find_Path_Component;

   --  -----------------------
   --  Build the mapping tree that corresponds to the given Path.
   --  Each path component is represented by a Mapper_Node element.
   --  The node is created if it does not exists.
   --  -----------------------
   procedure Build_Path (Into     : in out Mapper'Class;
                         Path     : in String;
                         Last_Pos : out Natural;
                         Node     : out Mapper_Access) is
      Pos      : Natural;
   begin
      Node     := Into'Unchecked_Access;
      Last_Pos := Path'First;
      loop
         Pos := Util.Strings.Index (Source => Path,
                                    Char   => '/',
                                    From   => Last_Pos);
         if Pos = 0 then
            Node.Find_Path_Component (Name   => Path (Last_Pos .. Path'Last),
                                      Result => Node);
            Last_Pos := Path'Last + 1;
         else
            Node.Find_Path_Component (Name   => Path (Last_Pos .. Pos - 1),
                                      Result => Node);
            Last_Pos := Pos + 1;
         end if;
         exit when Last_Pos > Path'Last;
      end loop;
   end Build_Path;

   --  -----------------------
   --  Add a mapping to associate the given Path to the mapper defined in Map.
   --  The Path string describes the matching node using a simplified XPath notation.
   --  Example:
   --     info/first_name    matches:  <info><first_name>...</first_name></info>
   --     info/a/b/name      matches:  <info><name>...</name></info>
   --     */a/b/name         matches:  <j><name>...</name></j>
   --  -----------------------
   procedure Add_Mapping (Into : in out Mapper;
                          Path : in String;
                          Map  : in Mapper_Access) is
      procedure Copy (To   : in Mapper_Access;
                      From : in Mapper_Access);

      Node     : Mapper_Access;
      Last_Pos : Natural;

      procedure Copy (To   : in Mapper_Access;
                      From : in Mapper_Access) is
         N   : Mapper_Access;
         Src : Mapper_Access := From;
      begin
         while Src /= null loop
            N := Src.Clone;
            N.Is_Clone := True;
            N.Next_Mapping := To.First_Child;
            To.First_Child := N;
            if Src.First_Child /= null then
               Copy (N, Src.First_Child);
            end if;
            Src := Src.Next_Mapping;
         end loop;
      end Copy;

   begin
      Log.Info ("Mapping '{0}' for mapper X", Path);

      --  Find or build the mapping tree.
      Into.Build_Path (Path, Last_Pos, Node);

      if Last_Pos < Path'Last then
         Log.Warn ("Ignoring the end of mapping path {0}", Path);
      end if;
      if Node.Mapper /= null then
         Log.Warn ("Overriding the mapping {0} for mapper X", Path);
      end if;
      if Map.First_Child /= null then
         Copy (Node, Map.First_Child);
      else
         Node.Mapper := Map;
      end if;
   end Add_Mapping;

   procedure Add_Mapping (Into : in out Mapper;
                          Path : in String;
                          Map  : in Mapping_Access) is
      use Ada.Strings.Unbounded;
      Node     : Mapper_Access;
      Last_Pos : Natural;
   begin
      Log.Info ("Mapping {0}", Path);

      --  Find or build the mapping tree.
      Into.Build_Path (Path, Last_Pos, Node);

      if Last_Pos < Path'Last then
         Log.Warn ("Ignoring the end of mapping path {0}", Path);
      end if;
      if Node.Mapping /= null then
         Log.Warn ("Overriding the mapping {0} for mapper X", Path);
      end if;
      if Length (Node.Name) = 0 then
         Log.Warn ("Mapped name is empty in mapping path {0}", Path);
      elsif Element (Node.Name, 1) = '@' then
         Delete (Node.Name, 1, 1);
         Map.Is_Attribute := True;
      else
         Map.Is_Attribute := False;
      end if;

      Node.Mapping := Map;
      Node.Mapper  := Into'Unchecked_Access;
   end Add_Mapping;

   --  -----------------------
   --  Clone the Handler instance and get a copy of that single object.
   --  -----------------------
   function Clone (Handler : in Mapper) return Mapper_Access is
      Result : constant Mapper_Access := new Mapper;
   begin
      Result.Name            := Handler.Name;
      Result.Mapper          := Handler.Mapper;
      Result.Mapping         := Handler.Mapping;
      Result.Is_Proxy_Mapper := Handler.Is_Proxy_Mapper;
      Result.Is_Clone        := True;
      Result.Is_Wildcard     := Handler.Is_Wildcard;
      return Result;
   end Clone;

   --  -----------------------
   --  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 Mapper;
                         Name      : in String;
                         Value     : in Util.Beans.Objects.Object;
                         Attribute : in Boolean := False;
                         Context   : in out Util.Serialize.Contexts.Context'Class) is
      Map : constant Mapper_Access := Mapper'Class (Handler).Find_Mapper (Name, Attribute);
   begin
      if Map /= null and then Map.Mapping /= null and then Map.Mapper /= null then
         Map.Mapper.all.Execute (Map.Mapping.all, Context, Value);
      end if;
   end Set_Member;

   procedure Start_Object (Handler : in Mapper;
                           Context : in out Util.Serialize.Contexts.Context'Class;
                           Name    : in String) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.Start_Object (Context, Name);
      end if;
   end Start_Object;

   procedure Finish_Object (Handler : in Mapper;
                            Context : in out Util.Serialize.Contexts.Context'Class;
                            Name    : in String) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.Finish_Object (Context, Name);
      end if;
   end Finish_Object;

   --  -----------------------
   --  Dump the mapping tree on the logger using the INFO log level.
   --  -----------------------
   procedure Dump (Handler : in Mapper'Class;
                   Log     : in Util.Log.Loggers.Logger'Class;
                   Prefix  : in String := "") is
      procedure Dump (Map : in Mapper'Class);

      --  -----------------------
      --  Dump the mapping description
      --  -----------------------
      procedure Dump (Map : in Mapper'Class) is
      begin
         if Map.Mapping /= null and then Map.Mapping.Is_Attribute then
            Log.Info (" {0}@{1}", Prefix,
                      Ada.Strings.Unbounded.To_String (Map.Mapping.Name));
         else
            Log.Info (" {0}/{1}", Prefix, Ada.Strings.Unbounded.To_String (Map.Name));
            Dump (Map, Log, Prefix & "/" & Ada.Strings.Unbounded.To_String (Map.Name));
         end if;
      end Dump;
   begin
      Iterate (Handler, Dump'Access);
   end Dump;

   procedure Iterate (Controller : in Mapper;
                      Process : not null access procedure (Map : in Mapper'Class)) is
      Node : Mapper_Access := Controller.First_Child;
   begin
      --  Pass 1: process the attributes first
      while Node /= null loop
         if Node.Mapping /= null and then Node.Mapping.Is_Attribute then
            Process.all (Node.all);
         end if;
         Node := Node.Next_Mapping;
      end loop;

      --  Pass 2: process the elements
      Node := Controller.First_Child;
      while Node /= null loop
         if Node.Mapping = null or else not Node.Mapping.Is_Attribute then
            Process.all (Node.all);
         end if;
         Node := Node.Next_Mapping;
      end loop;
   end Iterate;

   --  -----------------------
   --  Finalize the object and release any mapping.
   --  -----------------------
   overriding
   procedure Finalize (Controller : in out Mapper) is
      procedure Free is new Ada.Unchecked_Deallocation (Mapper'Class, Mapper_Access);
      procedure Free is new Ada.Unchecked_Deallocation (Mapping'Class, Mapping_Access);

      Node : Mapper_Access := Controller.First_Child;
      Next : Mapper_Access;
   begin
      Controller.First_Child := null;
      while Node /= null loop
         Next := Node.Next_Mapping;
         Free (Node);
         Node := Next;
      end loop;
      if not Controller.Is_Clone then
         Free (Controller.Mapping);
      else
         Controller.Mapping := null;
      end if;
   end Finalize;

end Util.Serialize.Mappers;

-----------------------------------------------------------------------
--  util-serialize-mappers -- Serialize objects in various formats
--  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.Strings;
with Ada.Unchecked_Deallocation;
package body Util.Serialize.Mappers is

   use Util.Log;

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

   --  -----------------------
   --  Execute the mapping operation on the object associated with the current context.
   --  The object is extracted from the context and the Execute operation is called.
   --  -----------------------
   procedure Execute (Handler : in Mapper;
                      Map     : in Mapping'Class;
                      Ctx     : in out Util.Serialize.Contexts.Context'Class;
                      Value   : in Util.Beans.Objects.Object) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.all.Execute (Map, Ctx, Value);
      end if;
   end Execute;

   function Is_Proxy (Controller : in Mapper) return Boolean is
   begin
      return Controller.Is_Proxy_Mapper;
   end Is_Proxy;

   --  -----------------------
   --  Returns true if the mapper is a wildcard node (matches any element).
   --  -----------------------
   function Is_Wildcard (Controller : in Mapper) return Boolean is
   begin
      return Controller.Is_Wildcard;
   end Is_Wildcard;

   --  -----------------------
   --  Returns the mapping name.
   --  -----------------------
   function Get_Name (Controller : in Mapper) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Controller.Name);
   end Get_Name;

   --  -----------------------
   --  Find the mapper associated with the given name.
   --  Returns null if there is no mapper.
   --  -----------------------
   function Find_Mapper (Controller : in Mapper;
                         Name       : in String;
                         Attribute  : in Boolean := False) return Mapper_Access is
      use type Ada.Strings.Unbounded.Unbounded_String;
      Node : Mapper_Access := Controller.First_Child;
   begin
      if Node = null and Controller.Mapper /= null then
         return Controller.Mapper.Find_Mapper (Name, Attribute);
      end if;
      while Node /= null loop
         if not Attribute and Node.Is_Wildcard then
            declare
               Result : constant Mapper_Access := Node.Find_Mapper (Name, Attribute);
            begin
               if Result /= null then
                  return Result;
               else
                  return Node;
               end if;
            end;
         end if;
         if Node.Name = Name then
            if (Attribute = False and Node.Mapping = null)
              or else not Node.Mapping.Is_Attribute then
               return Node;
            end if;
            if Attribute and Node.Mapping.Is_Attribute then
               return Node;
            end if;
         end if;
         Node := Node.Next_Mapping;
      end loop;
      return null;
   end Find_Mapper;

   --  -----------------------
   --  Find a path component representing a child mapper under From and
   --  identified by the given Name.  If the mapper is not found, a new
   --  Mapper_Node is created.
   --  -----------------------
   procedure Find_Path_Component (From   : in out Mapper'Class;
                                  Name   : in String;
                                  Result : out Mapper_Access) is
      use Ada.Strings.Unbounded;

      Node     : Mapper_Access := From.First_Child;
      Previous : Mapper_Access := null;
      Wildcard : constant Boolean := Name = "*";
   begin
      if Node = null then
         Result := new Mapper;
         Result.Name := To_Unbounded_String (Name);
         Result.Is_Wildcard := Wildcard;
         From.First_Child := Result;
         return;
      end if;
      loop
         if Node.Name = Name then
            Result := Node;
            return;
         end if;
         if Node.Next_Mapping = null then
            Result := new Mapper;
            Result.Name := To_Unbounded_String (Name);
            Result.Is_Wildcard := Wildcard;
            if Node.Is_Wildcard then
               Result.Next_Mapping := Node;
               if Previous = null then
                  From.First_Child := Result;
               else
                  Previous.Next_Mapping := Result;
               end if;
            else
               Node.Next_Mapping := Result;
            end if;
            return;
         end if;
         Previous := Node;
         Node := Node.Next_Mapping;
      end loop;
   end Find_Path_Component;

   --  -----------------------
   --  Build the mapping tree that corresponds to the given Path.
   --  Each path component is represented by a Mapper_Node element.
   --  The node is created if it does not exists.
   --  -----------------------
   procedure Build_Path (Into     : in out Mapper'Class;
                         Path     : in String;
                         Last_Pos : out Natural;
                         Node     : out Mapper_Access) is
      Pos      : Natural;
   begin
      Node     := Into'Unchecked_Access;
      Last_Pos := Path'First;
      loop
         Pos := Util.Strings.Index (Source => Path,
                                    Char   => '/',
                                    From   => Last_Pos);
         if Pos = 0 then
            Node.Find_Path_Component (Name   => Path (Last_Pos .. Path'Last),
                                      Result => Node);
            Last_Pos := Path'Last + 1;
         else
            Node.Find_Path_Component (Name   => Path (Last_Pos .. Pos - 1),
                                      Result => Node);
            Last_Pos := Pos + 1;
         end if;
         exit when Last_Pos > Path'Last;
      end loop;
   end Build_Path;

   --  -----------------------
   --  Add a mapping to associate the given Path to the mapper defined in Map.
   --  The Path string describes the matching node using a simplified XPath notation.
   --  Example:
   --     info/first_name    matches:  <info><first_name>...</first_name></info>
   --     info/a/b/name      matches:  <info><name>...</name></info>
   --     */a/b/name         matches:  <j><name>...</name></j>
   --  -----------------------
   procedure Add_Mapping (Into : in out Mapper;
                          Path : in String;
                          Map  : in Mapper_Access) is
      procedure Copy (To   : in Mapper_Access;
                      From : in Mapper_Access);

      Node     : Mapper_Access;
      Last_Pos : Natural;

      procedure Copy (To   : in Mapper_Access;
                      From : in Mapper_Access) is
         N   : Mapper_Access;
         Src : Mapper_Access := From;
      begin
         while Src /= null loop
            N := Src.Clone;
            N.Is_Clone := True;
            N.Next_Mapping := To.First_Child;
            To.First_Child := N;
            if Src.First_Child /= null then
               Copy (N, Src.First_Child);
            end if;
            Src := Src.Next_Mapping;
         end loop;
      end Copy;

   begin
      Log.Info ("Mapping '{0}' for mapper X", Path);

      --  Find or build the mapping tree.
      Into.Build_Path (Path, Last_Pos, Node);

      if Last_Pos < Path'Last then
         Log.Warn ("Ignoring the end of mapping path {0}", Path);
      end if;
      if Node.Mapper /= null then
         Log.Warn ("Overriding the mapping {0} for mapper X", Path);
      end if;
      if Map.First_Child /= null then
         Copy (Node, Map.First_Child);
      else
         Node.Mapper := Map;
      end if;
   end Add_Mapping;

   procedure Add_Mapping (Into : in out Mapper;
                          Path : in String;
                          Map  : in Mapping_Access) is
      use Ada.Strings.Unbounded;
      Node     : Mapper_Access;
      Last_Pos : Natural;
   begin
      Log.Info ("Mapping {0}", Path);

      --  Find or build the mapping tree.
      Into.Build_Path (Path, Last_Pos, Node);

      if Last_Pos < Path'Last then
         Log.Warn ("Ignoring the end of mapping path {0}", Path);
      end if;
      if Node.Mapping /= null then
         Log.Warn ("Overriding the mapping {0} for mapper X", Path);
      end if;
      if Length (Node.Name) = 0 then
         Log.Warn ("Mapped name is empty in mapping path {0}", Path);
      elsif Element (Node.Name, 1) = '@' then
         Delete (Node.Name, 1, 1);
         Map.Is_Attribute := True;
      else
         Map.Is_Attribute := False;
      end if;

      Node.Mapping := Map;
      Node.Mapper  := Into'Unchecked_Access;
   end Add_Mapping;

   --  -----------------------
   --  Clone the Handler instance and get a copy of that single object.
   --  -----------------------
   function Clone (Handler : in Mapper) return Mapper_Access is
      Result : constant Mapper_Access := new Mapper;
   begin
      Result.Name            := Handler.Name;
      Result.Mapper          := Handler.Mapper;
      Result.Mapping         := Handler.Mapping;
      Result.Is_Proxy_Mapper := Handler.Is_Proxy_Mapper;
      Result.Is_Clone        := True;
      Result.Is_Wildcard     := Handler.Is_Wildcard;
      return Result;
   end Clone;

   --  -----------------------
   --  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 Mapper;
                         Name      : in String;
                         Value     : in Util.Beans.Objects.Object;
                         Attribute : in Boolean := False;
                         Context   : in out Util.Serialize.Contexts.Context'Class) is
      Map : constant Mapper_Access := Mapper'Class (Handler).Find_Mapper (Name, Attribute);
   begin
      if Map /= null and then Map.Mapping /= null and then Map.Mapper /= null then
         Map.Mapper.all.Execute (Map.Mapping.all, Context, Value);
      end if;
   end Set_Member;

   procedure Start_Object (Handler : in Mapper;
                           Context : in out Util.Serialize.Contexts.Context'Class;
                           Name    : in String) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.Start_Object (Context, Name);
      end if;
   end Start_Object;

   procedure Finish_Object (Handler : in Mapper;
                            Context : in out Util.Serialize.Contexts.Context'Class;
                            Name    : in String) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.Finish_Object (Context, Name);
      end if;
   end Finish_Object;

   --  -----------------------
   --  Dump the mapping tree on the logger using the INFO log level.
   --  -----------------------
   procedure Dump (Handler : in Mapper'Class;
                   Log     : in Util.Log.Loggers.Logger'Class;
                   Prefix  : in String := "") is
      procedure Dump (Map : in Mapper'Class);

      --  -----------------------
      --  Dump the mapping description
      --  -----------------------
      procedure Dump (Map : in Mapper'Class) is
      begin
         if Map.Mapping /= null and then Map.Mapping.Is_Attribute then
            Log.Info (" {0}@{1}", Prefix,
                      Ada.Strings.Unbounded.To_String (Map.Mapping.Name));
         else
            Log.Info (" {0}/{1}", Prefix, Ada.Strings.Unbounded.To_String (Map.Name));
            Dump (Map, Log, Prefix & "/" & Ada.Strings.Unbounded.To_String (Map.Name));
         end if;
      end Dump;
   begin
      Iterate (Handler, Dump'Access);
   end Dump;

   procedure Iterate (Controller : in Mapper;
                      Process : not null access procedure (Map : in Mapper'Class)) is
      Node : Mapper_Access := Controller.First_Child;
   begin
      --  Pass 1: process the attributes first
      while Node /= null loop
         if Node.Mapping /= null and then Node.Mapping.Is_Attribute then
            Process.all (Node.all);
         end if;
         Node := Node.Next_Mapping;
      end loop;

      --  Pass 2: process the elements
      Node := Controller.First_Child;
      while Node /= null loop
         if Node.Mapping = null or else not Node.Mapping.Is_Attribute then
            Process.all (Node.all);
         end if;
         Node := Node.Next_Mapping;
      end loop;
   end Iterate;

   --  -----------------------
   --  Finalize the object and release any mapping.
   --  -----------------------
   overriding
   procedure Finalize (Controller : in out Mapper) is
      procedure Free is new Ada.Unchecked_Deallocation (Mapper'Class, Mapper_Access);
      procedure Free is new Ada.Unchecked_Deallocation (Mapping'Class, Mapping_Access);

      Node : Mapper_Access := Controller.First_Child;
      Next : Mapper_Access;
   begin
      Controller.First_Child := null;
      while Node /= null loop
         Next := Node.Next_Mapping;
         Free (Node);
         Node := Next;
      end loop;
      if not Controller.Is_Clone then
         Free (Controller.Mapping);
      else
         Controller.Mapping := null;
      end if;
   end Finalize;

end Util.Serialize.Mappers;

Fix mapping of attribute when wildcard mapping is also used