File: gnattest-skeleton-generator.adb

package info (click to toggle)
asis 2019-5
links: PTS, VCS
area: main
in suites: bullseye
size: 13,848 kB
sloc: ada: 156,772; makefile: 296; sh: 81; xml: 48; csh: 10
file content (7113 lines) | stat: -rw-r--r-- 246,398 bytes
------------------------------------------------------------------------------
--                                                                          --
--                           GNATTEST COMPONENTS                            --
--                                                                          --
--          G N A T T E S T  . S K E L E T O N . G E N E R A T O R          --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2011-2019, 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.Doubly_Linked_Lists;
with Ada.Containers.Indefinite_Doubly_Linked_Lists;
with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.Containers.Indefinite_Vectors;
with Ada.Containers.Indefinite_Ordered_Sets;
with Ada.Containers.Vectors;

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

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;

with GNAT.Directory_Operations;  use GNAT.Directory_Operations;

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

with Asis;                       use Asis;
with Asis.Ada_Environments;      use Asis.Ada_Environments;
with Asis.Clauses;               use Asis.Clauses;
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.Errors;
with Asis.Exceptions;            use Asis.Exceptions;
with Asis.Extensions.Flat_Kinds; use Asis.Extensions.Flat_Kinds;
with Asis.Implementation;
with Asis.Iterator;              use Asis.Iterator;
with Asis.Limited_Views;         use Asis.Limited_Views;
with Asis.Text;                  use Asis.Text;

with ASIS_UL.Common;
with ASIS_UL.Compiler_Options;   use ASIS_UL.Compiler_Options;
with ASIS_UL.Debug;

with GNATtest.Skeleton.Source_Table; use GNATtest.Skeleton.Source_Table;

with GNATtest.Common;            use GNATtest.Common;
with GNATtest.Options;           use GNATtest.Options;
with GNATtest.Environment;       use GNATtest.Environment;
with GNATtest.Mapping;           use GNATtest.Mapping;

with GNATtest.Harness.Generator;
with GNATtest.Stub.Generator;
with Ada.Containers;

