|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 35054 (0x88ee)
Types: TextFile
Names: »B«
└─⟦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⟧
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;