|
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: 9627 (0x259b)
Types: TextFile
Names: »B«
└─⟦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⟧
separate (Object_Info)
package body Utilities is
function Match_Pattern_For (This_Kind : in Kinds) return String is
--
-- Returns the most constrained naming qualifier that will still
-- return all instances of the specified kind from a naming resolution.
--
begin
case This_Kind is
when Library =>
return ("'C(LIBRARY)");
when Directory =>
return ("'C(DIRECTORY)");
when World | Simple_World =>
return ("'C(WORLD)");
when Subsystem =>
return ("'C(SUBSYSTEM)");
when View =>
return ("'C(SPEC_VIEW,LOAD_VIEW,COMBINED_VIEW)");
when Spec_View =>
return ("'C(SPEC_VIEW)");
when Load_View |
Working_Load_View |
Released_Load_View |
Code_Only_Load_View =>
return ("'C(LOAD_VIEW)");
when Combined_View =>
return ("'C(COMBINED_VIEW)");
when Simple_Object =>
return ("'C(~LIBRARY)");
when Ada_Unit =>
return ("'C(ADA)");
when File =>
return ("'C(FILE)");
when Misc_Simple_Object =>
return ("'C(~LIBRARY)'C(~ADA)'C(~FILE)");
when others =>
return ("");
end case;
end Match_Pattern_For;
function Superset_Objects_In (This_Object : in Object;
This_Kind : in Kinds;
Transitive : in Boolean) return Objects is
--
-- Returns an iterator of objects guaranteed to contain all objects
-- of the desired kind which are contained in the specified object.
-- The iterator may contain extra objects (since there is not a
-- naming expression for every kind of object), which is why this
-- is called "superset". The extra objects need to be removed
-- by some other procedure.
--
begin
if (Transitive) then
return (Directory_Tools.Naming.Resolution
(Directory_Tools.Naming.Full_Name (This_Object) &
".@??" &
Object_Info.Utilities.Match_Pattern_For (This_Kind)));
else
return (Directory_Tools.Naming.Resolution
(Directory_Tools.Naming.Full_Name (This_Object) & ".@" &
Object_Info.Utilities.Match_Pattern_For (This_Kind)));
end if;
end Superset_Objects_In;
function Is_Same_Kind (This_Object : in Object; This_Kind : in Kinds)
return Boolean is
--
-- Returns True iff the specified object is of the specified kind.
--
begin
case This_Kind is
when Anything =>
return (True);
when Library =>
return (Object_Info.Any.Is_Library (This_Object));
when Directory =>
return (Object_Info.Any.Is_Directory (This_Object));
when World =>
return (Object_Info.Any.Is_World (This_Object));
when Simple_World =>
return (Object_Info.Any.Is_Simple_World (This_Object));
when Subsystem =>
return (Object_Info.Any.Is_Subsystem (This_Object));
when Root =>
return (Object_Info.Any.Is_Root (This_Object));
when View =>
return (Object_Info.Any.Is_View (This_Object));
when Spec_View =>
return (Object_Info.Any.Is_Spec_View (This_Object));
when Load_View =>
return (Object_Info.Any.Is_Load_View (This_Object));
when Working_Load_View =>
return (Object_Info.Any.Is_Working_Load_View (This_Object));
when Released_Load_View =>
return (Object_Info.Any.Is_Released_Load_View (This_Object));
when Code_Only_Load_View =>
return (Object_Info.Any.Is_Code_Only_Load_View (This_Object));
when Combined_View =>
return (Object_Info.Any.Is_Combined_View (This_Object));
when Units_Directory_Of_View =>
return (Object_Info.Any.Is_Units_Directory_Of_View
(This_Object));
when Simple_Object =>
return (Object_Info.Any.Is_Simple_Object (This_Object));
when Ada_Unit =>
return (Object_Info.Any.Is_Ada_Unit (This_Object));
when File =>
return (Object_Info.Any.Is_File (This_Object));
when Misc_Simple_Object =>
return (Object_Info.Any.Is_Misc_Simple_Object (This_Object));
when Frozen =>
return (Object_Info.Any.Is_Frozen (This_Object));
when Controlled =>
return (Object_Info.Cmvc.Is_Controlled (This_Object));
when Checked_Out =>
return (Object_Info.Cmvc.Is_Checked_Out (This_Object));
end case;
end Is_Same_Kind;
function Contains_Objects (This_Object : in Object;
This_Kind : in Kinds;
Transitive : in Boolean) return Boolean is
--
Superset : Objects := Object_Info.Utilities.Superset_Objects_In
(This_Object, This_Kind, Transitive);
--
begin
Directory_Tools.Object.Reset (Superset);
while (not Directory_Tools.Object.Done (Superset)) loop
if (Object_Info.Utilities.Is_Same_Kind
(Directory_Tools.Object.Value (Superset), This_Kind)) then
return (True);
end if;
Directory_Tools.Object.Next (Superset);
end loop;
return (False);
end Contains_Objects;
function Objects_In (This_Object : in Object;
This_Kind : in Kinds;
Transitive : in Boolean) return Objects is
--
Superset : Objects := Object_Info.Utilities.Superset_Objects_In
(This_Object, This_Kind, Transitive);
--
The_Objects : Objects := Directory_Tools.Object.Create;
--
Dummy : Boolean;
--
begin
Directory_Tools.Object.Reset (Superset);
while (not Directory_Tools.Object.Done (Superset)) loop
if (Object_Info.Utilities.Is_Same_Kind
(Directory_Tools.Object.Value (Superset), This_Kind)) then
Directory_Tools.Object.Add
(The_Objects,
Directory_Tools.Object.Value (Superset), Dummy);
end if;
Directory_Tools.Object.Next (Superset);
end loop;
Directory_Tools.Object.Reset (The_Objects);
return (The_Objects);
end Objects_In;
function Is_Enclosed (This_Object : in Object;
This_Kind : in Kinds;
Transitive : in Boolean) return Boolean is
--
Current_Library : Object_Info.Any.Library := This_Object;
--
begin
if (Object_Info.Any.Is_Root (This_Object)) then
-- Cannot be contained by anything, because already at root.
return (False);
else
loop
Current_Library := Directory_Tools.Traversal.
Enclosing_Library (Current_Library);
if (Object_Info.Utilities.Is_Same_Kind
(Current_Library, This_Kind)) then
-- Found an enclosing library of the correct kind.
return (True);
elsif (Object_Info.Any.Is_Root (Current_Library)) then
-- Worked our way all the way up to the root without finding
-- an enclosing object of the correct kind.
return (False);
elsif (not Transitive) then
-- Only supposed to look at first level, so quit.
return (False);
end if;
end loop;
end if;
end Is_Enclosed;
function Enclosing_For (This_Object : in Object;
This_Kind : in Kinds;
Transitive : in Boolean) return Object is
--
Current_Library : Object_Info.Any.Library := This_Object;
--
begin
if (Object_Info.Any.Is_Root (This_Object)) then
-- Cannot be contained by anything, because already at root.
return (Bad_Object);
else
loop
Current_Library := Directory_Tools.Traversal.
Enclosing_Library (Current_Library);
if (Object_Info.Utilities.Is_Same_Kind
(Current_Library, This_Kind)) then
-- Found an enclosing library of the correct kind.
return (Current_Library);
elsif (Object_Info.Any.Is_Root (Current_Library)) then
-- Worked our way all the way up to the root without finding
-- an enclosing object of the correct kind.
return (Bad_Object);
elsif (not Transitive) then
-- Only supposed to look at first level, so quit.
return (Bad_Object);
end if;
end loop;
end if;
end Enclosing_For;
end Utilities;