File : asis-compilation_units.adb


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                A S I S . C O M P I L A T I O N _ U N I T S               --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            Copyright (c) 1995-1999, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General  --
-- Public License for more details. You should have received a copy of the  --
-- GNU General Public License  distributed with ASIS-for-GNAT; see file     --
-- COPYING. If not, write to the Free Software Foundation,  59 Temple Place --
-- - Suite 330,  Boston, MA 02111-1307, USA.                                --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  Ada Core Technologies Inc --
-- (http://www.gnat.com).                                                   --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;


with Asis.Errors;             use Asis.Errors;
with Asis.Exceptions;         use Asis.Exceptions;
with Asis.Extensions;         use Asis.Extensions;

with Asis.Set_Get;            use  Asis.Set_Get;

with A4G.A_Opt;               use A4G.A_Opt;
with A4G.A_Output;            use A4G.A_Output;
with A4G.Vcheck;              use A4G.Vcheck;
with A4G.Get_Unit;            use A4G.Get_Unit;
with A4G.Contt;               use A4G.Contt;
with A4G.Contt.UT;            use A4G.Contt.UT;

with Atree;                   use Atree;
with Types;                   use Types;
with Lib;                     use Lib;

package body Asis.Compilation_Units is

   --  !!!??? This file is '-gnatg-compilable', but both its content and its
   --  !!!???  documentation need revising

   function "=" (Left, Right : Compilation_Unit) return Boolean
      renames Asis.Set_Get."=";

------------------------------------------------------------------------------

   function Unit_Kind (Compilation_Unit : in Asis.Compilation_Unit)
                      return Asis.Unit_Kinds is
   begin
      Check_Validity (Compilation_Unit, "Asis.Compilation_Units.Unit_Kind");
      return Kind (Compilation_Unit);
   end Unit_Kind;
-----------------------------------------------------------------------------

   function Unit_Class (Compilation_Unit : in Asis.Compilation_Unit)
                       return Asis.Unit_Classes is
   begin
      Check_Validity (Compilation_Unit, "Asis.Compilation_Units.Unit_Class");
      Reset_Context (Encl_Cont_Id (Compilation_Unit));
      return Class (Compilation_Unit);
   end Unit_Class;
-----------------------------------------------------------------------------

   function Unit_Origin (Compilation_Unit : in Asis.Compilation_Unit)
                   return Asis.Unit_Origins is
   begin
      Check_Validity (Compilation_Unit,
               "Asis.Compilation_Units.Unit_Origin");
      Reset_Context (Encl_Cont_Id (Compilation_Unit));
      return Origin (Compilation_Unit);
   end Unit_Origin;
-----------------------------------------------------------------------------

   function Enclosing_Context (Compilation_Unit : in Asis.Compilation_Unit)
                              return Asis.Context is
   begin
      Check_Validity (Compilation_Unit,
                      "Asis.Compilation_Units.Enclosing_Context");

      if Is_Nil (Compilation_Unit) then
         Raise_ASIS_Inappropriate_Compilation_Unit
                 (Diagnosis => "Asis.Compilation_Units.Enclosing_Context");
      else
         return Encl_Cont (Compilation_Unit);
      end if;
   end Enclosing_Context;
------------------------------------------------------------------------------
   function Enclosing_Container
     (Compilation_Unit : in Asis.Compilation_Unit)
      return Asis.Ada_Environments.Containers .Container is
   begin
      Check_Validity (Compilation_Unit,
                      "Asis.Compilation_Units.Enclosing_Container");

      if Is_Nil (Compilation_Unit) then
         Raise_ASIS_Inappropriate_Compilation_Unit
                 (Diagnosis => "Asis.Compilation_Units.Enclosing_Container");
      else
         Not_Implemented_Yet (Diagnosis =>
                          "Asis.Compilation_Units.Enclosing_Container");
         return Asis.Ada_Environments.Containers.Nil_Container;
         --  to make the code syntactically correct
      end if;
   end Enclosing_Container;
------------------------------------------------------------------------------

   function Library_Unit_Declaration
     (Name        : in Wide_String;
      The_Context : in Asis.Context)
      return Asis.Compilation_Unit
   is
      Result_Id   : Unit_Id;
      Result_Cont : Context_Id;
   begin

      Check_Validity (The_Context,
               "Asis.Compilation_Units.Library_Unit_Declaration");

      Result_Cont := Get_Cont_Id (The_Context);
      Reset_Context (Result_Cont);
      Result_Id := Get_One_Unit (To_String (Name), Result_Cont, Spec => True);

      return Get_Comp_Unit (Result_Id, Result_Cont);

   exception
       when Program_Error =>
         raise;
      when ASIS_Inappropriate_Context =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
               "Asis.Compilation_Units.Library_Unit_Declaration");
         raise;
      when others      =>
         Raise_ASIS_Failed (
               "Asis.Compilation_Units.Library_Unit_Declaration");
   end Library_Unit_Declaration;
-----------------------------------------------------------------------------

   function Compilation_Unit_Body
     (Name        : in Wide_String;
      The_Context : in Asis.Context)
      return Asis.Compilation_Unit
   is
      Result_Id   : Unit_Id;
      Result_Cont : Context_Id;
   begin

      Check_Validity (The_Context,
               "Asis.Compilation_Units.Library_Unit_Body");

      Result_Cont := Get_Cont_Id (The_Context);
      Reset_Context (Result_Cont);
      Result_Id := Get_One_Unit (To_String (Name), Result_Cont, Spec => False);

      return Get_Comp_Unit (Result_Id, Result_Cont);
   exception

       when Program_Error =>
         raise;
      when ASIS_Inappropriate_Context =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
               "Asis.Compilation_Units.Library_Unit_Body");
         raise;
      when others      =>
         Raise_ASIS_Failed (
                "Asis.Compilation_Units.Library_Unit_Body");
   end Compilation_Unit_Body;
------------------------------------------------------------------------------
   function Library_Unit_Declarations
     (The_Context : in Asis.Context)
      return Asis.Compilation_Unit_List
   is
      Res_Cont_Id    : Context_Id := Get_Cont_Id (The_Context);
      Cont_Tree_Mode : Tree_Mode;
   begin
      Check_Validity (The_Context,
               "Asis.Compilation_Units.Library_Unit_Declarations");

      Cont_Tree_Mode := Tree_Processing_Mode (Res_Cont_Id);

      if Cont_Tree_Mode /= Pre_Created then
         Not_Implemented_Yet (Diagnosis =>
                  "Asis.Compilation_Units.Library_Unit_Declarations");
      end if;

      Reset_Context (Res_Cont_Id);

      declare
         Result_Len : Natural := Lib_Unit_Decls (Res_Cont_Id);
         Result     : Compilation_Unit_List (1 .. Result_Len);
         L_U_Decl   : Unit_Id := First_Unit_Id; --  Standard
      begin
         for I in 1 .. Result_Len loop
            Result (I) := Get_Comp_Unit (L_U_Decl,  Res_Cont_Id);
            L_U_Decl   := Next_Decl (Res_Cont_Id, L_U_Decl);
         end loop;
         return Result;
      end;
   exception
      when ASIS_Inappropriate_Context =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
                     "Asis.Compilation_Units.Library_Unit_Declarations");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
                     "Asis.Compilation_Units.Library_Unit_Declarations");
   end Library_Unit_Declarations;
