------------------------------------------------------------------------------
--                                                                          --
--                           GNATTEST COMPONENTS                            --
--                                                                          --
--  G N A T T E S T  . S T U B . G E N E R A T O R . G A T H E R _ D A T A  --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                        Copyright (C) 2011, 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).              --
--                                                                          --
------------------------------------------------------------------------------

separate (GNATtest.Stub.Generator)
procedure Gather_Data
  (The_Unit          :     Asis.Compilation_Unit;
   Data              : out Data_Holder;
   Apropriate_Source : out Boolean)
is

   Unit_SF_Name : constant String :=
     String'(Base_Name (To_String (Text_Name (The_Unit))));
   --  Stores the full name of the file containing the unit.

   Control : Traverse_Control := Continue;

   Dummy_State : No_State := Not_Used;

   --  Temporal elements used to maintain readability.
   Tmp_CU        : Asis.Compilation_Unit;
   Tmp_Element   : Asis.Element;
   Gen_Unit_Name : String_Access;

   Type_Counter : Positive := 1;

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

   OL_Info : Overloading_Info.Map;

   --------------------------
   --  Inner Subprogramms  --
   --------------------------

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

   procedure Get_Records is new Traverse_Element
     (Pre_Operation     => First_Pre_Operation,
      Post_Operation    => No_Op,
      State_Information => No_State);
   --  Sets the vulue of Main_Type with the first tagged record element
   --  and checks that there's no more tagged records in the given unit.

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

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

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

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

   function Parent_Subtype_Unit_Original
     (Type_Decl  : Asis.Element;
      Is_Generic : Boolean) return Asis.Compilation_Unit;
   pragma Unreferenced (Parent_Subtype_Unit_Original);
   --  Equivalent to Enclosing_Compilation_Unit (Corresponding_Parent_Subtype)
   --  for most cases. In case of a generic tested package tries to treat
   --  parent declaration as if it was declared in a formal package.

   function Get_Nesting (Elem : Asis.Element) return String;
   --  Returns the full package prefix if the element.

   function Parent_In_Same_Unit (Elem : Asis.Element) return Boolean;
   --  For a tagged record extention definition declared in a nested package
   --  checks if at least one of the corresponding parent types is declared
   --  in the root surrounding package.

   function Root_Level_Parent (Element : Asis.Element) return Asis.Element;
   --  Returns declaration of first predecessor of given tagged type that is
   --  located at the root package level.
   --  Returns Nil_Element if all predecessors are located in inner packages.

   procedure Gather_Test_Cases (Subp : Subp_Info);
   --  Adds one subprogram-to-test per each test case;

   procedure Update_OL_Info (Name : String);

   -----------------------
   -- Gather_Test_Cases --
   -----------------------

   procedure Gather_Test_Cases (Subp : Subp_Info) is
      Pragma_List : constant Asis.Pragma_Element_List :=
        Corresponding_Pragmas (Subp.Subp_Declaration);

      Subp_Add : Subp_Info;

      TC : Test_Case_Info;

      TC_Hash, Result_Value : String_Access;

      GT_Prefix : constant String := "Gnattest_";

      Params_To_Temp : String_Set.Set;

      type Old_Attr_Loc is record
         El_Span : Span;
         Is_Func_With_Params : Boolean;
      end record;

      package Source_Locations is new
        Ada.Containers.Indefinite_Vectors (Positive, Old_Attr_Loc);
      use Source_Locations;

      Old_Attr_Ref : Source_Locations.Vector;

      function Get_Condition_Image (Elem : Asis.Element) return String;
      --  Returns element image as a single line removing all double spaces.

      function Get_Condition_Image
        (Lst : Asis_Element_List.List)
         return String;
      --  Returns "and"'ed element images in as a single line removing all
      --  double spaces.

      function Replace_Result_Attribute
        (Post   : String;
         F_Name : String;
         R_Name : String)
         return String;
      --  Replaces all entrances of function'Result in Post with R_Name.

      function Replace_Old_Attribute (Elem : Asis.Element) return String;
      --  Replaces all entrances of <expr>'old in Post with
      --  Gnattest_<expr>'Old in Elem's image.

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

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

      function Is_Function (Subp : Subp_Info) return Boolean;

      function Get_Condition_Image (Elem : Asis.Element) return String is

         Res, Tmp, Packed : String_Access;

         Idx   : Integer;
         Space : Boolean;

      begin

         Res := new String'(Replace_Old_Attribute (Elem));

         Tmp := new String'(Trim (Res.all, Both));
         Free (Res);
         Res := new String'(Tmp.all);
         Free (Tmp);

         Space := False;
         Packed := new String'("");
         Idx := Res'First;
         for I in Res'Range loop
            if Res (I) = ' ' then
               if not Space then
                  Space := True;
                  Tmp := new String'(Packed.all & " " & Res (Idx .. I - 1));
                  Free (Packed);
                  Packed := new String'(Tmp.all);
                  Free (Tmp);
               end if;
            else
               if Space then
                  Idx   := I;
                  Space := False;
               end if;
            end if;

            if I = Res'Last then
               Tmp := new String'(Packed.all & " " & Res (Idx .. I));
               Free (Packed);
               Packed := new String'(Tmp.all);
               Free (Tmp);
            end if;
         end loop;

         return Trim (Packed.all, Both);

      end Get_Condition_Image;

      function Get_Condition_Image
        (Lst : Asis_Element_List.List)
         return String
      is

         Res, Tmp, Packed : String_Access;

         Idx   : Integer;
         Space : Boolean;

         Cur : Asis_Element_List.Cursor;
      begin

         if Integer (Lst.Length) = 0 then
            return "True";
         end if;

         if Integer (Lst.Length) = 1 then
            return Get_Condition_Image (Lst.First_Element);
         end if;

         Res := new String'("((");

         Cur := Lst.First;

         loop
            if Cur = Asis_Element_List.No_Element then
               Tmp := new String'
                 (Res.all & "))");
               Free (Res);
               Res := new String'(Tmp.all);
               Free (Tmp);

               exit;
            end if;

            if Cur /= Lst.First then
               Tmp := new String'(Res.all & ") and (");
               Free (Res);
               Res := new String'(Tmp.all);
               Free (Tmp);
            end if;

            declare
               Image : constant Line_List :=
                 Lines (Asis_Element_List.Element (Cur));
            begin
               for I in Image'Range loop
                  Tmp := new String'
                    (Res.all & " " &
                     To_String (Non_Comment_Image (Image (I))));
                  Free (Res);
                  Res := new String'(Tmp.all);
                  Free (Tmp);
               end loop;
            end;

            Asis_Element_List.Next (Cur);
         end loop;

         Tmp := new String'(Trim (Res.all, Both));
         Free (Res);
         Res := new String'(Tmp.all);
         Free (Tmp);

         Space := False;
         Packed := new String'("");
         Idx := Res'First;
         for I in Res'Range loop
            if Res (I) = ' ' then
               if not Space then
                  Space := True;
                  Tmp := new String'(Packed.all & " " & Res (Idx .. I - 1));
                  Free (Packed);
                  Packed := new String'(Tmp.all);
                  Free (Tmp);
               end if;
            else
               if Space then
                  Idx   := I;
                  Space := False;
               end if;
            end if;

            if I = Res'Last then
               Tmp := new String'(Packed.all & " " & Res (Idx .. I));
               Free (Packed);
               Packed := new String'(Tmp.all);
               Free (Tmp);
            end if;
         end loop;

         return Trim (Packed.all, Both);

      end Get_Condition_Image;

      function Is_Function (Subp : Subp_Info) return Boolean is
      begin
         if
           Declaration_Kind (Subp.Subp_Declaration) = A_Function_Declaration
         then
            return True;
         else
            return False;
         end if;
      end Is_Function;

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

         Tmp : String_Access;

         Elem, Elem2 : Asis.Element;

         Func_Call : String_Access;

         Elem_Span : Old_Attr_Loc;
      begin

         if Element_Kind (Element) = An_Expression then
            if Expression_Kind (Element) = An_Attribute_Reference and then
              Attribute_Kind (Element) = An_Implementation_Defined_Attribute
            then
               Tmp := new String'
                 (To_String
                    (Name_Image (Attribute_Designator_Identifier (Element))));
               if To_Lower (Tmp.all) = "old" then
                  Elem_Span.El_Span := Element_Span (Element);

                  Elem := Prefix (Element);
                  Func_Call := new String'
                    (Trim (To_String (Element_Image (Elem)), Both));

                  loop
                     case Expression_Kind (Elem) is
                        when An_Explicit_Dereference |
                             An_Attribute_Reference  |
                             A_Function_Call         |
                             An_Indexed_Component    |
                             A_Selected_Component    |
                             A_Slice                 =>

                           Elem := Prefix (Elem);

                        when others =>
                           exit;
                     end case;
                  end loop;

                  --  constructing temp variable assignments
                  Free (Tmp);
                  Elem2 := Corresponding_Name_Declaration (Elem);
                  if Declaration_Kind (Elem2) = A_Function_Declaration then
                     Elem2 := Result_Profile (Elem2);
                     Tmp := new String'
                       (GT_Prefix                                      &
                        To_String (Name_Image (Elem))                  &
                        " : constant "                                 &
                        Trim (To_String (Element_Image (Elem2)), Both) &
                        " := "                                         &
                        Func_Call.all                                  &
                        ";");
                     Free (Func_Call);

                     if
                       Is_Nil (Parameter_Profile
                         (Corresponding_Name_Declaration (Elem)))
                     then
                        Elem_Span.Is_Func_With_Params := False;
                     else
                        Elem_Span.Is_Func_With_Params := True;
                     end if;
                     Old_Attr_Ref.Append (Elem_Span);
                  else
                     Elem2 := Object_Declaration_View (Elem2);
                     Tmp := new String'
                       (GT_Prefix                                      &
                        To_String (Name_Image (Elem))                  &
                        " : constant "                                 &
                        Trim (To_String (Element_Image (Elem2)), Both) &
                        " := "                                         &
                        To_String (Name_Image (Elem))                  &
                        ";");

                     Elem_Span.Is_Func_With_Params := False;
                     Old_Attr_Ref.Append (Elem_Span);
                  end if;

                  if Params_To_Temp.Find (Tmp.all) = String_Set.No_Element then
                     Params_To_Temp.Insert (Tmp.all);
                  end if;

               end if;
               Free (Tmp);
            end if;
         end if;

      end PC_Pre_Operation;

      function Replace_Old_Attribute (Elem : Asis.Element) return String
      is
         Elem_Span : constant Span := Element_Span (Elem);
         Cur_Span : Span;

         Prev_Line   : Line_Number_Positive        := Elem_Span.First_Line;
         Prev_Column : Character_Position_Positive := Elem_Span.First_Column;

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

         Control : Traverse_Control := Continue;

         Dummy_State : No_State := Not_Used;

         function Process_Attr_Ref
           (S       : String;
            Is_Func : Boolean)
            return String;

         function Process_Attr_Ref
           (S       : String;
            Is_Func : Boolean)
            return String
         is
            Res  : String_Access := new String'("");
            Tmp  : String_Access;
            Idx  : Integer := S'First;
            Idx2 : Integer;

            Bracket_Counter : Integer := 0;
         begin
            for I in S'Range loop
               if S (I) = ''' then
                  Idx2 := I + 1;
                  loop
                     if S (Idx2) = ' ' then
                        Idx2 := Idx2 + 1;
                     else
                        exit;
                     end if;
                  end loop;

                  if
                    Idx2 + 2 <= S'Last and then
                    To_Lower (S (Idx2 .. Idx2 + 2)) = "old"
                  then
                     Tmp := new String'(Res.all & S (Idx .. I - 1));
                     Free (Res);
                     Res := Tmp;
                     Tmp := null;

                     Idx := Idx2 + 3;
                  end if;
               end if;
            end loop;

            Tmp := new String'(Res.all & S (Idx .. S'Last));
            Free (Res);
            Res := Tmp;
            Tmp := null;

            if not Is_Func then
               return GT_Prefix & Trim (Res.all, Both);
            end if;

            for I in Res'Range loop
               if Res (I) = '(' then
                  if Bracket_Counter = 0 then
                     Idx := I;
                  end if;
                  Bracket_Counter := Bracket_Counter + 1;
               end if;

               if Res (I) = ')' then
                  if Bracket_Counter = 0 then
                     Idx2 := I;
                     exit;
                  end if;
                  Bracket_Counter := Bracket_Counter - 1;
               end if;
            end loop;

            Tmp := new String'
              (Res.all (Res'First .. Idx - 1) &
               " "                            &
               Res.all (Idx2 + 1 .. Res'Last));
            return
              GT_Prefix & Trim (Tmp.all, Both);

         end Process_Attr_Ref;

      begin

         if not Is_Nil (Elem) then
            Get_Postcondition_Image (Elem, Control, Dummy_State);
         end if;

         for K in Old_Attr_Ref.First_Index .. Old_Attr_Ref.Last_Index loop

            --  last unprocessed peice of image
            Cur_Span.First_Line   := Prev_Line;
            Cur_Span.First_Column := Prev_Column;
            if Old_Attr_Ref (K).El_Span.First_Column = 1 then
               Cur_Span.Last_Line    :=
                 Old_Attr_Ref (K).El_Span.First_Line - 1;
               Cur_Span.Last_Column  := 1;
            else
               Cur_Span.Last_Line    := Old_Attr_Ref (K).El_Span.First_Line;
               Cur_Span.Last_Column  :=
                 Old_Attr_Ref (K).El_Span.First_Column - 1;
            end if;

            declare
               Image : constant Line_List := Lines (Elem, Cur_Span);
            begin
               for I in Image'Range loop
                  Buff := new String'
                    (Result.all & " " &
                     To_String (Non_Comment_Image (Image (I))));
                  Free (Result);
                  Result := Buff;
                  Buff := null;
               end loop;
            end;

            --  current processed piece of image
            declare
               Image : constant Line_List :=
                 Lines (Elem, Old_Attr_Ref (K).El_Span);
               Tmp_Res : String_Access := new String'("");
            begin
               for I in Image'Range loop
                  Buff := new String'
                    (Tmp_Res.all & " " &
                     To_String (Non_Comment_Image (Image (I))));
                  Free (Tmp_Res);
                  Tmp_Res := Buff;
                  Buff := null;
               end loop;

               Buff := new String'
                 (Result.all &
                  Process_Attr_Ref
                    (Tmp_Res.all, Old_Attr_Ref (K).Is_Func_With_Params));
               Free (Tmp_Res);
               Free (Result);
               Result := Buff;
               Buff := null;

               if
                 Old_Attr_Ref (K).El_Span.Last_Column =
                 Length (Image (Old_Attr_Ref (K).El_Span.Last_Line))
               then
                  Prev_Line    := Old_Attr_Ref (K).El_Span.Last_Line + 1;
                  Prev_Column  := 1;
               else
                  Prev_Line    := Old_Attr_Ref (K).El_Span.Last_Line;
                  Prev_Column  := Old_Attr_Ref (K).El_Span.Last_Column + 1;
               end if;
            end;

         end loop;

         --  last unprocessed piece or the whole expression in case that no
         --  Old attribute present
         Cur_Span.First_Line   := Prev_Line;
         Cur_Span.First_Column := Prev_Column;
         Cur_Span.Last_Line    := Elem_Span.Last_Line;
         Cur_Span.Last_Column  := Elem_Span.Last_Column;
         if not Is_Nil (Cur_Span) then
            declare
               Image : constant Line_List := Lines (Elem, Cur_Span);
            begin
               for I in Image'Range loop
                  Buff := new String'
                    (Result.all & " " &
                     To_String (Non_Comment_Image (Image (I))));
                  Free (Result);
                  Result := Buff;
                  Buff := null;
               end loop;
            end;
         end if;

         Old_Attr_Ref.Clear;

         return Result.all;
      end Replace_Old_Attribute;

      function Replace_Result_Attribute
        (Post   : String;
         F_Name : String;
         R_Name : String)
         return String
      is
         Res : String_Access := new String'("");
         Tmp : String_Access;

         Quote : Boolean := False;

         Subp_Is_Operator : Boolean := False;
         Trying_Quote     : Boolean := False;

         F_Name_Length : constant Integer := F_Name'Length + 7;
         Idx           :          Integer := Post'First;
      begin

         if F_Name (Idx) = '"' then
            Subp_Is_Operator := True;
         end if;

         for I in Post'Range loop
            if Post (I) = '"' then
               if Quote then
                  if I = Post'Last or else Post (I + 1) /= '"' then
                     Quote := False;
                  end if;
               else
                  Quote := True;
                  if Subp_Is_Operator then
                     Trying_Quote := True;
                  end if;
               end if;
            end if;
            if not Quote or else Trying_Quote then

               Trying_Quote := False;

               if Post'Last >= I + F_Name_Length - 1 then
                  if
                    Post (I .. I + F_Name_Length - 1) = F_Name & "'Result"
                  then
                     Tmp := new String'
                       (Res.all             &
                        Post (Idx .. I - 1) &
                        R_Name);
                     Free (Res);
                     Res := new String'(Tmp.all);
                     Free (Tmp);
                     Idx := I + F_Name_Length;
                  end if;

               end if;

               if Post'Last >= I + F_Name_Length then
                  if
                    Post (I .. I + F_Name_Length) = F_Name & "' Result" or else
                    Post (I .. I + F_Name_Length) = F_Name & " 'Result"
                  then
                     Tmp := new String'
                       (Res.all             &
                        Post (Idx .. I - 1) &
                        R_Name);
                     Free (Res);
                     Res := new String'(Tmp.all);
                     Free (Tmp);
                     Idx := I + F_Name_Length + 1;
                  end if;

               end if;

               if Post'Last >= I + F_Name_Length + 1 then
                  if
                    Post (I .. I + F_Name_Length + 1) = F_Name & " ' Result"
                  then
                     Tmp := new String'
                       (Res.all             &
                        Post (Idx .. I - 1) &
                        R_Name);
                     Free (Res);
                     Res := new String'(Tmp.all);
                     Free (Tmp);
                     Idx := I + F_Name_Length + 2;
                  end if;

               end if;

               if Post'Last = I then

                  Tmp := new String'
                    (Res.all &
                     Post (Idx .. I));
                  Free (Res);
                  Res := new String'(Tmp.all);
                  Free (Tmp);
               end if;
            end if;
         end loop;

         return Res.all;
      end Replace_Result_Attribute;

   begin

      if Pragma_List'Length = 0 then
         Data.Subp_List.Append (Subp);
         return;
      end if;

      declare
         TC_Found : Boolean := False;
      begin
         for I in Pragma_List'Range loop
            if Pragma_Name_Image (Pragma_List (I)) = "Test_Case" then
               TC_Found := True;
               exit;
            end if;
         end loop;
         if not TC_Found then
            Data.Subp_List.Append (Subp);
            return;
         end if;
      end;

      if Subp.Is_Abstract then
         Data.Subp_List.Append (Subp);
         return;
      end if;

      for I in Pragma_List'Range loop
         if Pragma_Name_Image (Pragma_List (I)) = "Precondition" then
            declare
               Associations : constant Asis.Association_List :=
                 Pragma_Argument_Associations (Pragma_List (I));
            begin
               TC.Pre.Append (Associations (Associations'First));
            end;
         end if;
         if Pragma_Name_Image (Pragma_List (I)) = "Postcondition" then
            declare
               Associations : constant Asis.Association_List :=
                 Pragma_Argument_Associations (Pragma_List (I));
            begin
               TC.Post.Append (Associations (Associations'First));
            end;
         end if;
      end loop;

      for I in Pragma_List'Range loop
         if Pragma_Name_Image (Pragma_List (I)) = "Test_Case" then

            Subp_Add.Has_TC_Info := True;

            Subp_Add.Subp_Declaration := Subp.Subp_Declaration;
            Subp_Add.Is_Abstract      := Subp.Is_Abstract;
            Subp_Add.Corresp_Type     := Subp.Corresp_Type;
            Subp_Add.Nesting          := new String'(Subp.Nesting.all);
            Subp_Add.Subp_Text_Name   := new String'(Subp.Subp_Text_Name.all);
            Subp_Add.Subp_Name_Image  := new String'(Subp.Subp_Name_Image.all);

            declare
               Associations : constant Asis.Association_List :=
                 Pragma_Argument_Associations (Pragma_List (I));
               Idx : constant Integer := Associations'First;

            begin
               TC.Req  := Asis.Nil_Element;
               TC.Ens  := Asis.Nil_Element;

               --  setting up test case name
               TC.Name := new String'(To_String (Static_Expression_Value_Image
                 (Actual_Parameter (Associations (Idx)))));

               --  setting up test mode
               if
                 To_Lower (Trim (To_String (Element_Image (Actual_Parameter
                   (Associations (Idx + 1)))), Both)) = "nominal"
               then
                  TC.Mode := Normal;
               else
                  TC.Mode := Robustness;
               end if;

               --  setting up requires and ensures
               if
                 To_Lower (Trim (To_String (Element_Image (Formal_Parameter
                   (Associations (Idx + 2)))), Both)) = "requires"
               then
                  TC.Req := Actual_Parameter (Associations (Idx + 2));
                  if Associations'Length > 3 then
                     TC.Ens := Actual_Parameter (Associations (Idx + 3));
                  end if;
               else
                  TC.Ens := Actual_Parameter (Associations (Idx + 2));
               end if;
            end;

            --  creating second part of hash code for test routine name
            if TC.Mode = Normal then
               TC_Hash := new String'
                 (GNAT.SHA1.Digest
                    (TC.Name.all                   &
                     "#"                           &
                     Get_Condition_Image (TC.Pre)  &
                     "#"                           &
                     Get_Condition_Image (TC.Post) &
                     "#"                           &
                     Get_Condition_Image (TC.Req)  &
                     "#"                           &
                     Get_Condition_Image (TC.Ens)));
            else
               TC_Hash := new String'
                 (GNAT.SHA1.Digest
                    (TC.Name.all                  &
                     "#"                          &
                     Get_Condition_Image (TC.Req) &
                     "#"                          &
                     Get_Condition_Image (TC.Ens)));
            end if;

            if Is_Function (Subp) then
               Result_Value := new String'
                 (Subp.Subp_Mangle_Name.all                    &
                  "_"                                          &
                  TC_Hash (TC_Hash'First .. TC_Hash'First + 5) &
                  "_Result");
            end if;

            Subp_Add.Subp_Mangle_Name := new String'
              (Subp.Subp_Mangle_Name.all &
               "_"                       &
               TC_Hash (TC_Hash'First .. TC_Hash'First + 5));

            --  creating condition images
            if TC.Mode = Normal then

               if Is_Nil (TC.Req) then
                  TC.Req_Image := new String'(Get_Condition_Image (TC.Pre));
               else
                  if TC.Pre.Is_Empty then
                     TC.Req_Image := new String'
                       (Get_Condition_Image (TC.Req));
                  else
                     TC.Req_Image := new String'
                       ("("                          &
                        Get_Condition_Image (TC.Pre) &
                        ") and ("                    &
                        Get_Condition_Image (TC.Req) &
                        ")");
                  end if;
               end if;

               if Is_Nil (TC.Ens) then

                  if Is_Function (Subp) then
                     TC.Ens_Image := new String'
                       (Replace_Result_Attribute
                          (Get_Condition_Image (TC.Post),
                           Subp.Subp_Name_Image.all,
                           Result_Value.all));
                  else
                     TC.Ens_Image := new String'
                       (Get_Condition_Image (TC.Post));
                  end if;

               else

                  if Is_Function (Subp) then

                     if TC.Post.Is_Empty then
                        TC.Ens_Image := new String'
                          (Replace_Result_Attribute
                             (Get_Condition_Image (TC.Ens),
                              Subp.Subp_Name_Image.all,
                              Result_Value.all));
                     else
                        TC.Ens_Image := new String'
                          (Replace_Result_Attribute
                             ("("                           &
                              Get_Condition_Image (TC.Post) &
                              ") and ("                     &
                              Get_Condition_Image (TC.Ens)  &
                              ")",
                              Subp.Subp_Name_Image.all,
                              Result_Value.all));
                     end if;
                  else
                     if TC.Post.Is_Empty then
                        TC.Ens_Image := new String'
                          (Get_Condition_Image (TC.Ens));
                     else
                        TC.Ens_Image := new String'
                          ("("                           &
                           Get_Condition_Image (TC.Post) &
                           ") and ("                     &
                           Get_Condition_Image (TC.Ens)  &
                           ")");
                     end if;
                  end if;
               end if;

            else

               if Is_Nil (TC.Req) then
                  TC.Req_Image := new String'("");
               else
                  TC.Req_Image := new String'(Get_Condition_Image (TC.Req));
               end if;

               if Is_Nil (TC.Ens) then
                  TC.Ens_Image := new String'("");
               else

                  if Is_Function (Subp) then
                     TC.Ens_Image := new String'
                       (Replace_Result_Attribute
                          (Get_Condition_Image (TC.Ens),
                           Subp.Subp_Name_Image.all,
                           Result_Value.all));
                  else
                     TC.Ens_Image := new String'(Get_Condition_Image (TC.Ens));
                  end if;
               end if;
            end if;

            TC.Params_To_Temp := Params_To_Temp;
            Params_To_Temp.Clear;
            Subp_Add.TC_Info := TC;

            Data.Subp_List.Append (Subp_Add);

         end if;

      end loop;

      TC.Pre.Clear;
      TC.Post.Clear;

   end Gather_Test_Cases;

   -----------------
   -- Get_Nesting --
   -----------------

   function Get_Nesting (Elem : Asis.Element) return String is
      Res  : String_Access := new String'("");
      Buff : String_Access;

      Enclosing : Asis.Element;
   begin

      Enclosing := Enclosing_Element (Elem);

      loop

         exit when Is_Nil (Enclosing);

         if Res.all = "" then
            Free (Res);
            Res := new String'
              (To_String (Defining_Name_Image
               (First_Name (Enclosing))));
         else
            Buff :=
              new String'(To_String (Defining_Name_Image
                (First_Name (Enclosing))) &
                "." & Res.all);
            Free (Res);
            Res := new String'(Buff.all);
            Free (Buff);
         end if;

         Enclosing := Enclosing_Element (Enclosing);

      end loop;

      return Res.all;

   end Get_Nesting;

   ---------------------------
   --  First_Pre_Operation  --
   ---------------------------

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

      Tmp_Element : Asis.Element;
      Cur_Element : Asis.Element := Element;

      Type_Data        : Base_Type_Info;
      Nested_Type_Data : Type_Info;

      Type_Doubling : Boolean := False;

      Not_Nested_Parent : Asis.Element;
--        Not_Nested_Parent_Info : Base_Type_Info;
      Index : Integer := 0;

      procedure Get_Type_Parent_Data (Type_Data : in out Base_Type_Info);
      --  Gathers data on parent type.

      procedure Get_Type_Parent_Data (Type_Data : in out Base_Type_Info) is
         Cur_Element : constant Asis.Element := Type_Data.Main_Type_Elem;

         Parent_Type_Check      : Asis.Element;
         Parent_Unit_Check      : Asis.Compilation_Unit;
         Parent_Unit_Check_Name : String_Access;

         function Is_Interface_Declaration
           (Arg : Asis.Declaration) return Boolean;
         --  Detects if Arg is a declaration of an interface.

         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 Set_No_Parent (Type_Data : in out Base_Type_Info);
         --  Sets all data relevant to parent type to null/false.

         function Is_Fully_Private
           (Arg : Asis.Declaration) return Boolean
         is
            Corresp_Decl : Asis.Declaration;
         begin
            if Is_Private (Arg) then
               Corresp_Decl := Corresponding_Type_Declaration (Arg);
               if Is_Nil (Corresp_Decl) then
                  return True;
               else
                  return Is_Private (Corresp_Decl);
               end if;
            else
               return False;
            end if;
         end Is_Fully_Private;

         function Is_Interface_Declaration
           (Arg : Asis.Declaration) return Boolean
         is
         begin
            if Type_Kind (Type_Declaration_View (Arg)) =
              An_Interface_Type_Definition
            then
               return True;
            end if;

            return False;
         end Is_Interface_Declaration;

         procedure Set_No_Parent (Type_Data : in out Base_Type_Info) is
         begin
            Type_Data.Argument_Father_Type_Name := null;
            Type_Data.Argument_Father_Nesting   := null;
            Type_Data.Argument_Father_Unit_Name := null;
            Type_Data.Root_Nesting_Ancestor     := null;

            Type_Data.Has_Argument_Father       := False;
            Type_Data.Has_Root_Nesting_Ancestor := False;
            Type_Data.Parent_In_Same_Unit       := False;
         end Set_No_Parent;

      begin
         if
           Type_Kind (Type_Declaration_View (Cur_Element)) =
           A_Tagged_Record_Type_Definition
         then
            --  No parent type at all.
            Set_No_Parent (Type_Data);
            return;
         end if;
         Parent_Type_Check :=
           Parent_Type_Declaration (Cur_Element);
         if
           Is_Interface_Declaration (Parent_Type_Check) or else
           Is_Fully_Private (Parent_Type_Check)
         then
            --  Parent is an interface or fully private. No test package
            --  for parent type expected.
            Set_No_Parent (Type_Data);
            return;
         end if;
         Parent_Unit_Check :=
           Enclosing_Compilation_Unit
             (Parent_Type_Declaration (Cur_Element));

         Parent_Unit_Check_Name := new
           String'(Base_Name (To_String
             (Text_Name (Parent_Unit_Check))));
         if not Source_Present (Parent_Unit_Check_Name.all) then
            --  The unit containing parent type declaration is not among
            --  argument packages. No test package for parent type expected.
            Set_No_Parent (Type_Data);
            return;
         end if;

         Type_Data.Parent_In_Same_Unit :=
           Parent_In_Same_Unit (Cur_Element);

         Type_Data.Argument_Father_Type_Name := new
           String'(To_String (Defining_Name_Image
             (First_Name (Parent_Type_Check))));

         Type_Data.Argument_Father_Nesting := new
           String'(Get_Nesting (Parent_Type_Check));

         Type_Data.Argument_Father_Unit_Name := new
           String'(To_String (Unit_Full_Name (Parent_Unit_Check)));

         --  Parent type can be declared either in a nested package
         --  or at the root level. Checking parent type nesting.
         if Type_Data.Argument_Father_Unit_Name.all =
           Type_Data.Argument_Father_Nesting.all
         then
            --  Parent type is not nested. No need in extra info about
            --  non-nested ancestors.
            Type_Data.Root_Nesting_Ancestor     := null;
            Type_Data.Has_Root_Nesting_Ancestor := False;

            Type_Data.Has_Argument_Father := True;

            return;
         end if;

         --  Parent type is in a nested package.
         Not_Nested_Parent :=
           Root_Level_Parent (Type_Data.Main_Type_Elem);

         if
           Is_Nil (Not_Nested_Parent) or else
           Is_Interface_Declaration (Not_Nested_Parent) or else
           Is_Fully_Private (Not_Nested_Parent)
         then
            --  Parent type does not have any non-nested ancestors which are
            --  tagged types. No test package for parent type expected.
            Set_No_Parent (Type_Data);
            return;
         end if;

         --  Parent type has a non-nested ancestor. Checking
         --  if both parent type and it's non-nested ancestor
         --  are declared in the same compilation unit.
         if
           Is_Equal
             (Enclosing_Compilation_Unit (Not_Nested_Parent),
              Enclosing_Compilation_Unit (Parent_Type_Check))
         then

            --  Both nested parent type and it's non-nested
            --  ancestor are in the same CU. Corresponding
            --  test type hierarchy can be built.

            Type_Data.Root_Nesting_Ancestor :=
              new String'(To_String (Defining_Name_Image
                (First_Name (Not_Nested_Parent))));

            Type_Data.Has_Root_Nesting_Ancestor := True;
            Type_Data.Has_Argument_Father       := True;

         else

            --  Non-nested ancestor is declared in a different CU than parent
            --  type. This case is currently not supported by the tool.
            --  The type is treated as if it it has no argument father.

            Set_No_Parent (Type_Data);
         end if;

      end Get_Type_Parent_Data;

   begin

      if Is_Private (Element) then
         Control := Abandon_Siblings;
         return;
      end if;

      if Elements.Element_Kind (Cur_Element) = A_Declaration then

         --  Temporary stub to ignore generics
         if
           Declaration_Kind (Cur_Element) = A_Generic_Package_Declaration
         then
            Control := Abandon_Children;
         end if;

         if
           Declaration_Kind (Cur_Element) = An_Ordinary_Type_Declaration or
           Declaration_Kind (Cur_Element) = A_Private_Type_Declaration   or
           Declaration_Kind (Cur_Element) = A_Private_Extension_Declaration
         then
            Tmp_Element := Type_Declaration_View (Cur_Element);

            case Definition_Kind (Tmp_Element) is
               when A_Tagged_Private_Type_Definition |
                    A_Private_Extension_Definition =>

                  Cur_Element := Corresponding_Type_Declaration (Cur_Element);
                  Tmp_Element := Type_Declaration_View (Cur_Element);

               when others =>
                  null;
            end case;

            case Type_Kind (Tmp_Element) is

               when A_Tagged_Record_Type_Definition |
                    A_Derived_Record_Extension_Definition =>

                  Type_Data.Main_Type_Elem := Cur_Element;

                  case Trait_Kind (Tmp_Element) is

                     when An_Abstract_Trait                 |
                          An_Abstract_Private_Trait         |
                          An_Abstract_Limited_Trait         |
                          An_Abstract_Limited_Private_Trait =>

                        Type_Data.Main_Type_Abstract := True;

                     when others =>
                        Type_Data.Main_Type_Abstract := False;
                        Data.Needs_Set_Up := True;

                  end case;

                  --  Checking if any of ancestor types had a discriminant part
                  Tmp_Element := Cur_Element;
                  Type_Data.No_Default_Discriminant := False;
                  loop

                     exit when Is_Nil (Tmp_Element);

                     if not Is_Nil (Discriminant_Part (Tmp_Element)) then
                        Type_Data.No_Default_Discriminant := True;
                        exit;
                     end if;

                     Tmp_Element := Parent_Type_Declaration (Tmp_Element);
                  end loop;

                  --  Gathering basic data about type
                  Type_Data.Main_Type_Text_Name := new
                    String'(To_String (Defining_Name_Image
                      (First_Name (Type_Data.Main_Type_Elem))));
                  Type_Data.Nesting := new String'(Get_Nesting (Cur_Element));

                  Get_Type_Parent_Data (Type_Data);
                  Data.Needs_Fixtures := True;

                  --  checking for doubled types.
                  --  should change to childreb abandoning for private parts
                  for I in Data.Type_Data_List.First_Index ..
                    Data.Type_Data_List.Last_Index
                  loop
                     if
                       Is_Equal
                         (Data.Type_Data_List.Element (I).Main_Type_Elem,
                          Cur_Element)
                     then
                        Type_Doubling := True;
                        exit;
                     end if;
                  end loop;

                  --  If the collected type is on the root nesting level
                  --  it should go to the root list, otherwise it should be
                  --  appended to the correspondig list of nested descendants.
                  if not Type_Doubling then

                     Type_Data.Type_Number := Type_Counter;
                     Type_Counter          := Type_Counter + 1;

                     if
                       Type_Data.Nesting.all = Data.Unit_Full_Name.all
                     then
                        Data.Type_Data_List.Append (Type_Data);
                     else
                        Not_Nested_Parent :=
                          Root_Level_Parent (Type_Data.Main_Type_Elem);

                        if Is_Nil (Not_Nested_Parent)
                          or else
                          Get_Nesting (Not_Nested_Parent) /=
                          Data.Unit_Full_Name.all
                        then
                           Nested_Type_Data := Type_Info (Type_Data);
                           Data.Nested_Type_Data_List.Append
                             (Nested_Type_Data);
                        else
                           Type_Data.Root_Nesting_Ancestor :=
                             new String'(To_String (Defining_Name_Image
                               (First_Name (Not_Nested_Parent))));
                           Type_Data.Has_Root_Nesting_Ancestor := True;

                           for I in Data.Type_Data_List.First_Index ..
                             Data.Type_Data_List.Last_Index
                           loop
                              if
                                Is_Equal
                                  (Data.Type_Data_List.Element (I).
                                     Main_Type_Elem,
                                   Not_Nested_Parent)
                              then
                                 Index := I;
                                 exit;
                              end if;
                           end loop;

                           --  A stub for now. To add the handling types
                           --  without root level parents.
                           if Index /= 0 then
                              Nested_Type_Data := Type_Info (Type_Data);
                              Type_Data := Data.Type_Data_List.Element (Index);

                              Type_Data.Nested_Descendants.Append
                                (Nested_Type_Data);
                              Data.Type_Data_List.Replace_Element
                                (Index, Type_Data);
                           end if;
                        end if;
                     end if;
                  end if;

                  Control := Abandon_Children;

               when others =>
                  null;
            end case;

         end if;

      end if;

   end First_Pre_Operation;

   -------------------------
   -- Parent_In_Same_Unit --
   -------------------------

   function Parent_In_Same_Unit (Elem : Asis.Element) return Boolean is
      Unit_Decl  : constant Asis.Declaration := Unit_Declaration (The_Unit);
      Parent     :          Asis.Element     := Elem;
      Has_Parent :          Boolean          := False;
   begin

      loop
         exit when Type_Kind (Type_Declaration_View (Parent)) /=
           A_Derived_Record_Extension_Definition;

         Parent := Parent_Type_Declaration (Parent);
         if Is_Equal (Enclosing_Element (Parent), Unit_Decl) then
            Has_Parent := True;
            exit;
         end if;
      end loop;

      return Has_Parent;

   end Parent_In_Same_Unit;

   ------------------------------------
   --  Parent_Subtype_Unit_Original  --
   ------------------------------------

   function Parent_Subtype_Unit_Original
     (Type_Decl  : Asis.Element;
      Is_Generic : Boolean) return Asis.Compilation_Unit
   is
      Dec_Elem : Asis.Element :=
        Parent_Type_Declaration (Type_Decl);

      Old_Unit : constant Asis.Compilation_Unit :=
        Enclosing_Compilation_Unit (Type_Decl);

      New_Unit : constant Asis.Compilation_Unit :=
        Enclosing_Compilation_Unit (Dec_Elem);
   begin

      if not Is_Equal (New_Unit, Old_Unit) then
         return New_Unit;
      end if;

      --  If the unit is the same, that means that parent subtype is declared
      --  in the formal package declaration. We need to get the declaration of
      --  the corresponding generic package.

      Dec_Elem := Enclosing_Element (Dec_Elem);

      if Is_Generic then
         return
           Enclosing_Compilation_Unit
             (Corresponding_Generic_Package (Dec_Elem));
      else
         return New_Unit;
      end if;

   exception

      when Asis.Exceptions.ASIS_Inappropriate_Element =>
         return Asis.Nil_Compilation_Unit;

   end Parent_Subtype_Unit_Original;

   -----------------------
   -- Root_Level_Parent --
   -----------------------

   function Root_Level_Parent (Element : Asis.Element) return Asis.Element is
      Elem : Asis.Element := Parent_Type_Declaration (Element);
   begin

      loop
         exit when Is_Nil (Elem);

         if
           Get_Nesting (Elem) =
           To_String (Unit_Full_Name (Enclosing_Compilation_Unit (Elem)))
         then
            return Elem;
         end if;

         Elem := Parent_Type_Declaration (Elem);
      end loop;

      return Asis.Nil_Element;
   end Root_Level_Parent;

   ----------------------------
   --  Second_Pre_Operation  --
   ----------------------------

   procedure Second_Pre_Operation
     (Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out No_State)
   is
      Subp       : Subp_Info;
      Owner_Def  : Asis.Element;
      Owner_Decl : Asis.Element;

      Type_Found : Boolean;

      Nesteds : Type_Info_List.List;
      Cur     : Type_Info_List.Cursor;
   begin
      pragma Unreferenced (State);

      if Element_Kind (Element) = A_Declaration then

         case Declaration_Kind (Element) is

            --  Temporary stub to ignore generics
            when A_Generic_Package_Declaration =>
               Control := Abandon_Children;

            when A_Protected_Type_Declaration   |
                 A_Single_Protected_Declaration =>
               Control := Abandon_Children;

            when A_Procedure_Declaration          |
                 A_Function_Declaration           |
                 A_Procedure_Renaming_Declaration |
                 A_Function_Renaming_Declaration  =>

               Subp.Subp_Declaration := Element;
               Subp.Subp_Text_Name   :=
                 new String'(Get_Subp_Name (Element));
               Subp.Subp_Name_Image   := new String'
                 (To_String (Defining_Name_Image (First_Name (Element))));
               Subp.Nesting := new String'(Get_Nesting (Element));

               case Trait_Kind (Element) is
                  when An_Abstract_Trait =>
                     Subp.Is_Abstract := True;
                  when others =>
                     Subp.Is_Abstract      := False;
                     Data.Needs_Assertions := True;
               end case;

               if Is_Dispatching_Operation (Element) then
                  Owner_Def  := Primitive_Owner (Element);
                  Owner_Decl := Enclosing_Element (Owner_Def);

                  case Definition_Kind (Owner_Def) is
                     when A_Private_Extension_Definition   |
                          A_Tagged_Private_Type_Definition =>
                        Owner_Decl :=
                          Corresponding_Type_Declaration (Owner_Decl);
                     when others =>
                        null;
                  end case;

                  Type_Found := False;
                  for
                    I in Data.Type_Data_List.First_Index ..
                         Data.Type_Data_List.Last_Index
                  loop

                     if
                       Is_Equal
                         (Data.Type_Data_List.Element (I).Main_Type_Elem,
                          Owner_Decl)
                     then
                        Subp.Corresp_Type :=
                          Data.Type_Data_List.Element (I).Type_Number;
                        Subp.Subp_Mangle_Name := new
                          String'(Mangle_Hash (Element,
                            Data.Type_Data_List.Element (I).Main_Type_Elem));
                        Type_Found := True;
                        exit;
                     else
                        Nesteds :=
                          Data.Type_Data_List.Element (I).Nested_Descendants;
                        Cur := Nesteds.First;
                        loop
                           exit when Cur = Type_Info_List.No_Element;

                           if
                             Is_Equal
                               (Type_Info_List.Element (Cur).Main_Type_Elem,
                                Owner_Decl)
                           then
                              Subp.Corresp_Type :=
                                Type_Info_List.Element (Cur).Type_Number;
                              Subp.Subp_Mangle_Name := new String'
                                (Mangle_Hash (Element,
                                 Type_Info_List.Element (Cur).Main_Type_Elem));
                              Type_Found := True;
                              exit;
                           end if;

                           Type_Info_List.Next (Cur);
                        end loop;
                     end if;

                  end loop;
               else
                  --  In simple case the type is always found, because in fact
                  --  we do not depend on it.
                  Type_Found            := True;
                  Subp.Corresp_Type     := 0;
                  Subp.Subp_Mangle_Name := new
                    String'(Mangle_Hash (Element, Asis.Nil_Element));
                  Data.Has_Simple_Case  := True;
                  Data.Needs_Fixtures   := True;
                  Data.Needs_Set_Up     := True;
                  Data.Needs_Assertions := True;
               end if;

               if not (Subp.Is_Abstract and not
                         Is_Dispatching_Operation (Element))
               then
                  if Type_Found then

                     Update_OL_Info (Subp.Subp_Text_Name.all);
                     Subp.OL_Number :=
                       OL_Info.Element (Subp.Subp_Text_Name.all);

                     if Test_Case then
                        Gather_Test_Cases (Subp);
                     else
                        Data.Subp_List.Append (Subp);
                     end if;
                  end if;
               end if;

               Control := Abandon_Children;

            when others =>
               null;

         end case;

      end if;

   end Second_Pre_Operation;

   -------------------------
   -- Third_Pre_Operation --
   -------------------------

   procedure Third_Pre_Operation
     (Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out No_State)
   is
      Package_Data : Package_Info;
   begin
      pragma Unreferenced (State);

      if Element_Kind (Element) = A_Declaration then

         if Is_Private (Element) then
            Control := Abandon_Siblings;
            return;
         end if;

         case Declaration_Kind (Element) is

            when A_Package_Declaration =>
               Package_Data.Name := new String'
                 (Get_Nesting (Element) & "." &
                  To_String (Defining_Name_Image (First_Name (Element))));
               Package_Data.Is_Generic := False;
               Package_Data.Data_Kind := Declaration_Data;
               Data.Package_Data_List.Append (Package_Data);

            when A_Generic_Package_Declaration =>
               --  Temporary stub to ignore generics
               Control := Abandon_Children;

--                 Package_Data.Name := new String'
--                   (Get_Nesting (Element) & "." &
--                    To_String (Defining_Name_Image (First_Name (Element))));
--                 Package_Data.Is_Generic := True;
--                 Package_Data.Data_Kind := Declaration_Data;
--                 Data.Package_Data_List.Append (Package_Data);

            when A_Package_Instantiation =>
               Package_Data.Name := new String'
                 (Get_Nesting (Element) & "." &
                  To_String (Defining_Name_Image (First_Name (Element))));
               Package_Data.Data_Kind := Instantiation;
               Data.Package_Data_List.Append (Package_Data);
               Control := Abandon_Children;

            when others =>
               null;
         end case;

      end if;

   end Third_Pre_Operation;

   --------------------
   -- Update_OL_Info --
   --------------------

   procedure Update_OL_Info (Name : String) is
      Cur : Overloading_Info.Cursor;
      T : Natural;
   begin
      Cur := OL_Info.Find (Name);
      if Cur = Overloading_Info.No_Element then
         OL_Info.Insert (Name, 0);
      else
         T := Overloading_Info.Element (Cur);
         OL_Info.Replace_Element (Cur, T + 1);
      end if;
   end Update_OL_Info;

begin

   case Declaration_Kind (Unit_Declaration (The_Unit)) is

      when A_Package_Declaration =>
         Data.Is_Generic := False;

      when A_Generic_Package_Declaration =>
         Data.Is_Generic := True;

      when A_Package_Instantiation =>
         if Get_Source_Status (Unit_SF_Name) = Waiting then
--              Set_Source_Status (Unit_SF_Name, Pending);
            Set_Source_Status (Unit_SF_Name, Processed);
            Apropriate_Source := False;
            return;
         end if;

         Tmp_Element := Normalize_Reference
           (Generic_Unit_Name (Unit_Declaration (The_Unit)));

         Tmp_CU := Enclosing_Compilation_Unit
           (Corresponding_Name_Declaration (Tmp_Element));

         Gen_Unit_Name :=
           new String'(Base_Name (To_String (Text_Name (Tmp_CU))));

         --  Checking if corresponding generic package is an argument package.
         if not Source_Present (Gen_Unit_Name.all) then
            Set_Source_Status (Unit_SF_Name, Bad_Inheritance);
            Apropriate_Source := False;
            Free (Gen_Unit_Name);
            return;
         end if;

         if Get_Source_Status (Gen_Unit_Name.all) /= Processed then
            Set_Source_Status (Unit_SF_Name, Bad_Inheritance);
            Apropriate_Source := False;
            Free (Gen_Unit_Name);
            return;
         end if;

         Data :=
           (Data_Kind      => Instantiation,
            Unit           => The_Unit,
            Unit_Full_Name =>
               new String'(To_String (Unit_Full_Name (The_Unit))),
            Unit_File_Name =>
               new String'(Base_Name (To_String (Text_Name (The_Unit)))),
            Gen_Unit => Tmp_CU,
            Gen_Unit_Full_Name  =>
               new String'(To_String (Unit_Full_Name (Tmp_CU))),
            Gen_Unit_File_Name  =>
               new String'(Gen_Unit_Name.all));

         Free (Gen_Unit_Name);
         Apropriate_Source := True;
         return;

      when others =>

         Report_Std
           ("gnattest: "                                &
            Base_Name (To_String (Text_Name (The_Unit))) &
            " is an unsuported kind of unit.");

         Apropriate_Source := False;
         Set_Source_Status (Unit_SF_Name, Bad_Content);
         return;

   end case;

   Data.Unit           := The_Unit;
   Data.Unit_Full_Name := new String'(To_String (Unit_Full_Name (The_Unit)));
   Data.Unit_File_Name :=
     new String'(Base_Name (To_String (Text_Name (The_Unit))));

   Get_Nested_Packages (Unit_Declaration (The_Unit), Control, Dummy_State);

   Get_Records (Unit_Declaration (The_Unit), Control, Dummy_State);

   Get_Subprograms (Unit_Declaration (The_Unit), Control, Dummy_State);

   if Data.Type_Data_List.Is_Empty and Data.Subp_List.Is_Empty then
      Apropriate_Source := False;
      Set_Source_Status (Unit_SF_Name, Processed_In_Vain);
   else
      Apropriate_Source := True;
   end if;

   OL_Info.Clear;

end Gather_Data;
