|
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 - downloadIndex: ┃ T V ┃
Length: 69355 (0x10eeb)
Types: TextFile
Names: »V«
└─⟦d10a02448⟧ Bits:30000409 8mm tape, Rational 1000, ENVIRONMENT, D_12_7_3
└─ ⟦fc9b38f02⟧ »DATA«
└─⟦9b46a407a⟧
└─⟦12c68c704⟧
└─⟦this⟧
└─⟦5f3412b64⟧ Bits:30000745 8mm tape, Rational 1000, ENVIRONMENT 12_6_5 TOOLS
└─ ⟦91c658230⟧ »DATA«
└─⟦458657fb6⟧
└─⟦220843204⟧
└─⟦this⟧
with Action;
with Calendar;
with Diana;
with Directory;
with Error_Messages;
with Profile;
with String_Table;
package Directory_Tools is
-- DIRECTORY TOOLS ORGANIZATION
-- The Directory system provides the structure for storing, managing
-- and naming objects.
-- Each object has a class, which determines the operations that can
-- be applied to object. Program units belong to the class Ada.
-- Libraries, the building blocks of the directory system, are
-- objects of class Library. The class reflects which object manager
-- manages objects of that type, as well as reflecting the type.
-- Except for objects of class Library, each Directory Object has
-- one or more versions, which can be selected by using the
-- appropriate version name.
-- Ada.Unit and Polymorphic_IO.File (and others) are ultimately of
-- type Directory.Object and provide type specific operations. The
-- general paradigm is that type independent operations (traversal,
-- create, copy, destroy, etc.) are provided in directory, while
-- type specific operations are provided by the packages
-- (Directory.Ada, Polymorphic_io, etc.) which introduce specific
-- managed types.
-- No exceptions are propagated from this subsystem, except those
-- associated with type specific operations.
-- . Package Object. Defines the object handle type and the
-- iterator on object types.
-- . Package Naming. Provides facilities for establishing a context
-- for name resolution and facilities for resolving string names.
-- . Package Traversal. Operations for traversing the directory
-- structure (which extends through all Ada units in the system).
-- . Package Any_Object. Standard Directory operations for
-- Creating, Freezing, Destroying and Copying managed objects in the
-- Directory.
-- . Package Library_Object. Defines operations specific to
-- objects of class library. Defines a Library object as a
-- distinguished point (World or Directory) in the directory system.
-- A world specifies the disk volume for storing its contents and
-- the policies which will apply to its contents.
-- . Package Ada_Object. Defines an Ada Unit as a kind of
-- Directory.Object. Provides type-specific operations for
-- constructing and manipulating Ada Units.
-- . Package Statistics. Queries about Directory Objects.
-- This package is the main interface to the directory subsystem.
-- . Package Object.Low_Level. Defines interface between Object. Handles
-- and the low level types of Directory_Implementation.
-- . Package Ada_Implementation. Defines operations for gaining
-- access to Diana Trees from Object.Handles;
package Object is
package Di renames Directory;
package St renames String_Table;
-- Herein are defined the principle structures for accessing the
-- Directory System objects: Object.Handle and Object.Iterator
type Handle is private;
-- Objects in the directory system and the Versions of those
-- Objects are accessed via an Object.Handle. A handle may denote
-- all Versions of an Object collectively or a specific Version of
-- an Object. Most operations operate on specific Versions of an
-- Object. If the Object.Handle passed to the operation denotes no
-- specific Version, the Default Version is used.
function Nil return Object.Handle;
function Is_Nil (The_Object : Object.Handle) return Boolean;
function Hash (The_Object : Object.Handle) return Integer;
function Unique (The_Object : Object.Handle) return Long_Integer;
function Image (The_Object : Object.Handle;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
-- See debug_tools.special_display
function Version (The_Object : Object.Handle) return String;
-- Returns a name of the form "V(nn)", for the Version denoted by the
-- Object.Handle.
function Same_Object (Left, Right : Object.Handle) return Boolean;
function Equal (Left, Right : Object.Handle) return Boolean
renames Same_Object;
-- Compare two handles to see if they refer to the same directory
-- entity. Please note, "=" will give incorrect results
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
type Class_Enumeration is new Natural range 0 .. 63;
Unknown_Class : constant Class_Enumeration := 0;
Library_Class : constant Class_Enumeration := 1;
Ada_Class : constant Class_Enumeration := 2;
File_Class : constant Class_Enumeration := 3;
User_Class : constant Class_Enumeration := 4;
Session_Class : constant Class_Enumeration := 5;
Pipe_Class : constant Class_Enumeration := 6;
Terminal_Class : constant Class_Enumeration := 7;
Tape_Class : constant Class_Enumeration := 8;
function Class (The_Object : Object.Handle) return Class_Enumeration;
function Equal (Class1, Class2 : Class_Enumeration) return Boolean;
function Image (The_Class : Class_Enumeration) return String;
function Value (S : String) return Class_Enumeration;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
type Subclass is private;
function Nil return Subclass;
function Is_Nil (The_Subclass : Subclass) return Boolean;
function Unique (The_Subclass : Subclass) return Integer;
function Subclass_Of (The_Object : Object.Handle) return Subclass;
function Image (The_Subclass : Subclass) return String;
function Value (S : String) return Subclass;
function Class_Of (The_Subclass : Subclass) return Class_Enumeration;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
type Iterator is private;
-- Representation of an ordered set of Objects (Object.Handles);
procedure Next (Iter : in out Object.Iterator);
function Done (Iter : Object.Iterator) return Boolean;
function Value (Iter : Object.Iterator) return Object.Handle;
procedure Reset (Iter : Object.Iterator);
-- reset the iterator to the beginning of the list.
function Nil return Object.Iterator;
function Is_Nil (Iter : Object.Iterator) return Boolean;
function Image (The_Iterator : Object.Iterator;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
function Create return Object.Iterator;
-- create a new (empty) iterator. Note: an empty iterator is different
-- than a 'nil' iterator
function Has (Iter : Object.Iterator; An_Object : Object.Handle)
return Boolean;
procedure Add (Iter : Object.Iterator;
An_Object : Object.Handle;
Duplicate : out Boolean;
Before : Object.Handle := Object.Nil);
-- The given Object is added to the Iterator just before the object
-- denoted by the Before parameter. If the Before parameter is not
-- found, the object is added at the end of the list of Objects.
procedure Remove (Iter : Object.Iterator;
An_Object : Object.Handle;
Found : out Boolean);
-- The specified object is removed from the iterator if it is there.
procedure Invert (Iter : Object.Iterator);
-- reverse the ordering of the given object list.
---------------------------------------------------------------------
-- procedures and functions to handle errors
type Error_Code is private;
-- All procedures return an object.Code, which describes the
-- success or failure of the operation.
function Err_Code (The_Object : Object.Handle) return Object.Error_Code;
function Err_Code (The_Objects : Object.Iterator)
return Object.Error_Code;
-- Object handles and Iterators contains an object.Code for the last oper-
-- ation performed on them. This error code is the only way problems
-- are reported by the Directory System functions. This error code is
-- a copy of the error code returned by Directory.System procedures.
-- Procedures and functions within the Directory System propagate bad
-- error codes from their input to their outputs. Except for this
-- propagation of error code, procedures passed bad objects are no-ops.
function Is_Bad (Error_Code : Object.Error_Code) return Boolean;
function Is_Bad (The_Object : Object.Handle) return Boolean;
function Is_Bad (The_Objects : Object.Iterator) return Boolean;
function Is_Ok (Error_Code : Object.Error_Code) return Boolean;
function Is_Ok (The_Object : Object.Handle) return Boolean;
function Is_Ok (The_Objects : Object.Iterator) return Boolean;
-- Test the object.Code for Success/Failure status
function Message (Error_Code : Object.Error_Code) return String;
function Message (The_Object : Object.Handle) return String;
function Message (The_Objects : Object.Iterator) return String;
function Message (Error_Code : Object.Error_Code) return St.Item;
function Message (The_Object : Object.Handle) return St.Item;
function Message (The_Objects : Object.Iterator) return St.Item;
-- Transforms the object.Code into an English explanation of the
-- Error.
procedure Report (Error_Code : Object.Error_Code;
Response : Profile.Response_Profile := Profile.Get);
procedure Report (The_Object : Object.Handle;
Response : Profile.Response_Profile := Profile.Get);
procedure Report (The_Objects : Object.Iterator;
Response : Profile.Response_Profile := Profile.Get);
-- If the object.Code is Bad, a message is formulated from the code and sent
-- the current Log device. If requested by the given response profile,
-- the exception Failure or Abandon is raised.
-- If the Code is Bad, a message is formulated from the code and sent
-- the current Log device. If requested by the given response profile,
-- the exception Failure or Abandon is raised.
Error : exception;
-- Raised by Report in the event of an error when the given Response
-- Profile asks that an exception be propagated to the caller.
Abandon : exception;
-- Raised by Report in the event of an error when the given response
-- Profile askes that the operationbe Abandonded without propagating
-- exceptions to the caller.
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- Depending on the operation that generated a bad error code, additional
-- useful information may be associated with an error code. First, each
-- error code is assigned to one of the following categories:
type Category_Enumeration is
(Successful,
-- No problems encountered.
Warning,
-- Some non-fatal error.
Lock_Error,
-- Some synchronization error occurred,
-- usually failure to acquire access to some
-- object within the specified maximum delay
Semantic_Error,
-- An operation requiring (Ada) semantic
-- consistency discovered semantic errors.
Code_Generation_Error,
-- An error was detected during cg.
Obsolescence_Error,
-- A change was prevented because it
-- obsolesced installed declarations.
Bad_Tree_Parameter,
-- An actual tree parameter failed to meet
-- the requirements of the formal subtype.
Illegal_Operation,
-- The attempted operation is not legal
-- when applied to the given parameters.
Consistency_Error,
-- The operation is inconsistent with the
-- current state of the universe.
Version_Error,
-- The specified version does not exist.
Policy_Error,
-- The operation violates some other policy
-- that applies at this point.
Bad_Naming_Context,
-- The context was not a valid context for
-- name resolution.
Ill_Formed_Name,
-- The name was not well formed lexically or
-- syntactically.
Undefined_Name,
-- The name could not be found in the given
-- context.
Ambiguous_Name,
-- Because of overloading or wildcards, the
-- name resolved to more than one entity.
Name_Error,
-- other errors occured resolving a name.
Access_Error,
-- The operation violates access control
-- policies.
Class_Error,
-- The class of the object passed to the
-- operation is incompatible with op
-- either because the op expects a
-- particular class, or because the
-- op is a type independent op which
-- is not supported for the given class.
-- various selection errors
No_Selection, Cursor_Not_In_Selection,
Selections_Not_Supported, No_Declaration, No_Object, No_Editor,
Other_Error); -- When all else fails ...
function Category (Error_Code : Object.Error_Code)
return Object.Category_Enumeration;
-- Extracts from each error code, the category it belongs to.
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- Error codes in the category Semantic_Error and Code_Generation_Error
-- (and perhaps others) may have a list of error messages associated them.
type Message_List is private;
type Severity_Enumeration is (Note, Warning, Lrm_Error,
Internal_Error, Exception_Handled);
function Severity (Result : Object.Message_List)
return Severity_Enumeration;
function Message (Result : Object.Message_List) return String;
function Message (Result : Object.Message_List) return St.Item;
-- Properties of the current message in the list
function Next (Result : Object.Message_List) return Object.Message_List;
function Done (Result : Object.Message_List) return Boolean;
function Nil return Object.Message_List;
procedure Report (Messages : Object.Message_List;
Response : Profile.Response_Profile := Profile.Get;
Top_Only : Boolean := False);
-- Displays the error messages in the standard format according to the
-- supplied profile. If Top_Only is true, only the first message in the
-- list will be displayed; other wise all messages in the list will be
-- Displayed.
function Messages (Error_Code : Object.Error_Code)
return Object.Message_List;
-- Extracts the message list from the error code. Returns the Nil list
-- if there are no messages.
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- Error codes in the category Obsolescence_Error may have a list of
-- the objects that would have been obsolesced.
function Change_Impact (Error_Code : Object.Error_Code)
return Object.Iterator;
-- Extracts the list of obsolesced objects from the error code. Returns
-- the Nil iterator if there are none.
function Modified_Units
(Error_Code : Object.Error_Code) return Object.Iterator;
-- Extracts the list of units that were implicitly coded/uncoded by the
-- operation that returned the error code.
function Value (Category : Object.Category_Enumeration;
Message : String := "";
Messages : Object.Message_List := Object.Nil;
Change_Impact : Object.Iterator := Object.Nil;
Modified_Units : Object.Iterator := Object.Nil)
return Object.Error_Code;
function Value (Category : Object.Category_Enumeration;
Message : St.Item := St.Nil;
Messages : Object.Message_List := Object.Nil;
Change_Impact : Object.Iterator := Object.Nil;
Modified_Units : Object.Iterator := Object.Nil)
return Object.Error_Code;
function Nil return Object.Error_Code;
-- Construct an Error code of a the given class and associated message.
function Image (The_Code : Object.Error_Code;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String;
-------------------------------------------------------------------
package Low_Level is
-- lower level routines to build and extract from handles,
-- error codes, and iterators
-------------------------------------------------------------
-- Routines to set and retrieve the default action. This action is
-- the action with a handle if one is not explicitly supplied.
-- default action is never finished. It is initially the
-- null action id.
-- Directory_tools routines take a handle as an argument will use
-- the action from the handle. If source and destination are
-- both arguments, the action comes from the destination.
-- If the routine takes a name and context, the action from the
-- context is used. If neither these are true, the default action
-- is used directly.
-- Handles created by the directory system are created with the
-- default action, with three exceptions. The first exception is
-- traversal.recursion. This routine propagates the action
-- from the supplied handle instead of using the default.
-- The second exception is ada_implementation.open, which
-- will start an action if one is not supplied and the access
-- mode is READ. This action is finished by closing the unit.
-- The third exception is library_object.create, which
-- will always start and finish an action, making the addition
-- permanent. The user must manually back out by destroying any
-- created directories if the desire is to abandon the operation.
-- After the library is created, the action is set to the
-- default action. As such, objects created in it will be covered
-- by the default in force at the time the directory is created.
procedure Set_Default_Action_Id (The_Action : Action.Id);
function Default_Action_Id return Action.Id;
--------------------------------------------------------------
-- object handle routines. These extract the underlying
-- components supplied by the environment directory system.
-- If no action is supplied, the action from the handle is used.
-- If the handle's action is NULL, the default action is used.
procedure Get_Declaration (Handle : Object.Handle;
The_Decl : out Di.Declaration;
Status : out Di.Error_Status;
Action_Id : Action.Id := Action.Null_Id;
Max_Wait : Duration := Di.Default_Wait);
procedure Get_Object (Handle : Object.Handle;
The_Object : out Di.Object;
Status : out Di.Error_Status);
procedure Get_Version (Handle : Object.Handle;
The_Version : out Di.Version;
Status : out Di.Error_Status;
Action_Id : Action.Id := Action.Null_Id;
Max_Wait : Duration := Di.Default_Wait);
procedure Get_Root (Handle : Object.Handle;
The_Root : out Diana.Tree;
Status : out Di.Error_Status;
Action_Id : Action.Id := Action.Null_Id;
Max_Wait : Duration := Di.Default_Wait);
function Get_Class (Handle : Object.Handle) return Di.Class;
function Get_Subclass (The_Subclass : Subclass) return Di.Subclass;
function Get_Subclass (Handle : Object.Handle) return Di.Subclass;
-- return the string supplied as the object name.
function Object_Name (Handle : Object.Handle) return String;
function Object_Name (Handle : Object.Handle) return St.Item;
function Action_Id (Handle : Object.Handle) return Action.Id;
function Finish_Action_On_Close
(Handle : Object.Handle) return Boolean;
-- constructors to make object.handles
procedure Set_Class (Handle : Object.Handle; Class : Di.Class);
procedure Set_Object_Name
(Handle : Object.Handle; The_Name : String);
procedure Set_Object_Name
(Handle : Object.Handle; The_Name : St.Item);
procedure Set_Error_Code (Handle : Object.Handle;
The_Code : Object.Error_Code);
procedure Set_Action_Id (Handle : Object.Handle;
The_Action : Action.Id;
Finish_Action_On_Close : Boolean := False);
procedure Set_Root (Handle : Object.Handle; The_Root : Diana.Tree);
procedure Set_Handle_Data
(Handle : Object.Handle;
The_Error : Object.Error_Code := Object.Nil;
The_Name : String := "";
The_Object : Di.Object := Di.Nil;
The_Version : Di.Version := Di.Nil;
The_Class : Di.Class := Di.Nil;
The_Declaration : Di.Declaration := Diana.Empty;
The_Root : Diana.Tree := Diana.Empty;
The_Action : Action.Id :=
Object.Low_Level.Default_Action_Id);
function Make_Handle
(The_Error : Object.Error_Code;
The_Name : String := "";
The_Object : Di.Object := Di.Nil;
The_Version : Di.Version := Di.Nil;
The_Class : Di.Class := Di.Nil;
The_Declaration : Di.Declaration := Diana.Empty;
The_Root : Diana.Tree := Diana.Empty;
The_Action : Action.Id :=
Object.Low_Level.Default_Action_Id)
return Object.Handle;
function Make_Handle
(The_Error : Object.Error_Code;
The_Name : St.Item := St.Nil;
The_Object : Di.Object := Di.Nil;
The_Version : Di.Version := Di.Nil;
The_Class : Di.Class := Di.Nil;
The_Declaration : Di.Declaration := Diana.Empty;
The_Root : Diana.Tree := Diana.Empty;
The_Action : Action.Id :=
Object.Low_Level.Default_Action_Id)
return Object.Handle;
-----------------------------------------------------------------
-- object iterator constructors
procedure Set_Error_Code (Iter : Object.Iterator;
Code : Object.Error_Code);
procedure Set_Pattern (Iter : Object.Iterator; Pattern : String);
procedure Set_Pattern (Iter : Object.Iterator; Pattern : St.Item);
function Pattern (Iter : Object.Iterator) return String;
function Pattern (Iter : Object.Iterator) return St.Item;
-- If possible, the iterator uses the environment iterators.
-- To do this, constructors are supplied for the types of interest.
function Make_Iterator
(Code : Object.Error_Code;
An_Object : Object.Handle;
Pattern : String := "?";
The_Class : Object.Class_Enumeration :=
Object.Unknown_Class) return Object.Iterator;
function Make_Iterator
(Code : Object.Error_Code;
A_Naming_Iter : Di.Naming.Iterator;
Pattern : String := "?";
The_Class : Object.Class_Enumeration :=
Object.Unknown_Class) return Object.Iterator;
function Make_Iterator
(Code : Object.Error_Code;
A_Version_Iter : Di.Traversal.Version_Iterator;
Pattern : String := "?";
The_Class : Object.Class_Enumeration :=
Object.Unknown_Class) return Object.Iterator;
function Make_Iterator
(Code : Object.Error_Code;
An_Object : Object.Handle;
Pattern : St.Item := St.Nil;
The_Class : Object.Class_Enumeration :=
Object.Unknown_Class) return Object.Iterator;
function Make_Iterator
(Code : Object.Error_Code;
A_Naming_Iter : Di.Naming.Iterator;
Pattern : St.Item := St.Nil;
The_Class : Object.Class_Enumeration :=
Object.Unknown_Class) return Object.Iterator;
function Make_Iterator
(Code : Object.Error_Code;
A_Version_Iter : Di.Traversal.Version_Iterator;
Pattern : St.Item := St.Nil;
The_Class : Object.Class_Enumeration :=
Object.Unknown_Class) return Object.Iterator;
-- the class argument specifies a filter class. Only items of the
-- specified class will be returned. If unknown_class is given,
-- the filter is disabled.
-------------------------------------------------------------
-- routines that handle low level error code actions.
function Translate_Status (The_Status : Di.Error_Status)
return Object.Category_Enumeration;
function Translate_Status (The_Status : Di.Naming.Name_Status)
return Object.Category_Enumeration;
procedure Set_Category (Code : Object.Error_Code;
Class : Object.Category_Enumeration);
procedure Set_Message (Code : Object.Error_Code; Msg : String);
procedure Set_Message (Code : Object.Error_Code; Msg : St.Item);
procedure Set_Message_List (Code : Object.Error_Code;
List : Error_Messages.Errors);
end Low_Level;
private
type Handle_Data;
type Handle is access Handle_Data;
pragma Segmented_Heap (Handle);
type Iterator_Kind_Enum is (Version_Iter, Name_Iter, No_Iter);
type Iterator_Data (Iterator_Kind : Iterator_Kind_Enum);
type Iterator is access Iterator_Data;
pragma Segmented_Heap (Iterator);
type Error_Code_Data;
type Error_Code is access Error_Code_Data;
pragma Segmented_Heap (Error_Code);
type Message_List is new Error_Messages.Errors;
type Subclass is new Di.Subclass;
end Object;
package Naming is
-- Provides mechanisms for manipulating and resolving names and for
-- establishing a context for name resolution.
subtype String_Name is String;
-- Lexically and syntactically a Directory system string name.
subtype Simple_String_Name is String;
-- A single segment of a string name: an Ada identfier with or wihout
-- attributes
subtype Context is Object.Handle;
-- The Directory System Object that serves as the initial context
-- for name resolution. May be any Object
procedure Set_Default_Context (The_Context : Naming.String_Name;
Status : out Object.Error_Code);
procedure Set_Default_Context (The_Context : Naming.Context;
Status : out Object.Error_Code);
-- Establishes the default naming context for the job.
function Default_Context return Naming.String_Name;
function Default_Context return Naming.Context;
-- Returns the default name resolution context for the job.
function Is_Well_Formed (A_Name : String_Name) return Boolean;
-- Tests whether a name is lexically and syntactically valid.
function Prefix (The_Name : String_Name) return String_Name;
-- Removes the last segment from a selected name and returns
-- the prefix.
-- Prefix ("A.B.C") => "A.B"
-- Prefix ("A") => ""
function Simple_Name (The_Name : String_Name) return Simple_String_Name;
-- Returns only the last segment of a selected name, without attributes
-- Simple_name ("A.B.C") => "C"
-- Simple_name ("A") => "A"
function Head (The_Name : String_Name) return Simple_String_Name;
-- Returns only the first segment of a selected name.
-- Head ("A.B.C") => "A"
-- Head ("A") => "A"
-- Head ("!A") => "!"
function Tail (The_Name : String_Name) return String_Name;
-- Removes the first segment from a selected name and returns the tail.
-- Tail ("A.B.C") => "B.C"
-- Tail ("A") => ""
function Attributes (A_Name : String_Name) return String;
-- Returns the Attributes at the end of the given string name.
-- If the simple name of the given string name has no attributes,
-- the null string is returned. The returned string starts with '''.
function Attribute
(A_Name : String_Name; Kind : String := "C") return String;
-- Returns the argument of the attribute designated by the kind
-- parameter that appears in the simple name of the given name.
-- If no argument follows the named attribute, the name of the attribute
-- is returned. (Parentheses are not part of the returned string.) If
-- the named attribute does not appear, the null string is returned.
function Nickname_Attribute
(A_Name : String_Name; Kind : String := "N") return String
renames Attribute;
function Class_Attribute
(A_Name : String_Name; Kind : String := "C") return String
renames Attribute;
function Version_Attribute
(A_Name : String_Name; Kind : String := "V") return String
renames Attribute;
-- returns the argument to the Nickname, Class and Version attributes
-- respectively.
function Part_Attribute (A_Name : String_Name) return String;
-- Returns either "'SPEC" or "'BODY" or the null string if neither
-- of these are present
function Expanded_Name (The_Name : Naming.String_Name;
Context : Naming.Context := Default_Context)
return String_Name;
-- Expands any prefix characters in the name appropriately.
function Full_Name (The_Object : Object.Handle)
return Naming.String_Name;
function Full_Name (The_Object : String_Name) return Naming.String_Name;
-- Computes the fully qualified string name for the The_Object
-- exclusive of qualifying attributes.
function Simple_Name (The_Object : Object.Handle)
return Simple_String_Name;
-- Computes the simple name for the The_Object exclusive of qualifying
-- attributes. (= Simple_Name (Full_Name (The_Object)));
function Unique_Full_Name
(The_Object : Object.Handle) return String_Name;
function Unique_Full_Name (The_Object : String_Name) return String_Name;
-- Full_Name with 'body, 'n(), and 'v() attributes as needed.
function Unique_Simple_Name
(The_Object : Object.Handle) return Simple_String_Name;
function Unique_Simple_Name
(The_Object : String_Name) return Simple_String_Name;
-- Simple_Name with 'body, 'n(), and 'v() attributes as needed.
function Ada_Name (The_Object : Object.Handle) return String_Name;
function Ada_Name (The_Object : String_Name) return String_Name;
-- Returns a valid ada name for an Object. (No extra attributes,
-- no library names, no "!", etc.)
function Resolution (Name : Naming.String_Name;
Context : Naming.Context := Default_Context;
Object_Only : Boolean := True)
return Object.Handle;
-- Resolve name to a single Object. Wild cards may be used, but
-- the name must resolve to a unique Object.
function Resolution (Name : Naming.String_Name;
Context : Naming.Context := Default_Context;
Objects_Only : Boolean := True)
return Object.Iterator;
-- Resolves (ambiguous) Source name in the given context. If
-- Objects_Only is true, only (separate) Objects that match the
-- name will be included; when false, Ada declarations will
-- be included even if no separate Object is associated with them.
-- Resolution is more efficient if Objects_Only is true.
function Pattern (Iter : Object.Iterator) return String_Name;
function Pattern (Iter : Object.Iterator) return String_Table.Item;
-- Returns a string_name that describes the objects of the iterator. For
-- the iterator returned by resolution, this is the value of the Name
-- parameter.
function Has_Substitution_Characters
(Target : String_Name) return Boolean;
function Target_Name (Iter : Object.Iterator; Target : String_Name)
return String_Name;
-- Replaces the substitution characters in the given Target name
-- with the appropriate values derived from the current Object of
-- the iteration (using the Pattern of the iterator).
function Target_Name (The_Object : Object.Handle;
Pattern : String_Name;
Target : String_Name) return String_Name;
function Target_Name (Source : String_Name; Target : String_Name)
return String_Name;
-- Given an Object and a source name (with wild cards) that
-- matches the name of the The_Object, returns a target string in which
-- substitution characters have been replaced by the matching
-- portions of the The_Object's name as indicated by the source name
-- pattern.
function Nickname (Def_Id : Object.Handle) return String;
function Nickname (Def_Id : Naming.String_Name) return String;
-- Returns the user-defined nickname associated with Def_Id, if one has
-- been specified; returns the system-defined nickname otherwise.
function System_Nickname (Def_Id : Object.Handle) return String;
function System_Nickname (Def_Id : Naming.String_Name) return String;
-- returns the system-assigned nickname for the given Def_Id, whether
-- or not a user-defined nickname has been assigned. The
-- system-assigned nickname is the image of the ordinal position
-- (1-origin) of the def_id among its namesakes in its declarative
-- region.
function Is_Overloaded (Def_Id : Object.Handle) return Boolean;
function Is_Overloaded (Def_Id : Naming.String_Name) return Boolean;
-- returns true if the given Def_Id is an overloaded Ada declaration.
end Naming;
package Traversal is
-- Provides operations for traversing the Directory System
-- in a variety of ways.
function Position (The_Object : Naming.String_Name) return Natural;
function Position (The_Object : Object.Handle) return Natural;
-- The position of the object in its declarative context. The first
-- item is position '0'.
Default_Position : constant Natural := Natural'Last;
-- Specifies the end of the list.
function Universe return Object.Handle;
-- Returns the (somewhat special) Object corresponding to the
-- root of the universe.
function Parent (The_Object : Object.Handle) return Object.Handle;
-- Returns the parent Object for The_Object.
function Enclosing_World
(The_Object : Object.Handle) return Object.Handle;
function Enclosing_Library
(The_Object : Object.Handle) return Object.Handle;
-- Returns the nearest enclosing Library/World that contains
-- the specified Object.
function Associated_World
(The_Object : Object.Handle) return Object.Handle;
function Associated_Library
(The_Object : Object.Handle) return Object.Handle;
-- Returns the nearest enclosing Library/World that contains
-- the specified Object, but if the object is a Library/World, that
-- value is returned.
function Child (The_Object : Object.Handle;
Child_Name : Naming.Simple_String_Name)
return Object.Handle;
-- Retrieve the named subobject.
function Children (The_Object : Object.Handle;
Pattern : Naming.Simple_String_Name := "@";
Declared : Boolean := True;
Class : Object.Class_Enumeration :=
Object.Unknown_Class) return Object.Iterator;
-- Initializes the iteration over the children that match the
-- specified name pattern. If Declared is True, only children
-- that are declared in the given Version of the the Object will be
-- returned. If Declared is false, all existing children of the
-- Object are returned even if they have no stub declaration in the
-- given Version of the unit.
-- If a class is provided, only children of that class are returned
function Versions (The_Object : Object.Handle;
Forward : Boolean := True) return Object.Iterator;
-- Get all versions of the given object; iterator is ordered forward
-- or backward according to creation time based on the Forward boolean.
type Control_Enumeration is (Continue, Abandon_Level,
Abandon_Recursion, Skip_Children);
generic
type State_Record is private;
with procedure Op (Depth : Positive;
State : in out State_Record;
The_Object : Object.Handle;
Status : out Object.Error_Code;
Control : in out Traversal.Control_Enumeration);
procedure Recursion (State : in out State_Record;
The_Object : Object.Handle;
Status : out Object.Error_Code;
Pattern : Naming.Simple_String_Name := "@";
Class : Object.Class_Enumeration :=
Object.Unknown_Class;
Subunits : Boolean := True;
Directories : Boolean := True;
Worlds : Boolean := False;
Objects_Only : Boolean := True;
Deleted : Boolean := False);
-- Performs a depth-first traversal of the Directory structure
-- rooted at the given Object.
-- The Boolean parameters control scope of the traversal as follows:
-- Subunits : Subunits of Ada units are included
-- Directories : Nested directories are included
-- Worlds : Nested worlds are included
-- Objects_Only : Only separate Ada objects are included
-- Deleted : deleted objects are included
-- The formal procedure Op is called for each Object visited. The
-- State variable is passed from call to call. The traversal will
-- terminate immediately if the error code parameter has a bad value
-- when the Op procedure returns. This error code is returned as the
-- error code of the Recursion procedure. Recursion can also be
-- controlled by the Control parameter.
-- Only Objects with a simple name that matches the given Pattern are
-- visited.
-- Only Objects of the given Class (if not nil) are visited.
-- The Pattern and Class attributes do not affect the scope of the
-- traversal, just the Objects on which Op is called. For example, if
-- Class is Object.Class (Object.Ada), Op will be called for each Ada
-- object (including subunits) nested within the given object and within
-- any directory nested within the given Object and in the same world as
-- the given object.
generic
type State_Record is private;
with procedure Op (State : in out State_Record;
The_Object : Object.Handle;
The_Objects : out Object.Iterator;
Status : out Object.Error_Code;
Control : in out Traversal.Control_Enumeration);
procedure Closure (State : in out State_Record;
In_Objects : Object.Iterator;
Out_Objects : out Object.Iterator;
Status : out Object.Error_Code);
-- Computes the transitive closure of the Op procedure applied to the
-- input objects.
-- The only control_enumeration values supported are
-- Continue, Abandon_Recursion
-- The objects in the iterator Out_objects are in a known order. This
-- order is such that if the "op" procedure were computing the closure
-- of "with x;" statements, the objects in the iterator could be
-- promoted in order without incurring 'uninstalled' errors. If the
-- desire is to demote the objects, the list should be reversed.
-- A formal way of stating the order is:
-- For each object, operate on its children, then operate on the object
-- The algorithm is:
-- 1. result_iterator := object.create;
-- 2. For each each object in in_objects:
-- i. If the object is not 'in' the result_iterator, then
-- a. 'Visit' the object.
-- b. Recurse, (step 2) with the result of visit as the
-- new in_objects.
-- c. add the object to the result_iterator.
-- 3. out_objects := result_iterator.
end Traversal;
package Any_Object is
-- Operations to Create, Copy and Destroy Objects.
-- Several versions of an object may exist simultaneously. One of
-- these versions may be designated the default version, which will
-- be the one accessed if no specific version is referenced. For
-- Ada objects, only the default version may be at the installed
-- state or higher. For an object in a library, if there is no
-- default version, there will be no declaration for the object
-- visible. (However, for an Ada subunit, a stub declaration may be
-- visible in the parent object even though there is no default
-- version for the subunit.)
-- The versions that are not the default version are called deleted
-- versions. The number of versions of an object that are retained in
-- the system is controlled by a retention count parameter, which may
-- be set for each object individually. When the number of deleted
-- versions exceeds the retention count (either because the count has
-- been changed, or additional versions are deleted), existing versions
-- are destroyed (oldest first) until the count is satisfied.
Default_Retention_Count : constant := -1;
-- A special retention count value that directs an operation to use the
-- existing count for the object or inherit one from the parent object.
function Retention_Count (The_Object : Object.Handle) return Natural;
procedure Set_Retention_Count
(The_Object : Object.Handle;
Retention_Count : Integer := Default_Retention_Count;
Status : out Object.Error_Code);
function Is_Visible (The_Object : Object.Handle) return Boolean;
function Is_Visible (The_Object : Naming.String_Name) return Boolean;
function Has_Versions (The_Object : Object.Handle) return Boolean;
function Has_Versions (The_Object : Naming.String_Name) return Boolean;
function Has_Default_Version
(The_Object : Object.Handle) return Boolean;
function Has_Default_Version
(The_Object : Naming.String_Name) return Boolean;
procedure Create (The_Object : Object.Handle;
New_Version : out Object.Handle;
Status : out Object.Error_Code);
-- Create a new version of an existing Object. The new version becomes
-- the default version.
procedure Create (Object_Name : Naming.String_Name;
New_Version : out Object.Handle;
Status : out Object.Error_Code;
Class : Object.Class_Enumeration :=
Object.Unknown_Class;
Context : Naming.Context := Naming.Default_Context;
Position : Natural := Traversal.Default_Position;
Subclass : Object.Subclass := Object.Nil);
-- Creates a new version of the named object, which becomes the default
-- version. If an Object does not
-- yet exist with that name, one is created of the indicated class.
-- The declaration for the object is placed at the indicated position in
-- its parent context.
procedure Copy (Source : Object.Handle;
Destination : Object.Handle;
New_Version : out Object.Handle;
Status : out Object.Error_Code);
-- The version of the Source Object specified by the Source handle is
-- copied to the Destination Object, where it becomes the default
-- version of the Destination Object.
procedure Copy (Source : Naming.String_Name;
Destination : Naming.String_Name;
New_Version : out Object.Handle;
Status : out Object.Error_Code;
Source_Context : Naming.Context :=
Naming.Default_Context;
Destination_Context : Naming.Context :=
Naming.Default_Context;
Position : Natural := Traversal.Default_Position;
Subclass : Object.Subclass := Object.Nil);
-- Copies the value. Creates an entirely new declaration and Object
-- at the destination if one did not exist. If the declaration
-- existed, but the specified Version did not, creates
-- a new Version of the destination Object and makes it the default.
-- If the destination Version already
-- exists, overwrites the old value with the new. Copied Ada
-- units are source only, regardless of the state of the Source.
-- Copies only the Source Object (no sub-Objects).
procedure Delete (The_Object : Object.Handle;
Status : out Object.Error_Code;
Retention_Count : Integer := Default_Retention_Count);
procedure Delete (The_Object : Naming.String_Name;
Status : out Object.Error_Code;
The_Context : Naming.Context :=
Naming.Default_Context;
Retention_Count : Integer := Default_Retention_Count);
-- Deletes the default version of the specified Object. If,
-- after the deletion, the number of deleted versions exceeds the retention
-- count, the oldest version will be destroyed.
-- If the target of any delete is an installed Ada unit, first
-- attempts to withdraw the unit, then (if there were no errors)
-- performs the delete.
procedure Undelete (The_Object : Object.Handle;
Status : out Object.Error_Code);
procedure Undelete (The_Object : Naming.String_Name;
Status : out Object.Error_Code;
The_Context : Naming.Context :=
Naming.Default_Context);
-- Make the specified version of the given object the default version.
-- Reinstates the declaration (visibility) of the object if it had been
-- deleted.
procedure Expunge (The_Object : Naming.String_Name;
Status : out Object.Error_Code;
Retention_Count : Integer := 0;
Context : Naming.Context := Naming.Default_Context);
procedure Expunge (The_Object : Object.Handle;
Status : out Object.Error_Code;
Retention_Count : Integer := 0);
-- Destroy deleted versions of an Object (oldest first) until
-- the numer of deleted versions remaining is no more than the retention
-- count.
procedure Destroy (The_Object : Object.Handle;
Status : out Object.Error_Code;
Retention_Count : Integer :=
Default_Retention_Count);
procedure Destroy (The_Object : Naming.String_Name;
Status : out Object.Error_Code;
The_Context : Naming.Context :=
Naming.Default_Context;
Retention_Count : Integer :=
Default_Retention_Count);
-- Destroys the specified Version of the Object. If this is the
-- default version of the object, the declaration is deleted as well.
-- If the target of any destroy is an installed Ada unit, Destroy first
-- attempts to withdraw the unit, then (if there were no errors)
-- performs the destroy. After the destroy the object is expunged,
-- using the supplied retention count.
function Is_Frozen (The_Object : Naming.String_Name) return Boolean;
function Is_Frozen (The_Object : Object.Handle) return Boolean;
-- Test whether an Object is frozen. Frozen objects cannot be changed.
procedure Freeze (The_Object : Object.Handle;
Recursive : Boolean := False;
Status : out Object.Error_Code);
-- Freeze an Object or a unit (and its children which are in the
-- same control point) so that it cannot be changed.
procedure Unfreeze (The_Object : Object.Handle;
Recursive : Boolean := False;
Status : out Object.Error_Code);
-- Unfreeze an Object or a unit (and its children which are in
-- the same control point) so that it can be manipulated normally.
end Any_Object;
package Ada_Object is
-- Directory operations specific to the class ADA are defined here.
-- Objects of class Ada correspond to the notion of Compilation Unit
-- as defined by the LRM. These Ada units can be in one of six states:
type Unit_State is
(Nonexistent, Archived, -- text only; no Diana tree
Source, -- Source ready to be installed
Installed, -- Semantically consistent.
Coded -- Has been code generated.
);
function State (For_Unit : Object.Handle) return Ada_Object.Unit_State;
function State (For_Unit : Naming.String_Name)
return Ada_Object.Unit_State;
function Is_Source (The_Unit : Object.Handle) return Boolean;
function Is_Source (The_Unit : Naming.String_Name) return Boolean;
function Is_Installed (The_Unit : Object.Handle) return Boolean;
function Is_Installed (The_Unit : Naming.String_Name) return Boolean;
type Compilation_Kind is (Not_Class_Ada, Uncertain,
Library_Unit, Library_Unit_Body,
Subunit, Internal_Declaration);
-- Uncertain is returned for source units in which insufficient
-- text is present to determine it's kind. Internal_declaration
-- is returned for declarations with bodies contained in a
-- library unit
function Kind (Ada_Unit : Object.Handle) return Compilation_Kind;
function Kind (Ada_Unit : Naming.String_Name) return Compilation_Kind;
type Unit_Kind is (Not_Class_Ada, Uncertain, Function_Spec,
Function_Body, Procedure_Spec, Procedure_Body,
Package_Spec, Package_Body, Function_Instantiation,
Procedure_Instantiation, Package_Instantiation,
Generic_Function, Generic_Procedure, Generic_Package,
Function_Rename, Procedure_Rename, Package_Rename,
Task_Spec, Task_Type, Task_Body, Not_A_Unit);
-- More specific classification of type of Ada unit (declaration).
function Kind (Ada_Unit : Object.Handle) return Unit_Kind;
function Kind (Ada_Unit : Naming.String_Name) return Unit_Kind;
function Is_Visible_Part (Ada_Unit : Object.Handle) return Boolean;
function Is_Visible_Part (Ada_Unit : Naming.String_Name) return Boolean;
-- Determines whether the given unit corresponds to a visible part.
function Is_Subunit (Ada_Unit : Object.Handle) return Boolean;
function Is_Subunit (Ada_Unit : Naming.String_Name) return Boolean;
function Other_Part (Ada_Unit : Object.Handle) return Object.Handle;
-- Given the visible part, return the body, and vice versa. Returns
-- a nil unit if there is no complement.
-- May have to actually create the Object.
function Subunit (Ada_Unit : Object.Handle;
Subunit_Name : Naming.Simple_String_Name)
return Object.Handle;
-- Retrieve the named subunit.
function Subunits (Ada_Unit : Object.Handle;
Pattern : Naming.Simple_String_Name := "@";
Declared : Boolean := True) return Object.Iterator;
-- Computes a list of all subunits of the given unit whose name
-- matches the given Pattern. If Declared is True, only subunits
-- that are declared in the given Version of the the unit will be
-- returned. If Declared is false, all existing subunits of the unit
-- are returned even if they have no stub declaration in the given
-- Version of the unit.
function Depends_On (Defining_Id : Naming.String_Name;
The_Context : Naming.Context :=
Naming.Default_Context) return Object.Iterator;
function Depends_On (Defining_Id_Handle : Object.Handle)
return Object.Iterator;
-- Computes the set of ada units that depend upon the defining_id given.
-- A defining_id is the full name of the defining occurance of the item,
-- and can be any ada object, from a package to a variable.
function List_Of_Withs (Ada_Unit : Naming.String_Name;
The_Context : Naming.Context :=
Naming.Default_Context)
return Object.Iterator;
function List_Of_Withs (Ada_Unit_Handle : Object.Handle)
return Object.Iterator;
-- computes the set of units 'with'ed by the supplied unit.
-----------------------------------------------------------
-- Operations to promote and demote declarations. Promoting
-- declarations moves them "up" to higher declaration states (toward
-- Coded), while demotion moves declarations "down" to lower
-- declaration states (toward Nonexistent). Promoting to a lower
-- state or demoting to a higher state is an Illegal_Operation.
procedure Promote (Ada_Unit : Object.Handle;
Status : out Object.Error_Code;
Goal_State : Ada_Object.Unit_State :=
Ada_Object.Installed;
Switches : Object.Handle := Object.Nil);
procedure Promote (Ada_Unit : Naming.String_Name;
Status : out Object.Error_Code;
Goal_State : Ada_Object.Unit_State :=
Ada_Object.Installed;
Switches : Object.Handle := Object.Nil;
Context : Naming.Context := Naming.Default_Context);
-- A subunit may not be promoted to a state higher than that of
-- its parent, except that a subunit may be coded before the parent
-- is coded.
procedure Demote (Location : Object.Handle;
Status : out Object.Error_Code;
Goal_State : Ada_Object.Unit_State :=
Ada_Object.Source;
Switches : Object.Handle := Object.Nil);
procedure Demote (Location : Naming.String_Name;
Status : out Object.Error_Code;
Goal_State : Ada_Object.Unit_State :=
Ada_Object.Source;
Switches : Object.Handle := Object.Nil;
Context : Naming.Context := Naming.Default_Context);
-- This operation will fail with obsolescence error if any
-- declarations (including installed subunits) depend upon
-- demoted declarations.
end Ada_Object;
package Library_Object is
-- Directory operations specific to Libraries. Unlike other objects,
-- there can be only one version of a library object.
type Library_Kind is (Not_A_Library, Directory, World);
function Kind (Any_Object : Object.Handle)
return Library_Object.Library_Kind;
function Kind (Any_Object : Naming.String_Name)
return Library_Object.Library_Kind;
function Is_Library (Any_Object : Object.Handle) return Boolean;
function Is_Library (Any_Object : Naming.String_Name) return Boolean;
-- Returns true IFF the indicated object is an object of class Library
function Is_World (Any_Object : Object.Handle) return Boolean;
function Is_World (Any_Object : Naming.String_Name) return Boolean;
function Is_Directory (Any_Object : Object.Handle) return Boolean;
function Is_Directory (Any_Object : Naming.String_Name) return Boolean;
procedure Set_Switch_Object (The_Library : Object.Handle;
The_File : Object.Handle;
Status : out Object.Error_Code);
procedure Set_Switch_Object (The_Library : Naming.String_Name;
The_File : Naming.String_Name;
Status : out Object.Error_Code);
function Switch_Object
(The_Library : Object.Handle) return Object.Handle;
function Switch_Object (The_Library : Naming.String_Name)
return Naming.String_Name;
-- Used to manipulate the file Object used to store switch files.
subtype Volume_Id is Natural range 0 .. 31;
-- Used to represent a disk volume.
function Nil return Library_Object.Volume_Id;
function Is_Nil (The_Volume : Library_Object.Volume_Id) return Boolean;
function Volume (The_Library : Object.Handle)
return Library_Object.Volume_Id;
procedure Create (Name : Naming.Simple_String_Name;
Kind : Library_Object.Library_Kind;
New_Library : out Object.Handle;
Status : out Object.Error_Code;
Volume : Library_Object.Volume_Id :=
Library_Object.Nil;
Context : Naming.Context := Naming.Default_Context;
Position : Natural := Traversal.Default_Position;
Subclass : Object.Subclass := Object.Nil);
-- Creates a new Library (Directory or World) at the indicated
-- position. If an appropriate declaration already exists and has
-- no directory Object associated with it, that stub will be used
-- rather than creating a new one.
end Library_Object;
package Ada_Implementation is
subtype Root is Diana.Tree;
subtype Any_Node is Diana.Tree;
package Ai renames Ada_Implementation;
function Is_Source (For_Node : Any_Node) return Boolean;
function Is_Installed (For_Node : Any_Node) return Boolean;
procedure Will_Be_A_Comp_Unit (Root : Ai.Root;
Verdict : out Boolean;
Status : out Object.Error_Code);
-- A predicate which determines if the root of a child unit will
-- be promoted in place or made into a comp_unit.
-- procedure Replace_Comment (Node : Diana.Tree;
-- New_Comment : Comment_Definitions.Comment;
-- Pre_Comment : Boolean := True;
-- Status : out Error.Code);
-- Make New_Comment the Pre_/Post_Comment of Node.
-- Node must be in an installed unit.
type Open_Mode is
(None, -- Mode None only applies to installed units.
-- There is no synchronization with mode None.
Read -- Mode Read applies to either source or installed
-- units, and aquires a non-exclusive read lock
-- (exclusive of update, but not other readers).
);
procedure Open (The_Unit : Object.Handle;
Mode : Open_Mode;
Root : out Ai.Root;
Status : out Object.Error_Code);
-- Returns the root of the separate tree designated by The_Unit.
-- Opens the unit with the specified access Mode.
-- Incompatible access modes Error in queueing or Lock_Error.
-- Open and Close invoke policy specific pre and post operations
-- before and after execution.
-- Open first tries to open an object. If that fails, it
-- then tries to open the object containing the declaration.
-- In the latter case, the return value is the declaration within
-- the object.
procedure Close (The_Unit : Object.Handle;
Status : out Object.Error_Code);
-- Closes the indicated unit, releasing access.
procedure Get_Root (Node : Any_Node;
Root : out Ai.Root;
Status : out Object.Error_Code);
-- Returns the Root of the unit represented by the Node.
procedure Get_Handle (Node : Any_Node;
Handle : out Object.Handle;
Status : out Object.Error_Code);
-- Returns the Object containing the Node.
end Ada_Implementation;
package Statistics is
subtype User is Object.Handle;
subtype Session is Object.Handle;
function Time_Of_Last_Update
(The_Object : Object.Handle) return Calendar.Time;
function Time_Of_Last_Read
(The_Object : Object.Handle) return Calendar.Time;
function Time_Of_Creation
(The_Object : Object.Handle) return Calendar.Time;
function Last_Updater (The_Object : Object.Handle) return User;
function Session_Of_Last_Updater
(The_Object : Object.Handle) return Session;
function Last_Reader (The_Object : Object.Handle) return User;
function Session_Of_Last_Reader
(The_Object : Object.Handle) return Session;
function Creator (The_Object : Object.Handle) return User;
function Session_Of_Creator (The_Object : Object.Handle) return Session;
function Total_Size (The_Object : Object.Handle) return Long_Integer;
function Header_Size (The_Object : Object.Handle) return Natural;
function Object_Size (The_Object : Object.Handle) return Long_Integer;
function Last_Edit_Time (The_Unit : Object.Handle) return Calendar.Time;
end Statistics;
pragma Subsystem (Cmvc, Closed);
pragma Module_Name (4, 3525);
end Directory_Tools;