------------------------------------------------------------------------------

   function Compilation_Unit_Bodies
     (The_Context : in Asis.Context)
      return Asis.Compilation_Unit_List
   is
      Res_Cont_Id : Context_Id := Get_Cont_Id (The_Context);
      Cont_Tree_Mode : Tree_Mode;
   begin
      Check_Validity (The_Context,
               "Asis.Compilation_Units.Compilation_Unit_Bodies");

      Cont_Tree_Mode := Tree_Processing_Mode (Res_Cont_Id);

      if Cont_Tree_Mode /= Pre_Created then
         Not_Implemented_Yet (Diagnosis =>
                  "Asis.Compilation_Units.Compilation_Unit_Bodies");
      end if;

      Reset_Context (Res_Cont_Id);

      declare
         Result_Len : Natural := Comp_Unit_Bodies (Res_Cont_Id);
         Result     : Compilation_Unit_List (1 .. Result_Len);
         L_U_Body   : Unit_Id := First_Body (Res_Cont_Id);
      begin
         for I in 1 .. Result_Len loop
            Result (I) := Get_Comp_Unit (L_U_Body,  Res_Cont_Id);
            L_U_Body   := Next_Body (Res_Cont_Id, L_U_Body);
         end loop;
         return Result;
      end;
   exception
      when ASIS_Inappropriate_Context =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
                     "Asis.Compilation_Units.Compilation_Unit_Bodies");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
                     "Asis.Compilation_Units.Compilation_Unit_Bodies");
   end Compilation_Unit_Bodies;
------------------------------------------------------------------------------

   function Compilation_Units
     (The_Context : in Asis.Context)
      return Asis.Compilation_Unit_List
   is
      Res_Cont_Id    : Context_Id := Get_Cont_Id (The_Context);
      Cont_Tree_Mode : Tree_Mode;
   begin
      Check_Validity (The_Context,
               "Asis.Compilation_Units.Compilation_Units");

      Cont_Tree_Mode := Tree_Processing_Mode (Res_Cont_Id);
      if Cont_Tree_Mode /= Pre_Created then
         Not_Implemented_Yet (Diagnosis =>
                  "Asis.Compilation_Units.Compilation_Units");
      end if;

      Reset_Context (Res_Cont_Id);

      declare
         Result_Len : Natural := Lib_Unit_Decls   (Res_Cont_Id) +
                                 Comp_Unit_Bodies (Res_Cont_Id);
         Result     : Compilation_Unit_List (1 .. Result_Len);
      begin
         for I in 1 .. Result_Len loop
            Result (I) := Get_Comp_Unit
                            (First_Unit_Id + Unit_Id (I) - 1, Res_Cont_Id);
         end loop;
         return Result;
      end;

   exception
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
                     "Asis.Compilation_Units.Compilation_Units");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
                     "Asis.Compilation_Units.Compilation_Units");
   end Compilation_Units;
------------------------------------------------------------------------------

   function Corresponding_Children (Library_Unit : in Asis.Compilation_Unit)
      return Asis.Compilation_Unit_List
   is
      Arg_Kind    : Asis.Unit_Kinds;
      Arg_Unit_Id : Unit_Id;
      Res_Cont_Id : Context_Id;
      Cont_Tree_Mode : Tree_Mode;
   begin
      Check_Validity (Library_Unit,
               "Asis.Compilation_Units.Corresponding_Children");

      Res_Cont_Id := Encl_Cont_Id (Library_Unit);
      Reset_Context (Res_Cont_Id);
      Arg_Kind := Kind (Library_Unit);

      if not (Arg_Kind = A_Package               or else
              Arg_Kind = A_Generic_Package       or else
              Arg_Kind = A_Package_Instance)
      then
         Raise_ASIS_Inappropriate_Compilation_Unit (Diagnosis =>
            "Asis.Compilation_Units.Corresponding_Children");
      end if;

      Cont_Tree_Mode := Tree_Processing_Mode (Res_Cont_Id);

      if Cont_Tree_Mode /= Pre_Created then
         Not_Implemented_Yet (Diagnosis =>
                  "Asis.Compilation_Units.Corresponding_Children");
      end if;

      Arg_Unit_Id := Get_Unit_Id  (Library_Unit);

      declare
         Result_Id_List : Unit_Id_List renames
            Children (Res_Cont_Id, Arg_Unit_Id);
         Result_List : Compilation_Unit_List renames
                             Get_Comp_Unit_List (Result_Id_List, Res_Cont_Id);
      begin
         return Result_List;
      end;

   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
                     "Asis.Compilation_Units.Corresponding_Children");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
                     "Asis.Compilation_Units.Corresponding_Children");
   end Corresponding_Children;

   function Corresponding_Children
     (Library_Unit : in Asis.Compilation_Unit;
      The_Context  : in Asis.Context)
      return Asis.Compilation_Unit_List
   is
      Arg_Kind        : Asis.Unit_Kinds;
      Arg_Unit_Id     : Unit_Id;
      Arg_Cont_Id     : Context_Id;
      Result_Cont_Id  : Context_Id;
      New_Arg_Unit_Id : Unit_Id;
      Cont_Tree_Mode : Tree_Mode;
   begin
      Check_Validity (The_Context,
               "Asis.Compilation_Units.Corresponding_Children");

      Check_Validity (Library_Unit,
               "Asis.Compilation_Units.Corresponding_Children");

      Arg_Cont_Id := Encl_Cont_Id (Library_Unit);
      Reset_Context (Arg_Cont_Id);
      Arg_Kind := Kind (Library_Unit);

      if not (Arg_Kind = A_Package               or else
              Arg_Kind = A_Generic_Package       or else
              Arg_Kind = A_Package_Instance)
      then
         Raise_ASIS_Inappropriate_Compilation_Unit (Diagnosis =>
            "Asis.Compilation_Units.Corresponding_Children");
      end if;

      Result_Cont_Id  := Get_Cont_Id  (The_Context);
      Cont_Tree_Mode := Tree_Processing_Mode (Result_Cont_Id);

      if Cont_Tree_Mode /= Pre_Created then
         Not_Implemented_Yet (Diagnosis =>
                  "Asis.Compilation_Units.Corresponding_Children");
      end if;

      Arg_Unit_Id     := Get_Unit_Id  (Library_Unit);

      New_Arg_Unit_Id := Get_Same_Unit
                           (Arg_Cont_Id, Arg_Unit_Id, Result_Cont_Id);

      if Present (New_Arg_Unit_Id) then
         return Corresponding_Children
                  (Get_Comp_Unit (New_Arg_Unit_Id, Result_Cont_Id));
      else
         return Nil_Compilation_Unit_List;
      end if;

   exception
      when   ASIS_Inappropriate_Compilation_Unit
           | ASIS_Inappropriate_Context          =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
                     "Asis.Compilation_Units.Corresponding_Children");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
                     "Asis.Compilation_Units.Corresponding_Children");
   end Corresponding_Children;
------------------------------------------------------------------------------
   function Corresponding_Parent_Declaration
     (Library_Unit : in Asis.Compilation_Unit)
      return Asis.Compilation_Unit
   is
      Arg_Kind    : Asis.Unit_Kinds;
      Arg_Unit_Id : Unit_Id;
      Res_Cont_Id : Context_Id;
      Result_Id   : Unit_Id;
   begin

      Check_Validity (Library_Unit,
               "Asis.Compilation_Units.Corresponding_Parent_Declaration");

      Res_Cont_Id := Encl_Cont_Id (Library_Unit);
      Reset_Context (Res_Cont_Id);
      Arg_Kind := Kind (Library_Unit);

      if not (Arg_Kind = A_Procedure                  or else
              Arg_Kind = A_Function                   or else
              Arg_Kind = A_Package                    or else
              Arg_Kind = A_Generic_Procedure          or else
              Arg_Kind = A_Generic_Function           or else
              Arg_Kind = A_Generic_Package            or else
              Arg_Kind = A_Procedure_Instance         or else
              Arg_Kind = A_Function_Instance          or else
              Arg_Kind = A_Package_Instance           or else
              Arg_Kind = A_Procedure_Renaming         or else
              Arg_Kind = A_Function_Renaming          or else
              Arg_Kind = A_Package_Renaming           or else
              Arg_Kind = A_Generic_Procedure_Renaming or else
              Arg_Kind = A_Generic_Function_Renaming  or else
              Arg_Kind = A_Generic_Package_Renaming   or else
              Arg_Kind = A_Procedure_Body             or else
              Arg_Kind = A_Function_Body              or else
              Arg_Kind = A_Package_Body)
      then
         Raise_ASIS_Inappropriate_Compilation_Unit (Diagnosis =>
            "Asis.Compilation_Units.Corresponding_Parent_Declaration");
      end if;

      Arg_Unit_Id := Get_Unit_Id  (Library_Unit);
      Result_Id   := Get_Parent_Unit (Res_Cont_Id, Arg_Unit_Id);

      --  Result_Id cannot be Nil_Unit here

