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 3, 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 COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 -- This package defines packages and attributes in GNAT project files.
27 -- There are predefined packages and attributes.
29 -- It is also possible to define new packages with their attributes
36 -- Initialize the predefined project level attributes and the predefined
37 -- packages and their attribute. This procedure should be called by
40 type Attribute_Kind is
44 Optional_Index_Associative_Array,
45 Case_Insensitive_Associative_Array,
46 Optional_Index_Case_Insensitive_Associative_Array);
47 -- Characteristics of an attribute. Optional_Index indicates that there
48 -- may be an optional index in the index of the associative array, as in
49 -- for Switches ("files.ada" at 2) use ...
51 subtype Defined_Attribute_Kind is Attribute_Kind
52 range Single .. Optional_Index_Case_Insensitive_Associative_Array;
53 -- Subset of Attribute_Kinds that may be used for the attributes that is
54 -- used when defining a new package.
56 Max_Attribute_Name_Length : constant := 64;
57 -- The maximum length of attribute names
59 subtype Attribute_Name_Length is
60 Positive range 1 .. Max_Attribute_Name_Length;
62 type Attribute_Data (Name_Length : Attribute_Name_Length := 1) is record
63 Name : String (1 .. Name_Length);
64 -- The name of the attribute
66 Attr_Kind : Defined_Attribute_Kind;
67 -- The type of the attribute
69 Index_Is_File_Name : Boolean;
70 -- For associative arrays, indicate if the index is a file name, so
71 -- that the attribute kind may be modified depending on the case
72 -- sensitivity of file names. This is only taken into account when
73 -- Attr_Kind is Associative_Array or Optional_Index_Associative_Array.
76 -- True if there may be an optional index in the value of the index,
79 -- ("main.adb", "file.ada" at 1)
81 Var_Kind : Defined_Variable_Kind;
82 -- The attribute value kind: single or list
85 -- Name and characteristics of an attribute in a package registered
86 -- explicitly with Register_New_Package (see below).
88 type Attribute_Data_Array is array (Positive range <>) of Attribute_Data;
89 -- A list of attribute name/characteristics to be used as parameter of
90 -- procedure Register_New_Package below.
92 -- In the subprograms below, when it is specified that the subprogram
93 -- "fails", procedure Prj.Com.Fail is called. Unless it is specified
94 -- otherwise, if Prj.Com.Fail returns, exception Prj.Prj_Error is raised.
96 procedure Register_New_Package
98 Attributes : Attribute_Data_Array);
99 -- Add a new package with its attributes. This procedure can only be
100 -- called after Initialize, but before any other call to a service of
101 -- the Project Manager. Fail if the name of the package is empty or not
102 -- unique, or if the names of the attributes are not different.
108 type Attribute_Node_Id is private;
109 -- The type to refers to an attribute, self-initialized
111 Empty_Attribute : constant Attribute_Node_Id;
112 -- Indicates no attribute. Default value of Attribute_Node_Id objects
114 Attribute_First : constant Attribute_Node_Id;
115 -- First attribute node id of project level attributes
117 function Attribute_Node_Id_Of
119 Starting_At : Attribute_Node_Id) return Attribute_Node_Id;
120 -- Returns the node id of an attribute at the project level or in
121 -- a package. Starting_At indicates the first known attribute node where
122 -- to start the search. Returns Empty_Attribute if the attribute cannot
125 function Attribute_Kind_Of
126 (Attribute : Attribute_Node_Id) return Attribute_Kind;
127 -- Returns the attribute kind of a known attribute. Returns Unknown if
128 -- Attribute is Empty_Attribute.
130 procedure Set_Attribute_Kind_Of
131 (Attribute : Attribute_Node_Id;
132 To : Attribute_Kind);
133 -- Set the attribute kind of a known attribute. Does nothing if
134 -- Attribute is Empty_Attribute.
136 function Attribute_Name_Of (Attribute : Attribute_Node_Id) return Name_Id;
137 -- Returns the name of a known attribute. Returns No_Name if Attribute is
140 function Variable_Kind_Of
141 (Attribute : Attribute_Node_Id) return Variable_Kind;
142 -- Returns the variable kind of a known attribute. Returns Undefined if
143 -- Attribute is Empty_Attribute.
145 procedure Set_Variable_Kind_Of
146 (Attribute : Attribute_Node_Id;
148 -- Set the variable kind of a known attribute. Does nothing if Attribute is
151 function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean;
152 -- Returns True if Attribute is a known attribute and may have an
153 -- optional index. Returns False otherwise.
155 function Is_Read_Only (Attribute : Attribute_Node_Id) return Boolean;
157 function Next_Attribute
158 (After : Attribute_Node_Id) return Attribute_Node_Id;
159 -- Returns the attribute that follow After in the list of project level
160 -- attributes or the list of attributes in a package.
161 -- Returns Empty_Attribute if After is either Empty_Attribute or is the
168 type Package_Node_Id is private;
169 -- Type to refer to a package, self initialized
171 Empty_Package : constant Package_Node_Id;
172 -- Default value of Package_Node_Id objects
174 procedure Register_New_Package (Name : String; Id : out Package_Node_Id);
175 -- Add a new package. Fails if Name (the package name) is empty or is
176 -- already the name of a package, and set Id to Empty_Package,
177 -- if Prj.Com.Fail returns. Initially, the new package has no attributes.
178 -- Id may be used to add attributes using procedure Register_New_Attribute
181 procedure Register_New_Attribute
183 In_Package : Package_Node_Id;
184 Attr_Kind : Defined_Attribute_Kind;
185 Var_Kind : Defined_Variable_Kind;
186 Index_Is_File_Name : Boolean := False;
187 Opt_Index : Boolean := False);
188 -- Add a new attribute to registered package In_Package. Fails if Name
189 -- (the attribute name) is empty, if In_Package is Empty_Package or if
190 -- the attribute name has a duplicate name. See definition of type
191 -- Attribute_Data above for the meaning of parameters Attr_Kind, Var_Kind,
192 -- Index_Is_File_Name and Opt_Index.
194 function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id;
195 -- Returns the package node id of the package with name Name. Returns
196 -- Empty_Package if there is no package with this name.
198 function First_Attribute_Of
199 (Pkg : Package_Node_Id) return Attribute_Node_Id;
200 -- Returns the first attribute in the list of attributes of package Pkg.
201 -- Returns Empty_Attribute if Pkg is Empty_Package.
208 Attributes_Initial : constant := 50;
209 Attributes_Increment : constant := 100;
211 Attribute_Node_Low_Bound : constant := 0;
212 Attribute_Node_High_Bound : constant := 099_999_999;
215 range Attribute_Node_Low_Bound .. Attribute_Node_High_Bound;
216 -- Index type for table Attrs in the body
218 type Attribute_Node_Id is record
219 Value : Attr_Node_Id := Attribute_Node_Low_Bound;
221 -- Full declaration of self-initialized private type
223 Empty_Attr : constant Attr_Node_Id := Attribute_Node_Low_Bound;
225 Empty_Attribute : constant Attribute_Node_Id := (Value => Empty_Attr);
227 First_Attribute : constant Attr_Node_Id := Attribute_Node_Low_Bound + 1;
229 First_Attribute_Node_Id : constant Attribute_Node_Id :=
230 (Value => First_Attribute);
232 Attribute_First : constant Attribute_Node_Id := First_Attribute_Node_Id;
238 Packages_Initial : constant := 10;
239 Packages_Increment : constant := 100;
241 Package_Node_Low_Bound : constant := 0;
242 Package_Node_High_Bound : constant := 099_999_999;
245 range Package_Node_Low_Bound .. Package_Node_High_Bound;
246 -- Index type for table Package_Attributes in the body
248 type Package_Node_Id is record
249 Value : Pkg_Node_Id := Package_Node_Low_Bound;
251 -- Full declaration of self-initialized private type
253 Empty_Pkg : constant Pkg_Node_Id := Package_Node_Low_Bound;
255 Empty_Package : constant Package_Node_Id := (Value => Empty_Pkg);
257 First_Package : constant Pkg_Node_Id := Package_Node_Low_Bound + 1;
259 First_Package_Node_Id : constant Package_Node_Id :=
260 (Value => First_Package);
262 Package_First : constant Package_Node_Id := First_Package_Node_Id;
268 type Attribute_Record is record
270 Var_Kind : Variable_Kind;
271 Optional_Index : Boolean;
272 Attr_Kind : Attribute_Kind;
276 -- Data for an attribute
279 new Table.Table (Table_Component_Type => Attribute_Record,
280 Table_Index_Type => Attr_Node_Id,
281 Table_Low_Bound => First_Attribute,
282 Table_Initial => Attributes_Initial,
283 Table_Increment => Attributes_Increment,
284 Table_Name => "Prj.Attr.Attrs");
285 -- The table of the attributes
291 type Package_Record is record
293 Known : Boolean := True;
294 First_Attribute : Attr_Node_Id;
296 -- Data for a package
298 package Package_Attributes is
299 new Table.Table (Table_Component_Type => Package_Record,
300 Table_Index_Type => Pkg_Node_Id,
301 Table_Low_Bound => First_Package,
302 Table_Initial => Packages_Initial,
303 Table_Increment => Packages_Increment,
304 Table_Name => "Prj.Attr.Packages");
305 -- The table of the packages