------------------------------------------------------------------------------
--                                                                          --
--                           GNATTEST COMPONENTS                            --
--                                                                          --
--              G N A T T E S T  . S T U B . G E N E R A T O R              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2014-2018, AdaCore                     --
--                                                                          --
-- GNATTEST  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.  GNATTEST  is  distributed  in the hope that it will be useful, --
-- but  WITHOUT  ANY  WARRANTY;   without  even  the  implied  warranty  of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details.  You should have received a copy of the --
-- GNU  General  Public License distributed with GNAT; see file COPYING. If --
-- not, write to the  Free  Software  Foundation, 51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA.,                                      --
--                                                                          --
-- GNATTEST is maintained by AdaCore (http://www.adacore.com).              --
--                                                                          --
------------------------------------------------------------------------------

pragma Ada_2012;

with Ada.Containers.Multiway_Trees;
with Ada.Containers.Doubly_Linked_Lists;
with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.Containers.Indefinite_Vectors;
with Ada.Containers.Indefinite_Ordered_Sets;

with GNAT.OS_Lib;                use GNAT.OS_Lib;
with GNAT.SHA1;
with GNAT.Directory_Operations;  use GNAT.Directory_Operations;

with Asis;                       use Asis;
with Asis.Compilation_Units;     use Asis.Compilation_Units;
with Asis.Declarations;          use Asis.Declarations;
with Asis.Definitions;           use Asis.Definitions;
with Asis.Elements;              use Asis.Elements;
with Asis.Expressions;           use Asis.Expressions;
with Asis.Extensions;            use Asis.Extensions;
with Asis.Iterator;              use Asis.Iterator;
with Asis.Limited_Views;         use Asis.Limited_Views;
with Asis.Text;                  use Asis.Text;
with Asis.Extensions.Flat_Kinds; use Asis.Extensions.Flat_Kinds;

with ASIS_UL.Misc;               use ASIS_UL.Misc;

with GNATCOLL.Traces;            use GNATCOLL.Traces;
with GNATCOLL.VFS;               use GNATCOLL.VFS;

with GNATtest.Common;            use GNATtest.Common;
with GNATtest.Options;           use GNATtest.Options;
with GNATtest.Mapping;           use GNATtest.Mapping;
with GNATtest.Skeleton.Source_Table;

with Ada.Text_IO;                use Ada.Text_IO;
with Ada.Characters.Handling;    use Ada.Characters.Handling;
with Ada.Strings;                use Ada.Strings;
with Ada.Strings.Fixed;          use Ada.Strings.Fixed;

package body GNATtest.Stub.Generator is

   Me :         constant Trace_Handle := Create ("Stubs", Default => Off);
   Me_Mapping : constant Trace_Handle :=
     Create ("Stubs.Mapping", Default => Off);

   ------------------
   -- ASIS parsing --
   ------------------

   type Element_Node is record
      Spec           : Asis.Element;
      Spec_Name      : String_Access;
      --  Not used for incomplete type declarations.
      Inside_Generic : Boolean;
      Private_Part   : Boolean;
   end record;

   Tasks_Present : Boolean;

   package Element_Node_Trees is new
     Ada.Containers.Multiway_Trees (Element_Node);
   use Element_Node_Trees;

   package Element_Node_Lists is new
     Ada.Containers.Doubly_Linked_Lists (Element_Node);
   use Element_Node_Lists;

   Nil_Element_Node : constant Element_Node :=
     (Spec           => Nil_Element,
      Spec_Name      => null,
      Inside_Generic => False,
      Private_Part   => False);

   type Data_Holder is record
      Elem_Tree : Element_Node_Trees.Tree;
      Flat_List : Element_Node_Lists.List;

      Limited_Withed_Units : String_Set.Set;
      --  All limited withed units from the spec should have a cooresponding
      --  regular with clause in the body.
   end record;

   function Requires_Body (El : Asis.Element) return Boolean;
   --  checks if a body sample should be created for an element

   procedure Gather_Data
     (The_Unit          :     Asis.Compilation_Unit;
      Data              : out Data_Holder);
   --  Gathers all ASIS info for stub generation.

   --  arguments & result profile analysis
   type Stubbed_Parameter_Kinds is (Access_Kind, Constrained, Not_Constrained);

   type Stubbed_Parameter is record
      Name                 : String_Access;
      Type_Image           : String_Access;
      Type_Full_Name_Image : String_Access;  --  for nested types
      Kind                 : Stubbed_Parameter_Kinds;
      Type_Elem            : Asis.Element;
   end record;

   package Stubbed_Parameter_Lists is new
     Ada.Containers.Doubly_Linked_Lists (Stubbed_Parameter);
   use Stubbed_Parameter_Lists;

   function Get_Args_List (Node : Element_Node)
                           return Stubbed_Parameter_Lists.List;
   --  Returns info on access, out and in out parameters of the subprogram and
   --  on result profile in case of functions.

   function Get_Type_Image (Param_Type : Asis.Element) return String;
   --  Returns exact image is the argument type is not declared in nested
   --  package. Otherwise replaces whatever name of the type is given with
   --  corresponding full ada name.

   function Is_Abstract (Param_Type : Asis.Element) return Boolean;
   --  Analyzes type definition and detects is it's private or public
   --  declaration is abstract.

   function Is_Limited (Param_Type : Asis.Element) return Boolean;
   --  Analyzes type definition and detects is it's private or public
   --  declaration is limited.

   function Is_Only_Limited_Withed (Param_Type : Asis.Element) return Boolean;
   --  Analyzes type definition and detects if only the limited view is
   --  available. If so, Is_Limited and Is_Abstract are not to be applied.

   function Is_Fully_Private (Param_Type : Asis.Element) return Boolean;
   --  Analyzes type definition and detects if corresponding type is declared
   --  only in the private declaration part.

   function Filter_Private_Parameters
     (Param_List : Stubbed_Parameter_Lists.List)
      return Stubbed_Parameter_Lists.List;
   --  Filer out parameters of private types.

   ------------------------------
   -- Markered Mata processing --
   ------------------------------

   type Markered_Data_Kinds is
     (
      --  with clauses, code 00
      Import_MD,
      --  incomplete type, code 01
      Type_MD,
      --  task type or single task, code 02
      Task_MD,
      --  local declarations in packages, code 03
      Package_MD,
      --  subprogram, code 04
      Subprogram_MD,
      --  entry, code 05
      Entry_MD,
      --  possible elaboration code, code 06
      Elaboration_MD,
      --  used in attempts to partially recover corrupted packages. code 99.
      Unknown_MD);

   function MD_Kind_To_String (MD : Markered_Data_Kinds) return String;
   --  Returns string with corresponding code.
   function MD_Kind_From_String (Str : String) return Markered_Data_Kinds;
   --  And back (Unknown for "99" and any illegal argument).

   type Markered_Data_Id is record
      Kind         : Markered_Data_Kinds;
      Self_Hash    : String_Access;
      Nesting_Hash : String_Access;
      Hash_Version : String_Access;
      Name         : String_Access;
   end record;
   function "<" (L, R : Markered_Data_Id) return Boolean;

   package String_Vectors is new
     Ada.Containers.Indefinite_Vectors (Natural, String);

   type Markered_Data_Type is record
      Commneted_Out : Boolean               := False;
      Lines         : String_Vectors.Vector := String_Vectors.Empty_Vector;
   end record;

   function Generate_MD_Id_String
     (Element       : Asis.Element;
      Commented_Out : Boolean := False) return String;
   function Generate_MD_Id_String
     (Id            : Markered_Data_Id;
      Commented_Out : Boolean := False) return String;
   function Generate_MD_Id
     (Element : Asis.Element)
      return Markered_Data_Id;

   package Markered_Data_Maps is new
     Ada.Containers.Indefinite_Ordered_Maps
       (Markered_Data_Id, Markered_Data_Type, "<");
   use Markered_Data_Maps;

   Markered_Data : Markered_Data_Maps.Map;
   --  Main MD storage for stub body.

   Markered_Subp_Data : Markered_Data_Maps.Map;
   --  Used to keep MD for subprograms that are actually present in the spec
   --  so that unused setters could be reported.

--     Setters_Data : Markered_Data_Maps.Map;
   --  Stub_Data body and spec.

   procedure Gather_Markered_Data
     (File : String; Map : in out Markered_Data_Maps.Map);

   -----------------------------
   -- Stub package generation --
   -----------------------------

   Level : Integer := 0;
   --  nesting level of a spec being processed
   Indent_Level : constant Natural := 3;
   --  indentation level

   procedure Generate_Body_Stub
     (Body_File_Name : String;
      Data           : Data_Holder);
   --  Generates stub body.

   procedure Generate_Stub_Data
     (Stub_Data_File_Spec : String;
      Stub_Data_File_Body : String;
      Data                : Data_Holder);
   --  Generates Stub_Data package which contains setters

   procedure Put_Stub_Header
     (Unit_Name      : String;
      Stub_Data      : Boolean := True;
      Limited_Withed : String_Set.Set);
   --  Puts header of generated stub explaining where user code should be put.

   procedure Put_Import_Section
     (Markered_Data : in out Markered_Data_Maps.Map;
      Add_Import    :        Boolean := False);
   --  Puts or regenerates markered section for with clauses.

   procedure Process_Siblings (Cursor : Element_Node_Trees.Cursor);

   procedure Process_Node (Cursor : Element_Node_Trees.Cursor);

   procedure Put_Lines (MD : Markered_Data_Type; Comment_Out : Boolean);

   procedure Generate_Package_Body
     (Node : Element_Node; Cursor : Element_Node_Trees.Cursor);

   procedure Generate_Protected_Body
     (Node : Element_Node; Cursor : Element_Node_Trees.Cursor);

   procedure Generate_Full_Type_Declaration (Node : Element_Node);

   procedure Generate_Task_Body (Node : Element_Node);

   procedure Generate_Entry_Body (Node : Element_Node);

   procedure Generate_Procedure_Body (Node : Element_Node);

   procedure Generate_Function_Body (Node : Element_Node);

   procedure Put_Dangling_Elements;

   -------------------------------
   -- Setter package generation --
   -------------------------------

   procedure Generate_Default_Setter_Spec (Node : Element_Node);
   --  Generate stub data type and object and a setter spec.

   procedure Generate_Default_Setter_Body (Node : Element_Node);
   --  Generate setter body.

   function Hash_Suffix (ID : Markered_Data_Id) return String;
   --  Returns hash suffix from gived ID.

   function Get_Access_Type_Name (Elem : Asis.Element) return String;
   --  Returns full ada name for given type definition with "." and "'"
   --  replaced with underscores and an "_Access" suffix.

   type Access_Dictionary_Entry is record
      Entry_Str : String_Access    := null;
      Type_Decl : Asis.Declaration := Nil_Element;
   end record;

   function "<" (L, R : Access_Dictionary_Entry) return Boolean is
     (L.Entry_Str.all < R.Entry_Str.all);

   package Access_Dictionaries is new
     Ada.Containers.Indefinite_Ordered_Sets (Access_Dictionary_Entry);
   use Access_Dictionaries;

   Dictionary : Access_Dictionaries.Set;
   --  A set of all unrestricted types that we need to make access types for.

   procedure Add_Unconstrained_Type_To_Dictionary (Elem : Asis.Element);
   --  Updates the dictionary of unconstrained-to-access types if needed.

   function Get_Declaration (Elem : Asis.Element) return Asis.Declaration;
   --  Returns declaration of corresponding parameter type.

   -------------
   -- Mapping --
   -------------

   use Entity_Stub_Mapping_List;

   Local_Stub_Unit_Mapping : Stub_Unit_Mapping;

   procedure Add_Entity_To_Local_List
     (Node : Element_Node; New_First_Line, New_First_Column : Natural);
   --  Adds mapping info to Local_Stub_Unit_Mapping.
   procedure Update_Local_Entity_With_Setter
     (Node : Element_Node; New_First_Line, New_First_Column : Natural);
   --  Adds mapping info on setter to corresponding item in the list.

   ---------
   -- "<" --
   ---------

   function "<" (L, R : Markered_Data_Id) return Boolean is
   begin
      if L.Kind < R.Kind then
         return True;
      end if;

      if L.Kind = R.Kind then
         if L.Self_Hash.all < R.Self_Hash.all then
            return True;
         end if;

         if L.Self_Hash.all = R.Self_Hash.all then
            if L.Nesting_Hash.all < R.Nesting_Hash.all then
               return True;
            end if;

            if L.Nesting_Hash.all = R.Nesting_Hash.all then
               if L.Hash_Version.all < R.Hash_Version.all then
                  return True;
               end if;
            end if;
         end if;
      end if;
      return False;
   end "<";

   ------------------------------
   -- Add_Entity_To_Local_List --
   ------------------------------

   procedure Add_Entity_To_Local_List
     (Node : Element_Node; New_First_Line, New_First_Column : Natural)
   is
      Local_Entity : Entity_Stub_Mapping;
--        Local_Body   : Asis.Element;
   begin
      Trace (Me_Mapping, "adding entry for " & Node.Spec_Name.all);
      Local_Entity.Name := new String'(Node.Spec_Name.all);
      Local_Entity.Line := First_Line_Number (Node.Spec);
      Local_Entity.Column := First_Column_Number (Node.Spec);

--        Local_Body := Corresponding_Body (Node.Spec);
--        Local_Entity.Original_Body.Line := First_Line_Number (Local_Body);
--        Local_Entity.Original_Body.Column :=
--          First_Column_Number (Local_Body);

      Local_Entity.Stub_Body.Line := New_First_Line;
      Local_Entity.Stub_Body.Column := New_First_Column;

      Local_Entity.Setter := Nil_Entity_Sloc;

      Local_Stub_Unit_Mapping.Entities.Append (Local_Entity);
   end Add_Entity_To_Local_List;

   ------------------------------------------
   -- Add_Unconstrained_Type_To_Dictionary --
   ------------------------------------------

   procedure Add_Unconstrained_Type_To_Dictionary (Elem : Asis.Element) is
      Encl : Asis.Element := Enclosing_Element (Get_Declaration (Elem));
      Dict_Elem : Access_Dictionary_Entry;

      D_Cur : Access_Dictionaries.Cursor;
   begin
      --  Types foraml or not, declared in nested generic packages should not
      --  be added to the dictionary.
      while not Is_Nil (Encl) loop
         case Declaration_Kind (Encl) is
            when A_Generic_Package_Declaration   |
                 A_Generic_Procedure_Declaration |
                 A_Generic_Function_Declaration  =>
               return;
            when others =>
               null;
         end case;
         Encl := Enclosing_Element (Encl);
      end loop;

      Dict_Elem.Type_Decl := Get_Declaration (Elem);

      D_Cur := Dictionary.First;
      while D_Cur /= Access_Dictionaries.No_Element loop
         if
           Is_Equal (Access_Dictionaries.Element (D_Cur).Type_Decl,
                     Dict_Elem.Type_Decl)
         then
            return;
         end if;

         Next (D_Cur);
      end loop;

      Dict_Elem.Entry_Str := new String'
        ("type "
         & Get_Access_Type_Name (Elem)
         & " is access all "
         & Get_Type_Image (Elem)
         & ";");
      Dictionary.Include (Dict_Elem);
   end Add_Unconstrained_Type_To_Dictionary;

   ------------------
   -- Process_Unit --
   ------------------

   procedure Process_Unit
     (CU                  : Asis.Compilation_Unit;
      Body_File_Name      : String;
      Stub_Data_File_Spec : String;
      Stub_Data_File_Body : String)
   is
      Data   : Data_Holder;
   begin
      Gather_Data (CU, Data);
      Gather_Markered_Data (Body_File_Name, Markered_Data);

      Local_Stub_Unit_Mapping.Stub_Data_File_Name :=
        new String'(Stub_Data_File_Body);
      Local_Stub_Unit_Mapping.Orig_Body_File_Name := new String'
        (GNATtest.Skeleton.Source_Table.Get_Source_Body
           (To_String (Text_Name (CU))));
      Local_Stub_Unit_Mapping.Stub_Body_File_Name :=
        new String'(Body_File_Name);

      Generate_Body_Stub (Body_File_Name, Data);
      Generate_Stub_Data
        (Stub_Data_File_Spec,
         Stub_Data_File_Body,
         Data);

      Add_Stub_List (To_String (Text_Name (CU)), Local_Stub_Unit_Mapping);

      Dictionary.Clear;
      Free (Local_Stub_Unit_Mapping.Stub_Data_File_Name);
      Free (Local_Stub_Unit_Mapping.Orig_Body_File_Name);
      Free (Local_Stub_Unit_Mapping.Stub_Body_File_Name);
      Local_Stub_Unit_Mapping.Entities.Clear;
      Local_Stub_Unit_Mapping.D_Setters.Clear;
      Local_Stub_Unit_Mapping.D_Bodies.Clear;

      Data.Elem_Tree.Clear;
      Data.Flat_List.Clear;
      Data.Limited_Withed_Units.Clear;
   end Process_Unit;

   ---------------------------
   -- Put_Dangling_Elements --
   ---------------------------

   procedure Put_Dangling_Elements is
      MD_Cur : Markered_Data_Maps.Cursor := Markered_Data.First;
      ID : Markered_Data_Id;
      MD : Markered_Data_Type;
   begin

      S_Put (3, "-------------------");
      New_Line_Count;
      S_Put (3, "-- Unused Bodies --");
      New_Line_Count;
      S_Put (3, "-------------------");
      New_Line_Count;
      New_Line_Count;

      while MD_Cur /= Markered_Data_Maps.No_Element loop

         ID := Markered_Data_Maps.Key (MD_Cur);
         MD := Markered_Data_Maps.Element (MD_Cur);

         if not (ID.Kind in Subprogram_MD | Task_MD | Entry_MD) then
            goto END_DANGLING;
         end if;

         S_Put (0, GT_Marker_Begin);
         New_Line_Count;

         case ID.Kind is
            when Subprogram_MD =>
               S_Put
                 (Indent_Level,
                  "--  procedure/function "
                  & ID.Name.all
                  & " is");
            when Task_MD =>
               S_Put
                 (3,
                  "--  task body "
                  & ID.Name.all
                  & " is");

            when Entry_MD =>
               S_Put
                 (3,
                  "--  entry "
                  & ID.Name.all
                  & " when");

            when others =>
               null;
         end case;

         New_Line_Count;

         Local_Stub_Unit_Mapping.D_Bodies.Append ((New_Line_Counter, 0));

         S_Put
           (2 * Indent_Level,
            Generate_MD_Id_String (ID, Commented_Out => True));
         New_Line_Count;
         S_Put (0, GT_Marker_End);
         New_Line_Count;

         Put_Lines (MD, Comment_Out => True);

         S_Put (0, GT_Marker_Begin);
         New_Line_Count;
         S_Put
           (Indent_Level,
            "--  end "
            & ID.Name.all
            & ";");
         New_Line_Count;
         S_Put (0, GT_Marker_End);
         New_Line_Count;
         New_Line_Count;

         <<END_DANGLING>>
         Next (MD_Cur);
      end loop;
   end Put_Dangling_Elements;

   ------------------------
   -- Put_Import_Section --
   ------------------------

   procedure Put_Import_Section
     (Markered_Data : in out Markered_Data_Maps.Map;
      Add_Import    :        Boolean := False)
   is
      ID : constant Markered_Data_Id :=
        (Import_MD,
         new String'(""),
         new String'(""),
         new String'(Hash_Version),
         new String'(""));
      MD : Markered_Data_Type;
   begin
      S_Put (0, GT_Marker_Begin);
      New_Line_Count;
      S_Put
        (0,
         "--  id:"
         & Hash_Version
         & "/"
         & MD_Kind_To_String (Import_MD)
         & "/");
      --  No need for hashes here.

      New_Line_Count;
      S_Put
        (0, "--");
      New_Line_Count;
      S_Put
        (0, "--  This section can be used to add with clauses if necessary.");
      New_Line_Count;
      S_Put
        (0, "--");
      New_Line_Count;
      S_Put (0, GT_Marker_End);

      New_Line_Count;

      if Markered_Data.Contains (ID) then
         --  Extract importing MD
         MD := Markered_Data.Element (ID);
         Put_Lines (MD, Comment_Out => False);
         Markered_Data.Delete (ID);
      else
         New_Line_Count;
         if Add_Import and then Tasks_Present then
            S_Put (3, "with Ada.Real_Time;");
            New_Line_Count;
         end if;
      end if;

      S_Put (0, GT_Marker_Begin);
      New_Line_Count;
      S_Put (0, GT_Marker_End);
      New_Line_Count;
      New_Line_Count;

   end Put_Import_Section;

   ---------------
   -- Put_Lines --
   ---------------

   procedure Put_Lines (MD : Markered_Data_Type; Comment_Out : Boolean) is

      function Comment_Line   (S : String) return String is ("--  " & S);
      function Uncomment_Line (S : String) return String;

      --------------------
      -- Uncomment_Line --
      --------------------

      function Uncomment_Line (S : String) return String is
      begin
         if S = "--  " then
            return "";
         end if;

         if S'Length < 5 then
            return S;
         end if;

         if S (S'First .. S'First + 3) = "--  " then
            return S (S'First + 4 .. S'Last);
         end if;

         return S;
      end Uncomment_Line;

   begin

      if MD.Commneted_Out = Comment_Out then
         for I in MD.Lines.First_Index .. MD.Lines.Last_Index loop
            S_Put (0, MD.Lines.Element (I));
            New_Line_Count;
         end loop;
      else
         if Comment_Out then
            for I in MD.Lines.First_Index .. MD.Lines.Last_Index loop
               S_Put (0, Comment_Line (MD.Lines.Element (I)));
               New_Line_Count;
            end loop;
         else
            for I in MD.Lines.First_Index .. MD.Lines.Last_Index loop
               S_Put (0, Uncomment_Line (MD.Lines.Element (I)));
               New_Line_Count;
            end loop;
         end if;
      end if;

   end Put_Lines;

   ---------------------
   -- Put_Stub_Header --
   ---------------------

   procedure Put_Stub_Header
     (Unit_Name      : String;
      Stub_Data      : Boolean := True;
      Limited_Withed : String_Set.Set)
   is
      Cur : String_Set.Cursor := Limited_Withed.First;
      use String_Set;
   begin
      S_Put
        (0,
         "--  This package has been generated "
         & "automatically by GNATtest.");
      New_Line_Count;
      S_Put
        (0,
         "--  You are allowed to add your code to "
         & "designated areas between read-only");
      New_Line_Count;
      S_Put
        (0,
         "--  sections. Such changes will be kept during "
         & "further regeneration of this");
      New_Line_Count;
      S_Put
        (0,
         "--  file. All code placed outside of such "
         & "areas will be lost during");
      New_Line_Count;
      S_Put
        (0,
         "--  regeneration of this package.");
      New_Line_Count;
      New_Line_Count;
      S_Put (0, GT_Marker_Begin);
      New_Line_Count;
      if Stub_Data then
         S_Put
           (0,
            "with "
            & Unit_Name
            & "."
            & Stub_Data_Unit_Name
            & "; use "
            & Unit_Name
            & "."
            & Stub_Data_Unit_Name
            & ";");
      end if;
      New_Line_Count;

      --  We need to put a regular with into the body for every limited with
      --  from the spec.
      while Cur /= String_Set.No_Element loop
         S_Put (0, "with " & String_Set.Element (Cur) & ";");
         New_Line_Count;
         Next (Cur);
      end loop;

      S_Put (0, GT_Marker_End);
      New_Line_Count;
      New_Line_Count;
   end Put_Stub_Header;

   procedure Process_Siblings (Cursor : Element_Node_Trees.Cursor)
   is
      Cur : Element_Node_Trees.Cursor := Cursor;
   begin
      while Cur /= Element_Node_Trees.No_Element loop
         Process_Node (Cur);
         Next_Sibling (Cur);
      end loop;
   end Process_Siblings;

   procedure Process_Node
     (Cursor : Element_Node_Trees.Cursor)
   is
      Node     : constant Element_Node := Element_Node_Trees.Element (Cursor);
      Arg_Kind : constant Flat_Element_Kinds :=
        Flat_Element_Kind (Node.Spec);
   begin
      case Arg_Kind is

         when A_Package_Declaration |
              A_Generic_Package_Declaration =>
            Generate_Package_Body (Node, Cursor);

         when A_Function_Declaration         |
              A_Function_Body_Stub           |
              A_Generic_Function_Declaration =>
            Generate_Function_Body (Node);

         when A_Procedure_Declaration        |
              A_Procedure_Body_Stub          |
              A_Generic_Procedure_Declaration =>
            Generate_Procedure_Body (Node);

         when An_Entry_Declaration =>
            Generate_Entry_Body (Node);

         when A_Single_Protected_Declaration |
              A_Protected_Type_Declaration =>
            Generate_Protected_Body (Node, Cursor);

         when A_Single_Task_Declaration |
              A_Task_Type_Declaration =>
            Generate_Task_Body (Node);

         when An_Incomplete_Type_Declaration       |
              A_Tagged_Incomplete_Type_Declaration =>
            Generate_Full_Type_Declaration (Node);

         when others =>
            Report_Err
              ("gnattest: unexpected element in the body structure");
            raise Fatal_Error;
      end case;
   end Process_Node;

   -----------------
   -- Gather_Data --
   -----------------

   procedure Gather_Data
     (The_Unit          :     Asis.Compilation_Unit;
      Data              : out Data_Holder) is separate;

   --------------------------
   -- Gather_Markered_Data --
   --------------------------

   procedure Gather_Markered_Data
     (File : String; Map : in out Markered_Data_Maps.Map)
   is
      Line : String_Access;

      Line_Counter : Natural := 0;

      ID_Found, Commented_Out : Boolean;

      MD : Markered_Data_Type;
      ID : Markered_Data_Id := (Unknown_MD, null, null, null, null);

      Input_File : Ada.Text_IO.File_Type;

      type Parsing_Modes is (Code, Marker, Other);

      Parsing_Mode      : Parsing_Modes := Other;
      Prev_Parsing_Mode : Parsing_Modes := Other;

      function Is_Marker_Start (S : String) return Boolean is
        (Trim (S, Both) = GT_Marker_Begin);
      function Is_Marker_End   (S : String) return Boolean is
        (Trim (S, Both) = GT_Marker_End);
      function Is_Id_String    (S : String) return Boolean is
        (Head (Trim (S, Both), 7) = "--  id:");

      procedure Parse_Id_String
        (S             :     String;
         MD            : out Markered_Data_Id;
         Commented_Out : out Boolean);

      procedure Parse_Id_String
        (S             :     String;
         MD            : out Markered_Data_Id;
         Commented_Out : out Boolean)
      is
         Str : constant String := Trim (S, Both);
         Idx1, Idx2 : Natural;
      begin
         Commented_Out := False;

         Idx1 := Str'First + 7;
         Idx2 := Index (Str, "/", Idx1 + 1);
         MD.Hash_Version := new String'(Str (Idx1 .. Idx2 - 1));

         Idx1 := Idx2 + 1;
         Idx2 := Index (Str, "/", Idx1 + 1);
         MD.Kind := MD_Kind_From_String (Str (Idx1 .. Idx2 - 1));
         if MD.Kind = Import_MD then
            --  Nothing else to parse for this type.
            MD.Self_Hash    := new String'("");
            MD.Nesting_Hash := new String'("");
            return;
         end if;

         Idx1 := Idx2 + 1;
         Idx2 := Index (Str, "/", Idx1 + 1);
         MD.Self_Hash := new String'(Str (Idx1 .. Idx2 - 1));

         Idx1 := Idx2 + 1;
         Idx2 := Index (Str, "/", Idx1 + 1);
         MD.Nesting_Hash := new String'(Str (Idx1 .. Idx2 - 1));

         Idx1 := Idx2 + 1;
         Idx2 := Index (Str, "/", Idx1 + 1);
         if Str (Idx1 .. Idx2 - 1) = "1" then
            Commented_Out := True;
         end if;

         Idx1 := Idx2 + 1;
         Idx2 := Index (Str, "/", Idx1 + 1);
         MD.Name := new String'(Str (Idx1 .. Idx2 - 1));
      end Parse_Id_String;
   begin
      if not Is_Regular_File (File) then
         return;
      end if;

      Open (Input_File, In_File, File);

      Trace (Me, "parsing " & File & " for markered blocks");
      Increase_Indent (Me);

      while not End_Of_File (Input_File) loop

         Line := new String'(Get_Line (Input_File));
         Line_Counter := Line_Counter + 1;

         case Parsing_Mode is
            when Code =>
               if Is_Marker_Start (Line.all) then
                  Map.Include (ID, MD);
                  Prev_Parsing_Mode := Code;
                  Parsing_Mode      := Marker;

                  MD.Lines := String_Vectors.Empty_Vector;
                  Trace
                    (Me,
                     "closing marker found at line"
                     & Natural'Image (Line_Counter));
               else
                  MD.Lines.Append (Line.all);
               end if;

            when Marker =>
               case Prev_Parsing_Mode is
                  when Other =>
                     if Is_Id_String (Line.all) then
                        Parse_Id_String (Line.all, ID, Commented_Out);
                        MD.Commneted_Out := Commented_Out;
                        ID_Found := True;
                        Trace
                          (Me,
                           "id string found at line"
                           & Natural'Image (Line_Counter));
                     end if;

                     if Is_Marker_End (Line.all) then
                        if ID_Found then
                           Prev_Parsing_Mode := Marker;
                           Parsing_Mode      := Code;
                           Trace
                             (Me,
                              "switching to 'Code' at line"
                              & Natural'Image (Line_Counter));
                        else
                           Prev_Parsing_Mode := Marker;
                           Parsing_Mode      := Other;
                           Trace
                             (Me,
                              "switching to 'Other' at line"
                              & Natural'Image (Line_Counter));
                        end if;
                     end if;

                  when Code =>
                     if Is_Marker_End (Line.all) then
                        Prev_Parsing_Mode := Marker;
                        Parsing_Mode      := Other;
                        Trace
                          (Me,
                           "switching to 'Other' at line"
                           & Natural'Image (Line_Counter));
                     end if;

                  when Marker =>
                     --  Can't happen.
                     null;
               end case;

            when Other =>
               if Is_Marker_Start (Line.all) then
                  Parsing_Mode := Marker;
                  Prev_Parsing_Mode := Other;
                  ID_Found := False;
                  Trace
                    (Me,
                     "opening marker found at line"
                     & Natural'Image (Line_Counter));
               end if;
         end case;

         Free (Line);
      end loop;

      Decrease_Indent (Me);
      Close (Input_File);
   end Gather_Markered_Data;

   ------------------------
   -- Generate_Body_Stub --
   ------------------------

   procedure Generate_Body_Stub
     (Body_File_Name : String;
      Data           : Data_Holder)
   is

      Tmp_File_Name      : constant String :=
        "gnattest_tmp_stub_body";
      Success : Boolean;

   begin
      Trace (Me, "generating body of " & Body_File_Name);
      Increase_Indent (Me);

      Create (Tmp_File_Name);
      Reset_Line_Counter;

      Put_Stub_Header
        (Element_Node_Trees.Element
           (First_Child (Data.Elem_Tree.Root)).Spec_Name.all,
         not Data.Flat_List.Is_Empty,
         Data.Limited_Withed_Units);
      Put_Import_Section (Markered_Data, Add_Import => True);

      Process_Siblings (First_Child (Data.Elem_Tree.Root));

      Close_File;

      declare
         F : File_Array_Access;
      begin
         Append (F, Dir (GNATCOLL.VFS.Create (+(Body_File_Name))));
         Create_Dirs (F);
      end;

      --  At this point temp package is coplete and it is safe
      --  to replace the old one with it.
      if Is_Regular_File (Body_File_Name) then
         Delete_File (Body_File_Name, Success);
         if not Success then
            Report_Err ("cannot delete " & Body_File_Name);
            raise Fatal_Error;
         end if;
      end if;
      Copy_File (Tmp_File_Name, Body_File_Name, Success);
      if not Success then
         Report_Err ("cannot copy tmp test package to "
                     & Body_File_Name);
         raise Fatal_Error;
      end if;
      Delete_File (Tmp_File_Name, Success);
      if not Success then
         Report_Err ("cannot delete tmp test package");
         raise Fatal_Error;
      end if;
      Decrease_Indent (Me);
   end Generate_Body_Stub;

   ----------------------------------
   -- Generate_Default_Setter_Spec --
   ----------------------------------

   procedure Generate_Default_Setter_Spec (Node : Element_Node) is

      ID     : constant Markered_Data_Id := Generate_MD_Id (Node.Spec);
      Suffix : constant String           := Hash_Suffix (ID);

      Param_List : Stubbed_Parameter_Lists.List :=
          Filter_Private_Parameters (Get_Args_List (Node));
      Cur        : Stubbed_Parameter_Lists.Cursor;

      Empty_Case           :          Boolean := Param_List.Is_Empty;
      Abstract_Res_Profile : constant Boolean :=
        not Empty_Case
        and then not Is_Nil (Param_List.Last_Element.Type_Elem)
        and then not Is_Only_Limited_Withed (Param_List.Last_Element.Type_Elem)
        and then Is_Abstract (Param_List.Last_Element.Type_Elem);

      SP : Stubbed_Parameter;

      Count : Natural;
   begin
      Trace (Me, "Generating default setter spec for " & Node.Spec_Name.all);
      if Abstract_Res_Profile and then not Empty_Case then
         --  No need to keep it in the parameters list.
         Param_List.Delete_Last;
      end if;
      Empty_Case := Param_List.Is_Empty;

      --  stub type
      S_Put
        (3,
         "type "
         & Stub_Type_Prefix
         & Node.Spec_Name.all
         & Suffix
         & " is record");
      New_Line_Count;

      Cur := Param_List.First;
      while Cur /= Stubbed_Parameter_Lists.No_Element loop
         SP := Stubbed_Parameter_Lists.Element (Cur);

         S_Put
           (6,
            SP.Name.all
            & " : "
            & SP.Type_Full_Name_Image.all
            & ";");
         New_Line_Count;

         Next (Cur);
      end loop;

      New_Line_Count;
      S_Put (6, Stub_Counter_Var & " : Natural := 0;");
      New_Line_Count;
      S_Put (3, "end record;");
      New_Line_Count;

      --  stub object
      S_Put
        (3,
         Stub_Object_Prefix
         & Node.Spec_Name.all
         & Suffix
         & " : "
         & Stub_Type_Prefix
         & Node.Spec_Name.all
         & Suffix & ";");
      New_Line_Count;

      --  setter
      S_Put
        (3,
         "procedure "
         & Setter_Prefix
         & Node.Spec_Name.all
         & Suffix);
      if not Empty_Case then
         New_Line_Count;
         S_Put (5, "(");

         Cur := Param_List.First;
         Count := 1;
         while Cur /= Stubbed_Parameter_Lists.No_Element loop
            SP := Stubbed_Parameter_Lists.Element (Cur);

            if Count = 1 then
               S_Put
                 (0,
                  SP.Name.all
                  & " : "
                  & SP.Type_Full_Name_Image.all
                  & " := "
                  & Stub_Object_Prefix
                  & Node.Spec_Name.all
                  & Suffix
                  & "."
                  & SP.Name.all);
            else
               S_Put
                 (6,
                  SP.Name.all
                  & " : "
                  & SP.Type_Full_Name_Image.all
                  & " := "
                  & Stub_Object_Prefix
                  & Node.Spec_Name.all
                  & Suffix
                  & "."
                  & SP.Name.all);
            end if;

            if Count = Natural (Param_List.Length) then
               S_Put (0, ");");
            else
               S_Put (0, ";");
            end if;
            New_Line_Count;

            Next (Cur);
            Count := Count + 1;
         end loop;
      else
         S_Put (0, ";");
         New_Line_Count;
      end if;

      Param_List.Clear;

   end Generate_Default_Setter_Spec;

   ----------------------------------
   -- Generate_Default_Setter_Body --
   ----------------------------------

   procedure Generate_Default_Setter_Body (Node : Element_Node) is

      ID     : constant Markered_Data_Id := Generate_MD_Id (Node.Spec);
      Suffix : constant String           := Hash_Suffix (ID);

      Param_List : Stubbed_Parameter_Lists.List :=
        Filter_Private_Parameters (Get_Args_List (Node));
      Cur        : Stubbed_Parameter_Lists.Cursor;

      Empty_Case           :          Boolean := Param_List.Is_Empty;
      Abstract_Res_Profile : constant Boolean :=
        not Empty_Case
        and then not Is_Nil (Param_List.Last_Element.Type_Elem)
        and then not Is_Only_Limited_Withed (Param_List.Last_Element.Type_Elem)
        and then Is_Abstract (Param_List.Last_Element.Type_Elem);

      SP : Stubbed_Parameter;

      Count : Natural;

      Non_Limited_Parameters : Boolean := False;
   begin
      Trace (Me, "Generating default setter body for " & Node.Spec_Name.all);
      if Abstract_Res_Profile and then not Empty_Case then
         --  No need to keep it in the parameters list.
         Param_List.Delete_Last;
      end if;
      Empty_Case := Param_List.Is_Empty;

      S_Put
        (3,
         "procedure "
         & Setter_Prefix
         & Node.Spec_Name.all
         & Suffix);
      if not Empty_Case then
         New_Line_Count;
         S_Put (5, "(");

         --  params declaration
         Cur := Param_List.First;
         Count := 1;
         while Cur /= Stubbed_Parameter_Lists.No_Element loop
            SP := Stubbed_Parameter_Lists.Element (Cur);

            if Count = 1 then
               S_Put
                 (0,
                  SP.Name.all
                  & " : "
                  & SP.Type_Full_Name_Image.all
                  & " := "
                  & Stub_Object_Prefix
                  & Node.Spec_Name.all
                  & Suffix
                  & "."
                  & SP.Name.all);
            else
               S_Put
                 (6,
                  SP.Name.all
                  & " : "
                  & SP.Type_Full_Name_Image.all
                  & " := "
                  & Stub_Object_Prefix
                  & Node.Spec_Name.all
                  & Suffix
                  & "."
                  & SP.Name.all);
            end if;

            if Count = Natural (Param_List.Length) then
               S_Put (0, ") is");
            else
               S_Put (0, ";");
            end if;
            New_Line_Count;

            Next (Cur);
            Count := Count + 1;
         end loop;

         S_Put (3, "begin");
         New_Line_Count;

         --  params setting
         Cur := Param_List.First;
         while Cur /= Stubbed_Parameter_Lists.No_Element loop
            SP := Stubbed_Parameter_Lists.Element (Cur);

            if not Is_Limited (SP.Type_Elem) then
               S_Put
                 (6,
                  Stub_Object_Prefix
                  & Node.Spec_Name.all
                  & Suffix
                  & "."
                  & SP.Name.all
                  & " := "
                  & SP.Name.all
                  & ";");
               New_Line_Count;

               Non_Limited_Parameters := True;
            end if;

            Next (Cur);
         end loop;
         if not Non_Limited_Parameters then
            S_Put (6, "null;");
         end if;
      else
         S_Put (1, " is");
         New_Line_Count;
         S_Put (3, "begin");
         New_Line_Count;
         S_Put (6, "null;");
         New_Line_Count;
      end if;

      New_Line_Count;

      S_Put
        (3,
         "end "
         & Setter_Prefix
         & Node.Spec_Name.all
         & Suffix
         & ";");
      New_Line_Count;
      New_Line_Count;

      Param_List.Clear;

   end Generate_Default_Setter_Body;

   -------------------------
   -- Generate_Entry_Body --
   -------------------------

   procedure Generate_Entry_Body (Node : Element_Node) is
      ID  : constant Markered_Data_Id := Generate_MD_Id (Node.Spec);
      MD  : Markered_Data_Type;

      Parameters : constant Asis.Element_List := Parameter_Profile (Node.Spec);
      Family_Def : constant Asis.Element :=
        Entry_Family_Definition (Node.Spec);
   begin
      Trace (Me, "Generating entry body for " & Node.Spec_Name.all);

      S_Put (0, GT_Marker_Begin);
      New_Line_Count;

      Add_Entity_To_Local_List (Node, New_Line_Counter, Level * Indent_Level);

      S_Put
        (Level * Indent_Level,
         "entry " & Node.Spec_Name.all);
      if not Is_Nil (Family_Def) then
         S_Put
           (0,
            " (for I in "
            & To_String (ASIS_Trim (Element_Image (Family_Def)))
            & ")");
      end if;
      New_Line_Count;

      if not Is_Nil (Parameters) then
         S_Put
          (Level * Indent_Level + 2, "(");

         for I in Parameters'Range loop
            if I = Parameters'First then
               S_Put
                 (0,
                  To_String (ASIS_Trim (Element_Image (Parameters (I)))));
            else
               S_Put
                 ((Level + 1) * Indent_Level,
                  To_String (ASIS_Trim (Element_Image (Parameters (I)))));
            end if;

            if I = Parameters'Last then
               S_Put (0, ") when");
            else
               S_Put (0, ";");
            end if;
            New_Line_Count;
         end loop;
      else
         S_Put
           (Level * Indent_Level + 2, "when");
         New_Line_Count;
      end if;

      S_Put
        ((Level + 1) * Indent_Level,
         Generate_MD_Id_String (Node.Spec));
      New_Line_Count;
      S_Put ((Level + 1) * Indent_Level, "--");
      New_Line_Count;
      S_Put
        ((Level + 1) * Indent_Level,
        "--  This section can be used to change entry body.");
      New_Line_Count;
      S_Put ((Level + 1) * Indent_Level, "--");
      New_Line_Count;

      S_Put (0, GT_Marker_End);
      New_Line_Count;

      --  Put body
      if Markered_Data.Contains (ID) then
         --  Extract importing MD
         MD := Markered_Data.Element (ID);
         Put_Lines (MD, Comment_Out => False);

         Markered_Data.Delete (ID);
      else
         New_Line_Count;
         S_Put (Level * Indent_Level + 2, " Standard.True");
         New_Line_Count;
         S_Put (Level * Indent_Level, "is");
         New_Line_Count;
         S_Put ((Level) * Indent_Level, "begin");
         New_Line_Count;
         S_Put
           ((Level + 1) * Indent_Level,
            "null;");
         New_Line_Count;
      end if;

      S_Put (0, GT_Marker_Begin);
         New_Line_Count;
      S_Put ((Level) * Indent_Level, "end " & Node.Spec_Name.all & ";");
      New_Line_Count;
      New_Line_Count;
      S_Put (0, GT_Marker_End);
      New_Line_Count;
      New_Line_Count;
   end Generate_Entry_Body;

   ------------------------------------
   -- Generate_Full_Type_Declaration --
   ------------------------------------

   procedure Generate_Full_Type_Declaration (Node : Element_Node) is
      Discr_Part : constant Asis.Element := Discriminant_Part (Node.Spec);
      Is_Tagged  : constant Boolean      := Flat_Element_Kind (Node.Spec) =
        A_Tagged_Incomplete_Type_Declaration;

      ID  : constant Markered_Data_Id := Generate_MD_Id (Node.Spec);
      MD  : Markered_Data_Type;
   begin
      Trace (Me, "Generating full type declaration for " & Node.Spec_Name.all);

      S_Put (0, GT_Marker_Begin);
      New_Line_Count;

      Add_Entity_To_Local_List (Node, New_Line_Counter, Level * Indent_Level);

      S_Put
        (Level * Indent_Level,
        "type " & Node.Spec_Name.all & " ");
      if Flat_Element_Kind (Discr_Part) = A_Known_Discriminant_Part then
         S_Put (0, To_String (ASIS_Trim (Element_Image (Discr_Part))) & " ");
      end if;
      S_Put (0, "is");
      if Is_Tagged then
         S_Put (0, " tagged");
      end if;
      New_Line_Count;

      S_Put
        ((Level) * Indent_Level,
         Generate_MD_Id_String (Node.Spec));
      New_Line_Count;
      S_Put ((Level) * Indent_Level, "--");
      New_Line_Count;
      S_Put
        ((Level) * Indent_Level,
        "--  This section can be used for changing type completion.");
      New_Line_Count;
      S_Put ((Level) * Indent_Level, "--");
      New_Line_Count;

      S_Put (0, GT_Marker_End);
      New_Line_Count;

      --  Put bodies

      if Markered_Data.Contains (ID) then
         --  Extract importing MD
         MD := Markered_Data.Element (ID);
         Put_Lines (MD, Comment_Out => False);

         Markered_Data.Delete (ID);
      else
         New_Line_Count;
         S_Put
           ((Level) * Indent_Level + 2,
            "null record;");
         New_Line_Count;
         New_Line_Count;
      end if;

      S_Put (0, GT_Marker_Begin);
      New_Line_Count;
      S_Put (0, GT_Marker_End);
      New_Line_Count;
      New_Line_Count;
   end Generate_Full_Type_Declaration;

   ----------------------------
   -- Generate_Function_Body --
   ----------------------------

   procedure Generate_Function_Body (Node : Element_Node) is
      ID  : constant Markered_Data_Id := Generate_MD_Id (Node.Spec);
      MD  : Markered_Data_Type;

      Arg_Kind  : constant Flat_Element_Kinds := Flat_Element_Kind (Node.Spec);
      Parameters : constant Asis.Element_List := Parameter_Profile (Node.Spec);
      Res_Profile : constant Asis.Element     := Result_Profile (Node.Spec);

      Param_List : constant Stubbed_Parameter_Lists.List :=
        Get_Args_List (Node);
      Cur        :          Stubbed_Parameter_Lists.Cursor;

      SP : Stubbed_Parameter;

      Suffix : constant String := Hash_Suffix (ID);

      Not_Empty_Stub : constant Boolean :=
        Arg_Kind = A_Function_Declaration and then
        (not Node.Inside_Generic) and then
        Flat_Element_Kind
          (Enclosing_Element (Node.Spec)) /= A_Protected_Definition;

      Count : Natural;

      procedure Output_Fake_Parameters;
      --  Prints out the fake parameters of the fake recursive call of the
      --  function to itself

      function Func_Name_For_Warning (Decl : Asis.Declaration) return String is
        (if
           Defining_Name_Kind (First_Name (Decl)) = A_Defining_Operator_Symbol
         then
            """" & To_String_First_Name (Decl) & """"
         else
            To_String_First_Name (Decl));

      procedure Output_Fake_Parameters is
      begin
         S_Put (0, " (");

         for J in Parameters'Range loop

            declare
               Formal_Names : constant Asis.Element_List :=
                 Names (Parameters (J));
            begin

               for K in Formal_Names'Range loop
                  S_Put
                    (0,
                     To_String (Defining_Name_Image (Formal_Names (K)))
                     & " => "
                     & To_String (Defining_Name_Image (Formal_Names (K))));
                  if K /= Formal_Names'Last or else J /= Parameters'Last then
                     S_Put (0, ", ");
                  end if;
               end loop;

            end;

         end loop;

         S_Put (0, ");");

      end Output_Fake_Parameters;

      Has_Limited_Params      : Boolean := False;
      Has_Limited_View_Params : Boolean := False;
      Has_Private_Params      : Boolean := False;
   begin
      Trace (Me, "Generating function body for " & Node.Spec_Name.all);
      Increase_Indent (Me);

      --  Node.Spec_Name cannot be referenced here since it will be translated
      --  for operators.

      S_Put (0, GT_Marker_Begin);
      New_Line_Count;

      Add_Entity_To_Local_List (Node, New_Line_Counter, Level * Indent_Level);

      if Is_Overriding_Declaration (Node.Spec) then
         S_Put (Level * Indent_Level, "overriding");
         New_Line_Count;
      elsif Is_Not_Overriding_Declaration (Node.Spec) then
         S_Put (Level * Indent_Level, "not overriding");
         New_Line_Count;
      end if;

      S_Put
        (Level * Indent_Level,
         "function "
         & To_String (Defining_Name_Image (First_Name (Node.Spec))));

      if Is_Nil (Parameters) then
         S_Put
           (0,
            " return "
            & To_String (ASIS_Trim (Element_Image (Res_Profile)))
            & " is");
         New_Line_Count;
      else
         New_Line_Count;
         S_Put
          (Level * Indent_Level + 2, "(");

         for I in Parameters'Range loop
            if I = Parameters'First then
               S_Put
                 (0,
                  To_String (ASIS_Trim (Element_Image (Parameters (I)))));
            else
               S_Put
                 ((Level + 1) * Indent_Level,
                  To_String (ASIS_Trim (Element_Image (Parameters (I)))));
            end if;

            if I = Parameters'Last then
               S_Put
                 (0,
                  ") return "
                  & To_String (ASIS_Trim (Element_Image (Res_Profile)))
                  & " is");
            else
               S_Put (0, ";");
            end if;
            New_Line_Count;
         end loop;
      end if;

      S_Put
        ((Level + 1) * Indent_Level,
         Generate_MD_Id_String (Node.Spec));
      New_Line_Count;
      S_Put ((Level + 1) * Indent_Level, "--");
      New_Line_Count;
      S_Put
        ((Level + 1) * Indent_Level,
        "--  This section can be used to change the function body.");
      New_Line_Count;
      S_Put ((Level + 1) * Indent_Level, "--");
      New_Line_Count;

      S_Put (0, GT_Marker_End);
      New_Line_Count;

      --  Put body
      if Markered_Data.Contains (ID) then
         --  Extract importing MD
         MD := Markered_Data.Element (ID);
         Put_Lines (MD, Comment_Out => False);

         Markered_Data.Delete (ID);
      else
         New_Line_Count;
         S_Put ((Level) * Indent_Level, "begin");
         New_Line_Count;
         if Not_Empty_Stub then
            S_Put
              (6,
               Stub_Object_Prefix
               & Node.Spec_Name.all
               & Suffix
               & "."
               & Stub_Counter_Var
               & " := "
               & Stub_Object_Prefix
               & Node.Spec_Name.all
               & Suffix
               & "."
               & Stub_Counter_Var
               & " + 1;");
            New_Line_Count;

            Count := 1;
            Cur := Param_List.First;
            --  Last one is the result of the function. Need to process it
            --  separately afterwards.
            while Cur /= Param_List.Last loop
               SP := Stubbed_Parameter_Lists.Element (Cur);

               if Is_Only_Limited_Withed (SP.Type_Elem) then
                  Has_Limited_View_Params := True;
               elsif Is_Limited (SP.Type_Elem) then
                  Has_Limited_Params := True;
               elsif Is_Fully_Private (SP.Type_Elem) then
                  Has_Private_Params := True;
               else

                  case SP.Kind is
                     when Constrained =>
                        S_Put
                          ((Level + 1) * Indent_Level,
                           SP.Name.all
                           & " := "
                           & Stub_Data_Unit_Name
                           & "."
                           & Stub_Object_Prefix
                           & Node.Spec_Name.all
                           & Suffix
                           & "."
                           & SP.Name.all
                           & ";");
                     when Not_Constrained =>
                        S_Put
                          ((Level + 1) * Indent_Level,
                           SP.Name.all
                           & " := "
                           & Stub_Data_Unit_Name
                           & "."
                           & Stub_Object_Prefix
                           & Node.Spec_Name.all
                           & Suffix
                           & "."
                           & SP.Name.all
                           & ".all;");
                     when Access_Kind =>
                        S_Put
                          ((Level + 1) * Indent_Level,
                           SP.Name.all
                           & ".all := "
                           & Stub_Data_Unit_Name
                           & "."
                           & Stub_Object_Prefix
                           & Node.Spec_Name.all
                           & Suffix
                           & "."
                           & SP.Name.all
                           & ".all;");
                  end case;

                  New_Line_Count;

               end if;

               Count := Count + 1;
               Next (Cur);
            end loop;

            --  processing result profile
            SP := Param_List.Last_Element;
            if
              Is_Only_Limited_Withed (SP.Type_Elem) or else
              Is_Abstract (SP.Type_Elem) or else Is_Limited (SP.Type_Elem)
              or else Is_Fully_Private (SP.Type_Elem)
            then
               S_Put
                 ((Level + 1) * Indent_Level,
                  "pragma Compile_Time_Warning");
               New_Line_Count;
               S_Put
                 ((Level + 1) * Indent_Level + 2,
                  "(Standard.True,");
               New_Line_Count;
               S_Put
                 ((Level + 2) * Indent_Level,
                  """Stub for "
                  & Func_Name_For_Warning (Node.Spec)
                  & " is unimplemented,""");
               New_Line_Count;
               S_Put
                 ((Level + 2) * Indent_Level,
                  "& "" this might affect some tests"");");
               New_Line_Count;
               S_Put
                 ((Level + 1) * Indent_Level,
                  "raise Program_Error with ""Unimplemented stub for function "
                  & Node.Spec_Name.all
                  & """;");
               New_Line_Count;
               S_Put
                 ((Level + 1) * Indent_Level,
                  "return "
                  & To_String (Defining_Name_Image (First_Name (Node.Spec))));
               if Is_Nil (Parameters) then
                  S_Put (0, ";");
               else
                  Output_Fake_Parameters;
               end if;
            else
               case SP.Kind is
                  when Constrained | Access_Kind =>
                     S_Put
                       ((Level + 1) * Indent_Level,
                        "return "
                        & Stub_Data_Unit_Name
                        & "."
                        & Stub_Object_Prefix
                        & Node.Spec_Name.all
                        & Suffix
                        & "."
                        & SP.Name.all
                        & ";");
                  when Not_Constrained =>
                     S_Put
                       ((Level + 1) * Indent_Level,
                        "return "
                        & Stub_Data_Unit_Name
                        & "."
                        & Stub_Object_Prefix
                        & Node.Spec_Name.all
                        & Suffix
                        & "."
                        & SP.Name.all
                        & ".all;");
               end case;
            end if;
            New_Line_Count;

         else
            S_Put
              ((Level + 1) * Indent_Level,
               "pragma Compile_Time_Warning");
            New_Line_Count;
            S_Put
              ((Level + 1) * Indent_Level + 2,
               "(Standard.True,");
            New_Line_Count;
            S_Put
              ((Level + 2) * Indent_Level,
               """Stub for "
               & Func_Name_For_Warning (Node.Spec)
               & " is unimplemented,""");
            New_Line_Count;
            S_Put
              ((Level + 2) * Indent_Level,
               "& "" this might affect some tests"");");
            New_Line_Count;
            S_Put
              ((Level + 1) * Indent_Level,
               "raise Program_Error with ""Unimplemented stub for function "
               & Node.Spec_Name.all
               & """;");
            New_Line_Count;
            S_Put
              ((Level + 1) * Indent_Level,
               "return "
               & To_String (Defining_Name_Image (First_Name (Node.Spec))));
            if Is_Nil (Parameters) then
               S_Put (0, ";");
            else
               Output_Fake_Parameters;
            end if;
            New_Line_Count;
         end if;
      end if;

      S_Put (0, GT_Marker_Begin);
      New_Line_Count;
      S_Put
        ((Level) * Indent_Level,
         "end "
         & To_String (Defining_Name_Image (First_Name (Node.Spec)))
         & ";");
      New_Line_Count;
      New_Line_Count;
      S_Put (0, GT_Marker_End);
      New_Line_Count;
      New_Line_Count;

      if Has_Limited_Params then
         Report_Std
           ("warning: (gnattest) "
            & Base_Name
              (To_String
                   (Text_Name (Enclosing_Compilation_Unit (Node.Spec))))
            & ":"
            & Trim (Integer'Image (First_Line_Number (Node.Spec)), Both)
            & ":"
            & Trim (Integer'Image (First_Column_Number (Node.Spec)), Both)
            & ": "
            & To_String (Defining_Name_Image (First_Name (Node.Spec)))
            & " has limited type parameter, generated setter is incomplete");
      end if;

      if Has_Limited_View_Params then
         Report_Std
           ("warning: (gnattest) "
            & Base_Name
              (To_String (Text_Name (Enclosing_Compilation_Unit (Node.Spec))))
            & ":"
            & Trim (Integer'Image (First_Line_Number (Node.Spec)), Both)
            & ":"
            & Trim (Integer'Image (First_Column_Number (Node.Spec)), Both)
            & ": "
            & Node.Spec_Name.all
            & " type of a parameter of this subprogram has limited view only, "
            & "generated setter is incomplete");
      end if;

      if Has_Private_Params then
         Report_Std
           ("warning: (gnattest) "
            & Base_Name
              (To_String (Text_Name (Enclosing_Compilation_Unit (Node.Spec))))
            & ":"
            & Trim (Integer'Image (First_Line_Number (Node.Spec)), Both)
            & ":"
            & Trim (Integer'Image (First_Column_Number (Node.Spec)), Both)
            & ": "
            & Node.Spec_Name.all
            & " has private type parameter, generated setter is incomplete");
      end if;

      Decrease_Indent (Me);

   end Generate_Function_Body;

   ---------------------------
   -- Generate_MD_Id_String --
   ---------------------------

   function Generate_MD_Id_String
     (Element       : Asis.Element;
      Commented_Out : Boolean := False) return String
   is
      Id  : constant Markered_Data_Id := Generate_MD_Id (Element);
   begin
      return Generate_MD_Id_String (Id, Commented_Out);
   end Generate_MD_Id_String;

   ---------------------------
   -- Generate_MD_Id_String --
   ---------------------------

   function Generate_MD_Id_String
     (Id            : Markered_Data_Id;
      Commented_Out : Boolean := False) return String
   is
      Res : constant String :=
        "--  id:"
        & Hash_Version
        & "/"
        & MD_Kind_To_String (Id.Kind)
        & "/"
        & Id.Self_Hash.all
        & "/"
        & Id.Nesting_Hash.all
        & "/"
        & (if Commented_Out then "1" else "0")
        & "/"
        & Id.Name.all
        & "/";
   begin
      return Res;
   end Generate_MD_Id_String;

   --------------------
   -- Generate_MD_Id --
   --------------------

   function Generate_MD_Id (Element : Asis.Element)
                            return Markered_Data_Id
   is
      Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (Element);
      Id       : Markered_Data_Id;
   begin
      Id.Hash_Version := new String'(Hash_Version);
      case Arg_Kind is
         when An_Incomplete_Type_Declaration       |
              A_Tagged_Incomplete_Type_Declaration =>
            Id.Kind := Type_MD;
            Id.Self_Hash := new String'
              (Substring_16
                 (GNAT.SHA1.Digest (To_String_First_Name (Element))));

         when A_Task_Type_Declaration         |
              A_Single_Task_Declaration       =>
            Id.Kind := Task_MD;
            Id.Self_Hash := new String'
              (Substring_16
                 (GNAT.SHA1.Digest (To_String_First_Name (Element))));

         when A_Package_Declaration           |
              A_Generic_Package_Declaration   =>
            Id.Kind := Package_MD;
            Id.Self_Hash := new String'
              (Substring_16
                 (GNAT.SHA1.Digest (To_String_First_Name (Element))));

         when A_Generic_Procedure_Declaration |
              A_Generic_Function_Declaration  |
              A_Procedure_Declaration         |
              A_Function_Declaration          =>
            Id.Kind := Subprogram_MD;
            if
              Arg_Kind in
                A_Generic_Function_Declaration |
                A_Generic_Procedure_Declaration
            then
               Id.Self_Hash := new String'
                 (Substring_16
                   (GNAT.SHA1.Digest (To_String_First_Name (Element))));
            else
               Id.Self_Hash := new String'
                 (Substring_16
                    (Mangle_Hash_Full (Element, For_Stubs => True)));
            end if;

         when An_Entry_Declaration =>
            Id.Kind := Entry_MD;
            Id.Self_Hash := new String'
              (Substring_16
                 (GNAT.SHA1.Digest (To_String_First_Name (Element))));

         when others =>
            null;
      end case;

      Id.Nesting_Hash := new String'
        (Substring_16 (GNAT.SHA1.Digest (Get_Nesting (Element))));
      Id.Name         := new String'
        (To_String (Defining_Name_Image (First_Name (Element))));

      return Id;
   end Generate_MD_Id;

   ---------------------------
   -- Generate_Package_Body --
   ---------------------------

   procedure Generate_Package_Body
     (Node : Element_Node; Cursor : Element_Node_Trees.Cursor)
   is
      Cur : constant Element_Node_Trees.Cursor := Cursor;
      ID  :          Markered_Data_Id := Generate_MD_Id (Node.Spec);
      MD  :          Markered_Data_Type;
   begin
      if Is_Leaf (Cur) and then not Is_Root (Parent (Cur)) then
         --  nothing to worry about
         return;
      end if;

      Trace (Me, "Generating package body for " & Node.Spec_Name.all);

      --  Put local declaration section
      S_Put (0, GT_Marker_Begin);
      New_Line_Count;

      Add_Entity_To_Local_List (Node, New_Line_Counter, Level * Indent_Level);

      S_Put
        (Level * Indent_Level,
        "package body " & Node.Spec_Name.all);
      New_Line_Count;

      Level := Level + 1;
      S_Put
        ((Level) * Indent_Level,
         Generate_MD_Id_String (Node.Spec));
      New_Line_Count;
      S_Put ((Level) * Indent_Level, "--");
      New_Line_Count;
      S_Put
        ((Level) * Indent_Level,
        "--  This section can be used for local declarations.");
      New_Line_Count;
      S_Put ((Level) * Indent_Level, "--");
      New_Line_Count;

      S_Put (0, GT_Marker_End);
      New_Line_Count;

      --  Put bodies

      if Markered_Data.Contains (ID) then
         --  Extract importing MD
         MD := Markered_Data.Element (ID);
         Put_Lines (MD, Comment_Out => False);

         Markered_Data.Delete (ID);
      else
         New_Line_Count;
         S_Put
           ((Level - 1) * Indent_Level, "is");
         New_Line_Count;
      end if;

      S_Put (0, GT_Marker_Begin);
      New_Line_Count;
      S_Put (0, GT_Marker_End);
      New_Line_Count;
      New_Line_Count;

      if not Is_Leaf (Cur) then
         Process_Siblings (First_Child (Cur));
      end if;

      --  Put possible Elab sections
      S_Put (0, GT_Marker_Begin);
      New_Line_Count;

      ID.Kind := Elaboration_MD;
      S_Put
        ((Level) * Indent_Level,
         Generate_MD_Id_String (ID));
      New_Line_Count;
      S_Put ((Level) * Indent_Level, "--");
      New_Line_Count;
      S_Put
        (Level * Indent_Level,
        "--  This section can be used for elaboration statements.");
      New_Line_Count;
      S_Put ((Level) * Indent_Level, "--");
      New_Line_Count;
      S_Put (0, GT_Marker_End);
      New_Line_Count;

      if Markered_Data.Contains (ID) then
         --  Extract importing MD
         MD := Markered_Data.Element (ID);
         Put_Lines (MD, Comment_Out => False);

         Markered_Data.Delete (ID);
      else
         New_Line_Count;
      end if;

      --  Put end package
      Level := Level - 1;
      S_Put (0, GT_Marker_Begin);
      New_Line_Count;
      S_Put
        (Level * Indent_Level,
        "end " & Node.Spec_Name.all & ";");
      New_Line_Count;
      S_Put (0, GT_Marker_End);
      New_Line_Count;
      New_Line_Count;

      --  If we are in the root package, we have to print all the dangling
      --  elements (if any);
      if Is_Root (Parent (Cur)) then
         if not Markered_Data.Is_Empty then
            Report_Std
              (" warning: "
               & Node.Spec_Name.all
               & " has dangling element(s)");

            Put_Dangling_Elements;
         end if;
      end if;

   end Generate_Package_Body;

   -----------------------------
   -- Generate_Procedure_Body --
   -----------------------------

   procedure Generate_Procedure_Body (Node : Element_Node) is
      ID  : constant Markered_Data_Id := Generate_MD_Id (Node.Spec);
      MD  : Markered_Data_Type;

      Arg_Kind  : constant Flat_Element_Kinds := Flat_Element_Kind (Node.Spec);
      Parameters : constant Asis.Element_List := Parameter_Profile (Node.Spec);

      Param_List : constant Stubbed_Parameter_Lists.List :=
        Get_Args_List (Node);
      Cur        :          Stubbed_Parameter_Lists.Cursor;

      SP : Stubbed_Parameter;

      Suffix : constant String := Hash_Suffix (ID);

      Not_Empty_Stub : constant Boolean :=
        Arg_Kind = A_Procedure_Declaration and then
        (not Node.Inside_Generic) and then

        Flat_Element_Kind
          (Enclosing_Element (Node.Spec)) /= A_Protected_Definition;

      Has_Limited_Params      : Boolean := False;
      Has_Limited_View_Params : Boolean := False;
      Has_Private_Params      : Boolean := False;
   begin
      Trace (Me, "Generating procedure body for " & Node.Spec_Name.all);
      Increase_Indent (Me);
      S_Put (0, GT_Marker_Begin);
      New_Line_Count;

      Add_Entity_To_Local_List (Node, New_Line_Counter, Level * Indent_Level);

      if Is_Overriding_Declaration (Node.Spec) then
         S_Put (Level * Indent_Level, "overriding");
         New_Line_Count;
      elsif Is_Not_Overriding_Declaration (Node.Spec) then
         S_Put (Level * Indent_Level, "not overriding");
         New_Line_Count;
      end if;

      S_Put (Level * Indent_Level, "procedure " & Node.Spec_Name.all);

      if Is_Nil (Parameters) then
         S_Put (0, " is");
         New_Line_Count;
      else
         New_Line_Count;
         S_Put
          (Level * Indent_Level + 2, "(");

         for I in Parameters'Range loop
            if I = Parameters'First then
               S_Put
                 (0,
                  To_String (ASIS_Trim (Element_Image (Parameters (I)))));
            else
               S_Put
                 ((Level + 1) * Indent_Level,
                  To_String (ASIS_Trim (Element_Image (Parameters (I)))));
            end if;

            if I = Parameters'Last then
               S_Put (0, ") is");
            else
               S_Put (0, ";");
            end if;
            New_Line_Count;
         end loop;
      end if;

      S_Put
        ((Level + 1) * Indent_Level,
         Generate_MD_Id_String (Node.Spec));
      New_Line_Count;
      S_Put ((Level + 1) * Indent_Level, "--");
      New_Line_Count;
      S_Put
        ((Level + 1) * Indent_Level,
        "--  This section can be used to change the procedure body.");
      New_Line_Count;
      S_Put ((Level + 1) * Indent_Level, "--");
      New_Line_Count;

      S_Put (0, GT_Marker_End);
      New_Line_Count;

      --  Put body
      if Markered_Data.Contains (ID) then
         --  Extract importing MD
         MD := Markered_Data.Element (ID);
         Put_Lines (MD, Comment_Out => False);

         Markered_Data.Delete (ID);
      else
         New_Line_Count;
         S_Put ((Level) * Indent_Level, "begin");
         New_Line_Count;
         if Not_Empty_Stub then
            New_Line_Count;
            S_Put
              (6,
               Stub_Object_Prefix
               & Node.Spec_Name.all
               & Suffix
               & "."
               & Stub_Counter_Var
               & " := "
               & Stub_Object_Prefix
               & Node.Spec_Name.all
               & Suffix
               & "."
               & Stub_Counter_Var
               & " + 1;");
            New_Line_Count;
            if not Param_List.Is_Empty then
               Cur := Param_List.First;
               while Cur /= Stubbed_Parameter_Lists.No_Element loop
                  SP := Stubbed_Parameter_Lists.Element (Cur);

                  if Is_Only_Limited_Withed (SP.Type_Elem) then
                     Has_Limited_View_Params := True;
                  elsif Is_Limited (SP.Type_Elem) then
                     Has_Limited_Params := True;
                  elsif Is_Fully_Private (SP.Type_Elem) then
                     Has_Private_Params := True;
                  else

                     case SP.Kind is
                        when Constrained =>
                           S_Put
                             ((Level + 1) * Indent_Level,
                              SP.Name.all
                              & " := "
                              & Stub_Data_Unit_Name
                              & "."
                              & Stub_Object_Prefix
                              & Node.Spec_Name.all
                              & Suffix
                              & "."
                              & SP.Name.all
                              & ";");
                        when Not_Constrained =>
                           S_Put
                             ((Level + 1) * Indent_Level,
                              SP.Name.all
                              & " := "
                              & Stub_Data_Unit_Name
                              & "."
                              & Stub_Object_Prefix
                              & Node.Spec_Name.all
                              & Suffix
                              & "."
                              & SP.Name.all
                              & ".all;");
                        when Access_Kind =>
                           S_Put
                             ((Level + 1) * Indent_Level,
                              SP.Name.all
                              & ".all := "
                              & Stub_Data_Unit_Name
                              & "."
                              & Stub_Object_Prefix
                              & Node.Spec_Name.all
                              & Suffix
                              & "."
                              & SP.Name.all
                              & ".all;");
                     end case;

                     New_Line_Count;

                  end if;

                  Next (Cur);
               end loop;
            end if;
         else
            S_Put
              ((Level + 1) * Indent_Level,
               "pragma Compile_Time_Warning");
            New_Line_Count;
            S_Put
              ((Level + 1) * Indent_Level + 2,
               "(Standard.True,");
            New_Line_Count;
            S_Put
              ((Level + 2) * Indent_Level,
               """Stub for "
               & Node.Spec_Name.all
               & " is unimplemented,""");
            New_Line_Count;
            S_Put
              ((Level + 2) * Indent_Level,
               "& "" this might affect some tests"");");
            New_Line_Count;
            S_Put
              ((Level + 1) * Indent_Level,
               "null;");
            New_Line_Count;
         end if;
      end if;

      S_Put (0, GT_Marker_Begin);
         New_Line_Count;
      S_Put ((Level) * Indent_Level, "end " & Node.Spec_Name.all & ";");
      New_Line_Count;
      New_Line_Count;
      S_Put (0, GT_Marker_End);
      New_Line_Count;
      New_Line_Count;

      if Has_Limited_Params then
         Report_Std
           ("warning: (gnattest) "
            & Base_Name
              (To_String (Text_Name (Enclosing_Compilation_Unit (Node.Spec))))
            & ":"
            & Trim (Integer'Image (First_Line_Number (Node.Spec)), Both)
            & ":"
            & Trim (Integer'Image (First_Column_Number (Node.Spec)), Both)
            & ": "
            & Node.Spec_Name.all
            & " has limited type parameter, generated setter is incomplete");
      end if;

      if Has_Limited_View_Params then
         Report_Std
           ("warning: (gnattest) "
            & Base_Name
              (To_String (Text_Name (Enclosing_Compilation_Unit (Node.Spec))))
            & ":"
            & Trim (Integer'Image (First_Line_Number (Node.Spec)), Both)
            & ":"
            & Trim (Integer'Image (First_Column_Number (Node.Spec)), Both)
            & ": "
            & Node.Spec_Name.all
            & " has parameter of a limited view type, "
            & "generated setter is incomplete");
      end if;

      if Has_Private_Params then
         Report_Std
           ("warning: (gnattest) "
            & Base_Name
              (To_String (Text_Name (Enclosing_Compilation_Unit (Node.Spec))))
            & ":"
            & Trim (Integer'Image (First_Line_Number (Node.Spec)), Both)
            & ":"
            & Trim (Integer'Image (First_Column_Number (Node.Spec)), Both)
            & ": "
            & Node.Spec_Name.all
            & " has private type parameter, generated setter is incomplete");
      end if;

      Decrease_Indent (Me);

   end Generate_Procedure_Body;

   -----------------------------
   -- Generate_Protected_Body --
   -----------------------------

   procedure Generate_Protected_Body
     (Node : Element_Node; Cursor : Element_Node_Trees.Cursor)
   is
      Cur : constant Element_Node_Trees.Cursor := Cursor;
   begin
      Trace (Me, "Generating protected body for " & Node.Spec_Name.all);

      S_Put (0, GT_Marker_Begin);
      New_Line_Count;

      Add_Entity_To_Local_List (Node, New_Line_Counter, Level * Indent_Level);

      S_Put
        (Level * Indent_Level,
        "protected body " & Node.Spec_Name.all & " is");
      New_Line_Count;
      S_Put (0, GT_Marker_End);
      New_Line_Count;
      New_Line_Count;

      Level := Level + 1;
      if not Is_Leaf (Cur) then
         Process_Siblings (First_Child (Cur));
      end if;

      Level := Level - 1;
      S_Put (0, GT_Marker_Begin);
      New_Line_Count;
      S_Put
        (Level * Indent_Level,
        "end " & Node.Spec_Name.all & ";");
      New_Line_Count;
      S_Put (0, GT_Marker_End);
      New_Line_Count;
      New_Line_Count;

   end Generate_Protected_Body;

   ------------------------
   -- Generate_Stub_Data --
   ------------------------

   procedure Generate_Stub_Data
     (Stub_Data_File_Spec : String;
      Stub_Data_File_Body : String;
      Data                : Data_Holder)
   is
      Node      :          Element_Node;
      Root_Node : constant Element_Node :=
        Element_Node_Trees.Element (First_Child (Data.Elem_Tree.Root));

      Tmp_File_Name      : constant String :=
        "gnattest_tmp_stub_body";
      Success : Boolean;

      Cur    : Element_Node_Lists.Cursor;
      MD_Cur : Markered_Data_Maps.Cursor;

      ID : Markered_Data_Id;
      MD : Markered_Data_Type;

      D_Cur : Access_Dictionaries.Cursor;
   begin
      if Data.Flat_List.Is_Empty then
         Excluded_Test_Data_Files.Include (Base_Name (Stub_Data_File_Spec));
         Excluded_Test_Data_Files.Include (Base_Name (Stub_Data_File_Body));
         return;
      end if;

      --  Spec
      Gather_Markered_Data (Stub_Data_File_Spec, Markered_Subp_Data);
      Trace
        (Me,
         "generating stub data spec for "
         & Root_Node.Spec_Name.all
         & "."
         & Stub_Data_Unit_Name);
      Increase_Indent (Me);
      Create (Tmp_File_Name);
      Reset_Line_Counter;

      Put_Import_Section (Markered_Subp_Data);

      S_Put
        (0,
         "package "
         & Root_Node.Spec_Name.all
         & "."
         & Stub_Data_Unit_Name
         & " is");
      New_Line_Count;

      D_Cur := Dictionary.First;
      while D_Cur /= Access_Dictionaries.No_Element loop
         S_Put (3, Access_Dictionaries.Element (D_Cur).Entry_Str.all);
         New_Line_Count;
         Next (D_Cur);
      end loop;

      New_Line_Count;

      Cur := Data.Flat_List.First;
      while Cur /= Element_Node_Lists.No_Element loop
         Node := Element_Node_Lists.Element (Cur);

         S_Put (0, GT_Marker_Begin);
         New_Line_Count;
         S_Put (3, Generate_MD_Id_String (Node.Spec));
         New_Line_Count;
         S_Put (0, GT_Marker_End);
         New_Line_Count;

         ID := Generate_MD_Id (Node.Spec);
         if Markered_Subp_Data.Contains (ID) then

            MD := Markered_Subp_Data.Element (ID);
            Put_Lines (MD, Comment_Out => False);

            Markered_Subp_Data.Delete (ID);
         else
            Generate_Default_Setter_Spec (Node);
         end if;

         S_Put (0, GT_Marker_Begin);
         New_Line_Count;
         S_Put (0, GT_Marker_End);
         New_Line_Count;
         New_Line_Count;

         Next (Cur);
      end loop;

      if not Markered_Subp_Data.Is_Empty then

         Report_Std
           (" warning: "
            & Root_Node.Spec_Name.all
            & "."
            & Stub_Data_Unit_Name
            & " has dangling setter spec(s)");

         S_Put (3, "----------------------");
         New_Line_Count;
         S_Put (3, "--  Unused Setters  --");
         New_Line_Count;
         S_Put (3, "----------------------");
         New_Line_Count;
         New_Line_Count;

         MD_Cur := Markered_Subp_Data.First;
         while MD_Cur /= Markered_Data_Maps.No_Element loop

            ID := Markered_Data_Maps.Key (MD_Cur);
            MD := Markered_Data_Maps.Element (MD_Cur);

            S_Put (0, GT_Marker_Begin);
            New_Line_Count;
            S_Put (3, Generate_MD_Id_String (ID));
            New_Line_Count;
            S_Put (0, GT_Marker_End);
            New_Line_Count;

            Put_Lines (MD, Comment_Out => False);

            S_Put (0, GT_Marker_Begin);
            New_Line_Count;
            S_Put (0, GT_Marker_End);
            New_Line_Count;
            New_Line_Count;
            Next (MD_Cur);
         end loop;

      end if;

      S_Put
        (0,
         "end "
         & Root_Node.Spec_Name.all
         & "."
         & Stub_Data_Unit_Name
         & ";");
      New_Line_Count;

      Close_File;
      Markered_Subp_Data.Clear;

      --  At this point temp package is coplete and it is safe
      --  to replace the old one with it.
      if Is_Regular_File (Stub_Data_File_Spec) then
         Delete_File (Stub_Data_File_Spec, Success);
         if not Success then
            Report_Err ("cannot delete " & Stub_Data_File_Spec);
            raise Fatal_Error;
         end if;
      end if;
      Copy_File (Tmp_File_Name, Stub_Data_File_Spec, Success);
      if not Success then
         Report_Err ("cannot copy tmp test package to "
                     & Stub_Data_File_Spec);
         raise Fatal_Error;
      end if;
      Delete_File (Tmp_File_Name, Success);
      if not Success then
         Report_Err ("cannot delete tmp test package");
         raise Fatal_Error;
      end if;
      Decrease_Indent (Me);

      --  Body
      Gather_Markered_Data (Stub_Data_File_Body, Markered_Subp_Data);
      Trace
        (Me,
         "generating stub data body for "
         & Root_Node.Spec_Name.all
         & "."
         & Stub_Data_Unit_Name);
      Increase_Indent (Me);
      Create (Tmp_File_Name);
      Reset_Line_Counter;

      Put_Import_Section (Markered_Subp_Data);

      S_Put
        (0,
         "package body "
         & Root_Node.Spec_Name.all
         & "."
         & Stub_Data_Unit_Name
         & " is");
      New_Line_Count;

      Cur := Data.Flat_List.First;
      while Cur /= Element_Node_Lists.No_Element loop
         Node := Element_Node_Lists.Element (Cur);

         S_Put (0, GT_Marker_Begin);
         New_Line_Count;
         S_Put (3, Generate_MD_Id_String (Node.Spec));
         New_Line_Count;
         S_Put (0, GT_Marker_End);
         New_Line_Count;

         Update_Local_Entity_With_Setter (Node, New_Line_Counter, 4);

         ID := Generate_MD_Id (Node.Spec);
         if Markered_Subp_Data.Contains (ID) then

            MD := Markered_Subp_Data.Element (ID);
            Put_Lines (MD, Comment_Out => False);

            Markered_Subp_Data.Delete (ID);
         else
            Generate_Default_Setter_Body (Node);
         end if;

         S_Put (0, GT_Marker_Begin);
         New_Line_Count;
         S_Put (0, GT_Marker_End);
         New_Line_Count;
         New_Line_Count;

         Next (Cur);
      end loop;

      if not Markered_Subp_Data.Is_Empty then

         Report_Std
           (" warning: "
            & Root_Node.Spec_Name.all
            & "."
            & Stub_Data_Unit_Name
            & " has dangling setter body(ies)");

         S_Put (3, "----------------------");
         New_Line_Count;
         S_Put (3, "--  Unused Setters  --");
         New_Line_Count;
         S_Put (3, "----------------------");
         New_Line_Count;
         New_Line_Count;

         MD_Cur := Markered_Subp_Data.First;
         while MD_Cur /= Markered_Data_Maps.No_Element loop

            ID := Markered_Data_Maps.Key (MD_Cur);
            MD := Markered_Data_Maps.Element (MD_Cur);

            S_Put (0, GT_Marker_Begin);
            New_Line_Count;
            Local_Stub_Unit_Mapping.D_Setters.Append ((New_Line_Counter, 0));
            S_Put (3, Generate_MD_Id_String (ID));
            New_Line_Count;
            S_Put (0, GT_Marker_End);
            New_Line_Count;

            Put_Lines (MD, Comment_Out => False);

            S_Put (0, GT_Marker_Begin);
            New_Line_Count;
            S_Put (0, GT_Marker_End);
            New_Line_Count;
            New_Line_Count;
            Next (MD_Cur);
         end loop;

      end if;

      S_Put
        (0,
         "end "
         & Root_Node.Spec_Name.all
         & "."
         & Stub_Data_Unit_Name
         & ";");
      New_Line_Count;

      Close_File;
      Markered_Subp_Data.Clear;

      --  At this point temp package is coplete and it is safe
      --  to replace the old one with it.
      if Is_Regular_File (Stub_Data_File_Body) then
         Delete_File (Stub_Data_File_Body, Success);
         if not Success then
            Report_Err ("cannot delete " & Stub_Data_File_Body);
            raise Fatal_Error;
         end if;
      end if;
      Copy_File (Tmp_File_Name, Stub_Data_File_Body, Success);
      if not Success then
         Report_Err ("cannot copy tmp test package to "
                     & Stub_Data_File_Body);
         raise Fatal_Error;
      end if;
      Delete_File (Tmp_File_Name, Success);
      if not Success then
         Report_Err ("cannot delete tmp test package");
         raise Fatal_Error;
      end if;
      Decrease_Indent (Me);

   end Generate_Stub_Data;

   ------------------------
   -- Generate_Task_Body --
   ------------------------

   procedure Generate_Task_Body (Node : Element_Node) is
      ID  : constant Markered_Data_Id := Generate_MD_Id (Node.Spec);
      MD  : Markered_Data_Type;
   begin
      Trace (Me, "Generating task body for " & Node.Spec_Name.all);

      S_Put (0, GT_Marker_Begin);
      New_Line_Count;

      Add_Entity_To_Local_List (Node, New_Line_Counter, Level * Indent_Level);

      S_Put
        (Level * Indent_Level,
        "task body " & Node.Spec_Name.all & " is");
      New_Line_Count;

      S_Put
        ((Level + 1) * Indent_Level,
         Generate_MD_Id_String (Node.Spec));
      New_Line_Count;
      S_Put ((Level + 1) * Indent_Level, "--");
      New_Line_Count;
      S_Put
        ((Level + 1) * Indent_Level,
        "--  This section can be used to change task body.");
      New_Line_Count;
      S_Put ((Level + 1) * Indent_Level, "--");
      New_Line_Count;

      S_Put (0, GT_Marker_End);
      New_Line_Count;

      --  Put body
      if Markered_Data.Contains (ID) then
         --  Extract importing MD
         MD := Markered_Data.Element (ID);
         Put_Lines (MD, Comment_Out => False);

         Markered_Data.Delete (ID);
      else
         New_Line_Count;
         S_Put ((Level) * Indent_Level, "begin");
         New_Line_Count;
         S_Put
           ((Level + 1) * Indent_Level,
            "delay until Ada.Real_Time.Time_Last;");
         New_Line_Count;
      end if;

      S_Put (0, GT_Marker_Begin);
         New_Line_Count;
      S_Put ((Level) * Indent_Level, "end " & Node.Spec_Name.all & ";");
      New_Line_Count;
      New_Line_Count;
      S_Put (0, GT_Marker_End);
      New_Line_Count;
      New_Line_Count;
   end Generate_Task_Body;

   --------------------------
   -- Get_Access_Type_Name --
   --------------------------

   function Get_Access_Type_Name (Elem : Asis.Element) return String is
      Attr_Suff : constant String :=
        (if Expression_Kind (Elem) = An_Attribute_Reference then
              "_" & To_String (ASIS_Trim
           (Element_Image (Attribute_Designator_Identifier (Elem))))
         else "");

      Decl : constant Asis.Declaration := Get_Declaration (Elem);

      S : String_Access;
   begin
      if Get_Nesting (Decl) = "Standard" then
         S := new String'
           (To_String_First_Name (Decl)
            & Attr_Suff);
      else
         S := new String'
           (Get_Nesting (Decl)
            & "."
            & To_String_First_Name (Decl)
            & Attr_Suff);
      end if;

      for I in S'Range loop
         if S (I) = '.' then
            S (I) := '_';
         end if;
      end loop;
      return S.all & "_Access";
   end Get_Access_Type_Name;

   -------------------
   -- Get_Args_List --
   -------------------

   function Get_Args_List (Node : Element_Node)
                           return Stubbed_Parameter_Lists.List
   is
      Result : Stubbed_Parameter_Lists.List :=
        Stubbed_Parameter_Lists.Empty_List;

      Arg_Kind  : constant Flat_Element_Kinds := Flat_Element_Kind (Node.Spec);
      Parameters : constant Asis.Element_List := Parameter_Profile (Node.Spec);

      SP : Stubbed_Parameter;

      function Can_Declare_Variable (Param_Type : Asis.Element) return Boolean;

      function Can_Declare_Variable (Param_Type : Asis.Element) return Boolean
      is
      begin

         if
           not Is_Definite_Subtype
             (Corresponding_Name_Declaration
                (Normalize_Reference (Param_Type)))
         then
            return False;
         end if;

         if
           Expression_Kind (Param_Type) = An_Attribute_Reference and then
           Attribute_Kind (Param_Type) = A_Class_Attribute
         then
            return False;
         end if;

         return True;
      end Can_Declare_Variable;

   begin
      Trace (Me, "Getting argument list for " & Node.Spec_Name.all);
      Increase_Indent (Me);

      if not Is_Nil (Parameters) then
         for J in Parameters'Range loop
            declare
               Parameter  : constant Asis.Parameter_Specification :=
                 Parameters (J);
               Name_List  : constant Defining_Name_List := Names (Parameter);
               Param_Type : constant Asis.Element :=
                 Object_Declaration_View (Parameter);
            begin

               for I in Name_List'Range loop
                  if Is_Only_Limited_Withed (Param_Type)
                    or else not Is_Abstract (Param_Type)
                  then
                     if
                       Definition_Kind (Param_Type) = An_Access_Definition
                       and then Access_Definition_Kind (Param_Type) =
                       An_Anonymous_Access_To_Variable
                     then
                        SP.Name := new String'
                          (To_String (Defining_Name_Image (Name_List (I))));
                        SP.Type_Image := new String'
                          (To_String (ASIS_Trim (Element_Image (Param_Type))));
                        SP.Type_Full_Name_Image := new String'
                          (Get_Type_Image (Param_Type));
                        SP.Kind := Access_Kind;

                        SP.Type_Elem := Param_Type;

                        Result.Append (SP);
                     else
                        if
                          Mode_Kind (Parameter) in An_Out_Mode | An_In_Out_Mode
                        then
                           SP.Type_Elem := Param_Type;

                           if Can_Declare_Variable (Param_Type) then
                              SP.Name := new String'
                                (To_String
                                   (Defining_Name_Image (Name_List (I))));
                              SP.Type_Image := new String'
                                (To_String
                                   (ASIS_Trim (Element_Image (Param_Type))));
                              SP.Type_Full_Name_Image := new String'
                                (Get_Type_Image (Param_Type));
                              SP.Kind := Constrained;
                           else
                              SP.Name := new String'
                                (To_String
                                   (Defining_Name_Image (Name_List (I))));
                              SP.Type_Image := new String'
                                (Get_Access_Type_Name (Param_Type));
                              SP.Type_Full_Name_Image := new String'
                                (Get_Access_Type_Name (Param_Type));
                              SP.Kind := Not_Constrained;

                              if not Is_Fully_Private (Param_Type) then
                                 Add_Unconstrained_Type_To_Dictionary
                                   (Param_Type);
                              end if;
                           end if;

                           Result.Append (SP);
                        end if;
                     end if;
                  end if;
               end loop;
            end;
         end loop;
      end if;

      if Arg_Kind = A_Function_Declaration then
         declare
            Res_Profile : constant Asis.Element := Result_Profile (Node.Spec);
         begin
            if Definition_Kind (Res_Profile) = An_Access_Definition then
               SP.Name := new String'
                 (Node.Spec_Name.all
                  & Stub_Result_Suffix);
               SP.Type_Image := new String'
                 (To_String (ASIS_Trim (Element_Image (Res_Profile))));
               SP.Type_Full_Name_Image := new String'
                 (Get_Type_Image (Res_Profile));
               SP.Kind := Access_Kind;
               SP.Type_Elem := Res_Profile;

               Result.Append (SP);
            else
               if Can_Declare_Variable (Res_Profile) then
                  SP.Name := new String'
                    (Node.Spec_Name.all
                     & Stub_Result_Suffix);
                  SP.Type_Image := new String'
                    (To_String (ASIS_Trim (Element_Image (Res_Profile))));
                  SP.Type_Full_Name_Image := new String'
                    (Get_Type_Image (Res_Profile));
                  SP.Kind := Constrained;
                  SP.Type_Elem := Res_Profile;

                  Result.Append (SP);
               else
                  SP.Name := new String'
                    (Node.Spec_Name.all
                     & Stub_Result_Suffix);
                  SP.Type_Image := new String'
                    (Get_Access_Type_Name (Res_Profile));
                  SP.Type_Full_Name_Image := new String'
                    (Get_Access_Type_Name (Res_Profile));
                  SP.Kind := Not_Constrained;
                  SP.Type_Elem := Res_Profile;

                  if not Is_Fully_Private (Res_Profile) then
                     Add_Unconstrained_Type_To_Dictionary (Res_Profile);
                  end if;

                  Result.Append (SP);
               end if;
            end if;
         end;
      end if;

      Decrease_Indent (Me);
      return Result;
   end Get_Args_List;

   --------------------
   -- Get_Type_Image --
   --------------------

   function Get_Type_Image (Param_Type : Asis.Element) return String is
      Elem : Asis.Element := Param_Type;
      Overall_Image : constant String :=
        To_String (ASIS_Trim (Element_Image (Param_Type)));
      Replacement, Head, Tail : String_Access;
      Decl : Asis.Element;
      Overall_Span, Subspan, Tmp_Span : Span;

      function Span_Image (El : Asis.Element; Sp : Span) return String;

      function Span_Image (El : Asis.Element; Sp : Span) return String is
         Tmp, Res : String_Access;
         Lines_List : constant Line_List := Lines (El, Sp);
      begin
         Res := new String'("");
         for I in Lines_List'Range loop
            Tmp := new String'
              (Res.all & To_String (Non_Comment_Image (Lines_List (I))));
            Free (Res);
            Res := Tmp;
         end loop;
         return Res.all;
      end Span_Image;
   begin
      if Definition_Kind (Param_Type) = An_Access_Definition then
         if
           Access_Definition_Kind (Param_Type) in
           An_Anonymous_Access_To_Variable |
         An_Anonymous_Access_To_Constant
         then
            Elem := Anonymous_Access_To_Object_Subtype_Mark (Elem);
         else
            return Overall_Image;
         end if;
      end if;

      while Expression_Kind (Elem) = An_Attribute_Reference loop
         Elem := Prefix (Elem);
      end loop;

      Subspan := Element_Span (Elem);

      Decl := Corresponding_Name_Declaration (Normalize_Reference (Elem));
      if To_Lower (Get_Nesting (Decl)) = "standard" then
         return Overall_Image;
      end if;

      --  No point in replacing non-nested types. Those are already visible.
      if Is_Nil (Enclosing_Element (Enclosing_Element (Decl))) then
         return Overall_Image;
      end if;

      Replacement := new String'
        (Get_Nesting (Decl)
         & "."
         & To_String_First_Name (Decl));

      Overall_Span := Element_Span (Param_Type);
      if Overall_Span.First_Line = Subspan.First_Line
        and then Overall_Span.First_Column = Subspan.First_Column
      then
         Head := new String'("");
      else
         Tmp_Span.First_Line   := Overall_Span.First_Line;
         Tmp_Span.First_Column := Overall_Span.First_Column;
         Tmp_Span.Last_Line    := Subspan.First_Line;
         Tmp_Span.Last_Column  := Subspan.First_Column - 1;
         Head := new String'
           (Trim (Span_Image (Param_Type, Tmp_Span), Left));
      end if;

      if Overall_Span.Last_Line = Subspan.Last_Line
        and then Overall_Span.Last_Column = Subspan.Last_Column
      then
         Tail := new String'("");
      else
         Tmp_Span.First_Line   := Subspan.Last_Line;
         Tmp_Span.First_Column := Subspan.Last_Column + 1;
         Tmp_Span.Last_Line    := Overall_Span.Last_Line;
         Tmp_Span.Last_Column := Overall_Span.Last_Column;
         Tail := new String'
           (Trim (Span_Image (Param_Type, Tmp_Span), Left));
      end if;

      return Head.all & Replacement.all & Tail.all;
   end Get_Type_Image;

   ---------------------
   -- Get_Declaration --
   ---------------------

   function Get_Declaration (Elem : Asis.Element) return Asis.Declaration is
   begin
      return
        Corresponding_Name_Declaration
          (Normalize_Reference
             (if Expression_Kind (Elem) = An_Attribute_Reference then
                   Prefix (Elem)
              else
                 Elem));
   end Get_Declaration;

   -----------------
   -- Hash_Suffix --
   -----------------

   function Hash_Suffix (ID : Markered_Data_Id) return String is
      Self_First    : constant Integer := ID.Self_Hash.all'First;
      Self_Last     : constant Integer := ID.Self_Hash.all'First + 5;
      Nesting_First : constant Integer := ID.Nesting_Hash.all'First;
      Nesting_Last  : constant Integer := ID.Nesting_Hash.all'First + 5;
   begin
      return
        "_"
        & ID.Self_Hash.all (Self_First .. Self_Last)
        & "_"
        & ID.Nesting_Hash.all (Nesting_First .. Nesting_Last);
   end Hash_Suffix;

   -----------------
   -- Is_Abstract --
   -----------------

   function Is_Abstract (Param_Type : Asis.Element) return Boolean is
      Decl, Def : Asis.Element;
      Elem : Asis.Element := Param_Type;
   begin
      if Verbose then
         Trace (Me, "Is_Abstract called for");
         Trace (Me, To_String (Debug_Image (Elem)));
      end if;
      if Definition_Kind (Param_Type) = An_Access_Definition then
         if
           Access_Definition_Kind (Param_Type) in
           An_Anonymous_Access_To_Variable |
         An_Anonymous_Access_To_Constant
         then
            Elem := Anonymous_Access_To_Object_Subtype_Mark (Elem);
         else
            --  Anonymous access to subprogram cannot be abstract anyway.
            return False;
         end if;
      end if;

      if Expression_Kind (Elem) = An_Attribute_Reference then
         Elem := Prefix (Elem);
      end if;

      Decl := Corresponding_Name_Declaration (Normalize_Reference (Elem));

      if Declaration_Kind (Decl) = A_Subtype_Declaration then
         Decl := Corresponding_First_Subtype (Decl);
      end if;

      if Is_From_Limited_View (Decl) then
         Decl := Get_Nonlimited_View (Decl);
      end if;

      if Declaration_Kind (Decl) = A_Formal_Type_Declaration
        or else Declaration_Kind (Decl) = A_Formal_Incomplete_Type_Declaration
      then
         return False;
      end if;

      if Flat_Element_Kind (Decl) = A_Tagged_Incomplete_Type_Declaration
        or else Flat_Element_Kind (Decl) = An_Incomplete_Type_Declaration
      then
         Decl := Corresponding_Type_Completion (Decl);
      end if;

      Def := Type_Declaration_View (Decl);

      if Type_Kind (Def) = An_Interface_Type_Definition then
         return True;
      end if;

      if
        Trait_Kind (Type_Declaration_View (Decl)) in
          An_Abstract_Trait         |
      An_Abstract_Private_Trait |
      An_Abstract_Limited_Trait |
      An_Abstract_Limited_Private_Trait
      then
         return True;
      end if;

      Decl := Corresponding_Type_Partial_View (Decl);
      if Flat_Element_Kind (Decl) = A_Tagged_Incomplete_Type_Declaration
        or else Flat_Element_Kind (Decl) = An_Incomplete_Type_Declaration
      then
         return False;
      end if;

      if not Is_Nil (Decl) then
         if
           Trait_Kind (Type_Declaration_View (Decl)) in
             An_Abstract_Trait         |
         An_Abstract_Private_Trait |
         An_Abstract_Limited_Trait |
         An_Abstract_Limited_Private_Trait
         then
            return True;
         end if;
      end if;
      return False;
   end Is_Abstract;

   ----------------------
   -- Is_Fully_Private --
   ----------------------

   function Is_Fully_Private  (Param_Type : Asis.Element) return Boolean is
      Decl : Asis.Element;
      Elem : Asis.Element := Param_Type;
   begin
      if Verbose then
         Trace (Me, "Is_Fully_Private called for");
         Trace (Me, To_String (Debug_Image (Elem)));
      end if;
      if Definition_Kind (Param_Type) = An_Access_Definition then
         if
           Access_Definition_Kind (Param_Type) in
           An_Anonymous_Access_To_Variable |
         An_Anonymous_Access_To_Constant
         then
            Elem := Anonymous_Access_To_Object_Subtype_Mark (Elem);
         else
            --  Anonymous access to subprogram cannot be private anyway.
            return False;
         end if;
      end if;

      if Expression_Kind (Elem) = An_Attribute_Reference then
         Elem := Prefix (Elem);
      end if;

      Decl := Corresponding_Name_Declaration (Normalize_Reference (Elem));

      if Declaration_Kind (Decl) = A_Subtype_Declaration then
         Decl := Corresponding_First_Subtype (Decl);
      end if;

      if Is_From_Limited_View (Decl) then
         Decl := Get_Nonlimited_View (Decl);
      end if;

      if Declaration_Kind (Decl) = A_Formal_Type_Declaration
        or else Declaration_Kind (Decl) = A_Formal_Incomplete_Type_Declaration
      then
         return False;
      end if;

      if not Is_Private (Decl) then
         return False;
      end if;

      if Flat_Element_Kind (Decl) = A_Tagged_Incomplete_Type_Declaration
        or else Flat_Element_Kind (Decl) = An_Incomplete_Type_Declaration
      then
         Decl := Corresponding_Type_Completion (Decl);
      end if;

      if not Is_Private (Decl) then
         return False;
      end if;

      Decl := Corresponding_Type_Partial_View (Decl);
      if not Is_Nil (Decl) then
         if not Is_Private (Decl) then
            return False;
         end if;
      end if;

      return True;
   end Is_Fully_Private;

   ----------------
   -- Is_Limited --
   ----------------

   function Is_Limited (Param_Type : Asis.Element) return Boolean is
      Decl, Decl2 : Asis.Element;
      Elem : Asis.Element := Param_Type;
   begin
      if Verbose then
         Trace (Me, "Is_Limited called for");
         Trace (Me, To_String (Debug_Image (Elem)));
      end if;
      if Definition_Kind (Elem) = An_Access_Definition then
         if
           Access_Definition_Kind (Elem) in
           An_Anonymous_Access_To_Variable |
           An_Anonymous_Access_To_Constant
         then
            Elem := Anonymous_Access_To_Object_Subtype_Mark (Elem);
         else
            --  Anonymous access to subprogram cannot be limited anyway.
            return False;
         end if;
      end if;

      if Expression_Kind (Elem) = An_Attribute_Reference then
         Elem := Prefix (Elem);
      end if;

      Decl := Corresponding_Name_Declaration (Normalize_Reference (Elem));

      if Is_From_Limited_View (Decl) then
         return True;
      end if;

      while not Is_Nil (Decl) loop
         if Declaration_Kind (Decl) = A_Subtype_Declaration then
            Decl := Corresponding_First_Subtype (Decl);
         end if;

         if Has_Limited (Decl) then
            return True;
         end if;

         if Declaration_Kind (Decl) = A_Formal_Type_Declaration
           or else Declaration_Kind (Decl) =
           A_Formal_Incomplete_Type_Declaration
         then
            --  Not really relevant if we return true or false, since generic
            --  subprograms do not have setters and stub data structures.
            return False;
         end if;

         Decl2 := Corresponding_Type_Partial_View (Decl);
         if not Is_Nil (Decl2) then
            if Has_Limited (Decl2) then
               return True;
            end if;
         end if;

         Decl := Parent_Type_Declaration (Decl);
      end loop;

      return False;
   end Is_Limited;

   ----------------------------
   -- Is_Only_Limited_Withed --
   ----------------------------

   function Is_Only_Limited_Withed (Param_Type : Asis.Element) return Boolean
     is
      Decl : Asis.Element;
      Elem : Asis.Element := Param_Type;
   begin
      if Verbose then
         Trace (Me, "Is_Only_Limited_Withed called for");
         Trace (Me, To_String (Debug_Image (Elem)));
      end if;
      if Definition_Kind (Elem) = An_Access_Definition then
         if
           Access_Definition_Kind (Elem) in
           An_Anonymous_Access_To_Variable |
           An_Anonymous_Access_To_Constant
         then
            Elem := Anonymous_Access_To_Object_Subtype_Mark (Elem);
         else
            return False;
         end if;
      end if;

      if Expression_Kind (Elem) = An_Attribute_Reference then
         Elem := Prefix (Elem);
      end if;

      Decl := Corresponding_Name_Declaration (Normalize_Reference (Elem));

      if Has_Limited_View_Only (Enclosing_Compilation_Unit (Decl)) then
         return True;
      end if;

      if Declaration_Kind (Decl) = A_Subtype_Declaration then
         Decl := Corresponding_First_Subtype (Decl);
      end if;

      if Has_Limited_View_Only (Enclosing_Compilation_Unit (Decl)) then
         return True;
      end if;

      return False;
   end Is_Only_Limited_Withed;

   -------------------------------
   -- Filter_Private_Parameters --
   -------------------------------

   function Filter_Private_Parameters
     (Param_List : Stubbed_Parameter_Lists.List)
      return Stubbed_Parameter_Lists.List
   is
      SP  : Stubbed_Parameter;
      Cur : Stubbed_Parameter_Lists.Cursor := Param_List.First;
      Res : Stubbed_Parameter_Lists.List := Stubbed_Parameter_Lists.Empty_List;
   begin
      while Cur /= Stubbed_Parameter_Lists.No_Element loop
         SP := Stubbed_Parameter_Lists.Element (Cur);
         if not Is_Fully_Private (SP.Type_Elem) then
            Res.Append (SP);
         end if;
         Next (Cur);
      end loop;

      return Res;
   end Filter_Private_Parameters;

   -------------------------
   -- MD_Kind_From_String --
   -------------------------

   function MD_Kind_From_String (Str : String) return Markered_Data_Kinds is
   begin
      if Str = "00" then
         return Import_MD;
      end if;
      if Str = "01" then
         return Type_MD;
      end if;
      if Str = "02" then
         return Task_MD;
      end if;
      if Str = "03" then
         return Package_MD;
      end if;
      if Str = "04" then
         return Subprogram_MD;
      end if;
      if Str = "05" then
         return Entry_MD;
      end if;
      if Str = "06" then
         return Elaboration_MD;
      end if;

      return Unknown_MD;
   end MD_Kind_From_String;

   -----------------------
   -- MD_Kind_To_String --
   -----------------------

   function MD_Kind_To_String (MD : Markered_Data_Kinds) return String is
   begin
      case MD is
         when Import_MD =>
            return "00";
         when Type_MD =>
            return "01";
         when Task_MD =>
            return "02";
         when Package_MD =>
            return "03";
         when Subprogram_MD =>
            return "04";
         when Entry_MD =>
            return "05";
         when Elaboration_MD =>
            return "06";
         when Unknown_MD =>
            return "99";
      end case;
   end MD_Kind_To_String;

   -------------------
   -- Requires_Body --
   -------------------

   function Requires_Body (El : Asis.Element) return Boolean is
      Arg_Kind     : constant Flat_Element_Kinds := Flat_Element_Kind (El);
      Encl_El      : Asis.Element;
      Encl_El_Kind : Flat_Element_Kinds;
      Result       : Boolean := False;

   begin

      case Arg_Kind is
         when An_Incomplete_Type_Declaration       |
              A_Tagged_Incomplete_Type_Declaration =>
            if Is_Nil (Corresponding_Type_Declaration (El)) then
               Result := True;
            else
               Result := not Is_Equal
                 (Enclosing_Compilation_Unit (El),
                  Enclosing_Compilation_Unit
                    (Corresponding_Type_Declaration (El)));
            end if;
         when A_Task_Type_Declaration         |
              A_Protected_Type_Declaration    |
              A_Single_Task_Declaration       |
              A_Single_Protected_Declaration  |
              A_Package_Declaration           |
              A_Generic_Procedure_Declaration |
              A_Generic_Function_Declaration  |
              A_Generic_Package_Declaration    =>

            --  there is no harm to generate a local body sample for a local
            --  package or generic package
            Result := True;

         when A_Procedure_Declaration |
              A_Function_Declaration    =>

            --  there are two cases when a subprogram does not require
            --  completion: when it is already completed by renaming-as-body
            --  in a package spec or when it is abstract

            if Trait_Kind (El) /= An_Abstract_Trait then
               --  Result := Is_Nil (Corresponding_Body (El));  ???
               --  ??? the statement below implements the temporary solution
               --  ??? for subprograms completed by pragmas Import.
               --  ??? it should be revised when Asis.Extensions.Is_Completed
               --  ??? gets in a proper shape.

               if not Is_Nil (Corresponding_Body (El)) then
                  if Is_Equal
                    (Enclosing_Compilation_Unit (El),
                     Enclosing_Compilation_Unit (Corresponding_Body (El)))
                  then
                     return False;
                  end if;
               end if;

               declare
                  Pragma_List : constant Asis.Pragma_Element_List :=
                    Corresponding_Pragmas (El);
               begin
                  Result := True;
                  for I in Pragma_List'Range loop
                     if
                       To_Lower
                         (To_String (Pragma_Name_Image (Pragma_List (I)))) in
                         "import" | "interface" | "import_function"
                     then
                        Result := False;
                        exit;
                     end if;
                  end loop;
               end;

            end if;

         when An_Entry_Declaration =>
            Encl_El      := Enclosing_Element (El);
            Encl_El_Kind := Flat_Element_Kind (Encl_El);
            Result := Encl_El_Kind = A_Protected_Definition;
         when others =>
            null;
      end case;

      return Result;

   end Requires_Body;

   -------------------------------------
   -- Update_Local_Entity_With_Setter --
   -------------------------------------

   procedure Update_Local_Entity_With_Setter
     (Node : Element_Node; New_First_Line, New_First_Column : Natural)
   is
      Cur : Entity_Stub_Mapping_List.Cursor;

      Local_Entity : Entity_Stub_Mapping;
   begin
      Trace (Me_Mapping, "adding setter info for " & Node.Spec_Name.all);
      Increase_Indent (Me_Mapping);

      Local_Entity.Name   := new String'(Node.Spec_Name.all);
      Local_Entity.Line   := First_Line_Number (Node.Spec);
      Local_Entity.Column := First_Column_Number (Node.Spec);

      Cur := Local_Stub_Unit_Mapping.Entities.Find (Local_Entity);

      if Cur = Entity_Stub_Mapping_List.No_Element then
         Trace
           (Me_Mapping,
            "no entity found for setter ("
            & Local_Entity.Name.all
            & ":"
            &  Trim (Natural'Image (Local_Entity.Line), Both)
            & ":"
            &  Trim (Natural'Image (Local_Entity.Column), Both));
         return;
      end if;

      Local_Entity := Entity_Stub_Mapping_List.Element (Cur);
      Local_Entity.Setter.Line   := New_First_Line;
      Local_Entity.Setter.Column := New_First_Column;

      Local_Stub_Unit_Mapping.Entities.Replace_Element (Cur, Local_Entity);
      Decrease_Indent (Me_Mapping);
   end Update_Local_Entity_With_Setter;

end GNATtest.Stub.Generator;
