-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2006, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- This package defines packages and attributes in GNAT project files.
-- There are predefined packages and attributes.
--- It is also possible to define new packages with their attributes.
-with Types; use Types;
+-- It is also possible to define new packages with their attributes
+
+with Table;
package Prj.Attr is
-- explicitly with Register_New_Package (see below).
type Attribute_Data_Array is array (Positive range <>) of Attribute_Data;
+ -- A list of attribute name/characteristics to be used as parameter of
+ -- procedure Register_New_Package below.
+
+ -- In the subprograms below, when it is specified that the subprogram
+ -- "fails", procedure Prj.Com.Fail is called. Unless it is specified
+ -- otherwise, if Prj.Com.Fail returns, exception Prj.Prj_Error is raised.
procedure Register_New_Package
(Name : String;
Attributes : Attribute_Data_Array);
- -- Add a new package with its attributes.
- -- This procedure can only be called after Initialize, but before any
- -- other call to a service of the Project Managers.
- -- The name of the package must be unique. The names of the attributes
- -- must be different.
-
- -- The following declarations are only for the Project Manager, that is
- -- the packages of the Prj or MLib hierarchies.
+ -- Add a new package with its attributes. This procedure can only be
+ -- called after Initialize, but before any other call to a service of
+ -- the Project Manager. Fail if the name of the package is empty or not
+ -- unique, or if the names of the attributes are not different.
----------------
-- Attributes --
-- The type to refers to an attribute, self-initialized
Empty_Attribute : constant Attribute_Node_Id;
- -- Indicates no attribute. Default value of Attribute_Node_Id objects.
+ -- Indicates no attribute. Default value of Attribute_Node_Id objects
Attribute_First : constant Attribute_Node_Id;
-- First attribute node id of project level attributes
-- Default value of Package_Node_Id objects
procedure Register_New_Package (Name : String; Id : out Package_Node_Id);
- -- Add a new package. Fails if the package has a duplicate name.
- -- Initially, the new package has no attributes. Id may be used to add
- -- attributes using procedure Register_New_Attribute below.
+ -- Add a new package. Fails if Name (the package name) is empty or is
+ -- already the name of a package, and set Id to Empty_Package,
+ -- if Prj.Com.Fail returns. Initially, the new package has no attributes.
+ -- Id may be used to add attributes using procedure Register_New_Attribute
+ -- below.
procedure Register_New_Attribute
(Name : String;
Var_Kind : Defined_Variable_Kind;
Index_Is_File_Name : Boolean := False;
Opt_Index : Boolean := False);
- -- Add a new attribute to registered package In_Package. Fails if the
- -- attribute has a duplicate name. See definition of type Attribute_Data
- -- above for the meaning of parameters Attr_Kind, Var_Kind,
+ -- Add a new attribute to registered package In_Package. Fails if Name
+ -- (the attribute name) is empty, if In_Package is Empty_Package or if
+ -- the attribute name has a duplicate name. See definition of type
+ -- Attribute_Data above for the meaning of parameters Attr_Kind, Var_Kind,
-- Index_Is_File_Name and Opt_Index.
function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id;
-- Returns the package node id of the package with name Name. Returns
-- Empty_Package if there is no package with this name.
- procedure Add_Unknown_Package (Name : Name_Id; Id : out Package_Node_Id);
- -- Add a new package. The Name cannot be the name of a predefined or
- -- already registered package.
-
function First_Attribute_Of
(Pkg : Package_Node_Id) return Attribute_Node_Id;
-- Returns the first attribute in the list of attributes of package Pkg.
-- Returns Empty_Attribute if Pkg is Empty_Package.
- procedure Add_Attribute
- (To_Package : Package_Node_Id;
- Attribute_Name : Name_Id;
- Attribute_Node : out Attribute_Node_Id);
- -- Add an attribute to the list for package To_Package. Attribute_Name
- -- cannot be the name of an existing attribute of the package.
- -- Does nothing if To_Package is Empty_Package.
-
private
----------------
-- Attributes --
----------------
Attributes_Initial : constant := 50;
- Attributes_Increment : constant := 50;
+ Attributes_Increment : constant := 100;
Attribute_Node_Low_Bound : constant := 0;
Attribute_Node_High_Bound : constant := 099_999_999;
--------------
Packages_Initial : constant := 10;
- Packages_Increment : constant := 50;
+ Packages_Increment : constant := 100;
Package_Node_Low_Bound : constant := 0;
Package_Node_High_Bound : constant := 099_999_999;
Package_First : constant Package_Node_Id := First_Package_Node_Id;
+ ----------------
+ -- Attributes --
+ ----------------
+
+ type Attribute_Record is record
+ Name : Name_Id;
+ Var_Kind : Variable_Kind;
+ Optional_Index : Boolean;
+ Attr_Kind : Attribute_Kind;
+ Next : Attr_Node_Id;
+ end record;
+ -- Data for an attribute
+
+ package Attrs is
+ new Table.Table (Table_Component_Type => Attribute_Record,
+ Table_Index_Type => Attr_Node_Id,
+ Table_Low_Bound => First_Attribute,
+ Table_Initial => Attributes_Initial,
+ Table_Increment => Attributes_Increment,
+ Table_Name => "Prj.Attr.Attrs");
+ -- The table of the attributes
+
+ --------------
+ -- Packages --
+ --------------
+
+ type Package_Record is record
+ Name : Name_Id;
+ Known : Boolean := True;
+ First_Attribute : Attr_Node_Id;
+ end record;
+ -- Data for a package
+
+ package Package_Attributes is
+ new Table.Table (Table_Component_Type => Package_Record,
+ Table_Index_Type => Pkg_Node_Id,
+ Table_Low_Bound => First_Package,
+ Table_Initial => Packages_Initial,
+ Table_Increment => Packages_Increment,
+ Table_Name => "Prj.Attr.Packages");
+ -- The table of the packages
+
end Prj.Attr;
OSDN Git Service