--      if not Is_Consistent (Res_Cont_Id, Result_Id, Arg_Unit_Id) then
--         --  the corresponding nonexistent declaration should be returned
--         Result_Id := Get_Nonexistent_Unit (Res_Cont_Id);
--      end if;

      return Get_Comp_Unit (Result_Id, Res_Cont_Id);

   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         if Status_Indicator /= Obsolete_Reference_Error then
            Add_Call_Information (Outer_Call =>
             "Asis.Compilation_Units.Corresponding_Parent_Declaration");
         end if;
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
          "Asis.Compilation_Units.Corresponding_Parent_Declaration");
   end Corresponding_Parent_Declaration;

   function Corresponding_Parent_Declaration
     (Library_Unit : in Asis.Compilation_Unit;
      The_Context  : in Asis.Context)
      return Asis.Compilation_Unit
   is
      Arg_Kind        : Asis.Unit_Kinds;
      Arg_Unit_Id     : Unit_Id;
      Arg_Cont_Id     : Context_Id;
      Result_Cont_Id  : Context_Id;
      New_Arg_Unit_Id : Unit_Id;
   begin
      Check_Validity (The_Context,
               "Asis.Compilation_Units.Corresponding_Parent_Declaration");

      Check_Validity (Library_Unit,
               "Asis.Compilation_Units.Corresponding_Parent_Declaration");

      Arg_Cont_Id := Encl_Cont_Id (Library_Unit);
      Reset_Context (Arg_Cont_Id);
      Arg_Kind := Kind (Library_Unit);

      if not (Arg_Kind = A_Procedure                  or else
              Arg_Kind = A_Function                   or else
              Arg_Kind = A_Package                    or else
              Arg_Kind = A_Generic_Procedure          or else
              Arg_Kind = A_Generic_Function           or else
              Arg_Kind = A_Generic_Package            or else
              Arg_Kind = A_Procedure_Instance         or else
              Arg_Kind = A_Function_Instance          or else
              Arg_Kind = A_Package_Instance           or else
              Arg_Kind = A_Procedure_Renaming         or else
              Arg_Kind = A_Function_Renaming          or else
              Arg_Kind = A_Package_Renaming           or else
              Arg_Kind = A_Generic_Procedure_Renaming or else
              Arg_Kind = A_Generic_Function_Renaming  or else
              Arg_Kind = A_Generic_Package_Renaming   or else
              Arg_Kind = A_Procedure_Body             or else
              Arg_Kind = A_Function_Body              or else
              Arg_Kind = A_Package_Body)
      then
         Raise_ASIS_Inappropriate_Compilation_Unit (Diagnosis =>
            "Asis.Compilation_Units.Corresponding_Parent_Declaration");
      end if;

      Arg_Unit_Id     := Get_Unit_Id  (Library_Unit);
      Result_Cont_Id  := Get_Cont_Id  (The_Context);

      New_Arg_Unit_Id := Get_Same_Unit
                           (Arg_Cont_Id, Arg_Unit_Id, Result_Cont_Id);

      if Present (New_Arg_Unit_Id) then
         return Corresponding_Parent_Declaration
                  (Get_Comp_Unit (New_Arg_Unit_Id, Result_Cont_Id));
      else
         return Nil_Compilation_Unit;
      end if;

   exception
      when   ASIS_Inappropriate_Compilation_Unit
           | ASIS_Inappropriate_Context          =>
         raise;
      when ASIS_Failed =>
         if Status_Indicator /= Obsolete_Reference_Error then
            Add_Call_Information (Outer_Call =>
             "Asis.Compilation_Units.Corresponding_Parent_Declaration");
         end if;
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
               "Asis.Compilation_Units.Corresponding_Parent_Declaration");
   end Corresponding_Parent_Declaration;
-----------------------------------------------------------------------------

   function Corresponding_Declaration
     (Library_Item : in Asis.Compilation_Unit)
      return Asis.Compilation_Unit
   is
      Arg_Kind       : Asis.Unit_Kinds;
      Arg_Unit_Id    : Unit_Id;
      Result_Unit_Id : Unit_Id;
      Result_Cont_Id : Context_Id;
   begin
      Check_Validity (Library_Item,
               "Asis.Compilation_Units.Corresponding_Declaration");

      Result_Cont_Id := Encl_Cont_Id (Library_Item);
      Reset_Context (Result_Cont_Id);
      Arg_Kind := Kind (Library_Item);

      if not (Arg_Kind = A_Procedure_Body             or else
              Arg_Kind = A_Function_Body              or else
              Arg_Kind = A_Package_Body               or else
              Arg_Kind = An_Unknown_Unit              or else
              Arg_Kind = A_Procedure                  or else
              Arg_Kind = A_Function                   or else
              Arg_Kind = A_Package                    or else
              Arg_Kind = A_Generic_Procedure          or else
              Arg_Kind = A_Generic_Function           or else
              Arg_Kind = A_Generic_Package            or else
              Arg_Kind = A_Procedure_Instance         or else
              Arg_Kind = A_Function_Instance          or else
              Arg_Kind = A_Package_Instance           or else
              Arg_Kind = A_Procedure_Renaming         or else
              Arg_Kind = A_Function_Renaming          or else
              Arg_Kind = A_Package_Renaming           or else
              Arg_Kind = A_Generic_Procedure_Renaming or else
              Arg_Kind = A_Generic_Function_Renaming  or else
              Arg_Kind = A_Generic_Package_Renaming   or else
              Arg_Kind = A_Procedure_Body_Subunit     or else
              Arg_Kind = A_Function_Body_Subunit      or else
              Arg_Kind = A_Package_Body_Subunit       or else
              Arg_Kind = A_Task_Body_Subunit          or else
              Arg_Kind = A_Protected_Body_Subunit     or else
              Arg_Kind = A_Nonexistent_Declaration    or else
              Arg_Kind = A_Nonexistent_Body)
      then
         Raise_ASIS_Inappropriate_Compilation_Unit (Diagnosis =>
            "Asis.Compilation_Units.Corresponding_Declaration");
      end if;

      if Arg_Kind = A_Procedure                  or else
         Arg_Kind = A_Function                   or else
         Arg_Kind = A_Package                    or else
         Arg_Kind = A_Generic_Procedure          or else
         Arg_Kind = A_Generic_Function           or else
         Arg_Kind = A_Generic_Package            or else
         Arg_Kind = A_Procedure_Instance         or else
         Arg_Kind = A_Function_Instance          or else
         Arg_Kind = A_Package_Instance           or else
         Arg_Kind = A_Procedure_Renaming         or else
         Arg_Kind = A_Function_Renaming          or else
         Arg_Kind = A_Package_Renaming           or else
         Arg_Kind = A_Generic_Procedure_Renaming or else
         Arg_Kind = A_Generic_Function_Renaming  or else
         Arg_Kind = A_Generic_Package_Renaming   or else
         Arg_Kind = A_Procedure_Body_Subunit     or else --  ???
         Arg_Kind = A_Function_Body_Subunit      or else --  ???
         Arg_Kind = A_Package_Body_Subunit       or else --  ???
         Arg_Kind = A_Task_Body_Subunit          or else --  ???
         Arg_Kind = A_Protected_Body_Subunit     or else --  ???
         Arg_Kind = A_Nonexistent_Declaration    or else
         Arg_Kind = A_Nonexistent_Body                   --  ???
      then
         return Library_Item;
      end if;

      if ((Arg_Kind = A_Procedure_Body or else
           Arg_Kind = A_Function_Body)
          and then
           Class (Library_Item) = A_Public_Declaration_And_Body)
      then
         return Nil_Compilation_Unit;
      end if;

      Arg_Unit_Id    := Get_Unit_Id  (Library_Item);

      Result_Unit_Id := Get_Declaration (Result_Cont_Id, Arg_Unit_Id);

