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


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

with Asis; use Asis;

----------------------------------------------------------
-- The goal of this package is, when we have an element --
-- to let us have ALL the possible queries for that     --
-- element that return its children.                    --
----------------------------------------------------------

package A4G.Queries is

   --  There is 3 kinds of queries in Asis :
   type Query_Kinds is
     (Bug,
      --  just for the discriminant default expression
      Single_Element_Query,
      --  Queries taking an element and returning an element.
      Element_List_Query,
      --  Queries taking an element and returning a list of elements.
      Element_List_Query_With_Boolean
      --  Queries taking an element and a boolean and returning a list
      --  of elements.
    );

   type A_Single_Element_Query is access
      function (Elem : Asis.Element) return Asis.Element;

   type A_Element_List_Query is access
      function (Elem : Asis.Element) return Asis.Element_List;

   type A_Element_List_Query_With_Boolean is access
      function
        (Elem : Asis.Element;
         Bool : Boolean)
         return Asis.Element_List;

   --  Discriminant record that can access any type of query.
   type Func_Elem (Query_Kind : Query_Kinds := Bug) is record
      case Query_Kind is
         when Bug =>
            null;
         when Single_Element_Query =>
            Func_Simple : A_Single_Element_Query;
         when Element_List_Query =>
            Func_List : A_Element_List_Query;
         when Element_List_Query_With_Boolean =>
            Func_List_Boolean : A_Element_List_Query_With_Boolean;
            Bool : Boolean;
      end case;
   end record;

   type Query_Array is array (Positive range <>) of Func_Elem;

   --  an empty array, when the element is a terminal
   No_Query : Query_Array (1 .. 0);

   ----------------------------------------------------
   -- This function returns a Query_Array containing --
   -- all the existing queries for that element.     --
   -- If an element has no children, No_Query is     --
   -- returned.                                      --
   ----------------------------------------------------
   function Appropriate_Queries (Element : Asis.Element) return Query_Array;

end A4G.Queries;

Add the ASIS file $i

Add the ASIS file $i


-----------------------------------------------------------------------
--  wiki-plugins-template -- Template Plugin
--  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.Strings;

--  === Template Plugins ===
--  The <b>Wiki.Plugins.Templates</b> package defines an abstract template plugin.
--  To use the template plugin, the <tt>Get_Template</tt> procedure must be implemented.
--  It is responsible for getting the template content according to the plugin parameters.
--
package Wiki.Plugins.Templates is

   pragma Preelaborate;

   type Template_Plugin is abstract new Wiki_Plugin with null record;

   --  Get the template content for the plugin evaluation.
   procedure Get_Template (Plugin   : in out Template_Plugin;
                           Params   : in out Wiki.Attributes.Attribute_List;
                           Template : out Wiki.Strings.UString) is abstract;

   --  Expand the template configured with the parameters for the document.
   --  The <tt>Get_Template</tt> operation is called and the template content returned
   --  by that operation is parsed in the current document.  Template parameters are passed
   --  in the <tt>Context</tt> instance and they can be evaluated within the template
   --  while parsing the template content.
   overriding
   procedure Expand (Plugin   : in out Template_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in Plugin_Context);

end Wiki.Plugins.Templates;

Declare the Wiki.Plugins.Templates package with the Template_Plugin type


-- RUN: %llvmgcc -c %s -o /dev/null
procedure VCE_LV is
   type P is access String ;
   type T is new P (5 .. 7);
   subtype U is String (5 .. 7);
   X : T := new U'(others => 'A');
begin
   null;
end;

Test that a VIEW_CONVERT_EXPR used as an lvalue has the right type.

git-svn-id: 0ff597fd157e6f4fc38580e8d64ab130330d2411@35387 91177308-0d34-0410-b5e6-96231b3b80d8


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

package body Util.Serialize.Mappers is

   --  -----------------------
   --  Bind the name and the handler in the current mapper.
   --  -----------------------
   procedure Add_Member (Controller : in out Mapper;
                         Name       : in String;
                         Handler    : in Mapper_Access) is
   begin
      Controller.Mapping.Insert (Key      => Name,
                                 New_Item => Handler);
   end Add_Member;

   --  -----------------------
   --  Add the member to the current mapper.
   --  -----------------------
   procedure Add_Member (Controller : in out Mapper;
                         Name       : in String) is
   begin
      Controller.Mapping.Insert (Key => Name, New_Item => null);
   end Add_Member;

   --  -----------------------
   --  Find the mapper associated with the given name.
   --  Returns null if there is no mapper.
   --  -----------------------
   function Find_Mapper (Controller : in Mapper;
                         Name       : in String) return Mapper_Access is
      Pos : constant Mapper_Map.Cursor := Controller.Mapping.Find (Key => Name);
   begin
      if Mapper_Map.Has_Element (Pos) then
         return Mapper_Map.Element (Pos);
      else
         return null;
      end if;
   end Find_Mapper;

end Util.Serialize.Mappers;

Add operations to specify the mapping

Add operations to specify the mapping


-----------------------------------------------------------------------
--  util-streams-texts-tr -- Text translation utilities on streams
--  Copyright (C) 2010, 2011, 2012, 2015, 2016, 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 Util.Texts.Transforms;
with Ada.Wide_Wide_Characters.Handling;
package Util.Streams.Texts.WTR is
  new Util.Texts.Transforms (Stream => Print_Stream'Class,
                             Char   => Wide_Wide_Character,
                             Input  => Wide_Wide_String,
                             Put    => Write_Char,
                             To_Upper => Ada.Wide_Wide_Characters.Handling.To_Upper,
                             To_Lower => Ada.Wide_Wide_Characters.Handling.To_Lower);

Refactor Buffered_Stream and Print_Stream - move the WTR package instantiation in a separate file


-----------------------------------------------------------------------
--  util-serialize-tools -- Tools to Serialize objects in various formats
--  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.Containers;