package body GNATtest.Skeleton.Generator is

   Me                : constant Trace_Handle :=
     Create ("Skeletons", Default => Off);
   Me_Direct_Callees : constant Trace_Handle :=
     Create ("Skeletons.Direct_Callees", Default => Off);

   -------------------
   --  Minded Data  --
   -------------------

   New_Tests_Counter : Natural := 0;
   All_Tests_Counter : Natural := 0;

   package Tests_Per_Unit is new
     Ada.Containers.Indefinite_Ordered_Maps (String, Natural);
   use Tests_Per_Unit;

   Test_Info : Tests_Per_Unit.Map;

   type Data_Kind_Type is
     (Declaration_Data,
      Instantiation);

   type Base_Type_Info is tagged record
      Main_Type_Elem            : Asis.Element := Asis.Nil_Element;
      Main_Type_Abstract        : Boolean;
      Main_Type_Text_Name       : String_Access;

      Has_Argument_Father       : Boolean;
      Argument_Father_Unit_Name : String_Access;
      Argument_Father_Type_Name : String_Access;
      Argument_Father_Nesting   : String_Access;

      Nesting                   : String_Access;

      Type_Number               : Positive;

      No_Default_Discriminant   : Boolean;
   end record;

   package Type_Info_Vect is new
     Ada.Containers.Indefinite_Vectors (Positive, Base_Type_Info);
   use Type_Info_Vect;

   use String_Set;

   type Test_Case_Mode is (Normal, Robustness);

   type Test_Case_Info is record
      Pre  : Asis_Element_List.List;
      Post : Asis_Element_List.List;

      Elem : Asis.Element;
      Name : String_Access;
      Mode : Test_Case_Mode;
      Req  : Asis.Element;
      Ens  : Asis.Element;

      Req_Image : String_Access;
      Ens_Image : String_Access;

      Params_To_Temp : String_Set.Set;

      Req_Line : String_Access;
      Ens_Line : String_Access;

      TC_Hash : String_Access;
   end record;

   type Subp_Info is record
      Subp_Declaration : Asis.Declaration;
      Subp_Text_Name   : String_Access;
      Subp_Name_Image  : String_Access;
      Subp_Mangle_Name : String_Access;
      Subp_Full_Hash   : String_Access;

      --  Those versions of hash are stored for compatibility reasons.
      --  Transitions from older versions of hash should be performed
      --  automatically.

      Subp_Hash_V1    : String_Access;
      --  Case-sensitive hash.
      Subp_Hash_V2_1  : String_Access;
      --  Non-controlling parameters with same root type as controlling ones
      --  are replaced with root type before hashing.

      Is_Abstract      : Boolean;
      Corresp_Type     : Natural;
      Nesting          : String_Access;

      Has_TC_Info      : Boolean := False;
      TC_Info          : Test_Case_Info;

      Is_Overloaded    : Boolean;
   end record;

   package Subp_Data_List is new
     Ada.Containers.Indefinite_Doubly_Linked_Lists (Subp_Info);
   use Subp_Data_List;

   type Package_Info is record
      Name       : String_Access;
      Is_Generic : Boolean;
      Data_Kind  : Data_Kind_Type;
      Element    : Asis.Element;

      --  only used for instantiations
      Generic_Containing_Package : String_Access;
   end record;

   package Package_Info_List is new
     Ada.Containers.Doubly_Linked_Lists (Package_Info);
   use Package_Info_List;

   --  Info on overloading subprograms
   package Name_Frequency is new
     Ada.Containers.Indefinite_Ordered_Maps (String, Natural);
   use Name_Frequency;

   use Asis_Element_List;

   type Data_Holder (Data_Kind : Data_Kind_Type := Declaration_Data) is record

      Unit : Asis.Compilation_Unit;
      --  CU itself.

      Unit_Full_Name : String_Access;
      --  Fully expanded Ada name of the CU.

      Unit_File_Name : String_Access;
      --  Full name of the file, containing the CU.

      case Data_Kind is
         --  Indicates which data storing structures are used, determines the
         --  way of suite generation.

         when Declaration_Data =>

            Is_Generic       : Boolean;
            --  Indicates if given argument package declaration is generic.

            Has_Simple_Case  : Boolean := False;
            --  Indicates if we have routines that are not primitives of any
            --  tagged type.

            Needs_Fixtures   : Boolean := False;
            --  Indicates if we need to unclude AUnit.Fixtures in the test
            --  package.

            Needs_Set_Up     : Boolean := False;
            --  Indicates if we need the Set_Up routine for at least one test
            --  type;

            Needs_Assertions : Boolean := False;
            --  Indicates if we need to include AUnit.Assertions into the body
            --  of the test package.

            Subp_List : Subp_Data_List.List;
            --  List of subprograms declared in the argument package
            --  declaration.

            Type_Data_List : Type_Info_Vect.Vector;
            --  Stores info on tagged records in the argument package
            --  declaration.

            Package_Data_List : Package_Info_List.List;
            --  Stores info of nested packages.

            Units_To_Stub : Asis_Element_List.List;
            --  List of direct dependancies of current unit.

            Subp_Name_Frequency : Name_Frequency.Map;

         when Instantiation =>

            Gen_Unit : Asis.Compilation_Unit;
            --  Generic CU that is instatinated into the given one.

            Gen_Unit_Full_Name : String_Access;
            --  Fully expanded Ada name of the generic CU.

            Gen_Unit_File_Name : String_Access;
            --  Name of file containing the generic CU.

      end case;

   end record;

   ----------------
   -- Suite Data --
   ----------------

   type Test_Type_Info_Wrapper is record
      TT_Info       : GNATtest.Harness.Generator.Test_Type_Info;
      Test_Package  : String_Access;
      Original_Type : Asis.Element := Asis.Nil_Element;
   end record;

   package TT_Info is new
     Ada.Containers.Indefinite_Vectors (Positive, Test_Type_Info_Wrapper);
   use TT_Info;

   type Test_Routine_Info_Wrapper is record
      TR_Info       : GNATtest.Harness.Generator.Test_Routine_Info;
      Test_Package  : String_Access;
      Original_Type : Asis.Element := Asis.Nil_Element;
      Original_Subp : Asis.Element := Asis.Nil_Element;
   end record;

   package TR_Info is new
     Ada.Containers.Indefinite_Vectors (Positive, Test_Routine_Info_Wrapper);
   use TR_Info;

   type Test_Routine_Info_Enhanced_Wrapper is record
      TR_Info       : GNATtest.Harness.Generator.Test_Routine_Info_Enhanced;
      Test_Package  : String_Access;
      Original_Type : Asis.Element := Asis.Nil_Element;
   end record;

   package TR_Info_Enhanced is new
     Ada.Containers.Indefinite_Vectors (Positive,
                                        Test_Routine_Info_Enhanced_Wrapper);
   use TR_Info_Enhanced;

   type Suites_Data_Type is record
      Test_Types   : TT_Info.Vector;
      TR_List      : TR_Info.Vector;
      ITR_List     : TR_Info_Enhanced.Vector;
      LTR_List     : TR_Info_Enhanced.Vector;
   end record;

   ------------------
   -- Test Mapping --
   ------------------

   use TC_Mapping_List;
   use TR_Mapping_List;
   use DT_Mapping_List;
   use TP_Mapping_List;
   use SP_Mapping;

   procedure Add_TR
     (TP_List : in out TP_Mapping_List.List;
      TPtarg  : String;
      Test_F  : String;
      Test_T  : String;
      Subp    : Subp_Info;
      TR_Line : Natural := 1);

   procedure Add_DT
     (TP_List : in out TP_Mapping_List.List;
      TPtarg  : String;
      Test_F  : String;
      Line    : Natural;
      Column  : Natural);

   --------------
   -- Geberics --
   --------------
   package Element_List is new
     Ada.Containers.Doubly_Linked_Lists (Asis.Element, Is_Equal);

   package Name_Set is new
     Ada.Containers.Indefinite_Ordered_Maps (String, Positive);

   use List_Of_Strings;

   type Generic_Tests is record
      Gen_Unit_Full_Name : String_Access;
      Tested_Type_Names  : List_Of_Strings.List;
      Has_Simple_Case    : Boolean := False;
   end record;
   --  Stores names of all tested type names, that produce names of generic
   --  test pachages, which should be instantiated
   --  if we have an instantiation of the tested package.

   package Generic_Tests_Storage is new
     Ada.Containers.Indefinite_Doubly_Linked_Lists (Generic_Tests);
   use Generic_Tests_Storage;

   Gen_Tests_Storage : Generic_Tests_Storage.List;
   --  List of data on all the generic tests created during the processing of
   --  generic tested packages.

   type Generic_Package is record
      Name : String_Access;
      Sloc : String_Access := null;

      Has_Instantiation : Boolean := False;
   end record;

   package Generic_Package_Storage is new
     Ada.Containers.Indefinite_Doubly_Linked_Lists (Generic_Package);
   use Generic_Package_Storage;

   Gen_Package_Storage : Generic_Package_Storage.List;
   --  Used to detect processed generic packages that do not have
   --  instantiations in the scope of argument sources and, therefore, won't be
   --  included into final harness.

   Last_Context_Name : String_Access;
   --  Suffixless name of the last tree file created

   -------------------------
   --  Inner Subprograms  --
   -------------------------

   function Initialize_Context (Source_Name : String) return Boolean;
   --  Creates a tree file and initializes the context.

   procedure Create_Tree (Full_Source_Name : String; Success : out Boolean);
   --  Tries to create the tree file for the given source file. The tree file
   --  and the corresponding ALI file are placed into a temporary directory.
   --  If the attempt is successful, Success is set ON, otherwise it is set
   --  OFF.

   procedure Process_Source (The_Unit : Asis.Compilation_Unit);
   --  Processes given compilation unit, gathers information that is needed
   --  for generating the testing unit and suite and generates them if the
   --  source is appropriate (contains one or less tagged type declaration).

   procedure Process_Stubs (List : Asis_Element_List.List);
   --  If ther are any units to stub, closes the context, generates .adt files
   --  for units to stub and passes compilation units to the Stub Generator.

   procedure Gather_Data
     (The_Unit          :     Asis.Compilation_Unit;
      Data              : out Data_Holder;
      Suite_Data_List   : out Suites_Data_Type;
      Apropriate_Source : out Boolean);
   --  Iterates through the given unit and gathers all the data needed for
   --  generation of test package. All the iterations are done here.
   --  Checks if given unit is of the right kind and if it is appropriate.
   --  Marks unappropriate sources in the source table.

   procedure Gather_Substitution_Data
     (Suite_Data_List : in out Suites_Data_Type);

   procedure Gather_Direct_Callees
     (Decl : Asis.Declaration; Set : in out String_Set.Set);

   procedure Source_Clean_Up;
   --  Minimal clean-up needed for one source (deleting .ali & .adt)

   function No_Inheritance_Through_Generics
     (Inheritance_Root_Type : Asis.Element;
      Inheritance_Final_Type : Asis.Element)
      return Boolean;
   --  Checks that all types between the root type and the final descendant
   --  are declared in regular packages.

   function Test_Types_Linked
     (Inheritance_Root_Type : Asis.Element;
      Inheritance_Final_Type : Asis.Element)
      return Boolean;
   --  Checks that there is no fully private types between the root type and
   --  the final descendant, so that corresponding test types are members of
   --  same hierarchy.

   function Is_Declared_In_Regular_Package
     (Elem : Asis.Element)
      return Boolean;
   --  Chechs that all enclosing elements for the given element are regular
   --  package declarations.

   function Is_Callable_Subprogram (Subp : Asis.Element) return Boolean;
   --  Checks that given subprogram is not abstract nor null procedure.

   function Is_Fully_Private
     (Arg : Asis.Declaration) return Boolean;
   --  Detects if Arg and it's incomplete declaration (if present)
   --  are both in private part.

   procedure Generate_Test_Package (Data : Data_Holder);
   --  Generates test package spec and body. Completely regeneratable.

   procedure Generate_Function_Wrapper
     (Current_Subp : Subp_Info; Declaration_Only : Boolean := False);
   --  Print a test-case specific wrapper for tested function.

   procedure Generate_Procedure_Wrapper
     (Current_Subp : Subp_Info; Declaration_Only : Boolean := False);
   --  Print a test-case specific wrapper for tested function.

   procedure Generate_Skeletons (Data : Data_Holder);
   --  Generates skeletons for those routines that do not have tests already.

   procedure Print_Comment_Declaration (Subp : Subp_Info; Span : Natural := 0);
   --  Prints the file containing the tested subprogram as well as the line
   --  coloumn numbers of the tested subprogram declaration.

   procedure Print_Comment_Separate (Subp : Subp_Info; Span : Natural := 0);
   --  Prints commented image of tested subprogram with given span.

   function Corresponding_Generic_Package
     (Package_Instance : Asis.Element) return Asis.Element;
   --  Returns a corresponding generic package declaration for a
   --  formal package.

   procedure Generate_Test_Package_Instantiation (Data : Data_Holder);
   --  Generates an instatiation of the corresponding generic test package

   procedure Generate_Project_File;
   --  Generates a project file that sets the value of Source_Dirs
   --  with the directories whe generated tests are placed and includes
   --  the argument project file.

   function Format_Time (Time : OS_Time) return String;
   --  Returns image of given time in 1901-01-01 00:00:00 format.

   procedure Put_Wrapper_Rename (Span : Natural; Current_Subp : Subp_Info);
   --  Puts subprogram renaming declaration, which renames generated wrapper
   --  into original tested subprogram's name.

   function Sanitize_TC_Name (TC_Name : String) return String;
   --  Processes the name of the test case in such a way that it could be used
   --  as a part of test routine name. the name is trimmed, then all sequences
   --  of whitespace characters are replaced with an underscore, all other
   --  illegal characters are omitted.

   ------------------------
   -- Nesting processing --
   ------------------------

   function Nesting_Common_Prefix
     (Nesting_1, Nesting_2 : String) return String;
   --  Returns the common prefix of two nestings.

   function Nesting_Difference
     (Nesting_1, Nesting_2 : String) return String;
   --  Returns difference in ending of two nestings without the first dot
   --  of the deeper nesting.

   procedure Generate_Nested_Hierarchy (Data : Data_Holder);
   --  Create dummy child packages copying nested packages from tested package.

   -----------------------
   -- Marker Processing --
   -----------------------

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

   type Markered_Data is record
      Commented_Out   : Boolean := False;
      Short_Name_Used : Boolean := False;
      Short_Name      : String_Access := new String'("");
      TR_Text         : String_Vectors.Vector;
      Issue_Warning   : Boolean := False;
   end record;

   type Unique_Hash is record
      Version : String_Access;
      Hash    : String_Access;
      TC_Hash : String_Access;
   end record;

   function "<" (L, R : Unique_Hash) return Boolean;

   package Markered_Data_Maps is new
     Ada.Containers.Indefinite_Ordered_Maps (Unique_Hash, Markered_Data);
   use Markered_Data_Maps;

   Markered_Data_Map : Markered_Data_Maps.Map;

   procedure Put_Opening_Comment_Section
     (Subp           : Subp_Info;
      Overloading_N  : Natural;
      Commented_Out  : Boolean := False;
      Use_Short_Name : Boolean := True;
      Type_Name      : String  := "");

   procedure Put_Closing_Comment_Section
     (Subp           : Subp_Info;
      Overloading_N  : Natural;
      Commented_Out  : Boolean := False;
      Use_Short_Name : Boolean := True);

   procedure Get_Subprograms_From_Package (File : String);

   procedure Get_Subprogram_From_Separate
     (File : String;
      UH   : Unique_Hash;
      Subp : Subp_Info);

   function Uncomment_Line (S : String) return String;
   --  Removes two dashes and two spaces from the beginning of the line.
   --  Returns argument string if commenting prefix not found.

   function Find_Same_Short_Name
     (MD_Map : Markered_Data_Maps.Map;
      Subp   : Subp_Info) return Markered_Data_Maps.Cursor;
   --  Searches for the test with given short name

   function "<" (L, R : Unique_Hash) return Boolean is
   begin
      if L.Version.all = R.Version.all then
         if L.Hash.all = R.Hash.all then
            return L.TC_Hash.all < R.TC_Hash.all;
         else
            return L.Hash.all < R.Hash.all;
         end if;
      else
         return L.Version.all < R.Version.all;
      end if;
   end "<";

   ---------------------------
   -- Nesting_Common_Prefix --
   ---------------------------

   function Nesting_Common_Prefix
     (Nesting_1, Nesting_2 : String) return String
   is
      L1, L2   : Integer;
      Last_Dot : Integer;
   begin
      L1 := Nesting_1'First;
      L2 := Nesting_2'First;
      loop

         if Nesting_1 (L1) = Nesting_2 (L2) then

            if L1 = Nesting_1'Last then
               return Nesting_1;
            end if;

            if L2 = Nesting_2'Last then
               return Nesting_2;
            end if;

            if Nesting_1 (L1) = '.' then
               Last_Dot := L1;
            end if;

            L1 := L1 + 1;
            L2 := L2 + 1;
         else
            return Nesting_1 (Nesting_1'First .. Last_Dot - 1);
         end if;

      end loop;

   end Nesting_Common_Prefix;

   ------------------------
   -- Nesting_Difference --
   ------------------------

   function Nesting_Difference
     (Nesting_1, Nesting_2 : String) return String
   is
      L : constant Integer := Integer'Min (Nesting_1'Length, Nesting_2'Length);
   begin

      if Nesting_1'Length > Nesting_2'Length then
         return Nesting_1 (Nesting_1'First + L + 1 .. Nesting_1'Last);
      else
         return Nesting_2 (Nesting_2'First + L + 1 .. Nesting_2'Last);
      end if;

   end Nesting_Difference;

   -------------------------------------
   --  Corresponding_Generic_Package  --
   -------------------------------------
   function Corresponding_Generic_Package
     (Package_Instance : Asis.Element) return Asis.Element
   is
      Name : constant Asis.Element := First_Name (Package_Instance);
   begin
      return
        Unit_Declaration (Library_Unit_Declaration (Defining_Name_Image
          (Corresponding_Generic_Element (Name)), The_Context));
   end Corresponding_Generic_Package;

   -----------------
   -- Create_Tree --
   -----------------

   procedure Create_Tree (Full_Source_Name : String; Success : out Boolean) is
   begin
      Trace (Me, "Creating tree for " & Full_Source_Name);
      Compile
       (new String'(Full_Source_Name),
        Arg_List.all,
        Success,
        GCC          => ASIS_UL.Common.Gcc_To_Call,
        Display_Call => ASIS_UL.Debug.Debug_Flag_C);
   end Create_Tree;

   --------------------------
   -- Find_Same_Short_Name --
   --------------------------

   function Find_Same_Short_Name
     (MD_Map : Markered_Data_Maps.Map;
      Subp   : Subp_Info) return Markered_Data_Maps.Cursor
   is
      Short_Name : constant String := Subp.Subp_Text_Name.all;
      TC_Hash    : constant String :=
        (if Subp.Has_TC_Info then
            Sanitize_TC_Name (Subp.TC_Info.Name.all)
         else "");
      Cur : Markered_Data_Maps.Cursor := MD_Map.First;
      MD  : Markered_Data;
   begin
      Trace
        (Me,
         "Looking for a compatible dangling test for " & Short_Name);

      loop
         exit when Cur = Markered_Data_Maps.No_Element;

         MD := Markered_Data_Maps.Element (Cur);
         if
           MD.Short_Name_Used
           and then MD.Short_Name.all = Short_Name
         --  It is hard to understand what happens when test case name
         --  is changed, so we do not handle this scenario.
           and then Markered_Data_Maps.Key (Cur).TC_Hash.all = TC_Hash
         then
            exit;
         end if;

         Markered_Data_Maps.Next (Cur);
      end loop;
      return Cur;
   end Find_Same_Short_Name;

   -----------------
   -- Format_Time --
   -----------------

   function Format_Time (Time : OS_Time) return String is

      function Prefix_With_Zero (S : String) return String;

      function Prefix_With_Zero (S : String) return String is
         S_Trimmed : constant String := Trim (S, Both);
      begin
         if S_Trimmed'Length = 1 then
            return "0" & S_Trimmed;
         else
            return S_Trimmed;
         end if;
      end Prefix_With_Zero;
   begin
      return
        Trim (Integer'Image (GM_Year (Time)), Both) & "-" &
      Prefix_With_Zero (Integer'Image (GM_Month (Time))) & "-" &
      Prefix_With_Zero (Integer'Image (GM_Day (Time))) & " " &
      Prefix_With_Zero (Integer'Image (GM_Hour (Time))) & ":" &
      Prefix_With_Zero (Integer'Image (GM_Minute (Time))) & ":" &
      Prefix_With_Zero (Integer'Image (GM_Second (Time)));
   end Format_Time;

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

   procedure Gather_Data
     (The_Unit          :     Asis.Compilation_Unit;
      Data              : out Data_Holder;
      Suite_Data_List   : out Suites_Data_Type;
      Apropriate_Source : out Boolean)
   is separate;

   ---------------------------
   -- Gather_Direct_Callees --
   ---------------------------

   procedure Gather_Direct_Callees
     (Decl : Asis.Declaration; Set : in out String_Set.Set)
   is
      Control : Traverse_Control := Continue;
      State   : No_State         := Not_Used;

      Origin_Unit : constant Compilation_Unit :=
        Enclosing_Compilation_Unit (Decl);

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

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

      procedure Pre_Operation
        (Element :        Asis.Element;
         Control : in out Traverse_Control;
         State   : in out No_State)
      is
         pragma Unreferenced (Control, State);
         Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (Element);

         Decl : Asis.Element;
      begin

         case Arg_Kind is

            when A_Procedure_Call_Statement =>
               Decl    := Corresponding_Called_Entity_Unwound (Element);

            when A_Function_Call =>
               Decl := Corresponding_Called_Function_Unwound (Element);

            when others =>
               return;
         end case;

         --  Process simple cases for now. Dispatchings, renamings and parts of
         --  instances are not yet supported.

         if Is_Nil (Decl)
           or else Is_Part_Of_Instance (Decl)
           or else Declaration_Kind (Decl) = Not_A_Declaration
         then
            return;
         end if;

         case Flat_Element_Kind (Decl) is
            when A_Function_Instantiation  |
                 A_Procedure_Instantiation =>
               --  No way to stub a generic
               return;
            when A_Function_Body_Declaration  |
                 A_Procedure_Body_Declaration |
                 A_Procedure_Body_Stub        |
                 A_Function_Body_Stub         =>
               --  No previous spec declaration, which means it is declared
               --  in same body; no need to call a setter.
               return;
            when An_Ordinary_Type_Declaration =>
               --  A function renaming an enumeration type's literal
               return;
            when others =>
               null;
         end case;

         if Is_Part_Of_Implicit (Decl) then
            if
              Flat_Element_Kind (Decl) = A_Function_Declaration and then
              (not Is_Nil (Corresponding_Equality_Operator (Decl)))
            then
               return;
            end if;
            Decl := Corresponding_Declaration (Decl);
         end if;

         case Flat_Element_Kind (Decl) is
            when A_Null_Procedure_Declaration   |
                 A_Formal_Procedure_Declaration |
                 A_Formal_Function_Declaration  =>
               return;
            when others =>
               null;
         end case;

         if
           Is_Equal (Enclosing_Compilation_Unit (Decl), Origin_Unit)
           or else Unit_Kind (Enclosing_Compilation_Unit (Decl)) /= A_Package
         then
            --  Callee is from the same unit spec or even from the body,
            --  it won't be stubbed.
            return;
         end if;

         declare
            Suffix : constant String :=
              "_"
              & Substring_6 (Mangle_Hash_Full (Decl))
              & "_"
              & Substring_6 (GNAT.SHA1.Digest (Get_Nesting (Decl)));
         begin
            Set.Include
              (Get_Nesting (Decl)
               & "."
               & Stub_Data_Unit_Name
               & "."
               & Setter_Prefix
               & To_String_First_Name (Decl)
               & Suffix);
         end;

      end Pre_Operation;
   begin
      Trace
        (Me_Direct_Callees,
         "Gathering direct callees for " & To_String_First_Name (Decl));
      Increase_Indent;
      Set.Clear;

      if Flat_Element_Kind (Decl) = An_Expression_Function_Declaration then
         --  Those do not have an actual bodyso we need to parse their return
         --  statement.
         Get_Callees (Result_Expression (Decl), Control, State);
      else
         if Is_Nil (Corresponding_Body (Decl)) then
            return;
         end if;
         Get_Callees (Corresponding_Body (Decl), Control, State);
      end if;
      Trace
        (Me_Direct_Callees,
         "Direct callees gathered");
      Decrease_Indent;
   end Gather_Direct_Callees;

   ------------------------------
   -- Gather_Substitution_Data --
   ------------------------------

   procedure Gather_Substitution_Data
     (Suite_Data_List : in out Suites_Data_Type)
   is
      TR    : GNATtest.Harness.Generator.Test_Routine_Info;
      TR_W  : Test_Routine_Info_Wrapper;
      LTR   : GNATtest.Harness.Generator.Test_Routine_Info_Enhanced;
      LTR_W : Test_Routine_Info_Enhanced_Wrapper;

      Test_Type_Wrapper : Test_Type_Info_Wrapper;

      Parent_Unit      :  Asis.Compilation_Unit;
      Parent_Unit_File : String_Access;

      Overridden_Subp : Asis.Element;
      Owner_Decl      : Asis.Element;

      Depth : Natural;
   begin
      for
        K in Suite_Data_List.TR_List.First_Index ..
          Suite_Data_List.TR_List.Last_Index
      loop
         TR_W := Suite_Data_List.TR_List.Element (K);
         TR   := TR_W.TR_Info;

         if Is_Overriding_Operation (TR_W.Original_Subp) then

            Overridden_Subp :=
              Corresponding_Overridden_Operation (TR_W.Original_Subp);

            if Is_Part_Of_Inherited (Overridden_Subp) then
               Overridden_Subp :=
                 Corresponding_Declaration (Overridden_Subp);
            end if;

            Parent_Unit := Enclosing_Compilation_Unit (Overridden_Subp);

            Parent_Unit_File := new String'
              (To_String (Text_Name (Parent_Unit)));

            if Is_Dispatching_Operation (Overridden_Subp) then
               --  In some cases it could be not dispatching

               Owner_Decl :=
                 Enclosing_Element (Primitive_Owner (Overridden_Subp));

               if
                 Source_Present (Parent_Unit_File.all)    and then
                 Is_Callable_Subprogram (Overridden_Subp) and then
                 Test_Types_Linked (Owner_Decl, TR_W.Original_Type) and then
                 No_Inheritance_Through_Generics
                   (Owner_Decl, TR_W.Original_Type)
               then
                  LTR.TR_Text_Name := new String'(TR.TR_Text_Name.all);

                  Depth :=
                    GNATtest.Harness.Generator.Inheritance_Depth
                      (TR_W.Original_Type, Owner_Decl);
                  LTR.Inheritance_Depth := Depth;

                  for
                    L in Suite_Data_List.Test_Types.First_Index ..
                      Suite_Data_List.Test_Types.Last_Index
                  loop

                     Test_Type_Wrapper :=
                       Suite_Data_List.Test_Types.Element (L);

                     if
                       Is_Equal
                         (Test_Type_Wrapper.Original_Type, TR_W.Original_Type)
                     then

                        if
                          Depth >
                            Test_Type_Wrapper.TT_Info.Max_Inheritance_Depth
                        then
                           Test_Type_Wrapper.TT_Info.Max_Inheritance_Depth :=
                             Depth;

                           Suite_Data_List.Test_Types.Replace_Element
                             (L, Test_Type_Wrapper);

                           exit;
                        end if;
                     end if;

                  end loop;

                  LTR_W.TR_Info       := LTR;
                  LTR_W.Original_Type := TR_W.Original_Type;
                  LTR_W.Test_Package  := new String'(TR_W.Test_Package.all);

                  --  adding sloc info
                  LTR_W.TR_Info.Tested_Sloc := new String'
                    (Base_Name (Parent_Unit_File.all)
                     & ":"
                     & Trim
                       (Integer'Image (First_Line_Number (Overridden_Subp)),
                        Both)
                     & ":"
                     & Trim
                       (Integer'Image (First_Column_Number (Overridden_Subp)),
                        Both)
                     & ": overridden at "
                     & Base_Name
                       (To_String
                          (Text_Name
                             (Enclosing_Compilation_Unit
                                (TR_W.Original_Type))))
                     & ":"
                     & Trim
                       (Integer'Image (First_Line_Number (TR_W.Original_Subp)),
                        Both)
                     & ":"
                     & Trim
                       (Integer'Image
                          (First_Column_Number (TR_W.Original_Subp)),
                        Both)
                     & ":");

                  Suite_Data_List.LTR_List.Append (LTR_W);

               end if;
            end if;
         end if;
      end loop;
   end Gather_Substitution_Data;

   -------------------------------
   -- Generate_Function_Wrapper --
   -------------------------------

   procedure Generate_Function_Wrapper
     (Current_Subp : Subp_Info; Declaration_Only : Boolean := False)
   is
      Str_Set : String_Set.Set;
      Cur     : String_Set.Cursor;
   begin
      S_Put (0, GT_Marker_Begin);
      New_Line_Count;
      S_Put
        (3,
         "function " &
         Wrapper_Prefix &
         Current_Subp.Subp_Mangle_Name.all);
      declare
         Params : constant
           Asis.Parameter_Specification_List := Parameter_Profile
             (Current_Subp.Subp_Declaration);
         Result : constant Asis.Element :=
           Result_Profile (Current_Subp.Subp_Declaration);

         Result_Image : constant String :=
           Trim (To_String (Element_Image (Result)), Both);
      begin
         for I in Params'Range loop
            if I = Params'First then
               S_Put (0, " (");
            end if;
            S_Put
              (0,
               Trim
                 (To_String (Element_Image (Params (I))),
                  Both));
            if I = Params'Last then
               S_Put
                 (0,
                  ") ");
            else
               S_Put (0, "; ");
            end if;
         end loop;

         S_Put (0, " return " & Result_Image);

         if Declaration_Only then
            return;
         end if;

         New_Line_Count;
         S_Put (3, "is");
         New_Line_Count;

         Str_Set := Current_Subp.TC_Info.Params_To_Temp;
         Cur := Str_Set.First;
         loop
            exit when Cur = String_Set.No_Element;

            S_Put (6, String_Set.Element (Cur));
            New_Line_Count;

            String_Set.Next (Cur);
         end loop;

         S_Put (3, "begin");
         New_Line_Count;

         if Current_Subp.TC_Info.Req_Image.all /= "" then
            S_Put (6, "begin");
            New_Line_Count;
            S_Put (9, "pragma Assert");
            New_Line_Count;
            S_Put
              (11,
               "(" &
               Current_Subp.TC_Info.Req_Image.all &
               ");");
            New_Line_Count;
            S_Put (9, "null;");
            New_Line_Count;
            S_Put (6, "exception");
            New_Line_Count;
            S_Put (12, "when System.Assertions.Assert_Failure =>");
            New_Line_Count;
            S_Put (15, "AUnit.Assertions.Assert");
            New_Line_Count;
            S_Put (17, "(False,");
            New_Line_Count;
            S_Put
              (18,
               """req_sloc("
               & Current_Subp.TC_Info.Req_Line.all
               & "):"
               & Current_Subp.TC_Info.Name.all
               & " test requirement violated"");");
            New_Line_Count;
            S_Put (6, "end;");
            New_Line_Count;
         end if;

         S_Put (6, "declare");
         New_Line_Count;
         S_Put
           (9,
            Current_Subp.Subp_Mangle_Name.all &
            "_Result : constant " &
            Result_Image &
            " := GNATtest_Generated.GNATtest_Standard." &
            Current_Subp.Nesting.all &
            "." &
            Current_Subp.Subp_Name_Image.all);

         if Params'Length = 0 then
            S_Put (0, ";");
         else
            S_Put (1, "(");
            for I in Params'Range loop
               declare
                  Name_List : constant Asis.Element_List := Names (Params (I));
               begin
                  for J in Name_List'Range loop
                     S_Put
                       (0,
                        To_String (Defining_Name_Image (Name_List (J))));
                     if J /= Name_List'Last then
                        S_Put (0, ", ");
                     end if;
                  end loop;
               end;

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

         New_Line_Count;

         S_Put (6, "begin");
         New_Line_Count;

         if Current_Subp.TC_Info.Ens_Image.all /= "" then
            S_Put (9, "begin");
            New_Line_Count;
            S_Put (12, "pragma Assert");
            New_Line_Count;
            S_Put
              (14,
               "(" &
               Current_Subp.TC_Info.Ens_Image.all &
               ");");
            New_Line_Count;
            S_Put (12, "null;");
            New_Line_Count;
            S_Put (9, "exception");
            New_Line_Count;
            S_Put (12, "when System.Assertions.Assert_Failure =>");
            New_Line_Count;
            S_Put (15, "AUnit.Assertions.Assert");
            New_Line_Count;
            S_Put (17, "(False,");
            New_Line_Count;
            S_Put
              (18,
               """ens_sloc("
               & Current_Subp.TC_Info.Ens_Line.all
               & "):"
               & Current_Subp.TC_Info.Name.all
               & " test commitment violated"");");
            New_Line_Count;
            S_Put (9, "end;");
            New_Line_Count;
         end if;

         S_Put
           (9,
            "return " &
            Current_Subp.Subp_Mangle_Name.all &
            "_Result;");
         New_Line_Count;

         S_Put (6, "end;");
         New_Line_Count;

         S_Put
           (3,
            "end " &
            Wrapper_Prefix &
            Current_Subp.Subp_Mangle_Name.all &
            ";");
         New_Line_Count;
         S_Put (0, GT_Marker_End);
         New_Line_Count;
      end;
   end Generate_Function_Wrapper;

   -------------------------------
   -- Generate_Nested_Hierarchy --
   -------------------------------

   procedure Generate_Nested_Hierarchy (Data : Data_Holder)
   is
      Cur : Package_Info_List.Cursor := Data.Package_Data_List.First;
      Output_Dir  : constant String :=
        Get_Source_Output_Dir (Data.Unit_File_Name.all);
   begin
      loop
         exit when Cur = Package_Info_List.No_Element;

         declare
            S           : constant String :=
              Package_Info_List.Element (Cur).Name.all;
            S_Pack : constant String :=
              Data.Unit_Full_Name.all & "." &
              Test_Data_Unit_Name & "." &
              Test_Unit_Name & "." &
              Nesting_Difference (Data.Unit_Full_Name.all, S);
         begin
            if
              Data.Unit_Full_Name.all /= S
            then
               Create
                 (Output_Dir & Directory_Separator &
                  Unit_To_File_Name (S_Pack) & ".ads");

               S_Put (0, "package " & S_Pack & " is");
               Put_New_Line;
               S_Put (0, "end " & S_Pack & ";");
               Put_New_Line;

               Close_File;
            end if;
         end;

         Package_Info_List.Next (Cur);
      end loop;

      if not Data.Has_Simple_Case then
         Create
           (Output_Dir & Directory_Separator &
            Unit_To_File_Name
              (Data.Unit_Full_Name.all & "." &
               Test_Data_Unit_Name & "." &
               Test_Unit_Name) &
            ".ads");

         S_Put
           (0,
            "package " & Data.Unit_Full_Name.all &
            "." & Test_Data_Unit_Name & "." & Test_Unit_Name & " is");
         Put_New_Line;
         S_Put
           (0,
            "end " & Data.Unit_Full_Name.all &
            "." & Test_Data_Unit_Name & "." & Test_Unit_Name  & ";");
         Put_New_Line;

         Close_File;

         Excluded_Test_Package_Bodies.Include
           (Unit_To_File_Name
              (Data.Unit_Full_Name.all & "."
               & Test_Data_Unit_Name & "."
               & Test_Unit_Name)
            & ".adb");

         Create
           (Output_Dir & Directory_Separator &
            Unit_To_File_Name
              (Data.Unit_Full_Name.all & "." &
               Test_Data_Unit_Name) &
            ".ads");

         S_Put
           (0,
            "package " & Data.Unit_Full_Name.all &
            "." & Test_Data_Unit_Name & " is");
         Put_New_Line;
         S_Put
           (0,
            "end " & Data.Unit_Full_Name.all &
            "." & Test_Data_Unit_Name  & ";");
         Put_New_Line;

         Close_File;

         Excluded_Test_Package_Bodies.Include
           (Unit_To_File_Name
              (Data.Unit_Full_Name.all & "."
               & Test_Data_Unit_Name)
            & ".adb");
      end if;

   end Generate_Nested_Hierarchy;

   --------------------------------
   -- Generate_Procedure_Wrapper --
   --------------------------------

   procedure Generate_Procedure_Wrapper
     (Current_Subp : Subp_Info; Declaration_Only : Boolean := False)
   is
      Str_Set : String_Set.Set;
      Cur     : String_Set.Cursor;
   begin
      S_Put (0, GT_Marker_Begin);
      New_Line_Count;
      S_Put
        (3,
         "procedure " &
         Wrapper_Prefix &
         Current_Subp.Subp_Mangle_Name.all);
      declare
         Params : constant
           Asis.Parameter_Specification_List := Parameter_Profile
             (Current_Subp.Subp_Declaration);
      begin
         for I in Params'Range loop
            if I = Params'First then
               S_Put (0, " (");
            end if;
            S_Put
              (0,
               Trim
                 (To_String (Element_Image (Params (I))),
                  Both));
            if I = Params'Last then
               S_Put
                 (0,
                  ") ");
            else
               S_Put (0, "; ");
            end if;
         end loop;

         if Declaration_Only then
            return;
         end if;

         New_Line_Count;
         S_Put (3, "is");
         New_Line_Count;

         Str_Set := Current_Subp.TC_Info.Params_To_Temp;
         Cur := Str_Set.First;
         loop
            exit when Cur = String_Set.No_Element;

            S_Put (6, String_Set.Element (Cur));
            New_Line_Count;

            String_Set.Next (Cur);
         end loop;

         S_Put (3, "begin");
         New_Line_Count;

         if Current_Subp.TC_Info.Req_Image.all /= "" then
            S_Put (6, "begin");
            New_Line_Count;
            S_Put (9, "pragma Assert");
            New_Line_Count;
            S_Put
              (11,
               "(" &
               Current_Subp.TC_Info.Req_Image.all &
                 ");");
            New_Line_Count;
            S_Put (9, "null;");
            New_Line_Count;
            S_Put (6, "exception");
            New_Line_Count;
            S_Put (9, "when System.Assertions.Assert_Failure =>");
            New_Line_Count;
            S_Put (12, "AUnit.Assertions.Assert");
            New_Line_Count;
            S_Put (14, "(False,");
            New_Line_Count;
            S_Put
              (15,
               """req_sloc("
               & Current_Subp.TC_Info.Req_Line.all
               & "):"
               & Current_Subp.TC_Info.Name.all
               & " test requirement violated"");");
            New_Line_Count;
            S_Put (6, "end;");
            New_Line_Count;
         end if;

         S_Put
           (6,
            "GNATtest_Generated.GNATtest_Standard." &
            Current_Subp.Nesting.all &
            "." &
            Current_Subp.Subp_Text_Name.all);

         if Params'Length = 0 then
            S_Put (0, ";");
         else
            S_Put (1, "(");
            for I in Params'Range loop
               declare
                  Name_List : constant Asis.Element_List := Names (Params (I));
               begin
                  for J in Name_List'Range loop
                     S_Put
                       (0,
                        To_String (Defining_Name_Image (Name_List (J))));
                     if J /= Name_List'Last then
                        S_Put (0, ", ");
                     end if;
                  end loop;
               end;
               if I = Params'Last then
                  S_Put (0, ");");
               else
                  S_Put (0, ", ");
               end if;
            end loop;
         end if;

         New_Line_Count;

         if Current_Subp.TC_Info.Ens_Image.all /= "" then
            S_Put (6, "begin");
            New_Line_Count;
            S_Put (9, "pragma Assert");
            New_Line_Count;
            S_Put
              (11,
               "(" &
               Current_Subp.TC_Info.Ens_Image.all &
               ");");
            New_Line_Count;
            S_Put (9, "null;");
            New_Line_Count;
            S_Put (6, "exception");
            New_Line_Count;
            S_Put (9, "when System.Assertions.Assert_Failure =>");
            New_Line_Count;
            S_Put (12, "AUnit.Assertions.Assert");
            New_Line_Count;
            S_Put (14, "(False,");
            New_Line_Count;
            S_Put
              (15,
               """ens_sloc("
               & Current_Subp.TC_Info.Ens_Line.all
               & "):"
               & Current_Subp.TC_Info.Name.all
               & " test commitment violated"");");
            New_Line_Count;
            S_Put (6, "end;");
            New_Line_Count;
         end if;

         S_Put
           (3,
            "end " &
            Wrapper_Prefix &
            Current_Subp.Subp_Mangle_Name.all &
            ";");
         New_Line_Count;
         S_Put (0, GT_Marker_End);
         New_Line_Count;
      end;
   end Generate_Procedure_Wrapper;

   ---------------------------
   -- Generate_Project_File --
   ---------------------------

   procedure Generate_Project_File is
      Tmp_Str : String_Access;
      package Srcs is new
        Ada.Containers.Indefinite_Ordered_Sets (String);
      use Srcs;

      Out_Dirs     : Srcs.Set;
      Out_Dirs_Cur : Srcs.Cursor;

      Output_Prj : String_Access;

      Source_Prj_Name : String :=
        Base_Name (Source_Prj.all, File_Extension (Source_Prj.all));

   begin
      for I in Source_Prj_Name'Range loop
         if Source_Prj_Name (I) = '-' then
            Source_Prj_Name (I) := '_';
         end if;
      end loop;

      Reset_Source_Iterator;
      loop
         Tmp_Str := new String'(Next_Source_Name);
         exit when Tmp_Str.all = "";

         if Is_Directory (Get_Source_Output_Dir (Tmp_Str.all)) then
            Include (Out_Dirs, Get_Source_Output_Dir (Tmp_Str.all));
         end if;
         Free (Tmp_Str);
      end loop;

      Output_Prj :=
        new String'(Harness_Dir.all
                    & Directory_Separator
                    & Test_Prj_Prefix
                    & Source_Prj_Name
                    & ".gpr");

      Create (Output_Prj.all);

      S_Put (0, "with ""aunit"";");

      Put_New_Line;
      S_Put (0, "with ""gnattest_common.gpr"";");
      Put_New_Line;
      S_Put (0, "with """);
      S_Put
        (0,
         +Relative_Path
           (Create (+Source_Prj.all),
            Create (+Harness_Dir.all)) &
           """;");
      Put_New_Line;
      S_Put
        (0,
         "project "
         & Test_Prj_Prefix
         & Base_Name (Source_Prj_Name)
         & " is");
      Put_New_Line;
      Put_New_Line;

      S_Put (3, "for Source_Dirs use");
      Put_New_Line;

      if Out_Dirs.Is_Empty then
         S_Put (5, "(""common"");");

         Put_New_Line;
         Put_New_Line;
      else
         Out_Dirs_Cur := Out_Dirs.First;
         S_Put (5, "(""");
         S_Put
           (0,
            +Relative_Path
              (Create (+Srcs.Element (Out_Dirs_Cur)),
               Create (+Harness_Dir.all)) &
              """");
         loop
            Srcs.Next (Out_Dirs_Cur);
            exit when Out_Dirs_Cur = Srcs.No_Element;

            S_Put (0, ",");
            Put_New_Line;
            S_Put (6, """");
            S_Put
              (0,
               +Relative_Path
                 (Create (+Srcs.Element (Out_Dirs_Cur)),
                  Create (+Harness_Dir.all)) &
                 """");

         end loop;
         S_Put (0, ",");
         Put_New_Line;
         S_Put (6, """common"");");

         Put_New_Line;
         Put_New_Line;
      end if;

      S_Put (3, "for Languages use Gnattest_Common'Languages & (""Ada"");");
      Put_New_Line;

      S_Put (3, "package Compiler renames Gnattest_Common.Compiler;");
      Put_New_Line;
      Put_New_Line;

      if IDE_Package_Present then
         S_Put
           (3,
            "package Ide renames " &
            Base_Name (Source_Prj.all, File_Extension (Source_Prj.all)) &
            ".Ide;");
         Put_New_Line;
         Put_New_Line;
      end if;

      if Make_Package_Present then
         S_Put
           (3,
            "package Make renames " &
            Base_Name (Source_Prj.all, File_Extension (Source_Prj.all)) &
            ".Make;");
         Put_New_Line;
         Put_New_Line;
      end if;

      S_Put
        (0,
         "end "
         & Test_Prj_Prefix
         & Base_Name (Source_Prj_Name)
         & ";");
      Put_New_Line;
      Close_File;

      Tmp_Test_Prj := new String'(Normalize_Pathname
                                  (Name => Output_Prj.all,
                                   Case_Sensitive => False));
   end Generate_Project_File;

   -----------------------------
   --  Generate_Test_Package  --
   -----------------------------

   procedure Generate_Test_Package (Data : Data_Holder) is

      Output_Dir             : constant String :=
        Get_Source_Output_Dir (Data.Unit_File_Name.all);

      Tmp_File_Name      : constant String :=
        "gnattest_tmp_test_package";

      Test_File_Name : String_Access;
      Data_Unit_Name : String_Access;
      Unit_Name      : String_Access;
      Unit_Pref      : String_Access;

      Setters_Set : String_Set.Set;
      Set_Cur     : String_Set.Cursor;

      Subp_Cur     : Subp_Data_List.Cursor;
      Pack_Cur     : Package_Info_List.Cursor;

      Current_Type : Base_Type_Info;
      --  The test type for which the primitives are
      --  put togather in the corresponding test package

      Test_Unit_Suffix : String_Access;
      --  Generic or non-generic test package suffix or.

      Actual_Test : Boolean;
      --  Indicates if current test package has at least one non-abstract test
      --  routine. In that case we need to include AUnit.Assertions.

      Gen_Tests : Generic_Tests;
      --  Used to store all test type names in case of generic tested package.
      --  They are to be added at generic test storage.

      Nesting_Add : String_Access;

      UH     : Unique_Hash;
      MD     : Markered_Data;
      MD_Cur : Markered_Data_Maps.Cursor;

      Subp_List : Subp_Data_List.List;
      Current_Subp : Subp_Info;
      Current_Pack : Package_Info;

      TP_Map  : TP_Mapping;
      TP_List : TP_Mapping_List.List;

      Tear_Down_Line_Add : Natural := 0;

      Short_Names_Used : String_Set.Set;

      package Elements_Set is new
        Ada.Containers.Indefinite_Ordered_Sets (Asis.Element, "<", Is_Equal);
      use Elements_Set;

      Shortnamed_Subps : Elements_Set.Set;

      --  overlodaing number counting
      Name_Numbers : Name_Frequency.Map;
      package Elem_Number_Maps is new
        Ada.Containers.Indefinite_Ordered_Maps (Asis.Element, Natural);
      use Elem_Number_Maps;
      Elem_Numbers : Elem_Number_Maps.Map;

      Test_Data_Package_Name : String_Access;

      --  temporary storage for slocs of test routines
      type TR_SLOC_Buffer_Type is record
         TPtarg  : String_Access;
         Test_F  : String_Access;
         Test_T  : String_Access;
         Subp    : Subp_Info;
         TR_Line : Natural := 1;
      end record;

      package TR_SLOC_Buffer_Lists is new
        Ada.Containers.Doubly_Linked_Lists (TR_SLOC_Buffer_Type);
      use TR_SLOC_Buffer_Lists;

      TR_SLOC_Buffer : TR_SLOC_Buffer_Lists.List;

      procedure Add_Buffered_TR_Slocs
        (TP_List     : in out TP_Mapping_List.List;
         Common_Time : String);
      --  Pushes buffered test routine slocs into main mapping container.

      function Is_Unimplemented_Test
        (TR_Text : String_Vectors.Vector) return Boolean;
      --  Searches for specific text pattern which indicates that given test
      --  skeleton was not modified by user after generation.

      procedure Put_Test_Data_Header;

      procedure Put_TP_Header (TD_Package_Name : String);

      procedure Update_Generic_Packages (Instantiation : String);
      procedure Update_Generic_Packages (Gen_Pack      : Generic_Package);

      type Persistent_Section_Type is
        (With_Clauses,      -- /00/
         Body_Declarations, -- /01/
         Body_Statements);  -- /02/

      procedure Put_Persistent_Section (PS_Type : Persistent_Section_Type);
      --  Puts persistent section of given kind surrounded with read-only
      --  markers and corresponding specific Id.

      function Markered_Data_Map_Is_Empty return Boolean;
      --  Check if Markered_Data_Map is empty or the only element present is
      --  actually the Body_Statements persistent block.

      procedure Put_Persistent_Section (PS_Type : Persistent_Section_Type) is
         UH     : Unique_Hash;
         MD     : Markered_Data;
         MD_Cur : Markered_Data_Maps.Cursor;
      begin
         S_Put (0, "--  begin read only");
         New_Line_Count;
         case PS_Type is
            when With_Clauses =>
               S_Put (0, "--  id:" & Hash_Version & "/00/");
            when Body_Declarations =>
               S_Put (0, "--  id:" & Hash_Version & "/01/");
            when Body_Statements =>
               S_Put (0, "--  id:" & Hash_Version & "/02/");
         end case;
         New_Line_Count;
         S_Put (0, "--");
         New_Line_Count;
         case PS_Type is
            when With_Clauses =>
               S_Put (0, "--  This section can be used to add with "
                      & "clauses if necessary.");
            when Body_Declarations =>
               S_Put (0, "--  This section can be used to add global "
                      & "variables and other elements.");
            when Body_Statements =>
               S_Put (0, "--  This section can be used to add "
                      & "elaboration code for the global state.");
         end case;
         New_Line_Count;
         S_Put (0, "--");
         New_Line_Count;
         if PS_Type = Body_Statements then
            S_Put (0, "begin");
            New_Line_Count;
         end if;
         S_Put (0, "--  end read only");
         New_Line_Count;

         UH.Version := new String'(Hash_Version);
         case PS_Type is
            when With_Clauses =>
               UH.Hash := new String'("00");
            when Body_Declarations =>
               UH.Hash := new String'("01");
            when Body_Statements =>
               UH.Hash := new String'("02");
         end case;
         UH.TC_Hash := new String'("");
         MD_Cur := Find (Markered_Data_Map, UH);
         if MD_Cur /= Markered_Data_Maps.No_Element then
            MD := Markered_Data_Maps.Element (MD_Cur);
            for I in MD.TR_Text.First_Index .. MD.TR_Text.Last_Index loop
               S_Put (0, MD.TR_Text.Element (I));
               New_Line_Count;
            end loop;
            Markered_Data_Map.Delete (MD_Cur);
         else
            if PS_Type = Body_Statements then
               S_Put (3, "null;");
            end if;
            New_Line_Count;
         end if;

         S_Put (0, "--  begin read only");
         New_Line_Count;
         S_Put (0, "--  end read only");
         New_Line_Count;
      end Put_Persistent_Section;

      procedure Add_Buffered_TR_Slocs
        (TP_List     : in out TP_Mapping_List.List;
         Common_Time : String)
      is
         Cur : TR_SLOC_Buffer_Lists.Cursor := TR_SLOC_Buffer.First;
      begin
         loop
            exit when Cur = TR_SLOC_Buffer_Lists.No_Element;

            if TR_SLOC_Buffer_Lists.Element (Cur).Test_T /= null then
               Add_TR
                 (TP_List,
                  TR_SLOC_Buffer_Lists.Element (Cur).TPtarg.all,
                  TR_SLOC_Buffer_Lists.Element (Cur).Test_F.all,
                  "modified",
                  TR_SLOC_Buffer_Lists.Element (Cur).Subp,
                  TR_SLOC_Buffer_Lists.Element (Cur).TR_Line);
            else
               Add_TR
                 (TP_List,
                  TR_SLOC_Buffer_Lists.Element (Cur).TPtarg.all,
                  TR_SLOC_Buffer_Lists.Element (Cur).Test_F.all,
                  Common_Time,
                  TR_SLOC_Buffer_Lists.Element (Cur).Subp,
                  TR_SLOC_Buffer_Lists.Element (Cur).TR_Line);
            end if;
            TR_SLOC_Buffer_Lists.Next (Cur);
         end loop;

         TR_SLOC_Buffer.Clear;

      end Add_Buffered_TR_Slocs;

      function Is_Unimplemented_Test
        (TR_Text : String_Vectors.Vector) return Boolean
      is
         Unimplemented_Line : constant String :=
           """Test not implemented.""";
      begin

         if TR_Text.Is_Empty then
            return True;
         end if;

         for I in TR_Text.First_Index .. TR_Text.Last_Index loop
            if Index (TR_Text.Element (I), Unimplemented_Line) /= 0 then
               return True;
            end if;
         end loop;

         return False;

      end Is_Unimplemented_Test;

      function Markered_Data_Map_Is_Empty return Boolean is
         use Ada.Containers;
      begin
         if Markered_Data_Map.Is_Empty then
            return True;
         elsif Markered_Data_Map.Length = 1
           and then Markered_Data_Map.First_Key.Hash.all = "02"
         then
            return True;
         else
            return False;
         end if;
      end Markered_Data_Map_Is_Empty;

      procedure Put_Test_Data_Header is
      begin
         S_Put
           (0,
            "--  This package is intended to set up and tear down "
            & " the test environment.");
         Put_New_Line;
         S_Put
           (0,
            "--  Once created by GNATtest, this package will "
            & "never be overwritten");
         Put_New_Line;
         S_Put
           (0,
            "--  automatically. Contents of this package can be "
            & "modified in any way");
         Put_New_Line;
         S_Put
           (0,
            "--  except for sections surrounded by a 'read only' marker.");
         Put_New_Line;
         Put_New_Line;
      end Put_Test_Data_Header;

      procedure Put_TP_Header (TD_Package_Name : String) is
      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 the bodies "
            & "of test routines.");
         New_Line_Count;
         S_Put
           (0,
            "--  Such changes will be kept during further regeneration "
            & "of this file.");
         New_Line_Count;
         S_Put
           (0,
            "--  All code placed outside of test routine bodies "
            & "will be lost. The");
         New_Line_Count;
         S_Put
           (0,
            "--  code intended to set up and tear down the test "
            & "environment should be");
         New_Line_Count;
         S_Put
           (0,
            "--  placed into "
            & TD_Package_Name & ".");
         New_Line_Count;
         New_Line_Count;
      end Put_TP_Header;

      procedure Update_Generic_Packages (Gen_Pack : Generic_Package) is
         Cur : Generic_Package_Storage.Cursor := Gen_Package_Storage.First;
         GP  : Generic_Package;
      begin
         while Cur /= Generic_Package_Storage.No_Element loop

            GP := Generic_Package_Storage.Element (Cur);

            if GP.Name.all = Gen_Pack.Name.all then
               if GP.Sloc /= null then
                  --  Same package can be added several times.
                  return;
               end if;
               GP.Sloc := Gen_Pack.Sloc;
               Gen_Package_Storage.Replace_Element (Cur, GP);
               return;
            end if;

            Next (Cur);
         end loop;

         Gen_Package_Storage.Append (Gen_Pack);
      end Update_Generic_Packages;

      procedure Update_Generic_Packages (Instantiation : String) is
         Cur : Generic_Package_Storage.Cursor := Gen_Package_Storage.First;
         GP  : Generic_Package;
      begin
         while Cur /= Generic_Package_Storage.No_Element loop

            GP := Generic_Package_Storage.Element (Cur);

            if GP.Name.all = Instantiation then
               if GP.Has_Instantiation then
                  --  Same package can be instantiated multiple times.
                  return;
               end if;
               GP.Has_Instantiation := True;
               Gen_Package_Storage.Replace_Element (Cur, GP);
               return;
            end if;

            Next (Cur);
         end loop;

         --  Instantiation is processed ahead of coresponding generic.
         --  Adding a template for it to later fill in the sloc.
         GP.Name := new String'(Instantiation);
         GP.Sloc := null;
         GP.Has_Instantiation := True;
         Gen_Package_Storage.Append (GP);
      end Update_Generic_Packages;

   begin

      if not Generate_Separates then
         Test_Info.Include (Data.Unit_File_Name.all, 0);
      end if;

      if Data.Is_Generic then
         Test_Unit_Suffix := new String'(Gen_Test_Unit_Name_Suff);
         Gen_Tests.Gen_Unit_Full_Name := new String'(Data.Unit_Full_Name.all);
      else
         Test_Unit_Suffix := new String'(Test_Unit_Name_Suff);
      end if;

      for I in
        Data.Type_Data_List.First_Index .. Data.Type_Data_List.Last_Index
      loop

         Current_Type := Data.Type_Data_List.Element (I);

         --  setting up current package
         Pack_Cur := Data.Package_Data_List.First;
         loop
            exit when Pack_Cur = Package_Info_List.No_Element;

            Current_Pack := Package_Info_List.Element (Pack_Cur);

            if Current_Type.Nesting.all = Current_Pack.Name.all then
               exit;
            end if;

            Pack_Cur := Package_Info_List.Next (Pack_Cur);
         end loop;

         Actual_Test := False;

         if Data.Unit_Full_Name.all = Current_Type.Nesting.all then
            Unit_Pref := new String'(Data.Unit_Full_Name.all);
         else
            Unit_Pref := new String'
              (Data.Unit_Full_Name.all & "." &
               Test_Data_Unit_Name & "." &
               Test_Unit_Name & "." &
               Nesting_Difference
                 (Data.Unit_Full_Name.all,
                  Current_Type.Nesting.all));
         end if;

         Data_Unit_Name := new String'
           (Unit_Pref.all & "."                  &
            Current_Type.Main_Type_Text_Name.all &
            Test_Data_Unit_Name_Suff);

         Test_File_Name := new String'(Unit_To_File_Name (Data_Unit_Name.all));

         --  saving test data package name for further reference
         Test_Data_Package_Name := new String'(Data_Unit_Name.all);

         if not Is_Regular_File
           (Output_Dir & Directory_Separator & Test_File_Name.all & ".ads")
         then

            Create
              (Output_Dir & Directory_Separator & Test_File_Name.all & ".ads");

            Put_Test_Data_Header;

            if not Current_Type.Has_Argument_Father then
               if Current_Pack.Data_Kind = Instantiation then
                  S_Put
                    (0,
                     "with "
                     & Current_Pack.Generic_Containing_Package.all
                     & "."
                     & Current_Type.Main_Type_Text_Name.all
                     & Test_Data_Unit_Name_Suff
                     & ";");
                  Put_New_Line;
                  S_Put
                    (0,
                     "with "
                     & Current_Pack.Generic_Containing_Package.all
                     & "."
                     & Current_Type.Main_Type_Text_Name.all
                     & Test_Data_Unit_Name_Suff
                     & "."
                     & Current_Type.Main_Type_Text_Name.all
                     & Test_Unit_Name_Suff
                     & ";");
               end if;
               Put_New_Line;
               S_Put (0, "with AUnit.Test_Fixtures;");
            else
               if
                 Current_Type.Argument_Father_Unit_Name.all =
                   Current_Type.Argument_Father_Nesting.all
               then
                  S_Put
                    (0,
                     "with "                                    &
                     Current_Type.Argument_Father_Unit_Name.all &
                     "."                                        &
                     Current_Type.Argument_Father_Type_Name.all &
                     Test_Data_Unit_Name_Suff                   &
                     "."                                        &
                     Current_Type.Argument_Father_Type_Name.all &
                     Test_Unit_Suffix.all                       &
                     ";");
               else
                  S_Put
                    (0,
                     "with "                                      &
                     Current_Type.Argument_Father_Unit_Name.all   &
                     "."                                          &
                     Test_Data_Unit_Name                          &
                     "."                                          &
                     Test_Unit_Name                               &
                     "."                                          &
                     Nesting_Difference
                       (Current_Type.Argument_Father_Unit_Name.all,
                        Current_Type.Argument_Father_Nesting.all) &
                     "."                                          &
                     Current_Type.Argument_Father_Type_Name.all   &
                     Test_Data_Unit_Name_Suff                     &
                     "."                                          &
                     Current_Type.Argument_Father_Type_Name.all   &
                     Test_Unit_Suffix.all                         &
                     ";");
               end if;
            end if;
            Put_New_Line;
            Put_New_Line;

            S_Put (0, "with GNATtest_Generated;");
            Put_New_Line;
            Put_New_Line;

            if Current_Pack.Is_Generic then
               S_Put (0, "generic");
               Put_New_Line;
               S_Put
                 (3,
                  "type GNATtest_Test_Type is new "
                  & "AUnit.Test_Fixtures.Test_Fixture");
               Put_New_Line;
               S_Put (5, "with private;");
               Put_New_Line;
            end if;

            S_Put (0, "package " & Data_Unit_Name.all & " is");
            Put_New_Line;
            Put_New_Line;

            if Current_Pack.Data_Kind = Declaration_Data then
               if Current_Type.Has_Argument_Father then
                  --  Declaring test type extension from another test type.
                  S_Put (0, GT_Marker_Begin);
                  Put_New_Line;
                  S_Put
                    (3,
                     "type Test_" &
                       Current_Type.Main_Type_Text_Name.all);
                  if Current_Type.Main_Type_Abstract then
                     S_Put (0, " is abstract new");
                  else
                     S_Put (0, " is new");
                  end if;
                  Put_New_Line;

                  if
                    Current_Type.Argument_Father_Unit_Name.all /=
                      Current_Type.Argument_Father_Nesting.all
                  then
                     Nesting_Add := new String'
                       (Test_Data_Unit_Name & "." &
                          Test_Unit_Name & "." &
                          Nesting_Difference
                          (Current_Type.Argument_Father_Unit_Name.all,
                           Current_Type.Argument_Father_Nesting.all) &
                          ".");
                  else
                     Nesting_Add := new String'("");
                  end if;

                  S_Put
                    (5,
                     "GNATtest_Generated.GNATtest_Standard."    &
                       Current_Type.Argument_Father_Unit_Name.all &
                       "."                                        &
                       Nesting_Add.all                            &
                       Current_Type.Argument_Father_Type_Name.all &
                       Test_Data_Unit_Name_Suff                   &
                       "."                                        &
                       Current_Type.Argument_Father_Type_Name.all &
                       Test_Unit_Suffix.all                       &
                       ".Test_"                                   &
                       Current_Type.Argument_Father_Type_Name.all);
                  Put_New_Line;
                  S_Put (0, GT_Marker_End);
                  Put_New_Line;
                  S_Put (3, "with null record;");

                  Free (Nesting_Add);

               else
                  --  Declaring access type to tested type.
                  S_Put
                    (3,
                     "type "                                 &
                       Current_Type.Main_Type_Text_Name.all    &
                       "_Access is access all "                &
                       "GNATtest_Generated.GNATtest_Standard." &
                       Current_Type.Nesting.all                &
                       "."                                     &
                       Current_Type.Main_Type_Text_Name.all    &
                       "'Class;");
                  Put_New_Line;
                  Put_New_Line;

                  --  Declaring root test type.
                  S_Put (0, GT_Marker_Begin);
                  Put_New_Line;
                  S_Put
                    (3,
                     "type Test_"                         &
                       Current_Type.Main_Type_Text_Name.all &
                       " is");
                  if Current_Type.Main_Type_Abstract then
                     S_Put (0, " abstract");
                  end if;
                  S_Put (0, " new AUnit.Test_Fixtures.Test_Fixture");
                  Put_New_Line;
                  S_Put (0, GT_Marker_End);
                  Put_New_Line;
                  S_Put (3, "with record");
                  Put_New_Line;
                  S_Put
                    (6,
                     "Fixture : "                         &
                       Current_Type.Main_Type_Text_Name.all &
                       "_Access;");
                  Put_New_Line;
                  S_Put (3, "end record;");
               end if;
            else
               S_Put (0, GT_Marker_Begin);
               Put_New_Line;
               S_Put
                 (3,
                  "type Test_"                         &
                    Current_Type.Main_Type_Text_Name.all &
                    " is");
               S_Put (0, " new AUnit.Test_Fixtures.Test_Fixture");
               Put_New_Line;
               S_Put (0, GT_Marker_End);
               Put_New_Line;
               S_Put (3, "with null record;");
            end if;

            Put_New_Line;
            Put_New_Line;

            if not Current_Type.Main_Type_Abstract then
               S_Put
                 (3,
                  "procedure Set_Up (Gnattest_T : in out Test_" &
                  Current_Type.Main_Type_Text_Name.all &
                  ");");
               Put_New_Line;
               S_Put
                 (3,
                  "procedure Tear_Down (Gnattest_T : in out Test_" &
                  Current_Type.Main_Type_Text_Name.all &
                  ");");
               Put_New_Line;
               Put_New_Line;
            end if;

            if Current_Pack.Data_Kind = Instantiation then
               S_Put (0, GT_Marker_Begin);
               Put_New_Line;
               S_Put
                 (3,
                  "package Gnattest_Data_Inst is new "
                  & "GNATtest_Generated.GNATtest_Standard."
                  & Current_Pack.Name.all
                  & "."
                  & Current_Type.Main_Type_Text_Name.all
                  & Test_Data_Unit_Name_Suff
                  & " (Test_"
                  & Current_Type.Main_Type_Text_Name.all
                  & ");");
               Put_New_Line;
               S_Put
                 (3,
                  "package Gnattest_Tests_Inst is new Gnattest_Data_Inst."
                  & Current_Type.Main_Type_Text_Name.all
                  & Test_Unit_Name_Suff
                  & ";");
               Put_New_Line;
               Put_New_Line;
               S_Put
                 (3,
                  "type New_Test is new Gnattest_Tests_Inst.Test_"
                  & Current_Type.Main_Type_Text_Name.all
                  & " with null record;");
               Put_New_Line;
               S_Put (0, GT_Marker_End);
               Put_New_Line;
               Put_New_Line;
               S_Put
                 (3,
                  "procedure User_Set_Up (Gnattest_T : in out New_Test);");
               Put_New_Line;
               S_Put
                 (3,
                  "procedure User_Tear_Down "
                  & "(Gnattest_T : in out New_Test);");
               Put_New_Line;
               Put_New_Line;
            end if;

            if Current_Pack.Is_Generic then
               S_Put
                 (3,
                  "procedure User_Set_Up (Gnattest_T : in out Test_"
                  & Current_Type.Main_Type_Text_Name.all
                  & ");");
               Put_New_Line;
               S_Put
                 (3,
                  "procedure User_Tear_Down (Gnattest_T : in out Test_"
                  & Current_Type.Main_Type_Text_Name.all
                  & ");");
               Put_New_Line;
               Put_New_Line;
            end if;

            S_Put (0, "end " & Data_Unit_Name.all & ";");
            Put_New_Line;

            Close_File;

         end if;

         if not Current_Type.Main_Type_Abstract and then
           not Is_Regular_File
           (Output_Dir & Directory_Separator & Test_File_Name.all & ".adb")
         then

            Create
              (Output_Dir & Directory_Separator & Test_File_Name.all & ".adb");

            Put_Test_Data_Header;

            S_Put (0, "package body " & Data_Unit_Name.all & " is");
            Put_New_Line;
            Put_New_Line;

            if Current_Pack.Data_Kind = Declaration_Data then
               if Current_Type.No_Default_Discriminant then
                  S_Put
                    (3,
                     "--  Local_"                            &
                       Current_Type.Main_Type_Text_Name.all    &
                       " : aliased "                           &
                       "GNATtest_Generated.GNATtest_Standard." &
                       Current_Type.Nesting.all                &
                       "."                                     &
                       Current_Type.Main_Type_Text_Name.all &
                       ";");
               else
                  S_Put
                    (3,
                     "Local_"                                &
                       Current_Type.Main_Type_Text_Name.all    &
                       " : aliased "                           &
                       "GNATtest_Generated.GNATtest_Standard." &
                       Current_Type.Nesting.all                &
                       "."                                     &
                       Current_Type.Main_Type_Text_Name.all    &
                       ";");
               end if;
               Put_New_Line;
            end if;

            S_Put
              (3,
               "procedure Set_Up (Gnattest_T : in out Test_" &
               Current_Type.Main_Type_Text_Name.all      &
               ") is");
            Put_New_Line;

            if Current_Pack.Data_Kind = Declaration_Data then
               if Current_Pack.Is_Generic then
                  S_Put
                    (6,
                     "X : Test_"
                     & Current_Type.Main_Type_Text_Name.all
                     & "'Class renames Test_"
                     & Current_Type.Main_Type_Text_Name.all
                     & "'Class (Gnattest_T);");
                  Put_New_Line;
               end if;
            end if;

            S_Put (3, "begin");
            Put_New_Line;

            if Current_Type.Has_Argument_Father then
               if
                 Current_Type.Argument_Father_Unit_Name.all /=
                   Current_Type.Argument_Father_Nesting.all
               then
                  Nesting_Add := new String'
                    (Test_Data_Unit_Name & "." &
                     Test_Unit_Name & "." &
                     Nesting_Difference
                       (Current_Type.Argument_Father_Unit_Name.all,
                        Current_Type.Argument_Father_Nesting.all) &
                     ".");
               else
                  Nesting_Add := new String'("");
               end if;

               S_Put
                 (6,
                  "GNATtest_Generated.GNATtest_Standard."    &
                  Current_Type.Argument_Father_Unit_Name.all &
                  "."                                        &
                  Nesting_Add.all                            &
                  Current_Type.Argument_Father_Type_Name.all &
                  Test_Data_Unit_Name_Suff                   &
                  "."                                        &
                  Current_Type.Argument_Father_Type_Name.all &
                  Test_Unit_Suffix.all                       &
                  ".Set_Up");
               Put_New_Line;
               S_Put
                 (8,
                  "(GNATtest_Generated.GNATtest_Standard."    &
                  Current_Type.Argument_Father_Unit_Name.all &
                  "."                                        &
                  Nesting_Add.all                            &
                  Current_Type.Argument_Father_Type_Name.all &
                  Test_Data_Unit_Name_Suff                   &
                  "."                                        &
                  Current_Type.Argument_Father_Type_Name.all &
                  Test_Unit_Suffix.all                       &
                  ".Test_"                                   &
                  Current_Type.Argument_Father_Type_Name.all &
                  " (Gnattest_T));");
               Put_New_Line;

               Free (Nesting_Add);
            end if;

            if Current_Pack.Data_Kind = Declaration_Data then
               if Current_Type.No_Default_Discriminant then
                  S_Put
                    (6, "null;");
                  Put_New_Line;
                  S_Put
                    (6, "--  Gnattest_T.Fixture := Local_"         &
                       Current_Type.Main_Type_Text_Name.all &
                       "'Access;");
                  Put_New_Line;
               else
                  S_Put
                    (6, "Gnattest_T.Fixture := Local_"             &
                       Current_Type.Main_Type_Text_Name.all &
                       "'Access;");
                  Put_New_Line;

                  if Current_Pack.Data_Kind = Declaration_Data then
                     if Current_Pack.Is_Generic then
                        S_Put (6, "User_Set_Up (X);");
                        Put_New_Line;
                     end if;
                  end if;
               end if;

            else
               S_Put
                 (6, "null;");
               Put_New_Line;
            end if;
            S_Put (3, "end Set_Up;");
            Put_New_Line;
            Put_New_Line;

            S_Put
              (3,
               "procedure Tear_Down (Gnattest_T : in out Test_" &
               Current_Type.Main_Type_Text_Name.all &
               ") is");
            Put_New_Line;

            if Current_Pack.Data_Kind = Declaration_Data then
               if Current_Pack.Is_Generic then
                  S_Put
                    (6,
                     "X : Test_"
                     & Current_Type.Main_Type_Text_Name.all
                     & "'Class renames Test_"
                     & Current_Type.Main_Type_Text_Name.all
                     & "'Class (Gnattest_T);");
                  Put_New_Line;
               end if;
            end if;

            S_Put (3, "begin");
            Put_New_Line;

            if Current_Type.Has_Argument_Father then
               if
                 Current_Type.Argument_Father_Unit_Name.all /=
                   Current_Type.Argument_Father_Nesting.all
               then
                  Nesting_Add := new String'
                    (Test_Data_Unit_Name & "." &
                     Test_Unit_Name & "." &
                     Nesting_Difference
                       (Current_Type.Argument_Father_Unit_Name.all,
                        Current_Type.Argument_Father_Nesting.all) &
                     ".");
               else
                  Nesting_Add := new String'("");
               end if;

               S_Put
                 (6,
                  "GNATtest_Generated.GNATtest_Standard."    &
                  Current_Type.Argument_Father_Unit_Name.all &
                  "."                                        &
                  Nesting_Add.all                            &
                  Current_Type.Argument_Father_Type_Name.all &
                  Test_Data_Unit_Name_Suff                   &
                  "."                                        &
                  Current_Type.Argument_Father_Type_Name.all &
                  Test_Unit_Suffix.all                       &
                  ".Tear_Down");
               Put_New_Line;
               S_Put
                 (8,
                  "(GNATtest_Generated.GNATtest_Standard."    &
                  Current_Type.Argument_Father_Unit_Name.all &
                  "."                                        &
                  Nesting_Add.all                            &
                  Current_Type.Argument_Father_Type_Name.all &
                  Test_Data_Unit_Name_Suff                   &
                  "."                                        &
                  Current_Type.Argument_Father_Type_Name.all &
                  Test_Unit_Suffix.all                       &
                  ".Test_"                                   &
                  Current_Type.Argument_Father_Type_Name.all &
                  " (Gnattest_T));");

               Free (Nesting_Add);
            else
               if Current_Pack.Data_Kind = Declaration_Data
                 and then Current_Pack.Is_Generic
               then
                     S_Put (6, "User_Tear_Down (X);");
               else
                  S_Put
                    (6, "null;");
               end if;
            end if;

            Put_New_Line;
            S_Put (3, "end Tear_Down;");

            Put_New_Line;
            Put_New_Line;

            if Current_Pack.Data_Kind = Instantiation then
               S_Put
                 (3,
                  "procedure User_Set_Up "
                  & "(Gnattest_T : in out New_Test) is");
               Put_New_Line;
               S_Put (6, "pragma Unreferenced (Gnattest_T);");
               Put_New_Line;
               S_Put (3, "begin");
               Put_New_Line;
               S_Put (6, "null;");
               Put_New_Line;
               S_Put (3, "end User_Set_Up;");
               Put_New_Line;
               Put_New_Line;
               S_Put
                 (3,
                  "procedure User_Tear_Down "
                  & "(Gnattest_T : in out New_Test) is");
               Put_New_Line;
               S_Put (6, "pragma Unreferenced (Gnattest_T);");
               Put_New_Line;
               S_Put (3, "begin");
               Put_New_Line;
               S_Put (6, "null;");
               Put_New_Line;
               S_Put (3, "end User_Tear_Down;");
               Put_New_Line;
               Put_New_Line;
            end if;

            if Current_Pack.Is_Generic then
               S_Put
                 (3,
                  "procedure User_Set_Up (Gnattest_T : in out Test_"
                  & Current_Type.Main_Type_Text_Name.all
                  & ") is");
               Put_New_Line;
               S_Put (3, "begin");
               Put_New_Line;
               S_Put (6, "null;");
               Put_New_Line;
               S_Put (3, "end User_Set_Up;");
               Put_New_Line;
               Put_New_Line;
               S_Put
                 (3,
                  "procedure User_Tear_Down (Gnattest_T : in out Test_"
                  & Current_Type.Main_Type_Text_Name.all
                  & ") is");
               Put_New_Line;
               S_Put (3, "begin");
               Put_New_Line;
               S_Put (6, "null;");
               Put_New_Line;
               S_Put (3, "end User_Tear_Down;");
               Put_New_Line;
               Put_New_Line;
            end if;

            S_Put (0, "end " & Data_Unit_Name.all & ";");
            Put_New_Line;
            Close_File;

         end if;

         TP_Map.SetUp_Name    := new String'(Test_File_Name.all & ".adb");
         TP_Map.TearDown_Name := new String'(Test_File_Name.all & ".adb");
         TP_Map.SetUp_Line    := 9;
         TP_Map.SetUp_Column  := 4;

         Tear_Down_Line_Add := 0;
         if Current_Type.No_Default_Discriminant then
            Tear_Down_Line_Add := Tear_Down_Line_Add + 1;
         end if;
         if Current_Type.Has_Argument_Father then
            Tear_Down_Line_Add := Tear_Down_Line_Add + 1;
         end if;
         TP_Map.TearDown_Line := 14 + Tear_Down_Line_Add;
         TP_Map.TearDown_Column := 4;

         Free (Test_File_Name);

         Unit_Name := new
           String'(Unit_Pref.all                        &
                     "."                                  &
                     Current_Type.Main_Type_Text_Name.all &
                     Test_Data_Unit_Name_Suff             &
                     "."                                  &
                     Current_Type.Main_Type_Text_Name.all &
                     Test_Unit_Name_Suff);

         Free (Unit_Pref);

         Test_File_Name := new String'(Unit_To_File_Name (Unit_Name.all));

         ----------------------------------
         --  Creating test package spec  --
         ----------------------------------

         Create
           (Output_Dir & Directory_Separator & Test_File_Name.all & ".ads");

         Put_Harness_Header;
         S_Put (0, GT_Marker_Begin);
         Put_New_Line;

         S_Put (0, "with GNATtest_Generated;");
         Put_New_Line;
         if Stub_Mode_ON then
            S_Put (0, "with AUnit.Test_Caller;");
            Put_New_Line;
         end if;
         Put_New_Line;

         if Current_Pack.Is_Generic then
            S_Put (0, "generic");
            Put_New_Line;

            declare
               GP : Generic_Package;
            begin
               GP.Name := new String'(Current_Pack.Name.all);  --  ???
               GP.Sloc := new String'
                 (Base_Name (Data.Unit_File_Name.all)
                  & ":"
                  & Trim
                    (Integer'Image
                         (First_Line_Number (Current_Pack.Element)),
                     Both)
                  & ":"
                  & Trim
                    (Integer'Image
                         (First_Column_Number (Current_Pack.Element)),
                     Both));
               Update_Generic_Packages (GP);
            end;
         end if;

         S_Put (0, "package " & Unit_Name.all & " is");
         Put_New_Line;
         Put_New_Line;

         if Current_Pack.Data_Kind = Declaration_Data then
            S_Put
              (3,
               "type Test_" &
                 Current_Type.Main_Type_Text_Name.all);
            if Current_Type.Main_Type_Abstract then
               S_Put (0, " is abstract new");
            else
               S_Put (0, " is new");
            end if;
            Put_New_Line;

            if Data.Unit_Full_Name.all = Current_Type.Nesting.all then
               S_Put
                 (5,
                  "GNATtest_Generated.GNATtest_Standard."    &
                    Data.Unit_Full_Name.all                    &
                    "."                                        &
                    Current_Type.Main_Type_Text_Name.all &
                    Test_Data_Unit_Name_Suff                   &
                    ".Test_"                                   &
                    Current_Type.Main_Type_Text_Name.all &
                    " with null record;");
            else
               S_Put
                 (5,
                  "GNATtest_Generated.GNATtest_Standard."    &
                    Data.Unit_Full_Name.all                    &
                    "."                                        &
                    Test_Data_Unit_Name                        &
                    "."                                        &
                    Test_Unit_Name                             &
                    "."                                        &
                    Nesting_Difference
                    (Data.Unit_Full_Name.all,
                     Current_Type.Nesting.all)               &
                    "."                                        &
                    Current_Type.Main_Type_Text_Name.all &
                    Test_Data_Unit_Name_Suff                   &
                    ".Test_"                                   &
                    Current_Type.Main_Type_Text_Name.all &
                    " with null record;");
            end if;

         else
            S_Put
              (3,
               "type Test_"
               & Current_Type.Main_Type_Text_Name.all
               & " is new GNATtest_Generated.GNATtest_Standard."
               & Data_Unit_Name.all & ".New_Test with null record;");

            Update_Generic_Packages
              (Current_Pack.Generic_Containing_Package.all);
         end if;

         Put_New_Line;
         Put_New_Line;

         --  Adding test routine declarations.
         if Current_Pack.Data_Kind = Declaration_Data then
            Subp_Cur := Data.Subp_List.First;
            loop
               exit when Subp_Cur = Subp_Data_List.No_Element;

               if
                 Subp_Data_List.Element (Subp_Cur).Corresp_Type =
                 Current_Type.Type_Number
               then

                  if not Subp_Data_List.Element (Subp_Cur).Is_Abstract then
                     S_Put
                       (3,
                        "procedure "
                        & Subp_Data_List.Element
                          (Subp_Cur).Subp_Mangle_Name.all
                        & " (Gnattest_T : in out Test_"
                        & Current_Type.Main_Type_Text_Name.all
                        & ");");
                     Actual_Test := True;
                  end if;

                  Put_New_Line;
                  Print_Comment_Declaration
                    (Subp_Data_List.Element (Subp_Cur), 3);
                  Put_New_Line;
               end if;

               Subp_Data_List.Next (Subp_Cur);
            end loop;
         end if;

         if Stub_Mode_ON then
            S_Put
              (3,
               "package Caller is new AUnit.Test_Caller (Test_"
               & Current_Type.Main_Type_Text_Name.all
               & ");");
            Put_New_Line;
            Put_New_Line;
         end if;

         S_Put (0, "end " & Unit_Name.all & ";");
         Put_New_Line;
         S_Put (0, GT_Marker_End);
         Put_New_Line;
         Close_File;

         if not Current_Type.Main_Type_Abstract then
            TP_Map.TP_Name := new String'(Test_File_Name.all & ".ads");
            TP_List.Append (TP_Map);
         end if;

         ----------------------------------
         --  Creating test package body  --
         ----------------------------------

         if Actual_Test then

            Reset_Line_Counter;

            if Generate_Separates then
               Create
                 (Output_Dir
                  & Directory_Separator
                  & Test_File_Name.all
                  & ".adb");
               Put_Harness_Header;
            else
               Get_Subprograms_From_Package
                 (Output_Dir
                  & Directory_Separator
                  & Test_File_Name.all
                  & ".adb");
               Create (Tmp_File_Name);
               Put_TP_Header (Test_Data_Package_Name.all);

               --  gathering transition data
               if Transition then
                  Subp_Cur := Data.Subp_List.First;
                  loop
                     exit when Subp_Cur = Subp_Data_List.No_Element;

                     Current_Subp := Subp_Data_List.Element (Subp_Cur);

                     if
                       Current_Subp.Corresp_Type = Current_Type.Type_Number
                       and then not Current_Subp.Is_Abstract
                     then
                        UH.Version := new String'("1");
                        UH.Hash := new String'
                          (Subp_Data_List.Element
                             (Subp_Cur).Subp_Hash_V1.all);
                        if
                          Subp_Data_List.Element (Subp_Cur).Has_TC_Info
                        then
                           UH.TC_Hash := new String'
                             (Subp_Data_List.Element
                                (Subp_Cur).TC_Info.TC_Hash.all);
                        else
                           UH.TC_Hash := new String'("");
                        end if;

                        Current_Subp := Subp_Data_List.Element (Subp_Cur);

                        Get_Subprogram_From_Separate
                          (Output_Dir
                           & Directory_Separator
                           & Unit_To_File_Name
                             (Unit_Name.all
                              & "."
                              & Test_Routine_Prefix
                              & Current_Subp.Subp_Text_Name.all
                              & "_"
                              & Current_Subp.Subp_Hash_V1
                                (Current_Subp.Subp_Hash_V1'First ..
                                   Current_Subp.Subp_Hash_V1'First + 5)
                              & (if Current_Subp.Has_TC_Info
                                then "_" & Current_Subp.TC_Info.TC_Hash
                                  (Current_Subp.TC_Info.TC_Hash'First ..
                                     Current_Subp.TC_Info.TC_Hash'First + 5)
                                else ""))
                           & ".adb",
                           UH,
                           Current_Subp);
                     end if;
                     Subp_Data_List.Next (Subp_Cur);
                  end loop;
               end if;

               --  gathering used short names
               Subp_Cur := Data.Subp_List.First;
               loop
                  exit when Subp_Cur = Subp_Data_List.No_Element;

                  Current_Subp := Subp_Data_List.Element (Subp_Cur);

                  if
                    Current_Subp.Corresp_Type = Current_Type.Type_Number
                    and then not Current_Subp.Is_Abstract
                  then
                     UH.Version := new String'(Hash_Version);
                     UH.Hash := new String'
                       (Current_Subp.Subp_Full_Hash.all);
                     if
                       Current_Subp.Has_TC_Info
                     then
                        UH.TC_Hash := new String'
                          (Sanitize_TC_Name (Current_Subp.TC_Info.Name.all));
                     else
                        UH.TC_Hash := new String'("");
                     end if;

                     MD_Cur := Find (Markered_Data_Map, UH);

                     if MD_Cur /= Markered_Data_Maps.No_Element then
                        MD := Markered_Data_Maps.Element (MD_Cur);
                        if MD.Short_Name_Used then
                           Short_Names_Used.Include
                             (To_Lower (MD.Short_Name.all));
                           Shortnamed_Subps.Include
                             (Current_Subp.Subp_Declaration);

                           Name_Numbers.Include
                             (To_Lower (Current_Subp.Subp_Text_Name.all), 1);
                           Elem_Numbers.Include
                             (Current_Subp.Subp_Declaration, 1);
                        end if;
                     end if;

                  end if;

                  Subp_Data_List.Next (Subp_Cur);
               end loop;

               --  updating hash v.1 to hash v.2 where possible
               Subp_Cur := Data.Subp_List.First;
               loop
                  exit when Subp_Cur = Subp_Data_List.No_Element;

                  Current_Subp := Subp_Data_List.Element (Subp_Cur);

                  if
                    Current_Subp.Corresp_Type = Current_Type.Type_Number
                    and then not Current_Subp.Is_Abstract
                  then
                     UH.Version := new String'("1");
                     UH.Hash := new String'
                       (Current_Subp.Subp_Hash_V1.all);
                     if
                       Current_Subp.Has_TC_Info
                     then
                        UH.TC_Hash := new String'
                          (Current_Subp.TC_Info.TC_Hash.all);
                     else
                        UH.TC_Hash := new String'("");
                     end if;

                     MD_Cur := Find (Markered_Data_Map, UH);

                     if MD_Cur /= Markered_Data_Maps.No_Element then
                        MD := Markered_Data_Maps.Element (MD_Cur);

                        Markered_Data_Map.Delete (MD_Cur);
                        Free (UH.Hash);
                        UH.Hash := new String'
                          (Current_Subp.Subp_Hash_V2_1.all);
                        Free (UH.Version);
                        UH.Version := new String'("2");

                        Markered_Data_Map.Include (UH, MD);
                     end if;

                  end if;

                  Subp_Data_List.Next (Subp_Cur);
               end loop;

               --  updating hash v.2 to hash v.2.1 where possible
               Subp_Cur := Data.Subp_List.First;
               loop
                  exit when Subp_Cur = Subp_Data_List.No_Element;

                  Current_Subp := Subp_Data_List.Element (Subp_Cur);

                  if
                    Current_Subp.Corresp_Type = Current_Type.Type_Number
                    and then not Current_Subp.Is_Abstract
                  then
                     UH.Version := new String'("2");
                     UH.Hash := new String'
                       (Current_Subp.Subp_Hash_V2_1 .all);

                     if Current_Subp.Has_TC_Info then
                        UH.TC_Hash := new String'
                          (Current_Subp.TC_Info.TC_Hash.all);
                     else
                        UH.TC_Hash := new String'("");
                     end if;

                     MD_Cur := Find (Markered_Data_Map, UH);

                     if MD_Cur /= Markered_Data_Maps.No_Element then
                        MD := Markered_Data_Maps.Element (MD_Cur);

                        Markered_Data_Map.Delete (MD_Cur);
                        Free (UH.Version);
                        UH.Version := new String'("2.1");
                        if UH.TC_Hash.all /= "" then
                           Free (UH.TC_Hash);
                           UH.TC_Hash := new String'
                             (Sanitize_TC_Name
                                (Current_Subp.TC_Info.Name.all));
                        end if;

                        Markered_Data_Map.Include (UH, MD);
                     end if;

                  end if;

                  Subp_Data_List.Next (Subp_Cur);
               end loop;

               --  updating hash v.2.1 to hash v.2.2
               --  and looking for new short names
               Subp_Cur := Data.Subp_List.First;
               loop
                  exit when Subp_Cur = Subp_Data_List.No_Element;

                  Current_Subp := Subp_Data_List.Element (Subp_Cur);

                  if
                    Current_Subp.Corresp_Type = Current_Type.Type_Number
                    and then not Current_Subp.Is_Abstract
                  then
                     UH.Version := new String'("2.1");
                     UH.Hash := new String'
                       (Current_Subp.Subp_Hash_V2_1 .all);

                     if Current_Subp.Has_TC_Info then
                        UH.TC_Hash := new String'
                          (Sanitize_TC_Name
                             (Current_Subp.TC_Info.Name.all));
                     else
                        UH.TC_Hash := new String'("");
                     end if;

                     MD_Cur := Find (Markered_Data_Map, UH);

                     if MD_Cur /= Markered_Data_Maps.No_Element then
                        MD := Markered_Data_Maps.Element (MD_Cur);

                        if not
                          Short_Names_Used.Contains (MD.Short_Name.all)
                          or else Shortnamed_Subps.Contains
                            (Current_Subp.Subp_Declaration)
                        then
                           Short_Names_Used.Include (MD.Short_Name.all);
                           Shortnamed_Subps.Include
                             (Current_Subp.Subp_Declaration);

                           Name_Numbers.Include
                             (To_Lower (Current_Subp.Subp_Text_Name.all), 1);
                           Elem_Numbers.Include
                             (Current_Subp.Subp_Declaration, 1);

                           MD.Short_Name_Used := True;
                        end if;

                        Markered_Data_Map.Delete (MD_Cur);
                        Free (UH.Hash);
                        UH.Hash := new String'
                          (Current_Subp.Subp_Full_Hash.all);
                        Free (UH.Version);
                        UH.Version := new String'(Hash_Version);
                        Markered_Data_Map.Include (UH, MD);
                     end if;

                  end if;

                  Subp_Data_List.Next (Subp_Cur);
               end loop;

               --  creating markered_data and deciding on new short names
               Subp_Cur := Data.Subp_List.First;
               loop
                  exit when Subp_Cur = Subp_Data_List.No_Element;

                  Current_Subp := Subp_Data_List.Element (Subp_Cur);

                  if
                    Current_Subp.Corresp_Type = Current_Type.Type_Number
                    and then not Current_Subp.Is_Abstract
                  then
                     UH.Version := new String'(Hash_Version);
                     UH.Hash := new String'
                       (Current_Subp.Subp_Full_Hash.all);
                     if Current_Subp.Has_TC_Info then
                        UH.TC_Hash := new String'
                          (Sanitize_TC_Name (Current_Subp.TC_Info.Name.all));
                     else
                        UH.TC_Hash := new String'("");
                     end if;

                     MD_Cur := Find (Markered_Data_Map, UH);

                     if MD_Cur = Markered_Data_Maps.No_Element then

                        MD.Commented_Out := False;
                        MD.Short_Name_Used := False;
                        MD.Short_Name := new String'
                          (To_Lower (Current_Subp.Subp_Text_Name.all));
                        MD.TR_Text.Clear;

                        if
                          not Short_Names_Used.Contains
                          (To_Lower (Current_Subp.Subp_Text_Name.all))
                          or else Shortnamed_Subps.Contains
                            (Current_Subp.Subp_Declaration)
                        then
                           --  Short name is free, we can use it
                           MD.Short_Name_Used := True;
                           Short_Names_Used.Include
                             (To_Lower (Current_Subp.Subp_Text_Name.all));
                           Shortnamed_Subps.Include
                             (Current_Subp.Subp_Declaration);

                           Name_Numbers.Include
                             (To_Lower (Current_Subp.Subp_Text_Name.all), 1);
                           Elem_Numbers.Include
                             (Current_Subp.Subp_Declaration, 1);

                           --  Looking for a dangling test with same short
                           --  name but different hash.
                           MD_Cur := Find_Same_Short_Name
                             (Markered_Data_Map,
                              Current_Subp);

                           if MD_Cur /= Markered_Data_Maps.No_Element then
                              --  Using corresponding dangling test

                              MD.TR_Text.Clear;
                              MD.TR_Text :=
                                Markered_Data_Maps.Element (MD_Cur).TR_Text;

                              --  also need to copy Commented_Out since
                              --  the test can be dangling for a long time
                              --  or just become dangling
                              MD.Commented_Out :=
                                Markered_Data_Maps.Element
                                  (MD_Cur).Commented_Out;

                              Markered_Data_Map.Delete (MD_Cur);
                              MD.Issue_Warning := True;
                           end if;

                        end if;

                        Markered_Data_Map.Insert (UH, MD);

                     end if;

                  end if;

                  Subp_Data_List.Next (Subp_Cur);
               end loop;

               --  setting overloading numbers;
               Subp_Cur := Data.Subp_List.First;
               loop
                  exit when Subp_Cur = Subp_Data_List.No_Element;

                  Current_Subp := Subp_Data_List.Element (Subp_Cur);

                  if
                    Current_Subp.Corresp_Type = Current_Type.Type_Number
                    and then not Current_Subp.Is_Abstract
                  then

                     if
                       Name_Numbers.Find
                         (To_Lower (Current_Subp.Subp_Text_Name.all)) =
                       Name_Frequency.No_Element
                     then

                        Name_Numbers.Include
                          (To_Lower (Current_Subp.Subp_Text_Name.all), 1);
                        Elem_Numbers.Include
                          (Current_Subp.Subp_Declaration, 1);

                     else
                        if
                          Elem_Numbers.Find
                            (Current_Subp.Subp_Declaration) =
                            Elem_Number_Maps.No_Element
                        then

                           declare
                              X : constant Natural :=
                                Name_Numbers.Element
                                  (To_Lower
                                       (Current_Subp.Subp_Text_Name.all));
                           begin
                              Name_Numbers.Replace
                                (To_Lower (Current_Subp.Subp_Text_Name.all),
                                 X + 1);
                              Elem_Numbers.Include
                                (Current_Subp.Subp_Declaration, X + 1);
                           end;

                        end if;
                     end if;

                  end if;

                  Subp_Data_List.Next (Subp_Cur);
               end loop;
               Name_Numbers.Clear;

            end if;

            S_Put (0, "with AUnit.Assertions; use AUnit.Assertions;");
            New_Line_Count;
            S_Put (0, "with System.Assertions;");
            New_Line_Count;
            if Stub_Mode_ON then
               declare
                  S_Cur : Asis_Element_List.Cursor := Data.Units_To_Stub.First;
                  Tmp : String_Access;
               begin
                  while S_Cur /= Asis_Element_List.No_Element loop
                     Tmp := new String'
                       (To_String
                          (Text_Name
                               (Enclosing_Compilation_Unit
                                    (Asis_Element_List.Element (S_Cur)))));

                     if
                       Source_Stubbed (Tmp.all) and then
                       not Excluded_Test_Data_Files.Contains
                         (Base_Name (Get_Source_Stub_Data_Spec (Tmp.all)))
                     then
                        S_Put
                          (0,
                           "with "
                           & To_String
                             (Defining_Name_Image
                                  (First_Name
                                       (Asis_Element_List.Element (S_Cur))))
                           & "."
                           & Stub_Data_Unit_Name
                           & "; use "
                           & To_String
                             (Defining_Name_Image
                                  (First_Name
                                       (Asis_Element_List.Element (S_Cur))))
                           & "."
                           & Stub_Data_Unit_Name
                           & ";");
                        New_Line_Count;
                     end if;

                     Free (Tmp);

                     Next (S_Cur);
                  end loop;
               end;
            end if;
            New_Line_Count;

            Put_Persistent_Section (With_Clauses);

            S_Put (0, "package body " & Unit_Name.all & " is");
            New_Line_Count;
            New_Line_Count;

            Put_Persistent_Section (Body_Declarations);

            --  Adding test routine body stubs.
            Subp_Cur := Data.Subp_List.First;
            loop
               exit when Subp_Cur = Subp_Data_List.No_Element;

               if
                 Subp_Data_List.Element (Subp_Cur).Corresp_Type =
                 Current_Type.Type_Number
               then
                  if not Subp_Data_List.Element (Subp_Cur).Is_Abstract then

                     Current_Subp := Subp_Data_List.Element (Subp_Cur);

                     if Subp_Data_List.Element (Subp_Cur).Has_TC_Info then

                        case
                          Declaration_Kind
                            (Subp_Data_List.Element
                                 (Subp_Cur).Subp_Declaration)
                        is

                           when A_Function_Declaration             |
                                An_Expression_Function_Declaration =>
                              Generate_Function_Wrapper
                                (Subp_Data_List.Element (Subp_Cur));

                           when A_Procedure_Declaration =>
                              Generate_Procedure_Wrapper
                                (Subp_Data_List.Element (Subp_Cur));

                           when others =>
                              null;

                        end case;

                     end if;

                     if Generate_Separates then
                        S_Put
                          (3,
                           "procedure "                         &
                             Subp_Data_List.Element
                             (Subp_Cur).Subp_Mangle_Name.all    &
                             " (Gnattest_T : in out Test_"        &
                             Current_Type.Main_Type_Text_Name.all &
                             ") is separate;");

                        New_Line_Count;
                        Print_Comment_Declaration
                          (Subp_Data_List.Element (Subp_Cur), 3);
                        New_Line_Count;

                     else

                        Test_Info.Replace
                          (Data.Unit_File_Name.all,
                           Test_Info.Element (Data.Unit_File_Name.all) + 1);

                        All_Tests_Counter := All_Tests_Counter + 1;

                        UH.Version := new String'(Hash_Version);
                        UH.Hash := new String'
                          (Subp_Data_List.Element
                             (Subp_Cur).Subp_Full_Hash.all);
                        if Subp_Data_List.Element (Subp_Cur).Has_TC_Info then
                           UH.TC_Hash := new String'
                             (Sanitize_TC_Name
                                (Subp_Data_List.Element
                                   (Subp_Cur).TC_Info.Name.all));
                        else
                           UH.TC_Hash := new String'("");
                        end if;

                        MD_Cur := Find (Markered_Data_Map, UH);
                        MD := Markered_Data_Maps.Element (MD_Cur);

                        Put_Opening_Comment_Section
                          (Subp_Data_List.Element (Subp_Cur),
                           Elem_Numbers.Element
                             (Current_Subp.Subp_Declaration),
                           Use_Short_Name => MD.Short_Name_Used,
                           Type_Name => Current_Type.Main_Type_Text_Name.all);

                        if Is_Unimplemented_Test (MD.TR_Text) then
                           TR_SLOC_Buffer.Append
                             ((new String'(Test_File_Name.all & ".ads"),
                              new String'(Test_File_Name.all & ".adb"),
                              null,
                              Subp_Data_List.Element (Subp_Cur),
                              New_Line_Counter));
                        else
                           TR_SLOC_Buffer.Append
                             ((new String'(Test_File_Name.all & ".ads"),
                              new String'(Test_File_Name.all & ".adb"),
                              new String'("modified"),
                              Subp_Data_List.Element (Subp_Cur),
                              New_Line_Counter));
                        end if;

                        if MD.TR_Text.Is_Empty then

                           if Stub_Mode_ON then
                              Gather_Direct_Callees
                                (Current_Subp.Subp_Declaration,
                                 Setters_Set);
                           end if;

                           New_Tests_Counter := New_Tests_Counter + 1;
                           New_Line_Count;
                           S_Put (6, "pragma Unreferenced (Gnattest_T);");
                           New_Line_Count;
                           New_Line_Count;
                           S_Put (3, "begin");
                           New_Line_Count;
                           New_Line_Count;
                           if not Setters_Set.Is_Empty then
                              Set_Cur := Setters_Set.First;
                              while Set_Cur /= String_Set.No_Element loop
                                 S_Put
                                   (3,
                                    "--  "
                                    & String_Set.Element (Set_Cur)
                                    & "( );");
                                 New_Line_Count;
                                 Next (Set_Cur);
                              end loop;
                              New_Line_Count;
                              Setters_Set.Clear;
                           end if;
                           S_Put (6, "AUnit.Assertions.Assert");
                           New_Line_Count;
                           S_Put
                             (8, "(Gnattest_Generated.Default_Assert_Value,");
                           New_Line_Count;
                           S_Put (9,  """Test not implemented."");");
                           New_Line_Count;
                           New_Line_Count;
                        else

                           if MD.Issue_Warning then
                              Report_Std
                                (Base_Name (Data.Unit_File_Name.all)
                                 & ":"
                                 & Trim
                                   (Integer'Image (First_Line_Number
                                    (Current_Subp.Subp_Declaration)),
                                    Both)
                                 & ":"
                                 & Trim
                                   (Integer'Image (First_Column_Number
                                    (Current_Subp.Subp_Declaration)),
                                    Both)
                                 & ": warning: test for "
                                 & MD.Short_Name.all
                                 & " at "
                                 & Unit_Name.all
                                 & ":"
                                 & Trim
                                   (Integer'Image (New_Line_Counter),
                                    Both)
                                 & " might be out of date ("
                                 & MD.Short_Name.all
                                 & " has been changed)");
                           end if;

                           for I in
                             MD.TR_Text.First_Index .. MD.TR_Text.Last_Index
                           loop
                              if MD.Commented_Out then
                                 S_Put
                                   (0,
                                    Uncomment_Line (MD.TR_Text.Element (I)));
                              else
                                 S_Put (0, MD.TR_Text.Element (I));
                              end if;
                              New_Line_Count;
                           end loop;
                        end if;

                        Markered_Data_Map.Delete (MD_Cur);

                        Put_Closing_Comment_Section
                          (Subp_Data_List.Element (Subp_Cur),
                           Elem_Numbers.Element
                             (Current_Subp.Subp_Declaration),
                           Use_Short_Name => MD.Short_Name_Used);
                        New_Line_Count;

                     end if;

                  end if;
               end if;

               Subp_Data_List.Next (Subp_Cur);
            end loop;

            --  printing dangling tests

            if not Markered_Data_Map_Is_Empty then
               Report_Std
                 (" warning: "
                  & Unit_Name.all
                  & " has dangling test(s)");
            end if;

            MD_Cur := Markered_Data_Map.First;
            loop
               exit when MD_Cur = Markered_Data_Maps.No_Element;

               MD := Markered_Data_Maps.Element (MD_Cur);

               if Markered_Data_Maps.Key (MD_Cur).Hash.all /= "02" then
                  declare
                     Stub : Subp_Info;
                  begin

                     Stub.Subp_Full_Hash := new String'
                       (Markered_Data_Maps.Key (MD_Cur).Hash.all);

                     Stub.Subp_Text_Name := new String'
                       (Markered_Data_Maps.Element (MD_Cur).Short_Name.all);

                     Stub.Subp_Mangle_Name := new String'
                       (Test_Routine_Prefix
                        & Stub.Subp_Text_Name.all
                        & "_"
                        & Stub.Subp_Full_Hash
                          (Stub.Subp_Full_Hash'First ..
                               Stub.Subp_Full_Hash'First + 5));

                     if Markered_Data_Maps.Key (MD_Cur).TC_Hash.all = "" then
                        Stub.Has_TC_Info := False;
                     else
                        Stub.Has_TC_Info := True;
                        Stub.TC_Info.TC_Hash := new String'
                          (Markered_Data_Maps.Key (MD_Cur).TC_Hash.all);
                        Stub.TC_Info.Name := Stub.TC_Info.TC_Hash;
                     end if;

                     Put_Opening_Comment_Section
                       (Stub, 0, True, False,
                        Current_Type.Main_Type_Text_Name.all);

                     Add_DT
                       (TP_List,
                        Test_File_Name.all & ".ads",
                        Test_File_Name.all & ".adb",
                        New_Line_Counter,
                        1);

                     for I in
                       MD.TR_Text.First_Index .. MD.TR_Text.Last_Index
                     loop
                        if MD.Commented_Out then
                           S_Put (0, MD.TR_Text.Element (I));
                        else
                           S_Put (0, "--  " & MD.TR_Text.Element (I));
                        end if;
                        New_Line_Count;
                     end loop;

                     Put_Closing_Comment_Section
                       (Stub,
                        Elem_Numbers.Element
                          (Current_Subp.Subp_Declaration),
                        True,
                        False);
                     New_Line_Count;
                  end;
               end if;

               Markered_Data_Maps.Next (MD_Cur);
            end loop;

            Put_Persistent_Section (Body_Statements);

            S_Put (0, "end " & Unit_Name.all & ";");
            New_Line_Count;

            Close_File;

            Add_Buffered_TR_Slocs
              (TP_List,
               Format_Time
                 (File_Time_Stamp
                    (Tmp_File_Name)));

            if not Generate_Separates then
               declare
                  Old_Package : constant String :=
                    Output_Dir & Directory_Separator
                    & Test_File_Name.all & ".adb";
                  Success : Boolean;
               begin
                  if Is_Regular_File (Old_Package) then
                     Delete_File (Old_Package, Success);
                     if not Success then
                        Report_Err ("cannot delete " & Old_Package);
                        raise Fatal_Error;
                     end if;
                  end if;
                  Copy_File (Tmp_File_Name, Old_Package, Success);
                  if not Success then
                     Report_Err ("cannot copy tmp test package to "
                                 & Old_Package);
                     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;
               end;
            end if;

            Markered_Data_Map.Clear;
         end if;

         Short_Names_Used.Clear;
         Shortnamed_Subps.Clear;
         Elem_Numbers.Clear;

      end loop;

      --  Simple case

      if Data.Has_Simple_Case then

         Pack_Cur := Data.Package_Data_List.First;
         loop
            exit when Pack_Cur = Package_Info_List.No_Element;

            Current_Pack := Package_Info_List.Element (Pack_Cur);

            Subp_Cur := Data.Subp_List.First;
            loop
               exit when Subp_Cur = Subp_Data_List.No_Element;

               Current_Subp := Subp_Data_List.Element (Subp_Cur);
               if Current_Subp.Nesting.all = Current_Pack.Name.all then
                  Subp_List.Append (Current_Subp);
               end if;

               Subp_Data_List.Next (Subp_Cur);
            end loop;

            if Current_Pack.Name.all = Data.Unit_Full_Name.all then
               Data_Unit_Name := new String'
                 (Current_Pack.Name.all & "." &  Test_Data_Unit_Name);
            else
               Data_Unit_Name := new String'
                 (Data.Unit_Full_Name.all & "." &
                  Test_Data_Unit_Name & "." &
                  Test_Unit_Name & "." &
                  Nesting_Difference
                    (Current_Pack.Name.all,
                     Data.Unit_Full_Name.all) &
                  "." &  Test_Data_Unit_Name);
            end if;

            Test_File_Name := new String'
              (Unit_To_File_Name (Data_Unit_Name.all));

            --  saving test data package name for further reference
            Test_Data_Package_Name := new String'(Data_Unit_Name.all);

            --  Generating simple test data package spec
            if not Is_Regular_File
              (Output_Dir & Directory_Separator & Test_File_Name.all & ".ads")
            then
               Create
                 (Output_Dir & Directory_Separator &
                  Test_File_Name.all & ".ads");

               Put_Test_Data_Header;

               if Current_Pack.Data_Kind = Instantiation then
                  S_Put
                    (0,
                     "with "
                     & Current_Pack.Generic_Containing_Package.all
                     & "."
                     & Test_Data_Unit_Name
                     & ";");
                  Put_New_Line;
                  S_Put
                    (0,
                     "with "
                     & Current_Pack.Generic_Containing_Package.all
                     & "."
                     & Test_Data_Unit_Name
                     & "."
                     & Test_Unit_Name
                     & ";");
               else
                  S_Put (0, "with AUnit.Test_Fixtures;");
               end if;
               Put_New_Line;
               Put_New_Line;
               if Current_Pack.Is_Generic then
                  S_Put (0, "generic");
                  Put_New_Line;
                  S_Put
                    (3,
                     "type GNATtest_Test_Type is new "
                     & "AUnit.Test_Fixtures.Test_Fixture");
                  Put_New_Line;
                  S_Put (5, "with private;");
                  Put_New_Line;
               end if;
               S_Put (0, "package " & Data_Unit_Name.all & " is");
               Put_New_Line;
               Put_New_Line;
               S_Put (0, GT_Marker_Begin);
               Put_New_Line;
               S_Put
                 (3,
                  "type Test is new AUnit.Test_Fixtures.Test_Fixture");
               Put_New_Line;
               S_Put (0, GT_Marker_End);
               Put_New_Line;
               S_Put (3, "with null record;");
               Put_New_Line;
               Put_New_Line;
               S_Put (3, "procedure Set_Up (Gnattest_T : in out Test);");
               Put_New_Line;
               S_Put (3, "procedure Tear_Down (Gnattest_T : in out Test);");
               Put_New_Line;
               Put_New_Line;

               if Current_Pack.Data_Kind = Instantiation then
                  S_Put (0, GT_Marker_Begin);
                  Put_New_Line;
                  S_Put
                    (3,
                     "package Gnattest_Data_Inst is new "
                     & "GNATtest_Generated.GNATtest_Standard."
                     & Current_Pack.Name.all
                     & "."
                     & Test_Data_Unit_Name
                     & " (Test);");
                  Put_New_Line;
                  S_Put
                    (3,
                     "package Gnattest_Tests_Inst is new Gnattest_Data_Inst."
                     & Test_Unit_Name
                     & ";");
                  Put_New_Line;
                  Put_New_Line;
                  S_Put
                    (3,
                     "type New_Test is new Gnattest_Tests_Inst.Test"
                     & " with null record;");
                  Put_New_Line;
                  S_Put (0, GT_Marker_End);
                  Put_New_Line;
                  Put_New_Line;
                  S_Put
                    (3,
                    "procedure User_Set_Up (Gnattest_T : in out New_Test);");
                  Put_New_Line;
                  S_Put
                    (3,
                     "procedure User_Tear_Down "
                     & "(Gnattest_T : in out New_Test);");
                  Put_New_Line;
                  Put_New_Line;
               end if;

               if Current_Pack.Is_Generic then
                  S_Put
                    (3,
                    "procedure User_Set_Up (Gnattest_T : in out Test);");
                  Put_New_Line;
                  S_Put
                    (3,
                    "procedure User_Tear_Down (Gnattest_T : in out Test);");
                  Put_New_Line;
                  Put_New_Line;
               end if;

               S_Put (0, "end " & Data_Unit_Name.all & ";");
               Put_New_Line;

               Close_File;
            end if;

            if not Is_Regular_File
              (Output_Dir & Directory_Separator & Test_File_Name.all & ".adb")
            then
               Create
                 (Output_Dir & Directory_Separator &
                  Test_File_Name.all & ".adb");

               Put_Test_Data_Header;

               S_Put (0, "package body " & Data_Unit_Name.all & " is");
               Put_New_Line;
               Put_New_Line;
               if Current_Pack.Data_Kind = Declaration_Data then
                  S_Put (3, "procedure Set_Up (Gnattest_T : in out Test) is");
                  Put_New_Line;
                  if Current_Pack.Is_Generic then
                     S_Put
                       (6, "X : Test'Class renames Test'Class (Gnattest_T);");
                     Put_New_Line;
                     S_Put (3, "begin");
                     Put_New_Line;
                     S_Put (6, "User_Set_Up (X);");
                  else
                     S_Put (6, "pragma Unreferenced (Gnattest_T);");
                     Put_New_Line;
                     S_Put (3, "begin");
                     Put_New_Line;
                     S_Put (6, "null;");
                  end if;
                  Put_New_Line;
                  S_Put (3, "end Set_Up;");
                  Put_New_Line;
                  Put_New_Line;
                  S_Put
                    (3, "procedure Tear_Down (Gnattest_T : in out Test) is");
                  Put_New_Line;
                  if Current_Pack.Is_Generic then
                     S_Put
                       (6, "X : Test'Class renames Test'Class (Gnattest_T);");
                     Put_New_Line;
                     S_Put (3, "begin");
                     Put_New_Line;
                     S_Put (6, "User_Tear_Down (X);");
                  else
                     S_Put (6, "pragma Unreferenced (Gnattest_T);");
                     Put_New_Line;
                     S_Put (3, "begin");
                     Put_New_Line;
                     S_Put (6, "null;");
                  end if;
                  Put_New_Line;
                  S_Put (3, "end Tear_Down;");
               else
                  S_Put
                    (3,
                     "procedure Set_Up "
                     & "(Gnattest_T : in out Test) is");
                  Put_New_Line;
                  S_Put (6, "pragma Unreferenced (Gnattest_T);");
                  Put_New_Line;
                  S_Put (3, "begin");
                  Put_New_Line;
                  S_Put (6, "null;");
                  Put_New_Line;
                  S_Put (3, "end Set_Up;");
                  Put_New_Line;
                  Put_New_Line;
                  S_Put
                    (3,
                     "procedure Tear_Down "
                     & "(Gnattest_T : in out Test) is");
                  Put_New_Line;
                  S_Put (6, "pragma Unreferenced (Gnattest_T);");
                  Put_New_Line;
                  S_Put (3, "begin");
                  Put_New_Line;
                  S_Put (6, "null;");
                  Put_New_Line;
                  S_Put (3, "end Tear_Down;");
                  Put_New_Line;
                  Put_New_Line;
                  S_Put
                    (3,
                     "procedure User_Set_Up "
                     & "(Gnattest_T : in out New_Test) is");
                  Put_New_Line;
                  S_Put (6, "pragma Unreferenced (Gnattest_T);");
                  Put_New_Line;
                  S_Put (3, "begin");
                  Put_New_Line;
                  S_Put (6, "null;");
                  Put_New_Line;
                  S_Put (3, "end User_Set_Up;");
                  Put_New_Line;
                  Put_New_Line;
                  S_Put
                    (3,
                     "procedure User_Tear_Down "
                     & "(Gnattest_T : in out New_Test) is");
                  Put_New_Line;
                  S_Put (6, "pragma Unreferenced (Gnattest_T);");
                  Put_New_Line;
                  S_Put (3, "begin");
                  Put_New_Line;
                  S_Put (6, "null;");
                  Put_New_Line;
                  S_Put (3, "end User_Tear_Down;");

                  Put_New_Line;
                  Put_New_Line;
               end if;

               if Current_Pack.Is_Generic then
                  S_Put
                    (3,
                     "procedure User_Set_Up "
                     & "(Gnattest_T : in out Test) is");
                  Put_New_Line;
                  S_Put (3, "begin");
                  Put_New_Line;
                  S_Put (6, "null;");
                  Put_New_Line;
                  S_Put (3, "end User_Set_Up;");
                  Put_New_Line;
                  Put_New_Line;
                  S_Put
                    (3,
                     "procedure User_Tear_Down "
                     & "(Gnattest_T : in out Test) is");
                  Put_New_Line;
                  S_Put (3, "begin");
                  Put_New_Line;
                  S_Put (6, "null;");
                  Put_New_Line;
                  S_Put (3, "end User_Tear_Down;");
                  Put_New_Line;
                  Put_New_Line;
               end if;

               S_Put (0, "end " & Data_Unit_Name.all & ";");
               Put_New_Line;

               Close_File;
            end if;

            TP_Map.SetUp_Name      := new String'(Test_File_Name.all & ".adb");
            TP_Map.TearDown_Name   := new String'(Test_File_Name.all & ".adb");
            TP_Map.SetUp_Line      := 8;
            TP_Map.SetUp_Column    := 4;
            TP_Map.TearDown_Line   := 14;
            TP_Map.TearDown_Column := 4;

            Free (Test_File_Name);

            if Current_Pack.Name.all = Data.Unit_Full_Name.all then
               Unit_Name := new String'
                 (Current_Pack.Name.all & "." &
                  Test_Data_Unit_Name & "." &
                  Test_Unit_Name);
            else
               Unit_Name := new String'
                 (Data.Unit_Full_Name.all & "." &
                  Test_Data_Unit_Name & "." &
                  Test_Unit_Name & "." &
                  Nesting_Difference
                    (Current_Pack.Name.all,
                     Data.Unit_Full_Name.all) &
                  "." & Test_Data_Unit_Name & "." & Test_Unit_Name);
            end if;

            Test_File_Name := new String'(Unit_To_File_Name (Unit_Name.all));

            Actual_Test := False;

            --  Generating simple test package spec.
            Create
              (Output_Dir & Directory_Separator & Test_File_Name.all & ".ads");

            Put_Harness_Header;
            S_Put (0, GT_Marker_Begin);
            Put_New_Line;

            S_Put (0, "with Gnattest_Generated;");
            Put_New_Line;
            if Stub_Mode_ON then
               S_Put (0, "with AUnit.Test_Caller;");
               Put_New_Line;
            end if;
            Put_New_Line;
            if Current_Pack.Is_Generic then
               S_Put (0, "generic");
               Put_New_Line;

               declare
                  GP : Generic_Package;
               begin
                  GP.Name := new String'(Current_Pack.Name.all);  --  ???
                  GP.Sloc := new String'
                    (Base_Name (Data.Unit_File_Name.all)
                     & ":"
                     & Trim
                       (Integer'Image
                            (First_Line_Number (Current_Pack.Element)),
                        Both)
                     & ":"
                     & Trim
                       (Integer'Image
                            (First_Column_Number (Current_Pack.Element)),
                        Both));
                  Update_Generic_Packages (GP);
               end;
            end if;

            S_Put (0, "package " & Unit_Name.all & " is");
            Put_New_Line;
            Put_New_Line;

            --  Declaring simple test type.
            if Current_Pack.Data_Kind = Declaration_Data then
               S_Put
                 (3,
                  "type Test is new GNATtest_Generated.GNATtest_Standard." &
                    Data_Unit_Name.all & ".Test");

            else
               S_Put
                 (3,
                  "type Test is new GNATtest_Generated.GNATtest_Standard." &
                    Data_Unit_Name.all & ".New_Test");

               Update_Generic_Packages
                 (Current_Pack.Generic_Containing_Package.all);
            end if;
            Put_New_Line;
            S_Put (3, "with null record;");
            Put_New_Line;
            Put_New_Line;

            --  Adding test routine declarations.

            if Current_Pack.Data_Kind = Declaration_Data then
               Subp_Cur := Subp_List.First;
               loop
                  exit when Subp_Cur = Subp_Data_List.No_Element;

                  if Subp_Data_List.Element (Subp_Cur).Corresp_Type = 0 then

                     S_Put
                       (3,
                        "procedure "
                        & Subp_Data_List.Element
                          (Subp_Cur).Subp_Mangle_Name.all
                        & " (Gnattest_T : in out Test);");

                     Put_New_Line;
                     Print_Comment_Declaration
                       (Subp_Data_List.Element (Subp_Cur),
                        3);
                     Put_New_Line;

                     Actual_Test := True;
                  end if;

                  Subp_Data_List.Next (Subp_Cur);
               end loop;
            end if;

            if Stub_Mode_ON then
               S_Put (3, "package Caller is new AUnit.Test_Caller (Test);");
               Put_New_Line;
               Put_New_Line;
            end if;

            S_Put (0, "end " & Unit_Name.all & ";");

            Put_New_Line;
            S_Put (0, GT_Marker_End);
            Put_New_Line;

            Close_File;

            TP_Map.TP_Name := new String'(Test_File_Name.all & ".ads");
            TP_List.Append (TP_Map);

            Reset_Line_Counter;

            --  Generating simple test package body
            if Actual_Test then

               if Generate_Separates then
                  Create
                    (Output_Dir
                     & Directory_Separator
                     & Test_File_Name.all
                     & ".adb");
                  Put_Harness_Header;
               else
                  Get_Subprograms_From_Package
                    (Output_Dir
                     & Directory_Separator
                     & Test_File_Name.all
                     & ".adb");

                  --  updating hash v2 to v2.1 and change TC hash to TC names
                  Subp_Cur := Subp_List.First;
                  loop
                     exit when Subp_Cur = Subp_Data_List.No_Element;

                     if Subp_Data_List.Element (Subp_Cur).Corresp_Type = 0 then
                        UH.Version := new String'("2");
                        UH.Hash := new String'
                          (Subp_Data_List.Element
                             (Subp_Cur).Subp_Full_Hash.all);
                        if
                          Subp_Data_List.Element (Subp_Cur).Has_TC_Info
                        then
                           UH.TC_Hash := new String'
                             (Subp_Data_List.Element
                                (Subp_Cur).TC_Info.TC_Hash.all);
                        else
                           UH.TC_Hash := new String'("");
                        end if;

                        MD_Cur := Find (Markered_Data_Map, UH);

                        if MD_Cur /= Markered_Data_Maps.No_Element then
                           MD := Markered_Data_Maps.Element (MD_Cur);

                           Free (UH.Version);
                           UH.Version := new String'(Hash_Version);
                           if UH.TC_Hash.all /= "" then
                              Free (UH.TC_Hash);
                              UH.TC_Hash := new String'
                                (Sanitize_TC_Name
                                   (Subp_Data_List.Element
                                      (Subp_Cur).TC_Info.Name.all));
                           end if;
                        end if;

                     end if;

                     Subp_Data_List.Next (Subp_Cur);
                  end loop;

                  --  gathering transition data
                  if Transition then
                     Subp_Cur := Subp_List.First;
                     loop
                        exit when Subp_Cur = Subp_Data_List.No_Element;

                        if
                          Subp_Data_List.Element (Subp_Cur).Corresp_Type = 0
                        then
                           UH.Version := new String'("1");
                           UH.Hash := new String'
                             (Subp_Data_List.Element
                                (Subp_Cur).Subp_Hash_V1.all);
                           if
                             Subp_Data_List.Element (Subp_Cur).Has_TC_Info
                           then
                              UH.TC_Hash := new String'
                                (Subp_Data_List.Element
                                   (Subp_Cur).TC_Info.TC_Hash.all);
                           else
                              UH.TC_Hash := new String'("");
                           end if;

                           Current_Subp := Subp_Data_List.Element (Subp_Cur);

                           Get_Subprogram_From_Separate
                             (Output_Dir
                              & Directory_Separator
                              & Unit_To_File_Name
                                (Unit_Name.all
                                 & "."
                                 & Test_Routine_Prefix
                                 & Current_Subp.Subp_Text_Name.all
                                 & "_"
                                 & Current_Subp.Subp_Hash_V1
                                   (Current_Subp.Subp_Hash_V1'First ..
                                      Current_Subp.Subp_Hash_V1'First + 5)
                                 & (if Current_Subp.Has_TC_Info
                                   then "_" & Current_Subp.TC_Info.TC_Hash
                                     (Current_Subp.TC_Info.TC_Hash'First ..
                                        Current_Subp.TC_Info.TC_Hash'First + 5)
                                   else ""))
                              & ".adb",
                              UH,
                              Current_Subp);
                        end if;
                        Subp_Data_List.Next (Subp_Cur);
                     end loop;
                  end if;

                  --  gathering used short names
                  Subp_Cur := Subp_List.First;
                  loop
                     exit when Subp_Cur = Subp_Data_List.No_Element;

                     Current_Subp := Subp_Data_List.Element (Subp_Cur);

                     if Subp_Data_List.Element (Subp_Cur).Corresp_Type = 0 then
                        UH.Version := new String'(Hash_Version);
                        UH.Hash := new String'
                          (Subp_Data_List.Element
                             (Subp_Cur).Subp_Full_Hash.all);
                        if
                          Subp_Data_List.Element (Subp_Cur).Has_TC_Info
                        then
                           UH.TC_Hash := new String'
                             (Sanitize_TC_Name
                                (Subp_Data_List.Element
                                   (Subp_Cur).TC_Info.Name.all));
                        else
                           UH.TC_Hash := new String'("");
                        end if;

                        MD_Cur := Find (Markered_Data_Map, UH);

                        if MD_Cur /= Markered_Data_Maps.No_Element then
                           MD := Markered_Data_Maps.Element (MD_Cur);
                           if MD.Short_Name_Used then
                              Short_Names_Used.Include
                                (To_Lower (MD.Short_Name.all));
                              Shortnamed_Subps.Include
                                (Current_Subp.Subp_Declaration);

                              Name_Numbers.Include
                                (To_Lower (Current_Subp.Subp_Text_Name.all),
                                 1);
                              Elem_Numbers.Include
                                (Current_Subp.Subp_Declaration, 1);
                           end if;
                        end if;

                     end if;

                     Subp_Data_List.Next (Subp_Cur);
                  end loop;

                  --  updating short names from markered data with hash v.1
                  --  to hash v.2.1 where possible
                  Subp_Cur := Subp_List.First;
                  loop
                     exit when Subp_Cur = Subp_Data_List.No_Element;

                     Current_Subp := Subp_Data_List.Element (Subp_Cur);

                     if Subp_Data_List.Element (Subp_Cur).Corresp_Type = 0 then
                        UH.Version := new String'("1");
                        UH.Hash := new String'(Current_Subp.Subp_Hash_V1.all);

                        if
                          Current_Subp.Has_TC_Info
                        then
                           UH.TC_Hash := new String'
                             (Current_Subp.TC_Info.TC_Hash.all);
                        else
                           UH.TC_Hash := new String'("");
                        end if;

                        MD_Cur := Find (Markered_Data_Map, UH);

                        if MD_Cur /= Markered_Data_Maps.No_Element then
                           MD := Markered_Data_Maps.Element (MD_Cur);

                           Markered_Data_Map.Delete (MD_Cur);
                           Free (UH.Hash);
                           UH.Hash := new String'
                             (Current_Subp.Subp_Hash_V2_1.all);
                           Free (UH.Version);
                           UH.Version := new String'(Hash_Version);
                           if UH.TC_Hash.all /= "" then
                              Free (UH.TC_Hash);
                              UH.TC_Hash := new String'
                                (Sanitize_TC_Name
                                   (Current_Subp.TC_Info.Name.all));
                           end if;
                           Markered_Data_Map.Include (UH, MD);
                        end if;

                     end if;

                     Subp_Data_List.Next (Subp_Cur);
                  end loop;

                  --  updating short names from markered data with hash v.2.1
                  --  to hash v.2.2 where possible and gnathering short names
                  Subp_Cur := Subp_List.First;
                  loop
                     exit when Subp_Cur = Subp_Data_List.No_Element;

                     Current_Subp := Subp_Data_List.Element (Subp_Cur);

                     if Subp_Data_List.Element (Subp_Cur).Corresp_Type = 0 then
                        UH.Version := new String'("2.1");
                        UH.Hash := new String'
                          (Current_Subp.Subp_Hash_V2_1.all);

                        if
                          Current_Subp.Has_TC_Info
                        then
                           UH.TC_Hash := new String'
                             (Sanitize_TC_Name
                                (Current_Subp.TC_Info.Name.all));
                        else
                           UH.TC_Hash := new String'("");
                        end if;

                        MD_Cur := Find (Markered_Data_Map, UH);

                        if MD_Cur /= Markered_Data_Maps.No_Element then
                           MD := Markered_Data_Maps.Element (MD_Cur);

                           if not
                             Short_Names_Used.Contains (MD.Short_Name.all)
                             or else Shortnamed_Subps.Contains
                               (Current_Subp.Subp_Declaration)
                           then
                              Short_Names_Used.Include (MD.Short_Name.all);
                              Shortnamed_Subps.Include
                                (Current_Subp.Subp_Declaration);

                              Name_Numbers.Include
                                (To_Lower (Current_Subp.Subp_Text_Name.all),
                                 1);
                              Elem_Numbers.Include
                                (Current_Subp.Subp_Declaration, 1);

                              MD.Short_Name_Used := True;
                           end if;

                           Markered_Data_Map.Delete (MD_Cur);
                           Free (UH.Hash);
                           UH.Hash := new String'
                             (Current_Subp.Subp_Full_Hash.all);
                           Free (UH.Version);
                           UH.Version := new String'(Hash_Version);

                           Markered_Data_Map.Include (UH, MD);
                        end if;

                     end if;

                     Subp_Data_List.Next (Subp_Cur);
                  end loop;

                  --  creating markered_data and deciding on new short names
                  Subp_Cur := Subp_List.First;
                  loop
                     exit when Subp_Cur = Subp_Data_List.No_Element;

                     Current_Subp := Subp_Data_List.Element (Subp_Cur);

                     if Subp_Data_List.Element (Subp_Cur).Corresp_Type = 0 then
                        UH.Version := new String'(Hash_Version);
                        UH.Hash := new String'
                          (Current_Subp.Subp_Full_Hash.all);
                        if
                          Subp_Data_List.Element (Subp_Cur).Has_TC_Info
                        then
                           UH.TC_Hash := new String'
                             (Sanitize_TC_Name
                                (Current_Subp.TC_Info.Name.all));
                        else
                           UH.TC_Hash := new String'("");
                        end if;

                        MD_Cur := Find (Markered_Data_Map, UH);

                        if MD_Cur = Markered_Data_Maps.No_Element then

                           MD.Commented_Out := False;
                           MD.Short_Name_Used := False;
                           MD.Short_Name := new String'
                             (To_Lower (Current_Subp.Subp_Text_Name.all));
                           MD.TR_Text.Clear;

                           if
                             not Short_Names_Used.Contains
                               (To_Lower (Current_Subp.Subp_Text_Name.all))
                             or else Shortnamed_Subps.Contains
                               (Current_Subp.Subp_Declaration)
                           then
                              --  Short name is free, we can use it
                              MD.Short_Name_Used := True;
                              Short_Names_Used.Include
                                (To_Lower (Current_Subp.Subp_Text_Name.all));
                              Shortnamed_Subps.Include
                                (Current_Subp.Subp_Declaration);

                              Name_Numbers.Include
                                (To_Lower (Current_Subp.Subp_Text_Name.all),
                                 1);
                              Elem_Numbers.Include
                                (Current_Subp.Subp_Declaration, 1);

                              --  Looking for a dangling test with same short
                              --  name but different hash.
                              MD_Cur := Find_Same_Short_Name
                                (Markered_Data_Map,
                                 Current_Subp);

                              if MD_Cur /= Markered_Data_Maps.No_Element then
                                 --  Using corresponding dangling test

                                 MD.TR_Text.Clear;
                                 MD.TR_Text :=
                                   Markered_Data_Maps.Element (MD_Cur).TR_Text;

                                 --  also need to copy Commented_Out since
                                 --  the test can be dangling for a long time
                                 --  or just become dangling
                                 MD.Commented_Out :=
                                   Markered_Data_Maps.Element
                                     (MD_Cur).Commented_Out;

                                 Markered_Data_Map.Delete (MD_Cur);
                                 MD.Issue_Warning := True;
                              end if;

                           end if;

                           Markered_Data_Map.Insert (UH, MD);

                        end if;

                     end if;

                     Subp_Data_List.Next (Subp_Cur);
                  end loop;

                  --  setting overloading numbers;
                  Subp_Cur := Subp_List.First;
                  loop
                     exit when Subp_Cur = Subp_Data_List.No_Element;

                     Current_Subp := Subp_Data_List.Element (Subp_Cur);

                     if Subp_Data_List.Element (Subp_Cur).Corresp_Type = 0 then

                        if
                          Name_Numbers.Find
                            (To_Lower (Current_Subp.Subp_Text_Name.all)) =
                            Name_Frequency.No_Element
                        then

                           Name_Numbers.Include
                             (To_Lower (Current_Subp.Subp_Text_Name.all), 1);
                           Elem_Numbers.Include
                             (Current_Subp.Subp_Declaration, 1);

                        else
                           if
                             Elem_Numbers.Find
                               (Current_Subp.Subp_Declaration) =
                               Elem_Number_Maps.No_Element
                           then
                              declare
                                 X : constant Natural :=
                                   Name_Numbers.Element
                                     (To_Lower
                                          (Current_Subp.Subp_Text_Name.all));
                              begin
                                 Name_Numbers.Replace
                                   (To_Lower (Current_Subp.Subp_Text_Name.all),
                                    X + 1);
                                 Elem_Numbers.Include
                                   (Current_Subp.Subp_Declaration, X + 1);
                              end;
                           end if;
                        end if;

                     end if;

                     Subp_Data_List.Next (Subp_Cur);
                  end loop;
                  Name_Numbers.Clear;

                  Create (Tmp_File_Name);
                  Put_TP_Header (Test_Data_Package_Name.all);
               end if;

               S_Put (0, "with AUnit.Assertions; use AUnit.Assertions;");
               New_Line_Count;
               S_Put (0, "with System.Assertions;");
               New_Line_Count;
               if Stub_Mode_ON then
                  declare
                     S_Cur : Asis_Element_List.Cursor :=
                       Data.Units_To_Stub.First;
                     Tmp : String_Access;
                  begin
                     while S_Cur /= Asis_Element_List.No_Element loop
                        Tmp := new String'
                             (To_String
                                  (Text_Name
                                       (Enclosing_Compilation_Unit
                                          (Asis_Element_List.Element
                                             (S_Cur)))));

                        if
                          Source_Stubbed (Tmp.all) and then
                          not Excluded_Test_Data_Files.Contains
                            (Base_Name (Get_Source_Stub_Data_Spec (Tmp.all)))
                        then
                           S_Put
                             (0,
                              "with "
                              & To_String
                                (Defining_Name_Image
                                     (First_Name
                                          (Asis_Element_List.Element (S_Cur))))
                              & "."
                              & Stub_Data_Unit_Name
                              & "; use "
                              & To_String
                                (Defining_Name_Image
                                     (First_Name
                                          (Asis_Element_List.Element (S_Cur))))
                              & "."
                              & Stub_Data_Unit_Name
                              & ";");
                           New_Line_Count;
                        end if;

                        Free (Tmp);

                        Next (S_Cur);
                     end loop;
                  end;
               end if;
               New_Line_Count;

               Put_Persistent_Section (With_Clauses);

               S_Put (0, "package body " & Unit_Name.all & " is");
               New_Line_Count;
               New_Line_Count;

               Put_Persistent_Section (Body_Declarations);

               --  Adding test routine body stubs.
               Subp_Cur := Subp_List.First;
               loop
                  exit when Subp_Cur = Subp_Data_List.No_Element;

                  if Subp_Data_List.Element (Subp_Cur).Corresp_Type = 0 then

                     Current_Subp := Subp_Data_List.Element (Subp_Cur);

                     if Subp_Data_List.Element (Subp_Cur).Has_TC_Info then

                        case
                          Declaration_Kind
                            (Subp_Data_List.Element
                                 (Subp_Cur).Subp_Declaration)
                        is

                        when A_Function_Declaration             |
                             An_Expression_Function_Declaration =>
                           Generate_Function_Wrapper
                             (Subp_Data_List.Element (Subp_Cur));

                        when A_Procedure_Declaration =>
                           Generate_Procedure_Wrapper
                             (Subp_Data_List.Element (Subp_Cur));

                        when others =>
                           null;

                        end case;

                     end if;

                     if Generate_Separates then
                        S_Put
                          (3,
                           "procedure "
                           & Subp_Data_List.Element
                             (Subp_Cur).Subp_Mangle_Name.all
                           & " (Gnattest_T : in out Test) is separate;");

                        New_Line_Count;
                        Print_Comment_Declaration
                          (Subp_Data_List.Element (Subp_Cur), 3);
                        New_Line_Count;

                     else

                        Test_Info.Replace
                          (Data.Unit_File_Name.all,
                           Test_Info.Element (Data.Unit_File_Name.all) + 1);

                        All_Tests_Counter := All_Tests_Counter + 1;

                        UH.Version := new String'(Hash_Version);
                        UH.Hash := new String'
                          (Subp_Data_List.Element
                             (Subp_Cur).Subp_Full_Hash.all);
                        if Subp_Data_List.Element (Subp_Cur).Has_TC_Info then
                           UH.TC_Hash := new String'
                             (Sanitize_TC_Name
                                (Subp_Data_List.Element
                                   (Subp_Cur).TC_Info.Name.all));
                        else
                           UH.TC_Hash := new String'("");
                        end if;

                        MD_Cur := Find (Markered_Data_Map, UH);
                        MD := Markered_Data_Maps.Element (MD_Cur);

                        Put_Opening_Comment_Section
                          (Subp_Data_List.Element (Subp_Cur),
                           Elem_Numbers.Element
                             (Current_Subp.Subp_Declaration),
                           Use_Short_Name => MD.Short_Name_Used);

                        if Is_Unimplemented_Test (MD.TR_Text) then
                           TR_SLOC_Buffer.Append
                             ((new String'(Test_File_Name.all & ".ads"),
                              new String'(Test_File_Name.all & ".adb"),
                              null,
                              Subp_Data_List.Element (Subp_Cur),
                              New_Line_Counter));
                        else
                           TR_SLOC_Buffer.Append
                             ((new String'(Test_File_Name.all & ".ads"),
                              new String'(Test_File_Name.all & ".adb"),
                              new String'("modified"),
                              Subp_Data_List.Element (Subp_Cur),
                              New_Line_Counter));
                        end if;

                        if MD.TR_Text.Is_Empty then

                           if Stub_Mode_ON then
                              Gather_Direct_Callees
                                (Current_Subp.Subp_Declaration,
                                 Setters_Set);
                           end if;

                           New_Tests_Counter := New_Tests_Counter + 1;
                           New_Line_Count;
                           S_Put (6, "pragma Unreferenced (Gnattest_T);");
                           New_Line_Count;
                           New_Line_Count;
                           S_Put (3, "begin");
                           New_Line_Count;
                           New_Line_Count;
                           if not Setters_Set.Is_Empty then
                              Set_Cur := Setters_Set.First;
                              while Set_Cur /= String_Set.No_Element loop
                                 S_Put
                                   (3,
                                    "--  "
                                    & String_Set.Element (Set_Cur)
                                    & "( );");
                                 New_Line_Count;
                                 Next (Set_Cur);
                              end loop;
                              New_Line_Count;
                              Setters_Set.Clear;
                           end if;
                           S_Put (6, "AUnit.Assertions.Assert");
                           New_Line_Count;
                           S_Put
                             (8, "(Gnattest_Generated.Default_Assert_Value,");
                           New_Line_Count;
                           S_Put (9,  """Test not implemented."");");
                           New_Line_Count;
                           New_Line_Count;
                        else

                           if MD.Issue_Warning then
                              Report_Std
                                (Base_Name (Data.Unit_File_Name.all)
                                 & ":"
                                 & Trim
                                   (Integer'Image (First_Line_Number
                                    (Current_Subp.Subp_Declaration)),
                                    Both)
                                 & ":"
                                 & Trim
                                   (Integer'Image (First_Column_Number
                                    (Current_Subp.Subp_Declaration)),
                                    Both)
                                 & ": warning: test for "
                                 & MD.Short_Name.all
                                 & " at "
                                 & Unit_Name.all
                                 & ":"
                                 & Trim
                                   (Integer'Image (New_Line_Counter),
                                    Both)
                                 & " might be out of date ("
                                 & MD.Short_Name.all
                                 & " has been changed)");
                           end if;

                           for I in
                             MD.TR_Text.First_Index .. MD.TR_Text.Last_Index
                           loop
                              if MD.Commented_Out then
                                 S_Put
                                   (0,
                                    Uncomment_Line (MD.TR_Text.Element (I)));
                              else
                                 S_Put (0, MD.TR_Text.Element (I));
                              end if;
                              New_Line_Count;
                           end loop;
                        end if;

                        Markered_Data_Map.Delete (MD_Cur);

                        Put_Closing_Comment_Section
                          (Subp_Data_List.Element (Subp_Cur),
                           Elem_Numbers.Element
                             (Current_Subp.Subp_Declaration),
                           Use_Short_Name => MD.Short_Name_Used);
                        New_Line_Count;

                     end if;

                  end if;

                  Subp_Data_List.Next (Subp_Cur);
               end loop;

               --  printing dangling tests

               if not Markered_Data_Map_Is_Empty then
                  Report_Std
                    (" warning: "
                     & Unit_Name.all
                     & " has dangling test(s)");
               end if;

               MD_Cur := Markered_Data_Map.First;
               loop
                  exit when MD_Cur = Markered_Data_Maps.No_Element;

                  MD := Markered_Data_Maps.Element (MD_Cur);

                  if Markered_Data_Maps.Key (MD_Cur).Hash.all /= "02" then
                     declare
                        Stub : Subp_Info;
                     begin

                        Stub.Subp_Full_Hash := new String'
                          (Markered_Data_Maps.Key (MD_Cur).Hash.all);
                        Stub.Subp_Text_Name := new String'
                          (MD.Short_Name.all);

                        if Markered_Data_Maps.Key (MD_Cur).TC_Hash.all = ""
                        then
                           Stub.Has_TC_Info := False;

                           Stub.Subp_Mangle_Name := new String'
                             (Test_Routine_Prefix
                              & Markered_Data_Maps.Element
                                (MD_Cur).Short_Name.all
                              & "_"
                              & Stub.Subp_Full_Hash
                                (Stub.Subp_Full_Hash'First ..
                                     Stub.Subp_Full_Hash'First + 5));

                        else
                           Stub.Has_TC_Info := True;
                           Stub.TC_Info.TC_Hash := new String'
                             (Markered_Data_Maps.Key (MD_Cur).TC_Hash.all);

                           Stub.TC_Info.Name := Stub.TC_Info.TC_Hash;
                           Stub.Subp_Mangle_Name := new String'
                             (Test_Routine_Prefix
                              & Markered_Data_Maps.Element
                                (MD_Cur).Short_Name.all
                              & "_"
                              & Stub.Subp_Full_Hash
                                (Stub.Subp_Full_Hash'First ..
                                     Stub.Subp_Full_Hash'First + 5)
                              & "_"
                              & Stub.TC_Info.TC_Hash.all);
                        end if;

                        Put_Opening_Comment_Section
                          (Stub, 0, True, MD.Short_Name_Used);

                        Add_DT
                          (TP_List,
                           Test_File_Name.all & ".ads",
                           Test_File_Name.all & ".adb",
                           New_Line_Counter,
                           1);

                        for I in
                          MD.TR_Text.First_Index .. MD.TR_Text.Last_Index
                        loop
                           if MD.Commented_Out then
                              S_Put (0, MD.TR_Text.Element (I));
                           else
                              S_Put (0, "--  " & MD.TR_Text.Element (I));
                           end if;
                           New_Line_Count;
                        end loop;

                        Put_Closing_Comment_Section
                          (Stub, 0, True, MD.Short_Name_Used);
                        New_Line_Count;
                     end;
                  end if;

                  Markered_Data_Maps.Next (MD_Cur);
               end loop;

               Put_Persistent_Section (Body_Statements);

               S_Put (0, "end " & Unit_Name.all & ";");
               New_Line_Count;

               Close_File;

               Add_Buffered_TR_Slocs
                 (TP_List,
                  Format_Time
                    (File_Time_Stamp
                       (Tmp_File_Name)));

               if not Generate_Separates then
                  declare
                     Old_Package : constant String :=
                       Output_Dir & Directory_Separator
                       & Test_File_Name.all & ".adb";
                     Success : Boolean;
                  begin
                     if Is_Regular_File (Old_Package) then
                        Delete_File (Old_Package, Success);
                        if not Success then
                           Report_Err ("cannot delete " & Old_Package);
                           raise Fatal_Error;
                        end if;
                     end if;
                     Copy_File (Tmp_File_Name, Old_Package, Success);
                     if not Success then
                        Report_Err ("cannot copy tmp test package to "
                                    & Old_Package);
                        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;
                  end;
               end if;

               Markered_Data_Map.Clear;

            else
               Excluded_Test_Package_Bodies.Include
                 (Test_File_Name.all & ".adb");
            end if;

            Short_Names_Used.Clear;
            Shortnamed_Subps.Clear;
            Elem_Numbers.Clear;
            Subp_List.Clear;
            Package_Info_List.Next (Pack_Cur);
         end loop;

      end if;

      Add_Test_List (Data.Unit_File_Name.all, TP_List);
      TP_List.Clear;

      if Data.Is_Generic then
         Gen_Tests_Storage.Append (Gen_Tests);
      end if;

   end Generate_Test_Package;

   -------------------------------------------
   --  Generate_Test_Package_Instantiation  --
   -------------------------------------------

   procedure Generate_Test_Package_Instantiation (Data : Data_Holder) is
      Output_Dir     : constant String :=
        Get_Source_Output_Dir (Data.Unit_File_Name.all);
      New_Unit_Name  : String_Access;
      Test_File_Name : String_Access;

      Cur_Stor  : Generic_Tests_Storage.Cursor;
      Gen_Tests : Generic_Tests;
      Cur_Test  : List_Of_Strings.Cursor;
   begin

      Cur_Stor := Gen_Tests_Storage.First;
      loop
         exit when Cur_Stor = Generic_Tests_Storage.No_Element;

         Gen_Tests := Generic_Tests_Storage.Element (Cur_Stor);

         if Gen_Tests.Gen_Unit_Full_Name.all = Data.Gen_Unit_Full_Name.all then
            Cur_Test := Gen_Tests.Tested_Type_Names.First;
            loop
               exit when Cur_Test = List_Of_Strings.No_Element;

               New_Unit_Name :=
                 new String'(Data.Unit_Full_Name.all        &
                             "."                            &
                             List_Of_Strings.Element (Cur_Test) &
                             "_"                            &
                             Inst_Test_Unit_Name);
               Test_File_Name :=
                 new String'(Unit_To_File_Name (New_Unit_Name.all));

               Create (Output_Dir & Directory_Separator &
                       Test_File_Name.all & ".ads");

               S_Put
                 (0,
                  "with "                        &
                  Data.Gen_Unit_Full_Name.all    &
                  "."                            &
                  List_Of_Strings.Element (Cur_Test) &
                  Gen_Test_Unit_Name_Suff        &
                  ";");
               Put_New_Line;
               Put_New_Line;
               S_Put (0, "package " & New_Unit_Name.all & " is new");
               Put_New_Line;
               S_Put (2,
                      Data.Unit_Full_Name.all        &
                      "."                            &
                      List_Of_Strings.Element (Cur_Test) &
                      Gen_Test_Unit_Name_Suff
                      & ";");
               Put_New_Line;

               Close_File;

               List_Of_Strings.Next (Cur_Test);
            end loop;

            if Gen_Tests.Has_Simple_Case then

               New_Unit_Name :=
                 new String'(Data.Unit_Full_Name.all        &
                             "."                            &
                             Inst_Test_Unit_Name);
               Test_File_Name :=
                 new String'(Unit_To_File_Name (New_Unit_Name.all));

               Create (Output_Dir & Directory_Separator &
                       Test_File_Name.all & ".ads");

               S_Put
                 (0,
                  "with "                     &
                  Data.Gen_Unit_Full_Name.all &
                  "."                         &
                  Gen_Test_Unit_Name          &
                  ";");
               Put_New_Line;
               Put_New_Line;
               S_Put (0, "package " & New_Unit_Name.all & " is new");
               Put_New_Line;
               S_Put (2,
                      Data.Unit_Full_Name.all      &
                      "."                          &
                      Gen_Test_Unit_Name           &
                      ";");
               Put_New_Line;

               Close_File;

            end if;

            exit;
         end if;

         Generic_Tests_Storage.Next (Cur_Stor);
      end loop;

   end Generate_Test_Package_Instantiation;

   --------------------------
   --  Generate_Skeletons  --
   --------------------------

   procedure Generate_Skeletons (Data : Data_Holder) is
      Output_Dir         : constant String :=
        Get_Source_Output_Dir (Data.Unit_File_Name.all);

      Tmp_File_Name      : constant String :=
        "gnattest_tmp_skeleton";
      --  Name of temporary file created to compare with already existing
      --  skeleton to check if the skeleton was modified by user.

      New_Skeleton : Boolean;
      --  True when the skeleton is generated for the first time.

      Unit_Name          : String_Access;
      --  Test package unit name.

      New_Unit_Full_Name : String_Access;

      Separate_Unit_Name : String_Access;
      --  Full name of the separated unit.

      Separate_File_Name : String_Access;
      --  File name for the separated unit.

      Separated_Name     : String_Access;
      --  Unit name of the separated test routine of environment management.

      Current_Type   : Base_Type_Info;

      Current_Subp : Subp_Info;

      Subp_Cur : Subp_Data_List.Cursor;

      TP_List : TP_Mapping_List.List;

      procedure Set_Current_Type (Type_Numb : Natural);
      --  Looks trough types and nested types and sets the value of
      --  Current_Type with correspondig element.

      procedure Set_Current_Type (Type_Numb : Natural) is
      begin

         for
           I in Data.Type_Data_List.First_Index ..
             Data.Type_Data_List.Last_Index
         loop

            if
              Data.Type_Data_List.Element (I).Type_Number = Type_Numb
            then
               Current_Type   := Data.Type_Data_List.Element (I);
               exit;
            end if;

         end loop;

      end Set_Current_Type;

   begin

      Test_Info.Include (Data.Unit_File_Name.all, 0);

      --  Setting up TP_List if there is one already from test_data stage.
      if GNATtest.Mapping.Mapping.Find (Data.Unit_File_Name.all) /=
        SP_Mapping.No_Element
      then
         TP_List :=
           SP_Mapping.Element
             (GNATtest.Mapping.Mapping.Find (Data.Unit_File_Name.all)).
               Test_Info;
      end if;

      --  Test routines.
      Subp_Cur := Data.Subp_List.First;
      loop
         exit when Subp_Cur = Subp_Data_List.No_Element;

         Current_Subp := Subp_Data_List.Element (Subp_Cur);

         Set_Current_Type (Current_Subp.Corresp_Type);

         if not Current_Subp.Is_Abstract then

            Separated_Name := new String'
              (Current_Subp.Subp_Mangle_Name.all);

            if Current_Subp.Nesting.all = Data.Unit_Full_Name.all then
               if Current_Subp.Corresp_Type = 0 then
                  if Data.Is_Generic then
                     New_Unit_Full_Name :=
                       new String'(Data.Unit_Full_Name.all &
                                   "."                     &
                                   Gen_Test_Unit_Name);
                  else
                     New_Unit_Full_Name :=
                       new String'(Data.Unit_Full_Name.all &
                                   "."                     &
                                   Test_Data_Unit_Name     &
                                   "."                     &
                                   Test_Unit_Name);
                  end if;
               else
                  New_Unit_Full_Name := new String'(Data.Unit_Full_Name.all);
               end if;
            else
               if Current_Subp.Corresp_Type = 0 then
                  New_Unit_Full_Name := new String'
                    (Data.Unit_Full_Name.all & "." &
                     Test_Data_Unit_Name & "."     &
                     Test_Unit_Name & "."          &
                     Nesting_Difference
                       (Current_Subp.Nesting.all,
                        Data.Unit_Full_Name.all) &
                     "." & Test_Data_Unit_Name & "." & Test_Unit_Name);

               else
                  Set_Current_Type (Current_Subp.Corresp_Type);

                  if Current_Type.Nesting.all = Data.Unit_Full_Name.all then
                     New_Unit_Full_Name := new String'
                       (Data.Unit_Full_Name.all & "." &
                        Nesting_Difference
                          (Current_Subp.Nesting.all,
                           Data.Unit_Full_Name.all));
                  else
                     New_Unit_Full_Name := new String'
                       (Data.Unit_Full_Name.all & "." &
                        Test_Data_Unit_Name & "." &
                        Test_Unit_Name & "." &
                        Nesting_Difference
                          (Current_Subp.Nesting.all,
                           Data.Unit_Full_Name.all));
                  end if;
               end if;
            end if;

            if Current_Subp.Corresp_Type = 0 then

               Unit_Name := new String'(New_Unit_Full_Name.all);

            else

               if Data.Is_Generic then
                  Unit_Name := new
                    String'(New_Unit_Full_Name.all              &
                            "."                                  &
                            Current_Type.Main_Type_Text_Name.all &
                            Gen_Test_Unit_Name_Suff);
               else
                  Unit_Name := new
                    String'(New_Unit_Full_Name.all              &
                            "."                                  &
                            Current_Type.Main_Type_Text_Name.all &
                            Test_Data_Unit_Name_Suff             &
                            "."                                  &
                            Current_Type.Main_Type_Text_Name.all &
                            Test_Unit_Name_Suff);
               end if;

            end if;

            Free (New_Unit_Full_Name);

            Separate_Unit_Name := new
              String'(Unit_Name.all &
                      "."           &
                      Separated_Name.all);

            Separate_File_Name :=
              new String'(Unit_To_File_Name (Separate_Unit_Name.all) & ".adb");

            Test_Info.Replace
              (Data.Unit_File_Name.all,
               Test_Info.Element (Data.Unit_File_Name.all) + 1);

            All_Tests_Counter := All_Tests_Counter + 1;

            if not Is_Regular_File (Output_Dir          &
                                    Directory_Separator &
                                    Separate_File_Name.all)
            then

               New_Tests_Counter := New_Tests_Counter + 1;

               Create
                 (Output_Dir & Directory_Separator & Separate_File_Name.all);

               New_Skeleton := True;
            else
               Create (Tmp_File_Name);
               New_Skeleton := False;
            end if;

            Print_Comment_Separate
              (Subp_Data_List.Element (Subp_Cur));
            Put_New_Line;
            S_Put (0, "with Gnattest_Generated;");
            Put_New_Line;
            Put_New_Line;
            S_Put (0, "separate (" & Unit_Name.all & ")");
            Put_New_Line;

            if not Subp_Data_List.Element (Subp_Cur).Is_Abstract then
               S_Put
                 (0,
                  "procedure "       &
                  Separated_Name.all &
                  " (Gnattest_T : in out ");

               if Subp_Data_List.Element (Subp_Cur).Corresp_Type = 0 then
                  S_Put (0, "Test) is");
               else
                  S_Put
                    (0,
                     "Test_"                              &
                     Current_Type.Main_Type_Text_Name.all &
                     ") is");
               end if;
               Put_New_Line;
               S_Put (3, "pragma Unreferenced (Gnattest_T);");
               Put_New_Line;

               if Subp_Data_List.Element (Subp_Cur).Has_TC_Info then
                  Put_Wrapper_Rename (3, Subp_Data_List.Element (Subp_Cur));
               end if;

               S_Put (0, "begin");
               Put_New_Line;
               S_Put (3,
                      "AUnit.Assertions.Assert");
               Put_New_Line;
               S_Put (5, "(Gnattest_Generated.Default_Assert_Value,");
               Put_New_Line;
               S_Put (6,  """Test not implemented."");");
               Put_New_Line;
               S_Put (0, "end " & Separated_Name.all & ";");
               Put_New_Line;

            end if;

            Close_File;

            declare
               Skeleton_Time : constant OS_Time :=
                 File_Time_Stamp
                   (Output_Dir          &
                    Directory_Separator &
                    Separate_File_Name.all);

               Old_File, New_File : Ada.Text_IO.File_Type;
               Old_File_Line, New_File_Line : String_Access;
               Idx : Integer;

               Unmodified : Boolean := True;
            begin
               if New_Skeleton then
                  Add_TR
                    (TP_List,
                     Unit_To_File_Name (Unit_Name.all) & ".ads",
                     Separate_File_Name.all,
                     Format_Time (Skeleton_Time),
                     Subp_Data_List.Element (Subp_Cur));
               else
                  Open (New_File, In_File, Tmp_File_Name);
                  Open
                    (Old_File, In_File,
                     Output_Dir          &
                     Directory_Separator &
                     Separate_File_Name.all);

                  --  Skipping header comments from both new and old skeletons.
                  --  Simple reformatting of source code can lead to
                  --  differences in how tested subprogram image is presented
                  --  while the test itself is still unmodified.
                  loop
                     exit when End_Of_File (Old_File);
                     Old_File_Line := new String'(Get_Line (Old_File));
                     Idx := Old_File_Line'First;
                     if
                       Old_File_Line'Length > 1 and then
                       Old_File_Line (Idx .. Idx + 1) = "--"
                     then
                        Free (Old_File_Line);
                     else
                        exit;
                     end if;
                  end loop;

                  loop
                     exit when End_Of_File (New_File);
                     New_File_Line := new String'(Get_Line (New_File));
                     Idx := New_File_Line'First;
                     if
                       New_File_Line'Length > 1 and then
                       New_File_Line (Idx .. Idx + 1) = "--"
                     then
                        Free (New_File_Line);
                     else
                        exit;
                     end if;
                  end loop;

                  loop
                     if
                       End_Of_File (New_File) and not End_Of_File (Old_File)
                     then
                        Unmodified := False;
                        exit;
                     end if;

                     if
                       End_Of_File (Old_File) and not End_Of_File (New_File)
                     then
                        Unmodified := False;
                        exit;
                     end if;

                     if End_Of_File (Old_File) and End_Of_File (New_File) then
                        exit;
                     end if;

                     Old_File_Line := new String'(Get_Line (Old_File));
                     New_File_Line := new String'(Get_Line (New_File));
                     if Old_File_Line.all /= New_File_Line.all then
                        Unmodified := False;
                        exit;
                     end if;
                  end loop;

                  if Unmodified then
                     Add_TR
                       (TP_List,
                        Unit_To_File_Name (Unit_Name.all) & ".ads",
                        Separate_File_Name.all,
                        Format_Time (Skeleton_Time),
                        Subp_Data_List.Element (Subp_Cur));
                  else
                     Add_TR
                       (TP_List,
                        Unit_To_File_Name (Unit_Name.all) & ".ads",
                        Separate_File_Name.all,
                        "modified",
                        Subp_Data_List.Element (Subp_Cur));
                  end if;

                  Close (New_File);
                  Close (Old_File);
               end if;
            end;

            Free (Separate_Unit_Name);
            Free (Separate_File_Name);
            Free (Separated_Name);
         end if;

         Subp_Data_List.Next (Subp_Cur);
      end loop;

      Add_Test_List (Data.Unit_File_Name.all, TP_List);
      TP_List.Clear;

   end Generate_Skeletons;

   ----------------------------------
   -- Get_Subprogram_From_Separate --
   ----------------------------------

   procedure Get_Subprogram_From_Separate
     (File : String;
      UH   : Unique_Hash;
      Subp : Subp_Info)
   is
      Input_File : Ada.Text_IO.File_Type;
      MD : Markered_Data;
      Line : String_Access;
      Append_Line : Boolean;
   begin
      if not Is_Regular_File (File) then
         return;
      end if;

      MD.Commented_Out := False;
      MD.TR_Text := String_Vectors.Empty_Vector;
      MD.Short_Name := new String'(Subp.Subp_Text_Name.all);

      Open (Input_File, In_File, File);

      loop
         exit when End_Of_File (Input_File);
         Line := new String'(Get_Line (Input_File));
         Append_Line := True;

         if To_Lower (Line.all) = "with gnattest_generated;" then
            Append_Line := False;
         end if;

         --  skipping test routine profile up to declaration section;
         --  depending on line breaks it can take different number of lines
         if Index (To_Lower (Line.all), "separate", Line'First) /= 0 then
            loop
               if
                 Index (To_Lower (Line.all), ") is", Line'First) /= 0
                 or else Trim (To_Lower (Line.all), Both) = "is"
               then
                  Append_Line := False;
                  exit;
               else
                  Free (Line);
                  Line := new String'(Get_Line (Input_File));
               end if;
            end loop;
         end if;

         --  skipping "end test_outine_name;"
         if
           Index
             (To_Lower (Line.all),
              "end "
              & To_Lower
                (Test_Routine_Prefix
                 & Subp.Subp_Text_Name.all
                 & "_"
                 & Subp.Subp_Hash_V1
                   (Subp.Subp_Hash_V1'First .. Subp.Subp_Hash_V1'First + 5))
              & ";",
              Line'First) /= 0
         then
            Append_Line := False;
         end if;

         if Append_Line then
            MD.TR_Text.Append (Line.all);
         end if;

         Free (Line);
      end loop;

      Close (Input_File);

      if Find (Markered_Data_Map, UH) = Markered_Data_Maps.No_Element then
         Markered_Data_Map.Insert (UH, MD);
      else
         Markered_Data_Map.Replace (UH, MD);
      end if;

   end Get_Subprogram_From_Separate;

   ----------------------------------
   -- Get_Subprograms_From_Package --
   ----------------------------------

   procedure Get_Subprograms_From_Package (File : String) is

      Input_File : Ada.Text_IO.File_Type;

      Line_Counter : Natural := 0;

      Line : String_Access;

      Idx, Idx2 : Natural;

      UH : Unique_Hash;
      MD : Markered_Data;

      ID_Found : Boolean;

      type Parsing_Modes is (TR, Marker, Other);

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

      procedure Report_Corrupted_Marker;
      pragma Unreferenced (Report_Corrupted_Marker);

      procedure Report_Corrupted_Marker is
      begin
         Report_Err
           ("gnattest: marker corrupted at "
            & Base_Name (File)
            & ":"
            & Natural'Image (Line_Counter));
      end Report_Corrupted_Marker;

   begin

      if not Is_Regular_File (File) then
         return;
      end if;

      MD.Commented_Out   := False;
      MD.Short_Name_Used := False;
      MD.TR_Text := String_Vectors.Empty_Vector;
      UH.Hash    := new String'("");
      UH.TC_Hash := new String'("");

      Open (Input_File, In_File, File);

      loop
         exit when End_Of_File (Input_File);

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

         case Parsing_Mode is
            when Other =>
               if Index (Line.all, GT_Marker_Begin) /= 0 then
                  Parsing_Mode := Marker;
                  Prev_Parsing_Mode := Other;
                  ID_Found := False;
               end if;

            when Marker =>

               Idx := Index (Line.all, "--  id:");
               if Idx /= 0 then
                  ID_Found := True;

                  Idx  := Idx + 7;
                  Idx2 := Index (Line.all, "/", Idx + 1);
                  UH.Version := new String'(Line (Idx .. Idx2 - 1));

                  Idx  := Idx2 + 1;
                  Idx2 := Index (Line.all, "/", Idx + 1);
                  UH.Hash := new String'(Line (Idx .. Idx2 - 1));

                  Idx  := Idx2 + 1;
                  Idx2 := Index (Line.all, "/", Idx + 1);
                  MD.Short_Name := new String'(Line (Idx .. Idx2 - 1));

                  Idx  := Idx2 + 1;
                  Idx2 := Index (Line.all, "/", Idx + 1);
                  if Line (Idx .. Idx2 - 1) = "1" then
                     MD.Short_Name_Used := True;
                  else
                     MD.Short_Name_Used := False;
                  end if;

                  Idx  := Idx2 + 1;
                  Idx2 := Index (Line.all, "/", Idx + 1);
                  if Line (Idx .. Idx2 - 1) = "1" then
                     MD.Commented_Out := True;
                  else
                     MD.Commented_Out := False;
                  end if;

                  if Idx2 < Line'Last then

                     Idx  := Idx2 + 1;
                     Idx2 := Index (Line.all, "/", Idx + 1);
                     UH.TC_Hash := new String'(Line (Idx .. Idx2 - 1));

                  end if;

               else

                  if Index (Line.all, GT_Marker_End) /= 0 then
                     if Prev_Parsing_Mode = Other then
                        if ID_Found then
                           Parsing_Mode := TR;
                        else
                           Parsing_Mode := Other;
                        end if;
                     end if;
                     if Prev_Parsing_Mode = TR then
                        Parsing_Mode := Other;
                     end if;
                  end if;

               end if;

            when TR =>

               if Index (Line.all, GT_Marker_Begin) /= 0 then
                  Markered_Data_Map.Include (UH, MD);
                  Prev_Parsing_Mode := TR;
                  Parsing_Mode := Marker;

                  MD.Commented_Out   := False;
                  MD.Short_Name_Used := False;
                  MD.TR_Text := String_Vectors.Empty_Vector;
                  UH.Hash    := new String'("");
                  UH.TC_Hash := new String'("");
               else
                  MD.TR_Text.Append (Line.all);
               end if;

         end case;

      end loop;

      Close (Input_File);
   end Get_Subprograms_From_Package;

   --------------------------
   --  Initialize_Context  --
   --------------------------

   function Initialize_Context (Source_Name : String) return Boolean is
      Success : Boolean;

      use type Asis.Errors.Error_Kinds; --  for EC12-013
   begin

      Create_Tree (Source_Name, Success);

      if not Success then
         Set_Source_Status (Source_Name, Bad_Content);

         Report_Std ("gnattest: " & Source_Name &
                       " is not a legal Ada source");
         Source_Compilation_Failed := True;

         return False;

      end if;

      Last_Context_Name :=
        new String'(Get_Source_Suffixless_Name (Source_Name));

      Associate
       (The_Context => The_Context,
        Name        => "",
        Parameters  => "-C1 "
        & To_Wide_String (Get_Source_Suffixless_Name (Source_Name) & ".adt"));

      begin
         Open (The_Context);
         Success := True;
      exception
         when ASIS_Failed =>
            --  The only known situation when we can not open a C1 context for
            --  newly created tree is recompilation of System (see D617-017)

            if Asis.Implementation.Status = Asis.Errors.Use_Error
              and then
               Asis.Implementation.Diagnosis = "Internal implementation error:"
               & " Asis.Ada_Environments.Open - System is recompiled"
            then
               Report_Err
                 ("gnattest: can not process redefinition of System in " &
                    Source_Name);

               Set_Source_Status (Source_Name, Bad_Content);
               Success := False;
            else
               raise;
            end if;

      end;

      return Success;
   end Initialize_Context;

   ----------------------------
   -- Is_Callable_Subprogram --
   ----------------------------

   function Is_Callable_Subprogram (Subp : Asis.Element) return Boolean
   is
   begin
      if Trait_Kind (Subp) = An_Abstract_Trait then
         return False;
      end if;
      if Declaration_Kind (Subp) = A_Null_Procedure_Declaration then
         return False;
      end if;
      return True;
   end Is_Callable_Subprogram;

   ------------------------------------
   -- Is_Declared_In_Regular_Package --
   ------------------------------------

   function Is_Declared_In_Regular_Package
     (Elem : Asis.Element)
      return Boolean
   is
      Encl : Asis.Element := Enclosing_Element (Elem);
   begin
      loop
         exit when Is_Nil (Encl);

         if Declaration_Kind (Encl) /= A_Package_Declaration then
            return False;
         end if;

         Encl := Enclosing_Element (Encl);

      end loop;

      return True;

   end Is_Declared_In_Regular_Package;

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

   function Is_Fully_Private
     (Arg : Asis.Declaration) return Boolean
   is
      Decl_1, Decl_2, Decl_3 : Asis.Element :=
        Asis.Nil_Element;

      function Is_Private_Or_Null (El : Asis.Element) return Boolean is
         (if Is_Nil (El) then True else Is_Private (El));

   begin
      case Declaration_Kind (Arg) is
         when An_Ordinary_Type_Declaration =>
            Decl_3 := Arg;
            Decl_2 := Corresponding_Type_Partial_View (Arg);
            if Declaration_Kind (Decl_2) in
              A_Private_Type_Declaration | A_Private_Extension_Declaration
            then
               Decl_1 := Corresponding_Type_Partial_View (Decl_2);
            end if;
         when A_Private_Type_Declaration      |
              A_Private_Extension_Declaration =>
            Decl_3 := Corresponding_Type_Completion (Arg);
            Decl_2 := Arg;
            Decl_1 := Corresponding_Type_Partial_View (Arg);
         when An_Incomplete_Type_Declaration       |
              A_Tagged_Incomplete_Type_Declaration =>
            Decl_1 := Arg;
            Decl_2 := Corresponding_Type_Completion (Arg);
            if Declaration_Kind (Decl_2) in
              A_Private_Type_Declaration | A_Private_Extension_Declaration
            then
               Decl_3 := Corresponding_Type_Completion (Decl_2);
            end if;
         when others =>
            null;
      end case;

      return Is_Private_Or_Null (Decl_1)
        and then Is_Private_Or_Null (Decl_2)
        and then Is_Private_Or_Null (Decl_3);
   end Is_Fully_Private;

   -----------------
   -- Mangle_Hash --
   -----------------

   function Mangle_Hash
     (Subp       : Asis.Declaration) return String
   is
      Full_Hash : String_Access;
   begin

      if Generate_Separates then
         Full_Hash := new String'(Mangle_Hash_Full (Subp, True));
      else
         Full_Hash := new String'(Mangle_Hash_Full (Subp));
      end if;

      return
        Test_Routine_Prefix
        & Get_Subp_Name (Subp)
        & "_"
        & Full_Hash (Full_Hash'First .. Full_Hash'First + 5);
   end Mangle_Hash;

   -------------------------------------
   -- No_Inheritance_Through_Generics --
   -------------------------------------

   function No_Inheritance_Through_Generics
     (Inheritance_Root_Type : Asis.Element;
      Inheritance_Final_Type : Asis.Element)
         return Boolean
   is
      Elem  : Asis.Element := Inheritance_Final_Type;
      Elem2 : Asis.Element := Inheritance_Root_Type;
   begin
      if Declaration_Kind (Inheritance_Root_Type) in
        A_Private_Type_Declaration | A_Private_Extension_Declaration
      then
         Elem2 := Corresponding_Type_Completion (Elem2);
      end if;

      loop
         if not Is_Declared_In_Regular_Package (Elem) then
            return False;
         end if;

         exit when
           Is_Equal (Elem, Elem2);
         Elem := Parent_Type_Declaration (Elem);
      end loop;
      return True;
   end No_Inheritance_Through_Generics;

   -------------------------------
   -- Print_Comment_Declaration --
   -------------------------------

   procedure Print_Comment_Declaration (Subp : Subp_Info; Span : Natural := 0)
   is
      File_Name : constant String    := Base_Name (To_String (Text_Name
        (Enclosing_Compilation_Unit (Subp.Subp_Declaration))));

      Elem_Span : constant Asis.Text.Span :=
        Element_Span (Subp.Subp_Declaration);
   begin
      S_Put
        (Span,
         "--  " &
         File_Name &
         ":" &
         Trim (Integer'Image (Elem_Span.First_Line), Both) &
         ":" &
         Trim (Integer'Image (Elem_Span.First_Column), Both) &
         ":" &
         Subp.Subp_Text_Name.all);
      if Subp.Has_TC_Info then
         S_Put (0, ":" & Subp.TC_Info.Name.all);
      end if;
      New_Line_Count;
   end Print_Comment_Declaration;

   ----------------------------
   -- Print_Comment_Separate --
   ----------------------------

   procedure Print_Comment_Separate (Subp : Subp_Info; Span : Natural := 0) is

      Params : constant Parameter_Specification_List :=
        Parameter_Profile (Subp.Subp_Declaration);

      Subp_Name : constant String := Get_Subp_Name (Subp.Subp_Declaration);

      Func_Profile_Span : Asis.Text.Span;
      Last_Arg_Span     : Asis.Text.Span;

   begin

      case Declaration_Kind (Subp.Subp_Declaration) is
         when A_Procedure_Declaration          |
              A_Procedure_Renaming_Declaration =>

            if Params'Length = 0 then

               S_Put (Span, "--  procedure " & Subp_Name);
               Put_New_Line;

            else

               Last_Arg_Span.First_Line :=
                 Element_Span (Subp.Subp_Declaration).First_Line;
               Last_Arg_Span.First_Column :=
                 Element_Span (Subp.Subp_Declaration).First_Column;
               Last_Arg_Span.Last_Line :=
                 Element_Span (Params (Params'First)).Last_Line;
               Last_Arg_Span.Last_Column :=
                 Element_Span (Params (Params'First)).Last_Column;

               declare
                  Proc_Lines : constant Line_List :=
                    Lines (Subp.Subp_Declaration, Last_Arg_Span);
               begin
                  for I in Proc_Lines'Range loop
                     S_Put
                       (Span,
                        "--  " &
                        Trim
                          (To_String (Non_Comment_Image (Proc_Lines (I))),
                           Both));
                     if I = Proc_Lines'Last then
                        S_Put (0, ")");
                     end if;
                     Put_New_Line;
                  end loop;
               end;
            end if;

         when others =>

            Func_Profile_Span.First_Line :=
              Element_Span (Subp.Subp_Declaration).First_Line;
            Func_Profile_Span.First_Column :=
              Element_Span (Subp.Subp_Declaration).First_Column;
            Func_Profile_Span.Last_Line :=
              Element_Span (Result_Profile (Subp.Subp_Declaration)).Last_Line;
            Func_Profile_Span.Last_Column :=
              Element_Span
                (Result_Profile (Subp.Subp_Declaration)).Last_Column;

            declare
               Func_Lines : constant Line_List :=
                 Lines (Subp.Subp_Declaration, Func_Profile_Span);
            begin
               for I in Func_Lines'Range loop
                  S_Put
                    (Span,
                     "--  " &
                     Trim
                       (To_String (Non_Comment_Image (Func_Lines (I))), Both));
                  Put_New_Line;
               end loop;
            end;

      end case;

      if Subp.Has_TC_Info then
         S_Put (Span, "--  Test Case """ & Subp.TC_Info.Name.all & """");
         Put_New_Line;
      end if;
   end Print_Comment_Separate;

   --------------------
   -- Process_Source --
   --------------------

   procedure Process_Source (The_Unit : Asis.Compilation_Unit) is
      Source_Name      : String_Access;
      Data             : Data_Holder;

      Suite_Data_List  : Suites_Data_Type;
      Suite_Data       : GNATtest.Harness.Generator.Data_Holder;

      Apropriate_Source : Boolean;

      Test_Packages : String_Set.Set;
      Cur : String_Set.Cursor;

      procedure Get_Test_Packages_List (S_Data : Suites_Data_Type);

      function Get_Suite_Components
        (S_Data       : Suites_Data_Type;
         Package_Name : String)
         return GNATtest.Harness.Generator.Data_Holder;

      procedure Get_Test_Packages_List (S_Data : Suites_Data_Type)
      is
         Declared_In_Generic : Boolean;
         Elem : Asis.Element;
      begin
         for K in S_Data.TR_List.First_Index .. S_Data.TR_List.Last_Index loop

            Declared_In_Generic := False;
            Elem := S_Data.TR_List.Element (K).Original_Subp;
            loop
               exit when Is_Nil (Elem);

               if Declaration_Kind (Elem) = A_Generic_Package_Declaration then
                  Declared_In_Generic := True;
                  exit;
               end if;

               Elem := Enclosing_Element (Elem);
            end loop;

            if not Declared_In_Generic then
               Test_Packages.Include
                 (S_Data.TR_List.Element (K).Test_Package.all);
            end if;
         end loop;

         for
           K in S_Data.ITR_List.First_Index .. S_Data.ITR_List.Last_Index
         loop
            Test_Packages.Include
              (S_Data.ITR_List.Element (K).Test_Package.all);
         end loop;
      end Get_Test_Packages_List;

      function Get_Suite_Components
        (S_Data       : Suites_Data_Type;
         Package_Name : String)
         return GNATtest.Harness.Generator.Data_Holder
      is
         Suite_Data   : GNATtest.Harness.Generator.Data_Holder;
         Test_Routine : GNATtest.Harness.Generator.Test_Routine_Info;
         TT   : GNATtest.Harness.Generator.Test_Type_Info;
         TR_E : GNATtest.Harness.Generator.Test_Routine_Info_Enhanced;

         package Test_Type_Origins is new
           Ada.Containers.Vectors (Positive, Asis.Element, Is_Equal);
         use Test_Type_Origins;

         TT_Origins : Test_Type_Origins.Vector;
         --  Used to set test type numbers.

         Original_Type : Asis.Element;

         Type_Found : Boolean;
      begin

         Suite_Data.Test_Unit_Full_Name := new String'(Package_Name);

         for
           K in S_Data.Test_Types.First_Index .. S_Data.Test_Types.Last_Index
         loop

            if
              S_Data.Test_Types.Element (K).Test_Package.all = Package_Name
            then
               TT := S_Data.Test_Types.Element (K).TT_Info;
               TT.Tested_Type := S_Data.Test_Types.Element (K).Original_Type;
               Suite_Data.Test_Types.Append (TT);
               TT_Origins.Append (S_Data.Test_Types.Element (K).Original_Type);
            end if;
         end loop;

         for K in S_Data.TR_List.First_Index .. S_Data.TR_List.Last_Index loop

            if S_Data.TR_List.Element (K).Test_Package.all = Package_Name then

               Test_Routine := S_Data.TR_List.Element (K).TR_Info;

               --  Setting test type number;

               Original_Type := S_Data.TR_List.Element (K).Original_Type;
               Type_Found := False;

               for L in TT_Origins.First_Index .. TT_Origins.Last_Index loop
                  if Is_Equal (TT_Origins.Element (L), Original_Type) then
                     Test_Routine.Test_Type_Numb := L;
                     Type_Found := True;
                     exit;
                  end if;
               end loop;

               if Type_Found then
                  Suite_Data.TR_List.Append (Test_Routine);
                  Suite_Data.Good_For_Suite := True;
               end if;
            end if;
         end loop;

         for
           K in S_Data.ITR_List.First_Index .. S_Data.ITR_List.Last_Index
         loop
            if S_Data.ITR_List.Element (K).Test_Package.all = Package_Name then

               TR_E := S_Data.ITR_List.Element (K).TR_Info;

               --  Setting up test type number

               Original_Type := S_Data.ITR_List.Element (K).Original_Type;
               Type_Found := False;

               for L in TT_Origins.First_Index .. TT_Origins.Last_Index loop
                  if Is_Equal (TT_Origins.Element (L), Original_Type) then
                     TR_E.Test_Type_Numb := L;
                     Type_Found := True;
                     exit;
                  end if;
               end loop;

               if Type_Found then
                  Suite_Data.ITR_List.Append (TR_E);
                  Suite_Data.Good_For_Suite := True;
               end if;

            end if;
         end loop;

         for
           K in S_Data.LTR_List.First_Index .. S_Data.LTR_List.Last_Index
         loop
            if S_Data.LTR_List.Element (K).Test_Package.all = Package_Name then

               TR_E := S_Data.LTR_List.Element (K).TR_Info;

               --  Setting up test type number

               Original_Type := S_Data.LTR_List.Element (K).Original_Type;
               Type_Found := False;

               for L in TT_Origins.First_Index .. TT_Origins.Last_Index loop
                  if Is_Equal (TT_Origins.Element (L), Original_Type) then
                     TR_E.Test_Type_Numb := L;
                     Type_Found := True;
                     exit;
                  end if;
               end loop;

               if Type_Found then
                  TR_E.Tested_Type := Original_Type;
                  Suite_Data.LTR_List.Append (TR_E);
                  Suite_Data.Good_For_Substitution  := True;
               end if;
            end if;
         end loop;

         TT_Origins.Clear;

         return Suite_Data;

      end Get_Suite_Components;

   begin

      Source_Name :=
        new String'(To_String (Text_Name (The_Unit)));

      Report_Source (Source_Name.all);

      Gather_Data (The_Unit, Data, Suite_Data_List, Apropriate_Source);

      if Apropriate_Source then

         --  First, create stubs if needed. This will allow to import stub_data
         --  packages into test packages only for actually stubbed dependencies
         if Stub_Mode_ON then
            Process_Stubs (Data.Units_To_Stub);
         end if;

         declare
            F : File_Array_Access;
         begin
            Append
              (F,
               GNATCOLL.VFS.Create
                 (+(Get_Source_Output_Dir (Source_Name.all))));
            Create_Dirs (F);
         end;

         if Substitution_Suite then
            Gather_Substitution_Data (Suite_Data_List);
         end if;
         if Data.Data_Kind = Declaration_Data then
            Generate_Nested_Hierarchy (Data);
            Generate_Test_Package (Data);
            if Generate_Separates then
               Generate_Skeletons (Data);
            end if;

            Get_Test_Packages_List (Suite_Data_List);
            Cur := Test_Packages.First;
            loop
               exit when Cur = String_Set.No_Element;

               Suite_Data := Get_Suite_Components
                 (Suite_Data_List,
                  String_Set.Element (Cur));

               if Suite_Data.Good_For_Suite then
                  if not Stub_Mode_ON and then not Separate_Drivers then

                     GNATtest.Harness.Generator.Generate_Suite (Suite_Data);

                     if Suite_Data.Good_For_Substitution  then
                        GNATtest.Harness.Generator.
                          Generate_Substitution_Suite_From_Tested (Suite_Data);
                     end if;
                  end if;
               end if;

               String_Set.Next (Cur);
            end loop;

            if Stub_Mode_ON or else Separate_Drivers then

               Cur := Test_Packages.First;
               while Cur /= String_Set.No_Element loop

                  Suite_Data := Get_Suite_Components
                    (Suite_Data_List,
                     String_Set.Element (Cur));

                  if Suite_Data.Good_For_Suite then
                     GNATtest.Harness.Generator.Generate_Test_Drivers
                       (Suite_Data,
                        Data.Unit_File_Name.all,
                        Data.Units_To_Stub);
                  end if;
                  if Suite_Data.Good_For_Substitution
                    and then not Driver_Per_Unit
                  then
                     GNATtest.Harness.Generator.
                       Generate_Substitution_Test_Drivers (Suite_Data);
                  end if;
                  String_Set.Next (Cur);
               end loop;
            end if;

         end if;
         if Data.Data_Kind = Instantiation then
            Generate_Test_Package_Instantiation (Data);
         end if;
         Set_Source_Status (Source_Name.all, Processed);
      end if;

      if Data.Data_Kind = Declaration_Data then
         Clear (Data.Type_Data_List);
         Clear (Data.Subp_List);
         Clear (Data.Package_Data_List);
         Clear (Data.Subp_Name_Frequency);
         Clear (Data.Units_To_Stub);
      end if;

      Suite_Data.Test_Types.Clear;
      Suite_Data.TR_List.Clear;
      Suite_Data.ITR_List.Clear;
      Suite_Data.LTR_List.Clear;

   end Process_Source;

   -----------------------
   --  Process_Sources  --
   -----------------------

   procedure Process_Sources is
      Source_Name : String_Access;
      Successful_Initialization : Boolean := True;
      The_Unit : Asis.Compilation_Unit;

      procedure Iterate_Sources (All_CU : Asis.Compilation_Unit_List);
      --  iterates through compilation units and checks if they are present in
      --  the source table, if so - processes them.

      procedure Iterate_Sources (All_CU : Asis.Compilation_Unit_List) is
         File_Name : String_Access;
      begin

         for J in All_CU'Range loop

            if Unit_Origin (All_CU (J)) = An_Application_Unit then
               File_Name :=
                 new String'(To_String (Text_Name (All_CU (J))));

               if
                 Source_Present (File_Name.all) and then
                 Get_Source_Status (File_Name.all) = Waiting and then
                 not Has_Limited_View_Only (All_CU (J))
               then
                  Process_Source (All_CU (J));
               end if;

               Free (File_Name);
            end if;
         end loop;

      end Iterate_Sources;

      Cur : Tests_Per_Unit.Cursor;

   begin

      Asis.Implementation.Initialize ("-asis05 -ws");

      loop
         Source_Name := new String'(Next_Non_Processed_Source);
         exit when Source_Name.all = "";

         if
           (Stub_Mode_ON or else not Main_Units.Is_Empty)
           and then Get_Source_Body (Source_Name.all) /= ""
         then
            Successful_Initialization :=
              Initialize_Context (Get_Source_Body (Source_Name.all));

            if
              Get_Source_Status
                (Get_Source_Body (Source_Name.all)) = Bad_Content
            then
               --  If correspondig body is bad, the spec is also not usable
               --  for stubbing.

               Set_Source_Status (Source_Name.all, Bad_Content);
            end if;
         else
            Successful_Initialization := Initialize_Context (Source_Name.all);
         end if;

         if Successful_Initialization then

            if not Main_Units.Is_Empty then
               declare
                  Success  : Boolean;
                  ALI_File : constant String :=
                    Temp_Dir.all & Directory_Separator
                    & Get_Source_Suffixless_Name (Source_Name.all) & ".ali";
                  Subdir   : constant String :=
                    Temp_Dir.all & Directory_Separator & Closure_Subdir_Name;
               begin

                  --  If gnattest is invoked with -U unit.adb and there is
                  --  a correspodning unit.ads, then the unit.ali will already
                  --  be present in closure subdir. No harm ovewriting it,
                  --  we will still get all other errors.
                  Copy_File
                    (ALI_File,
                     Subdir,
                     Success,
                     Overwrite);
                  if not Success then
                     Trace (Me, "Cannot copy " & ALI_File & " to " & Subdir);
                     Report_Err ("cannot calculate closure");
                     raise Fatal_Error;
                  end if;
               end;
               Update_Closure;
            end if;

            if Stub_Mode_ON or else not Main_Units.Is_Empty then

               if Get_Source_Body (Source_Name.all) = "" then
                  The_Unit := Main_Unit_In_Current_Tree (The_Context);
               else
                  The_Unit :=
                    Corresponding_Declaration
                      (Main_Unit_In_Current_Tree (The_Context));
               end if;

               --  processing main unit
               Process_Source (The_Unit);

               --  Iterate_Sources won't work in stub mode since we need
               --  bodies corresponding to argument specs (if they exist),
               --  thus we need to recreate the tree almost each time and
               --  little to none optimisation can be gained with
               --  Iterate_Sources.

            else
               The_Unit := Main_Unit_In_Current_Tree (The_Context);

               --  processing main unit
               Process_Source (The_Unit);

               --  processing others in same context
               Iterate_Sources
                 (Asis.Compilation_Units.Compilation_Units (The_Context));
            end if;

         end if;

         Source_Clean_Up;
         Context_Clean_Up;
         Free (Source_Name);
      end loop;

      Asis.Implementation.Finalize;

      Generate_Project_File;
      Generate_Common_File;

      declare
         Cur_Stor  : Generic_Package_Storage.Cursor :=
           Gen_Package_Storage.First;
         GP : Generic_Package;
      begin
         while Cur_Stor /= Generic_Package_Storage.No_Element loop
            GP := Generic_Package_Storage.Element (Cur_Stor);
            if not GP.Has_Instantiation then
               Report_Std
                 (GP.Sloc.all
                  & ": warning: no instance of "
                  & GP.Name.all);
               Report_Std
                 (" corresponding tests are not included into harness");
            end if;

            Next (Cur_Stor);
         end loop;
      end;

      if not Main_Units.Is_Empty then
         --  Report exclusions that were not found dyring on-the-fly closure
         --  computation.
         Report_Exclusions_Not_Found;
      end if;

      if Verbose then
         Cur := Test_Info.First;
         loop
            exit when Cur = Tests_Per_Unit.No_Element;

            Report_Std
              (Natural'Image (Tests_Per_Unit.Element (Cur)) &
               " testable subprograms in " &
               Base_Name (Tests_Per_Unit.Key (Cur)));

            Tests_Per_Unit.Next (Cur);
         end loop;

         Test_Info.Clear;
         Report_Std
           ("gnattest:" &
            Natural'Image (All_Tests_Counter) &
            " testable subprogram(s) processed");
         Report_Std
           ("gnattest:" &
            Natural'Image (New_Tests_Counter) &
            " new skeleton(s) generated");
      end if;

      if Stub_Mode_ON then
         GNATtest.Harness.Generator.Generate_Stub_Test_Driver_Projects;
      elsif Separate_Drivers then
         GNATtest.Harness.Generator.Generate_Test_Driver_Projects;
      else
         GNATtest.Harness.Generator.Test_Runner_Generator;
         GNATtest.Harness.Generator.Project_Creator;
      end if;

   end Process_Sources;

   -------------------
   -- Process_Stubs --
   -------------------

   procedure Process_Stubs (List : Asis_Element_List.List)
   is
      Cur : Asis_Element_List.Cursor;
      CU  : Compilation_Unit;
      Str : String_Access;
   begin
      if Is_Empty (List) then
         return;
      end if;

      --  Once we change the context, contents of List won't make sense.
      Cur := List.First;
      while Cur /= Asis_Element_List.No_Element loop

         CU := Enclosing_Compilation_Unit (Asis_Element_List.Element (Cur));

         Str := new String'(To_String (Text_Name (CU)));

         if Get_Source_Body (Str.all) /= "" then
            if not Source_Stubbed (Str.all) then
               GNATtest.Stub.Generator.Process_Unit
                 (CU,
                  Get_Source_Stub_Dir (Str.all)
                  & Directory_Separator
                  & Base_Name (Get_Source_Body (Str.all)),
                  Get_Source_Stub_Dir (Str.all)
                  & Directory_Separator
                  & Get_Source_Stub_Data_Spec (Str.all),
                  Get_Source_Stub_Dir (Str.all)
                  & Directory_Separator
                  & Get_Source_Stub_Data_Body (Str.all));
               Mark_Sourse_Stubbed (Str.all);
            end if;
         end if;

         Free (Str);

         Next (Cur);
      end loop;

   end Process_Stubs;

   ---------------------------------
   -- Put_Closing_Comment_Section --
   ---------------------------------

   procedure Put_Closing_Comment_Section
     (Subp           : Subp_Info;
      Overloading_N  : Natural;
      Commented_Out  : Boolean := False;
      Use_Short_Name : Boolean := True)
   is
      Overloading_Prefix : String_Access;
   begin

      if Overloading_N /= 0 then
         if Subp.Is_Overloaded then
            if Use_Short_Name then
               Overloading_Prefix := new String'("1_");
            else
               Overloading_Prefix := new String'
                 (Trim (Natural'Image (Overloading_N), Both) & "_");
            end if;
         else
            Overloading_Prefix := new String'("");
         end if;
      end if;

      S_Put (0, "--  begin read only");
      New_Line_Count;

      if Commented_Out then
         S_Put
           (3,
            "--  end "
            & Test_Routine_Prefix
            & Subp.Subp_Text_Name.all
            & (if Subp.Has_TC_Info
              then "_" & Sanitize_TC_Name (Subp.TC_Info.Name.all)
              else "")
            & ";");
      else
         S_Put
           (3,
            "end "
            & Test_Routine_Prefix
            & Overloading_Prefix.all
            & Subp.Subp_Text_Name.all
            & (if Subp.Has_TC_Info
              then "_" & Sanitize_TC_Name (Subp.TC_Info.Name.all)
              else "")
            & ";");
      end if;
      New_Line_Count;
      S_Put (0, "--  end read only");
      New_Line_Count;

   end Put_Closing_Comment_Section;

   ---------------------------------
   -- Put_Opening_Comment_Section --
   ---------------------------------

   procedure Put_Opening_Comment_Section
     (Subp           : Subp_Info;
      Overloading_N  : Natural;
      Commented_Out  : Boolean := False;
      Use_Short_Name : Boolean := True;
      Type_Name      : String  := "")
   is
      Hash_Length_Used : constant := 15;
      Hash_First : constant Integer := Subp.Subp_Full_Hash'First;
      Hash_Last  : constant Integer :=
        Subp.Subp_Full_Hash'First + Hash_Length_Used;

      Overloading_Prefix : String_Access;
   begin

      if Overloading_N /= 0 then
         if Subp.Is_Overloaded then
            if Use_Short_Name then
               Overloading_Prefix := new String'("1_");
            else
               Overloading_Prefix := new String'
                 (Trim (Natural'Image (Overloading_N), Both) & "_");
            end if;
         else
            Overloading_Prefix := new String'("");
         end if;
      end if;

      New_Line_Count;
      S_Put (0, "--  begin read only");
      New_Line_Count;

      if Subp.Corresp_Type = 0 then
         if Commented_Out then
            S_Put
              (3,
               "--  procedure "
               & Test_Routine_Prefix
               & Subp.Subp_Text_Name.all
               & (if Subp.Has_TC_Info
                 then "_" & Sanitize_TC_Name (Subp.TC_Info.Name.all)
                 else "")
               &  " (Gnattest_T : in out Test);");
            New_Line_Count;
            S_Put
              (3,
               "--  procedure "
               & Subp.Subp_Mangle_Name.all
               &  " (Gnattest_T : in out Test) renames "
               & Test_Routine_Prefix
               & Subp.Subp_Text_Name.all
               & (if Subp.Has_TC_Info
                 then "_" & Sanitize_TC_Name (Subp.TC_Info.Name.all)
                 else "")
               & ";");
            New_Line_Count;
         else
            S_Put
              (3,
               "procedure "
               & Test_Routine_Prefix
               & Overloading_Prefix.all
               & Subp.Subp_Text_Name.all
               & (if Subp.Has_TC_Info
                 then "_" & Sanitize_TC_Name (Subp.TC_Info.Name.all)
                 else "")
               &  " (Gnattest_T : in out Test);");
            New_Line_Count;
            S_Put
              (3,
               "procedure "
               & Subp.Subp_Mangle_Name.all
               &  " (Gnattest_T : in out Test) renames "
               & Test_Routine_Prefix
               & Overloading_Prefix.all
               & Subp.Subp_Text_Name.all
               & (if Subp.Has_TC_Info
                 then "_" & Sanitize_TC_Name (Subp.TC_Info.Name.all)
                 else "")
               & ";");
            New_Line_Count;
         end if;
      else
         if Commented_Out then
            S_Put
              (3,
               "--  procedure "
               & Test_Routine_Prefix
               & Subp.Subp_Text_Name.all
               & (if Subp.Has_TC_Info
                 then "_" & Sanitize_TC_Name (Subp.TC_Info.Name.all)
                 else "")
               &  " (Gnattest_T : in out Test_"
               & Type_Name
               & ");");
            New_Line_Count;
            S_Put
              (3,
               "--  procedure "
               & Subp.Subp_Mangle_Name.all
               &  " (Gnattest_T : in out Test_"
               & Type_Name
               & ") renames "
               & Test_Routine_Prefix
               & Subp.Subp_Text_Name.all
               & (if Subp.Has_TC_Info
                 then "_" & Sanitize_TC_Name (Subp.TC_Info.Name.all)
                 else "")
               & ";");
            New_Line_Count;
         else
            S_Put
              (3,
               "procedure "
               & Test_Routine_Prefix
               & Overloading_Prefix.all
               & Subp.Subp_Text_Name.all
               & (if Subp.Has_TC_Info
                 then "_" & Sanitize_TC_Name (Subp.TC_Info.Name.all)
                 else "")
               &  " (Gnattest_T : in out Test_"
               & Type_Name
               & ");");
            New_Line_Count;
            S_Put
              (3,
               "procedure "
               & Subp.Subp_Mangle_Name.all
               &  " (Gnattest_T : in out Test_"
               & Type_Name
               & ") renames "
               & Test_Routine_Prefix
               & Overloading_Prefix.all
               & Subp.Subp_Text_Name.all
               & (if Subp.Has_TC_Info
                 then "_" & Sanitize_TC_Name (Subp.TC_Info.Name.all)
                 else "")
               & ";");
            New_Line_Count;
         end if;
      end if;

      S_Put
        (0,
         "--  id:"
         & Hash_Version
         & "/"
         & Subp.Subp_Full_Hash (Hash_First .. Hash_Last)
         & "/"
         & Subp.Subp_Text_Name.all
         & "/"
         & (if Use_Short_Name then "1" else "0")
         & "/"
         & (if Commented_Out then "1" else "0")
         & "/");
      if Subp.Has_TC_Info then
         S_Put
           (0,
            Sanitize_TC_Name (Subp.TC_Info.Name.all)
            & "/");
      end if;
      New_Line_Count;

      if Commented_Out then
         S_Put
           (3,
            "--  procedure "
            & Test_Routine_Prefix
            & Subp.Subp_Text_Name.all
            & (if Subp.Has_TC_Info
              then "_" & Sanitize_TC_Name (Subp.TC_Info.Name.all)
              else "")
            & " (Gnattest_T : in out ");
      else
         S_Put
           (3,
            "procedure "
            & Test_Routine_Prefix
            & Overloading_Prefix.all
            & Subp.Subp_Text_Name.all
            & (if Subp.Has_TC_Info
              then "_" & Sanitize_TC_Name (Subp.TC_Info.Name.all)
              else "")
            & " (Gnattest_T : in out ");
      end if;
      if Subp.Corresp_Type = 0 then
         S_Put (0, "Test) is");
      else
         S_Put
           (0,
            "Test_"
            & Type_Name
            & ") is");
      end if;

      New_Line_Count;

      if not Commented_Out then

         --  we cannot relate to any sloc in case of a dangling test

         if not Omit_Sloc then
            S_Put
              (3,
               "--  "
               & Base_Name
                 (To_String
                      (Text_Name
                           (Enclosing_Compilation_Unit
                              (Subp.Subp_Declaration))))
               & ":"
               & Trim
                 (Integer'Image
                      (First_Line_Number (Subp.Subp_Declaration)), Both)
               & ":"
               & Trim
                 (Integer'Image (First_Column_Number (Subp.Subp_Declaration)),
                  Both)
               & ":"
               & Subp.Subp_Name_Image.all);
            New_Line_Count;
         end if;

         if Subp.Has_TC_Info then
            Put_Wrapper_Rename (6, Subp);
         end if;
      end if;

      S_Put (0, "--  end read only");
      New_Line_Count;

   end Put_Opening_Comment_Section;

   ------------------------
   -- Put_Wrapper_Rename --
   ------------------------

   procedure Put_Wrapper_Rename (Span : Natural; Current_Subp : Subp_Info) is
   begin

      case Declaration_Kind (Current_Subp.Subp_Declaration) is
         when A_Function_Declaration             |
              An_Expression_Function_Declaration =>
            S_Put
              (Span,
               "function " &
                 Current_Subp.Subp_Name_Image.all);

            declare
               Params : constant
                 Asis.Parameter_Specification_List :=
                   Parameter_Profile
                     (Current_Subp.Subp_Declaration);

               Result : constant Asis.Element :=
                 Result_Profile (Current_Subp.Subp_Declaration);

               Result_Image : constant String :=
                 Trim (To_String (Element_Image (Result)),
                       Both);
            begin

               if Params'Length /= 0 then
                  S_Put (1, "(");
                  for I in Params'Range loop
                     S_Put
                       (0,
                        Trim
                          (To_String
                             (Element_Image (Params (I))),
                           Both));
                     if I = Params'Last then
                        S_Put (0, ")");
                     else
                        S_Put (0, "; ");
                     end if;
                  end loop;
               end if;

               S_Put (1, "return " & Result_Image);
            end;

         when A_Procedure_Declaration =>
            S_Put
              (3,
               "procedure " &
                 Current_Subp.Subp_Name_Image.all);

            declare
               Params : constant
                 Asis.Parameter_Specification_List :=
                   Parameter_Profile
                     (Current_Subp.Subp_Declaration);
            begin

               if Params'Length /= 0 then
                  S_Put (1, "(");
                  for I in Params'Range loop
                     S_Put
                       (0,
                        Trim
                          (To_String
                             (Element_Image (Params (I))),
                           Both));
                     if I = Params'Last then
                        S_Put (0, ")");
                     else
                        S_Put (0, "; ");
                     end if;
                  end loop;
               end if;
            end;

         when others => null;

      end case;

      S_Put
        (1,
         "renames "                        &
           Wrapper_Prefix                    &
           Current_Subp.Subp_Mangle_Name.all &
           ";");
      New_Line_Count;
   end Put_Wrapper_Rename;

   ----------------------
   -- Sanitize_TC_Name --
   ----------------------

   function Sanitize_TC_Name (TC_Name : String) return String
   is
      Name : String := Trim (TC_Name, Both);

      Tmp  : String_Access := new String'("");
      Buff : String_Access;

      Underscore : Boolean := True;
   begin

      for I in Name'Range loop

         if Name (I) = ' ' then
            Name (I) := '_';
         end if;

      end loop;

      for I in Name'Range loop

         if Underscore then
            if Name (I) /= '_' then
               Underscore := False;
               if Is_Letter (Name (I)) or else Is_Digit (Name (I)) then
                  Buff := new String'(Tmp.all & Name (I));
                  Free (Tmp);
                  Tmp := Buff;
                  Buff := null;
               end if;
            end if;
         else
            if
              Is_Letter (Name (I))
              or else Is_Digit (Name (I))
              or else Name (I) = '_'
            then
               Buff := new String'(Tmp.all & Name (I));
               Free (Tmp);
               Tmp := Buff;
               Buff := null;
               if Name (I) = '_' then
                  Underscore := True;
               end if;
            end if;
         end if;

      end loop;

      return To_Lower (Tmp.all);
   end Sanitize_TC_Name;

   -----------------------
   --  Source_Clean_Up  --
   -----------------------

   procedure Source_Clean_Up is
      Success : Boolean;
   begin
      if Last_Context_Name = null then
         return;
      end if;

      Delete_File (Last_Context_Name.all & ".adt", Success);
      if not Success then
         Report_Std ("gnattest: cannot delete " &
                     Last_Context_Name.all & ".adt");
      end if;

      if Main_Units.Is_Empty then
         --  We need to keep ALI files for incremental closure recomputation.
         Delete_File (Last_Context_Name.all & ".ali", Success);
         if not Success then
            Report_Std ("gnattest: cannot delete " &
                          Last_Context_Name.all & ".ali");
         end if;
      end if;

      Free (Last_Context_Name);
   end Source_Clean_Up;

   ------------
   -- Add_DT --
   ------------

   procedure Add_DT
     (TP_List : in out TP_Mapping_List.List;
      TPtarg  : String;
      Test_F  : String;
      Line    : Natural;
      Column  : Natural)
   is
      TP : TP_Mapping;
      TD : DT_Mapping;

      TP_Cur : TP_Mapping_List.Cursor := TP_List.First;
   begin

      TD.File := new String'(Test_F);
      TD.Line := Line;
      TD.Column := Column;

      loop
         exit when TP_Cur = TP_Mapping_List.No_Element;

         if TP_Mapping_List.Element (TP_Cur).TP_Name.all = TPtarg then
            exit;
         end if;

         TP_Mapping_List.Next (TP_Cur);
      end loop;

      TP := TP_Mapping_List.Element (TP_Cur);
      TP.DT_List.Append (TD);
      TP_List.Replace_Element (TP_Cur, TP);

   end Add_DT;

   ------------
   -- Add_TR --
   ------------

   procedure Add_TR
     (TP_List : in out TP_Mapping_List.List;
      TPtarg  : String;
      Test_F  : String;
      Test_T  : String;
      Subp    : Subp_Info;
      TR_Line : Natural := 1)
   is
      TC : TC_Mapping;
      TR : TR_Mapping;
      TP : TP_Mapping;

      TR_Cur : TR_Mapping_List.Cursor;
      TP_Cur : TP_Mapping_List.Cursor := TP_List.First;

      Subp_Span : constant Asis.Text.Span :=
        Element_Span (First_Name (Subp.Subp_Declaration));
      TC_Span   : constant Asis.Text.Span :=
        Element_Span (Subp.TC_Info.Elem);
   begin

      loop
         exit when TP_Cur = TP_Mapping_List.No_Element;

         if TP_Mapping_List.Element (TP_Cur).TP_Name.all = TPtarg then
            exit;
         end if;

         TP_Mapping_List.Next (TP_Cur);
      end loop;

      if TP_Cur = TP_Mapping_List.No_Element then
         TP.TP_Name := new String'(TPtarg);
         TR.TR_Name := new String'(Subp.Subp_Text_Name.all);
         TR.Line := Subp_Span.First_Line;
         TR.Column := Subp_Span.First_Column;
         if Subp.Has_TC_Info then
            TC.T_Name := new String'(Subp.Subp_Mangle_Name.all);
            TC.TC_Name := new String'(Subp.TC_Info.Name.all);
            TC.Line := TC_Span.First_Line;
            TC.Column := TC_Span.First_Column;
            TC.Test := new String'(Test_F);
            TC.Test_Time := new String'(Test_T);
            TC.TR_Line := TR_Line;
            TR.TC_List.Append (TC);
         else
            TR.Test := new String'(Test_F);
            TR.Test_Time := new String'(Test_T);
            TR.TR_Line := TR_Line;
            TR.T_Name := new String'(Subp.Subp_Mangle_Name.all);
         end if;

         TP.TR_List.Append (TR);
         TP_List.Append (TP);

         return;
      end if;

      TP := TP_Mapping_List.Element (TP_Cur);

      TR_Cur := TP.TR_List.First;
      loop
         exit when TR_Cur = TR_Mapping_List.No_Element;

         if
           TR_Mapping_List.Element (TR_Cur).Line = Subp_Span.First_Line and
           TR_Mapping_List.Element (TR_Cur).Column = Subp_Span.First_Column
         then
            exit;
         end if;

         TR_Mapping_List.Next (TR_Cur);
      end loop;

      if TR_Cur = TR_Mapping_List.No_Element then

         TR.TR_Name := new String'(Subp.Subp_Text_Name.all);
         TR.Line := Subp_Span.First_Line;
         TR.Column := Subp_Span.First_Column;
         if Subp.Has_TC_Info then
            TC.T_Name := new String'(Subp.Subp_Mangle_Name.all);
            TC.TC_Name := new String'(Subp.TC_Info.Name.all);
            TC.Line := TC_Span.First_Line;
            TC.Column := TC_Span.First_Column;
            TC.Test := new String'(Test_F);
            TC.Test_Time := new String'(Test_T);
            TC.TR_Line := TR_Line;
            TR.TC_List.Append (TC);
         else
            TR.Test := new String'(Test_F);
            TR.Test_Time := new String'(Test_T);
            TR.TR_Line := TR_Line;
            TR.T_Name := new String'(Subp.Subp_Mangle_Name.all);
         end if;

         TP.TR_List.Append (TR);
         TP_List.Replace_Element (TP_Cur, TP);

         return;
      end if;

      TR := TR_Mapping_List.Element (TR_Cur);

      --  The only way that there is same subprogram already is when it has
      --  test_cases. So no need to check if it has TC_Info.
      TC.T_Name := new String'(Subp.Subp_Mangle_Name.all);
      TC.TC_Name := new String'(Subp.TC_Info.Name.all);
      TC.Line := TC_Span.First_Line;
      TC.Column := TC_Span.First_Column;
      TC.Test := new String'(Test_F);
      TC.Test_Time := new String'(Test_T);
      TC.TR_Line := TR_Line;
      TR.TC_List.Append (TC);

      TP.TR_List.Replace_Element (TR_Cur, TR);
      TP_List.Replace_Element (TP_Cur, TP);

   end Add_TR;

   -----------------------
   -- Test_Types_Linked --
   -----------------------

   function Test_Types_Linked
     (Inheritance_Root_Type : Asis.Element;
      Inheritance_Final_Type : Asis.Element)
      return Boolean
   is
      Elem  : Asis.Element := Inheritance_Final_Type;
      Elem2 : Asis.Element := Inheritance_Root_Type;
   begin
      if Declaration_Kind (Inheritance_Root_Type) in
        A_Private_Type_Declaration | A_Private_Extension_Declaration
      then
         Elem2 := Corresponding_Type_Completion (Elem2);
      end if;

      loop
         if Is_Fully_Private (Elem) then
            return False;
         end if;

         exit when Is_Equal (Elem, Elem2);
         Elem := Parent_Type_Declaration (Elem);
      end loop;
      return True;
   end Test_Types_Linked;

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

end GNATtest.Skeleton.Generator;