--      if not Is_Consistent (Result_Cont_Id, Result_Unit_Id, Arg_Unit_Id) then
--         --  the corresponding nonexistent declaration should be returned
--         --  this should cover the crazy situation, when a Context contains
--         --  the body of the procedure P and the declaration of the package
--         --  P in the same time. (??? it's not quite clear at the moment...)
--         Result_Unit_Id := Get_Nonexistent_Unit (Result_Cont_Id);
--      end if;

      return Get_Comp_Unit (Result_Unit_Id, Result_Cont_Id);

   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         if Status_Indicator /= Obsolete_Reference_Error then
            Add_Call_Information (Outer_Call =>
             "Asis.Compilation_Units.Corresponding_Declaration");
         end if;
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
               "Asis.Compilation_Units.Corresponding_Declaration");
   end Corresponding_Declaration;


   function Corresponding_Declaration
    (Library_Item   : in Asis.Compilation_Unit;
     The_Context    : in Asis.Context)
     return Asis.Compilation_Unit
   is
      Arg_Kind        : Asis.Unit_Kinds;
      Arg_Unit_Id     : Unit_Id;
      Arg_Cont_Id     : Context_Id;
      Result_Cont_Id  : Context_Id;
      New_Arg_Unit_Id : Unit_Id;
   begin
      Check_Validity (The_Context,
               "Asis.Compilation_Units.Corresponding_Declaration");

      Check_Validity (Library_Item,
               "Asis.Compilation_Units.Corresponding_Declaration");

      Arg_Cont_Id     := Encl_Cont_Id  (Library_Item);
      Reset_Context (Arg_Cont_Id);
      Arg_Kind := Kind (Library_Item);

      if not (Arg_Kind = A_Procedure_Body             or else
              Arg_Kind = A_Function_Body              or else
              Arg_Kind = A_Package_Body               or else
              Arg_Kind = An_Unknown_Unit              or else
              Arg_Kind = A_Procedure                  or else
              Arg_Kind = A_Function                   or else
              Arg_Kind = A_Package                    or else
              Arg_Kind = A_Generic_Procedure          or else
              Arg_Kind = A_Generic_Function           or else
              Arg_Kind = A_Generic_Package            or else
              Arg_Kind = A_Procedure_Instance         or else
              Arg_Kind = A_Function_Instance          or else
              Arg_Kind = A_Package_Instance           or else
              Arg_Kind = A_Procedure_Renaming         or else
              Arg_Kind = A_Function_Renaming          or else
              Arg_Kind = A_Package_Renaming           or else
              Arg_Kind = A_Generic_Procedure_Renaming or else
              Arg_Kind = A_Generic_Function_Renaming  or else
              Arg_Kind = A_Generic_Package_Renaming   or else
              Arg_Kind = A_Procedure_Body_Subunit     or else
              Arg_Kind = A_Function_Body_Subunit      or else
              Arg_Kind = A_Package_Body_Subunit       or else
              Arg_Kind = A_Task_Body_Subunit          or else
              Arg_Kind = A_Protected_Body_Subunit     or else
              Arg_Kind = A_Nonexistent_Declaration    or else
              Arg_Kind = A_Nonexistent_Body)
      then
         Raise_ASIS_Inappropriate_Compilation_Unit (Diagnosis =>
            "Asis.Compilation_Units.Corresponding_Declaration");
      end if;

      Arg_Unit_Id     := Get_Unit_Id   (Library_Item);
      Result_Cont_Id  := Get_Cont_Id   (The_Context);

      New_Arg_Unit_Id := Get_Same_Unit
                           (Arg_Cont_Id, Arg_Unit_Id, Result_Cont_Id);

      if Present (New_Arg_Unit_Id) then
         return Corresponding_Declaration
                  (Get_Comp_Unit (New_Arg_Unit_Id, Result_Cont_Id));
      else
         return Nil_Compilation_Unit;
      end if;

   exception
      when   ASIS_Inappropriate_Compilation_Unit
           | ASIS_Inappropriate_Context          =>
         raise;
      when ASIS_Failed =>
         if Status_Indicator /= Obsolete_Reference_Error then
            Add_Call_Information (Outer_Call =>
              "Asis.Compilation_Units.Corresponding_Declaration");
         end if;
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
               "Asis.Compilation_Units.Corresponding_Declaration");
   end Corresponding_Declaration;
-----------------------------------------------------------------------------
   function Corresponding_Body
     (Library_Item : in Asis.Compilation_Unit)
      return Asis.Compilation_Unit
   is
      Arg_Kind       : Asis.Unit_Kinds;
      Arg_Unit_Id    : Unit_Id;
      Result_Unit_Id : Unit_Id;
      Result_Cont_Id : Context_Id;
      Cont_Tree_Mode : Tree_Mode;
   begin
      Check_Validity (Library_Item,
               "Asis.Compilation_Units.Body");

      Result_Cont_Id := Encl_Cont_Id (Library_Item);
      Reset_Context (Result_Cont_Id);
      Arg_Kind := Kind (Library_Item);

      if not (Arg_Kind = A_Procedure                  or else
              Arg_Kind = A_Function                   or else
              Arg_Kind = A_Package                    or else
              Arg_Kind = A_Generic_Procedure          or else
              Arg_Kind = A_Generic_Function           or else
              Arg_Kind = A_Generic_Package            or else
              Arg_Kind = An_Unknown_Unit              or else
              Arg_Kind = A_Procedure_Body             or else
              Arg_Kind = A_Function_Body              or else
              Arg_Kind = A_Package_Body               or else
              Arg_Kind = A_Procedure_Instance         or else
              Arg_Kind = A_Function_Instance          or else
              Arg_Kind = A_Package_Instance           or else
              Arg_Kind = A_Procedure_Renaming         or else
              Arg_Kind = A_Function_Renaming          or else
              Arg_Kind = A_Package_Renaming           or else
              Arg_Kind = A_Generic_Procedure_Renaming or else
              Arg_Kind = A_Generic_Function_Renaming  or else
              Arg_Kind = A_Generic_Package_Renaming   or else
              Arg_Kind = A_Procedure_Body_Subunit     or else
              Arg_Kind = A_Function_Body_Subunit      or else
              Arg_Kind = A_Package_Body_Subunit       or else
              Arg_Kind = A_Task_Body_Subunit          or else
              Arg_Kind = A_Protected_Body_Subunit     or else
              Arg_Kind = A_Nonexistent_Declaration    or else
              Arg_Kind = A_Nonexistent_Body)
      then
         Raise_ASIS_Inappropriate_Compilation_Unit (Diagnosis =>
            "Asis.Compilation_Units.Corresponding_Body");
      end if;

      if Arg_Kind = A_Procedure_Body             or else
         Arg_Kind = A_Function_Body              or else
         Arg_Kind = A_Package_Body               or else
         Arg_Kind = A_Procedure_Instance         or else
         Arg_Kind = A_Function_Instance          or else
         Arg_Kind = A_Package_Instance           or else
         Arg_Kind = A_Procedure_Renaming         or else
         Arg_Kind = A_Function_Renaming          or else
         Arg_Kind = A_Package_Renaming           or else
         Arg_Kind = A_Generic_Procedure_Renaming or else
         Arg_Kind = A_Generic_Function_Renaming  or else
         Arg_Kind = A_Generic_Package_Renaming   or else
         Arg_Kind = A_Procedure_Body_Subunit     or else
         Arg_Kind = A_Function_Body_Subunit      or else
         Arg_Kind = A_Package_Body_Subunit       or else
         Arg_Kind = A_Task_Body_Subunit          or else
         Arg_Kind = A_Protected_Body_Subunit     or else
         Arg_Kind = A_Nonexistent_Declaration    or else
         Arg_Kind = A_Nonexistent_Body
      then
         return Library_Item;
      end if;

      if  (Arg_Kind = A_Package or else
           Arg_Kind = A_Generic_Package)
         and then
           not Asis.Set_Get.Is_Body_Required (Library_Item)
      then
         return Nil_Compilation_Unit;
      end if;

      Arg_Unit_Id    := Get_Unit_Id  (Library_Item);
      Cont_Tree_Mode := Tree_Processing_Mode (Result_Cont_Id);
      Result_Unit_Id := Get_Body (Result_Cont_Id, Arg_Unit_Id);

      if No (Result_Unit_Id) and then
         (Cont_Tree_Mode = On_The_Fly or else Cont_Tree_Mode = Mixed)
      then
         --  as a last escape, we try to create the result body by
         --  compiling on the fly:
         Result_Unit_Id :=
           Get_One_Unit (Name    => Unit_Name (Library_Item),
                         Context => Result_Cont_Id,
                         Spec    => False);
      end if;

      if No (Result_Unit_Id)
