* testsuite/libgomp.fortran/vla7.f90: Add -w to options.
[official-gcc.git] / gcc / ada / prj-attr.ads
blobdf964044ea8b532ef15fb1c75a39b793c20d55b2
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . A T T R --
6 -- --
7 -- S p e c --
8 -- --
9 -- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
10 -- --
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. --
21 -- --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 -- --
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
32 with Table;
34 package Prj.Attr is
36 procedure Initialize;
37 -- Initialize the predefined project level attributes and the predefined
38 -- packages and their attribute. This procedure should be called by
39 -- Prj.Initialize.
41 type Attribute_Kind is
42 (Unknown,
43 Single,
44 Associative_Array,
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.
76 Opt_Index : Boolean;
77 -- True if there may be an optional index in the value of the index,
78 -- as in:
79 -- "file.ada" at 2
80 -- ("main.adb", "file.ada" at 1)
82 Var_Kind : Defined_Variable_Kind;
83 -- The attribute value kind: single or list
85 end record;
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
98 (Name : String;
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.
105 ----------------
106 -- Attributes --
107 ----------------
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
119 (Name : Name_Id;
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
124 -- be found.
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
139 -- Empty_Attribute.
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;
148 To : Variable_Kind);
149 -- Set the variable kind of a known attribute. Does nothing if Attribute is
150 -- Empty_Attribute.
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 Next_Attribute
157 (After : Attribute_Node_Id) return Attribute_Node_Id;
158 -- Returns the attribute that follow After in the list of project level
159 -- attributes or the list of attributes in a package.
160 -- Returns Empty_Attribute if After is either Empty_Attribute or is the
161 -- last of the list.
163 --------------
164 -- Packages --
165 --------------
167 type Package_Node_Id is private;
168 -- Type to refer to a package, self initialized
170 Empty_Package : constant Package_Node_Id;
171 -- Default value of Package_Node_Id objects
173 procedure Register_New_Package (Name : String; Id : out Package_Node_Id);
174 -- Add a new package. Fails if Name (the package name) is empty or is
175 -- already the name of a package, and set Id to Empty_Package,
176 -- if Prj.Com.Fail returns. Initially, the new package has no attributes.
177 -- Id may be used to add attributes using procedure Register_New_Attribute
178 -- below.
180 procedure Register_New_Attribute
181 (Name : String;
182 In_Package : Package_Node_Id;
183 Attr_Kind : Defined_Attribute_Kind;
184 Var_Kind : Defined_Variable_Kind;
185 Index_Is_File_Name : Boolean := False;
186 Opt_Index : Boolean := False);
187 -- Add a new attribute to registered package In_Package. Fails if Name
188 -- (the attribute name) is empty, if In_Package is Empty_Package or if
189 -- the attribute name has a duplicate name. See definition of type
190 -- Attribute_Data above for the meaning of parameters Attr_Kind, Var_Kind,
191 -- Index_Is_File_Name and Opt_Index.
193 function Package_Node_Id_Of (Name : Name_Id) return Package_Node_Id;
194 -- Returns the package node id of the package with name Name. Returns
195 -- Empty_Package if there is no package with this name.
197 function First_Attribute_Of
198 (Pkg : Package_Node_Id) return Attribute_Node_Id;
199 -- Returns the first attribute in the list of attributes of package Pkg.
200 -- Returns Empty_Attribute if Pkg is Empty_Package.
202 private
203 ----------------
204 -- Attributes --
205 ----------------
207 Attributes_Initial : constant := 50;
208 Attributes_Increment : constant := 50;
210 Attribute_Node_Low_Bound : constant := 0;
211 Attribute_Node_High_Bound : constant := 099_999_999;
213 type Attr_Node_Id is
214 range Attribute_Node_Low_Bound .. Attribute_Node_High_Bound;
215 -- Index type for table Attrs in the body
217 type Attribute_Node_Id is record
218 Value : Attr_Node_Id := Attribute_Node_Low_Bound;
219 end record;
220 -- Full declaration of self-initialized private type
222 Empty_Attr : constant Attr_Node_Id := Attribute_Node_Low_Bound;
224 Empty_Attribute : constant Attribute_Node_Id := (Value => Empty_Attr);
226 First_Attribute : constant Attr_Node_Id := Attribute_Node_Low_Bound + 1;
228 First_Attribute_Node_Id : constant Attribute_Node_Id :=
229 (Value => First_Attribute);
231 Attribute_First : constant Attribute_Node_Id := First_Attribute_Node_Id;
233 --------------
234 -- Packages --
235 --------------
237 Packages_Initial : constant := 10;
238 Packages_Increment : constant := 50;
240 Package_Node_Low_Bound : constant := 0;
241 Package_Node_High_Bound : constant := 099_999_999;
243 type Pkg_Node_Id is
244 range Package_Node_Low_Bound .. Package_Node_High_Bound;
245 -- Index type for table Package_Attributes in the body
247 type Package_Node_Id is record
248 Value : Pkg_Node_Id := Package_Node_Low_Bound;
249 end record;
250 -- Full declaration of self-initialized private type
252 Empty_Pkg : constant Pkg_Node_Id := Package_Node_Low_Bound;
254 Empty_Package : constant Package_Node_Id := (Value => Empty_Pkg);
256 First_Package : constant Pkg_Node_Id := Package_Node_Low_Bound + 1;
258 First_Package_Node_Id : constant Package_Node_Id :=
259 (Value => First_Package);
261 Package_First : constant Package_Node_Id := First_Package_Node_Id;
263 ----------------
264 -- Attributes --
265 ----------------
267 type Attribute_Record is record
268 Name : Name_Id;
269 Var_Kind : Variable_Kind;
270 Optional_Index : Boolean;
271 Attr_Kind : Attribute_Kind;
272 Next : Attr_Node_Id;
273 end record;
274 -- Data for an attribute
276 package Attrs is
277 new Table.Table (Table_Component_Type => Attribute_Record,
278 Table_Index_Type => Attr_Node_Id,
279 Table_Low_Bound => First_Attribute,
280 Table_Initial => Attributes_Initial,
281 Table_Increment => Attributes_Increment,
282 Table_Name => "Prj.Attr.Attrs");
283 -- The table of the attributes
285 --------------
286 -- Packages --
287 --------------
289 type Package_Record is record
290 Name : Name_Id;
291 Known : Boolean := True;
292 First_Attribute : Attr_Node_Id;
293 end record;
294 -- Data for a package
296 package Package_Attributes is
297 new Table.Table (Table_Component_Type => Package_Record,
298 Table_Index_Type => Pkg_Node_Id,
299 Table_Low_Bound => First_Package,
300 Table_Initial => Packages_Initial,
301 Table_Increment => Packages_Increment,
302 Table_Name => "Prj.Attr.Packages");
303 -- The table of the packages
305 end Prj.Attr;