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
38 function Package_Name_List return Strings.String_List;
39 -- Returns the list of valid package names, including those added by
40 -- procedures Register_New_Package below. The String_Access components of
41 -- the returned String_List should never be feeed.
44 -- Initialize the predefined project level attributes and the predefined
45 -- packages and their attribute. This procedure should be called by
48 type Attribute_Kind is
52 Optional_Index_Associative_Array,
53 Case_Insensitive_Associative_Array,
54 Optional_Index_Case_Insensitive_Associative_Array);
55 -- Characteristics of an attribute. Optional_Index indicates that there
56 -- may be an optional index in the index of the associative array, as in
57 -- for Switches ("files.ada" at 2) use ...
59 subtype Defined_Attribute_Kind is Attribute_Kind
60 range Single .. Optional_Index_Case_Insensitive_Associative_Array;
61 -- Subset of Attribute_Kinds that may be used for the attributes that is
62 -- used when defining a new package.
64 Max_Attribute_Name_Length : constant := 64;
65 -- The maximum length of attribute names
67 subtype Attribute_Name_Length is
68 Positive range 1 .. Max_Attribute_Name_Length;
70 type Attribute_Data (Name_Length : Attribute_Name_Length := 1) is record
71 Name : String (1 .. Name_Length);
72 -- The name of the attribute
74 Attr_Kind : Defined_Attribute_Kind;
75 -- The type of the attribute
77 Index_Is_File_Name : Boolean;
78 -- For associative arrays, indicate if the index is a file name, so
79 -- that the attribute kind may be modified depending on the case
80 -- sensitivity of file names. This is only taken into account when
81 -- Attr_Kind is Associative_Array or Optional_Index_Associative_Array.
84 -- True if there may be an optional index in the value of the index,
87 -- ("main.adb", "file.ada" at 1)
89 Var_Kind : Defined_Variable_Kind;
90 -- The attribute value kind: single or list
93 -- Name and characteristics of an attribute in a package registered
94 -- explicitly with Register_New_Package (see below).
96 type Attribute_Data_Array is array (Positive range <>) of Attribute_Data;
97 -- A list of attribute name/characteristics to be used as parameter of
98 -- procedure Register_New_Package below.
100 -- In the subprograms below, when it is specified that the subprogram
101 -- "fails", procedure Prj.Com.Fail is called. Unless it is specified
102 -- otherwise, if Prj.Com.Fail returns, exception Prj.Prj_Error is raised.
104 procedure Register_New_Package
106 Attributes : Attribute_Data_Array);
107 -- Add a new package with its attributes. This procedure can only be
108 -- called after Initialize, but before any other call to a service of
109 -- the Project Manager. Fail if the name of the package is empty or not
110 -- unique, or if the names of the attributes are not different.
116 type Attribute_Node_Id is private;
117 -- The type to refers to an attribute, self-initialized
119 Empty_Attribute : constant Attribute_Node_Id;
120 -- Indicates no attribute. Default value of Attribute_Node_Id objects
122 Attribute_First : constant Attribute_Node_Id;
123 -- First attribute node id of project level attributes
125 function Attribute_Node_Id_Of
127 Starting_At : Attribute_Node_Id) return Attribute_Node_Id;
128 -- Returns the node id of an attribute at the project level or in
129 -- a package. Starting_At indicates the first known attribute node where
130 -- to start the search. Returns Empty_Attribute if the attribute cannot
133 function Attribute_Kind_Of
134 (Attribute : Attribute_Node_Id) return Attribute_Kind;
135 -- Returns the attribute kind of a known attribute. Returns Unknown if
136 -- Attribute is Empty_Attribute.
138 procedure Set_Attribute_Kind_Of
139 (Attribute : Attribute_Node_Id;
140 To : Attribute_Kind);
141 -- Set the attribute kind of a known attribute. Does nothing if
142 -- Attribute is Empty_Attribute.
144 function Attribute_Name_Of (Attribute : Attribute_Node_Id) return Name_Id;
145 -- Returns the name of a known attribute. Returns No_Name if Attribute is
148 function Variable_Kind_Of
149 (Attribute : Attribute_Node_Id) return Variable_Kind;
150 -- Returns the variable kind of a known attribute. Returns Undefined if
151 -- Attribute is Empty_Attribute.
153 procedure Set_Variable_Kind_Of
154 (Attribute : Attribute_Node_Id;
156 -- Set the variable kind of a known attribute. Does nothing if Attribute is
159 function Optional_Index_Of (Attribute : Attribute_Node_Id) return Boolean;
160 -- Returns True if Attribute is a known attribute and may have an
161 -- optional index. Returns False otherwise.
163 function Is_Read_Only (Attribute : Attribute_Node_Id) return Boolean;
165 function Next_Attribute
166 (After : Attribute_Node_Id) return Attribute_Node_Id;
167 -- Returns the attribute that follow After in the list of project level
168 -- attributes or the list of attributes in a package.
169 -- Returns Empty_Attribute if After is either Empty_Attribute or is the
176 type Package_Node_Id is private;
177 -- Type to refer to a package, self initialized
179 Empty_Package : constant Package_Node_Id;
180 -- Default value of Package_Node_Id objects
182 Unknown_Package : constant Package_Node_Id;
183 -- Value of an unknown package that has been found but is unknown.
185 procedure Register_New_Package (Name : String; Id : out Package_Node_Id);
186 -- Add a new package. Fails if Name (the package name) is empty or is
187 -- already the name of a package, and set Id to Empty_Package,
188 -- if Prj.Com.Fail returns. Initially, the new package has no attributes.
189 -- Id may be used to add attributes using procedure Register_New_Attribute
192 procedure Register_New_Attribute
194 In_Package : Package_Node_Id;
195 Attr_Kind : Defined_Attribute_Kind;
196 Var_Kind : Defined_Variable_Kind;
197 Index_Is_File_Name : Boolean := False;
198 Opt_Index : Boolean := False);
199 -- Add a new attribute to registered package In_Package. Fails if Name
200 -- (the attribute name) is empty, if In_Package is Empty_Package or if
201 -- the attribute name has a duplicate name. See definition of type
202 -- Attribute_Data above for the meaning of parameters Attr_Kind, Var_Kind,
203 -- Index_Is_File_Name and Opt_Index.
205 function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id;
206 -- Returns the package node id of the package with name Name. Returns
207 -- Empty_Package if there is no package with this name.
209 function First_Attribute_Of
210 (Pkg : Package_Node_Id) return Attribute_Node_Id;
211 -- Returns the first attribute in the list of attributes of package Pkg.
212 -- Returns Empty_Attribute if Pkg is Empty_Package.
219 Attributes_Initial : constant := 50;
220 Attributes_Increment : constant := 100;
222 Attribute_Node_Low_Bound : constant := 0;
223 Attribute_Node_High_Bound : constant := 099_999_999;
226 range Attribute_Node_Low_Bound .. Attribute_Node_High_Bound;
227 -- Index type for table Attrs in the body
229 type Attribute_Node_Id is record
230 Value : Attr_Node_Id := Attribute_Node_Low_Bound;
232 -- Full declaration of self-initialized private type
234 Empty_Attr : constant Attr_Node_Id := Attribute_Node_Low_Bound;
236 Empty_Attribute : constant Attribute_Node_Id := (Value => Empty_Attr);
238 First_Attribute : constant Attr_Node_Id := Attribute_Node_Low_Bound + 1;
240 First_Attribute_Node_Id : constant Attribute_Node_Id :=
241 (Value => First_Attribute);
243 Attribute_First : constant Attribute_Node_Id := First_Attribute_Node_Id;
249 Packages_Initial : constant := 10;
250 Packages_Increment : constant := 100;
252 Package_Node_Low_Bound : constant := 0;
253 Package_Node_High_Bound : constant := 099_999_999;
256 range Package_Node_Low_Bound .. Package_Node_High_Bound;
257 -- Index type for table Package_Attributes in the body
259 type Package_Node_Id is record
260 Value : Pkg_Node_Id := Package_Node_Low_Bound;
262 -- Full declaration of self-initialized private type
264 Empty_Pkg : constant Pkg_Node_Id := Package_Node_Low_Bound;
265 Empty_Package : constant Package_Node_Id := (Value => Empty_Pkg);
266 Unknown_Pkg : constant Pkg_Node_Id := Package_Node_High_Bound;
267 Unknown_Package : constant Package_Node_Id := (Value => Unknown_Pkg);
268 First_Package : constant Pkg_Node_Id := Package_Node_Low_Bound + 1;
270 First_Package_Node_Id : constant Package_Node_Id :=
271 (Value => First_Package);
273 Package_First : constant Package_Node_Id := First_Package_Node_Id;
279 type Attribute_Record is record
281 Var_Kind : Variable_Kind;
282 Optional_Index : Boolean;
283 Attr_Kind : Attribute_Kind;
287 -- Data for an attribute
290 new Table.Table (Table_Component_Type => Attribute_Record,
291 Table_Index_Type => Attr_Node_Id,
292 Table_Low_Bound => First_Attribute,
293 Table_Initial => Attributes_Initial,
294 Table_Increment => Attributes_Increment,
295 Table_Name => "Prj.Attr.Attrs");
296 -- The table of the attributes
302 type Package_Record is record
304 Known : Boolean := True;
305 First_Attribute : Attr_Node_Id;
307 -- Data for a package
309 package Package_Attributes is
310 new Table.Table (Table_Component_Type => Package_Record,
311 Table_Index_Type => Pkg_Node_Id,
312 Table_Low_Bound => First_Package,
313 Table_Initial => Packages_Initial,
314 Table_Increment => Packages_Increment,
315 Table_Name => "Prj.Attr.Packages");
316 -- The table of the packages