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 - metrics - download
Index: B T

⟦965455c4e⟧ TextFile

    Length: 17060 (0x42a4)
    Types: TextFile
    Names: »B«

Derivation

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧

TextFile

separate (Object_Info)
package body Cmvc is

    -- ***** BE CAREFUL NOT TO INTRODUCE MUTUAL RECURSION BETWEEN
    -- ***** THIS PACKAGE AND "OBJECT_INFO.LINKS"!!!

    function "=" (This_Error_Status : in Standard.Directory.Error_Status;
                  That_Error_Status : in Standard.Directory.Error_Status)
                 return Boolean renames Standard.Directory."=";

    function "=" (This_Error_Status : in Standard.Directory.Naming.Name_Status;
                  That_Error_Status : in Standard.Directory.Naming.Name_Status)
                 return Boolean renames Standard.Directory.Naming."=";

    function Model_For (This_View : in View) return Model_World is
        --
        View_Model_Database_Name : constant String :=
           Directory_Tools.Naming.Full_Name (This_View) & ".STATE.MODEL";
        --
        View_Model_Database : Standard.Directory.Object;
        --
        View_Model_Set : Object_Set.Set;
        --
        View_Model_Iterator : Object_Set.Iterator;
        --
        View_Model : Standard.Directory.Object;
        --
        Error_Status : Standard.Directory.Error_Status;
        Name_Status : Standard.Directory.Naming.Name_Status;
        --
        The_Model : Model_World := Object_Info.Utilities.Bad_Object;
        --
    begin
        if (Object_Info.Any.Is_Bad (This_View)) then
            return (The_Model);
        end if;
        if (not Object_Info.Any.Is_View (This_View)) then
            return (The_Model);
        end if;
        Standard.Directory.Naming.Resolve (View_Model_Database_Name,
                                           View_Model_Database, Name_Status);
        if (Name_Status /= Standard.Directory.Naming.Successful) then
            return (The_Model);
        end if;
        Object_Set.Open (View_Model_Database, View_Model_Set, Error_Status);
        if (Error_Status /= Standard.Directory.Successful) then
            return (The_Model);
        end if;
        Object_Set.Init (View_Model_Iterator, View_Model_Set);
        View_Model := Object_Set.Value (View_Model_Iterator);
        The_Model := Directory_Tools.Naming.Resolution
                        (Standard.Directory.Naming.Get_Full_Name (View_Model));
        if (Object_Info.Any.Is_Bad (The_Model)) then
            return (Object_Info.Utilities.Bad_Object);
        end if;
        Object_Set.Close (The_Set => View_Model_Set, Status => Error_Status);
        return (The_Model);
        --
    exception
        when others =>
            return (Object_Info.Utilities.Bad_Object);
            --
    end Model_For;

    function Models_Equal (This_View : in View; This_Model : in Model_World)
                          return Boolean is
    begin
        if (not Object_Info.Any.Is_Good (This_Model)) then
            return (False);
        end if;
        if (not Object_Info.Any.Is_Simple_World (This_Model)) then
            return (False);
        end if;
        return ((Directory_Tools.Naming.Full_Name
                    (Object_Info.Cmvc.Model_For (This_View))) =
                (Directory_Tools.Naming.Full_Name (This_Model)));
        --
    exception
        when others =>
            return (False);
            --
    end Models_Equal;

    function Is_Primary (This_Subsystem : in Subsystem) return Boolean is
        --
        The_Info_File : Io.File_Type;
        --
    begin
        The_Info_File := Low_Level_File_Operations.Open_To_Read
                            (Directory_Tools.Naming.Full_Name (This_Subsystem) &
                             ".STATE.COMPATIBILITY.STATE");
        declare
            The_Entry : constant String := Io.Get_Line (The_Info_File);
        begin  
            Low_Level_File_Operations.Close (The_Info_File);
            return (The_Entry = "PRIMARY => TRUE");
        end;
        --
    exception
        when others =>
            Low_Level_File_Operations.Close (The_Info_File);
            return False;
            --
    end Is_Primary;

    function Is_Secondary (This_Subsystem : in Subsystem) return Boolean is
    begin
        return (not Object_Info.Cmvc.Is_Primary (This_Subsystem));
    end Is_Secondary;

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

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

    function Contains_Controlled_Objects
                (This_Object : in Object; Transitive : in Boolean := True)
                return Boolean is
    begin
        return (Object_Info.Utilities.Contains_Objects
                   (This_Object, Object_Info.Utilities.Controlled, Transitive));
    end Contains_Controlled_Objects;

    function Contains_Checked_Out_Objects
                (This_Object : in Object; Transitive : in Boolean := True)
                return Boolean is
    begin
        return (Object_Info.Utilities.Contains_Objects
                   (This_Object, Object_Info.Utilities.Checked_Out,
                    Transitive));
    end Contains_Checked_Out_Objects;

    function Controlled_Objects_In
                (This_Object : in Object; Transitive : in Boolean := True)
                return Controlled_Objects is
    begin
        return (Object_Info.Utilities.Objects_In
                   (This_Object, Object_Info.Utilities.Controlled, Transitive));
    end Controlled_Objects_In;

    function Checked_Out_Objects_In
                (This_Object : in Object; Transitive : in Boolean := True)
                return Checked_Out_Objects is
    begin
        return (Object_Info.Utilities.Objects_In
                   (This_Object, Object_Info.Utilities.Checked_Out,
                    Transitive));
    end Checked_Out_Objects_In;

    function Current_Spec_View_In
                (This_Subsystem : in Subsystem;
                 This_Activity : in Activity.Activity_Name :=
                    Activity.The_Current_Activity) return Spec_View is
        --
        Subsystem_Id : Activity_Implementation.Subsystem_Id;
        Activity_Id : Activity_Implementation.Activity_Id;
        Activity_Handle : Activity_Implementation.Activity_Handle;
        Name_Status : Standard.Directory.Naming.Name_Status;
        Error_Status : Standard.Directory.Error_Status;
        Spec_Id : Activity_Implementation.Spec_View_Id;
        The_Spec_View : Directory_Tools.Object.Handle;
        --
    begin
        Standard.Directory.Naming.Resolve
           (Directory_Tools.Naming.Full_Name (This_Subsystem),
            Subsystem_Id, Name_Status);
        Standard.Directory.Naming.Resolve
           (This_Activity, Activity_Id, Name_Status);
        Activity_Implementation.Open
           (Activity_Id, Activity_Handle, Error_Status);
        Spec_Id := Activity_Implementation.Get_Spec_View
                      (Subsystem_Id, Activity_Handle);
        Activity_Implementation.Close (Activity_Handle, Error_Status);
        The_Spec_View := Directory_Tools.Naming.Resolution
                            (Standard.Directory.Naming.Get_Full_Name (Spec_Id));
        return (The_Spec_View);
        --
    exception
        when others =>
            return (Object_Info.Utilities.Bad_Object);
            --
    end Current_Spec_View_In;

    function Current_Load_View_In
                (This_Subsystem : in Subsystem;
                 This_Activity : in Activity.Activity_Name :=
                    Activity.The_Current_Activity) return Load_View is
        --
        Subsystem_Id : Activity_Implementation.Subsystem_Id;
        Activity_Id : Activity_Implementation.Activity_Id;
        Activity_Handle : Activity_Implementation.Activity_Handle;
        Name_Status : Standard.Directory.Naming.Name_Status;
        Error_Status : Standard.Directory.Error_Status;
        Load_Id : Activity_Implementation.Load_View_Id;
        The_Load_View : Directory_Tools.Object.Handle;
        --
    begin
        Standard.Directory.Naming.Resolve
           (Directory_Tools.Naming.Full_Name (This_Subsystem),
            Subsystem_Id, Name_Status);
        Standard.Directory.Naming.Resolve
           (This_Activity, Activity_Id, Name_Status);
        Activity_Implementation.Open
           (Activity_Id, Activity_Handle, Error_Status);
        Load_Id := Activity_Implementation.Get_Load_View
                      (Subsystem_Id, Activity_Handle);
        Activity_Implementation.Close (Activity_Handle, Error_Status);
        The_Load_View := Directory_Tools.Naming.Resolution
                            (Standard.Directory.Naming.Get_Full_Name (Load_Id));
        return (The_Load_View);
        --
    exception
        when others =>
            return (Object_Info.Utilities.Bad_Object);
            --
    end Current_Load_View_In;

    function Imports_For (This_View : in View; Used_Only : in Boolean := True)
                         return Imports is
        --
        The_Imports : Imports := Directory_Tools.Object.Create;
        --
        Imports_Database_Name : constant String :=
           Directory_Tools.Naming.Full_Name (This_View) & ".STATE.IMPORTS";
        --
        Imports_Database : Standard.Directory.Object;
        --
        Imports_Set : Object_Set.Set;
        --
        Imports_Iterator : Object_Set.Iterator;
        --
        Error_Status : Standard.Directory.Error_Status;
        Name_Status : Standard.Directory.Naming.Name_Status;
        --
    begin
        if (not Object_Info.Any.Is_Good (This_View)) then
            return (The_Imports);
        end if;
        if (not Object_Info.Any.Is_View (This_View)) then
            return (The_Imports);
        end if;
        Standard.Directory.Naming.Resolve
           (Imports_Database_Name, Imports_Database, Name_Status);
        if (Name_Status /= Standard.Directory.Naming.Successful) then
            return (The_Imports);
        end if;
        Object_Set.Open (Imports_Database, Imports_Set, Error_Status);
        if (Error_Status /= Standard.Directory.Successful) then
            return (The_Imports);
        end if;
        Object_Set.Init (Imports_Iterator, Imports_Set);
        while (not Object_Set.Done (Imports_Iterator)) loop
            declare
                The_Import_Object : Standard.Directory.Object :=
                   Object_Set.Value (Imports_Iterator);
                The_Import_Object_Name : constant String :=
                   Standard.Directory.Naming.Get_Full_Name (The_Import_Object);
                The_Import : Import := Directory_Tools.Naming.Resolution
                                          (The_Import_Object_Name);
                Dummy : Boolean;
            begin  
                if (Object_Info.Any.Is_Good (The_Import)) then  
                    if (Used_Only) then
                        if (Object_Info.Cmvc.Is_Used
                               (The_Import, This_View)) then
                            Directory_Tools.Object.Add
                               (The_Imports, The_Import, Dummy);
                        end if;
                    else
                        Directory_Tools.Object.Add
                           (The_Imports, The_Import, Dummy);
                    end if;
                end if;
            end;
            Object_Set.Next (Imports_Iterator);
        end loop;
        Object_Set.Close (The_Set => Imports_Set, Status => Error_Status);
        return (The_Imports);
        --
    exception
        when others =>
            return (The_Imports);
            --
    end Imports_For;

    function Is_Used (This_Import : in Import; By_View : in View)
                     return Boolean is
        --
        Imported_Links : Object_Info.Links.Imported_External_Links :=
           Object_Info.Links.Links_Derived_From  
              (This_Import => This_Import,
               Into_View => By_View,
               Used_Only => True);
        --
    begin
        return (not Object_Info.Any.Is_Empty (Imported_Links));
    end Is_Used;

    function Referencers_Of
                (This_Spec_View : in Spec_View; Using_Only : in Boolean := True)
                return Referencers is
        --
        The_Referencers : Referencers := Directory_Tools.Object.Create;
        --
        Referencers_Database_Name : constant String :=
           Directory_Tools.Naming.Full_Name (This_Spec_View) &
              ".STATE.REFERENCERS";
        --
        Referencers_Database : Standard.Directory.Object;
        --
        Referencers_Set : Object_Set.Set;
        --
        Referencers_Iterator : Object_Set.Iterator;
        --
        Error_Status : Standard.Directory.Error_Status;
        Name_Status : Standard.Directory.Naming.Name_Status;
        --
    begin
        if (not Object_Info.Any.Is_Good (This_Spec_View)) then
            return (The_Referencers);
        end if;
        if (not Object_Info.Any.Is_View (This_Spec_View)) then
            return (The_Referencers);
        end if;
        Standard.Directory.Naming.Resolve (Referencers_Database_Name,
                                           Referencers_Database, Name_Status);
        if (Name_Status /= Standard.Directory.Naming.Successful) then
            return (The_Referencers);
        end if;
        Object_Set.Open (Referencers_Database, Referencers_Set, Error_Status);
        if (Error_Status /= Standard.Directory.Successful) then
            return (The_Referencers);
        end if;
        Object_Set.Init (Referencers_Iterator, Referencers_Set);
        while (not Object_Set.Done (Referencers_Iterator)) loop
            declare
                The_Referencer_Object : Standard.Directory.Object :=
                   Object_Set.Value (Referencers_Iterator);
                The_Referencer_Object_Name : constant String :=
                   Standard.Directory.Naming.Get_Full_Name
                      (The_Referencer_Object);
                The_Referencer : Referencer := Directory_Tools.Naming.Resolution
                                                  (The_Referencer_Object_Name);
                Dummy : Boolean;
            begin  
                if (Object_Info.Any.Is_Good (The_Referencer)) then
                    if (Using_Only) then
                        if (Object_Info.Cmvc.Is_User
                               (The_Referencer, This_Spec_View)) then
                            Directory_Tools.Object.Add
                               (The_Referencers, The_Referencer, Dummy);
                        end if;
                    else
                        Directory_Tools.Object.Add
                           (The_Referencers, The_Referencer, Dummy);
                    end if;
                end if;
            end;
            Object_Set.Next (Referencers_Iterator);
        end loop;
        Object_Set.Close (The_Set => Referencers_Set, Status => Error_Status);
        return (The_Referencers);
        --
    exception
        when others =>
            return (The_Referencers);
            --
    end Referencers_Of;

    function Is_User (This_Referencer : in Referencer;
                      Of_Spec_View : in Spec_View) return Boolean is
        --
        Imported_Links : Object_Info.Links.Imported_External_Links :=
           Object_Info.Links.Links_Derived_From  
              (This_Import => Of_Spec_View,
               Into_View => This_Referencer,
               Used_Only => True);
        --
    begin
        return (not Object_Info.Any.Is_Empty (Imported_Links));
    end Is_User;

end Cmvc;