--      or else
--         (not Is_Consistent (Result_Cont_Id, Arg_Unit_Id, Result_Unit_Id))
      then
         Result_Unit_Id := Get_Nonexistent_Unit (Result_Cont_Id);
      end if;

      return Get_Comp_Unit (Result_Unit_Id, Result_Cont_Id);

   exception
      when Program_Error =>
         raise;
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         if Status_Indicator /= Obsolete_Reference_Error then
            Add_Call_Information (Outer_Call =>
             "Asis.Compilation_Units.Corresponding_Body");
         end if;
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
               "Asis.Compilation_Units.Corresponding_Body");
   end Corresponding_Body;
------------------------------------------------------------------------------
   function Corresponding_Body
     (Library_Item   : in Asis.Compilation_Unit;
      The_Context    : in Asis.Context)
      return Asis.Compilation_Unit
   is
      Arg_Kind        : Asis.Unit_Kinds;
      Arg_Unit_Id     : Unit_Id;
      Arg_Cont_Id     : Context_Id;
      Result_Cont_Id  : Context_Id;
      New_Arg_Unit_Id : Unit_Id;
   begin
      Check_Validity (The_Context,
               "Asis.Compilation_Units.Corresponding_Body");

      Check_Validity (Library_Item,
               "Asis.Compilation_Units.Corresponding_Body");

      Arg_Cont_Id := Encl_Cont_Id  (Library_Item);
      Reset_Context (Arg_Cont_Id);
      Arg_Kind := Kind (Library_Item);

      if not (Arg_Kind = A_Procedure                  or else
              Arg_Kind = A_Function                   or else
              Arg_Kind = A_Package                    or else
              Arg_Kind = A_Generic_Procedure          or else
              Arg_Kind = A_Generic_Function           or else
              Arg_Kind = A_Generic_Package            or else
              Arg_Kind = An_Unknown_Unit              or else
              Arg_Kind = A_Procedure_Body             or else
              Arg_Kind = A_Function_Body              or else
              Arg_Kind = A_Package_Body               or else
              Arg_Kind = A_Procedure_Instance         or else
              Arg_Kind = A_Function_Instance          or else
              Arg_Kind = A_Package_Instance           or else
              Arg_Kind = A_Procedure_Renaming         or else
              Arg_Kind = A_Function_Renaming          or else
              Arg_Kind = A_Package_Renaming           or else
              Arg_Kind = A_Generic_Procedure_Renaming or else
              Arg_Kind = A_Generic_Function_Renaming  or else
              Arg_Kind = A_Generic_Package_Renaming   or else
              Arg_Kind = A_Procedure_Body_Subunit     or else
              Arg_Kind = A_Function_Body_Subunit      or else
              Arg_Kind = A_Package_Body_Subunit       or else
              Arg_Kind = A_Task_Body_Subunit          or else
              Arg_Kind = A_Protected_Body_Subunit     or else
              Arg_Kind = A_Nonexistent_Declaration    or else
              Arg_Kind = A_Nonexistent_Body)
      then
         Raise_ASIS_Inappropriate_Compilation_Unit (Diagnosis =>
            "Asis.Compilation_Units.Corresponding_Body");
      end if;

      Arg_Unit_Id     := Get_Unit_Id   (Library_Item);
      Result_Cont_Id  := Get_Cont_Id   (The_Context);

      New_Arg_Unit_Id := Get_Same_Unit
                            (Arg_Cont_Id, Arg_Unit_Id, Result_Cont_Id);

      if Present (New_Arg_Unit_Id) then
         return Corresponding_Body
                  (Get_Comp_Unit (New_Arg_Unit_Id, Result_Cont_Id));
      else
         return Nil_Compilation_Unit;
      end if;

   exception
      when   ASIS_Inappropriate_Compilation_Unit
           | ASIS_Inappropriate_Context          =>
         raise;
      when ASIS_Failed =>
         if Status_Indicator /= Obsolete_Reference_Error then
            Add_Call_Information (Outer_Call =>
              "Asis.Compilation_Units.Corresponding_Body");
         end if;
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
               "Asis.Compilation_Units.Corresponding_Body");
   end Corresponding_Body;
------------------------------------------------------------------------------

   function Is_Nil (Right : in Asis.Compilation_Unit) return Boolean is
   begin
      Check_Validity (Right, "Asis.Compilation_Units.Is_Nil");
      return Right = Nil_Compilation_Unit;
   end Is_Nil;
-----------------------------------------------------------------------------

   function Is_Nil (Right : in Asis.Compilation_Unit_List) return Boolean is
   begin
      return Right = Nil_Compilation_Unit_List;
   end Is_Nil;
-----------------------------------------------------------------------------

   function Is_Equal
     (Left  : in Asis.Compilation_Unit;
      Right : in Asis.Compilation_Unit)
      return Boolean
   is
      Left_Unit_Id  : Unit_Id;
      Right_Unit_Id : Unit_Id;
      Left_Cont_Id  : Context_Id;
      Right_Cont_Id : Context_Id;
--      Left_Kind     : Asis.Unit_Kinds;
--      Right_Kind    : Asis.Unit_Kinds;
   begin
      Check_Validity (Left,  "Asis.Compilation_Units.Is_Equal");
      Check_Validity (Right, "Asis.Compilation_Units.Is_Equal");

      Left_Unit_Id  := Get_Unit_Id (Left);
      Right_Unit_Id := Get_Unit_Id (Right);

      if Left_Unit_Id = Nil_Unit and then Right_Unit_Id = Nil_Unit then
         return True;
      elsif (Right_Unit_Id = Nil_Unit and then Right_Unit_Id /= Nil_Unit)
            or else
            (Right_Unit_Id /= Nil_Unit and then Right_Unit_Id = Nil_Unit)
      then
         return False;
      end if;

      Left_Cont_Id  := Encl_Cont_Id (Left);
      Right_Cont_Id := Encl_Cont_Id (Right);

      if Left_Cont_Id = Right_Cont_Id then
         return Left_Unit_Id = Right_Unit_Id;
      else
