DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦f5344b681⟧ TextFile

    Length: 42997 (0xa7f5)
    Types: TextFile
    Names: »B«

Derivation

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Diana;
with Directory;
with Object_Subclass;
with String_Utilities;
with Semantic_Attributes;
with Activity_Implementation;
package body Object_Sets is
    --
    function "=" (This_Class : in Directory_Tools.Object.Class_Enumeration;
                  That_Class : in Directory_Tools.Object.Class_Enumeration)
                 return Boolean renames Directory_Tools.Object."=";
    --
    function "=" (This_Kind : in Directory_Tools.Ada_Object.Compilation_Kind;
                  That_Kind : in Directory_Tools.Ada_Object.Compilation_Kind)
                 return Boolean renames Directory_Tools.Ada_Object."=";
    --
    function "=" (This_Kind : in Directory_Tools.Ada_Object.Unit_Kind;
                  That_Kind : in Directory_Tools.Ada_Object.Unit_Kind)
                 return Boolean renames Directory_Tools.Ada_Object."=";
    --
    function "+" (This_Set : in Object_Set; That_Set : in Object_Set)
                 return Object_Set renames Union;
    --
    function Empty_Set return Object_Set is
    begin
        return (Directory_Tools.Object.Create);
    end Empty_Set;
    --
    function Is_Empty (This_Set : in Object_Set) return Boolean is
    begin
        return (Number_In (This_Set) = 0);
    end Is_Empty;
    --
    function Number_In (This_Set : in Object_Set) return Natural is
        --
        Working_Set : Object_Set := This_Set;
        Count : Natural := 0;
        --
    begin  
        Directory_Tools.Object.Reset (Working_Set);
        while (not Directory_Tools.Object.Done (Working_Set)) loop
            Count := Count + 1;
            Directory_Tools.Object.Next (Working_Set);
        end loop;
        return (Count);
    end Number_In;
    --
    function Are_Equal (This_Set : in Object_Set; That_Set : in Object_Set)
                       return Boolean is
        --
        Working_Set : Object_Set := This_Set;
        Result : Boolean := True;
        --
    begin
        if (Number_In (This_Set) /= Number_In (That_Set)) then
            Result := False;
        else
            Directory_Tools.Object.Reset (Working_Set);
            while (not Directory_Tools.Object.Done (Working_Set)) loop
                if (not Is_Member (That_Set, Directory_Tools.Object.Value
                                                (Working_Set))) then
                    -- Found object in one set which isn't in other set.
                    Result := False;
                    exit;
                end if;
                Directory_Tools.Object.Next (Working_Set);
            end loop;
        end if;
        return (Result);
    end Are_Equal;
    --
    function Copy_Of (This_Set : in Object_Set) return Object_Set is
        --
        Working_Set : Object_Set := This_Set;
        Copy_Set : Object_Set := Empty_Set;
        --
    begin
        Directory_Tools.Object.Reset (Working_Set);  
        while (not Directory_Tools.Object.Done (Working_Set)) loop
            Add (Directory_Tools.Object.Value (Working_Set), Copy_Set);
            Directory_Tools.Object.Next (Working_Set);
        end loop;
        return (Copy_Set);
    end Copy_Of;
    --
    function Is_Member (This_Set : in Object_Set; This_Object : in Object)
                       return Boolean is
    begin
        return (Directory_Tools.Object.Has (This_Set, This_Object));
    end Is_Member;
    --
    procedure Add (This_Object : in Object; This_Set : in out Object_Set) is
        --
        Dummy : Boolean;
        --
    begin
        if ((not Directory_Tools.Object.Is_Bad (This_Object)) and
            (not Is_Member (This_Set, This_Object))) then
            Directory_Tools.Object.Add (This_Set, This_Object, Dummy);
        end if;
    end Add;
    --
    procedure Remove (This_Object : in Object; This_Set : in out Object_Set) is
        --
        Dummy : Boolean;
        --
    begin
        Directory_Tools.Object.Remove (This_Set, This_Object, Dummy);
    end Remove;
    --
    procedure Sort (This_Set : in out Object_Set) is
        --
        type Sorted_Array is array (1 .. Number_In (This_Set)) of Boolean;
        --
        Already_Sorted : Sorted_Array := (others => False);
        Remaining : Natural := Number_In (This_Set);
        Sorted_Set : Object_Set := Empty_Set;
        Smallest_This_Pass : Object;  
        Index_Of_Smallest : Natural;
        Current_Index : Natural;
        --
    begin  
        while (Remaining > 0) loop  
            Current_Index := 1;
            Directory_Tools.Object.Reset (This_Set);
            Smallest_This_Pass := Directory_Tools.Object.Value (This_Set);
            while (not Directory_Tools.Object.Done (This_Set)) loop
                if (not Already_Sorted (Current_Index)) then
                    -- Current element hasn't already been put in
                    -- the sorted array, so test it.
                    if (Directory_Tools.Object.Value (This_Set) <
                        Smallest_This_Pass) then
                        -- Current element is smaller than the smallest
                        -- element found so far on this pass, so make
                        -- it the new smallest.
                        Smallest_This_Pass :=
                           Directory_Tools.Object.Value (This_Set);
                        Index_Of_Smallest := Current_Index;
                    end if;
                end if;
                Directory_Tools.Object.Next (This_Set);  
                Current_Index := Current_Index + 1;
            end loop;
            Add (Smallest_This_Pass, Sorted_Set);
            Already_Sorted (Index_Of_Smallest) := True;
            Remaining := Remaining - 1;
        end loop;
        This_Set := Sorted_Set;
    end Sort;
    --
    procedure Filter (This_Set : in out Object_Set) is
        --
        New_Set : Object_Set := Empty_Set;
        --
    begin
        Directory_Tools.Object.Reset (This_Set);
        while (not Directory_Tools.Object.Done (This_Set)) loop
            if (not Dont_Want (Directory_Tools.Object.Value (This_Set))) then
                -- Want current object, so add it.
                Add (Directory_Tools.Object.Value (This_Set), New_Set);
            end if;
            Directory_Tools.Object.Next (This_Set);
        end loop;
        This_Set := New_Set;
    end Filter;
    --
    procedure Process_Objects (This_Set : in out Object_Set) is
    begin
        Directory_Tools.Object.Reset (This_Set);
        while (not Directory_Tools.Object.Done (This_Set)) loop
            declare
                Current_Object : Object :=
                   Directory_Tools.Object.Value (This_Set);
            begin
                Process (Current_Object);
            end;
            Directory_Tools.Object.Next (This_Set);
        end loop;
    end Process_Objects;
    --
    procedure Process_Objects_With_State (This_Set : in out Object_Set;
                                          This_State : in out Process_State) is
    begin
        Initialize (This_State);
        Directory_Tools.Object.Reset (This_Set);
        while (not Directory_Tools.Object.Done (This_Set)) loop
            declare
                Current_Object : Object :=
                   Directory_Tools.Object.Value (This_Set);
            begin
                Process (Current_Object, This_State);
            end;
            Directory_Tools.Object.Next (This_Set);
        end loop;
        Finalize (This_State);
    end Process_Objects_With_State;
    --
    function Union (This_Set : in Object_Set; That_Set : in Object_Set)
                   return Object_Set is
        --
        Union_Set : Object_Set := Empty_Set;
        --
        procedure Union_Copy (This_Set : in Object_Set;
                              New_Set : in out Object_Set) is
            --
            Working_Set : Object_Set := This_Set;
            --
        begin
            Directory_Tools.Object.Reset (Working_Set);
            while (not Directory_Tools.Object.Done (Working_Set)) loop
                Add (Directory_Tools.Object.Value (Working_Set), New_Set);
                Directory_Tools.Object.Next (Working_Set);
            end loop;
        end Union_Copy;
        --
    begin  
        Union_Copy (This_Set, Union_Set);
        Union_Copy (That_Set, Union_Set);
        return (Union_Set);
    end Union;
    --
    function Intersection (This_Set : in Object_Set; That_Set : in Object_Set)
                          return Object_Set is
        --
        Working_Set : Object_Set := This_Set;
        Intersection_Set : Object_Set := Empty_Set;
        --
    begin
        Directory_Tools.Object.Reset (Working_Set);
        while (not Directory_Tools.Object.Done (Working_Set)) loop
            if (Is_Member (That_Set,
                           Directory_Tools.Object.Value (Working_Set))) then
                -- Found an object in the one set which is also in the
                -- other set, so add it to the intersection set.
                Add (Directory_Tools.Object.Value (Working_Set),
                     Intersection_Set);
            end if;
            Directory_Tools.Object.Next (Working_Set);
        end loop;
        return (Intersection_Set);
    end Intersection;
    --
    function Exclusive_Or (This_Set : in Object_Set; That_Set : in Object_Set)
                          return Object_Set is
        --
        Xor_Set : Object_Set := Empty_Set;
        --
        procedure Xor_Copy (This_Set : in Object_Set;
                            Except_For : in Object_Set;
                            Into : in out Object_Set) is
            --
            Working_Set : Object_Set := This_Set;
            --
        begin
            Directory_Tools.Object.Reset (Working_Set);
            while (not Directory_Tools.Object.Done (Working_Set)) loop
                if (not Is_Member (Except_For, Directory_Tools.Object.Value
                                                  (Working_Set))) then
                    -- Found an object in the one set which is not also
                    -- in the other set, so add it to the new set.
                    Add (Directory_Tools.Object.Value (Working_Set), Into);
                end if;
                Directory_Tools.Object.Next (Working_Set);
            end loop;
        end Xor_Copy;
        --
    begin
        Xor_Copy (This_Set, That_Set, Xor_Set);
        Xor_Copy (That_Set, This_Set, Xor_Set);
        return (Xor_Set);
    end Exclusive_Or;
    --
    function Subtraction (This_Set : in Object_Set; Except_For : in Object_Set)
                         return Object_Set is
        --
        Working_Set : Object_Set := This_Set;
        Subtraction_Set : Object_Set := Empty_Set;
        --
    begin
        Directory_Tools.Object.Reset (Working_Set);
        while (not Directory_Tools.Object.Done (Working_Set)) loop
            if (not Is_Member (Except_For,
                               Directory_Tools.Object.Value (Working_Set))) then
                -- Found an object in the one set which is not also
                -- in the other set, so add it to the subtraction set.
                Add (Directory_Tools.Object.Value (Working_Set),
                     Subtraction_Set);
            end if;
            Directory_Tools.Object.Next (Working_Set);
        end loop;
        return (Subtraction_Set);
    end Subtraction;
    --
    function Subset (This_Set : in Object_Set; Contains : in Object_Set)
                    return Boolean is
        --
        Working_Set : Object_Set := Contains;
        Result : Boolean := True;
        --
    begin  
        Directory_Tools.Object.Reset (Working_Set);
        while (not Directory_Tools.Object.Done (Working_Set)) loop
            if (not Is_Member (This_Set,
                               Directory_Tools.Object.Value (Working_Set))) then
                -- Found an object in "Contains" which is not in the
                -- other set, so is not a subset of the other set.
                Result := False;
                exit;
            end if;
            Directory_Tools.Object.Next (Working_Set);
        end loop;
        return (Result);
    end Subset;
    --
    function Proper_Subset (This_Set : in Object_Set; Contains : in Object_Set)
                           return Boolean is
    begin
        return (Subset (This_Set, Contains) and
                (Number_In (This_Set) > Number_In (Contains)));
    end Proper_Subset;
    --
    function Is_Universe_Mirror (This_Unit : in Object) return Boolean is
        --
        -- Diana hacking because no predicate is available.
        --
        The_Root : Directory.Ada.Root;
        The_Status : Directory.Error_Status;  
        Object_Id : Diana.Tree;
        Pragmas : Diana.Sequence;
        --
        Is_Subsystem_Interface : Boolean := False;
        Has_Module_Name : Boolean := False;
        --
    begin
        -- 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);
        -- See if is a subsystem interface.
        Is_Subsystem_Interface :=
           Semantic_Attributes.Has_Sm_Subsystem_Interface (Object_Id);
        if (Is_Subsystem_Interface) 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
                    Has_Module_Name := True;
                    exit;
                end if;
                Pragmas := Diana.Tail (Pragmas);
            end loop;  
        end if;
        return (Is_Subsystem_Interface and Has_Module_Name);
    end Is_Universe_Mirror;
    --
    function Is_Spec (This_Object : in Object) return Boolean is
    begin
        return (Directory_Tools.Ada_Object.Is_Visible_Part (This_Object));
    end Is_Spec;
    --
    procedure Screen (These_Units : in out Object_Set;
                      Exclude : in Object_Set;
                      Specs_Only : in Boolean;
                      Include_Universe_Mirrors : in Boolean) is
        --
        Screened : Object_Set := Empty_Set;
        --
        Current : Object;
        --
    begin
        Directory_Tools.Object.Reset (These_Units);
        while (not Directory_Tools.Object.Done (These_Units)) loop
            Current := Directory_Tools.Object.Value (These_Units);
            if (Directory_Tools.Object.Is_Bad (Current)) then
                -- Current unit is bad, so don't add it.
                null;  
            elsif (Directory_Tools.Object.Has (Exclude, Current)) then
                -- Already have the current unit, so don't add it.
                null;
            elsif ((Specs_Only) and then (not Is_Spec (Current))) then
                -- Client wants specs only, and current unit is not a spec,
                -- so don't add it.
                null;
            elsif ((not Include_Universe_Mirrors) and then
                   (Is_Universe_Mirror (Current))) then
                -- Client doesn't want universe mirrors, and current unit is
                -- a universe mirror, so don't add it.
                null;
            else
                -- Current unit met all criteria, so add it.
                Add (Current, Screened);
            end if;
            Directory_Tools.Object.Next (These_Units);
        end loop;  
        These_Units := Screened;
    end Screen;
    --
    generic

        with function Immediate_Dependencies
                         (This_Object : in Object;
                          Code_Share_Generics : in Boolean;
                          This_Activity : in Activity.Activity_Name)
                         return Object_Set;

    function Single_Unit_Dependency_Closure
                (Unit : in Object;
                 Specs_Only : in Boolean := False;
                 Transitive : in Boolean := True;
                 Include_Universe_Mirrors : in Boolean := False;
                 Code_Share_Generics : in Boolean := True;
                 This_Activity : in Activity.Activity_Name := Activity.Nil)
                return Object_Set;

    function Single_Unit_Dependency_Closure
                (Unit : in Object;
                 Specs_Only : in Boolean := False;
                 Transitive : in Boolean := True;
                 Include_Universe_Mirrors : in Boolean := False;
                 Code_Share_Generics : in Boolean := True;
                 This_Activity : in Activity.Activity_Name := Activity.Nil)
                return Object_Set is
        --
        Closure : Object_Set := Empty_Set;
        New_Units : Object_Set := Empty_Set;
        --
        procedure Get_Next_Units (These_Units : in out Object_Set) is
            --
            New_Units : Object_Set := Empty_Set;
            --
        begin
            Directory_Tools.Object.Reset (These_Units);
            while (not Directory_Tools.Object.Done (These_Units)) loop
                New_Units := New_Units +
                                Immediate_Dependencies
                                   (Directory_Tools.Object.Value (These_Units),
                                    Code_Share_Generics, This_Activity);  
                Directory_Tools.Object.Next (These_Units);
            end loop;  
            These_Units := New_Units;
        end Get_Next_Units;
        --
    begin  
        New_Units := Immediate_Dependencies
                        (Unit, Code_Share_Generics, This_Activity);
        loop
            Screen (New_Units, Closure, Specs_Only, Include_Universe_Mirrors);
            Closure := Closure + New_Units;
            if (not Transitive) then
                -- Only needed to calculate first level.
                exit;
            elsif (Is_Empty (New_Units)) then
                -- There were no new units, so closure is complete.
                exit;
            else
                -- There are more units requiring processing.
                Get_Next_Units (New_Units);  
            end if;
        end loop;
        return (Closure);
    end Single_Unit_Dependency_Closure;
    --
    generic

        with function Single_Unit_Dependency_Closure_Instantiation
                         (Unit : in Object;
                          Specs_Only : in Boolean := False;
                          Transitive : in Boolean := True;
                          Include_Universe_Mirrors : in Boolean := False;
                          Code_Share_Generics : in Boolean := True;
                          This_Activity : in
                             Activity.Activity_Name := Activity.Nil)
                         return Object_Set;

    function Multiple_Unit_Dependency_Closure
                (Units : in Object_Set;
                 Specs_Only : in Boolean := False;
                 Transitive : in Boolean := True;
                 Include_Universe_Mirrors : in Boolean := False;
                 Code_Share_Generics : in Boolean := True;
                 This_Activity : in Activity.Activity_Name := Activity.Nil)
                return Object_Set;

    function Multiple_Unit_Dependency_Closure
                (Units : in Object_Set;
                 Specs_Only : in Boolean := False;
                 Transitive : in Boolean := True;
                 Include_Universe_Mirrors : in Boolean := False;
                 Code_Share_Generics : in Boolean := True;
                 This_Activity : in Activity.Activity_Name := Activity.Nil)
                return Object_Set is
        --
        Working_Set : Object_Set := Units;
        Closure : Object_Set := Empty_Set;
        --
    begin
        Directory_Tools.Object.Reset (Working_Set);
        while (not Directory_Tools.Object.Done (Working_Set)) loop
            Closure := Closure + Single_Unit_Dependency_Closure_Instantiation
                                    (Directory_Tools.Object.Value (Working_Set),
                                     Specs_Only, Transitive,
                                     Include_Universe_Mirrors,
                                     Code_Share_Generics, This_Activity);
            Directory_Tools.Object.Next (Working_Set);
        end loop;  
        return (Closure);
    end Multiple_Unit_Dependency_Closure;
    --
    -- ***** UNTIL NEXT MARK LIKE THIS, CAN BE REPLACED BY OBJECT_INFO.
    --
    function Subclasses_Equal
                (This_Object : in Object; This_Subclass : in Directory.Subclass)
                return Boolean is
        --
        function "=" (This_Subclass : in Directory.Subclass;
                      That_Subclass : in Directory.Subclass) return Boolean
            renames Directory."=";
        --
        function "=" (This_Error_Status : in Directory.Error_Status;
                      That_Error_Status : in Directory.Error_Status)
                     return Boolean renames Directory."=";
        --
        The_Object : Directory.Object;
        The_Subclass : Directory.Subclass;  
        The_Status : Directory.Error_Status;
        --
    begin
        Directory_Tools.Object.Low_Level.Get_Object
           (This_Object, The_Object, The_Status);
        The_Subclass := Directory.Get_Subclass (The_Object);
        return ((The_Status = Directory.Successful) and
                (The_Subclass = This_Subclass));
    end Subclasses_Equal;
    --
    function Is_Spec_View (This_Object : in Directory_Tools.Object.Handle)
                          return Boolean is
    begin
        return (Subclasses_Equal (This_Object,
                                  Object_Subclass.Spec_View_Subclass));
    end Is_Spec_View;
    --
    function Is_Load_View (This_Object : in Directory_Tools.Object.Handle)
                          return Boolean is
    begin
        return (Subclasses_Equal (This_Object,
                                  Object_Subclass.Load_View_Subclass));
    end Is_Load_View;
    --
    generic

        with function Is_Correct_Kind
                         (This_Library : in Directory_Tools.Object.Handle)
                         return Boolean;

    function Is_Enclosed (This_Object : in Object) return Boolean;
    --
    function Is_Enclosed (This_Object : in Object) return Boolean is
        --
        -- This function finds successive enclosing libraries of the original
        -- object and tests each one to determine if it is the correct kind
        -- or not.
        --
        Current_Library : Object;
        --
        Result : Boolean := False;
        --
    begin  
        if (Directory_Tools.Naming.Full_Name (This_Object) = "!") then
            -- Cannot be contained by anything, because already at root.
            Result := False;
        else  
            Current_Library := Directory_Tools.Traversal.  
                                  Enclosing_Library (This_Object);
            loop  
                if (Is_Correct_Kind (Current_Library)) then
                    -- Found an enclosing library of the correct kind.
                    Result := True;
                    exit;
                elsif (Directory_Tools.Naming.  
                       Full_Name (Current_Library) = "!") then
                    -- Worked our way all the way up to the root without finding
                    -- an enclosing object of the correct kind.
                    exit;
                else
                    -- Keep looking.
                    Current_Library := Directory_Tools.Traversal.  
                                          Enclosing_Library (Current_Library);
                end if;
            end loop;
        end if;
        return (Result);
    end Is_Enclosed;
    --
    function Is_Enclosed_By_Spec_View is new Is_Enclosed (Is_Spec_View);

    function Is_Contained_By_Spec_View
                (This_Object : in Directory_Tools.Object.Handle)
                return Boolean is
    begin
        return (Is_Enclosed_By_Spec_View (This_Object));
    end Is_Contained_By_Spec_View;
    --
    function Is_Enclosed_By_Load_View is new Is_Enclosed (Is_Load_View);
    --
    function Is_Contained_By_Load_View
                (This_Object : in Directory_Tools.Object.Handle)
                return Boolean is
    begin
        return (Is_Enclosed_By_Load_View (This_Object));
    end Is_Contained_By_Load_View;
    --
    -- ****** END OF STUFF THAT CAN BE REPLACED BY OBJECT_INFO.
    -- ****** SOME OF THE STUFF BELOW SHOULD BE ADDED TO OBJECT_INFO.
    --
    function Is_Spec_In_Spec_View (This_Object : in Object) return Boolean is
        --
        -- Returns True if the specified object is a spec in a view.
        --
    begin
        return ((Is_Spec (This_Object)) and then
                (Is_Contained_By_Spec_View (This_Object)));
    end Is_Spec_In_Spec_View;
    --
    function Is_Spec_In_Load_View (This_Object : in Object) return Boolean is
        --
        -- Returns True if the specified object is a spec in a view.
        --
    begin
        return ((Is_Spec (This_Object)) and then
                (Is_Contained_By_Load_View (This_Object)));
    end Is_Spec_In_Load_View;
    --
    function Is_Subsystem (This_Object : in Object) return Boolean is
    begin
        return ((Subclasses_Equal
                    (This_Object, Object_Subclass.Subsystem_Subclass)) or
                (Subclasses_Equal
                    (This_Object, Object_Subclass.
                                     Spec_Load_Subsystem_Subclass)) or  
                (Subclasses_Equal
                    (This_Object, Object_Subclass.
                                     Combined_Subsystem_Subclass)));
    end Is_Subsystem;
    --
    function Is_Root (This_Object : in Object) return Boolean is
    begin
        return (Directory_Tools.Naming.Full_Name (This_Object) = "!");
    end Is_Root;
    --
    function Bogus_Object return Object is
    begin
        return (Directory_Tools.Naming.Resolution ("%*$&"));
    end Bogus_Object;
    --
    function Subsystem_Containing (This_Object : in Object) return Object is
        --
        Current_Library : Object := This_Object;
        --
    begin
        loop  
            if (Is_Root (Current_Library)) then
                Current_Library := Bogus_Object;
                exit;
            else
                Current_Library := Directory_Tools.Traversal.Enclosing_Library
                                      (Current_Library);
                if (Is_Subsystem (Current_Library)) then
                    -- Found the enclosing subsystem.
                    exit;
                end if;
            end if;
        end loop;
        return (Current_Library);
    end Subsystem_Containing;
    --
    function Spec_In_Other_View
                (This_Object : in Object;
                 This_Activity : in Activity.Activity_Name) return Object is
        --
        -- If the specified object is a spec in a view, returns the spec
        -- associated with it in the other view, as specified by the
        -- activity. If no such spec exists, returns a bogus object.
        --
        Subsystem_Id : Activity_Implementation.Subsystem_Id;
        Activity_Id : Activity_Implementation.Activity_Id;
        Activity_Handle : Activity_Implementation.Activity_Handle;
        Name_Status : Directory.Naming.Name_Status;
        Error_Status : Directory.Error_Status;  
        Current_View : Directory.Object;
        Other_View : Directory.Object;
        Other_Spec : Object := Bogus_Object;
        --
        function Spec_Matching
                    (Current_Spec : in Object;
                     View_Containing_Current_Spec : in Directory.Object;
                     View_Containing_Other_Spec : in Directory.Object)
                    return Object is
            --
            Name_Of_View_Containing_Current_Spec : constant String :=
               Directory.Naming.Get_Full_Name (View_Containing_Current_Spec);
            Name_Of_View_Containing_Other_Spec : constant String :=
               Directory.Naming.Get_Full_Name (View_Containing_Other_Spec);
            Name_Of_Current_Spec : constant String :=
               Directory_Tools.Naming.Full_Name (Current_Spec);
            Name_Of_Other_Spec : constant String :=
               Name_Of_View_Containing_Other_Spec &
                  Name_Of_Current_Spec
                     ((Name_Of_Current_Spec'First +
                       Name_Of_View_Containing_Current_Spec'Length) ..
                         Name_Of_Current_Spec'Last);
            --
        begin
            return (Directory_Tools.Naming.Resolution (Name_Of_Other_Spec));
        end Spec_Matching;
        --
    begin  
        Directory.Naming.Resolve
           (Name => Directory_Tools.Naming.Full_Name
                       (Subsystem_Containing (This_Object)),
            The_Object => Subsystem_Id,
            Status => Name_Status);
        Directory.Naming.Resolve (Name => This_Activity,
                                  The_Object => Activity_Id,
                                  Status => Name_Status);
        Activity_Implementation.Open
           (Activity_Id, Activity_Handle, Error_Status);  
        if (Is_Spec_In_Spec_View (This_Object)) then  
            Current_View := Activity_Implementation.Get_Spec_View
                               (Subsystem_Id, Activity_Handle);
            Other_View := Activity_Implementation.Get_Load_View
                             (Subsystem_Id, Activity_Handle);
            Other_Spec := Spec_Matching (This_Object, Current_View, Other_View);
        elsif (Is_Spec_In_Load_View (This_Object)) then
            Current_View := Activity_Implementation.Get_Load_View
                               (Subsystem_Id, Activity_Handle);
            Other_View := Activity_Implementation.Get_Spec_View
                             (Subsystem_Id, Activity_Handle);
            Other_Spec := Spec_Matching (This_Object, Current_View, Other_View);
        end if;
        Activity_Implementation.Close (Activity_Handle, Error_Status);
        return (Other_Spec);
        --
    exception
        when others =>
            return (Other_Spec);
            --
    end Spec_In_Other_View;
    --
    function Spec_For (This_Object : in Object) return Object is
        --
        -- For a subunit or body, returns the spec associated with
        -- the subunit or body. For a spec, returns the spec itself.
        --
        Current_Object : Object := This_Object;
        --
    begin
        -- First, find parents transitively until get to body.
        while (Directory_Tools.Ada_Object.Is_Subunit (Current_Object)) loop
            Current_Object := Directory_Tools.Traversal.Parent (Current_Object);
        end loop;  
        if (not Is_Spec (Current_Object)) then
            -- Find spec associated with body.
            Current_Object :=
               Directory_Tools.Ada_Object.Other_Part (Current_Object);
        end if;
        return (Current_Object);
    end Spec_For;
    --
    function Is_Body (This_Object : in Object) return Boolean is
        --
        -- Returns True if the specified object is a body.
        --
        Unit_Kind : Directory_Tools.Ada_Object.Unit_Kind :=
           Directory_Tools.Ada_Object.Kind (This_Object);
        --
    begin
        return ((Unit_Kind = Directory_Tools.Ada_Object.Package_Body) or
                (Unit_Kind = Directory_Tools.Ada_Object.Procedure_Body) or
                (Unit_Kind = Directory_Tools.Ada_Object.Function_Body));
    end Is_Body;
    --
    function Is_Subunit (This_Object : in Object) return Boolean is
        --
        -- Returns True if the specified object is a subunit.
        --
        Compilation_Kind : Directory_Tools.Ada_Object.Compilation_Kind :=
           Directory_Tools.Ada_Object.Kind (This_Object);
        --
    begin
        return (Compilation_Kind = Directory_Tools.Ada_Object.Subunit);
    end Is_Subunit;
    --
    function Is_Body_Or_Subunit (This_Object : in Object) return Boolean is
        --
        -- Returns True if the specified object is a body or subunit.
        --
    begin
        return ((Is_Body (This_Object)) or (Is_Subunit (This_Object)));
    end Is_Body_Or_Subunit;
    --
    function Is_Generic_Spec (This_Object : in Object) return Boolean is
        --
        -- Returns True if the spec specified object is a generic spec.
        --
        Object_Kind : Directory_Tools.Ada_Object.Unit_Kind :=
           Directory_Tools.Ada_Object.Kind (This_Object);
        --
    begin
        return ((Is_Spec (This_Object)) and then
                ((Object_Kind = Directory_Tools.Ada_Object.  
                                   Generic_Package) or
                 (Object_Kind = Directory_Tools.Ada_Object.Generic_Procedure) or
                 (Object_Kind = Directory_Tools.Ada_Object.Generic_Function)));
    end Is_Generic_Spec;
    --
    function Spec_Is_Generic_For (This_Object : in Object) return Boolean is
        --
        -- Returns True if the spec associated with the specified object
        -- is a generic spec.
        --
    begin
        return (Is_Generic_Spec (Spec_For (This_Object)));
    end Spec_Is_Generic_For;
    --
    function Immediate_Dependencies_On
                (This_Object : in Object;
                 Code_Share_Generics : in Boolean;
                 This_Activity : in Activity.Activity_Name) return Object_Set is
        --
        Dependencies : Object_Set :=
           Directory_Tools.Ada_Object.Depends_On (This_Object);
        --
    begin
        -- Deal with question of code sharing.
        if ((not Code_Share_Generics) and then
            (Is_Body_Or_Subunit (This_Object)) and then
            (Spec_Is_Generic_For (This_Object))) then
            -- Current object is body or subunit associated with
            -- a generic spec, and generic bodies are not code-shared.
            -- Therefore, the current object will be macro-
            -- inline expanded, and dependencies on the current
            -- object include dependencies on its spec.
            Dependencies := Dependencies + Directory_Tools.Ada_Object.Depends_On
                                              (Spec_For (This_Object));
        end if;
        -- Perform spec look-through.
        if (Is_Spec_In_Load_View (This_Object)) then
            -- The object is a spec in a load view, so it has an associated spec
            -- in a spec view. Anything that depends on the spec in the spec view
            -- in actuality depends on the current object, so add the spec view
            -- spec to the dependencies (so that the next pass will get the
            -- dependencies on it).
            Add (Spec_In_Other_View (This_Object, This_Activity), Dependencies);
        end if;
        return (Dependencies);
    end Immediate_Dependencies_On;
    --
    function Dependencies_On_Single_Unit is
       new Single_Unit_Dependency_Closure (Immediate_Dependencies_On);
    --
    function Dependencies_On
                (Unit : in Object;
                 Specs_Only : in Boolean := False;
                 Transitive : in Boolean := True;
                 Include_Universe_Mirrors : in Boolean := False;
                 Code_Share_Generics : in Boolean := True;
                 This_Activity : in Activity.Activity_Name := Activity.Nil)
                return Object_Set is
    begin
        return (Dependencies_On_Single_Unit
                   (Unit, Specs_Only, Transitive, Include_Universe_Mirrors,
                    Code_Share_Generics, This_Activity));
    end Dependencies_On;
    --
    function Dependencies_On_Multiple_Units is
       new Multiple_Unit_Dependency_Closure (Dependencies_On);
    --
    function Dependencies_On
                (Units : in Object_Set;
                 Specs_Only : in Boolean := False;
                 Transitive : in Boolean := True;
                 Include_Universe_Mirrors : in Boolean := False;
                 Code_Share_Generics : in Boolean := True;
                 This_Activity : in Activity.Activity_Name := Activity.Nil)
                return Object_Set is
    begin
        return (Dependencies_On_Multiple_Units
                   (Units, Specs_Only, Transitive, Include_Universe_Mirrors,
                    Code_Share_Generics, This_Activity));
    end Dependencies_On;
    --
    function Immediate_Dependencies_By
                (This_Object : in Object;
                 Code_Share_Generics : in Boolean;
                 This_Activity : in Activity.Activity_Name) return Object_Set is
        --
        Dependencies : Object_Set := Withed_Objects (This_Object);
        --
        Families_Of_Generic_Specs : Object_Set := Empty_Set;
        --
        Specs_In_Load_Views : Object_Set := Empty_Set;
        --
    begin
        -- Deal with bodies and subunits.
        if (Is_Subunit (This_Object)) then
            Add (Directory_Tools.Traversal.Parent (This_Object), Dependencies);
        elsif (Is_Body (This_Object)) then
            Add (Directory_Tools.Ada_Object.Other_Part (This_Object),
                 Dependencies);
        end if;
        -- Deal with question of code sharing.
        if (not Code_Share_Generics) then
            Directory_Tools.Object.Reset (Dependencies);
            while (not Directory_Tools.Object.Done (Dependencies)) loop
                if (Is_Generic_Spec (Directory_Tools.Object.Value
                                        (Dependencies))) then
                    -- The object depends on a generic spec. Since the body and
                    -- subunits of the generic spec are not code-shared, they
                    -- will be macro-inline expanded. Therefore, the object
                    -- depends on the entire family of the generic spec.
                    Families_Of_Generic_Specs :=
                       Families_Of_Generic_Specs +
                          Family (Directory_Tools.Object.Value (Dependencies));
                end if;
                Directory_Tools.Object.Next (Dependencies);
            end loop;
        end if;
        Dependencies := Dependencies + Families_Of_Generic_Specs;
        -- Perform spec look-through.
        Directory_Tools.Object.Reset (Dependencies);
        while (not Directory_Tools.Object.Done (Dependencies)) loop
            if (Is_Spec_In_Spec_View
                   (Directory_Tools.Object.Value (Dependencies))) then
                -- The object depends on a spec in a spec view. So add
                -- the associated spec in the load view to the dependencies.
                Add (Spec_In_Other_View
                        (Directory_Tools.Object.Value (Dependencies),
                         This_Activity), Specs_In_Load_Views);
            end if;
            Directory_Tools.Object.Next (Dependencies);
        end loop;  
        Dependencies := Dependencies + Specs_In_Load_Views;
        return (Dependencies);
    end Immediate_Dependencies_By;
    --
    function Dependencies_By_Single_Unit is
       new Single_Unit_Dependency_Closure (Immediate_Dependencies_By);
    --
    function Dependencies_By
                (Unit : in Object;
                 Specs_Only : in Boolean := False;
                 Transitive : in Boolean := True;
                 Include_Universe_Mirrors : in Boolean := False;
                 Code_Share_Generics : in Boolean := True;
                 This_Activity : in Activity.Activity_Name := Activity.Nil)
                return Object_Set is
    begin
        return (Dependencies_By_Single_Unit
                   (Unit, Specs_Only, Transitive, Include_Universe_Mirrors,
                    Code_Share_Generics, This_Activity));
    end Dependencies_By;
    --
    function Dependencies_By_Multiple_Units is
       new Multiple_Unit_Dependency_Closure (Dependencies_By);
    --
    function Dependencies_By
                (Units : in Object_Set;
                 Specs_Only : in Boolean := False;
                 Transitive : in Boolean := True;
                 Include_Universe_Mirrors : in Boolean := False;
                 Code_Share_Generics : in Boolean := True;
                 This_Activity : in Activity.Activity_Name := Activity.Nil)
                return Object_Set is
    begin
        return (Dependencies_By_Multiple_Units
                   (Units, Specs_Only, Transitive, Include_Universe_Mirrors,
                    Code_Share_Generics, This_Activity));
    end Dependencies_By;
    --
    function Withed_Objects (Unit : in Object) return Object_Set is
    begin
        return (Directory_Tools.Ada_Object.List_Of_Withs (Unit));
    end Withed_Objects;
    --
    function Immediate_Family_Dependencies_On
                (This_Object : in Object;
                 Code_Share_Generics : in Boolean;
                 This_Activity : in Activity.Activity_Name) return Object_Set is
        --
        Dependencies : Object_Set := Directory_Tools.Ada_Object.Subunits
                                        (This_Object, Declared => False);
        --
    begin  
        if (Is_Spec (This_Object)) then
            -- Add body.
            Add (Directory_Tools.Ada_Object.Other_Part (This_Object),
                 Dependencies);
            -- Add subunits.
            Dependencies :=
               Dependencies + Directory_Tools.Ada_Object.Subunits
                                 (Directory_Tools.Ada_Object.Other_Part
                                     (This_Object));
            -- Perform spec look-through.
            if (Is_Spec_In_Spec_View (This_Object)) then
                Add (Spec_In_Other_View (This_Object, This_Activity),
                     Dependencies);
            end if;
        elsif (Is_Body_Or_Subunit (This_Object)) then
            -- Add subunits.
            Dependencies :=
               Dependencies + Directory_Tools.Ada_Object.Subunits (This_Object);
        end if;
        return (Dependencies);
    end Immediate_Family_Dependencies_On;
    --
    function Family_Dependencies_On is
       new Single_Unit_Dependency_Closure (Immediate_Family_Dependencies_On);
    --
    function Family (Unit : in Object;
                     This_Activity : in Activity.Activity_Name := Activity.Nil)
                    return Object_Set is
        --
        Family_Dependencies : Object_Set :=
           Family_Dependencies_On (Unit,
                                   Specs_Only => False,
                                   Transitive => True,
                                   Include_Universe_Mirrors => True,
                                   Code_Share_Generics => True,
                                   This_Activity => This_Activity);
        --
    begin
        Add (Unit, Family_Dependencies);
        return (Family_Dependencies);
    end Family;
    --
end Object_Sets;