⟦ef0f7a20c⟧

TextFile

with Object_Set;
with Object_Subclass;
with String_Utilities;

package body Object_Info is

    generic

        with function Is_Desired
                         (This_Object : in Directory_Tools.Object.Handle)
                         return Boolean;

    function Desired_Objects_From
                (This_Object : in Directory_Tools.Object.Handle;
                 Recursive : in Boolean) return Directory_Tools.Object.Iterator;

    function Desired_Objects_From
                (This_Object : in Directory_Tools.Object.Handle;
                 Recursive : in Boolean)
                return Directory_Tools.Object.Iterator is

        --
        All_Objects : Directory_Tools.Object.Iterator :=
           Object_Info.Any.All_Objects_In (This_Object, Recursive);
        --
        Desired_Objects : Directory_Tools.Object.Iterator :=
           Directory_Tools.Object.Create;
        --
        Dummy : Boolean;
        --
    begin
        Directory_Tools.Object.Reset (All_Objects);
        while (not Directory_Tools.Object.Done (All_Objects)) loop
            if (Is_Desired (Directory_Tools.Object.Value (All_Objects))) then
                Directory_Tools.Object.Add
                   (Desired_Objects,
                    Directory_Tools.Object.Value (All_Objects), Dummy);
            end if;
            Directory_Tools.Object.Next (All_Objects);
        end loop;  
        return (Desired_Objects);
    end Desired_Objects_From;

    generic

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

    function Is_Enclosed
                (This_Object : in Directory_Tools.Object.Handle) return Boolean;

    function Is_Enclosed (This_Object : in Directory_Tools.Object.Handle)
                         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 : Directory_Tools.Object.Handle;
        --
        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;

    package body Any is

        function Number_Of_Objects_In
                    (This_Iterator : in Directory_Tools.Object.Iterator)
                    return Natural is
            --
            The_Objects : Directory_Tools.Object.Iterator := This_Iterator;
            --
            Count : Natural := 0;
            --
        begin
            Directory_Tools.Object.Reset (The_Objects);
            while (not Directory_Tools.Object.Done (The_Objects)) loop
                Count := Count + 1;
                Directory_Tools.Object.Next (The_Objects);
            end loop;
            return (Count);
        end Number_Of_Objects_In;

        function Number_Of_Objects_Enclosed_By
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Natural is
        begin  
            if (Recursive) then
                return (Number_Of_Objects_In
                           (Directory_Tools.Naming.Resolution
                               (Directory_Tools.Naming.Full_Name (This_Object) &
                                ".@??")));
            else
                return (Number_Of_Objects_In
                           (Directory_Tools.Naming.Resolution
                               (Directory_Tools.Naming.Full_Name (This_Object) &
                                ".@")));
            end if;
        end Number_Of_Objects_Enclosed_By;

        function Classes_Equal
                    (This_Object : in Directory_Tools.Object.Handle;
                     This_Class : in Directory_Tools.Object.Class_Enumeration)
                    return Boolean is
        begin
            return (Directory_Tools.Object.Equal
                       (Directory_Tools.Object.Class (This_Object),
                        This_Class));
        end Classes_Equal;

        function Subclasses_Equal
                    (This_Object : in Directory_Tools.Object.Handle;
                     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_Good (This_Object : in Directory_Tools.Object.Handle)
                         return Boolean is
        begin
            return (not Directory_Tools.Object.Is_Bad (This_Object));
        end Is_Good;

        function Is_Bad (This_Object : in Directory_Tools.Object.Handle)
                        return Boolean is
        begin
            return (Directory_Tools.Object.Is_Bad (This_Object));
        end Is_Bad;

        function Is_Library (This_Object : in Directory_Tools.Object.Handle)
                            return Boolean is
        begin
            return (Directory_Tools.Library_Object.Is_Library (This_Object));
        end Is_Library;

        function Is_Directory (This_Object : in Directory_Tools.Object.Handle)
                              return Boolean is
        begin
            return (Directory_Tools.Library_Object.Is_Directory (This_Object));
        end Is_Directory;

        function Is_World (This_Object : in Directory_Tools.Object.Handle)
                          return Boolean is
        begin
            return (Directory_Tools.Library_Object.Is_World (This_Object));
        end Is_World;

        function Is_Simple_World
                    (This_Object : in Directory_Tools.Object.Handle)
                    return Boolean is
        begin
            return ((Is_World (This_Object)) and
                    (not Is_Subsystem (This_Object)) and
                    (not Is_View (This_Object)));
        end Is_Simple_World;

        function Is_Subsystem (This_Object : in Directory_Tools.Object.Handle)
                              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_View (This_Object : in Directory_Tools.Object.Handle)
                         return Boolean is
        begin
            return ((Subclasses_Equal
                        (This_Object, Object_Subclass.Spec_View_Subclass) or
                     Subclasses_Equal
                        (This_Object, Object_Subclass.Load_View_Subclass) or
                     Subclasses_Equal
                        (This_Object, Object_Subclass.Combined_View_Subclass)));
        end Is_View;

        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;

        function Is_Regular_Load_View
                    (This_Object : in Directory_Tools.Object.Handle)
                    return Boolean is
        begin
            return ((Subclasses_Equal (This_Object,
                                       Object_Subclass.Load_View_Subclass)) and
                    (not Is_Coded_Load_View (This_Object)));
        end Is_Regular_Load_View;

        function Is_Coded_Load_View
                    (This_Object : in Directory_Tools.Object.Handle)
                    return Boolean is
            --
            -- Since there is no Code_View subclass, we need
            -- to test for the presence or absence of a code
            -- database. This kludge will hopefully go away
            -- soon.
            --
        begin
            return (Object_Info.Any.Is_Good
                       (Directory_Tools.Naming.Resolution
                           (Directory_Tools.Naming.Full_Name (This_Object) &
                            ".CODE_DATABASE")));
        end Is_Coded_Load_View;

        function Is_Combined_View
                    (This_Object : in Directory_Tools.Object.Handle)
                    return Boolean is
        begin
            return (Subclasses_Equal (This_Object,
                                      Object_Subclass.Combined_View_Subclass));
        end Is_Combined_View;

        function Is_Simple_Object
                    (This_Object : in Directory_Tools.Object.Handle)
                    return Boolean is
        begin
            return ((Is_Good (This_Object)) and  
                    (not Is_Library (This_Object)));
        end Is_Simple_Object;

        function Is_Ada_Unit (This_Object : in Directory_Tools.Object.Handle)
                             return Boolean is
        begin
            return (Classes_Equal (This_Object,
                                   Directory_Tools.Object.Ada_Class));
        end Is_Ada_Unit;

        function Is_File (This_Object : in Directory_Tools.Object.Handle)
                         return Boolean is
        begin
            return (Classes_Equal (This_Object,
                                   Directory_Tools.Object.File_Class));
        end Is_File;

        function Is_Misc_Simple_Object
                    (This_Object : in Directory_Tools.Object.Handle)
                    return Boolean is
        begin
            return ((Is_Simple_Object (This_Object)) and
                    (not Is_Ada_Unit (This_Object)) and
                    (not Is_File (This_Object)));
        end Is_Misc_Simple_Object;

        function Is_Frozen (This_Object : in Directory_Tools.Object.Handle)
                           return Boolean is
        begin
            return (Directory_Tools.Any_Object.Is_Frozen (This_Object));
        end Is_Frozen;

        function Contains_Libraries
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Libraries_In (This_Object, Recursive)) > 0);
        end Contains_Libraries;

        function Contains_Directories
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Directories_In (This_Object, Recursive)) > 0);
        end Contains_Directories;

        function Contains_Worlds
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Worlds_In (This_Object, Recursive)) > 0);
        end Contains_Worlds;

        function Contains_Simple_Worlds
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Simple_Worlds_In (This_Object, Recursive)) > 0);
        end Contains_Simple_Worlds;

        function Contains_Subsystems
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Subsystems_In (This_Object, Recursive)) > 0);
        end Contains_Subsystems;

        function Contains_Views
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Views_In (This_Object, Recursive)) > 0);
        end Contains_Views;

        function Contains_Spec_Views
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Spec_Views_In (This_Object, Recursive)) > 0);
        end Contains_Spec_Views;

        function Contains_Load_Views
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Load_Views_In (This_Object, Recursive)) > 0);
        end Contains_Load_Views;

        function Contains_Regular_Load_Views
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Regular_Load_Views_In (This_Object, Recursive)) > 0);
        end Contains_Regular_Load_Views;

        function Contains_Coded_Load_Views
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Coded_Load_Views_In (This_Object, Recursive)) > 0);
        end Contains_Coded_Load_Views;

        function Contains_Combined_Views
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Combined_Views_In (This_Object, Recursive)) > 0);
        end Contains_Combined_Views;

        function Contains_Simple_Objects
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Simple_Objects_In (This_Object, Recursive)) > 0);
        end Contains_Simple_Objects;

        function Contains_Ada_Units
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Ada_Units_In (This_Object, Recursive)) > 0);
        end Contains_Ada_Units;

        function Contains_Files
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Files_In (This_Object, Recursive)) > 0);
        end Contains_Files;

        function Contains_Misc_Simple_Objects
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Misc_Simple_Objects_In (This_Object, Recursive)) > 0);
        end Contains_Misc_Simple_Objects;

        function Contains_Frozen_Objects
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Number_Of_Objects_In  
                       (Frozen_Objects_In (This_Object, Recursive)) > 0);
        end Contains_Frozen_Objects;

        function Is_Enclosed_By_Subsystem is new Is_Enclosed (Is_Subsystem);

        function Is_Contained_By_Subsystem
                    (This_Object : in Directory_Tools.Object.Handle)
                    return Boolean is
        begin
            return (Is_Enclosed_By_Subsystem (This_Object));
        end Is_Contained_By_Subsystem;

        function Is_Enclosed_By_View is new Is_Enclosed (Is_View);

        function Is_Contained_By_View
                    (This_Object : in Directory_Tools.Object.Handle)
                    return Boolean is
        begin
            return (Is_Enclosed_By_View (This_Object));
        end Is_Contained_By_View;

        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;

        function Is_Contained_By_Units_Directory_Of_View
                    (This_Object : in Directory_Tools.Object.Handle)
                    return Boolean is
            --
            Current_Library : Directory_Tools.Object.Handle := This_Object;
            --
            Result : Boolean := False;
            --
        begin
            if (Is_Contained_By_View (This_Object)) then
                loop  
                    Current_Library :=
                       Directory_Tools.Traversal.Enclosing_Library
                          (Current_Library);
                    if (Is_View (Current_Library)) then
                        -- Found the enclosing view. Now look for the object
                        -- in the units directory of the enclosing view.
                        if (Directory_Tools.Object.Has
                               (Directory_Tools.Naming.Resolution
                                   (Directory_Tools.Naming.Full_Name
                                       (Current_Library) & ".UNITS.@??"),
                                This_Object)) then
                            Result := True;
                        else
                            Result := False;
                        end if;
                        exit;
                    end if;  
                end loop;
            end if;
            return (Result);
        end Is_Contained_By_Units_Directory_Of_View;

        function All_Objects_In (This_Object : in Directory_Tools.Object.Handle;
                                 Recursive : in Boolean := True)
                                return Directory_Tools.Object.Iterator is
        begin
            if (Recursive) then
                return (Directory_Tools.Naming.Resolution
                           (Directory_Tools.Naming.Full_Name (This_Object) &
                            ".@??"));
            else
                return (Directory_Tools.Naming.Resolution
                           (Directory_Tools.Naming.Full_Name (This_Object) &
                            ".@"));
            end if;
        end All_Objects_In;

        function Libraries is new Desired_Objects_From (Is_Library);

        function Libraries_In (This_Object : in Directory_Tools.Object.Handle;
                               Recursive : in Boolean := True)
                              return Directory_Tools.Object.Iterator is
        begin
            return (Libraries (This_Object, Recursive));
        end Libraries_In;

        function Directories is new Desired_Objects_From (Is_Directory);

        function Directories_In (This_Object : in Directory_Tools.Object.Handle;
                                 Recursive : in Boolean := True)
                                return Directory_Tools.Object.Iterator is
        begin
            return (Directories (This_Object, Recursive));
        end Directories_In;

        function Worlds is new Desired_Objects_From (Is_World);

        function Worlds_In (This_Object : in Directory_Tools.Object.Handle;
                            Recursive : in Boolean := True)
                           return Directory_Tools.Object.Iterator is
        begin
            return (Worlds (This_Object, Recursive));
        end Worlds_In;

        function Simple_Worlds is new Desired_Objects_From (Is_Simple_World);

        function Simple_Worlds_In (This_Object : in
                                      Directory_Tools.Object.Handle;
                                   Recursive : in Boolean := True)
                                  return Directory_Tools.Object.Iterator is
        begin  
            return (Simple_Worlds (This_Object, Recursive));
        end Simple_Worlds_In;

        function Subsystems is new Desired_Objects_From (Is_Subsystem);

        function Subsystems_In (This_Object : in Directory_Tools.Object.Handle;
                                Recursive : in Boolean := True)
                               return Directory_Tools.Object.Iterator is
        begin
            return (Subsystems (This_Object, Recursive));
        end Subsystems_In;

        function Views is new Desired_Objects_From (Is_View);

        function Views_In (This_Object : in Directory_Tools.Object.Handle;
                           Recursive : in Boolean := True)
                          return Directory_Tools.Object.Iterator is
        begin
            return (Views (This_Object, Recursive));
        end Views_In;

        function Spec_Views is new Desired_Objects_From (Is_Spec_View);

        function Spec_Views_In (This_Object : in Directory_Tools.Object.Handle;
                                Recursive : in Boolean := True)
                               return Directory_Tools.Object.Iterator is
        begin
            return (Spec_Views (This_Object, Recursive));
        end Spec_Views_In;

        function Load_Views is new Desired_Objects_From (Is_Load_View);

        function Load_Views_In (This_Object : in Directory_Tools.Object.Handle;
                                Recursive : in Boolean := True)
                               return Directory_Tools.Object.Iterator is
        begin
            return (Load_Views (This_Object, Recursive));
        end Load_Views_In;

        function Regular_Load_Views is
           new Desired_Objects_From (Is_Regular_Load_View);

        function Regular_Load_Views_In
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True)
                    return Directory_Tools.Object.Iterator is
        begin
            return (Regular_Load_Views (This_Object, Recursive));
        end Regular_Load_Views_In;

        function Coded_Load_Views is
           new Desired_Objects_From (Is_Coded_Load_View);

        function Coded_Load_Views_In (This_Object : in
                                         Directory_Tools.Object.Handle;
                                      Recursive : in Boolean := True)
                                     return Directory_Tools.Object.Iterator is
        begin  
            return (Coded_Load_Views (This_Object, Recursive));
        end Coded_Load_Views_In;

        function Combined_Views is new Desired_Objects_From (Is_Combined_View);

        function Combined_Views_In (This_Object : in
                                       Directory_Tools.Object.Handle;
                                    Recursive : in Boolean := True)
                                   return Directory_Tools.Object.Iterator is
        begin  
            return (Combined_Views (This_Object, Recursive));
        end Combined_Views_In;

        function Simple_Objects is new Desired_Objects_From (Is_Simple_Object);

        function Simple_Objects_In (This_Object : in
                                       Directory_Tools.Object.Handle;
                                    Recursive : in Boolean := True)
                                   return Directory_Tools.Object.Iterator is
        begin
            return (Simple_Objects (This_Object, Recursive));
        end Simple_Objects_In;

        function Ada_Units is new Desired_Objects_From (Is_Ada_Unit);

        function Ada_Units_In (This_Object : in Directory_Tools.Object.Handle;
                               Recursive : in Boolean := True)
                              return Directory_Tools.Object.Iterator is
        begin
            return (Ada_Units (This_Object, Recursive));
        end Ada_Units_In;

        function Files is new Desired_Objects_From (Is_File);

        function Files_In (This_Object : in Directory_Tools.Object.Handle;
                           Recursive : in Boolean := True)
                          return Directory_Tools.Object.Iterator is
        begin
            return (Files (This_Object, Recursive));
        end Files_In;

        function Misc_Simple_Objects is
           new Desired_Objects_From (Is_Misc_Simple_Object);

        function Misc_Simple_Objects_In
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True)
                    return Directory_Tools.Object.Iterator is
        begin
            return (Misc_Simple_Objects (This_Object, Recursive));
        end Misc_Simple_Objects_In;

        function Frozen_Objects is new Desired_Objects_From (Is_Frozen);

        function Frozen_Objects_In (This_Object : in
                                       Directory_Tools.Object.Handle;
                                    Recursive : in Boolean := True)
                                   return Directory_Tools.Object.Iterator is
        begin
            return (Frozen_Objects (This_Object, Recursive));
        end Frozen_Objects_In;

    end Any;

    package body Cmvc is

        function Models_Equal
                    (This_View : in Directory_Tools.Object.Handle;
                     This_Model : in String := "!MODEL.R1000") return Boolean is
            --
            -- By a series of transformations, we convert the Directory_Tools.
            -- Object.Handle for the view into an Object_Set.Iterator. Then we
            -- iterate over the contents of the set, comparing the name of each
            -- object in the set to the name of the model world until a match is
            -- found or the iterator is done.
            --
            function "=" (This_Error_Status : in Directory.Error_Status;
                          That_Error_Status : in Directory.Error_Status)
                         return Boolean renames Directory."=";
            --
            function "=" (This_Error_Status : in Directory.Naming.Name_Status;
                          That_Error_Status : in Directory.Naming.Name_Status)
                         return Boolean renames Directory.Naming."=";
            --
            Model_World : Directory_Tools.Object.Handle :=
               Directory_Tools.Naming.Resolution (This_Model);
            --
            Model_Name : constant String :=
               String_Utilities.Upper_Case
                  (Directory_Tools.Naming.Full_Name (Model_World));
            --
            Object_Set_Name : constant String :=
               Directory_Tools.Naming.Full_Name (This_View) & ".STATE.MODEL";
            --
            Object_Set_Object : Directory.Object;
            --
            The_Object_Set : Object_Set.Set;
            --
            Object_Iterator : Object_Set.Iterator;
            --
            Error_Status : Directory.Error_Status;
            Name_Status : Directory.Naming.Name_Status;
            --
            Result : Boolean := False;
            --
        begin
            if ((Object_Info.Any.Is_Good (This_View)) and
                (Object_Info.Any.Is_Good (Model_World))) then
                Directory.Naming.Resolve (Object_Set_Name,
                                          Object_Set_Object, Name_Status);
                if (Name_Status = Directory.Naming.Successful) then
                    Object_Set.Open (Object_Set_Object,
                                     The_Object_Set, Error_Status);
                    if (Error_Status = Directory.Successful) then
                        Object_Set.Init (Object_Iterator, The_Object_Set);
                        while (not Object_Set.Done (Object_Iterator)) loop
                            declare
                                Object : Directory.Object :=
                                   Object_Set.Value (Object_Iterator);
                                Object_Name : constant String :=
                                   String_Utilities.Upper_Case
                                      (Directory.Naming.Get_Full_Name (Object));
                            begin  
                                if (Object_Name = Model_Name) then
                                    -- Models are the same.
                                    Result := True;
                                    exit;  
                                end if;
                            end;
                            Object_Set.Next (Object_Iterator);
                        end loop;
                    end if;
                end if;
            end if;
            Object_Set.Close (The_Set => The_Object_Set,
                              Status => Error_Status);
            return (Result);
        exception
            when others =>
                return (False);
        end Models_Equal;

        function Is_Controlled (This_Object : in Directory_Tools.Object.Handle)
                               return Boolean is
            --
            function "=" (This_Error_Status : in Directory.Error_Status;
                          That_Error_Status : in Directory.Error_Status)
                         return Boolean renames Directory."=";
            --
            The_Object : Directory.Object;
            The_Status : Directory.Error_Status;
            --
            Object_Is_Controlled : Boolean := False;
            --
        begin
            Directory_Tools.Object.Low_Level.Get_Object
               (This_Object, The_Object, The_Status);
            Directory.Object_Operations.Is_Controlled
               (The_Object, Object_Is_Controlled, The_Status);
            return ((The_Status = Directory.Successful) and
                    (Object_Is_Controlled));
        end Is_Controlled;

        function Is_Checked_Out (This_Object : in Directory_Tools.Object.Handle)
                                return Boolean is
            --
            function "=" (This_Error_Status : in Directory.Error_Status;
                          That_Error_Status : in Directory.Error_Status)
                         return Boolean renames Directory."=";
            --
            The_Object : Directory.Object;
            The_Status : Directory.Error_Status;
            --
            Object_Is_Checked_In : Boolean;
            --
        begin
            Directory_Tools.Object.Low_Level.Get_Object
               (This_Object, The_Object, The_Status);
            Directory.Object_Operations.Is_Slushy
               (The_Object, Object_Is_Checked_In, The_Status);
            return ((The_Status = Directory.Successful) and
                    (not Object_Info.Any.Is_Library (This_Object)) and
                    (Is_Controlled (This_Object)) and  
                    (not Object_Is_Checked_In));
        end Is_Checked_Out;

        function Contains_Controlled_Objects
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Object_Info.Any.Number_Of_Objects_In  
                       (Controlled_Objects_In (This_Object, Recursive)) > 0);
        end Contains_Controlled_Objects;

        function Contains_Checked_Out_Objects
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True) return Boolean is
        begin
            return (Object_Info.Any.Number_Of_Objects_In  
                       (Checked_Out_Objects_In (This_Object, Recursive)) > 0);
        end Contains_Checked_Out_Objects;

        function Controlled_Objects is new Desired_Objects_From (Is_Controlled);

        function Controlled_Objects_In
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True)
                    return Directory_Tools.Object.Iterator is
        begin
            return (Controlled_Objects (This_Object, Recursive));
        end Controlled_Objects_In;

        function Checked_Out_Objects is
           new Desired_Objects_From (Is_Checked_Out);

        function Checked_Out_Objects_In
                    (This_Object : in Directory_Tools.Object.Handle;
                     Recursive : in Boolean := True)
                    return Directory_Tools.Object.Iterator is
        begin
            return (Checked_Out_Objects (This_Object, Recursive));
        end Checked_Out_Objects_In;

    end Cmvc;

end Object_Info;
DataMuseum.dk

Rational R1000/400 Tapes

⟦ef0f7a20c⟧ TextFile

Derivation

TextFile