--         if Unit_Name (Left) /= Unit_Name (Right) then
--            --  Unit_Name should reset context!
--            return False;
--         else
--            Left_Kind  := Kind (Left);
--            Right_Kind := Kind (Right);

--            if Left_Kind /= Right_Kind then
--               return False;
--            elsif Left_Kind = A_Nonexistent_Declaration or else
--                  Left_Kind = A_Nonexistent_Body
--            then
--               return True;
--            else
         return Right_Unit_Id = Get_Same_Unit
                                  (Left_Cont_Id, Left_Unit_Id, Right_Cont_Id);
--            end if;
--         end if;
      end if;
   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
           "Asis.Compilation_Units.Is_Equal");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
               "Asis.Compilation_Units.Is_Equal");
   end Is_Equal;
-----------------------------------------------------------------------------

   function Is_Identical
     (Left  : in Asis.Compilation_Unit;
      Right : in Asis.Compilation_Unit)
      return Boolean
   is
      Left_Cont_Id  : Context_Id;
      Right_Cont_Id : Context_Id;
   begin

      Check_Validity (Left,  "Asis.Compilation_Units.Is_Identical");
      Check_Validity (Right, "Asis.Compilation_Units.Is_Identical");

      Left_Cont_Id  := Encl_Cont_Id (Left);
      Right_Cont_Id := Encl_Cont_Id (Right);

      return Left_Cont_Id = Right_Cont_Id and then Is_Equal (Left, Right);

   end Is_Identical;

-----------------------------------------------------------------------------

   function Unit_Full_Name
     (Compilation_Unit : in Asis.Compilation_Unit)
      return Wide_String
   is
   begin

      Check_Validity (Compilation_Unit,
               "Asis.Compilation_Units.Unit_Full_Name");

      if Is_Nil (Compilation_Unit) then
         return Nil_Asis_Wide_String;
      else
         Reset_Context (Encl_Cont_Id (Compilation_Unit));
         return To_Wide_String (Unit_Name (Compilation_Unit));
      end if;

   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
                     "Asis.Compilation_Units.Unit_Full_Name");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
                     "Asis.Compilation_Units.Unit_Full_Name");
   end Unit_Full_Name;
-----------------------------------------------------------------------------

   function Unique_Name
     (Compilation_Unit : in Asis.Compilation_Unit)
      return Wide_String
   is
      Arg_Kind : Unit_Kinds;
   begin
      Check_Validity (Compilation_Unit,
               "Asis.Compilation_Units.Unique_Name");

      if Is_Nil (Compilation_Unit) then
         return Nil_Asis_Wide_String;
      else
         Reset_Context (Encl_Cont_Id (Compilation_Unit));
         Arg_Kind := Unit_Kind (Compilation_Unit);

         --  ???!!! Diagnosis_Buffer and Diagnosis_Len should noy be used here!

         Diagnosis_Len := 0;
         A4G.Vcheck.Add (Context_Info (Compilation_Unit));
         A4G.Vcheck.Add (": ");
         A4G.Vcheck.Add (Unit_Name (Compilation_Unit));

         case Arg_Kind is
            when Asis.A_Library_Unit_Body =>
               A4G.Vcheck.Add (" (body)");
            when Asis.A_Subunit =>
               A4G.Vcheck.Add (" (subunit)");
            when others =>
               A4G.Vcheck.Add (" (spec)");
         end case;

         return To_Wide_String (Diagnosis_Buffer (1 .. Diagnosis_Len));
      end if;
   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
                     "Asis.Compilation_Units.Unique_Name");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
                     "Asis.Compilation_Units.Unique_Name");
   end Unique_Name;
-----------------------------------------------------------------------------

   function Exists
     (Compilation_Unit : in Asis.Compilation_Unit)
      return Boolean
   is
      Unit_Kind : Asis.Unit_Kinds;
   begin

      Check_Validity (Compilation_Unit, "Asis.Compilation_Units.Exists");

      Reset_Context (Encl_Cont_Id (Compilation_Unit));
      Unit_Kind := Kind (Compilation_Unit);

      return not (Unit_Kind = Not_A_Unit                 or else
                   Unit_Kind = A_Nonexistent_Declaration  or else
                   Unit_Kind = A_Nonexistent_Body);
   end Exists;
-----------------------------------------------------------------------------

   function Can_Be_Main_Program
     (Compilation_Unit : in Asis.Compilation_Unit)
      return Boolean
   is
      Unit_Kind : Asis.Unit_Kinds;
   begin

      Check_Validity (Compilation_Unit,
               "Asis.Compilation_Units.Can_Be_Main_Program");

      Reset_Context (Encl_Cont_Id (Compilation_Unit));
      Unit_Kind := Kind (Compilation_Unit);

      if not (Unit_Kind = A_Procedure      or else
               Unit_Kind = A_Function       or else
               Unit_Kind = A_Procedure_Body or else
               Unit_Kind = A_Function_Body)
      then
         return False;
      else
         return Is_Main_Unit (Compilation_Unit);
      end if;
   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
                     "Asis.Compilation_Units.Can_Be_Main_Program");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
                     "Asis.Compilation_Units.Can_Be_Main_Program");
   end Can_Be_Main_Program;
-----------------------------------------------------------------------------

   function Is_Body_Required
     (Compilation_Unit : in Asis.Compilation_Unit)
      return Boolean
   is
      Unit_Kind : Asis.Unit_Kinds;
   begin
      Check_Validity (Compilation_Unit,
               "Asis.Compilation_Units.Is_Body_Required");
      Reset_Context (Encl_Cont_Id (Compilation_Unit));
      Unit_Kind := Kind (Compilation_Unit);

      if not (Unit_Kind = A_Package or else
               Unit_Kind = A_Generic_Package)
      then
         return False;
      else
         return Asis.Set_Get.Is_Body_Required (Compilation_Unit);
      end if;
   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
                     "Asis.Compilation_Units.Is_Body_Required");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
                     "Asis.Compilation_Units.Is_Body_Required");

   end Is_Body_Required;
-----------------------------------------------------------------------------

   function Text_Name
     (Compilation_Unit : in Asis.Compilation_Unit)
      return Wide_String is
   begin
      Check_Validity (Compilation_Unit,
               "Asis.Compilation_Units.Text_Name");

      if not Exists (Compilation_Unit) then
         return Nil_Asis_Wide_String;
      else
         --  Exists resets the Context!
         return To_Wide_String (Ref_File (Compilation_Unit));
      end if;

   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
                     "Asis.Compilation_Units.Text_Name");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
                     "Asis.Compilation_Units.Text_Name");
   end Text_Name;
-----------------------------------------------------------------------------

   function Text_Form
     (Compilation_Unit : in Asis.Compilation_Unit)
      return Wide_String is
   begin

      Check_Validity (Compilation_Unit,
               "Asis.Compilation_Units.Text_Form");

      return Nil_Asis_Wide_String;
--   exception
--      when ASIS_Inappropriate_Compilation_Unit =>
--        raise;
--      when ASIS_Failed =>
--        Add_Call_Information (Outer_Call =>
--                     "Asis.Compilation_Units.Text_Form");
--        raise;
--      when others =>
--        Raise_ASIS_Failed (Diagnosis =>
--                     "Asis.Compilation_Units.Text_Form");
   end Text_Form;
-----------------------------------------------------------------------------

   function Object_Name
     (Compilation_Unit : in Asis.Compilation_Unit)
      return Wide_String
   is
   begin
      Check_Validity (Compilation_Unit,
               "Asis.Compilation_Units.Object_Name");
      if not Exists (Compilation_Unit) then
         return Nil_Asis_Wide_String;
      else
         return Nil_Asis_Wide_String;
         --  chould be changed to real implementation
      end if;