with Util.Streams.Texts;
with Util.Streams.Buffered;
with Util.Serialize.IO.JSON;
with Util.Serialize.Mappers.Record_Mapper;
package body Util.Serialize.Tools is

   type Object_Field is (FIELD_NAME, FIELD_VALUE);
   type Object_Map_Access is access all Util.Beans.Objects.Maps.Map'Class;

   type Object_Mapper_Context is record
      Map  : Object_Map_Access;
      Name : Util.Beans.Objects.Object;
   end record;
   type Object_Mapper_Context_Access is access all Object_Mapper_Context;

   procedure Set_Member (Into  : in out Object_Mapper_Context;
                         Field : in Object_Field;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_NAME =>
            Into.Name := Value;

         when FIELD_VALUE =>
            Into.Map.Include (Util.Beans.Objects.To_String (Into.Name), Value);
            Into.Name := Util.Beans.Objects.Null_Object;

      end case;
   end Set_Member;

   package Object_Mapper is new
     Util.Serialize.Mappers.Record_Mapper (Element_Type        => Object_Mapper_Context,
                                           Element_Type_Access => Object_Mapper_Context_Access,
                                           Fields              => Object_Field,
                                           Set_Member          => Set_Member);

   Object_Mapping : aliased Object_Mapper.Mapper;

   procedure To_JSON (Output : in out Util.Serialize.IO.JSON.Output_Stream;
                     Map    : in Util.Beans.Objects.Maps.Map) is
      use type Ada.Containers.Count_Type;

      procedure Write (Name  : in String;
                       Value : in Util.Beans.Objects.Object) is
      begin
         Output.Start_Entity (Name => "");
         Output.Write_Attribute (Name  => "name",
                                 Value => Util.Beans.Objects.To_Object (Name));
         Output.Write_Attribute (Name  => "value",
                                 Value => Value);
         Output.End_Entity (Name => "");
      end Write;

   begin
      if Map.Length > 0 then
         declare
            Iter : Util.Beans.Objects.Maps.Cursor := Map.First;
         begin
            Output.Start_Array (Name   => "params",
                                Length => Map.Length);
            while Util.Beans.Objects.Maps.Has_Element (Iter) loop
               Util.Beans.Objects.Maps.Query_Element (Iter, Write'Access);
               Util.Beans.Objects.Maps.Next (Iter);
            end loop;
            Output.End_Array;
         end;
      end if;
   end To_JSON;

   --  -----------------------
   --  Serialize the objects defined in the object map Map into an XML stream.
   --  Returns the JSON string that contains a serialization of the object maps.
   --  -----------------------
   function To_JSON (Map : in Util.Beans.Objects.Maps.Map) return String is
      use type Ada.Containers.Count_Type;
   begin
      if Map.Length = 0 then
         return "";
      end if;
      declare
         Output : Util.Serialize.IO.JSON.Output_Stream;
      begin
         Output.Initialize (Size => 10000);
         Output.Start_Document;
         To_JSON (Output, Map);
         Output.End_Document;
         return Util.Streams.Texts.To_String (Util.Streams.Buffered.Buffered_Stream (Output));
      end;
   end To_JSON;

   --  -----------------------
   --  Deserializes the JSON content passed in Content and restore the object map
   --  which their values.
   --  Returns the object map that was restored.
   --  -----------------------
   function From_JSON (Content : in String) return Util.Beans.Objects.Maps.Map is
      Result  : aliased Util.Beans.Objects.Maps.Map;
      Parser  : Util.Serialize.IO.JSON.Parser;
      Context : aliased Object_Mapper_Context;
   begin
      Context.Map := Result'Unchecked_Access;
      Parser.Add_Mapping ("params", Object_Mapping'Access);
      Object_Mapper.Set_Context (Parser, Context'Unchecked_Access);
      Parser.Parse (Content);
      return Result;
   end From_JSON;

begin
   Object_Mapping.Add_Mapping ("param/@name", FIELD_NAME);
   Object_Mapping.Add_Mapping ("param", FIELD_VALUE);
end Util.Serialize.Tools;

Implement the To_JSON and From_JSON operations


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                         A 4 G . D E C L _ S E M                          --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            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 routines needed for semantic queries from
--  the Asis.Declarations package

with Asis.Declarations; use Asis.Declarations;
with Asis.Definitions;  use Asis.Definitions;
with Asis.Iterator;     use Asis.Iterator;
with Asis.Elements;     use Asis.Elements;
with Asis.Errors;       use Asis.Errors;
with Asis.Exceptions;   use Asis.Exceptions;
with Asis.Extensions;   use Asis.Extensions;

with Asis.Set_Get;      use Asis.Set_Get;

with A4G.A_Sem;         use A4G.A_Sem;
with A4G.Int_Knds;      use A4G.Int_Knds;
with A4G.Vcheck;        use A4G.Vcheck;
with A4G.Mapping;       use A4G.Mapping;

with Atree;             use Atree;
with Einfo;             use Einfo;
with Namet;             use Namet;
with Nlists;            use Nlists;
with Sinfo;             use Sinfo;
with Sinput;            use Sinput;

package body A4G.Decl_Sem is

   -----------------------------
   -- Corresponding_Body_Node --
   -----------------------------

   function Corresponding_Body_Node (Decl_Node : Node_Id) return Node_Id is
      Result_Node : Node_Id;
   begin
      Result_Node := Corresponding_Body (Decl_Node);

      if No (Result_Node) then
         --  package without a body
         return Result_Node;
      end if;

      Result_Node := Parent (Result_Node);

      if Nkind (Result_Node) = N_Defining_Program_Unit_Name then
         Result_Node := Parent (Result_Node);
      end if;

      if Nkind (Result_Node) = N_Function_Specification  or else
         Nkind (Result_Node) = N_Procedure_Specification
      then
         Result_Node := Parent (Result_Node);
      end if;

      if Nkind (Parent (Result_Node)) = N_Subunit then
         --  we come back to the stub!
         Result_Node := Corresponding_Stub (Parent (Result_Node));
      end if;

      if not Comes_From_Source (Result_Node)
        and then
          not (Is_Rewrite_Substitution (Result_Node)
                 --  SCz
--              and then
              --                Nkind (Original_Node (Result_Node)) = N_Expression_Function)
              )
      then
         --  implicit body created by the compiler for renaming-as-body.
         --  the renaming itself is the previous list member, so
         Result_Node := Get_Renaming_As_Body (Decl_Node);
      end if;

      return Result_Node;

   end Corresponding_Body_Node;

   -----------------------------
   -- Corresponding_Decl_Node --
   -----------------------------

   function Corresponding_Decl_Node (Body_Node : Node_Id) return Node_Id is
      Result_Node        : Node_Id := Empty;
      Protected_Def_Node : Node_Id;
      Tmp_Node           : Node_Id := Empty;
   begin

      case Nkind (Body_Node) is
         when N_Body_Stub =>
            Result_Node := Corr_Decl_For_Stub (Body_Node);

         when N_Entry_Body =>

            Protected_Def_Node := Corresponding_Spec (Parent (Body_Node));

            if Ekind (Protected_Def_Node) = E_Limited_Private_Type then
               Protected_Def_Node := Full_View (Protected_Def_Node);
            end if;

            Protected_Def_Node := Parent (Protected_Def_Node);
            Protected_Def_Node := Protected_Definition (Protected_Def_Node);

            Tmp_Node :=
              First_Non_Pragma (Visible_Declarations (Protected_Def_Node));

            while Present (Tmp_Node) loop

               if Nkind (Tmp_Node) = N_Entry_Declaration and then
                  Parent (Corresponding_Body (Tmp_Node)) = Body_Node
               then
                  Result_Node := Tmp_Node;
                  exit;
               end if;

               Tmp_Node := Next_Non_Pragma (Tmp_Node);

            end loop;

            if No (Result_Node) and then
               Present (Private_Declarations (Protected_Def_Node))
            then
               Tmp_Node :=
                 First_Non_Pragma (Private_Declarations (Protected_Def_Node));

               while Present (Tmp_Node) loop

                  if Nkind (Tmp_Node) = N_Entry_Declaration and then
                     Parent (Corresponding_Body (Tmp_Node)) = Body_Node
                  then
                     Result_Node := Tmp_Node;
                     exit;
                  end if;

                  Tmp_Node := Next_Non_Pragma (Tmp_Node);

               end loop;

            end if;

         when others =>
            Result_Node := Corresponding_Spec (Body_Node);
            Result_Node := Parent (Result_Node);

            if Nkind (Result_Node) = N_Defining_Program_Unit_Name then
               Result_Node := Parent (Result_Node);
            end if;

      end case;

      pragma Assert (Present (Result_Node));
      --  now - from a defining entity to the declaration itself; note,
      --  that here we cannot get a defining expanded name, because the
      --  corresponding declaration for library units are obtained in
      --  another control flow
      case Nkind (Result_Node) is
         when N_Function_Specification  |
              N_Procedure_Specification |
              N_Package_Specification =>
            Result_Node := Parent (Result_Node);
         when N_Private_Type_Declaration =>
            --  this is the case when a task type is the completion
            --  of a private type
            Result_Node := Full_View (Defining_Identifier (Result_Node));
            Result_Node := Parent (Result_Node);
         when others =>
            null;
      end case;

      return Result_Node;
   end Corresponding_Decl_Node;

   ---------------------------------------
   -- Get_Corresponding_Generic_Element --
   ---------------------------------------

   function Get_Corresponding_Generic_Element
     (Gen_Unit : Asis.Declaration;
      Def_Name : Asis.Element)
      return     Asis.Element
   is
      Kind_To_Check   : constant Internal_Element_Kinds := Int_Kind (Def_Name);
      Sloc_To_Check   : constant Source_Ptr := Sloc (Node (Def_Name));
      Line_To_Check   : constant Physical_Line_Number :=
         Get_Physical_Line_Number (Sloc_To_Check);
      Column_To_Check : constant Column_Number :=
        Get_Column_Number (Sloc_To_Check);

      Result_Element  : Asis.Element := Nil_Element;

      Tmp_El          : Asis.Element;

      Check_Inherited_Element : constant Boolean :=
         Is_Part_Of_Inherited (Def_Name);

      Sloc_To_Check_1 : constant Source_Ptr := Sloc (Node_Field_1 (Def_Name));
      Line_To_Check_1 : constant Physical_Line_Number :=
         Get_Physical_Line_Number (Sloc_To_Check_1);
      Column_To_Check_1 : constant Column_Number :=
        Get_Column_Number (Sloc_To_Check_1);
      --  Used in case if we are looking for an implicit Element

      function Is_Found (E : Asis.Element) return Boolean;
      --  Checks if the Element being traversed is a corresponding generic
      --  element for Def_Name

      function Is_Found (E : Asis.Element) return Boolean is
         Elem_Sloc   : constant Source_Ptr := Sloc (Node (E));
         Elem_Sloc_1 :          Source_Ptr;
         Result      : Boolean             := False;
      begin

         if not (Check_Inherited_Element xor Is_Part_Of_Inherited (E)) then

            Result :=
               Line_To_Check = Get_Physical_Line_Number (Elem_Sloc)
            and then
               Column_To_Check = Get_Column_Number (Elem_Sloc);

            if Result
             and then
               Check_Inherited_Element
            then
               Elem_Sloc_1 := Sloc (Node_Field_1 (E));

               Result :=
                  Line_To_Check_1 = Get_Physical_Line_Number (Elem_Sloc_1)
                 and then
                  Column_To_Check_1 = Get_Column_Number (Elem_Sloc_1);
            end if;

         end if;

         return Result;
      end Is_Found;

      --  and now, variables and actuals for Traverse_Element
      My_Control : Traverse_Control := Continue;
      My_State   : No_State         := Not_Used;

      procedure Pre_Op
        (Element    :        Asis.Element;
         Control    : in out Traverse_Control;
         State      : in out No_State);

      procedure Look_For_Corr_Gen_El is new Traverse_Element
        (State_Information => No_State,
         Pre_Operation     => Pre_Op,
         Post_Operation    => No_Op);

      procedure Pre_Op
        (Element    :        Asis.Element;
         Control    : in out Traverse_Control;
         State      : in out No_State)
      is
         pragma Unreferenced (State);

         Arg_Kind : constant Internal_Element_Kinds := Int_Kind (Element);
      begin

         case Arg_Kind is

            when An_Internal_Body_Stub =>

               if Kind_To_Check = A_Defining_Identifier or else
                  Kind_To_Check in Internal_Defining_Operator_Kinds
               then
                  --  We have to traverse the code of the subunit -
                  --  see 9217-015. But before doing this, let's check the
                  --  name of the subunit:

                  Tmp_El := Asis.Declarations.Names (Element) (1);

                  if Int_Kind (Tmp_El) = Kind_To_Check and then
                     Is_Found (Tmp_El)
                  then
                     Result_Element := Tmp_El;
                     Control        := Terminate_Immediately;

                     return;
                  end if;

               end if;

               --  If we are here, we have to traverse the proper body:

               Tmp_El := Corresponding_Subunit (Element);

               if not Is_Nil (Tmp_El) then
                  Look_For_Corr_Gen_El (Element => Tmp_El,
                                        Control => My_Control,
                                        State   => My_State);
               end if;

            when Internal_Defining_Name_Kinds =>

               if Int_Kind (Element) = Kind_To_Check and then
                  Is_Found (Element)
               then
                  Result_Element := Element;
                  Control        := Terminate_Immediately;
               end if;

            when A_Derived_Type_Definition             |
                 A_Derived_Record_Extension_Definition |
                 A_Formal_Derived_Type_Definition      =>

                  if Check_Inherited_Element then

                     declare
                        Inherited_Decls : constant Asis.Element_List :=
                         Implicit_Inherited_Declarations (Element);

                        Inherited_Subprgs : constant Asis.Element_List :=
                         Implicit_Inherited_Subprograms (Element);
                     begin

                        for J in Inherited_Decls'Range loop
                           exit when My_Control = Terminate_Immediately;

                           Look_For_Corr_Gen_El
                             (Element => Inherited_Decls (J),
                              Control => My_Control,
                              State   => My_State);
                        end loop;

                        for J in Inherited_Subprgs'Range loop
                           exit when My_Control = Terminate_Immediately;

                           Look_For_Corr_Gen_El
                            (Element => Inherited_Subprgs (J),
                             Control => My_Control,
                             State   => My_State);
                        end loop;

                     end;

                  end if;

            when others =>
               null;
         end case;

      end Pre_Op;

   begin  -- Get_Corresponding_Generic_Element
      Look_For_Corr_Gen_El (Element => Gen_Unit,
                            Control => My_Control,
                            State   => My_State);
      return Result_Element;

   exception
      when ASIS_Failed =>

         if Status_Indicator = Unhandled_Exception_Error then
            Add_Call_Information
              (Argument   => Nil_Element,
               Outer_Call => "A4G.Decl_Sem.Get_Corresponding_Generic_Element");
         end if;

         raise;
   end Get_Corresponding_Generic_Element;

   -----------------------
   -- Get_Expanded_Spec --
   -----------------------

   function Get_Expanded_Spec (Instance_Node : Node_Id) return Node_Id is
      Result_Node : Node_Id;
   begin
      --  GNAT constructs the structure corresponding to an expanded generic
      --  specification just before the instantiation itself, except the case
      --  of the formal package with box:

      if Nkind (Instance_Node) = N_Package_Declaration and then
         Nkind (Original_Node (Instance_Node)) = N_Formal_Package_Declaration
      then
         Result_Node := Instance_Node;
      else
         Result_Node := Prev_Non_Pragma (Instance_Node);
      end if;

      if Nkind (Result_Node) = N_Package_Body then
         --  Here we have the expanded generic body, therefore - one
         --  more step up the list
         Result_Node := Prev_Non_Pragma (Result_Node);
      end if;

      --  in case of a package instantiation, we have to take the whole
      --  expanded package, but in case of a subprogram instantiation we
      --  need only the subprogram declaration, which is the last element
      --  of the visible declarations list of the "artificial" package
      --  spec created by the compiler
      if not (Nkind (Instance_Node) = N_Package_Instantiation or else
              Nkind (Original_Node (Instance_Node)) =
              N_Formal_Package_Declaration)
      then
         Result_Node  := Last_Non_Pragma (Visible_Declarations
                            (Specification (Result_Node)));

         if Nkind (Result_Node) = N_Subprogram_Body then
            Result_Node := Parent (Parent (Corresponding_Spec (Result_Node)));
         end if;

         pragma Assert (Nkind (Result_Node) = N_Subprogram_Declaration);
      end if;

      return Result_Node;
   end Get_Expanded_Spec;

   --------------------------
   -- Get_Renaming_As_Body --
   --------------------------

   function Get_Renaming_As_Body
     (Node      : Node_Id;
      Spec_Only : Boolean := False)
      return      Node_Id
   is
      Entity_Node      : Node_Id;
      Scope_Node       : Node_Id;
      Result_Node      : Node_Id := Empty;
      List_To_Search   : List_Id;
      Search_Node      : Node_Id := Node;
      --  in the first List_To_Search we start not from the very beginning;
      --  but from the node representing the argument subprogram declaration
      Completion_Found : Boolean := False;

      procedure Search_In_List;
      --  looks for a possible renaming-as-bode node being a completion for
      --  Node, using global settings for List_To_Search and Search_Node
      procedure Search_In_List is
      begin

         while Present (Search_Node) loop

            if Nkind (Search_Node) = N_Subprogram_Renaming_Declaration and then
               Corresponding_Spec (Search_Node) = Entity_Node
            then
               Result_Node := Search_Node;
               Completion_Found := True;
               return;
            end if;

            Search_Node := Next_Non_Pragma (Search_Node);
         end loop;

      end Search_In_List;
   begin  --  Get_Renaming_As_Body
      Entity_Node    := Defining_Unit_Name (Specification (Node));
      List_To_Search := List_Containing (Node);
      Search_In_List;

      if Completion_Found then
         goto end_of_search;
      end if;

      --  here we have to see, where we are. If we are not in a package,
      --  we have nothing to do, but if we are in the package, we may
      --  have to search again in another lists (the private part and
      --  the body)

      Scope_Node := Scope (Entity_Node);
      --  Node here can be of N_Subprogram_Declaration only!
      if Nkind (Parent (Scope_Node)) = N_Implicit_Label_Declaration then
         --  this is the implicit name created for a block statement,
         --  so we do not have any other list to search in
         goto end_of_search;
      else
         Scope_Node := Parent (Scope_Node);
      end if;

      if Nkind (Scope_Node) = N_Defining_Program_Unit_Name then
         Scope_Node := Parent (Scope_Node);
      end if;
      --  now if we are not in  N_Package_Specification, we have no
      --  other list to search in

      if  Nkind (Scope_Node) /= N_Package_Specification then
         goto end_of_search;
      end if;

      --  and here we are in N_Package_Specification

      if List_To_Search = Visible_Declarations (Scope_Node) then
         --  continuing in the private part:
         List_To_Search := Private_Declarations (Scope_Node);
         if not (No (List_To_Search)
            or else Is_Empty_List (List_To_Search))
         then
            Search_Node    := First_Non_Pragma (List_To_Search);
            Search_In_List;
         end if;
         if Completion_Found or else Spec_Only then
            goto end_of_search;
         end if;
      end if;

      --  and here we have to go into the package body, if any:
      Scope_Node := Corresponding_Body (Parent (Scope_Node));
      if Present (Scope_Node) then

         while Nkind (Scope_Node) /= N_Package_Body loop
            Scope_Node := Parent (Scope_Node);
         end loop;

         --  and to continue to search in the package body:
         List_To_Search := Sinfo.Declarations (Scope_Node);

         if not (No (List_To_Search)
            or else Is_Empty_List (List_To_Search))
         then
            Search_Node    := First_Non_Pragma (List_To_Search);
            Search_In_List;
         end if;

      end if;

      << end_of_search >>

      return Result_Node;
   end Get_Renaming_As_Body;

   -----------------------
   -- Serach_First_View --
   -----------------------

   function Serach_First_View (Type_Entity : Entity_Id) return Entity_Id is
      Type_Chars  : constant Name_Id := Chars (Type_Entity);
      Type_Decl   : constant Node_Id := Parent (Type_Entity);
      Result_Node : Node_Id          := Empty;
      Scope_Node  : Node_Id;
      Scope_Kind  : Node_Kind;
      Search_List : List_Id;

      Private_Decls_Passed : Boolean := False;

      procedure Sesrch_In_List (L : List_Id);
      --  we have a separate procedure for searching in a list of
      --  declarations, because we have to do this search from one to
      --  three times in case of a package. This procedure uses Type_Chars,
      --  Type_Decl and Result_Node as global values, and it sets
      --  Result_Node equal to the node defining the type with the same name
      --  as the name of the type represented by Type_Entity, if the
      --  search is successful, otherwise it remains is equal to Empty.
      --  this procedure supposes, that L is not No_List

      procedure Sesrch_In_List (L : List_Id) is
         Next_Decl          : Node_Id;
         Next_Decl_Original : Node_Id;
         Next_Kind          : Node_Kind;
      begin
         Next_Decl          := First_Non_Pragma (L);
         Next_Decl_Original := Original_Node (Next_Decl);
         Next_Kind          := Nkind (Next_Decl_Original);

         while Present (Next_Decl) loop

            if (Comes_From_Source (Next_Decl_Original)
                 and then
                   (Next_Kind = N_Full_Type_Declaration or else
                    Next_Kind = N_Task_Type_Declaration or else
                    Next_Kind = N_Protected_Type_Declaration or else
                    Next_Kind = N_Private_Type_Declaration or else
                    Next_Kind = N_Private_Extension_Declaration or else
                    Next_Kind = N_Formal_Type_Declaration or else
--  impossible in ASIS, but possible in the tree
--  because of the tree rewritings
                    Next_Kind = N_Incomplete_Type_Declaration))
--  these cases correspond to non-rewritten type
--  declarations
                or else
                  (not (Comes_From_Source (Next_Decl_Original))
                 and then
                    Next_Kind = N_Subtype_Declaration)
--  the declaration of a derived type rewritten into a
--  subtype declaration
            then

               if Is_Not_Duplicated_Decl (Next_Decl) then
--  ??? <tree problem 2>  - we need this "if" only because of this problem
                  if Next_Decl_Original = Type_Decl then
                     --  no private or incomplete view
                     Result_Node := Type_Entity;
                     return;
                  end if;

                  if Type_Chars = Chars (Defining_Identifier (Next_Decl)) then
                     --  we've found something...
                     Result_Node := Defining_Identifier (Next_Decl);
                     return;
                  end if;

               end if;
            end if;

            Next_Decl := Next_Non_Pragma (Next_Decl);
            Next_Decl_Original := Original_Node (Next_Decl);
            Next_Kind          := Nkind (Next_Decl_Original);

         end loop;
      end Sesrch_In_List;

   begin  --  Serach_First_View
      --  first, defining the scope of the Type_Entity. In case of a package
      --  body it will be a package spec anyway.
      Scope_Node := Scope (Type_Entity);

      if Nkind (Parent (Scope_Node)) = N_Implicit_Label_Declaration then
         --  this is the implicit name created for a block statement
         Scope_Node := Parent (Block_Node (Scope_Node));
      else
         Scope_Node := Parent (Scope_Node);
      end if;

      if Nkind (Scope_Node) = N_Defining_Program_Unit_Name then
         Scope_Node := Parent (Scope_Node);
      end if;
      --  now we are in N_Function_Specification, N_Procedure_Specification
      --  or in N_Package_Specification
      Scope_Kind := Nkind (Scope_Node);

      if Scope_Kind = N_Function_Specification  or else
         Scope_Kind = N_Procedure_Specification
      then
         --  we do not do this additional step for packages, because
         --  N_Package_Specification_Node already contains references to
         --  declaration lists, and for a package we gave to start from the
         --  declarations in the package spec, but for a subprogram
         --  we have to go to a subprogram body, because nothing interesting
         --  for this function can be declared in a separate subprogram
         --  specification (if any) or in a generic formal part (if any)
         Scope_Node := Parent (Scope_Node);
         Scope_Kind := Nkind (Scope_Node);
      end if;

      if Scope_Kind = N_Subprogram_Declaration
        or else
         Scope_Kind = N_Generic_Subprogram_Declaration
        or else
         Scope_Kind = N_Task_Type_Declaration
        or else
         Scope_Kind = N_Entry_Declaration
        or else
         Scope_Kind = N_Subprogram_Body_Stub
      then
         Scope_Node := Corresponding_Body (Scope_Node);
         Scope_Node := Parent (Scope_Node);

         if Nkind (Scope_Node) = N_Defining_Program_Unit_Name then
            Scope_Node := Parent (Scope_Node);
         end if;

         if Nkind (Scope_Node) = N_Function_Specification  or else
            Nkind (Scope_Node) = N_Procedure_Specification
         then
            Scope_Node := Parent (Scope_Node);
         end if;

         Scope_Kind := Nkind (Scope_Node);
      end if;

      --  now, defining the list to search. In case of generics, we do not
      --  have to start from parsing the list of generic parameters, because
      --  a generic formal type cannot have a completion as its full view,
      --  and it cannot be a completion of some other type.

      if Scope_Kind = N_Subprogram_Body or else
         Scope_Kind = N_Task_Body       or else
         Scope_Kind = N_Block_Statement or else
         Scope_Kind = N_Entry_Body
      then
         Search_List := Sinfo.Declarations (Scope_Node);
      elsif Scope_Kind = N_Package_Specification then
         Search_List := Visible_Declarations (Scope_Node);

         if Is_Empty_List (Search_List) then
            --  note, that Visible_Declarations cannot be No_List
            Private_Decls_Passed := True;
            Search_List := Private_Declarations (Scope_Node);

            if No (Search_List) or else Is_Empty_List (Search_List) then
               --  here we should go to the declarative part of the package
               --  body. Note, that if we are in a legal ada program, and if
               --  we start from a type declaration, Search_List cannot
               --  be No_List or an empty list
               Scope_Node := Parent (Corresponding_Body (Parent (Scope_Node)));
               --  note, that Search_Kind is unchanged here
               Search_List := Sinfo.Declarations (Scope_Node);
            end if;

         end if;

      end if;

      Sesrch_In_List (Search_List);

      if Result_Node /= Empty then
         if Result_Node /= Type_Entity and then
            Full_View (Result_Node) /= Type_Entity
         then
            --  The case when Type_Entity is a full type declaration that
            --  completes a private type/extension declaration that in turn
            --  completes an incomplete type.
            Result_Node := Full_View (Result_Node);
         end if;

         return Result_Node;
      end if;

      --  it is possible only for a package - we have to continue in the
      --  private part or/and in the body

      pragma Assert (Scope_Kind = N_Package_Specification);

      --  first, try a private part, if needed and if any

      if not Private_Decls_Passed then
         --  Scope_Node is still of N_Package_Specification kind here!
         Private_Decls_Passed := True;
         Search_List := Private_Declarations (Scope_Node);

         if Present (Search_List) and then Is_Non_Empty_List (Search_List) then
            Sesrch_In_List (Search_List);

            if Result_Node /= Empty then
               return Result_Node;
            end if;

         end if;

      end if;

      --  if we are here, Scope_Node is still of N_Package_Specification,
      --  and the only thing we have to do now is to check the package
      --  body
      --  There is some redundancy in the code - in fact, we need only
      --  one boolean flag (Private_Decls_Passed) to control the search in
      --  case of a package
      Scope_Node := Parent (Corresponding_Body (Parent (Scope_Node)));

      if Nkind (Scope_Node) = N_Defining_Program_Unit_Name then
         Scope_Node := Parent (Scope_Node);
      end if;

      Search_List := Sinfo.Declarations (Scope_Node);
      Sesrch_In_List (Search_List);

      if Result_Node /= Empty then
         return Result_Node;
      else
         pragma Assert (False);
         return Empty;
      end if;

   end Serach_First_View;

end A4G.Decl_Sem;

Add the ASIS file $i

Add the ASIS file $i


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                          A 4 G . D E F A U L T S                         --
--                                                                          --
--            Copyright (C) 1995-2010, 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 Unchecked_Deallocation;

with A4G.A_Osint; use A4G.A_Osint;
with A4G.U_Conv;  use A4G.U_Conv;

with Output;      use Output;

package body A4G.Defaults is

   procedure Free_String is new Unchecked_Deallocation
     (String, String_Access);

   procedure Add_Src_Search_Dir (Dir : String);
   --  Add Dir at the end of the default source file search path.

   procedure Add_Lib_Search_Dir (Dir : String);
   --  Add Dir at the end of the default library (=object+ALI) file search
   --  path.

   ------------------------
   -- Add_Lib_Search_Dir --
   ------------------------

   procedure Add_Lib_Search_Dir (Dir : String) is
   begin
      ASIS_Lib_Search_Directories.Increment_Last;
      ASIS_Lib_Search_Directories.Table (ASIS_Lib_Search_Directories.Last) :=
        new String'(Normalize_Directory_Name (Dir));
   end Add_Lib_Search_Dir;

   ------------------------
   -- Add_Src_Search_Dir --
   ------------------------

   procedure Add_Src_Search_Dir (Dir : String) is
   begin
      ASIS_Src_Search_Directories.Increment_Last;
      ASIS_Src_Search_Directories.Table (ASIS_Src_Search_Directories.Last) :=
        new String'(Normalize_Directory_Name (Dir));
   end Add_Src_Search_Dir;

   --------------
   -- Finalize --
   --------------

   procedure Finalize is
   begin
      --  finalise ASIS_Src_Search_Directories:
      for I in First_Dir_Id .. ASIS_Src_Search_Directories.Last loop
         Free_String (ASIS_Src_Search_Directories.Table (I));
      end loop;

      --  finalize ASIS_Lib_Search_Directories:
      for I in First_Dir_Id .. ASIS_Lib_Search_Directories.Last loop
         Free_String (ASIS_Lib_Search_Directories.Table (I));
      end loop;

      --  finalize ASIS_Tree_Search_Directories
      for I in First_Dir_Id .. ASIS_Tree_Search_Directories.Last loop
         Free_String (ASIS_Tree_Search_Directories.Table (I));
      end loop;
   end Finalize;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize is
      Search_Path : String_Access;
   begin
      --  just in case:
      Finalize;

      ASIS_Src_Search_Directories.Init;
      ASIS_Lib_Search_Directories.Init;
      ASIS_Tree_Search_Directories.Init;

      --  stroring the defaults for: the code is stolen from Osint
      --  (body, rev. 1.147) and then adjusted

      for Dir_kind in Search_Dir_Kinds loop

         case Dir_kind is
            when Source =>
               Search_Path := Getenv ("ADA_INCLUDE_PATH");
            when Object =>
               Search_Path := Getenv ("ADA_OBJECTS_PATH");
            when Tree =>
               --  There is no environment variable for separate
               --  tree path at the moment;
               exit;
         end case;

         if Search_Path'Length > 0 then
            declare
               Lower_Bound : Positive := 1;
               Upper_Bound : Positive;

            begin
               loop
                  while Lower_Bound <= Search_Path'Last
                    and then Search_Path.all (Lower_Bound) =
                    ASIS_Path_Separator
                  loop
                     Lower_Bound := Lower_Bound + 1;
                  end loop;

                  exit when Lower_Bound > Search_Path'Last;

                  Upper_Bound := Lower_Bound;
                  while Upper_Bound <= Search_Path'Last
                    and then Search_Path.all (Upper_Bound) /=
                    ASIS_Path_Separator
                  loop
                     Upper_Bound := Upper_Bound + 1;
                  end loop;

                  case Dir_kind is
                     when Source =>
                        Add_Src_Search_Dir
                          (Search_Path.all (Lower_Bound .. Upper_Bound - 1));
                     when Object =>
                        Add_Lib_Search_Dir
                          (Search_Path.all (Lower_Bound .. Upper_Bound - 1));
                     when Tree =>
                        exit; --  non implemented yet;
                  end case;

                  Lower_Bound := Upper_Bound + 1;
               end loop;
            end;
         end if;
      end loop;

      --  ???  TEMPORARY SOLUTION: the default objects search path
      --  is also used as the default tree path

      for J in First_Dir_Id .. ASIS_Lib_Search_Directories.Last loop

         ASIS_Tree_Search_Directories.Increment_Last;

         ASIS_Tree_Search_Directories.Table
           (ASIS_Tree_Search_Directories.Last) :=
            new String'(ASIS_Lib_Search_Directories.Table (J).all);

      end loop;

      Free (Search_Path);

   end Initialize;

   -------------------------
   -- Locate_Default_File --
   -------------------------

   function Locate_Default_File
     (File_Name : String_Access;
      Dir_Kind  : Search_Dir_Kinds)
      return String_Access
   is
      function Is_Here_In_Src  (File_Name : String_Access; Dir : Dir_Id)
         return Boolean;
      function Is_Here_In_Lib  (File_Name : String_Access; Dir : Dir_Id)
         return Boolean;
      --  funtion Is_Here_In_Tree (File_Name : String_Access; Dir : Dir_Id)
      --     return Boolean;

      function Is_Here_In_Src  (File_Name : String_Access; Dir : Dir_Id)
         return Boolean
      is
      begin
         return Is_Regular_File (ASIS_Src_Search_Directories.Table (Dir).all
                               & To_String (File_Name));
      end Is_Here_In_Src;

      function Is_Here_In_Lib  (File_Name : String_Access; Dir : Dir_Id)
         return Boolean
      is
      begin
         return Is_Regular_File (ASIS_Lib_Search_Directories.Table (Dir).all
                               & To_String (File_Name));
      end Is_Here_In_Lib;

   begin
      case Dir_Kind is

         when Source =>
            for Dir in First_Dir_Id .. ASIS_Src_Search_Directories.Last loop
               if Is_Here_In_Src (File_Name, Dir) then
                  return new String'
                       (ASIS_Src_Search_Directories.Table (Dir).all
                      & File_Name.all);
               end if;
            end loop;

         when Object =>
            for Dir in First_Dir_Id .. ASIS_Lib_Search_Directories.Last loop
               if Is_Here_In_Lib (File_Name, Dir) then
                  return new String'
                       (ASIS_Lib_Search_Directories.Table (Dir).all
                      & File_Name.all);
               end if;
            end loop;
         when Tree =>
            null; --  non implemented yet;
      end case;

      return null;
   end Locate_Default_File;

   ------------------------
   -- Print_Lib_Defaults --
   ------------------------

   procedure Print_Lib_Defaults is
   begin
      if ASIS_Lib_Search_Directories.Last < First_Dir_Id then
         Write_Str ("   No default library files search path");
         Write_Eol;
      else
         for Dir in First_Dir_Id .. ASIS_Lib_Search_Directories.Last loop
            Write_Str ("   " & ASIS_Lib_Search_Directories.Table (Dir).all);
            Write_Eol;
         end loop;
      end if;
   end Print_Lib_Defaults;

   ---------------------------
   -- Print_Source_Defaults --
   ---------------------------

   procedure Print_Source_Defaults is
   begin
      if ASIS_Src_Search_Directories.Last < First_Dir_Id then
         Write_Str ("   No default source search path");
         Write_Eol;
      else
         for Dir in First_Dir_Id .. ASIS_Src_Search_Directories.Last loop
            Write_Str ("   " & ASIS_Src_Search_Directories.Table (Dir).all);
            Write_Eol;
         end loop;
      end if;
   end Print_Source_Defaults;

   -------------------------
   -- Print_Tree_Defaults --
   -------------------------

   procedure Print_Tree_Defaults is
   begin
      if ASIS_Tree_Search_Directories.Last < First_Dir_Id then
         Write_Str ("   No default tree files search path");
         Write_Eol;
      else
         for Dir in First_Dir_Id .. ASIS_Tree_Search_Directories.Last loop
            Write_Str ("   " & ASIS_Tree_Search_Directories.Table (Dir).all);
            Write_Eol;
         end loop;
      end if;
   end Print_Tree_Defaults;

end A4G.Defaults;

Add the ASIS file $i

Add the ASIS file $i


-----------------------------------------------------------------------
--  components-widgets-tabs -- Tab views and tabs
--  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.Components.Base;
with ASF.Contexts.Writer;
package body ASF.Components.Widgets.Tabs is

   --  ------------------------------
   --  Render the tab start.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UITab;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if UI.Is_Rendered (Context) then
         Writer.Start_Element ("div");
         Writer.Write_Attribute ("id", UI.Get_Client_Id);
      end if;
   end Encode_Begin;

   --  ------------------------------
   --  Render the tab close.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UITab;
                         Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if UI.Is_Rendered (Context) then
         Writer.End_Element ("div");
      end if;
   end Encode_End;

   --  ------------------------------
   --  Render the tab list and prepare to render the tab contents.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UITabView;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class) is

      procedure Render_Tab (T : in Components.Base.UIComponent_Access);

      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;

      procedure Render_Tab (T : in Components.Base.UIComponent_Access) is
         Id : constant Unbounded_String := T.Get_Client_Id;
      begin
         if T.all in UITab'Class then
            Writer.Start_Element ("li");
            Writer.Start_Element ("a");
            Writer.Write_Attribute ("href", "#" & To_String (Id));
            Writer.Write_Text (T.Get_Attribute ("title", Context));
            Writer.End_Element ("a");
            Writer.End_Element ("li");
         end if;
      end Render_Tab;

      procedure Render_Tabs is
        new ASF.Components.Base.Iterate (Process => Render_Tab);

   begin
      if UI.Is_Rendered (Context) then
         declare
            Id : constant Unbounded_String := UI.Get_Client_Id;
         begin
            Writer.Start_Element ("div");
            Writer.Write_Attribute ("id", Id);
            Writer.Start_Element ("ul");
            Render_Tabs (UI);
            Writer.End_Element ("ul");
            Writer.Queue_Script ("$(""#");
            Writer.Queue_Script (Id);
            Writer.Queue_Script (""").tabs({");
            Writer.Queue_Script ("});");
         end;
      end if;
   end Encode_Begin;

   --  ------------------------------
   --  Render the tab view close.
   --  ------------------------------
   overriding
   procedure Encode_End (UI      : in UITabView;
                         Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer  : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if UI.Is_Rendered (Context) then
         Writer.End_Element ("div");
      end if;
   end Encode_End;

end ASF.Components.Widgets.Tabs;

Implement the new <w:tab> and <w:tabView> components


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

--  This package contains routines forming debug images for bstractions
--  declared in Asis.Data_Decomposition.

package Asis.Data_Decomposition.Debug is

   function Debug_Image (RC : Record_Component) return Wide_String;
   function Debug_Image (AC : Array_Component) return Wide_String;

   --  Returns a string value containing implementation-defined debug
   --  information associated with the element.
   --
   --  The return value uses Asis.Text.Delimiter_Image to separate the lines
   --  of multi-line results.  The return value does not end with
   --  Asis.Text.Delimiter_Image.

   function Is_Derived_From_Record (TD : Element) return Boolean;
   function Is_Derived_From_Array  (TD : Element) return Boolean;
   --  The public renaming of
   --  Asis.Data_Decomposition.Aux.Is_Derived_From_Record/
   --  Asis.Data_Decomposition.Aux.Is_Derived_From_Array
   --  May be, we should have it in Asis.Extensions

   function Dimension (Comp : Array_Component) return ASIS_Natural;
   --  The public renaming of
   --  Asis.Data_Decomposition.Set_Get.Dimension
   --  May be, we should have it in Asis.Extensions

--   function Linear_Index
--     (Inds        : Dimension_Indexes;
--      D           : ASIS_Natural;
--      Ind_Lengths : Dimention_Length;
--      Conv        : Convention_Id := Convention_Ada)
--      return Asis.ASIS_Natural;

--   function De_Linear_Index
--     (Index       : Asis.ASIS_Natural;
--      D           : ASIS_Natural;
--      Ind_Lengths : Dimention_Length;
--      Conv        : Convention_Id := Convention_Ada)
--      return Dimension_Indexes;
   --  The public renaming of
   --  Asis.Data_Decomposition.Aux.Linear_Index and
   --  Asis.Data_Decomposition.Aux.De_Linear_Index

end Asis.Data_Decomposition.Debug;

Add the ASIS file $i

Add the ASIS file $i


-----------------------------------------------------------------------
--  wiki-parsers-html -- Wiki HTML parser
--  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.
-----------------------------------------------------------------------

--  This is a small HTML parser that is called to deal with embedded HTML in wiki text.
--  The parser is intended to handle incorrect HTML and clean the result as much as possible.
--  We cannot use a real XML/Sax parser (such as XML/Ada) because we must handle errors and
--  backtrack from HTML parsing to wiki or raw text parsing.
--
--  When parsing HTML content, we call the <tt>Start_Element</tt> or <tt>End_Element</tt>
--  operations.  The renderer is then able to handle the HTML tag according to its needs.
private package Wiki.Parsers.Html is

   pragma Preelaborate;

   --  Parse a HTML element <XXX attributes>
   --  or parse an end of HTML element </XXX>
   procedure Parse_Element (P : in out Parser);

end Wiki.Parsers.Html;

Define a simple HTML parser that can be used to parse HTML text embedded in wiki text


-----------------------------------------------------------------------
--  awa-helpers -- Helpers for AWA applications
--  Copyright (C) 2011, 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.
-----------------------------------------------------------------------

package body AWA.Helpers is

   --  ------------------------------
   --  Get the value as an identifier.
   --  Returns NO_IDENTIFIER if the value is invalid.
   --  ------------------------------
   function To_Identifier (Value : in Util.Beans.Objects.Object) return ADO.Identifier is
   begin
      return ADO.Identifier (Util.Beans.Objects.To_Long_Long_Integer (Value));

   exception
      when Constraint_Error =>
         return ADO.NO_IDENTIFIER;
   end To_Identifier;

end AWA.Helpers;

Implement new operation To_Identifier

Implement new operation To_Identifier