separate (Object_Info) package body Ada is function Is_Installed (This_Unit : in Ada_Unit) return Boolean is begin return ((Object_Info.Any.Is_Ada_Unit (This_Unit)) and then (Directory_Tools.Ada_Object.State (This_Unit) = Directory_Tools.Ada_Object.Installed)); end Is_Installed; function Is_Coded (This_Unit : in Ada_Unit) return Boolean is begin return ((Object_Info.Any.Is_Ada_Unit (This_Unit)) and then (Directory_Tools.Ada_Object.State (This_Unit) = Directory_Tools.Ada_Object.Coded)); end Is_Coded; function Is_Installed_Or_Coded (This_Unit : in Ada_Unit) return Boolean is begin return ((Directory_Tools.Ada_Object.State (This_Unit) = Directory_Tools.Ada_Object.Installed) or else (Directory_Tools.Ada_Object.State (This_Unit) = Directory_Tools.Ada_Object.Coded)); end Is_Installed_Or_Coded; function Is_Body (This_Unit : in Ada_Unit) return Boolean is -- Unit_Kind : Directory_Tools.Ada_Object.Unit_Kind := Directory_Tools.Ada_Object.Kind (This_Unit); -- begin return ((Object_Info.Any.Is_Ada_Unit (This_Unit)) and then (not Object_Info.Ada.Is_Subunit (This_Unit)) and then ((Unit_Kind = Directory_Tools.Ada_Object.Package_Body) or else (Unit_Kind = Directory_Tools.Ada_Object.Procedure_Body) or else (Unit_Kind = Directory_Tools.Ada_Object.Function_Body))); end Is_Body; function Is_Subunit (This_Unit : in Ada_Unit) return Boolean is -- Compilation_Kind : Directory_Tools.Ada_Object.Compilation_Kind := Directory_Tools.Ada_Object.Kind (This_Unit); -- begin return ((Object_Info.Any.Is_Ada_Unit (This_Unit)) and then (Compilation_Kind = Directory_Tools.Ada_Object.Subunit)); end Is_Subunit; function Is_Body_Or_Subunit (This_Unit : in Ada_Unit) return Boolean is begin return ((Object_Info.Ada.Is_Body (This_Unit)) or else (Object_Info.Ada.Is_Subunit (This_Unit))); end Is_Body_Or_Subunit; function Is_Spec (This_Unit : in Ada_Unit) return Boolean is begin return ((Object_Info.Any.Is_Ada_Unit (This_Unit)) and then (Directory_Tools.Ada_Object.Is_Visible_Part (This_Unit))); end Is_Spec; function Is_Universe_Mirror (This_Unit : in Ada_Unit) return Boolean is -- The_Root : Standard.Directory.Ada.Root; The_Status : Standard.Directory.Error_Status; Object_Id : Diana.Tree; Pragmas : Diana.Sequence; -- begin if (Object_Info.Ada.Is_Spec (This_Unit)) then -- Find the root of the object. Directory_Tools.Object.Low_Level.Get_Root (This_Unit, The_Root, The_Status); -- Get the id for the object. Object_Id := Diana.Id_Utilities.Comp_Unit_Id (The_Root); if (Semantic_Attributes.Has_Sm_Subsystem_Interface (Object_Id)) then -- Since is subsystem interface, see if has a pragma -- for Module_Name in it: if so, it is a universe mirror. Pragmas := Semantic_Attributes.Sm_Applied_Pragmas (Object_Id); while (not Diana.Is_Empty (Pragmas)) loop if (String_Utilities.Upper_Case (Diana.Image (Diana.Id (Diana.As_Id (Diana.Head (Pragmas))))) = "MODULE_NAME") then return (True); end if; Pragmas := Diana.Tail (Pragmas); end loop; end if; end if; return (False); -- exception when others => return (False); -- end Is_Universe_Mirror; function Is_Generic_Spec (This_Unit : in Ada_Unit) return Boolean is -- Object_Kind : Directory_Tools.Ada_Object.Unit_Kind := Directory_Tools.Ada_Object.Kind (This_Unit); -- begin return ((Object_Info.Ada.Is_Spec (This_Unit)) and then ((Object_Kind = Directory_Tools.Ada_Object. Generic_Package) or else (Object_Kind = Directory_Tools.Ada_Object. Generic_Procedure) or else (Object_Kind = Directory_Tools.Ada_Object. Generic_Function))); end Is_Generic_Spec; function Is_Spec_In_Spec_View (This_Unit : in Ada_Unit) return Boolean is begin return ((Object_Info.Ada.Is_Spec (This_Unit)) and then (Object_Info.Any.Is_Contained_By_Spec_View (This_Unit))); end Is_Spec_In_Spec_View; function Is_Spec_In_Load_View (This_Unit : in Ada_Unit) return Boolean is begin return ((Object_Info.Ada.Is_Spec (This_Unit)) and then (Object_Info.Any.Is_Contained_By_Load_View (This_Unit))); end Is_Spec_In_Load_View; function Matching_Spec (Current_Spec : in Ada_Spec; Current_View : in Object_Info.Any.View; Other_View : in Object_Info.Any.View) return Ada_Spec is begin declare -- Current_Spec_Name : constant String := Directory_Tools.Naming.Full_Name (Current_Spec); Current_View_Name : constant String := Directory_Tools.Naming.Full_Name (Current_View); Current_Tail : constant String := Current_Spec_Name ((Current_Spec_Name'First + Current_View_Name'Length) .. Current_Spec_Name'Last); -- Other_View_Name : constant String := Directory_Tools.Naming.Full_Name (Other_View); Other_Spec_Name : constant String := Other_View_Name & Current_Tail; -- Other_Spec : Ada_Spec := Directory_Tools.Naming.Resolution (Other_Spec_Name); -- begin return (Other_Spec); end; -- exception when others => return (Object_Info.Utilities.Bad_Object); -- end Matching_Spec; function Spec_In_Other_View (This_Spec : in Ada_Spec; This_Activity : in Activity.Activity_Name := Activity.The_Current_Activity) return Ada_Spec is -- Current_View : Object_Info.Any.View := Object_Info.Any.View_Containing (This_Spec); -- begin if (Object_Info.Any.Is_Spec_View (Current_View)) then return (Matching_Spec (Current_Spec => This_Spec, Current_View => Current_View, Other_View => Object_Info.Cmvc.Current_Load_View_In (Object_Info.Any.Subsystem_Containing (Current_View), This_Activity))); elsif (Object_Info.Any.Is_Load_View (Current_View)) then return (Matching_Spec (Current_Spec => This_Spec, Current_View => Current_View, Other_View => Object_Info.Cmvc.Current_Spec_View_In (Object_Info.Any.Subsystem_Containing (Current_View), This_Activity))); elsif (Object_Info.Any.Is_Combined_View (Current_View)) then return (This_Spec); else return (Object_Info.Utilities.Bad_Object); end if; -- exception when others => return (Object_Info.Utilities.Bad_Object); -- end Spec_In_Other_View; function Specs_Withed_By (This_Unit : in Ada_Unit) return Ada_Specs is begin return (Directory_Tools.Ada_Object.List_Of_Withs (This_Unit)); end Specs_Withed_By; function Dependents_Of (This_Unit : in Ada_Unit) return Ada_Units is begin return (Directory_Tools.Ada_Object.Depends_On (This_Unit)); end Dependents_Of; function Parent_Of (This_Unit : in Ada_Unit) return Ada_Unit is begin if (Object_Info.Ada.Is_Spec (This_Unit)) then return (Object_Info.Utilities.Bad_Object); elsif (Object_Info.Ada.Is_Body (This_Unit)) then return (Directory_Tools.Ada_Object.Other_Part (This_Unit)); elsif (Object_Info.Ada.Is_Subunit (This_Unit)) then return (Directory_Tools.Traversal.Parent (This_Unit)); end if; -- exception when others => return (Object_Info.Utilities.Bad_Object); -- end Parent_Of; function Subunits_Of (This_Unit : in Ada_Unit) return Subunits is begin return (Directory_Tools.Ada_Object.Subunits (This_Unit, Declared => False)); end Subunits_Of; function Body_For (This_Unit : in Ada_Unit) return Ada_Body is -- Current_Unit : Ada_Unit := This_Unit; -- begin if (Object_Info.Ada.Is_Spec (Current_Unit)) then -- Find body associated with spec. Current_Unit := Directory_Tools.Ada_Object.Other_Part (Current_Unit); elsif (Object_Info.Ada.Is_Subunit (Current_Unit)) then -- Find parents transitively until get to body. while (Directory_Tools.Ada_Object.Is_Subunit (Current_Unit)) loop Current_Unit := Object_Info.Ada.Parent_Of (Current_Unit); end loop; end if; if (not Object_Info.Ada.Is_Body (Current_Unit)) then -- Something went wrong. return (Object_Info.Utilities.Bad_Object); else return (Current_Unit); end if; -- exception when others => return (Object_Info.Utilities.Bad_Object); -- end Body_For; function Spec_For (This_Unit : in Ada_Unit) return Ada_Spec is -- Current_Unit : Ada_Unit := This_Unit; -- begin -- Find parents transitively until get to body. while (Directory_Tools.Ada_Object.Is_Subunit (Current_Unit)) loop Current_Unit := Object_Info.Ada.Parent_Of (Current_Unit); end loop; if (Object_Info.Ada.Is_Body (Current_Unit)) then -- Find spec associated with body. Current_Unit := Object_Info.Ada.Parent_Of (Current_Unit); end if; if (not Object_Info.Ada.Is_Spec (Current_Unit)) then -- Something went wrong. return (Object_Info.Utilities.Bad_Object); else return (Current_Unit); end if; -- exception when others => return (Object_Info.Utilities.Bad_Object); -- end Spec_For; end Ada;