--   exception
--      when ASIS_Inappropriate_Compilation_Unit =>
--        raise;
--      when ASIS_Failed =>
--        Add_Call_Information (Outer_Call =>
--                     "Asis.Compilation_Units.Object_Name");
--        raise;
--      when others =>
--        Raise_ASIS_Failed (Diagnosis =>
--                     "Asis.Compilation_Units.Object_Name");
   end Object_Name;
-----------------------------------------------------------------------------

   function Object_Form
     (Compilation_Unit : in Asis.Compilation_Unit)
      return Wide_String
   is
   begin
      Check_Validity (Compilation_Unit,
               "Asis.Compilation_Units.Object_Form");
      if not Exists (Compilation_Unit) then
         return Nil_Asis_Wide_String;
      else
         return Nil_Asis_Wide_String;
         --  chould be changed to real implementation
      end if;
--   exception
--      when ASIS_Inappropriate_Compilation_Unit =>
--        raise;
--      when ASIS_Failed =>
--        Add_Call_Information (Outer_Call =>
--                     "Asis.Compilation_Units.Object_Form");
--        raise;
--      when others =>
--        Raise_ASIS_Failed (Diagnosis =>
--                     "Asis.Compilation_Units.Object_Form");
   end Object_Form;
-----------------------------------------------------------------------------

   function Compilation_Command_Line_Options
     (Compilation_Unit : in Asis.Compilation_Unit)
      return Wide_String
   is
      Arg_Kind       : Asis.Unit_Kinds;
      Arg_Unit_Id    : Unit_Id;
      Arg_Cont_Id    : Context_Id;

      use Lib.Compilation_Arguments;

      Arg_Len : Natural := 0;

      Corr_Main_Unit_Id       : Unit_Id               := Nil_Unit;
      Corresponding_Main_Unit : Asis.Compilation_Unit := Nil_Compilation_Unit;
   begin
      Check_Validity (Compilation_Unit,
               "Asis.Compilation_Units.Compilation_Command_Line_Options");

      Arg_Kind := Kind (Compilation_Unit);

      if Arg_Kind not in A_Procedure .. A_Protected_Body_Subunit then
         return Nil_Asis_Wide_String;
      end if;

      Arg_Cont_Id := Encl_Cont_Id (Compilation_Unit);
      Reset_Context (Arg_Cont_Id);


      if Is_Main_Unit_In_Tree (Compilation_Unit) then
         Corresponding_Main_Unit := Compilation_Unit;
      else
         Arg_Unit_Id       := Get_Unit_Id  (Compilation_Unit);

         --  Here we have to check if the argument unit should to
         --  inherit command line options from some main unit:

         if Arg_Kind in A_Procedure .. A_Package then
            --  Here we have to check if the corresponding body is a
            --  main unit of some compilation:
            Corr_Main_Unit_Id := Get_Body (Arg_Cont_Id, Arg_Unit_Id);

         elsif Arg_Kind in A_Procedure_Body_Subunit ..
               A_Protected_Body_Subunit
         then
            --  We have to go to ancestor body and to check it it is a main
            --  unit of some compilation
            Corr_Main_Unit_Id :=
               Get_Subunit_Parent_Body (Arg_Cont_Id, Arg_Unit_Id);

            while Class (Arg_Cont_Id, Corr_Main_Unit_Id) = A_Separate_Body
            loop

               Corr_Main_Unit_Id :=
                  Get_Subunit_Parent_Body (Arg_Cont_Id, Corr_Main_Unit_Id);

            end loop;

         end if;

         Corresponding_Main_Unit :=
            Get_Comp_Unit (Corr_Main_Unit_Id, Arg_Cont_Id);

         if not Is_Main_Unit_In_Tree (Corresponding_Main_Unit) then
            Corresponding_Main_Unit := Nil_Compilation_Unit;
         end if;

      end if;

      if Is_Nil (Corresponding_Main_Unit) then
         return Nil_Asis_Wide_String;
      else

         Reset_Main_Tree (Corresponding_Main_Unit);

         --  First, declaring the length of the string to return:
         for Next_Arg in 1 .. Last loop
            Arg_Len := Arg_Len + Table (Next_Arg)'Length + 1;
         end loop;

         if Arg_Len > 0 then
            Arg_Len := Arg_Len - 1;
         end if;

         declare
            Result : String (1 .. Arg_Len);
            Next_Pos : Natural := 1;
            Next_Arg_Len : Natural;
         begin

            --  Should be rewritten on the base of ASIS string buffer???
            for Next_Arg in 1 .. Last loop
               Next_Arg_Len := Table (Next_Arg)'Length;

               Result (Next_Pos .. Next_Pos + Next_Arg_Len - 1) :=
                  Table (Next_Arg).all;

               Next_Pos := Next_Pos + Next_Arg_Len;

               if Next_Arg < Last then
                  Result (Next_Pos) := ' ';

                  Next_Pos := Next_Pos + 1;
               end if;

            end loop;

            return To_Wide_String (Result);
         end;
      end if;

   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
            "Asis.Compilation_Units.Compilation_Command_Line_Options");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
            "Asis.Compilation_Units.Compilation_Command_Line_Options");
   end Compilation_Command_Line_Options;
-----------------------------------------------------------------------------
   function Has_Attribute
     (Compilation_Unit : in Asis.Compilation_Unit;
      Attribute : in Wide_String)
   return Boolean
   is
   begin
      Check_Validity (Compilation_Unit,
               "Asis.Compilation_Units.Has_Attribute");
      return False;
   end Has_Attribute;
-----------------------------------------------------------------------------
   function Attribute_Value_Delimiter return Wide_String is
   begin
      return Asis_Wide_Line_Terminator;
   end Attribute_Value_Delimiter;
-----------------------------------------------------------------------------
   function Attribute_Values
     (Compilation_Unit : in Asis.Compilation_Unit;
      Attribute        : in Wide_String)
      return Wide_String
   is
   begin
      Check_Validity (Compilation_Unit,
               "Asis.Compilation_Units.Attribute_Values");
      return Nil_Asis_Wide_String;
   end Attribute_Values;
