1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 -- This package defines packages and attributes in GNAT project files.
28 -- There are predefined packages and attributes.
30 -- It is also possible to define new packages with their attributes
37 -- Initialize the predefined project level attributes and the predefined
38 -- packages and their attribute. This procedure should be called by
41 type Attribute_Kind is
45 Optional_Index_Associative_Array,
46 Case_Insensitive_Associative_Array,
47 Optional_Index_Case_Insensitive_Associative_Array);
48 -- Characteristics of an attribute. Optional_Index indicates that there
49 -- may be an optional index in the index of the associative array, as in
50 -- for Switches ("files.ada" at 2) use ...
52 subtype Defined_Attribute_Kind is Attribute_Kind
53 range Single .. Optional_Index_Case_Insensitive_Associative_Array;
54 -- Subset of Attribute_Kinds that may be used for the attributes that is
55 -- used when defining a new package.
57 Max_Attribute_Name_Length : constant := 64;
58 -- The maximum length of attribute names
60 subtype Attribute_Name_Length is
61 Positive range 1 .. Max_Attribute_Name_Length;
63 type Attribute_Data (Name_Length : Attribute_Name_Length := 1) is record
64 Name : String (1 .. Name_Length);
65 -- The name of the attribute
67 Attr_Kind : Defined_Attribute_Kind;
68 -- The type of the attribute
70 Index_Is_File_Name : Boolean;
71 -- For associative arrays, indicate if the index is a file name, so
72 -- that the attribute kind may be modified depending on the case
73 -- sensitivity of file names. This is only taken into account when
74 -- Attr_Kind is Associative_Array or Optional_Index_Associative_Array.
77 -- True if there may be an optional index in the value of the index,
80 -- ("main.adb", "file.ada" at 1)
82 Var_Kind : Defined_Variable_Kind;
83 -- The attribute value kind: single or list
86 -- Name and characteristics of an attribute in a package registered
87 -- explicitly with Register_New_Package (see below).
89 type Attribute_Data_Array is array (Positive range <>) of Attribute_Data;
90 -- A list of attribute name/characteristics to be used as parameter of
91 -- procedure Register_New_Package below.
93 -- In the subprograms below, when it is specified that the subprogram
94 -- "fails", procedure Prj.Com.Fail is called. Unless it is specified
95 -- otherwise, if Prj.Com.Fail returns, exception Prj.Prj_Error is raised.
97 procedure Register_New_Package
99 Attributes : Attribute_Data_Array);
100 -- Add a new package with its attributes. This procedure can only be
101 -- called after Initialize, but before any other call to a service of
102 -- the Project Manager. Fail if the name of the package is empty or not
103 -- unique, or if the names of the attributes are not different.
109 type Attribute_Node_Id is private;
110 -- The type to refers to an attribute, self-initialized
112 Empty_Attribute : constant Attribute_Node_Id;
113 -- Indicates no attribute. Default value of Attribute_Node_Id objects
115 Attribute_First : constant Attribute_Node_Id;
116 -- First attribute node id of project level attributes
118 function Attribute_Node_Id_Of
120 Starting_At : Attribute_Node_Id) return Attribute_Node_Id;
121 -- Returns the node id of an attribute at the project level or in
122 -- a package. Starting_At indicates the first known attribute node where
123 -- to start the search. Returns Empty_Attribute if the attribute cannot
126 function Attribute_Kind_Of
127 (Attribute : Attribute_Node_Id) return Attribute_Kind;
128 -- Returns the attribute kind of a known attribute. Returns Unknown if
129 -- Attribute is Empty_Attribute.
131 procedure Set_Attribute_Kind_Of
132 (Attribute : Attribute_Node_Id;
133 To : Attribute_Kind);
134 -- Set the attribute kind of a known attribute. Does nothing if
135 -- Attribute is Empty_Attribute.
137 function Attribute_Name_Of (Attribute : Attribute_Node_Id) return Name_Id;
138 -- Returns the name of a known attribute. Returns No_Name if Attribute is
141 function Variable_Kind_Of
142 (Attribute : Attribute_Node_Id) return Variable_Kind;
143 -- Returns the variable kind of a known attribute. Returns Undefined if
144 -- Attribute is Empty_Attribute.
146 procedure Set_Variable_Kind_Of
147 (Attribute : Attribute_Node_Id;
149 -- Set the variable kind of a known attribute. Does nothing if Attribute is
152 function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean;
153 -- Returns True if Attribute is a known attribute and may have an
154 -- optional index. Returns False otherwise.
156 function Is_Read_Only (Attribute : Attribute_Node_Id) return Boolean;
158 function Next_Attribute
159 (After : Attribute_Node_Id) return Attribute_Node_Id;
160 -- Returns the attribute that follow After in the list of project level
161 -- attributes or the list of attributes in a package.
162 -- Returns Empty_Attribute if After is either Empty_Attribute or is the
169 type Package_Node_Id is private;
170 -- Type to refer to a package, self initialized
172 Empty_Package : constant Package_Node_Id;
173 -- Default value of Package_Node_Id objects
175 procedure Register_New_Package (Name : String; Id : out Package_Node_Id);
176 -- Add a new package. Fails if Name (the package name) is empty or is
177 -- already the name of a package, and set Id to Empty_Package,
178 -- if Prj.Com.Fail returns. Initially, the new package has no attributes.
179 -- Id may be used to add attributes using procedure Register_New_Attribute
182 procedure Register_New_Attribute
184 In_Package : Package_Node_Id;
185 Attr_Kind : Defined_Attribute_Kind;
186 Var_Kind : Defined_Variable_Kind;
187 Index_Is_File_Name : Boolean := False;
188 Opt_Index : Boolean := False);
189 -- Add a new attribute to registered package In_Package. Fails if Name
190 -- (the attribute name) is empty, if In_Package is Empty_Package or if
191 -- the attribute name has a duplicate name. See definition of type
192 -- Attribute_Data above for the meaning of parameters Attr_Kind, Var_Kind,
193 -- Index_Is_File_Name and Opt_Index.
195 function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id;
196 -- Returns the package node id of the package with name Name. Returns
197 -- Empty_Package if there is no package with this name.
199 function First_Attribute_Of
200 (Pkg : Package_Node_Id) return Attribute_Node_Id;
201 -- Returns the first attribute in the list of attributes of package Pkg.
202 -- Returns Empty_Attribute if Pkg is Empty_Package.
209 Attributes_Initial : constant := 50;
210 Attributes_Increment : constant := 100;
212 Attribute_Node_Low_Bound : constant := 0;
213 Attribute_Node_High_Bound : constant := 099_999_999;
216 range Attribute_Node_Low_Bound .. Attribute_Node_High_Bound;
217 -- Index type for table Attrs in the body
219 type Attribute_Node_Id is record
220 Value : Attr_Node_Id := Attribute_Node_Low_Bound;
222 -- Full declaration of self-initialized private type
224 Empty_Attr : constant Attr_Node_Id := Attribute_Node_Low_Bound;
226 Empty_Attribute : constant Attribute_Node_Id := (Value => Empty_Attr);
228 First_Attribute : constant Attr_Node_Id := Attribute_Node_Low_Bound + 1;
230 First_Attribute_Node_Id : constant Attribute_Node_Id :=
231 (Value => First_Attribute);
233 Attribute_First : constant Attribute_Node_Id := First_Attribute_Node_Id;
239 Packages_Initial : constant := 10;
240 Packages_Increment : constant := 100;
242 Package_Node_Low_Bound : constant := 0;
243 Package_Node_High_Bound : constant := 099_999_999;
246 range Package_Node_Low_Bound .. Package_Node_High_Bound;
247 -- Index type for table Package_Attributes in the body
249 type Package_Node_Id is record
250 Value : Pkg_Node_Id := Package_Node_Low_Bound;
252 -- Full declaration of self-initialized private type
254 Empty_Pkg : constant Pkg_Node_Id := Package_Node_Low_Bound;
256 Empty_Package : constant Package_Node_Id := (Value => Empty_Pkg);
258 First_Package : constant Pkg_Node_Id := Package_Node_Low_Bound + 1;
260 First_Package_Node_Id : constant Package_Node_Id :=
261 (Value => First_Package);
263 Package_First : constant Package_Node_Id := First_Package_Node_Id;
269 type Attribute_Record is record
271 Var_Kind : Variable_Kind;
272 Optional_Index : Boolean;
273 Attr_Kind : Attribute_Kind;
277 -- Data for an attribute
280 new Table.Table (Table_Component_Type => Attribute_Record,
281 Table_Index_Type => Attr_Node_Id,
282 Table_Low_Bound => First_Attribute,
283 Table_Initial => Attributes_Initial,
284 Table_Increment => Attributes_Increment,
285 Table_Name => "Prj.Attr.Attrs");
286 -- The table of the attributes
292 type Package_Record is record
294 Known : Boolean := True;
295 First_Attribute : Attr_Node_Id;
297 -- Data for a package
299 package Package_Attributes is
300 new Table.Table (Table_Component_Type => Package_Record,
301 Table_Index_Type => Pkg_Node_Id,
302 Table_Low_Bound => First_Package,
303 Table_Initial => Packages_Initial,
304 Table_Increment => Packages_Increment,
305 Table_Name => "Prj.Attr.Packages");
306 -- The table of the packages