------------------------------------------------------------------------------

   function Subunits
     (Parent_Body : in Asis.Compilation_Unit)
      return Asis.Compilation_Unit_List
   is
      Arg_Kind    : Asis.Unit_Kinds;
      Arg_Unit_Id : Unit_Id;
      Res_Cont_Id : Context_Id;
      Cont_Tree_Mode : Tree_Mode;
   begin
      Check_Validity (Parent_Body,
               "Asis.Compilation_Units.Subunits");

      Res_Cont_Id := Encl_Cont_Id (Parent_Body);
      Reset_Context (Res_Cont_Id);
      Arg_Kind := Kind (Parent_Body);

      if not (Arg_Kind = A_Procedure_Body         or else
              Arg_Kind = A_Function_Body          or else
              Arg_Kind = A_Package_Body           or else
              Arg_Kind = A_Procedure_Body_Subunit or else
              Arg_Kind = A_Function_Body_Subunit  or else
              Arg_Kind = A_Package_Body_Subunit   or else
              Arg_Kind = A_Task_Body_Subunit      or else
              Arg_Kind = A_Protected_Body_Subunit)
      then
         Raise_ASIS_Inappropriate_Compilation_Unit (Diagnosis =>
            "Asis.Compilation_Units.Subunits");
      end if;

      Cont_Tree_Mode := Tree_Processing_Mode (Res_Cont_Id);

      if Cont_Tree_Mode /= Pre_Created then
         Not_Implemented_Yet (Diagnosis =>
                  "Asis.Compilation_Units.Subunits");
      end if;

      Arg_Unit_Id := Get_Unit_Id  (Parent_Body);

      declare
         Result_Id_List : Unit_Id_List renames
            Subunits (Res_Cont_Id, Arg_Unit_Id);
         Result_List : Compilation_Unit_List renames
             Get_Comp_Unit_List (Result_Id_List, Res_Cont_Id);
      begin
         return Result_List;
      end;
   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
                     "Asis.Compilation_Units.Subunits");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
                     "Asis.Compilation_Units.Subunits");
   end Subunits;

   function Subunits
     (Parent_Body : in Asis.Compilation_Unit;
      The_Context : in Asis.Context)
      return Asis.Compilation_Unit_List
   is
      Arg_Kind        : Asis.Unit_Kinds;
      Arg_Unit_Id     : Unit_Id;
      Arg_Cont_Id     : Context_Id;
      Result_Cont_Id  : Context_Id;
      New_Arg_Unit_Id : Unit_Id;
      Cont_Tree_Mode : Tree_Mode;
   begin
      Check_Validity (The_Context,
               "Asis.Compilation_Units.Subunits");
      Check_Validity (Parent_Body,
               "Asis.Compilation_Units.Subunits");

      Arg_Cont_Id := Encl_Cont_Id (Parent_Body);
      Reset_Context (Arg_Cont_Id);
      Arg_Kind := Kind (Parent_Body);

      if not (Arg_Kind = A_Procedure_Body         or else
              Arg_Kind = A_Function_Body          or else
              Arg_Kind = A_Package_Body           or else
              Arg_Kind = A_Procedure_Body_Subunit or else
              Arg_Kind = A_Function_Body_Subunit  or else
              Arg_Kind = A_Package_Body_Subunit   or else
              Arg_Kind = A_Task_Body_Subunit      or else
              Arg_Kind = A_Protected_Body_Subunit)
      then
         Raise_ASIS_Inappropriate_Compilation_Unit (Diagnosis =>
            "Asis.Compilation_Units.Subunits");
      end if;

      Result_Cont_Id  := Get_Cont_Id  (The_Context);
      Cont_Tree_Mode := Tree_Processing_Mode (Result_Cont_Id);

      if Cont_Tree_Mode /= Pre_Created then
         Not_Implemented_Yet (Diagnosis =>
                  "Asis.Compilation_Units.Subunits");
         --  ASIS_Failed is raised, Not_Implemented_Error status is setted
      end if;

      Arg_Unit_Id     := Get_Unit_Id  (Parent_Body);
      New_Arg_Unit_Id := Get_Same_Unit
                           (Arg_Cont_Id, Arg_Unit_Id, Result_Cont_Id);

      if Present (New_Arg_Unit_Id) then
         return Subunits
                  (Get_Comp_Unit (New_Arg_Unit_Id, Result_Cont_Id));
      else
         return Nil_Compilation_Unit_List;
      end if;
   exception
      when  ASIS_Inappropriate_Compilation_Unit
          | ASIS_Inappropriate_Context            =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
                     "Asis.Compilation_Units.Subunits");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
                     "Asis.Compilation_Units.Subunits");
   end Subunits;
-----------------------------------------------------------------------------
   function Corresponding_Subunit_Parent_Body
     (Subunit : in Asis.Compilation_Unit)
      return Asis.Compilation_Unit
   is
      Arg_Kind       : Asis.Unit_Kinds;
      Arg_Unit_Id    : Unit_Id;
      Result_Unit_Id : Unit_Id;
      Result_Cont_Id : Context_Id;
   begin
      Check_Validity
        (Subunit,
        "Asis.Compilation_Units.Corresponding_Subunit_Parent_Body");

      Result_Cont_Id := Encl_Cont_Id (Subunit);
      Reset_Context (Result_Cont_Id);
      Arg_Kind := Kind (Subunit);

      if not (Arg_Kind = A_Procedure_Body_Subunit or else
              Arg_Kind = A_Function_Body_Subunit  or else
              Arg_Kind = A_Package_Body_Subunit   or else
              Arg_Kind = A_Task_Body_Subunit      or else
              Arg_Kind = A_Protected_Body_Subunit)
      then
         Raise_ASIS_Inappropriate_Compilation_Unit (Diagnosis =>
            "Asis.Compilation_Units.Corresponding_Subunit_Parent_Body");
      end if;

      Arg_Unit_Id    := Get_Unit_Id  (Subunit);
      Result_Unit_Id := Get_Subunit_Parent_Body (Result_Cont_Id, Arg_Unit_Id);

--      if not Is_Consistent (Result_Cont_Id, Result_Unit_Id, Arg_Unit_Id) then
--         Result_Unit_Id := Get_Nonexistent_Unit (Result_Cont_Id);
--      end if;

      return Get_Comp_Unit (Result_Unit_Id, Result_Cont_Id);

   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         if Status_Indicator /= Obsolete_Reference_Error then
            Add_Call_Information (Outer_Call =>
             "Asis.Compilation_Units.Corresponding_Subunit_Parent_Body");
         end if;
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
               "Asis.Compilation_Units.Corresponding_Subunit_Parent_Body");
   end Corresponding_Subunit_Parent_Body;


   function Corresponding_Subunit_Parent_Body
     (Subunit     : in Asis.Compilation_Unit;
      The_Context : in Asis.Context)
      return Asis.Compilation_Unit
   is
      Arg_Kind        : Asis.Unit_Kinds;
      Arg_Unit_Id     : Unit_Id;
      Arg_Cont_Id     : Context_Id;
      Result_Cont_Id  : Context_Id;
      New_Arg_Unit_Id : Unit_Id;
   begin
      Check_Validity (The_Context,
               "Asis.Compilation_Units.Corresponding_Subunit_Parent_Body");
      Check_Validity (Subunit,
               "Asis.Compilation_Units.Corresponding_Subunit_Parent_Body");

      Arg_Cont_Id := Encl_Cont_Id (Subunit);
      Reset_Context (Arg_Cont_Id);
      Arg_Kind := Kind (Subunit);

      if not (Arg_Kind = A_Procedure_Body_Subunit or else
              Arg_Kind = A_Function_Body_Subunit  or else
              Arg_Kind = A_Package_Body_Subunit   or else
              Arg_Kind = A_Task_Body_Subunit      or else
              Arg_Kind = A_Protected_Body_Subunit)
      then
         Raise_ASIS_Inappropriate_Compilation_Unit (Diagnosis =>
            "Asis.Compilation_Units.Corresponding_Subunit_Parent_Body");
      end if;


      Arg_Unit_Id     := Get_Unit_Id  (Subunit);
      Result_Cont_Id  := Get_Cont_Id  (The_Context);
      New_Arg_Unit_Id := Get_Same_Unit
                           (Arg_Cont_Id, Arg_Unit_Id, Result_Cont_Id);

      if Present (New_Arg_Unit_Id) then
         return Corresponding_Subunit_Parent_Body
                  (Get_Comp_Unit (New_Arg_Unit_Id, Result_Cont_Id));
      else
         return Nil_Compilation_Unit;
      end if;
   exception
      when  ASIS_Inappropriate_Compilation_Unit
          | ASIS_Inappropriate_Context            =>
         raise;
      when ASIS_Failed =>
         if Status_Indicator /= Obsolete_Reference_Error then
            Add_Call_Information (Outer_Call =>
             "Asis.Compilation_Units.Corresponding_Subunit_Parent_Body");
         end if;
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
               "Asis.Compilation_Units.Corresponding_Subunit_Parent_Body");
   end Corresponding_Subunit_Parent_Body;
-----------------------------------------------------------------------------

   function Debug_Image
     (Compilation_Unit : in Asis.Compilation_Unit)
      return Wide_String
   is
      LT : String renames A4G.A_Types.ASIS_Line_Terminator;
   begin
      return To_Wide_String (LT & "Compilation Unit Debug_Image: "
             & Debug_String (Compilation_Unit));
   end Debug_Image;
end Asis.Compilation_Units