]>
Commit | Line | Data |
---|---|---|
19235870 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- P R J . N M S C -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
1f6439e3 | 9 | -- Copyright (C) 2000-2011, Free Software Foundation, Inc. -- |
19235870 RK |
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- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
19235870 RK |
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 -- | |
b5c84c3c RD |
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. -- | |
19235870 RK |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
19235870 RK |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
fbf5a39b | 26 | with Err_Vars; use Err_Vars; |
2f41ec1a | 27 | with Opt; use Opt; |
07fc65c4 GB |
28 | with Osint; use Osint; |
29 | with Output; use Output; | |
dfa8a067 | 30 | with Prj.Com; |
a96ca600 | 31 | with Prj.Env; use Prj.Env; |
e2d9085b | 32 | with Prj.Err; use Prj.Err; |
c4d67e2d | 33 | with Prj.Tree; use Prj.Tree; |
07fc65c4 | 34 | with Prj.Util; use Prj.Util; |
fbf5a39b | 35 | with Sinput.P; |
07fc65c4 | 36 | with Snames; use Snames; |
bb4daba3 | 37 | with Targparm; use Targparm; |
07fc65c4 | 38 | |
67c86178 | 39 | with Ada; use Ada; |
b30668b7 | 40 | with Ada.Characters.Handling; use Ada.Characters.Handling; |
67c86178 | 41 | with Ada.Directories; use Ada.Directories; |
b30668b7 VC |
42 | with Ada.Strings; use Ada.Strings; |
43 | with Ada.Strings.Fixed; use Ada.Strings.Fixed; | |
19235870 | 44 | with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; |
07fc65c4 | 45 | |
3ce5ca75 RD |
46 | with GNAT.Case_Util; use GNAT.Case_Util; |
47 | with GNAT.Directory_Operations; use GNAT.Directory_Operations; | |
48 | with GNAT.Dynamic_HTables; | |
1aa23421 | 49 | with GNAT.Regexp; use GNAT.Regexp; |
3ce5ca75 RD |
50 | with GNAT.Table; |
51 | ||
19235870 RK |
52 | package body Prj.Nmsc is |
53 | ||
ede007da VC |
54 | No_Continuation_String : aliased String := ""; |
55 | Continuation_String : aliased String := "\"; | |
56 | -- Used in Check_Library for continuation error messages at the same | |
57 | -- location. | |
58 | ||
fbf5a39b | 59 | type Name_Location is record |
dc718e52 RD |
60 | Name : File_Name_Type; |
61 | -- Key is duplicated, so that it is known when using functions Get_First | |
62 | -- and Get_Next, as these functions only return an Element. | |
63 | ||
fbf5a39b | 64 | Location : Source_Ptr; |
ede007da | 65 | Source : Source_Id := No_Source; |
602a7ec0 | 66 | Listed : Boolean := False; |
fbf5a39b AC |
67 | Found : Boolean := False; |
68 | end record; | |
47edeeab | 69 | |
fbf5a39b | 70 | No_Name_Location : constant Name_Location := |
47edeeab AC |
71 | (Name => No_File, |
72 | Location => No_Location, | |
73 | Source => No_Source, | |
74 | Listed => False, | |
75 | Found => False); | |
76 | ||
fdd7e7bb | 77 | package Source_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable |
fbf5a39b AC |
78 | (Header_Num => Header_Num, |
79 | Element => Name_Location, | |
80 | No_Element => No_Name_Location, | |
751089b2 | 81 | Key => File_Name_Type, |
fbf5a39b AC |
82 | Hash => Hash, |
83 | Equal => "="); | |
47edeeab | 84 | -- File name information found in string list attribute (Source_Files or |
7a0ddd20 | 85 | -- Source_List_File). Used to check that all referenced files were indeed |
47edeeab | 86 | -- found on the disk. |
6c1f47ee EB |
87 | |
88 | type Unit_Exception is record | |
dc718e52 RD |
89 | Name : Name_Id; |
90 | -- Key is duplicated, so that it is known when using functions Get_First | |
91 | -- and Get_Next, as these functions only return an Element. | |
92 | ||
6c1f47ee EB |
93 | Spec : File_Name_Type; |
94 | Impl : File_Name_Type; | |
95 | end record; | |
32404665 | 96 | |
fdd7e7bb | 97 | No_Unit_Exception : constant Unit_Exception := (No_Name, No_File, No_File); |
32404665 | 98 | |
fdd7e7bb | 99 | package Unit_Exceptions_Htable is new GNAT.Dynamic_HTables.Simple_HTable |
6c1f47ee EB |
100 | (Header_Num => Header_Num, |
101 | Element => Unit_Exception, | |
102 | No_Element => No_Unit_Exception, | |
103 | Key => Name_Id, | |
104 | Hash => Hash, | |
105 | Equal => "="); | |
fdd7e7bb EB |
106 | -- Record special naming schemes for Ada units (name of spec file and name |
107 | -- of implementation file). The elements in this list come from the naming | |
108 | -- exceptions specified in the project files. | |
aa720a54 | 109 | |
fdd7e7bb | 110 | type File_Found is record |
1f6439e3 AC |
111 | File : File_Name_Type := No_File; |
112 | Excl_File : File_Name_Type := No_File; | |
113 | Excl_Line : Natural := 0; | |
114 | Found : Boolean := False; | |
115 | Location : Source_Ptr := No_Location; | |
7324bf49 | 116 | end record; |
32404665 | 117 | |
1f6439e3 AC |
118 | No_File_Found : constant File_Found := |
119 | (No_File, No_File, 0, False, No_Location); | |
32404665 | 120 | |
fdd7e7bb | 121 | package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable |
7324bf49 | 122 | (Header_Num => Header_Num, |
fdd7e7bb EB |
123 | Element => File_Found, |
124 | No_Element => No_File_Found, | |
751089b2 | 125 | Key => File_Name_Type, |
7324bf49 AC |
126 | Hash => Hash, |
127 | Equal => "="); | |
c37845f8 | 128 | -- A hash table to store the base names of excluded files, if any |
7324bf49 | 129 | |
fdd7e7bb | 130 | package Object_File_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable |
c7867d82 | 131 | (Header_Num => Header_Num, |
fc2c32e2 EB |
132 | Element => Source_Id, |
133 | No_Element => No_Source, | |
c7867d82 VC |
134 | Key => File_Name_Type, |
135 | Hash => Hash, | |
136 | Equal => "="); | |
137 | -- A hash table to store the object file names for a project, to check that | |
138 | -- two different sources have different object file names. | |
139 | ||
fdd7e7bb EB |
140 | type Project_Processing_Data is record |
141 | Project : Project_Id; | |
142 | Source_Names : Source_Names_Htable.Instance; | |
143 | Unit_Exceptions : Unit_Exceptions_Htable.Instance; | |
144 | Excluded : Excluded_Sources_Htable.Instance; | |
fdd7e7bb EB |
145 | |
146 | Source_List_File_Location : Source_Ptr; | |
147 | -- Location of the Source_List_File attribute, for error messages | |
6c1f47ee | 148 | end record; |
fdd7e7bb EB |
149 | -- This is similar to Tree_Processing_Data, but contains project-specific |
150 | -- information which is only useful while processing the project, and can | |
151 | -- be discarded as soon as we have finished processing the project | |
6c1f47ee | 152 | |
32404665 | 153 | type Tree_Processing_Data is record |
978ffe02 AC |
154 | Tree : Project_Tree_Ref; |
155 | Node_Tree : Prj.Tree.Project_Node_Tree_Ref; | |
156 | Flags : Prj.Processing_Flags; | |
32404665 EB |
157 | end record; |
158 | -- Temporary data which is needed while parsing a project. It does not need | |
159 | -- to be kept in memory once a project has been fully loaded, but is | |
160 | -- necessary while performing consistency checks (duplicate sources,...) | |
161 | -- This data must be initialized before processing any project, and the | |
162 | -- same data is used for processing all projects in the tree. | |
163 | ||
3a4ec5cc VC |
164 | type Lib_Data is record |
165 | Name : Name_Id; | |
166 | Proj : Project_Id; | |
167 | end record; | |
168 | ||
169 | package Lib_Data_Table is new GNAT.Table | |
170 | (Table_Component_Type => Lib_Data, | |
3b6d290a | 171 | Table_Index_Type => Natural, |
3a4ec5cc VC |
172 | Table_Low_Bound => 1, |
173 | Table_Initial => 10, | |
174 | Table_Increment => 100); | |
175 | -- A table to record library names in order to check that two library | |
176 | -- projects do not have the same library names. | |
177 | ||
32404665 | 178 | procedure Initialize |
a0a786e3 EB |
179 | (Data : out Tree_Processing_Data; |
180 | Tree : Project_Tree_Ref; | |
181 | Node_Tree : Prj.Tree.Project_Node_Tree_Ref; | |
182 | Flags : Prj.Processing_Flags); | |
32404665 EB |
183 | -- Initialize Data |
184 | ||
185 | procedure Free (Data : in out Tree_Processing_Data); | |
186 | -- Free the memory occupied by Data | |
187 | ||
188 | procedure Check | |
e917aec2 RD |
189 | (Project : Project_Id; |
190 | Data : in out Tree_Processing_Data); | |
c37845f8 | 191 | -- Process the naming scheme for a single project |
32404665 | 192 | |
fdd7e7bb EB |
193 | procedure Initialize |
194 | (Data : in out Project_Processing_Data; | |
195 | Project : Project_Id); | |
196 | procedure Free (Data : in out Project_Processing_Data); | |
197 | -- Initialize or free memory for a project-specific data | |
6c1f47ee EB |
198 | |
199 | procedure Find_Excluded_Sources | |
32404665 EB |
200 | (Project : in out Project_Processing_Data; |
201 | Data : in out Tree_Processing_Data); | |
6c1f47ee | 202 | -- Find the list of files that should not be considered as source files |
fdd7e7bb | 203 | -- for this project. Sets the list in the Project.Excluded_Sources_Htable. |
6c1f47ee | 204 | |
95cd3246 AC |
205 | procedure Override_Kind (Source : Source_Id; Kind : Source_Kind); |
206 | -- Override the reference kind for a source file. This properly updates | |
207 | -- the unit data if necessary. | |
208 | ||
aa903780 | 209 | procedure Load_Naming_Exceptions |
32404665 EB |
210 | (Project : in out Project_Processing_Data; |
211 | Data : in out Tree_Processing_Data); | |
aa903780 EB |
212 | -- All source files in Data.First_Source are considered as naming |
213 | -- exceptions, and copied into the Source_Names and Unit_Exceptions tables | |
214 | -- as appropriate. | |
215 | ||
c5be6c3a | 216 | type Search_Type is (Search_Files, Search_Directories); |
c5be6c3a EB |
217 | |
218 | generic | |
219 | with procedure Callback | |
86828d40 AC |
220 | (Path : Path_Information; |
221 | Pattern_Index : Natural); | |
c5be6c3a EB |
222 | procedure Expand_Subdirectory_Pattern |
223 | (Project : Project_Id; | |
224 | Data : in out Tree_Processing_Data; | |
225 | Patterns : String_List_Id; | |
e7efbe2f | 226 | Ignore : String_List_Id; |
c5be6c3a EB |
227 | Search_For : Search_Type; |
228 | Resolve_Links : Boolean); | |
229 | -- Search the subdirectories of Project's directory for files or | |
230 | -- directories that match the globbing patterns found in Patterns (for | |
231 | -- instance "**/*.adb"). Typically, Patterns will be the value of the | |
232 | -- Source_Dirs or Excluded_Source_Dirs attributes. | |
e917aec2 | 233 | -- |
c5be6c3a EB |
234 | -- Every time such a file or directory is found, the callback is called. |
235 | -- Resolve_Links indicates whether we should resolve links while | |
236 | -- normalizing names. | |
e917aec2 | 237 | -- |
c5be6c3a EB |
238 | -- In the callback, Pattern_Index is the index within Patterns where the |
239 | -- expanded pattern was found (1 for the first element of Patterns and | |
240 | -- all its matching directories, then 2,...). | |
e917aec2 | 241 | -- |
c5be6c3a | 242 | -- We use a generic and not an access-to-subprogram because in some cases |
c4d67e2d AC |
243 | -- this code is compiled with the restriction No_Implicit_Dynamic_Code. |
244 | -- An error message is raised if a pattern does not match any file. | |
c5be6c3a | 245 | |
ede007da | 246 | procedure Add_Source |
6c1f47ee | 247 | (Id : out Source_Id; |
fdd7e7bb | 248 | Data : in out Tree_Processing_Data; |
6c1f47ee | 249 | Project : Project_Id; |
75a64833 | 250 | Source_Dir_Rank : Natural; |
e0697153 | 251 | Lang_Id : Language_Ptr; |
6c1f47ee EB |
252 | Kind : Source_Kind; |
253 | File_Name : File_Name_Type; | |
254 | Display_File : File_Name_Type; | |
9f55bc62 AC |
255 | Naming_Exception : Naming_Exception_Type := No; |
256 | Path : Path_Information := No_Path_Information; | |
257 | Alternate_Languages : Language_List := null; | |
258 | Unit : Name_Id := No_Name; | |
259 | Index : Int := 0; | |
260 | Locally_Removed : Boolean := False; | |
261 | Location : Source_Ptr := No_Location); | |
ede007da VC |
262 | -- Add a new source to the different lists: list of all sources in the |
263 | -- project tree, list of source of a project and list of sources of a | |
e917aec2 RD |
264 | -- language. If Path is specified, the file is also added to |
265 | -- Source_Paths_HT. Location is used for error messages | |
ede007da | 266 | |
347ab254 EB |
267 | function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type; |
268 | -- Same as Osint.Canonical_Case_File_Name but applies to Name_Id. | |
e917aec2 | 269 | -- This alters Name_Buffer. |
347ab254 | 270 | |
ce30eccb | 271 | function Suffix_Matches |
d9c0e057 AC |
272 | (Filename : String; |
273 | Suffix : File_Name_Type) return Boolean; | |
349ff68f AC |
274 | -- True if the file name ends with the given suffix. Always returns False |
275 | -- if Suffix is No_Name. | |
ce30eccb EB |
276 | |
277 | procedure Replace_Into_Name_Buffer | |
d9c0e057 AC |
278 | (Str : String; |
279 | Pattern : String; | |
280 | Replacement : Character); | |
281 | -- Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is | |
282 | -- converted to lower-case at the same time. | |
ce30eccb | 283 | |
cf161d66 | 284 | procedure Check_Abstract_Project |
c37845f8 | 285 | (Project : Project_Id; |
602a7ec0 | 286 | Data : in out Tree_Processing_Data); |
cf161d66 | 287 | -- Check abstract projects attributes |
0da2c8ac | 288 | |
ede007da | 289 | procedure Check_Configuration |
fdd7e7bb EB |
290 | (Project : Project_Id; |
291 | Data : in out Tree_Processing_Data); | |
ede007da VC |
292 | -- Check the configuration attributes for the project |
293 | ||
44e1918a AC |
294 | procedure Check_If_Externally_Built |
295 | (Project : Project_Id; | |
fdd7e7bb | 296 | Data : in out Tree_Processing_Data); |
7e98a4c6 | 297 | -- Check attribute Externally_Built of project Project in project tree |
fdd7e7bb | 298 | -- Data.Tree and modify its data Data if it has the value "true". |
44e1918a | 299 | |
4f469be3 VC |
300 | procedure Check_Interfaces |
301 | (Project : Project_Id; | |
fdd7e7bb | 302 | Data : in out Tree_Processing_Data); |
4f469be3 VC |
303 | -- If a list of sources is specified in attribute Interfaces, set |
304 | -- In_Interfaces only for the sources specified in the list. | |
305 | ||
44e1918a | 306 | procedure Check_Library_Attributes |
fdd7e7bb EB |
307 | (Project : Project_Id; |
308 | Data : in out Tree_Processing_Data); | |
309 | -- Check the library attributes of project Project in project tree | |
7e98a4c6 | 310 | -- and modify its data Data accordingly. |
44e1918a | 311 | |
cf161d66 | 312 | procedure Check_Package_Naming |
9d9f5f49 AC |
313 | (Project : Project_Id; |
314 | Data : in out Tree_Processing_Data); | |
cf161d66 AC |
315 | -- Check the naming scheme part of Data, and initialize the naming scheme |
316 | -- data in the config of the various languages. | |
9d9f5f49 | 317 | |
7e98a4c6 | 318 | procedure Check_Programming_Languages |
fdd7e7bb EB |
319 | (Project : Project_Id; |
320 | Data : in out Tree_Processing_Data); | |
7e98a4c6 | 321 | -- Check attribute Languages for the project with data Data in project |
fdd7e7bb | 322 | -- tree Data.Tree and set the components of Data for all the programming |
7e98a4c6 | 323 | -- languages indicated in attribute Languages, if any. |
7324bf49 | 324 | |
44e1918a | 325 | procedure Check_Stand_Alone_Library |
c37845f8 AC |
326 | (Project : Project_Id; |
327 | Data : in out Tree_Processing_Data); | |
fdd7e7bb | 328 | -- Check if project Project in project tree Data.Tree is a Stand-Alone |
7e98a4c6 | 329 | -- Library project, and modify its data Data accordingly if it is one. |
6c1f47ee | 330 | |
cf161d66 AC |
331 | procedure Check_Unit_Name (Name : String; Unit : out Name_Id); |
332 | -- Check that a name is a valid unit name | |
333 | ||
7324bf49 AC |
334 | function Compute_Directory_Last (Dir : String) return Natural; |
335 | -- Return the index of the last significant character in Dir. This is used | |
f53f9dd7 | 336 | -- to avoid duplicate '/' (slash) characters at the end of directory names. |
7324bf49 | 337 | |
6c1f47ee | 338 | procedure Search_Directories |
fdd7e7bb EB |
339 | (Project : in out Project_Processing_Data; |
340 | Data : in out Tree_Processing_Data; | |
341 | For_All_Sources : Boolean); | |
e1f3cb58 AC |
342 | -- Search the source directories to find the sources. If For_All_Sources is |
343 | -- True, check each regular file name against the naming schemes of the | |
442c0581 RD |
344 | -- various languages. Otherwise consider only the file names in hash table |
345 | -- Source_Names. If Allow_Duplicate_Basenames then files with identical | |
346 | -- base names are permitted within a project for source-based languages | |
347 | -- (never for unit based languages). | |
6c1f47ee EB |
348 | |
349 | procedure Check_File | |
fdd7e7bb EB |
350 | (Project : in out Project_Processing_Data; |
351 | Data : in out Tree_Processing_Data; | |
75a64833 | 352 | Source_Dir_Rank : Natural; |
fdd7e7bb | 353 | Path : Path_Name_Type; |
fcfb981b | 354 | Display_Path : Path_Name_Type; |
fdd7e7bb EB |
355 | File_Name : File_Name_Type; |
356 | Display_File_Name : File_Name_Type; | |
357 | Locally_Removed : Boolean; | |
358 | For_All_Sources : Boolean); | |
6c1f47ee | 359 | -- Check if file File_Name is a valid source of the project. This is used |
e1f3cb58 AC |
360 | -- in multi-language mode only. When the file matches one of the naming |
361 | -- schemes, it is added to various htables through Add_Source and to | |
362 | -- Source_Paths_Htable. | |
6c1f47ee | 363 | -- |
fcfb981b AC |
364 | -- File_Name is the same as Display_File_Name, but has been normalized. |
365 | -- They do not include the directory information. | |
6c1f47ee | 366 | -- |
fcfb981b AC |
367 | -- Path and Display_Path on the other hand are the full path to the file. |
368 | -- Path must have been normalized (canonical casing and possibly links | |
369 | -- resolved). | |
6c1f47ee | 370 | -- |
442c0581 RD |
371 | -- Source_Directory is the directory in which the file was found. It is |
372 | -- neither normalized nor has had links resolved, and must not end with a | |
373 | -- a directory separator, to avoid duplicates later on. | |
6c1f47ee EB |
374 | -- |
375 | -- If For_All_Sources is True, then all possible file names are analyzed | |
442c0581 | 376 | -- otherwise only those currently set in the Source_Names hash table. |
6c1f47ee | 377 | |
ce30eccb | 378 | procedure Check_File_Naming_Schemes |
6c1f47ee | 379 | (In_Tree : Project_Tree_Ref; |
fdd7e7bb | 380 | Project : Project_Processing_Data; |
6c1f47ee | 381 | File_Name : File_Name_Type; |
e1c9f239 | 382 | Alternate_Languages : out Language_List; |
e0697153 | 383 | Language : out Language_Ptr; |
6c1f47ee EB |
384 | Display_Language_Name : out Name_Id; |
385 | Unit : out Name_Id; | |
386 | Lang_Kind : out Language_Kind; | |
387 | Kind : out Source_Kind); | |
f6cf5b85 AC |
388 | -- Check if the file name File_Name conforms to one of the naming schemes |
389 | -- of the project. If the file does not match one of the naming schemes, | |
390 | -- set Language to No_Language_Index. Filename is the name of the file | |
391 | -- being investigated. It has been normalized (case-folded). File_Name is | |
392 | -- the same value. | |
6c1f47ee | 393 | |
44e1918a | 394 | procedure Get_Directories |
86828d40 AC |
395 | (Project : Project_Id; |
396 | Data : in out Tree_Processing_Data); | |
44e1918a | 397 | -- Get the object directory, the exec directory and the source directories |
32404665 | 398 | -- of a project. |
44e1918a | 399 | |
7e98a4c6 VC |
400 | procedure Get_Mains |
401 | (Project : Project_Id; | |
fdd7e7bb | 402 | Data : in out Tree_Processing_Data); |
7324bf49 AC |
403 | -- Get the mains of a project from attribute Main, if it exists, and put |
404 | -- them in the project data. | |
405 | ||
406 | procedure Get_Sources_From_File | |
32404665 EB |
407 | (Path : String; |
408 | Location : Source_Ptr; | |
409 | Project : in out Project_Processing_Data; | |
410 | Data : in out Tree_Processing_Data); | |
7324bf49 AC |
411 | -- Get the list of sources from a text file and put them in hash table |
412 | -- Source_Names. | |
413 | ||
a7a3cf5c | 414 | procedure Find_Sources |
32404665 EB |
415 | (Project : in out Project_Processing_Data; |
416 | Data : in out Tree_Processing_Data); | |
f6cf5b85 AC |
417 | -- Process the Source_Files and Source_List_File attributes, and store the |
418 | -- list of source files into the Source_Names htable. When these attributes | |
419 | -- are not defined, find all files matching the naming schemes in the | |
420 | -- source directories. If Allow_Duplicate_Basenames, then files with the | |
421 | -- same base names are authorized within a project for source-based | |
422 | -- languages (never for unit based languages) | |
6c1f47ee | 423 | |
ce30eccb | 424 | procedure Compute_Unit_Name |
84157c9a RD |
425 | (File_Name : File_Name_Type; |
426 | Naming : Lang_Naming_Data; | |
427 | Kind : out Source_Kind; | |
428 | Unit : out Name_Id; | |
fdd7e7bb | 429 | Project : Project_Processing_Data; |
84157c9a | 430 | In_Tree : Project_Tree_Ref); |
ce30eccb EB |
431 | -- Check whether the file matches the naming scheme. If it does, |
432 | -- compute its unit name. If Unit is set to No_Name on exit, none of the | |
433 | -- other out parameters are relevant. | |
434 | ||
fc2c32e2 EB |
435 | procedure Check_Illegal_Suffix |
436 | (Project : Project_Id; | |
fc2c32e2 EB |
437 | Suffix : File_Name_Type; |
438 | Dot_Replacement : File_Name_Type; | |
439 | Attribute_Name : String; | |
fdd7e7bb EB |
440 | Location : Source_Ptr; |
441 | Data : in out Tree_Processing_Data); | |
fc2c32e2 EB |
442 | -- Display an error message if the given suffix is illegal for some reason. |
443 | -- The name of the attribute we are testing is specified in Attribute_Name, | |
444 | -- which is used in the error message. Location is the location where the | |
445 | -- suffix is defined. | |
19235870 | 446 | |
fbf5a39b | 447 | procedure Locate_Directory |
a9872a59 | 448 | (Project : Project_Id; |
a9872a59 | 449 | Name : File_Name_Type; |
3249690d AC |
450 | Path : out Path_Information; |
451 | Dir_Exists : out Boolean; | |
fdd7e7bb | 452 | Data : in out Tree_Processing_Data; |
a9872a59 | 453 | Create : String := ""; |
a9872a59 | 454 | Location : Source_Ptr := No_Location; |
3249690d | 455 | Must_Exist : Boolean := True; |
a9872a59 | 456 | Externally_Built : Boolean := False); |
f6cf5b85 AC |
457 | -- Locate a directory. Name is the directory name. Relative paths are |
458 | -- resolved relative to the project's directory. If the directory does not | |
459 | -- exist and Setup_Projects is True and Create is a non null string, an | |
460 | -- attempt is made to create the directory. If the directory does not | |
461 | -- exist, it is either created if Setup_Projects is False (and then | |
462 | -- returned), or simply returned without checking for its existence (if | |
463 | -- Must_Exist is False) or No_Path_Information is returned. In all cases, | |
464 | -- Dir_Exists indicates whether the directory now exists. Create is also | |
32404665 | 465 | -- used for debugging traces to show which path we are computing. |
19235870 | 466 | |
44e1918a | 467 | procedure Look_For_Sources |
fdd7e7bb EB |
468 | (Project : in out Project_Processing_Data; |
469 | Data : in out Tree_Processing_Data); | |
470 | -- Find all the sources of project Project in project tree Data.Tree and | |
9d9f5f49 AC |
471 | -- update its Data accordingly. This assumes that the special naming |
472 | -- exceptions have already been processed. | |
44e1918a | 473 | |
19235870 | 474 | function Path_Name_Of |
751089b2 VC |
475 | (File_Name : File_Name_Type; |
476 | Directory : Path_Name_Type) return String; | |
4f469be3 VC |
477 | -- Returns the path name of a (non project) file. Returns an empty string |
478 | -- if file cannot be found. | |
19235870 | 479 | |
ede007da | 480 | procedure Remove_Source |
72e9f2b9 AC |
481 | (Tree : Project_Tree_Ref; |
482 | Id : Source_Id; | |
5d07d0cf | 483 | Replaced_By : Source_Id); |
32404665 EB |
484 | -- Remove a file from the list of sources of a project. This might be |
485 | -- because the file is replaced by another one in an extending project, | |
486 | -- or because a file was added as a naming exception but was not found | |
487 | -- in the end. | |
ede007da VC |
488 | |
489 | procedure Report_No_Sources | |
4f469be3 VC |
490 | (Project : Project_Id; |
491 | Lang_Name : String; | |
fdd7e7bb | 492 | Data : Tree_Processing_Data; |
4f469be3 VC |
493 | Location : Source_Ptr; |
494 | Continuation : Boolean := False); | |
97b7ca6f | 495 | -- Report an error or a warning depending on the value of When_No_Sources |
ede007da | 496 | -- when there are no sources for language Lang_Name. |
97b7ca6f | 497 | |
7e98a4c6 | 498 | procedure Show_Source_Dirs |
40ecf2f5 EB |
499 | (Project : Project_Id; |
500 | Shared : Shared_Project_Tree_Data_Access); | |
44e1918a | 501 | -- List all the source directories of a project |
fbf5a39b | 502 | |
347ab254 EB |
503 | procedure Write_Attr (Name, Value : String); |
504 | -- Debug print a value for a specific property. Does nothing when not in | |
505 | -- debug mode | |
506 | ||
e771c085 AC |
507 | procedure Error_Or_Warning |
508 | (Flags : Processing_Flags; | |
509 | Kind : Error_Warning; | |
510 | Msg : String; | |
511 | Location : Source_Ptr; | |
512 | Project : Project_Id); | |
513 | -- Emits either an error or warning message (or nothing), depending on Kind | |
514 | ||
1f6439e3 AC |
515 | function No_Space_Img (N : Natural) return String; |
516 | -- Image of a Natural without the initial space | |
517 | ||
e771c085 AC |
518 | ---------------------- |
519 | -- Error_Or_Warning -- | |
520 | ---------------------- | |
521 | ||
522 | procedure Error_Or_Warning | |
523 | (Flags : Processing_Flags; | |
524 | Kind : Error_Warning; | |
525 | Msg : String; | |
526 | Location : Source_Ptr; | |
527 | Project : Project_Id) is | |
528 | begin | |
529 | case Kind is | |
530 | when Error => Error_Msg (Flags, Msg, Location, Project); | |
531 | when Warning => Error_Msg (Flags, "?" & Msg, Location, Project); | |
532 | when Silent => null; | |
533 | end case; | |
534 | end Error_Or_Warning; | |
535 | ||
ce30eccb EB |
536 | ------------------------------ |
537 | -- Replace_Into_Name_Buffer -- | |
538 | ------------------------------ | |
539 | ||
540 | procedure Replace_Into_Name_Buffer | |
d9c0e057 AC |
541 | (Str : String; |
542 | Pattern : String; | |
543 | Replacement : Character) | |
ce30eccb EB |
544 | is |
545 | Max : constant Integer := Str'Last - Pattern'Length + 1; | |
d9c0e057 AC |
546 | J : Positive; |
547 | ||
ce30eccb EB |
548 | begin |
549 | Name_Len := 0; | |
550 | ||
d9c0e057 | 551 | J := Str'First; |
ce30eccb EB |
552 | while J <= Str'Last loop |
553 | Name_Len := Name_Len + 1; | |
554 | ||
555 | if J <= Max | |
556 | and then Str (J .. J + Pattern'Length - 1) = Pattern | |
557 | then | |
558 | Name_Buffer (Name_Len) := Replacement; | |
559 | J := J + Pattern'Length; | |
560 | ||
561 | else | |
562 | Name_Buffer (Name_Len) := GNAT.Case_Util.To_Lower (Str (J)); | |
563 | J := J + 1; | |
564 | end if; | |
565 | end loop; | |
566 | end Replace_Into_Name_Buffer; | |
567 | ||
568 | -------------------- | |
569 | -- Suffix_Matches -- | |
570 | -------------------- | |
571 | ||
572 | function Suffix_Matches | |
d9c0e057 AC |
573 | (Filename : String; |
574 | Suffix : File_Name_Type) return Boolean | |
575 | is | |
2b426674 | 576 | Min_Prefix_Length : Natural := 0; |
f6cf5b85 | 577 | |
ce30eccb | 578 | begin |
f91c36dc | 579 | if Suffix = No_File or else Suffix = Empty_File then |
ce30eccb EB |
580 | return False; |
581 | end if; | |
582 | ||
583 | declare | |
c37845f8 | 584 | Suf : String := Get_Name_String (Suffix); |
2b426674 | 585 | |
f6cf5b85 | 586 | begin |
c37845f8 | 587 | -- On non case-sensitive systems, use proper suffix casing |
ce14c577 | 588 | |
c37845f8 AC |
589 | Canonical_Case_File_Name (Suf); |
590 | ||
2b426674 EB |
591 | -- The file name must end with the suffix (which is not an extension) |
592 | -- For instance a suffix "configure.in" must match a file with the | |
593 | -- same name. To avoid dummy cases, though, a suffix starting with | |
594 | -- '.' requires a file that is at least one character longer ('.cpp' | |
f5fc5b9d | 595 | -- should not match a file with the same name). |
2b426674 EB |
596 | |
597 | if Suf (Suf'First) = '.' then | |
598 | Min_Prefix_Length := 1; | |
599 | end if; | |
600 | ||
601 | return Filename'Length >= Suf'Length + Min_Prefix_Length | |
2598ee6d RD |
602 | and then |
603 | Filename (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf; | |
ce30eccb EB |
604 | end; |
605 | end Suffix_Matches; | |
606 | ||
347ab254 EB |
607 | ---------------- |
608 | -- Write_Attr -- | |
609 | ---------------- | |
610 | ||
611 | procedure Write_Attr (Name, Value : String) is | |
612 | begin | |
613 | if Current_Verbosity = High then | |
3e582869 | 614 | Debug_Output (Name & " = """ & Value & '"'); |
347ab254 EB |
615 | end if; |
616 | end Write_Attr; | |
617 | ||
ede007da VC |
618 | ---------------- |
619 | -- Add_Source -- | |
620 | ---------------- | |
621 | ||
622 | procedure Add_Source | |
6c1f47ee | 623 | (Id : out Source_Id; |
fdd7e7bb | 624 | Data : in out Tree_Processing_Data; |
6c1f47ee | 625 | Project : Project_Id; |
75a64833 | 626 | Source_Dir_Rank : Natural; |
e0697153 | 627 | Lang_Id : Language_Ptr; |
6c1f47ee EB |
628 | Kind : Source_Kind; |
629 | File_Name : File_Name_Type; | |
630 | Display_File : File_Name_Type; | |
9f55bc62 AC |
631 | Naming_Exception : Naming_Exception_Type := No; |
632 | Path : Path_Information := No_Path_Information; | |
633 | Alternate_Languages : Language_List := null; | |
634 | Unit : Name_Id := No_Name; | |
635 | Index : Int := 0; | |
636 | Locally_Removed : Boolean := False; | |
637 | Location : Source_Ptr := No_Location) | |
ede007da | 638 | is |
86828d40 AC |
639 | Config : constant Language_Config := Lang_Id.Config; |
640 | UData : Unit_Index; | |
641 | Add_Src : Boolean; | |
642 | Source : Source_Id; | |
643 | Prev_Unit : Unit_Index := No_Unit_Index; | |
fc2c32e2 | 644 | Source_To_Replace : Source_Id := No_Source; |
ede007da VC |
645 | |
646 | begin | |
fc2c32e2 EB |
647 | -- Check if the same file name or unit is used in the prj tree |
648 | ||
649 | Add_Src := True; | |
fc2c32e2 EB |
650 | |
651 | if Unit /= No_Name then | |
fdd7e7bb | 652 | Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit); |
fc2c32e2 EB |
653 | end if; |
654 | ||
655 | if Prev_Unit /= No_Unit_Index | |
d1ced162 | 656 | and then (Kind = Impl or else Kind = Spec) |
fc2c32e2 EB |
657 | and then Prev_Unit.File_Names (Kind) /= null |
658 | then | |
659 | -- Suspicious, we need to check later whether this is authorized | |
32404665 | 660 | |
fc2c32e2 EB |
661 | Add_Src := False; |
662 | Source := Prev_Unit.File_Names (Kind); | |
663 | ||
72a3d7c7 | 664 | else |
686d0984 AC |
665 | Source := Source_Files_Htable.Get |
666 | (Data.Tree.Source_Files_HT, File_Name); | |
72a3d7c7 | 667 | |
86828d40 | 668 | if Source /= No_Source and then Source.Index = Index then |
fc2c32e2 EB |
669 | Add_Src := False; |
670 | end if; | |
671 | end if; | |
672 | ||
32404665 | 673 | -- Duplication of file/unit in same project is allowed if order of |
97ed5872 AC |
674 | -- source directories is known, or if there is no compiler for the |
675 | -- language. | |
fc2c32e2 EB |
676 | |
677 | if Add_Src = False then | |
678 | Add_Src := True; | |
679 | ||
680 | if Project = Source.Project then | |
681 | if Prev_Unit = No_Unit_Index then | |
32404665 | 682 | if Data.Flags.Allow_Duplicate_Basenames then |
fc2c32e2 | 683 | Add_Src := True; |
32404665 | 684 | |
97ed5872 AC |
685 | elsif Lang_Id.Config.Compiler_Driver = Empty_File then |
686 | Add_Src := True; | |
687 | ||
75a64833 | 688 | elsif Source_Dir_Rank /= Source.Source_Dir_Rank then |
fc2c32e2 | 689 | Add_Src := False; |
32404665 | 690 | |
fc2c32e2 EB |
691 | else |
692 | Error_Msg_File_1 := File_Name; | |
693 | Error_Msg | |
e2d9085b EB |
694 | (Data.Flags, "duplicate source file name {", |
695 | Location, Project); | |
fc2c32e2 EB |
696 | Add_Src := False; |
697 | end if; | |
698 | ||
699 | else | |
75a64833 | 700 | if Source_Dir_Rank /= Source.Source_Dir_Rank then |
fc2c32e2 EB |
701 | Add_Src := False; |
702 | ||
703 | -- We might be seeing the same file through a different path | |
32404665 | 704 | -- (for instance because of symbolic links). |
fc2c32e2 EB |
705 | |
706 | elsif Source.Path.Name /= Path.Name then | |
8779dffa AC |
707 | if not Source.Duplicate_Unit then |
708 | Error_Msg_Name_1 := Unit; | |
709 | Error_Msg | |
710 | (Data.Flags, "\duplicate unit %%", Location, Project); | |
711 | Source.Duplicate_Unit := True; | |
712 | end if; | |
713 | ||
fc2c32e2 EB |
714 | Add_Src := False; |
715 | end if; | |
716 | end if; | |
717 | ||
7b00e31d AC |
718 | -- Do not allow the same unit name in different projects, except |
719 | -- if one is extending the other. | |
fc2c32e2 | 720 | |
7b00e31d AC |
721 | -- For a file based language, the same file name replaces a file |
722 | -- in a project being extended, but it is allowed to have the same | |
723 | -- file name in unrelated projects. | |
fc2c32e2 EB |
724 | |
725 | elsif Is_Extending (Project, Source.Project) then | |
9f55bc62 | 726 | if not Locally_Removed and then Naming_Exception /= Inherited then |
e2d9085b EB |
727 | Source_To_Replace := Source; |
728 | end if; | |
fc2c32e2 EB |
729 | |
730 | elsif Prev_Unit /= No_Unit_Index | |
199c6a10 | 731 | and then Prev_Unit.File_Names (Kind) /= null |
fc2c32e2 EB |
732 | and then not Source.Locally_Removed |
733 | then | |
72a3d7c7 AC |
734 | -- Path is set if this is a source we found on the disk, in which |
735 | -- case we can provide more explicit error message. Path is unset | |
736 | -- when the source is added from one of the naming exceptions in | |
32404665 | 737 | -- the project. |
72a3d7c7 | 738 | |
fc2c32e2 EB |
739 | if Path /= No_Path_Information then |
740 | Error_Msg_Name_1 := Unit; | |
741 | Error_Msg | |
e2d9085b | 742 | (Data.Flags, |
fc2c32e2 | 743 | "unit %% cannot belong to several projects", |
e2d9085b | 744 | Location, Project); |
fc2c32e2 EB |
745 | |
746 | Error_Msg_Name_1 := Project.Name; | |
96867674 | 747 | Error_Msg_Name_2 := Name_Id (Path.Display_Name); |
fc2c32e2 | 748 | Error_Msg |
e2d9085b | 749 | (Data.Flags, "\ project %%, %%", Location, Project); |
fc2c32e2 EB |
750 | |
751 | Error_Msg_Name_1 := Source.Project.Name; | |
752 | Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name); | |
753 | Error_Msg | |
e2d9085b | 754 | (Data.Flags, "\ project %%, %%", Location, Project); |
fc2c32e2 EB |
755 | |
756 | else | |
757 | Error_Msg_Name_1 := Unit; | |
758 | Error_Msg_Name_2 := Source.Project.Name; | |
759 | Error_Msg | |
e2d9085b EB |
760 | (Data.Flags, "unit %% already belongs to project %%", |
761 | Location, Project); | |
fc2c32e2 EB |
762 | end if; |
763 | ||
764 | Add_Src := False; | |
765 | ||
766 | elsif not Source.Locally_Removed | |
32404665 | 767 | and then not Data.Flags.Allow_Duplicate_Basenames |
fc2c32e2 | 768 | and then Lang_Id.Config.Kind = Unit_Based |
be257e99 | 769 | and then Source.Language.Config.Kind = Unit_Based |
fc2c32e2 EB |
770 | then |
771 | Error_Msg_File_1 := File_Name; | |
772 | Error_Msg_File_2 := File_Name_Type (Source.Project.Name); | |
773 | Error_Msg | |
e2d9085b EB |
774 | (Data.Flags, |
775 | "{ is already a source of project {", Location, Project); | |
fc2c32e2 EB |
776 | |
777 | -- Add the file anyway, to avoid further warnings like "language | |
32404665 EB |
778 | -- unknown". |
779 | ||
fc2c32e2 EB |
780 | Add_Src := True; |
781 | end if; | |
782 | end if; | |
783 | ||
784 | if not Add_Src then | |
785 | return; | |
786 | end if; | |
787 | ||
788 | -- Add the new file | |
789 | ||
5d07d0cf | 790 | Id := new Source_Data; |
6c1f47ee EB |
791 | |
792 | if Current_Verbosity = High then | |
3e582869 | 793 | Debug_Indent; |
2598ee6d | 794 | Write_Str ("adding source File: "); |
aaf31e16 | 795 | Write_Str (Get_Name_String (Display_File)); |
6c1f47ee | 796 | |
fc2c32e2 EB |
797 | if Index /= 0 then |
798 | Write_Str (" at" & Index'Img); | |
799 | end if; | |
800 | ||
5a66a766 | 801 | if Lang_Id.Config.Kind = Unit_Based then |
5eed512d | 802 | Write_Str (" Unit: "); |
f6cf5b85 | 803 | |
5eed512d | 804 | -- ??? in gprclean, it seems we sometimes pass an empty Unit name |
f6cf5b85 AC |
805 | -- (see test extended_projects). |
806 | ||
5eed512d EB |
807 | if Unit /= No_Name then |
808 | Write_Str (Get_Name_String (Unit)); | |
809 | end if; | |
f6cf5b85 | 810 | |
5eed512d EB |
811 | Write_Str (" Kind: "); |
812 | Write_Str (Source_Kind'Image (Kind)); | |
6c1f47ee EB |
813 | end if; |
814 | ||
68c3f02a | 815 | Write_Eol; |
6c1f47ee EB |
816 | end if; |
817 | ||
5d07d0cf | 818 | Id.Project := Project; |
602a7ec0 | 819 | Id.Location := Location; |
75a64833 | 820 | Id.Source_Dir_Rank := Source_Dir_Rank; |
5d07d0cf | 821 | Id.Language := Lang_Id; |
5d07d0cf EB |
822 | Id.Kind := Kind; |
823 | Id.Alternate_Languages := Alternate_Languages; | |
e2d9085b | 824 | Id.Locally_Removed := Locally_Removed; |
e7f10ba9 EB |
825 | Id.Index := Index; |
826 | Id.File := File_Name; | |
827 | Id.Display_File := Display_File; | |
828 | Id.Dep_Name := Dependency_Name | |
b125fe15 | 829 | (File_Name, Lang_Id.Config.Dependency_Kind); |
e7f10ba9 | 830 | Id.Naming_Exception := Naming_Exception; |
ee81cbe9 AC |
831 | Id.Object := Object_Name |
832 | (File_Name, Config.Object_File_Suffix); | |
833 | Id.Switches := Switches_Name (File_Name); | |
4f469be3 | 834 | |
5a66a766 EB |
835 | -- Add the source id to the Unit_Sources_HT hash table, if the unit name |
836 | -- is not null. | |
837 | ||
838 | if Unit /= No_Name then | |
b125fe15 | 839 | |
e7f10ba9 EB |
840 | -- Note: we might be creating a dummy unit here, when we in fact have |
841 | -- a separate. For instance, file file-bar.adb will initially be | |
842 | -- assumed to be the IMPL of unit "file.bar". Only later on (in | |
843 | -- Check_Object_Files) will we parse those units that only have an | |
844 | -- impl and no spec to make sure whether we have a Separate in fact | |
845 | -- (that significantly reduces the number of times we need to parse | |
846 | -- the files, since we are then only interested in those with no | |
847 | -- spec). We still need those dummy units in the table, since that's | |
848 | -- the name we find in the ALI file | |
849 | ||
fdd7e7bb | 850 | UData := Units_Htable.Get (Data.Tree.Units_HT, Unit); |
95cd3246 | 851 | |
5a66a766 | 852 | if UData = No_Unit_Index then |
f6cf5b85 | 853 | UData := new Unit_Data; |
5a66a766 | 854 | UData.Name := Unit; |
9f55bc62 AC |
855 | |
856 | if Naming_Exception /= Inherited then | |
857 | Units_Htable.Set (Data.Tree.Units_HT, Unit, UData); | |
858 | end if; | |
5a66a766 EB |
859 | end if; |
860 | ||
95cd3246 AC |
861 | Id.Unit := UData; |
862 | ||
863 | -- Note that this updates Unit information as well | |
864 | ||
9f55bc62 AC |
865 | if Naming_Exception /= Inherited then |
866 | Override_Kind (Id, Kind); | |
867 | end if; | |
5a66a766 EB |
868 | end if; |
869 | ||
aca53298 AC |
870 | if Path /= No_Path_Information then |
871 | Id.Path := Path; | |
fdd7e7bb | 872 | Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id); |
6c1f47ee EB |
873 | end if; |
874 | ||
f166413a AC |
875 | Id.Next_With_File_Name := |
876 | Source_Files_Htable.Get (Data.Tree.Source_Files_HT, File_Name); | |
877 | Source_Files_Htable.Set (Data.Tree.Source_Files_HT, File_Name, Id); | |
878 | ||
43ccd04b AC |
879 | if Index /= 0 then |
880 | Project.Has_Multi_Unit_Sources := True; | |
881 | end if; | |
882 | ||
ede007da VC |
883 | -- Add the source to the language list |
884 | ||
5d07d0cf | 885 | Id.Next_In_Lang := Lang_Id.First_Source; |
e0697153 | 886 | Lang_Id.First_Source := Id; |
6c1f47ee | 887 | |
6c1f47ee | 888 | if Source_To_Replace /= No_Source then |
72e9f2b9 AC |
889 | Remove_Source (Data.Tree, Source_To_Replace, Id); |
890 | end if; | |
891 | ||
86828d40 AC |
892 | if Data.Tree.Replaced_Source_Number > 0 |
893 | and then | |
894 | Replaced_Source_HTable.Get | |
895 | (Data.Tree.Replaced_Sources, Id.File) /= No_File | |
72e9f2b9 AC |
896 | then |
897 | Replaced_Source_HTable.Remove (Data.Tree.Replaced_Sources, Id.File); | |
898 | Data.Tree.Replaced_Source_Number := | |
899 | Data.Tree.Replaced_Source_Number - 1; | |
6c1f47ee | 900 | end if; |
ede007da VC |
901 | end Add_Source; |
902 | ||
347ab254 EB |
903 | ------------------------------ |
904 | -- Canonical_Case_File_Name -- | |
905 | ------------------------------ | |
906 | ||
907 | function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type is | |
908 | begin | |
909 | if Osint.File_Names_Case_Sensitive then | |
910 | return File_Name_Type (Name); | |
911 | else | |
912 | Get_Name_String (Name); | |
913 | Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); | |
914 | return Name_Find; | |
915 | end if; | |
916 | end Canonical_Case_File_Name; | |
917 | ||
c4d67e2d AC |
918 | --------------------------------- |
919 | -- Process_Aggregated_Projects -- | |
920 | --------------------------------- | |
9d9f5f49 | 921 | |
c4d67e2d | 922 | procedure Process_Aggregated_Projects |
e917aec2 RD |
923 | (Tree : Project_Tree_Ref; |
924 | Project : Project_Id; | |
925 | Node_Tree : Prj.Tree.Project_Node_Tree_Ref; | |
926 | Flags : Processing_Flags) | |
9d9f5f49 | 927 | is |
c4d67e2d | 928 | Data : Tree_Processing_Data := |
2c1b72d7 AC |
929 | (Tree => Tree, |
930 | Node_Tree => Node_Tree, | |
931 | Flags => Flags); | |
c4d67e2d | 932 | |
9d9f5f49 AC |
933 | Project_Files : constant Prj.Variable_Value := |
934 | Prj.Util.Value_Of | |
935 | (Snames.Name_Project_Files, | |
936 | Project.Decl.Attributes, | |
40ecf2f5 | 937 | Tree.Shared); |
76e3504f | 938 | |
a96ca600 EB |
939 | Project_Path_For_Aggregate : Prj.Env.Project_Search_Path; |
940 | ||
2c1b72d7 | 941 | procedure Found_Project_File (Path : Path_Information; Rank : Natural); |
3e582869 | 942 | -- Called for each project file aggregated by Project |
76e3504f | 943 | |
1aa23421 AC |
944 | procedure Expand_Project_Files is |
945 | new Expand_Subdirectory_Pattern (Callback => Found_Project_File); | |
3e582869 | 946 | -- Search for all project files referenced by the patterns given in |
e917aec2 | 947 | -- parameter. Calls Found_Project_File for each of them. |
76e3504f AC |
948 | |
949 | ------------------------ | |
950 | -- Found_Project_File -- | |
951 | ------------------------ | |
952 | ||
2c1b72d7 | 953 | procedure Found_Project_File (Path : Path_Information; Rank : Natural) is |
76e3504f | 954 | pragma Unreferenced (Rank); |
2c1b72d7 | 955 | |
76e3504f | 956 | begin |
40ecf2f5 | 957 | if Path.Name /= Project.Path.Name then |
2598ee6d | 958 | Debug_Output ("aggregates: ", Name_Id (Path.Display_Name)); |
40ecf2f5 EB |
959 | |
960 | -- For usual "with" statement, this phase will have been done when | |
961 | -- parsing the project itself. However, for aggregate projects, we | |
962 | -- can only do this when processing the aggregate project, since | |
963 | -- the exact list of project files or project directories can | |
964 | -- depend on scenario variables. | |
965 | -- | |
966 | -- We only load the projects explicitly here, but do not process | |
967 | -- them. For the processing, Prj.Proc will take care of processing | |
968 | -- them, within the same call to Recursive_Process (thus avoiding | |
969 | -- the processing of a given project multiple times). | |
970 | -- | |
971 | -- ??? We might already have loaded the project | |
972 | ||
973 | Add_Aggregated_Project (Project, Path => Path.Name); | |
974 | ||
975 | else | |
2598ee6d | 976 | Debug_Output ("pattern returned the aggregate itself, ignored"); |
40ecf2f5 | 977 | end if; |
76e3504f AC |
978 | end Found_Project_File; |
979 | ||
1aa23421 AC |
980 | -- Start of processing for Check_Aggregate_Project |
981 | ||
9d9f5f49 | 982 | begin |
5415acbd | 983 | pragma Assert (Project.Qualifier in Aggregate_Project); |
c4d67e2d | 984 | |
9d9f5f49 AC |
985 | if Project_Files.Default then |
986 | Error_Msg_Name_1 := Snames.Name_Project_Files; | |
987 | Error_Msg | |
c4d67e2d | 988 | (Flags, |
9d9f5f49 AC |
989 | "Attribute %% must be specified in aggregate project", |
990 | Project.Location, Project); | |
76e3504f | 991 | return; |
9d9f5f49 | 992 | end if; |
76e3504f | 993 | |
c4d67e2d AC |
994 | -- The aggregated projects are only searched relative to the directory |
995 | -- of the aggregate project, not in the default project path. | |
996 | ||
a96ca600 EB |
997 | Initialize_Empty (Project_Path_For_Aggregate); |
998 | ||
c4d67e2d AC |
999 | Free (Project.Aggregated_Projects); |
1000 | ||
76e3504f AC |
1001 | -- Look for aggregated projects. For similarity with source files and |
1002 | -- dirs, the aggregated project files are not searched for on the | |
1003 | -- project path, and are only found through the path specified in | |
1004 | -- the Project_Files attribute. | |
1005 | ||
1006 | Expand_Project_Files | |
1007 | (Project => Project, | |
1008 | Data => Data, | |
1009 | Patterns => Project_Files.Values, | |
e7efbe2f | 1010 | Ignore => Nil_String, |
76e3504f AC |
1011 | Search_For => Search_Files, |
1012 | Resolve_Links => Opt.Follow_Links_For_Files); | |
a96ca600 EB |
1013 | |
1014 | Free (Project_Path_For_Aggregate); | |
c4d67e2d | 1015 | end Process_Aggregated_Projects; |
9d9f5f49 | 1016 | |
44e1918a AC |
1017 | ----------- |
1018 | -- Check -- | |
1019 | ----------- | |
1020 | ||
1021 | procedure Check | |
aaf31e16 AC |
1022 | (Project : Project_Id; |
1023 | Data : in out Tree_Processing_Data) | |
7324bf49 | 1024 | is |
86828d40 | 1025 | Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; |
e917aec2 | 1026 | Prj_Data : Project_Processing_Data; |
ede007da | 1027 | |
44e1918a | 1028 | begin |
2598ee6d | 1029 | Debug_Increase_Indent ("check", Project.Name); |
3e582869 | 1030 | |
fdd7e7bb | 1031 | Initialize (Prj_Data, Project); |
19235870 | 1032 | |
86828d40 | 1033 | Check_If_Externally_Built (Project, Data); |
76e3504f | 1034 | |
5415acbd AC |
1035 | case Project.Qualifier is |
1036 | when Aggregate => | |
1037 | null; | |
76e3504f | 1038 | |
5415acbd AC |
1039 | when Aggregate_Library => |
1040 | if Project.Object_Directory = No_Path_Information then | |
1041 | Project.Object_Directory := Project.Directory; | |
1042 | end if; | |
ede007da | 1043 | |
5415acbd AC |
1044 | when others => |
1045 | Get_Directories (Project, Data); | |
1046 | Check_Programming_Languages (Project, Data); | |
1047 | ||
1048 | if Current_Verbosity = High then | |
1049 | Show_Source_Dirs (Project, Shared); | |
1050 | end if; | |
1051 | ||
1052 | if Project.Qualifier = Dry then | |
1053 | Check_Abstract_Project (Project, Data); | |
1054 | end if; | |
9d9f5f49 | 1055 | end case; |
68c3f02a | 1056 | |
7bccff24 EB |
1057 | -- Check configuration. This must be done even for gnatmake (even though |
1058 | -- no user configuration file was provided) since the default config we | |
1059 | -- generate indicates whether libraries are supported for instance. | |
ede007da | 1060 | |
7bccff24 | 1061 | Check_Configuration (Project, Data); |
fbf5a39b | 1062 | |
9d9f5f49 | 1063 | if Project.Qualifier /= Aggregate then |
76e3504f AC |
1064 | Check_Library_Attributes (Project, Data); |
1065 | Check_Package_Naming (Project, Data); | |
5415acbd AC |
1066 | |
1067 | -- An aggregate library has no source, no need to look for them | |
1068 | ||
1069 | if Project.Qualifier /= Aggregate_Library then | |
1070 | Look_For_Sources (Prj_Data, Data); | |
1071 | end if; | |
1072 | ||
76e3504f | 1073 | Check_Interfaces (Project, Data); |
19235870 | 1074 | |
76e3504f AC |
1075 | if Project.Library then |
1076 | Check_Stand_Alone_Library (Project, Data); | |
1077 | end if; | |
4f469be3 | 1078 | |
76e3504f | 1079 | Get_Mains (Project, Data); |
44e1918a | 1080 | end if; |
19235870 | 1081 | |
fdd7e7bb | 1082 | Free (Prj_Data); |
3e582869 | 1083 | |
2598ee6d | 1084 | Debug_Decrease_Indent ("done check"); |
44e1918a | 1085 | end Check; |
19235870 | 1086 | |
cf161d66 AC |
1087 | ---------------------------- |
1088 | -- Check_Abstract_Project -- | |
1089 | ---------------------------- | |
1b685674 | 1090 | |
cf161d66 AC |
1091 | procedure Check_Abstract_Project |
1092 | (Project : Project_Id; | |
1093 | Data : in out Tree_Processing_Data) | |
1094 | is | |
1095 | Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; | |
6c1f47ee | 1096 | |
cf161d66 AC |
1097 | Source_Dirs : constant Variable_Value := |
1098 | Util.Value_Of | |
1099 | (Name_Source_Dirs, | |
1100 | Project.Decl.Attributes, Shared); | |
1101 | Source_Files : constant Variable_Value := | |
1102 | Util.Value_Of | |
1103 | (Name_Source_Files, | |
1104 | Project.Decl.Attributes, Shared); | |
1105 | Source_List_File : constant Variable_Value := | |
1106 | Util.Value_Of | |
1107 | (Name_Source_List_File, | |
1108 | Project.Decl.Attributes, Shared); | |
1109 | Languages : constant Variable_Value := | |
1110 | Util.Value_Of | |
1111 | (Name_Languages, | |
1112 | Project.Decl.Attributes, Shared); | |
1b685674 | 1113 | |
cf161d66 AC |
1114 | begin |
1115 | if Project.Source_Dirs /= Nil_String then | |
1116 | if Source_Dirs.Values = Nil_String | |
1117 | and then Source_Files.Values = Nil_String | |
1118 | and then Languages.Values = Nil_String | |
1119 | and then Source_List_File.Default | |
1b685674 | 1120 | then |
cf161d66 | 1121 | Project.Source_Dirs := Nil_String; |
1b685674 VC |
1122 | |
1123 | else | |
cf161d66 AC |
1124 | Error_Msg |
1125 | (Data.Flags, | |
1126 | "at least one of Source_Files, Source_Dirs or Languages " | |
1127 | & "must be declared empty for an abstract project", | |
1128 | Project.Location, Project); | |
1b685674 | 1129 | end if; |
cf161d66 AC |
1130 | end if; |
1131 | end Check_Abstract_Project; | |
1b685674 | 1132 | |
cf161d66 AC |
1133 | ------------------------- |
1134 | -- Check_Configuration -- | |
1135 | ------------------------- | |
fbf5a39b | 1136 | |
cf161d66 AC |
1137 | procedure Check_Configuration |
1138 | (Project : Project_Id; | |
1139 | Data : in out Tree_Processing_Data) | |
1140 | is | |
86828d40 AC |
1141 | Shared : constant Shared_Project_Tree_Data_Access := |
1142 | Data.Tree.Shared; | |
fbf5a39b | 1143 | |
cf161d66 AC |
1144 | Dot_Replacement : File_Name_Type := No_File; |
1145 | Casing : Casing_Type := All_Lower_Case; | |
1146 | Separate_Suffix : File_Name_Type := No_File; | |
ddd6e5ae | 1147 | |
cf161d66 AC |
1148 | Lang_Index : Language_Ptr := No_Language_Index; |
1149 | -- The index of the language data being checked | |
ddd6e5ae | 1150 | |
cf161d66 AC |
1151 | Prev_Index : Language_Ptr := No_Language_Index; |
1152 | -- The index of the previous language | |
ddd6e5ae | 1153 | |
cf161d66 AC |
1154 | procedure Process_Project_Level_Simple_Attributes; |
1155 | -- Process the simple attributes at the project level | |
fbf5a39b | 1156 | |
cf161d66 AC |
1157 | procedure Process_Project_Level_Array_Attributes; |
1158 | -- Process the associate array attributes at the project level | |
fbf5a39b | 1159 | |
cf161d66 AC |
1160 | procedure Process_Packages; |
1161 | -- Read the packages of the project | |
1b685674 | 1162 | |
cf161d66 AC |
1163 | ---------------------- |
1164 | -- Process_Packages -- | |
1165 | ---------------------- | |
fbf5a39b | 1166 | |
cf161d66 AC |
1167 | procedure Process_Packages is |
1168 | Packages : Package_Id; | |
1169 | Element : Package_Element; | |
fbf5a39b | 1170 | |
cf161d66 AC |
1171 | procedure Process_Binder (Arrays : Array_Id); |
1172 | -- Process the associate array attributes of package Binder | |
fbf5a39b | 1173 | |
cf161d66 AC |
1174 | procedure Process_Builder (Attributes : Variable_Id); |
1175 | -- Process the simple attributes of package Builder | |
fbf5a39b | 1176 | |
cf161d66 AC |
1177 | procedure Process_Compiler (Arrays : Array_Id); |
1178 | -- Process the associate array attributes of package Compiler | |
44e1918a | 1179 | |
cf161d66 AC |
1180 | procedure Process_Naming (Attributes : Variable_Id); |
1181 | -- Process the simple attributes of package Naming | |
fbf5a39b | 1182 | |
cf161d66 AC |
1183 | procedure Process_Naming (Arrays : Array_Id); |
1184 | -- Process the associate array attributes of package Naming | |
fbf5a39b | 1185 | |
cf161d66 AC |
1186 | procedure Process_Linker (Attributes : Variable_Id); |
1187 | -- Process the simple attributes of package Linker of a | |
1188 | -- configuration project. | |
fbf5a39b | 1189 | |
cf161d66 AC |
1190 | -------------------- |
1191 | -- Process_Binder -- | |
1192 | -------------------- | |
fbf5a39b | 1193 | |
cf161d66 AC |
1194 | procedure Process_Binder (Arrays : Array_Id) is |
1195 | Current_Array_Id : Array_Id; | |
1196 | Current_Array : Array_Data; | |
1197 | Element_Id : Array_Element_Id; | |
1198 | Element : Array_Element; | |
fbf5a39b | 1199 | |
cf161d66 AC |
1200 | begin |
1201 | -- Process the associative array attribute of package Binder | |
7324bf49 | 1202 | |
cf161d66 AC |
1203 | Current_Array_Id := Arrays; |
1204 | while Current_Array_Id /= No_Array loop | |
1205 | Current_Array := Shared.Arrays.Table (Current_Array_Id); | |
ede007da | 1206 | |
a70f5d82 VC |
1207 | Element_Id := Current_Array.Value; |
1208 | while Element_Id /= No_Array_Element loop | |
40ecf2f5 | 1209 | Element := Shared.Array_Elements.Table (Element_Id); |
ede007da | 1210 | |
0df218a9 | 1211 | if Element.Index /= All_Other_Names then |
628a4180 | 1212 | |
0df218a9 | 1213 | -- Get the name of the language |
ede007da | 1214 | |
95cd3246 AC |
1215 | Lang_Index := |
1216 | Get_Language_From_Name | |
1217 | (Project, Get_Name_String (Element.Index)); | |
ede007da | 1218 | |
0df218a9 AC |
1219 | if Lang_Index /= No_Language_Index then |
1220 | case Current_Array.Name is | |
95cd3246 | 1221 | when Name_Driver => |
ede007da | 1222 | |
95cd3246 | 1223 | -- Attribute Driver (<language>) |
ede007da | 1224 | |
95cd3246 AC |
1225 | Lang_Index.Config.Binder_Driver := |
1226 | File_Name_Type (Element.Value.Value); | |
ede007da | 1227 | |
95cd3246 AC |
1228 | when Name_Required_Switches => |
1229 | Put | |
1230 | (Into_List => | |
e0697153 | 1231 | Lang_Index.Config.Binder_Required_Switches, |
95cd3246 | 1232 | From_List => Element.Value.Values, |
fdd7e7bb | 1233 | In_Tree => Data.Tree); |
ede007da | 1234 | |
95cd3246 | 1235 | when Name_Prefix => |
ede007da | 1236 | |
95cd3246 | 1237 | -- Attribute Prefix (<language>) |
ede007da | 1238 | |
95cd3246 AC |
1239 | Lang_Index.Config.Binder_Prefix := |
1240 | Element.Value.Value; | |
ede007da | 1241 | |
95cd3246 | 1242 | when Name_Objects_Path => |
ede007da | 1243 | |
95cd3246 | 1244 | -- Attribute Objects_Path (<language>) |
ede007da | 1245 | |
95cd3246 AC |
1246 | Lang_Index.Config.Objects_Path := |
1247 | Element.Value.Value; | |
ede007da | 1248 | |
95cd3246 | 1249 | when Name_Objects_Path_File => |
ede007da | 1250 | |
95cd3246 | 1251 | -- Attribute Objects_Path (<language>) |
ede007da | 1252 | |
95cd3246 AC |
1253 | Lang_Index.Config.Objects_Path_File := |
1254 | Element.Value.Value; | |
ede007da | 1255 | |
95cd3246 AC |
1256 | when others => |
1257 | null; | |
0df218a9 AC |
1258 | end case; |
1259 | end if; | |
a70f5d82 | 1260 | end if; |
ede007da | 1261 | |
a70f5d82 VC |
1262 | Element_Id := Element.Next; |
1263 | end loop; | |
ede007da | 1264 | |
a70f5d82 VC |
1265 | Current_Array_Id := Current_Array.Next; |
1266 | end loop; | |
1267 | end Process_Binder; | |
ede007da | 1268 | |
a70f5d82 VC |
1269 | --------------------- |
1270 | -- Process_Builder -- | |
1271 | --------------------- | |
ede007da | 1272 | |
a70f5d82 VC |
1273 | procedure Process_Builder (Attributes : Variable_Id) is |
1274 | Attribute_Id : Variable_Id; | |
1275 | Attribute : Variable; | |
ede007da | 1276 | |
a70f5d82 VC |
1277 | begin |
1278 | -- Process non associated array attribute from package Builder | |
ede007da | 1279 | |
a70f5d82 VC |
1280 | Attribute_Id := Attributes; |
1281 | while Attribute_Id /= No_Variable loop | |
40ecf2f5 | 1282 | Attribute := Shared.Variable_Elements.Table (Attribute_Id); |
ede007da | 1283 | |
a70f5d82 VC |
1284 | if not Attribute.Value.Default then |
1285 | if Attribute.Name = Name_Executable_Suffix then | |
ede007da | 1286 | |
a70f5d82 VC |
1287 | -- Attribute Executable_Suffix: the suffix of the |
1288 | -- executables. | |
ede007da | 1289 | |
66713d62 | 1290 | Project.Config.Executable_Suffix := |
a70f5d82 VC |
1291 | Attribute.Value.Value; |
1292 | end if; | |
1293 | end if; | |
ede007da | 1294 | |
a70f5d82 VC |
1295 | Attribute_Id := Attribute.Next; |
1296 | end loop; | |
1297 | end Process_Builder; | |
ede007da | 1298 | |
a70f5d82 VC |
1299 | ---------------------- |
1300 | -- Process_Compiler -- | |
1301 | ---------------------- | |
ede007da | 1302 | |
a70f5d82 VC |
1303 | procedure Process_Compiler (Arrays : Array_Id) is |
1304 | Current_Array_Id : Array_Id; | |
1305 | Current_Array : Array_Data; | |
1306 | Element_Id : Array_Element_Id; | |
1307 | Element : Array_Element; | |
1308 | List : String_List_Id; | |
ede007da | 1309 | |
a70f5d82 VC |
1310 | begin |
1311 | -- Process the associative array attribute of package Compiler | |
ede007da | 1312 | |
a70f5d82 VC |
1313 | Current_Array_Id := Arrays; |
1314 | while Current_Array_Id /= No_Array loop | |
40ecf2f5 | 1315 | Current_Array := Shared.Arrays.Table (Current_Array_Id); |
ede007da | 1316 | |
a70f5d82 VC |
1317 | Element_Id := Current_Array.Value; |
1318 | while Element_Id /= No_Array_Element loop | |
40ecf2f5 | 1319 | Element := Shared.Array_Elements.Table (Element_Id); |
ede007da | 1320 | |
0df218a9 | 1321 | if Element.Index /= All_Other_Names then |
628a4180 | 1322 | |
0df218a9 | 1323 | -- Get the name of the language |
ede007da | 1324 | |
5a66a766 EB |
1325 | Lang_Index := Get_Language_From_Name |
1326 | (Project, Get_Name_String (Element.Index)); | |
ede007da | 1327 | |
0df218a9 AC |
1328 | if Lang_Index /= No_Language_Index then |
1329 | case Current_Array.Name is | |
9b20e59b | 1330 | |
cf161d66 | 1331 | -- Attribute Dependency_Kind (<language>) |
9b20e59b | 1332 | |
cf161d66 | 1333 | when Name_Dependency_Kind => |
9b20e59b AC |
1334 | Get_Name_String (Element.Value.Value); |
1335 | ||
1336 | begin | |
1337 | Lang_Index.Config.Dependency_Kind := | |
1338 | Dependency_File_Kind'Value | |
1339 | (Name_Buffer (1 .. Name_Len)); | |
1340 | ||
1341 | exception | |
1342 | when Constraint_Error => | |
1343 | Error_Msg | |
1344 | (Data.Flags, | |
1345 | "illegal value for Dependency_Kind", | |
1346 | Element.Value.Location, | |
1347 | Project); | |
1348 | end; | |
1349 | ||
cf161d66 | 1350 | -- Attribute Dependency_Switches (<language>) |
ede007da | 1351 | |
cf161d66 | 1352 | when Name_Dependency_Switches => |
e0697153 EB |
1353 | if Lang_Index.Config.Dependency_Kind = None then |
1354 | Lang_Index.Config.Dependency_Kind := Makefile; | |
6c1f47ee EB |
1355 | end if; |
1356 | ||
a70f5d82 | 1357 | List := Element.Value.Values; |
ede007da | 1358 | |
6c1f47ee EB |
1359 | if List /= Nil_String then |
1360 | Put (Into_List => | |
e0697153 | 1361 | Lang_Index.Config.Dependency_Option, |
6c1f47ee | 1362 | From_List => List, |
fdd7e7bb | 1363 | In_Tree => Data.Tree); |
a70f5d82 | 1364 | end if; |
ede007da | 1365 | |
cf161d66 | 1366 | -- Attribute Dependency_Driver (<language>) |
ede007da | 1367 | |
cf161d66 | 1368 | when Name_Dependency_Driver => |
e0697153 EB |
1369 | if Lang_Index.Config.Dependency_Kind = None then |
1370 | Lang_Index.Config.Dependency_Kind := Makefile; | |
6c1f47ee EB |
1371 | end if; |
1372 | ||
a70f5d82 VC |
1373 | List := Element.Value.Values; |
1374 | ||
6c1f47ee EB |
1375 | if List /= Nil_String then |
1376 | Put (Into_List => | |
e0697153 | 1377 | Lang_Index.Config.Compute_Dependency, |
6c1f47ee | 1378 | From_List => List, |
fdd7e7bb | 1379 | In_Tree => Data.Tree); |
a70f5d82 | 1380 | end if; |
ede007da | 1381 | |
cf161d66 | 1382 | -- Attribute Language_Kind (<language>) |
9b20e59b | 1383 | |
cf161d66 | 1384 | when Name_Language_Kind => |
9b20e59b AC |
1385 | Get_Name_String (Element.Value.Value); |
1386 | ||
1387 | begin | |
1388 | Lang_Index.Config.Kind := | |
1389 | Language_Kind'Value | |
1390 | (Name_Buffer (1 .. Name_Len)); | |
1391 | ||
1392 | exception | |
1393 | when Constraint_Error => | |
1394 | Error_Msg | |
1395 | (Data.Flags, | |
1396 | "illegal value for Language_Kind", | |
1397 | Element.Value.Location, | |
1398 | Project); | |
1399 | end; | |
1400 | ||
cf161d66 | 1401 | -- Attribute Include_Switches (<language>) |
ede007da | 1402 | |
cf161d66 | 1403 | when Name_Include_Switches => |
a70f5d82 | 1404 | List := Element.Value.Values; |
ede007da | 1405 | |
a70f5d82 VC |
1406 | if List = Nil_String then |
1407 | Error_Msg | |
e2d9085b EB |
1408 | (Data.Flags, "include option cannot be null", |
1409 | Element.Value.Location, Project); | |
a70f5d82 | 1410 | end if; |
ede007da | 1411 | |
fdd7e7bb | 1412 | Put (Into_List => Lang_Index.Config.Include_Option, |
a70f5d82 | 1413 | From_List => List, |
fdd7e7bb | 1414 | In_Tree => Data.Tree); |
ede007da | 1415 | |
cf161d66 | 1416 | -- Attribute Include_Path (<language>) |
ede007da | 1417 | |
cf161d66 | 1418 | when Name_Include_Path => |
e0697153 | 1419 | Lang_Index.Config.Include_Path := |
0df218a9 | 1420 | Element.Value.Value; |
ede007da | 1421 | |
cf161d66 | 1422 | -- Attribute Include_Path_File (<language>) |
ede007da | 1423 | |
cf161d66 | 1424 | when Name_Include_Path_File => |
e0697153 | 1425 | Lang_Index.Config.Include_Path_File := |
9b20e59b | 1426 | Element.Value.Value; |
a70f5d82 | 1427 | |
cf161d66 | 1428 | -- Attribute Driver (<language>) |
a70f5d82 | 1429 | |
cf161d66 | 1430 | when Name_Driver => |
e0697153 | 1431 | Lang_Index.Config.Compiler_Driver := |
3249690d | 1432 | File_Name_Type (Element.Value.Value); |
a70f5d82 | 1433 | |
86828d40 AC |
1434 | when Name_Required_Switches |
1435 | | Name_Leading_Required_Switches | |
1436 | => | |
f91c36dc | 1437 | Put (Into_List => |
cf161d66 AC |
1438 | Lang_Index.Config. |
1439 | Compiler_Leading_Required_Switches, | |
f91c36dc | 1440 | From_List => Element.Value.Values, |
fdd7e7bb | 1441 | In_Tree => Data.Tree); |
f91c36dc | 1442 | |
efc81a89 | 1443 | when Name_Trailing_Required_Switches => |
a70f5d82 | 1444 | Put (Into_List => |
cf161d66 AC |
1445 | Lang_Index.Config. |
1446 | Compiler_Trailing_Required_Switches, | |
a70f5d82 | 1447 | From_List => Element.Value.Values, |
fdd7e7bb | 1448 | In_Tree => Data.Tree); |
a70f5d82 | 1449 | |
c9df623a AC |
1450 | when Name_Multi_Unit_Switches => |
1451 | Put (Into_List => | |
1452 | Lang_Index.Config.Multi_Unit_Switches, | |
1453 | From_List => Element.Value.Values, | |
1454 | In_Tree => Data.Tree); | |
1455 | ||
1456 | when Name_Multi_Unit_Object_Separator => | |
1457 | Get_Name_String (Element.Value.Value); | |
1458 | ||
1459 | if Name_Len /= 1 then | |
1460 | Error_Msg | |
1461 | (Data.Flags, | |
1462 | "multi-unit object separator must have " & | |
1463 | "a single character", | |
1464 | Element.Value.Location, Project); | |
1465 | ||
1466 | elsif Name_Buffer (1) = ' ' then | |
1467 | Error_Msg | |
1468 | (Data.Flags, | |
1469 | "multi-unit object separator cannot be " & | |
1470 | "a space", | |
1471 | Element.Value.Location, Project); | |
1472 | ||
1473 | else | |
1474 | Lang_Index.Config.Multi_Unit_Object_Separator := | |
1475 | Name_Buffer (1); | |
1476 | end if; | |
1477 | ||
434a2807 VC |
1478 | when Name_Path_Syntax => |
1479 | begin | |
e0697153 | 1480 | Lang_Index.Config.Path_Syntax := |
628a4180 RD |
1481 | Path_Syntax_Kind'Value |
1482 | (Get_Name_String (Element.Value.Value)); | |
434a2807 VC |
1483 | |
1484 | exception | |
1485 | when Constraint_Error => | |
1486 | Error_Msg | |
e2d9085b EB |
1487 | (Data.Flags, |
1488 | "invalid value for Path_Syntax", | |
1489 | Element.Value.Location, Project); | |
434a2807 VC |
1490 | end; |
1491 | ||
d2b4b3da AC |
1492 | when Name_Source_File_Switches => |
1493 | Put (Into_List => | |
1494 | Lang_Index.Config.Source_File_Switches, | |
1495 | From_List => Element.Value.Values, | |
1496 | In_Tree => Data.Tree); | |
1497 | ||
618fb570 AC |
1498 | when Name_Object_File_Suffix => |
1499 | if Get_Name_String (Element.Value.Value) = "" then | |
1500 | Error_Msg | |
e2d9085b EB |
1501 | (Data.Flags, |
1502 | "object file suffix cannot be empty", | |
1503 | Element.Value.Location, Project); | |
618fb570 AC |
1504 | |
1505 | else | |
e0697153 | 1506 | Lang_Index.Config.Object_File_Suffix := |
618fb570 AC |
1507 | Element.Value.Value; |
1508 | end if; | |
1509 | ||
f91c36dc AC |
1510 | when Name_Object_File_Switches => |
1511 | Put (Into_List => | |
1512 | Lang_Index.Config.Object_File_Switches, | |
1513 | From_List => Element.Value.Values, | |
fdd7e7bb | 1514 | In_Tree => Data.Tree); |
f91c36dc | 1515 | |
cf161d66 | 1516 | -- Attribute Compiler_Pic_Option (<language>) |
a70f5d82 | 1517 | |
cf161d66 | 1518 | when Name_Pic_Option => |
a70f5d82 VC |
1519 | List := Element.Value.Values; |
1520 | ||
1521 | if List = Nil_String then | |
1522 | Error_Msg | |
e2d9085b EB |
1523 | (Data.Flags, |
1524 | "compiler PIC option cannot be null", | |
1525 | Element.Value.Location, Project); | |
a70f5d82 VC |
1526 | end if; |
1527 | ||
1528 | Put (Into_List => | |
e0697153 | 1529 | Lang_Index.Config.Compilation_PIC_Option, |
a70f5d82 | 1530 | From_List => List, |
fdd7e7bb | 1531 | In_Tree => Data.Tree); |
a70f5d82 | 1532 | |
cf161d66 | 1533 | -- Attribute Mapping_File_Switches (<language>) |
a70f5d82 | 1534 | |
cf161d66 | 1535 | when Name_Mapping_File_Switches => |
a70f5d82 VC |
1536 | List := Element.Value.Values; |
1537 | ||
1538 | if List = Nil_String then | |
1539 | Error_Msg | |
e2d9085b | 1540 | (Data.Flags, |
a70f5d82 | 1541 | "mapping file switches cannot be null", |
e2d9085b | 1542 | Element.Value.Location, Project); |
a70f5d82 VC |
1543 | end if; |
1544 | ||
1545 | Put (Into_List => | |
fdd7e7bb | 1546 | Lang_Index.Config.Mapping_File_Switches, |
a70f5d82 | 1547 | From_List => List, |
fdd7e7bb | 1548 | In_Tree => Data.Tree); |
a70f5d82 | 1549 | |
cf161d66 | 1550 | -- Attribute Mapping_Spec_Suffix (<language>) |
a70f5d82 | 1551 | |
cf161d66 | 1552 | when Name_Mapping_Spec_Suffix => |
e0697153 EB |
1553 | Lang_Index.Config.Mapping_Spec_Suffix := |
1554 | File_Name_Type (Element.Value.Value); | |
a70f5d82 | 1555 | |
cf161d66 | 1556 | -- Attribute Mapping_Body_Suffix (<language>) |
a70f5d82 | 1557 | |
cf161d66 | 1558 | when Name_Mapping_Body_Suffix => |
e0697153 EB |
1559 | Lang_Index.Config.Mapping_Body_Suffix := |
1560 | File_Name_Type (Element.Value.Value); | |
a70f5d82 | 1561 | |
cf161d66 | 1562 | -- Attribute Config_File_Switches (<language>) |
a70f5d82 | 1563 | |
cf161d66 | 1564 | when Name_Config_File_Switches => |
a70f5d82 VC |
1565 | List := Element.Value.Values; |
1566 | ||
1567 | if List = Nil_String then | |
1568 | Error_Msg | |
e2d9085b | 1569 | (Data.Flags, |
a70f5d82 | 1570 | "config file switches cannot be null", |
e2d9085b | 1571 | Element.Value.Location, Project); |
a70f5d82 VC |
1572 | end if; |
1573 | ||
1574 | Put (Into_List => | |
e0697153 | 1575 | Lang_Index.Config.Config_File_Switches, |
a70f5d82 | 1576 | From_List => List, |
fdd7e7bb | 1577 | In_Tree => Data.Tree); |
a70f5d82 | 1578 | |
cf161d66 | 1579 | -- Attribute Objects_Path (<language>) |
a70f5d82 | 1580 | |
cf161d66 | 1581 | when Name_Objects_Path => |
e0697153 EB |
1582 | Lang_Index.Config.Objects_Path := |
1583 | Element.Value.Value; | |
a70f5d82 | 1584 | |
cf161d66 | 1585 | -- Attribute Objects_Path_File (<language>) |
a70f5d82 | 1586 | |
cf161d66 | 1587 | when Name_Objects_Path_File => |
e0697153 EB |
1588 | Lang_Index.Config.Objects_Path_File := |
1589 | Element.Value.Value; | |
a70f5d82 | 1590 | |
cf161d66 | 1591 | -- Attribute Config_Body_File_Name (<language>) |
a70f5d82 | 1592 | |
cf161d66 | 1593 | when Name_Config_Body_File_Name => |
e0697153 EB |
1594 | Lang_Index.Config.Config_Body := |
1595 | Element.Value.Value; | |
a70f5d82 | 1596 | |
cf161d66 | 1597 | -- Attribute Config_Body_File_Name_Index (< Language>) |
c9df623a | 1598 | |
cf161d66 | 1599 | when Name_Config_Body_File_Name_Index => |
c9df623a AC |
1600 | Lang_Index.Config.Config_Body_Index := |
1601 | Element.Value.Value; | |
1602 | ||
cf161d66 | 1603 | -- Attribute Config_Body_File_Name_Pattern(<language>) |
a70f5d82 | 1604 | |
cf161d66 | 1605 | when Name_Config_Body_File_Name_Pattern => |
e0697153 EB |
1606 | Lang_Index.Config.Config_Body_Pattern := |
1607 | Element.Value.Value; | |
a70f5d82 | 1608 | |
a70f5d82 VC |
1609 | -- Attribute Config_Spec_File_Name (<language>) |
1610 | ||
cf161d66 | 1611 | when Name_Config_Spec_File_Name => |
e0697153 EB |
1612 | Lang_Index.Config.Config_Spec := |
1613 | Element.Value.Value; | |
a70f5d82 | 1614 | |
cf161d66 | 1615 | -- Attribute Config_Spec_File_Name_Index (<language>) |
c9df623a | 1616 | |
cf161d66 | 1617 | when Name_Config_Spec_File_Name_Index => |
c9df623a AC |
1618 | Lang_Index.Config.Config_Spec_Index := |
1619 | Element.Value.Value; | |
1620 | ||
cf161d66 | 1621 | -- Attribute Config_Spec_File_Name_Pattern(<language>) |
a70f5d82 | 1622 | |
cf161d66 | 1623 | when Name_Config_Spec_File_Name_Pattern => |
e0697153 | 1624 | Lang_Index.Config.Config_Spec_Pattern := |
0df218a9 | 1625 | Element.Value.Value; |
a70f5d82 | 1626 | |
cf161d66 | 1627 | -- Attribute Config_File_Unique (<language>) |
a70f5d82 | 1628 | |
cf161d66 | 1629 | when Name_Config_File_Unique => |
a70f5d82 | 1630 | begin |
e0697153 EB |
1631 | Lang_Index.Config.Config_File_Unique := |
1632 | Boolean'Value | |
1633 | (Get_Name_String (Element.Value.Value)); | |
a70f5d82 VC |
1634 | exception |
1635 | when Constraint_Error => | |
1636 | Error_Msg | |
e2d9085b | 1637 | (Data.Flags, |
a70f5d82 | 1638 | "illegal value for Config_File_Unique", |
e2d9085b | 1639 | Element.Value.Location, Project); |
a70f5d82 VC |
1640 | end; |
1641 | ||
1642 | when others => | |
1643 | null; | |
0df218a9 AC |
1644 | end case; |
1645 | end if; | |
a70f5d82 VC |
1646 | end if; |
1647 | ||
1648 | Element_Id := Element.Next; | |
1649 | end loop; | |
1650 | ||
1651 | Current_Array_Id := Current_Array.Next; | |
1652 | end loop; | |
1653 | end Process_Compiler; | |
1654 | ||
1655 | -------------------- | |
1656 | -- Process_Naming -- | |
1657 | -------------------- | |
1658 | ||
1659 | procedure Process_Naming (Attributes : Variable_Id) is | |
1660 | Attribute_Id : Variable_Id; | |
1661 | Attribute : Variable; | |
1662 | ||
1663 | begin | |
1664 | -- Process non associated array attribute from package Naming | |
1665 | ||
1666 | Attribute_Id := Attributes; | |
1667 | while Attribute_Id /= No_Variable loop | |
40ecf2f5 | 1668 | Attribute := Shared.Variable_Elements.Table (Attribute_Id); |
a70f5d82 VC |
1669 | |
1670 | if not Attribute.Value.Default then | |
1671 | if Attribute.Name = Name_Separate_Suffix then | |
1672 | ||
1673 | -- Attribute Separate_Suffix | |
1674 | ||
54ecb428 AC |
1675 | Get_Name_String (Attribute.Value.Value); |
1676 | Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); | |
1677 | Separate_Suffix := Name_Find; | |
a70f5d82 VC |
1678 | |
1679 | elsif Attribute.Name = Name_Casing then | |
1680 | ||
1681 | -- Attribute Casing | |
1682 | ||
1683 | begin | |
1684 | Casing := | |
1685 | Value (Get_Name_String (Attribute.Value.Value)); | |
1686 | ||
1687 | exception | |
1688 | when Constraint_Error => | |
1689 | Error_Msg | |
e2d9085b | 1690 | (Data.Flags, |
a70f5d82 | 1691 | "invalid value for Casing", |
e2d9085b | 1692 | Attribute.Value.Location, Project); |
a70f5d82 VC |
1693 | end; |
1694 | ||
1695 | elsif Attribute.Name = Name_Dot_Replacement then | |
1696 | ||
1697 | -- Attribute Dot_Replacement | |
1698 | ||
1699 | Dot_Replacement := File_Name_Type (Attribute.Value.Value); | |
1700 | ||
1701 | end if; | |
ede007da VC |
1702 | end if; |
1703 | ||
a70f5d82 | 1704 | Attribute_Id := Attribute.Next; |
ede007da | 1705 | end loop; |
a70f5d82 VC |
1706 | end Process_Naming; |
1707 | ||
1708 | procedure Process_Naming (Arrays : Array_Id) is | |
1709 | Current_Array_Id : Array_Id; | |
1710 | Current_Array : Array_Data; | |
1711 | Element_Id : Array_Element_Id; | |
1712 | Element : Array_Element; | |
f6cf5b85 | 1713 | |
a70f5d82 VC |
1714 | begin |
1715 | -- Process the associative array attribute of package Naming | |
1716 | ||
1717 | Current_Array_Id := Arrays; | |
1718 | while Current_Array_Id /= No_Array loop | |
40ecf2f5 | 1719 | Current_Array := Shared.Arrays.Table (Current_Array_Id); |
a70f5d82 VC |
1720 | |
1721 | Element_Id := Current_Array.Value; | |
1722 | while Element_Id /= No_Array_Element loop | |
40ecf2f5 | 1723 | Element := Shared.Array_Elements.Table (Element_Id); |
a70f5d82 VC |
1724 | |
1725 | -- Get the name of the language | |
1726 | ||
5a66a766 EB |
1727 | Lang_Index := Get_Language_From_Name |
1728 | (Project, Get_Name_String (Element.Index)); | |
a70f5d82 VC |
1729 | |
1730 | if Lang_Index /= No_Language_Index then | |
1731 | case Current_Array.Name is | |
852dba80 | 1732 | when Name_Spec_Suffix | Name_Specification_Suffix => |
a70f5d82 VC |
1733 | |
1734 | -- Attribute Spec_Suffix (<language>) | |
1735 | ||
54ecb428 AC |
1736 | Get_Name_String (Element.Value.Value); |
1737 | Canonical_Case_File_Name | |
1738 | (Name_Buffer (1 .. Name_Len)); | |
e0697153 | 1739 | Lang_Index.Config.Naming_Data.Spec_Suffix := |
54ecb428 | 1740 | Name_Find; |
a70f5d82 VC |
1741 | |
1742 | when Name_Implementation_Suffix | Name_Body_Suffix => | |
1743 | ||
54ecb428 AC |
1744 | Get_Name_String (Element.Value.Value); |
1745 | Canonical_Case_File_Name | |
1746 | (Name_Buffer (1 .. Name_Len)); | |
1747 | ||
a70f5d82 VC |
1748 | -- Attribute Body_Suffix (<language>) |
1749 | ||
e0697153 | 1750 | Lang_Index.Config.Naming_Data.Body_Suffix := |
54ecb428 | 1751 | Name_Find; |
e0697153 | 1752 | Lang_Index.Config.Naming_Data.Separate_Suffix := |
54ecb428 | 1753 | Lang_Index.Config.Naming_Data.Body_Suffix; |
a70f5d82 VC |
1754 | |
1755 | when others => | |
1756 | null; | |
1757 | end case; | |
1758 | end if; | |
1759 | ||
1760 | Element_Id := Element.Next; | |
1761 | end loop; | |
1762 | ||
1763 | Current_Array_Id := Current_Array.Next; | |
1764 | end loop; | |
1765 | end Process_Naming; | |
1766 | ||
1767 | -------------------- | |
1768 | -- Process_Linker -- | |
1769 | -------------------- | |
1770 | ||
1771 | procedure Process_Linker (Attributes : Variable_Id) is | |
1772 | Attribute_Id : Variable_Id; | |
1773 | Attribute : Variable; | |
1774 | ||
1775 | begin | |
1776 | -- Process non associated array attribute from package Linker | |
1777 | ||
1778 | Attribute_Id := Attributes; | |
1779 | while Attribute_Id /= No_Variable loop | |
40ecf2f5 | 1780 | Attribute := Shared.Variable_Elements.Table (Attribute_Id); |
a70f5d82 VC |
1781 | |
1782 | if not Attribute.Value.Default then | |
1783 | if Attribute.Name = Name_Driver then | |
1784 | ||
1785 | -- Attribute Linker'Driver: the default linker to use | |
1786 | ||
66713d62 | 1787 | Project.Config.Linker := |
a70f5d82 VC |
1788 | Path_Name_Type (Attribute.Value.Value); |
1789 | ||
3568b271 AC |
1790 | -- Linker'Driver is also used to link shared libraries |
1791 | -- if the obsolescent attribute Library_GCC has not been | |
1792 | -- specified. | |
1793 | ||
66713d62 AC |
1794 | if Project.Config.Shared_Lib_Driver = No_File then |
1795 | Project.Config.Shared_Lib_Driver := | |
3568b271 AC |
1796 | File_Name_Type (Attribute.Value.Value); |
1797 | end if; | |
1798 | ||
b3af75af | 1799 | elsif Attribute.Name = Name_Required_Switches then |
a70f5d82 | 1800 | |
e2534738 | 1801 | -- Attribute Required_Switches: the minimum trailing |
a70f5d82 VC |
1802 | -- options to use when invoking the linker |
1803 | ||
e2534738 AC |
1804 | Put (Into_List => |
1805 | Project.Config.Trailing_Linker_Required_Switches, | |
a70f5d82 | 1806 | From_List => Attribute.Value.Values, |
fdd7e7bb | 1807 | In_Tree => Data.Tree); |
a70f5d82 | 1808 | |
b3af75af | 1809 | elsif Attribute.Name = Name_Map_File_Option then |
66713d62 | 1810 | Project.Config.Map_File_Option := Attribute.Value.Value; |
fad0600d AC |
1811 | |
1812 | elsif Attribute.Name = Name_Max_Command_Line_Length then | |
1813 | begin | |
66713d62 | 1814 | Project.Config.Max_Command_Line_Length := |
fad0600d AC |
1815 | Natural'Value (Get_Name_String |
1816 | (Attribute.Value.Value)); | |
1817 | ||
1818 | exception | |
1819 | when Constraint_Error => | |
1820 | Error_Msg | |
e2d9085b | 1821 | (Data.Flags, |
fad0600d | 1822 | "value must be positive or equal to 0", |
e2d9085b | 1823 | Attribute.Value.Location, Project); |
fad0600d AC |
1824 | end; |
1825 | ||
1826 | elsif Attribute.Name = Name_Response_File_Format then | |
1827 | declare | |
1828 | Name : Name_Id; | |
1829 | ||
1830 | begin | |
1831 | Get_Name_String (Attribute.Value.Value); | |
1832 | To_Lower (Name_Buffer (1 .. Name_Len)); | |
1833 | Name := Name_Find; | |
1834 | ||
1835 | if Name = Name_None then | |
66713d62 | 1836 | Project.Config.Resp_File_Format := None; |
fad0600d AC |
1837 | |
1838 | elsif Name = Name_Gnu then | |
66713d62 | 1839 | Project.Config.Resp_File_Format := GNU; |
fad0600d AC |
1840 | |
1841 | elsif Name = Name_Object_List then | |
66713d62 | 1842 | Project.Config.Resp_File_Format := Object_List; |
fad0600d AC |
1843 | |
1844 | elsif Name = Name_Option_List then | |
66713d62 | 1845 | Project.Config.Resp_File_Format := Option_List; |
fad0600d | 1846 | |
e2534738 AC |
1847 | elsif Name_Buffer (1 .. Name_Len) = "gcc" then |
1848 | Project.Config.Resp_File_Format := GCC; | |
1849 | ||
1850 | elsif Name_Buffer (1 .. Name_Len) = "gcc_gnu" then | |
1851 | Project.Config.Resp_File_Format := GCC_GNU; | |
1852 | ||
1853 | elsif | |
1854 | Name_Buffer (1 .. Name_Len) = "gcc_option_list" | |
1855 | then | |
1856 | Project.Config.Resp_File_Format := GCC_Option_List; | |
1857 | ||
1858 | elsif | |
1859 | Name_Buffer (1 .. Name_Len) = "gcc_object_list" | |
1860 | then | |
1861 | Project.Config.Resp_File_Format := GCC_Object_List; | |
1862 | ||
fad0600d AC |
1863 | else |
1864 | Error_Msg | |
e2d9085b | 1865 | (Data.Flags, |
fad0600d | 1866 | "illegal response file format", |
e2d9085b | 1867 | Attribute.Value.Location, Project); |
fad0600d AC |
1868 | end if; |
1869 | end; | |
1870 | ||
1871 | elsif Attribute.Name = Name_Response_File_Switches then | |
66713d62 | 1872 | Put (Into_List => Project.Config.Resp_File_Options, |
fad0600d | 1873 | From_List => Attribute.Value.Values, |
fdd7e7bb | 1874 | In_Tree => Data.Tree); |
a70f5d82 VC |
1875 | end if; |
1876 | end if; | |
1877 | ||
1878 | Attribute_Id := Attribute.Next; | |
1879 | end loop; | |
1880 | end Process_Linker; | |
1881 | ||
1882 | -- Start of processing for Process_Packages | |
1883 | ||
1884 | begin | |
66713d62 | 1885 | Packages := Project.Decl.Packages; |
a70f5d82 | 1886 | while Packages /= No_Package loop |
40ecf2f5 | 1887 | Element := Shared.Packages.Table (Packages); |
a70f5d82 VC |
1888 | |
1889 | case Element.Name is | |
1890 | when Name_Binder => | |
1891 | ||
1892 | -- Process attributes of package Binder | |
1893 | ||
1894 | Process_Binder (Element.Decl.Arrays); | |
1895 | ||
1896 | when Name_Builder => | |
1897 | ||
1898 | -- Process attributes of package Builder | |
1899 | ||
1900 | Process_Builder (Element.Decl.Attributes); | |
1901 | ||
1902 | when Name_Compiler => | |
1903 | ||
1904 | -- Process attributes of package Compiler | |
1905 | ||
1906 | Process_Compiler (Element.Decl.Arrays); | |
1907 | ||
1908 | when Name_Linker => | |
1909 | ||
1910 | -- Process attributes of package Linker | |
1911 | ||
1912 | Process_Linker (Element.Decl.Attributes); | |
1913 | ||
1914 | when Name_Naming => | |
1915 | ||
1916 | -- Process attributes of package Naming | |
ede007da | 1917 | |
a70f5d82 VC |
1918 | Process_Naming (Element.Decl.Attributes); |
1919 | Process_Naming (Element.Decl.Arrays); | |
1920 | ||
1921 | when others => | |
1922 | null; | |
1923 | end case; | |
1924 | ||
1925 | Packages := Element.Next; | |
ede007da | 1926 | end loop; |
a70f5d82 | 1927 | end Process_Packages; |
ede007da | 1928 | |
a70f5d82 VC |
1929 | --------------------------------------------- |
1930 | -- Process_Project_Level_Simple_Attributes -- | |
1931 | --------------------------------------------- | |
ede007da | 1932 | |
a70f5d82 VC |
1933 | procedure Process_Project_Level_Simple_Attributes is |
1934 | Attribute_Id : Variable_Id; | |
1935 | Attribute : Variable; | |
1936 | List : String_List_Id; | |
ede007da | 1937 | |
a70f5d82 VC |
1938 | begin |
1939 | -- Process non associated array attribute at project level | |
ede007da | 1940 | |
66713d62 | 1941 | Attribute_Id := Project.Decl.Attributes; |
a70f5d82 | 1942 | while Attribute_Id /= No_Variable loop |
40ecf2f5 | 1943 | Attribute := Shared.Variable_Elements.Table (Attribute_Id); |
ede007da | 1944 | |
a70f5d82 | 1945 | if not Attribute.Value.Default then |
b20de9b9 AC |
1946 | if Attribute.Name = Name_Target then |
1947 | ||
1948 | -- Attribute Target: the target specified | |
1949 | ||
66713d62 | 1950 | Project.Config.Target := Attribute.Value.Value; |
b20de9b9 AC |
1951 | |
1952 | elsif Attribute.Name = Name_Library_Builder then | |
ede007da | 1953 | |
a70f5d82 VC |
1954 | -- Attribute Library_Builder: the application to invoke |
1955 | -- to build libraries. | |
ede007da | 1956 | |
66713d62 | 1957 | Project.Config.Library_Builder := |
a70f5d82 | 1958 | Path_Name_Type (Attribute.Value.Value); |
ede007da | 1959 | |
a70f5d82 | 1960 | elsif Attribute.Name = Name_Archive_Builder then |
ede007da | 1961 | |
a70f5d82 VC |
1962 | -- Attribute Archive_Builder: the archive builder |
1963 | -- (usually "ar") and its minimum options (usually "cr"). | |
ede007da | 1964 | |
a70f5d82 VC |
1965 | List := Attribute.Value.Values; |
1966 | ||
1967 | if List = Nil_String then | |
1968 | Error_Msg | |
e2d9085b | 1969 | (Data.Flags, |
a70f5d82 | 1970 | "archive builder cannot be null", |
e2d9085b | 1971 | Attribute.Value.Location, Project); |
a70f5d82 VC |
1972 | end if; |
1973 | ||
66713d62 | 1974 | Put (Into_List => Project.Config.Archive_Builder, |
a70f5d82 | 1975 | From_List => List, |
fdd7e7bb | 1976 | In_Tree => Data.Tree); |
a70f5d82 | 1977 | |
68c3f02a VC |
1978 | elsif Attribute.Name = Name_Archive_Builder_Append_Option then |
1979 | ||
1980 | -- Attribute Archive_Builder: the archive builder | |
1981 | -- (usually "ar") and its minimum options (usually "cr"). | |
1982 | ||
1983 | List := Attribute.Value.Values; | |
1984 | ||
1985 | if List /= Nil_String then | |
1986 | Put | |
66713d62 AC |
1987 | (Into_List => |
1988 | Project.Config.Archive_Builder_Append_Option, | |
68c3f02a | 1989 | From_List => List, |
fdd7e7bb | 1990 | In_Tree => Data.Tree); |
68c3f02a VC |
1991 | end if; |
1992 | ||
a70f5d82 VC |
1993 | elsif Attribute.Name = Name_Archive_Indexer then |
1994 | ||
1995 | -- Attribute Archive_Indexer: the optional archive | |
1996 | -- indexer (usually "ranlib") with its minimum options | |
1997 | -- (usually none). | |
1998 | ||
1999 | List := Attribute.Value.Values; | |
2000 | ||
2001 | if List = Nil_String then | |
2002 | Error_Msg | |
e2d9085b | 2003 | (Data.Flags, |
a70f5d82 | 2004 | "archive indexer cannot be null", |
e2d9085b | 2005 | Attribute.Value.Location, Project); |
a70f5d82 VC |
2006 | end if; |
2007 | ||
66713d62 | 2008 | Put (Into_List => Project.Config.Archive_Indexer, |
a70f5d82 | 2009 | From_List => List, |
fdd7e7bb | 2010 | In_Tree => Data.Tree); |
a70f5d82 VC |
2011 | |
2012 | elsif Attribute.Name = Name_Library_Partial_Linker then | |
2013 | ||
2014 | -- Attribute Library_Partial_Linker: the optional linker | |
2015 | -- driver with its minimum options, to partially link | |
2016 | -- archives. | |
2017 | ||
2018 | List := Attribute.Value.Values; | |
2019 | ||
2020 | if List = Nil_String then | |
2021 | Error_Msg | |
e2d9085b | 2022 | (Data.Flags, |
a70f5d82 | 2023 | "partial linker cannot be null", |
e2d9085b | 2024 | Attribute.Value.Location, Project); |
a70f5d82 VC |
2025 | end if; |
2026 | ||
66713d62 | 2027 | Put (Into_List => Project.Config.Lib_Partial_Linker, |
a70f5d82 | 2028 | From_List => List, |
fdd7e7bb | 2029 | In_Tree => Data.Tree); |
a70f5d82 | 2030 | |
9570dc5b | 2031 | elsif Attribute.Name = Name_Library_GCC then |
66713d62 | 2032 | Project.Config.Shared_Lib_Driver := |
9570dc5b | 2033 | File_Name_Type (Attribute.Value.Value); |
3568b271 | 2034 | Error_Msg |
e2d9085b | 2035 | (Data.Flags, |
3568b271 AC |
2036 | "?Library_'G'C'C is an obsolescent attribute, " & |
2037 | "use Linker''Driver instead", | |
e2d9085b | 2038 | Attribute.Value.Location, Project); |
9570dc5b | 2039 | |
a70f5d82 | 2040 | elsif Attribute.Name = Name_Archive_Suffix then |
66713d62 | 2041 | Project.Config.Archive_Suffix := |
a70f5d82 VC |
2042 | File_Name_Type (Attribute.Value.Value); |
2043 | ||
2044 | elsif Attribute.Name = Name_Linker_Executable_Option then | |
2045 | ||
2046 | -- Attribute Linker_Executable_Option: optional options | |
2047 | -- to specify an executable name. Defaults to "-o". | |
2048 | ||
2049 | List := Attribute.Value.Values; | |
2050 | ||
2051 | if List = Nil_String then | |
2052 | Error_Msg | |
e2d9085b | 2053 | (Data.Flags, |
a70f5d82 | 2054 | "linker executable option cannot be null", |
e2d9085b | 2055 | Attribute.Value.Location, Project); |
a70f5d82 VC |
2056 | end if; |
2057 | ||
66713d62 | 2058 | Put (Into_List => Project.Config.Linker_Executable_Option, |
a70f5d82 | 2059 | From_List => List, |
fdd7e7bb | 2060 | In_Tree => Data.Tree); |
a70f5d82 VC |
2061 | |
2062 | elsif Attribute.Name = Name_Linker_Lib_Dir_Option then | |
2063 | ||
2064 | -- Attribute Linker_Lib_Dir_Option: optional options | |
2065 | -- to specify a library search directory. Defaults to | |
2066 | -- "-L". | |
2067 | ||
2068 | Get_Name_String (Attribute.Value.Value); | |
2069 | ||
2070 | if Name_Len = 0 then | |
2071 | Error_Msg | |
e2d9085b | 2072 | (Data.Flags, |
a70f5d82 | 2073 | "linker library directory option cannot be empty", |
e2d9085b | 2074 | Attribute.Value.Location, Project); |
a70f5d82 VC |
2075 | end if; |
2076 | ||
66713d62 AC |
2077 | Project.Config.Linker_Lib_Dir_Option := |
2078 | Attribute.Value.Value; | |
a70f5d82 VC |
2079 | |
2080 | elsif Attribute.Name = Name_Linker_Lib_Name_Option then | |
2081 | ||
2082 | -- Attribute Linker_Lib_Name_Option: optional options | |
2083 | -- to specify the name of a library to be linked in. | |
2084 | -- Defaults to "-l". | |
2085 | ||
2086 | Get_Name_String (Attribute.Value.Value); | |
2087 | ||
2088 | if Name_Len = 0 then | |
2089 | Error_Msg | |
e2d9085b | 2090 | (Data.Flags, |
a70f5d82 | 2091 | "linker library name option cannot be empty", |
e2d9085b | 2092 | Attribute.Value.Location, Project); |
a70f5d82 VC |
2093 | end if; |
2094 | ||
66713d62 AC |
2095 | Project.Config.Linker_Lib_Name_Option := |
2096 | Attribute.Value.Value; | |
a70f5d82 VC |
2097 | |
2098 | elsif Attribute.Name = Name_Run_Path_Option then | |
2099 | ||
2100 | -- Attribute Run_Path_Option: optional options to | |
2101 | -- specify a path for libraries. | |
2102 | ||
2103 | List := Attribute.Value.Values; | |
2104 | ||
2105 | if List /= Nil_String then | |
66713d62 | 2106 | Put (Into_List => Project.Config.Run_Path_Option, |
a70f5d82 | 2107 | From_List => List, |
fdd7e7bb | 2108 | In_Tree => Data.Tree); |
a70f5d82 VC |
2109 | end if; |
2110 | ||
c94a0b9d AC |
2111 | elsif Attribute.Name = Name_Run_Path_Origin then |
2112 | Get_Name_String (Attribute.Value.Value); | |
2113 | ||
2114 | if Name_Len = 0 then | |
2115 | Error_Msg | |
2116 | (Data.Flags, | |
2117 | "run path origin cannot be empty", | |
2118 | Attribute.Value.Location, Project); | |
2119 | end if; | |
2120 | ||
2121 | Project.Config.Run_Path_Origin := Attribute.Value.Value; | |
2122 | ||
2123 | elsif Attribute.Name = Name_Library_Install_Name_Option then | |
2124 | Project.Config.Library_Install_Name_Option := | |
2125 | Attribute.Value.Value; | |
3d923671 | 2126 | |
c9a1acdc AC |
2127 | elsif Attribute.Name = Name_Separate_Run_Path_Options then |
2128 | declare | |
2129 | pragma Unsuppress (All_Checks); | |
2130 | begin | |
66713d62 | 2131 | Project.Config.Separate_Run_Path_Options := |
d9c0e057 | 2132 | Boolean'Value (Get_Name_String (Attribute.Value.Value)); |
c9a1acdc AC |
2133 | exception |
2134 | when Constraint_Error => | |
2135 | Error_Msg | |
e2d9085b | 2136 | (Data.Flags, |
c9a1acdc AC |
2137 | "invalid value """ & |
2138 | Get_Name_String (Attribute.Value.Value) & | |
2139 | """ for Separate_Run_Path_Options", | |
e2d9085b | 2140 | Attribute.Value.Location, Project); |
c9a1acdc AC |
2141 | end; |
2142 | ||
a70f5d82 VC |
2143 | elsif Attribute.Name = Name_Library_Support then |
2144 | declare | |
2145 | pragma Unsuppress (All_Checks); | |
2146 | begin | |
66713d62 | 2147 | Project.Config.Lib_Support := |
a70f5d82 VC |
2148 | Library_Support'Value (Get_Name_String |
2149 | (Attribute.Value.Value)); | |
2150 | exception | |
2151 | when Constraint_Error => | |
2152 | Error_Msg | |
e2d9085b | 2153 | (Data.Flags, |
a70f5d82 VC |
2154 | "invalid value """ & |
2155 | Get_Name_String (Attribute.Value.Value) & | |
2156 | """ for Library_Support", | |
e2d9085b | 2157 | Attribute.Value.Location, Project); |
a70f5d82 VC |
2158 | end; |
2159 | ||
2160 | elsif Attribute.Name = Name_Shared_Library_Prefix then | |
66713d62 | 2161 | Project.Config.Shared_Lib_Prefix := |
a70f5d82 VC |
2162 | File_Name_Type (Attribute.Value.Value); |
2163 | ||
2164 | elsif Attribute.Name = Name_Shared_Library_Suffix then | |
66713d62 | 2165 | Project.Config.Shared_Lib_Suffix := |
a70f5d82 VC |
2166 | File_Name_Type (Attribute.Value.Value); |
2167 | ||
2168 | elsif Attribute.Name = Name_Symbolic_Link_Supported then | |
2169 | declare | |
2170 | pragma Unsuppress (All_Checks); | |
2171 | begin | |
66713d62 | 2172 | Project.Config.Symbolic_Link_Supported := |
a70f5d82 VC |
2173 | Boolean'Value (Get_Name_String |
2174 | (Attribute.Value.Value)); | |
2175 | exception | |
2176 | when Constraint_Error => | |
2177 | Error_Msg | |
e2d9085b | 2178 | (Data.Flags, |
68c3f02a VC |
2179 | "invalid value """ |
2180 | & Get_Name_String (Attribute.Value.Value) | |
2181 | & """ for Symbolic_Link_Supported", | |
e2d9085b | 2182 | Attribute.Value.Location, Project); |
a70f5d82 VC |
2183 | end; |
2184 | ||
2185 | elsif | |
2186 | Attribute.Name = Name_Library_Major_Minor_Id_Supported | |
2187 | then | |
2188 | declare | |
2189 | pragma Unsuppress (All_Checks); | |
2190 | begin | |
66713d62 | 2191 | Project.Config.Lib_Maj_Min_Id_Supported := |
a70f5d82 VC |
2192 | Boolean'Value (Get_Name_String |
2193 | (Attribute.Value.Value)); | |
2194 | exception | |
2195 | when Constraint_Error => | |
2196 | Error_Msg | |
e2d9085b | 2197 | (Data.Flags, |
a70f5d82 VC |
2198 | "invalid value """ & |
2199 | Get_Name_String (Attribute.Value.Value) & | |
2200 | """ for Library_Major_Minor_Id_Supported", | |
e2d9085b | 2201 | Attribute.Value.Location, Project); |
a70f5d82 VC |
2202 | end; |
2203 | ||
68c3f02a | 2204 | elsif Attribute.Name = Name_Library_Auto_Init_Supported then |
a70f5d82 VC |
2205 | declare |
2206 | pragma Unsuppress (All_Checks); | |
2207 | begin | |
66713d62 | 2208 | Project.Config.Auto_Init_Supported := |
68c3f02a | 2209 | Boolean'Value (Get_Name_String (Attribute.Value.Value)); |
a70f5d82 VC |
2210 | exception |
2211 | when Constraint_Error => | |
2212 | Error_Msg | |
e2d9085b | 2213 | (Data.Flags, |
68c3f02a VC |
2214 | "invalid value """ |
2215 | & Get_Name_String (Attribute.Value.Value) | |
2216 | & """ for Library_Auto_Init_Supported", | |
e2d9085b | 2217 | Attribute.Value.Location, Project); |
a70f5d82 VC |
2218 | end; |
2219 | ||
68c3f02a | 2220 | elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then |
a70f5d82 VC |
2221 | List := Attribute.Value.Values; |
2222 | ||
2223 | if List /= Nil_String then | |
66713d62 | 2224 | Put (Into_List => Project.Config.Shared_Lib_Min_Options, |
a70f5d82 | 2225 | From_List => List, |
fdd7e7bb | 2226 | In_Tree => Data.Tree); |
a70f5d82 VC |
2227 | end if; |
2228 | ||
68c3f02a | 2229 | elsif Attribute.Name = Name_Library_Version_Switches then |
a70f5d82 | 2230 | List := Attribute.Value.Values; |
ede007da | 2231 | |
a70f5d82 | 2232 | if List /= Nil_String then |
66713d62 | 2233 | Put (Into_List => Project.Config.Lib_Version_Options, |
a70f5d82 | 2234 | From_List => List, |
fdd7e7bb | 2235 | In_Tree => Data.Tree); |
a70f5d82 VC |
2236 | end if; |
2237 | end if; | |
2238 | end if; | |
2239 | ||
2240 | Attribute_Id := Attribute.Next; | |
2241 | end loop; | |
2242 | end Process_Project_Level_Simple_Attributes; | |
2243 | ||
2244 | -------------------------------------------- | |
2245 | -- Process_Project_Level_Array_Attributes -- | |
2246 | -------------------------------------------- | |
2247 | ||
2248 | procedure Process_Project_Level_Array_Attributes is | |
2249 | Current_Array_Id : Array_Id; | |
2250 | Current_Array : Array_Data; | |
2251 | Element_Id : Array_Element_Id; | |
2252 | Element : Array_Element; | |
68c3f02a | 2253 | List : String_List_Id; |
a70f5d82 VC |
2254 | |
2255 | begin | |
2256 | -- Process the associative array attributes at project level | |
2257 | ||
66713d62 | 2258 | Current_Array_Id := Project.Decl.Arrays; |
a70f5d82 | 2259 | while Current_Array_Id /= No_Array loop |
40ecf2f5 | 2260 | Current_Array := Shared.Arrays.Table (Current_Array_Id); |
a70f5d82 VC |
2261 | |
2262 | Element_Id := Current_Array.Value; | |
2263 | while Element_Id /= No_Array_Element loop | |
40ecf2f5 | 2264 | Element := Shared.Array_Elements.Table (Element_Id); |
a70f5d82 VC |
2265 | |
2266 | -- Get the name of the language | |
2267 | ||
95cd3246 AC |
2268 | Lang_Index := |
2269 | Get_Language_From_Name | |
2270 | (Project, Get_Name_String (Element.Index)); | |
a70f5d82 VC |
2271 | |
2272 | if Lang_Index /= No_Language_Index then | |
2273 | case Current_Array.Name is | |
68c3f02a VC |
2274 | when Name_Inherit_Source_Path => |
2275 | List := Element.Value.Values; | |
2276 | ||
2277 | if List /= Nil_String then | |
2278 | Put | |
2279 | (Into_List => | |
e0697153 | 2280 | Lang_Index.Config.Include_Compatible_Languages, |
68c3f02a | 2281 | From_List => List, |
fdd7e7bb | 2282 | In_Tree => Data.Tree, |
68c3f02a VC |
2283 | Lower_Case => True); |
2284 | end if; | |
2285 | ||
a70f5d82 | 2286 | when Name_Toolchain_Description => |
ede007da | 2287 | |
a70f5d82 | 2288 | -- Attribute Toolchain_Description (<language>) |
ede007da | 2289 | |
e0697153 | 2290 | Lang_Index.Config.Toolchain_Description := |
a70f5d82 | 2291 | Element.Value.Value; |
ede007da | 2292 | |
a70f5d82 | 2293 | when Name_Toolchain_Version => |
ede007da | 2294 | |
a70f5d82 | 2295 | -- Attribute Toolchain_Version (<language>) |
ede007da | 2296 | |
e0697153 | 2297 | Lang_Index.Config.Toolchain_Version := |
a70f5d82 | 2298 | Element.Value.Value; |
ede007da | 2299 | |
dc718e52 | 2300 | -- For Ada, set proper checksum computation mode |
b251750b | 2301 | |
dc718e52 | 2302 | if Lang_Index.Name = Name_Ada then |
1ce9dff3 VC |
2303 | declare |
2304 | Vers : constant String := | |
2305 | Get_Name_String (Element.Value.Value); | |
2306 | pragma Assert (Vers'First = 1); | |
2307 | ||
2308 | begin | |
dc718e52 RD |
2309 | -- Version 6.3 or earlier |
2310 | ||
1ce9dff3 VC |
2311 | if Vers'Length >= 8 |
2312 | and then Vers (1 .. 5) = "GNAT " | |
2313 | and then Vers (7) = '.' | |
2314 | and then | |
2315 | (Vers (6) < '6' | |
2316 | or else | |
2317 | (Vers (6) = '6' and then Vers (8) < '4')) | |
2318 | then | |
b251750b | 2319 | Checksum_GNAT_6_3 := True; |
1ce9dff3 | 2320 | |
dc718e52 RD |
2321 | -- Version 5.03 or earlier |
2322 | ||
1ce9dff3 VC |
2323 | if Vers (6) < '5' |
2324 | or else (Vers (6) = '5' | |
2325 | and then Vers (Vers'Last) < '4') | |
2326 | then | |
b251750b VC |
2327 | Checksum_GNAT_5_03 := True; |
2328 | ||
dc718e52 RD |
2329 | -- Version 5.02 or earlier |
2330 | ||
b251750b VC |
2331 | if Vers (6) /= '5' |
2332 | or else Vers (Vers'Last) < '3' | |
2333 | then | |
2334 | Checksum_Accumulate_Token_Checksum := | |
dc718e52 | 2335 | False; |
b251750b | 2336 | end if; |
1ce9dff3 VC |
2337 | end if; |
2338 | end if; | |
2339 | end; | |
2340 | end if; | |
2341 | ||
1b685674 VC |
2342 | when Name_Runtime_Library_Dir => |
2343 | ||
2344 | -- Attribute Runtime_Library_Dir (<language>) | |
2345 | ||
e0697153 | 2346 | Lang_Index.Config.Runtime_Library_Dir := |
1b685674 VC |
2347 | Element.Value.Value; |
2348 | ||
b61ebe4f AC |
2349 | when Name_Runtime_Source_Dir => |
2350 | ||
9f55bc62 | 2351 | -- Attribute Runtime_Source_Dir (<language>) |
b61ebe4f | 2352 | |
e0697153 | 2353 | Lang_Index.Config.Runtime_Source_Dir := |
b61ebe4f AC |
2354 | Element.Value.Value; |
2355 | ||
4f469be3 VC |
2356 | when Name_Object_Generated => |
2357 | declare | |
2358 | pragma Unsuppress (All_Checks); | |
2359 | Value : Boolean; | |
2360 | ||
2361 | begin | |
2362 | Value := | |
2363 | Boolean'Value | |
2364 | (Get_Name_String (Element.Value.Value)); | |
2365 | ||
e0697153 | 2366 | Lang_Index.Config.Object_Generated := Value; |
4f469be3 VC |
2367 | |
2368 | -- If no object is generated, no object may be | |
2369 | -- linked. | |
2370 | ||
2371 | if not Value then | |
e0697153 | 2372 | Lang_Index.Config.Objects_Linked := False; |
4f469be3 VC |
2373 | end if; |
2374 | ||
2375 | exception | |
2376 | when Constraint_Error => | |
2377 | Error_Msg | |
e2d9085b | 2378 | (Data.Flags, |
4f469be3 VC |
2379 | "invalid value """ |
2380 | & Get_Name_String (Element.Value.Value) | |
2381 | & """ for Object_Generated", | |
e2d9085b | 2382 | Element.Value.Location, Project); |
4f469be3 VC |
2383 | end; |
2384 | ||
2385 | when Name_Objects_Linked => | |
2386 | declare | |
2387 | pragma Unsuppress (All_Checks); | |
2388 | Value : Boolean; | |
2389 | ||
2390 | begin | |
2391 | Value := | |
2392 | Boolean'Value | |
2393 | (Get_Name_String (Element.Value.Value)); | |
2394 | ||
2395 | -- No change if Object_Generated is False, as this | |
2396 | -- forces Objects_Linked to be False too. | |
2397 | ||
e0697153 EB |
2398 | if Lang_Index.Config.Object_Generated then |
2399 | Lang_Index.Config.Objects_Linked := Value; | |
4f469be3 VC |
2400 | end if; |
2401 | ||
2402 | exception | |
2403 | when Constraint_Error => | |
2404 | Error_Msg | |
e2d9085b | 2405 | (Data.Flags, |
4f469be3 VC |
2406 | "invalid value """ |
2407 | & Get_Name_String (Element.Value.Value) | |
2408 | & """ for Objects_Linked", | |
e2d9085b | 2409 | Element.Value.Location, Project); |
4f469be3 | 2410 | end; |
ede007da VC |
2411 | when others => |
2412 | null; | |
2413 | end case; | |
2414 | end if; | |
2415 | ||
a70f5d82 | 2416 | Element_Id := Element.Next; |
ede007da VC |
2417 | end loop; |
2418 | ||
a70f5d82 | 2419 | Current_Array_Id := Current_Array.Next; |
ede007da | 2420 | end loop; |
a70f5d82 VC |
2421 | end Process_Project_Level_Array_Attributes; |
2422 | ||
f6cf5b85 AC |
2423 | -- Start of processing for Check_Configuration |
2424 | ||
a70f5d82 VC |
2425 | begin |
2426 | Process_Project_Level_Simple_Attributes; | |
a70f5d82 | 2427 | Process_Project_Level_Array_Attributes; |
a70f5d82 VC |
2428 | Process_Packages; |
2429 | ||
2430 | -- For unit based languages, set Casing, Dot_Replacement and | |
2431 | -- Separate_Suffix in Naming_Data. | |
2432 | ||
66713d62 | 2433 | Lang_Index := Project.Languages; |
a70f5d82 | 2434 | while Lang_Index /= No_Language_Index loop |
9b20e59b | 2435 | if Lang_Index.Config.Kind = Unit_Based then |
e0697153 EB |
2436 | Lang_Index.Config.Naming_Data.Casing := Casing; |
2437 | Lang_Index.Config.Naming_Data.Dot_Replacement := Dot_Replacement; | |
a70f5d82 VC |
2438 | |
2439 | if Separate_Suffix /= No_File then | |
e0697153 | 2440 | Lang_Index.Config.Naming_Data.Separate_Suffix := |
a70f5d82 VC |
2441 | Separate_Suffix; |
2442 | end if; | |
2443 | ||
2444 | exit; | |
2445 | end if; | |
2446 | ||
e0697153 | 2447 | Lang_Index := Lang_Index.Next; |
a70f5d82 VC |
2448 | end loop; |
2449 | ||
2450 | -- Give empty names to various prefixes/suffixes, if they have not | |
2451 | -- been specified in the configuration. | |
2452 | ||
66713d62 AC |
2453 | if Project.Config.Archive_Suffix = No_File then |
2454 | Project.Config.Archive_Suffix := Empty_File; | |
a70f5d82 VC |
2455 | end if; |
2456 | ||
66713d62 AC |
2457 | if Project.Config.Shared_Lib_Prefix = No_File then |
2458 | Project.Config.Shared_Lib_Prefix := Empty_File; | |
a70f5d82 VC |
2459 | end if; |
2460 | ||
66713d62 AC |
2461 | if Project.Config.Shared_Lib_Suffix = No_File then |
2462 | Project.Config.Shared_Lib_Suffix := Empty_File; | |
ede007da | 2463 | end if; |
a70f5d82 | 2464 | |
66713d62 | 2465 | Lang_Index := Project.Languages; |
a70f5d82 | 2466 | while Lang_Index /= No_Language_Index loop |
f6cf5b85 | 2467 | |
1290ef14 | 2468 | -- For all languages, Compiler_Driver needs to be specified. This is |
84157c9a | 2469 | -- only needed if we do intend to compile (not in GPS for instance). |
6c1f47ee | 2470 | |
32404665 | 2471 | if Data.Flags.Compiler_Driver_Mandatory |
1290ef14 AC |
2472 | and then Lang_Index.Config.Compiler_Driver = No_File |
2473 | then | |
5a66a766 | 2474 | Error_Msg_Name_1 := Lang_Index.Display_Name; |
6c1f47ee | 2475 | Error_Msg |
e2d9085b | 2476 | (Data.Flags, |
6c1f47ee | 2477 | "?no compiler specified for language %%" & |
84157c9a | 2478 | ", ignoring all its sources", |
e2d9085b | 2479 | No_Location, Project); |
6c1f47ee | 2480 | |
66713d62 AC |
2481 | if Lang_Index = Project.Languages then |
2482 | Project.Languages := Lang_Index.Next; | |
6c1f47ee | 2483 | else |
e0697153 | 2484 | Prev_Index.Next := Lang_Index.Next; |
6c1f47ee EB |
2485 | end if; |
2486 | ||
9b20e59b | 2487 | elsif Lang_Index.Config.Kind = Unit_Based then |
6c1f47ee | 2488 | Prev_Index := Lang_Index; |
a70f5d82 VC |
2489 | |
2490 | -- For unit based languages, Dot_Replacement, Spec_Suffix and | |
2491 | -- Body_Suffix need to be specified. | |
2492 | ||
e0697153 | 2493 | if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then |
a70f5d82 | 2494 | Error_Msg |
e2d9085b | 2495 | (Data.Flags, |
9b20e59b AC |
2496 | "Dot_Replacement not specified for " & |
2497 | Get_Name_String (Lang_Index.Name), | |
e2d9085b | 2498 | No_Location, Project); |
a70f5d82 VC |
2499 | end if; |
2500 | ||
e0697153 | 2501 | if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then |
a70f5d82 | 2502 | Error_Msg |
e2d9085b | 2503 | (Data.Flags, |
9b20e59b AC |
2504 | "Spec_Suffix not specified for " & |
2505 | Get_Name_String (Lang_Index.Name), | |
e2d9085b | 2506 | No_Location, Project); |
a70f5d82 VC |
2507 | end if; |
2508 | ||
e0697153 | 2509 | if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then |
a70f5d82 | 2510 | Error_Msg |
e2d9085b | 2511 | (Data.Flags, |
9b20e59b AC |
2512 | "Body_Suffix not specified for " & |
2513 | Get_Name_String (Lang_Index.Name), | |
e2d9085b | 2514 | No_Location, Project); |
a70f5d82 VC |
2515 | end if; |
2516 | ||
2517 | else | |
6c1f47ee EB |
2518 | Prev_Index := Lang_Index; |
2519 | ||
a70f5d82 VC |
2520 | -- For file based languages, either Spec_Suffix or Body_Suffix |
2521 | -- need to be specified. | |
2522 | ||
7bccff24 EB |
2523 | if Data.Flags.Require_Sources_Other_Lang |
2524 | and then Lang_Index.Config.Naming_Data.Spec_Suffix = No_File | |
2525 | and then Lang_Index.Config.Naming_Data.Body_Suffix = No_File | |
a70f5d82 | 2526 | then |
5a66a766 | 2527 | Error_Msg_Name_1 := Lang_Index.Display_Name; |
a70f5d82 | 2528 | Error_Msg |
e2d9085b | 2529 | (Data.Flags, |
6c1f47ee | 2530 | "no suffixes specified for %%", |
e2d9085b | 2531 | No_Location, Project); |
a70f5d82 VC |
2532 | end if; |
2533 | end if; | |
2534 | ||
e0697153 | 2535 | Lang_Index := Lang_Index.Next; |
a70f5d82 | 2536 | end loop; |
ede007da VC |
2537 | end Check_Configuration; |
2538 | ||
44e1918a AC |
2539 | ------------------------------- |
2540 | -- Check_If_Externally_Built -- | |
2541 | ------------------------------- | |
19235870 | 2542 | |
44e1918a | 2543 | procedure Check_If_Externally_Built |
7e98a4c6 | 2544 | (Project : Project_Id; |
fdd7e7bb | 2545 | Data : in out Tree_Processing_Data) |
44e1918a | 2546 | is |
40ecf2f5 | 2547 | Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; |
44e1918a AC |
2548 | Externally_Built : constant Variable_Value := |
2549 | Util.Value_Of | |
7e98a4c6 | 2550 | (Name_Externally_Built, |
40ecf2f5 | 2551 | Project.Decl.Attributes, Shared); |
19235870 | 2552 | |
44e1918a AC |
2553 | begin |
2554 | if not Externally_Built.Default then | |
2555 | Get_Name_String (Externally_Built.Value); | |
2556 | To_Lower (Name_Buffer (1 .. Name_Len)); | |
19235870 | 2557 | |
44e1918a | 2558 | if Name_Buffer (1 .. Name_Len) = "true" then |
66713d62 | 2559 | Project.Externally_Built := True; |
19235870 | 2560 | |
44e1918a | 2561 | elsif Name_Buffer (1 .. Name_Len) /= "false" then |
e2d9085b | 2562 | Error_Msg (Data.Flags, |
44e1918a | 2563 | "Externally_Built may only be true or false", |
e2d9085b | 2564 | Externally_Built.Location, Project); |
44e1918a AC |
2565 | end if; |
2566 | end if; | |
fbf5a39b | 2567 | |
68c3f02a VC |
2568 | -- A virtual project extending an externally built project is itself |
2569 | -- externally built. | |
2570 | ||
66713d62 AC |
2571 | if Project.Virtual and then Project.Extends /= No_Project then |
2572 | Project.Externally_Built := Project.Extends.Externally_Built; | |
68c3f02a VC |
2573 | end if; |
2574 | ||
3e582869 | 2575 | if Project.Externally_Built then |
2598ee6d | 2576 | Debug_Output ("project is externally built"); |
3e582869 | 2577 | else |
2598ee6d | 2578 | Debug_Output ("project is not externally built"); |
44e1918a AC |
2579 | end if; |
2580 | end Check_If_Externally_Built; | |
19235870 | 2581 | |
4f469be3 VC |
2582 | ---------------------- |
2583 | -- Check_Interfaces -- | |
2584 | ---------------------- | |
2585 | ||
2586 | procedure Check_Interfaces | |
2587 | (Project : Project_Id; | |
fdd7e7bb | 2588 | Data : in out Tree_Processing_Data) |
4f469be3 | 2589 | is |
40ecf2f5 EB |
2590 | Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; |
2591 | ||
4f469be3 VC |
2592 | Interfaces : constant Prj.Variable_Value := |
2593 | Prj.Util.Value_Of | |
2594 | (Snames.Name_Interfaces, | |
66713d62 | 2595 | Project.Decl.Attributes, |
40ecf2f5 | 2596 | Shared); |
4f469be3 | 2597 | |
226e989e | 2598 | Library_Interface : constant Prj.Variable_Value := |
d0995fa2 RD |
2599 | Prj.Util.Value_Of |
2600 | (Snames.Name_Library_Interface, | |
2601 | Project.Decl.Attributes, | |
40ecf2f5 | 2602 | Shared); |
226e989e | 2603 | |
481f29eb VC |
2604 | List : String_List_Id; |
2605 | Element : String_Element; | |
2606 | Name : File_Name_Type; | |
2607 | Iter : Source_Iterator; | |
2608 | Source : Source_Id; | |
4f469be3 | 2609 | Project_2 : Project_Id; |
c9287857 | 2610 | Other : Source_Id; |
4f469be3 VC |
2611 | |
2612 | begin | |
2613 | if not Interfaces.Default then | |
2614 | ||
2615 | -- Set In_Interfaces to False for all sources. It will be set to True | |
2616 | -- later for the sources in the Interfaces list. | |
2617 | ||
2618 | Project_2 := Project; | |
5eed512d | 2619 | while Project_2 /= No_Project loop |
fdd7e7bb | 2620 | Iter := For_Each_Source (Data.Tree, Project_2); |
5eed512d EB |
2621 | loop |
2622 | Source := Prj.Element (Iter); | |
2623 | exit when Source = No_Source; | |
5d07d0cf | 2624 | Source.In_Interfaces := False; |
5eed512d EB |
2625 | Next (Iter); |
2626 | end loop; | |
4f469be3 | 2627 | |
66713d62 | 2628 | Project_2 := Project_2.Extends; |
4f469be3 VC |
2629 | end loop; |
2630 | ||
2631 | List := Interfaces.Values; | |
2632 | while List /= Nil_String loop | |
40ecf2f5 | 2633 | Element := Shared.String_Elements.Table (List); |
347ab254 | 2634 | Name := Canonical_Case_File_Name (Element.Value); |
4f469be3 VC |
2635 | |
2636 | Project_2 := Project; | |
4f469be3 | 2637 | Big_Loop : |
5eed512d | 2638 | while Project_2 /= No_Project loop |
fdd7e7bb | 2639 | Iter := For_Each_Source (Data.Tree, Project_2); |
5eed512d EB |
2640 | |
2641 | loop | |
2642 | Source := Prj.Element (Iter); | |
2643 | exit when Source = No_Source; | |
2644 | ||
5d07d0cf EB |
2645 | if Source.File = Name then |
2646 | if not Source.Locally_Removed then | |
2647 | Source.In_Interfaces := True; | |
2648 | Source.Declared_In_Interfaces := True; | |
ecc4ddde | 2649 | |
c9287857 EB |
2650 | Other := Other_Part (Source); |
2651 | ||
2652 | if Other /= No_Source then | |
2653 | Other.In_Interfaces := True; | |
2654 | Other.Declared_In_Interfaces := True; | |
4f469be3 | 2655 | end if; |
4f469be3 | 2656 | |
3e582869 AC |
2657 | Debug_Output |
2658 | ("interface: ", Name_Id (Source.Path.Name)); | |
ecc4ddde | 2659 | end if; |
4f469be3 | 2660 | |
5d07d0cf EB |
2661 | exit Big_Loop; |
2662 | end if; | |
2663 | ||
2664 | Next (Iter); | |
4f469be3 VC |
2665 | end loop; |
2666 | ||
66713d62 | 2667 | Project_2 := Project_2.Extends; |
4f469be3 VC |
2668 | end loop Big_Loop; |
2669 | ||
2670 | if Source = No_Source then | |
2671 | Error_Msg_File_1 := File_Name_Type (Element.Value); | |
66713d62 | 2672 | Error_Msg_Name_1 := Project.Name; |
4f469be3 VC |
2673 | |
2674 | Error_Msg | |
e2d9085b | 2675 | (Data.Flags, |
b72d8ad5 AC |
2676 | "{ cannot be an interface of project %% " |
2677 | & "as it is not one of its sources", | |
e2d9085b | 2678 | Element.Location, Project); |
4f469be3 VC |
2679 | end if; |
2680 | ||
2681 | List := Element.Next; | |
2682 | end loop; | |
2683 | ||
66713d62 | 2684 | Project.Interfaces_Defined := True; |
4f469be3 | 2685 | |
226e989e | 2686 | elsif Project.Library and then not Library_Interface.Default then |
4f469be3 | 2687 | |
226e989e AC |
2688 | -- Set In_Interfaces to False for all sources. It will be set to True |
2689 | -- later for the sources in the Library_Interface list. | |
2690 | ||
2691 | Project_2 := Project; | |
2692 | while Project_2 /= No_Project loop | |
2693 | Iter := For_Each_Source (Data.Tree, Project_2); | |
5eed512d EB |
2694 | loop |
2695 | Source := Prj.Element (Iter); | |
2696 | exit when Source = No_Source; | |
226e989e | 2697 | Source.In_Interfaces := False; |
5eed512d | 2698 | Next (Iter); |
4f469be3 | 2699 | end loop; |
226e989e AC |
2700 | |
2701 | Project_2 := Project_2.Extends; | |
2702 | end loop; | |
2703 | ||
2704 | List := Library_Interface.Values; | |
2705 | while List /= Nil_String loop | |
40ecf2f5 | 2706 | Element := Shared.String_Elements.Table (List); |
226e989e AC |
2707 | Get_Name_String (Element.Value); |
2708 | To_Lower (Name_Buffer (1 .. Name_Len)); | |
2709 | Name := Name_Find; | |
2710 | ||
2711 | Project_2 := Project; | |
2712 | Big_Loop_2 : | |
2713 | while Project_2 /= No_Project loop | |
2714 | Iter := For_Each_Source (Data.Tree, Project_2); | |
2715 | ||
2716 | loop | |
2717 | Source := Prj.Element (Iter); | |
2718 | exit when Source = No_Source; | |
2719 | ||
2720 | if Source.Unit /= No_Unit_Index and then | |
2721 | Source.Unit.Name = Name_Id (Name) | |
2722 | then | |
2723 | if not Source.Locally_Removed then | |
2724 | Source.In_Interfaces := True; | |
2725 | Source.Declared_In_Interfaces := True; | |
2726 | ||
2727 | Other := Other_Part (Source); | |
2728 | ||
2729 | if Other /= No_Source then | |
2730 | Other.In_Interfaces := True; | |
2731 | Other.Declared_In_Interfaces := True; | |
2732 | end if; | |
2733 | ||
3e582869 AC |
2734 | Debug_Output |
2735 | ("interface: ", Name_Id (Source.Path.Name)); | |
226e989e AC |
2736 | end if; |
2737 | ||
2738 | exit Big_Loop_2; | |
2739 | end if; | |
2740 | ||
2741 | Next (Iter); | |
2742 | end loop; | |
2743 | ||
2744 | Project_2 := Project_2.Extends; | |
2745 | end loop Big_Loop_2; | |
2746 | ||
2747 | List := Element.Next; | |
2748 | end loop; | |
2749 | ||
2750 | Project.Interfaces_Defined := True; | |
2751 | ||
d0995fa2 RD |
2752 | elsif Project.Extends /= No_Project |
2753 | and then Project.Extends.Interfaces_Defined | |
226e989e AC |
2754 | then |
2755 | Project.Interfaces_Defined := True; | |
2756 | ||
2757 | Iter := For_Each_Source (Data.Tree, Project); | |
2758 | loop | |
2759 | Source := Prj.Element (Iter); | |
2760 | exit when Source = No_Source; | |
2761 | ||
2762 | if not Source.Declared_In_Interfaces then | |
2763 | Source.In_Interfaces := False; | |
2764 | end if; | |
2765 | ||
2766 | Next (Iter); | |
2767 | end loop; | |
4f469be3 VC |
2768 | end if; |
2769 | end Check_Interfaces; | |
2770 | ||
cf161d66 AC |
2771 | ------------------------------ |
2772 | -- Check_Library_Attributes -- | |
2773 | ------------------------------ | |
19235870 | 2774 | |
cf161d66 AC |
2775 | -- This procedure is awfully long (over 700 lines) should be broken up??? |
2776 | ||
2777 | procedure Check_Library_Attributes | |
c37845f8 | 2778 | (Project : Project_Id; |
602a7ec0 | 2779 | Data : in out Tree_Processing_Data) |
44e1918a | 2780 | is |
cf161d66 | 2781 | Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; |
b30668b7 | 2782 | |
cf161d66 | 2783 | Attributes : constant Prj.Variable_Id := Project.Decl.Attributes; |
347ab254 | 2784 | |
cf161d66 AC |
2785 | Lib_Dir : constant Prj.Variable_Value := |
2786 | Prj.Util.Value_Of | |
2787 | (Snames.Name_Library_Dir, Attributes, Shared); | |
347ab254 | 2788 | |
cf161d66 AC |
2789 | Lib_Name : constant Prj.Variable_Value := |
2790 | Prj.Util.Value_Of | |
2791 | (Snames.Name_Library_Name, Attributes, Shared); | |
347ab254 | 2792 | |
cf161d66 AC |
2793 | Lib_Version : constant Prj.Variable_Value := |
2794 | Prj.Util.Value_Of | |
2795 | (Snames.Name_Library_Version, Attributes, Shared); | |
39d4e04a | 2796 | |
cf161d66 AC |
2797 | Lib_ALI_Dir : constant Prj.Variable_Value := |
2798 | Prj.Util.Value_Of | |
2799 | (Snames.Name_Library_Ali_Dir, Attributes, Shared); | |
fadcf313 | 2800 | |
cf161d66 AC |
2801 | Lib_GCC : constant Prj.Variable_Value := |
2802 | Prj.Util.Value_Of | |
2803 | (Snames.Name_Library_GCC, Attributes, Shared); | |
347ab254 | 2804 | |
cf161d66 AC |
2805 | The_Lib_Kind : constant Prj.Variable_Value := |
2806 | Prj.Util.Value_Of | |
2807 | (Snames.Name_Library_Kind, Attributes, Shared); | |
b30668b7 | 2808 | |
cf161d66 | 2809 | Imported_Project_List : Project_List; |
d9c0e057 | 2810 | |
cf161d66 | 2811 | Continuation : String_Access := No_Continuation_String'Access; |
d9c0e057 | 2812 | |
cf161d66 | 2813 | Support_For_Libraries : Library_Support; |
b30668b7 | 2814 | |
cf161d66 | 2815 | Library_Directory_Present : Boolean; |
b30668b7 | 2816 | |
cf161d66 AC |
2817 | procedure Check_Library (Proj : Project_Id; Extends : Boolean); |
2818 | -- Check if an imported or extended project if also a library project | |
d9c0e057 | 2819 | |
cf161d66 AC |
2820 | ------------------- |
2821 | -- Check_Library -- | |
2822 | ------------------- | |
347ab254 | 2823 | |
cf161d66 AC |
2824 | procedure Check_Library (Proj : Project_Id; Extends : Boolean) is |
2825 | Src_Id : Source_Id; | |
2826 | Iter : Source_Iterator; | |
b30668b7 | 2827 | |
cf161d66 AC |
2828 | begin |
2829 | if Proj /= No_Project then | |
2830 | if not Proj.Library then | |
b30668b7 | 2831 | |
cf161d66 AC |
2832 | -- The only not library projects that are OK are those that |
2833 | -- have no sources. However, header files from non-Ada | |
2834 | -- languages are OK, as there is nothing to compile. | |
b30668b7 | 2835 | |
cf161d66 AC |
2836 | Iter := For_Each_Source (Data.Tree, Proj); |
2837 | loop | |
2838 | Src_Id := Prj.Element (Iter); | |
2839 | exit when Src_Id = No_Source | |
2840 | or else Src_Id.Language.Config.Kind /= File_Based | |
2841 | or else Src_Id.Kind /= Spec; | |
2842 | Next (Iter); | |
2843 | end loop; | |
b30668b7 | 2844 | |
cf161d66 AC |
2845 | if Src_Id /= No_Source then |
2846 | Error_Msg_Name_1 := Project.Name; | |
2847 | Error_Msg_Name_2 := Proj.Name; | |
f6cf5b85 | 2848 | |
cf161d66 AC |
2849 | if Extends then |
2850 | if Project.Library_Kind /= Static then | |
2851 | Error_Msg | |
2852 | (Data.Flags, | |
2853 | Continuation.all & | |
2854 | "shared library project %% cannot extend " & | |
2855 | "project %% that is not a library project", | |
2856 | Project.Location, Project); | |
2857 | Continuation := Continuation_String'Access; | |
2858 | end if; | |
2859 | ||
2860 | elsif (not Unchecked_Shared_Lib_Imports) | |
2861 | and then Project.Library_Kind /= Static | |
2862 | then | |
2863 | Error_Msg | |
2864 | (Data.Flags, | |
2865 | Continuation.all & | |
2866 | "shared library project %% cannot import project %% " & | |
2867 | "that is not a shared library project", | |
2868 | Project.Location, Project); | |
2869 | Continuation := Continuation_String'Access; | |
2870 | end if; | |
347ab254 EB |
2871 | end if; |
2872 | ||
cf161d66 AC |
2873 | elsif Project.Library_Kind /= Static and then |
2874 | Proj.Library_Kind = Static | |
2875 | then | |
2876 | Error_Msg_Name_1 := Project.Name; | |
2877 | Error_Msg_Name_2 := Proj.Name; | |
347ab254 | 2878 | |
cf161d66 | 2879 | if Extends then |
347ab254 | 2880 | Error_Msg |
e2d9085b | 2881 | (Data.Flags, |
cf161d66 AC |
2882 | Continuation.all & |
2883 | "shared library project %% cannot extend static " & | |
2884 | "library project %%", | |
2885 | Project.Location, Project); | |
2886 | Continuation := Continuation_String'Access; | |
2887 | ||
2888 | elsif not Unchecked_Shared_Lib_Imports then | |
2889 | Error_Msg | |
2890 | (Data.Flags, | |
2891 | Continuation.all & | |
2892 | "shared library project %% cannot import static " & | |
2893 | "library project %%", | |
2894 | Project.Location, Project); | |
2895 | Continuation := Continuation_String'Access; | |
2896 | end if; | |
2897 | ||
2898 | end if; | |
347ab254 | 2899 | end if; |
cf161d66 | 2900 | end Check_Library; |
347ab254 | 2901 | |
cf161d66 | 2902 | Dir_Exists : Boolean; |
347ab254 | 2903 | |
cf161d66 AC |
2904 | -- Start of processing for Check_Library_Attributes |
2905 | ||
2906 | begin | |
2907 | Library_Directory_Present := Lib_Dir.Value /= Empty_String; | |
2908 | ||
2909 | -- Special case of extending project | |
2910 | ||
2911 | if Project.Extends /= No_Project then | |
2912 | ||
2913 | -- If the project extended is a library project, we inherit the | |
2914 | -- library name, if it is not redefined; we check that the library | |
2915 | -- directory is specified. | |
2916 | ||
2917 | if Project.Extends.Library then | |
2918 | if Project.Qualifier = Standard then | |
44e1918a | 2919 | Error_Msg |
e2d9085b | 2920 | (Data.Flags, |
cf161d66 AC |
2921 | "a standard project cannot extend a library project", |
2922 | Project.Location, Project); | |
b30668b7 | 2923 | |
44e1918a | 2924 | else |
cf161d66 AC |
2925 | if Lib_Name.Default then |
2926 | Project.Library_Name := Project.Extends.Library_Name; | |
2927 | end if; | |
d9c0e057 | 2928 | |
cf161d66 AC |
2929 | if Lib_Dir.Default then |
2930 | if not Project.Virtual then | |
2931 | Error_Msg | |
2932 | (Data.Flags, | |
2933 | "a project extending a library project must " & | |
2934 | "specify an attribute Library_Dir", | |
2935 | Project.Location, Project); | |
2936 | ||
2937 | else | |
2938 | -- For a virtual project extending a library project, | |
2939 | -- inherit library directory and library kind. | |
2940 | ||
2941 | Project.Library_Dir := Project.Extends.Library_Dir; | |
2942 | Library_Directory_Present := True; | |
2943 | Project.Library_Kind := Project.Extends.Library_Kind; | |
2944 | end if; | |
2945 | end if; | |
44e1918a | 2946 | end if; |
347ab254 | 2947 | end if; |
cf161d66 | 2948 | end if; |
fbf5a39b | 2949 | |
cf161d66 AC |
2950 | pragma Assert (Lib_Name.Kind = Single); |
2951 | ||
2952 | if Lib_Name.Value = Empty_String then | |
2953 | if Current_Verbosity = High | |
2954 | and then Project.Library_Name = No_Name | |
2955 | then | |
2956 | Debug_Indent; | |
2957 | Write_Line ("no library name"); | |
347ab254 | 2958 | end if; |
b30668b7 | 2959 | |
cf161d66 AC |
2960 | else |
2961 | -- There is no restriction on the syntax of library names | |
b30668b7 | 2962 | |
cf161d66 AC |
2963 | Project.Library_Name := Lib_Name.Value; |
2964 | end if; | |
10d2a6f7 | 2965 | |
cf161d66 AC |
2966 | if Project.Library_Name /= No_Name then |
2967 | if Current_Verbosity = High then | |
86828d40 AC |
2968 | Write_Attr |
2969 | ("Library name: ", Get_Name_String (Project.Library_Name)); | |
cf161d66 | 2970 | end if; |
b30668b7 | 2971 | |
cf161d66 | 2972 | pragma Assert (Lib_Dir.Kind = Single); |
ede007da | 2973 | |
cf161d66 AC |
2974 | if not Library_Directory_Present then |
2975 | Debug_Output ("no library directory"); | |
5453d5bd | 2976 | |
cf161d66 AC |
2977 | else |
2978 | -- Find path name (unless inherited), check that it is a directory | |
fbf5a39b | 2979 | |
cf161d66 AC |
2980 | if Project.Library_Dir = No_Path_Information then |
2981 | Locate_Directory | |
2982 | (Project, | |
2983 | File_Name_Type (Lib_Dir.Value), | |
2984 | Path => Project.Library_Dir, | |
2985 | Dir_Exists => Dir_Exists, | |
2986 | Data => Data, | |
2987 | Create => "library", | |
2988 | Must_Exist => False, | |
2989 | Location => Lib_Dir.Location, | |
2990 | Externally_Built => Project.Externally_Built); | |
ede007da | 2991 | |
cf161d66 AC |
2992 | else |
2993 | Dir_Exists := | |
2994 | Is_Directory | |
2995 | (Get_Name_String (Project.Library_Dir.Display_Name)); | |
2996 | end if; | |
b30668b7 | 2997 | |
cf161d66 | 2998 | if not Dir_Exists then |
ede007da | 2999 | |
cf161d66 AC |
3000 | -- Get the absolute name of the library directory that |
3001 | -- does not exist, to report an error. | |
ede007da | 3002 | |
cf161d66 AC |
3003 | Err_Vars.Error_Msg_File_1 := |
3004 | File_Name_Type (Project.Library_Dir.Display_Name); | |
9b20e59b AC |
3005 | Error_Msg |
3006 | (Data.Flags, | |
cf161d66 AC |
3007 | "library directory { does not exist", |
3008 | Lib_Dir.Location, Project); | |
ede007da | 3009 | |
cf161d66 | 3010 | elsif not Project.Externally_Built then |
10d2a6f7 | 3011 | |
cf161d66 | 3012 | -- Library directory cannot be the same as Object directory |
ede007da | 3013 | |
cf161d66 AC |
3014 | if Project.Library_Dir.Name = Project.Object_Directory.Name then |
3015 | Error_Msg | |
3016 | (Data.Flags, | |
3017 | "library directory cannot be the same " & | |
3018 | "as object directory", | |
3019 | Lib_Dir.Location, Project); | |
3020 | Project.Library_Dir := No_Path_Information; | |
ede007da | 3021 | |
cf161d66 AC |
3022 | else |
3023 | declare | |
3024 | OK : Boolean := True; | |
3025 | Dirs_Id : String_List_Id; | |
3026 | Dir_Elem : String_Element; | |
3027 | Pid : Project_List; | |
ede007da | 3028 | |
cf161d66 AC |
3029 | begin |
3030 | -- The library directory cannot be the same as a source | |
3031 | -- directory of the current project. | |
ede007da | 3032 | |
cf161d66 AC |
3033 | Dirs_Id := Project.Source_Dirs; |
3034 | while Dirs_Id /= Nil_String loop | |
3035 | Dir_Elem := Shared.String_Elements.Table (Dirs_Id); | |
3036 | Dirs_Id := Dir_Elem.Next; | |
ede007da | 3037 | |
cf161d66 AC |
3038 | if Project.Library_Dir.Name = |
3039 | Path_Name_Type (Dir_Elem.Value) | |
3040 | then | |
3041 | Err_Vars.Error_Msg_File_1 := | |
3042 | File_Name_Type (Dir_Elem.Value); | |
3043 | Error_Msg | |
3044 | (Data.Flags, | |
3045 | "library directory cannot be the same " & | |
3046 | "as source directory {", | |
3047 | Lib_Dir.Location, Project); | |
3048 | OK := False; | |
3049 | exit; | |
3050 | end if; | |
3051 | end loop; | |
ede007da | 3052 | |
cf161d66 | 3053 | if OK then |
ede007da | 3054 | |
cf161d66 AC |
3055 | -- The library directory cannot be the same as a |
3056 | -- source directory of another project either. | |
1b685674 | 3057 | |
cf161d66 AC |
3058 | Pid := Data.Tree.Projects; |
3059 | Project_Loop : loop | |
3060 | exit Project_Loop when Pid = null; | |
ede007da | 3061 | |
cf161d66 AC |
3062 | if Pid.Project /= Project then |
3063 | Dirs_Id := Pid.Project.Source_Dirs; | |
ede007da | 3064 | |
cf161d66 AC |
3065 | Dir_Loop : while Dirs_Id /= Nil_String loop |
3066 | Dir_Elem := | |
3067 | Shared.String_Elements.Table (Dirs_Id); | |
3068 | Dirs_Id := Dir_Elem.Next; | |
fc2c32e2 | 3069 | |
cf161d66 AC |
3070 | if Project.Library_Dir.Name = |
3071 | Path_Name_Type (Dir_Elem.Value) | |
3072 | then | |
3073 | Err_Vars.Error_Msg_File_1 := | |
3074 | File_Name_Type (Dir_Elem.Value); | |
3075 | Err_Vars.Error_Msg_Name_1 := | |
3076 | Pid.Project.Name; | |
fc2c32e2 | 3077 | |
cf161d66 AC |
3078 | Error_Msg |
3079 | (Data.Flags, | |
3080 | "library directory cannot be the same" & | |
3081 | " as source directory { of project %%", | |
3082 | Lib_Dir.Location, Project); | |
3083 | OK := False; | |
3084 | exit Project_Loop; | |
3085 | end if; | |
3086 | end loop Dir_Loop; | |
3087 | end if; | |
ede007da | 3088 | |
cf161d66 AC |
3089 | Pid := Pid.Next; |
3090 | end loop Project_Loop; | |
3091 | end if; | |
ede007da | 3092 | |
cf161d66 AC |
3093 | if not OK then |
3094 | Project.Library_Dir := No_Path_Information; | |
ede007da | 3095 | |
cf161d66 AC |
3096 | elsif Current_Verbosity = High then |
3097 | ||
3098 | -- Display the Library directory in high verbosity | |
3099 | ||
3100 | Write_Attr | |
3101 | ("Library directory", | |
3102 | Get_Name_String (Project.Library_Dir.Display_Name)); | |
3103 | end if; | |
3104 | end; | |
3105 | end if; | |
39d4e04a | 3106 | end if; |
cf161d66 | 3107 | end if; |
ede007da | 3108 | |
cf161d66 | 3109 | end if; |
fc2c32e2 | 3110 | |
cf161d66 AC |
3111 | Project.Library := |
3112 | Project.Library_Dir /= No_Path_Information | |
86828d40 | 3113 | and then Project.Library_Name /= No_Name; |
fc2c32e2 | 3114 | |
cf161d66 AC |
3115 | if Project.Extends = No_Project then |
3116 | case Project.Qualifier is | |
3117 | when Standard => | |
3118 | if Project.Library then | |
3119 | Error_Msg | |
3120 | (Data.Flags, | |
3121 | "a standard project cannot be a library project", | |
3122 | Lib_Name.Location, Project); | |
fc2c32e2 EB |
3123 | end if; |
3124 | ||
cf161d66 AC |
3125 | when Library => |
3126 | if not Project.Library then | |
3127 | if Project.Library_Name = No_Name then | |
3128 | Error_Msg | |
3129 | (Data.Flags, | |
3130 | "attribute Library_Name not declared", | |
3131 | Project.Location, Project); | |
fc2c32e2 | 3132 | |
cf161d66 AC |
3133 | if not Library_Directory_Present then |
3134 | Error_Msg | |
3135 | (Data.Flags, | |
3136 | "\attribute Library_Dir not declared", | |
3137 | Project.Location, Project); | |
3138 | end if; | |
fc2c32e2 | 3139 | |
cf161d66 AC |
3140 | elsif Project.Library_Dir = No_Path_Information then |
3141 | Error_Msg | |
3142 | (Data.Flags, | |
3143 | "attribute Library_Dir not declared", | |
3144 | Project.Location, Project); | |
3145 | end if; | |
3146 | end if; | |
fc2c32e2 | 3147 | |
cf161d66 AC |
3148 | when others => |
3149 | null; | |
fc2c32e2 | 3150 | |
cf161d66 AC |
3151 | end case; |
3152 | end if; | |
ede007da | 3153 | |
cf161d66 AC |
3154 | if Project.Library then |
3155 | Support_For_Libraries := Project.Config.Lib_Support; | |
d9c0e057 | 3156 | |
cf161d66 AC |
3157 | if Support_For_Libraries = Prj.None then |
3158 | Error_Msg | |
3159 | (Data.Flags, | |
3160 | "?libraries are not supported on this platform", | |
3161 | Lib_Name.Location, Project); | |
3162 | Project.Library := False; | |
ede007da | 3163 | |
cf161d66 AC |
3164 | else |
3165 | if Lib_ALI_Dir.Value = Empty_String then | |
3166 | Debug_Output ("no library ALI directory specified"); | |
3167 | Project.Library_ALI_Dir := Project.Library_Dir; | |
347ab254 | 3168 | |
cf161d66 AC |
3169 | else |
3170 | -- Find path name, check that it is a directory | |
ede007da | 3171 | |
cf161d66 AC |
3172 | Locate_Directory |
3173 | (Project, | |
3174 | File_Name_Type (Lib_ALI_Dir.Value), | |
3175 | Path => Project.Library_ALI_Dir, | |
3176 | Create => "library ALI", | |
3177 | Dir_Exists => Dir_Exists, | |
3178 | Data => Data, | |
3179 | Must_Exist => False, | |
3180 | Location => Lib_ALI_Dir.Location, | |
3181 | Externally_Built => Project.Externally_Built); | |
ede007da | 3182 | |
cf161d66 | 3183 | if not Dir_Exists then |
ede007da | 3184 | |
cf161d66 AC |
3185 | -- Get the absolute name of the library ALI directory that |
3186 | -- does not exist, to report an error. | |
fadcf313 | 3187 | |
cf161d66 AC |
3188 | Err_Vars.Error_Msg_File_1 := |
3189 | File_Name_Type (Project.Library_ALI_Dir.Display_Name); | |
3190 | Error_Msg | |
3191 | (Data.Flags, | |
3192 | "library 'A'L'I directory { does not exist", | |
3193 | Lib_ALI_Dir.Location, Project); | |
3194 | end if; | |
85686ad9 | 3195 | |
cf161d66 AC |
3196 | if (not Project.Externally_Built) and then |
3197 | Project.Library_ALI_Dir /= Project.Library_Dir | |
3198 | then | |
3199 | -- The library ALI directory cannot be the same as the | |
3200 | -- Object directory. | |
85686ad9 | 3201 | |
cf161d66 AC |
3202 | if Project.Library_ALI_Dir = Project.Object_Directory then |
3203 | Error_Msg | |
3204 | (Data.Flags, | |
3205 | "library 'A'L'I directory cannot be the same " & | |
3206 | "as object directory", | |
3207 | Lib_ALI_Dir.Location, Project); | |
3208 | Project.Library_ALI_Dir := No_Path_Information; | |
fadcf313 | 3209 | |
cf161d66 AC |
3210 | else |
3211 | declare | |
3212 | OK : Boolean := True; | |
3213 | Dirs_Id : String_List_Id; | |
3214 | Dir_Elem : String_Element; | |
3215 | Pid : Project_List; | |
fadcf313 | 3216 | |
cf161d66 AC |
3217 | begin |
3218 | -- The library ALI directory cannot be the same as | |
3219 | -- a source directory of the current project. | |
fadcf313 | 3220 | |
cf161d66 AC |
3221 | Dirs_Id := Project.Source_Dirs; |
3222 | while Dirs_Id /= Nil_String loop | |
3223 | Dir_Elem := Shared.String_Elements.Table (Dirs_Id); | |
3224 | Dirs_Id := Dir_Elem.Next; | |
54ecb428 | 3225 | |
cf161d66 AC |
3226 | if Project.Library_ALI_Dir.Name = |
3227 | Path_Name_Type (Dir_Elem.Value) | |
3228 | then | |
3229 | Err_Vars.Error_Msg_File_1 := | |
3230 | File_Name_Type (Dir_Elem.Value); | |
3231 | Error_Msg | |
3232 | (Data.Flags, | |
3233 | "library 'A'L'I directory cannot be " & | |
3234 | "the same as source directory {", | |
3235 | Lib_ALI_Dir.Location, Project); | |
3236 | OK := False; | |
3237 | exit; | |
3238 | end if; | |
3239 | end loop; | |
54ecb428 | 3240 | |
cf161d66 | 3241 | if OK then |
54ecb428 | 3242 | |
cf161d66 AC |
3243 | -- The library ALI directory cannot be the same as |
3244 | -- a source directory of another project either. | |
54ecb428 | 3245 | |
cf161d66 AC |
3246 | Pid := Data.Tree.Projects; |
3247 | ALI_Project_Loop : loop | |
3248 | exit ALI_Project_Loop when Pid = null; | |
54ecb428 | 3249 | |
cf161d66 AC |
3250 | if Pid.Project /= Project then |
3251 | Dirs_Id := Pid.Project.Source_Dirs; | |
32404665 | 3252 | |
cf161d66 AC |
3253 | ALI_Dir_Loop : |
3254 | while Dirs_Id /= Nil_String loop | |
3255 | Dir_Elem := | |
3256 | Shared.String_Elements.Table (Dirs_Id); | |
3257 | Dirs_Id := Dir_Elem.Next; | |
fadcf313 | 3258 | |
cf161d66 AC |
3259 | if Project.Library_ALI_Dir.Name = |
3260 | Path_Name_Type (Dir_Elem.Value) | |
3261 | then | |
3262 | Err_Vars.Error_Msg_File_1 := | |
3263 | File_Name_Type (Dir_Elem.Value); | |
3264 | Err_Vars.Error_Msg_Name_1 := | |
3265 | Pid.Project.Name; | |
fadcf313 | 3266 | |
cf161d66 AC |
3267 | Error_Msg |
3268 | (Data.Flags, | |
3269 | "library 'A'L'I directory cannot " & | |
3270 | "be the same as source directory " & | |
3271 | "{ of project %%", | |
3272 | Lib_ALI_Dir.Location, Project); | |
3273 | OK := False; | |
3274 | exit ALI_Project_Loop; | |
3275 | end if; | |
3276 | end loop ALI_Dir_Loop; | |
3277 | end if; | |
3278 | Pid := Pid.Next; | |
3279 | end loop ALI_Project_Loop; | |
3280 | end if; | |
fadcf313 | 3281 | |
cf161d66 AC |
3282 | if not OK then |
3283 | Project.Library_ALI_Dir := No_Path_Information; | |
fadcf313 | 3284 | |
cf161d66 | 3285 | elsif Current_Verbosity = High then |
fadcf313 | 3286 | |
cf161d66 | 3287 | -- Display Library ALI directory in high verbosity |
fadcf313 | 3288 | |
cf161d66 AC |
3289 | Write_Attr |
3290 | ("Library ALI dir", | |
3291 | Get_Name_String | |
3292 | (Project.Library_ALI_Dir.Display_Name)); | |
3293 | end if; | |
3294 | end; | |
3295 | end if; | |
fadcf313 AC |
3296 | end if; |
3297 | end if; | |
3298 | ||
cf161d66 | 3299 | pragma Assert (Lib_Version.Kind = Single); |
d9c0e057 | 3300 | |
cf161d66 AC |
3301 | if Lib_Version.Value = Empty_String then |
3302 | Debug_Output ("no library version specified"); | |
b30668b7 | 3303 | |
cf161d66 AC |
3304 | else |
3305 | Project.Lib_Internal_Name := Lib_Version.Value; | |
3306 | end if; | |
fbf5a39b | 3307 | |
cf161d66 | 3308 | pragma Assert (The_Lib_Kind.Kind = Single); |
40ecf2f5 | 3309 | |
cf161d66 AC |
3310 | if The_Lib_Kind.Value = Empty_String then |
3311 | Debug_Output ("no library kind specified"); | |
fbf5a39b | 3312 | |
cf161d66 AC |
3313 | else |
3314 | Get_Name_String (The_Lib_Kind.Value); | |
fbf5a39b | 3315 | |
cf161d66 AC |
3316 | declare |
3317 | Kind_Name : constant String := | |
3318 | To_Lower (Name_Buffer (1 .. Name_Len)); | |
fbf5a39b | 3319 | |
cf161d66 | 3320 | OK : Boolean := True; |
fbf5a39b | 3321 | |
cf161d66 AC |
3322 | begin |
3323 | if Kind_Name = "static" then | |
3324 | Project.Library_Kind := Static; | |
104e4daa | 3325 | |
cf161d66 AC |
3326 | elsif Kind_Name = "dynamic" then |
3327 | Project.Library_Kind := Dynamic; | |
3568b271 | 3328 | |
cf161d66 AC |
3329 | elsif Kind_Name = "relocatable" then |
3330 | Project.Library_Kind := Relocatable; | |
fbf5a39b | 3331 | |
cf161d66 AC |
3332 | else |
3333 | Error_Msg | |
3334 | (Data.Flags, | |
3335 | "illegal value for Library_Kind", | |
3336 | The_Lib_Kind.Location, Project); | |
3337 | OK := False; | |
3338 | end if; | |
ede007da | 3339 | |
cf161d66 AC |
3340 | if Current_Verbosity = High and then OK then |
3341 | Write_Attr ("Library kind", Kind_Name); | |
3342 | end if; | |
ede007da | 3343 | |
cf161d66 AC |
3344 | if Project.Library_Kind /= Static then |
3345 | if Support_For_Libraries = Prj.Static_Only then | |
3346 | Error_Msg | |
3347 | (Data.Flags, | |
3348 | "only static libraries are supported " & | |
3349 | "on this platform", | |
3350 | The_Lib_Kind.Location, Project); | |
3351 | Project.Library := False; | |
ede007da | 3352 | |
cf161d66 AC |
3353 | else |
3354 | -- Check if (obsolescent) attribute Library_GCC or | |
3355 | -- Linker'Driver is declared. | |
68c3f02a | 3356 | |
cf161d66 AC |
3357 | if Lib_GCC.Value /= Empty_String then |
3358 | Error_Msg | |
3359 | (Data.Flags, | |
3360 | "?Library_'G'C'C is an obsolescent attribute, " & | |
3361 | "use Linker''Driver instead", | |
3362 | Lib_GCC.Location, Project); | |
3363 | Project.Config.Shared_Lib_Driver := | |
3364 | File_Name_Type (Lib_GCC.Value); | |
ede007da | 3365 | |
cf161d66 AC |
3366 | else |
3367 | declare | |
3368 | Linker : constant Package_Id := | |
3369 | Value_Of | |
3370 | (Name_Linker, | |
3371 | Project.Decl.Packages, | |
3372 | Shared); | |
3373 | Driver : constant Variable_Value := | |
3374 | Value_Of | |
3375 | (Name => No_Name, | |
3376 | Attribute_Or_Array_Name => | |
3377 | Name_Driver, | |
3378 | In_Package => Linker, | |
3379 | Shared => Shared); | |
ede007da | 3380 | |
cf161d66 AC |
3381 | begin |
3382 | if Driver /= Nil_Variable_Value | |
3383 | and then Driver.Value /= Empty_String | |
3384 | then | |
3385 | Project.Config.Shared_Lib_Driver := | |
3386 | File_Name_Type (Driver.Value); | |
3387 | end if; | |
3388 | end; | |
3389 | end if; | |
3390 | end if; | |
3391 | end if; | |
3392 | end; | |
3393 | end if; | |
ede007da | 3394 | |
5415acbd AC |
3395 | if Project.Library |
3396 | and then Project.Qualifier /= Aggregate_Library | |
3397 | then | |
cf161d66 | 3398 | Debug_Output ("this is a library project file"); |
68c3f02a | 3399 | |
cf161d66 | 3400 | Check_Library (Project.Extends, Extends => True); |
68c3f02a | 3401 | |
cf161d66 AC |
3402 | Imported_Project_List := Project.Imported_Projects; |
3403 | while Imported_Project_List /= null loop | |
3404 | Check_Library | |
3405 | (Imported_Project_List.Project, | |
3406 | Extends => False); | |
3407 | Imported_Project_List := Imported_Project_List.Next; | |
68c3f02a | 3408 | end loop; |
cf161d66 | 3409 | end if; |
68c3f02a | 3410 | |
cf161d66 AC |
3411 | end if; |
3412 | end if; | |
ede007da | 3413 | |
cf161d66 AC |
3414 | -- Check if Linker'Switches or Linker'Default_Switches are declared. |
3415 | -- Warn if they are declared, as it is a common error to think that | |
3416 | -- library are "linked" with Linker switches. | |
ede007da | 3417 | |
cf161d66 AC |
3418 | if Project.Library then |
3419 | declare | |
3420 | Linker_Package_Id : constant Package_Id := | |
3421 | Util.Value_Of | |
3422 | (Name_Linker, | |
3423 | Project.Decl.Packages, Shared); | |
3424 | Linker_Package : Package_Element; | |
3425 | Switches : Array_Element_Id := No_Array_Element; | |
ede007da | 3426 | |
cf161d66 AC |
3427 | begin |
3428 | if Linker_Package_Id /= No_Package then | |
3429 | Linker_Package := Shared.Packages.Table (Linker_Package_Id); | |
ede007da | 3430 | |
cf161d66 AC |
3431 | Switches := |
3432 | Value_Of | |
3433 | (Name => Name_Switches, | |
3434 | In_Arrays => Linker_Package.Decl.Arrays, | |
3435 | Shared => Shared); | |
ede007da | 3436 | |
cf161d66 AC |
3437 | if Switches = No_Array_Element then |
3438 | Switches := | |
3439 | Value_Of | |
3440 | (Name => Name_Default_Switches, | |
3441 | In_Arrays => Linker_Package.Decl.Arrays, | |
3442 | Shared => Shared); | |
3443 | end if; | |
3444 | ||
3445 | if Switches /= No_Array_Element then | |
ede007da | 3446 | Error_Msg |
e2d9085b | 3447 | (Data.Flags, |
cf161d66 AC |
3448 | "?Linker switches not taken into account in library " & |
3449 | "projects", | |
3450 | No_Location, Project); | |
ede007da | 3451 | end if; |
ede007da | 3452 | end if; |
cf161d66 AC |
3453 | end; |
3454 | end if; | |
3249690d | 3455 | |
cf161d66 | 3456 | if Project.Extends /= No_Project and then Project.Extends.Library then |
1b685674 | 3457 | |
cf161d66 | 3458 | -- Remove the library name from Lib_Data_Table |
68c3f02a | 3459 | |
cf161d66 AC |
3460 | for J in 1 .. Lib_Data_Table.Last loop |
3461 | if Lib_Data_Table.Table (J).Proj = Project.Extends then | |
3462 | Lib_Data_Table.Table (J) := | |
3463 | Lib_Data_Table.Table (Lib_Data_Table.Last); | |
3464 | Lib_Data_Table.Set_Last (Lib_Data_Table.Last - 1); | |
3465 | exit; | |
3466 | end if; | |
3467 | end loop; | |
3468 | end if; | |
19f0526a | 3469 | |
cf161d66 | 3470 | if Project.Library and then not Lib_Name.Default then |
132410cb | 3471 | |
cf161d66 | 3472 | -- Check if the same library name is used in an other library project |
44e1918a | 3473 | |
cf161d66 AC |
3474 | for J in 1 .. Lib_Data_Table.Last loop |
3475 | if Lib_Data_Table.Table (J).Name = Project.Library_Name then | |
3476 | Error_Msg_Name_1 := Lib_Data_Table.Table (J).Proj.Name; | |
66713d62 | 3477 | Error_Msg |
e2d9085b | 3478 | (Data.Flags, |
cf161d66 AC |
3479 | "Library name cannot be the same as in project %%", |
3480 | Lib_Name.Location, Project); | |
3481 | Project.Library := False; | |
3482 | exit; | |
3483 | end if; | |
3484 | end loop; | |
3485 | end if; | |
68c3f02a | 3486 | |
cf161d66 | 3487 | if Project.Library then |
68c3f02a | 3488 | |
cf161d66 | 3489 | -- Record the library name |
68c3f02a | 3490 | |
cf161d66 AC |
3491 | Lib_Data_Table.Append |
3492 | ((Name => Project.Library_Name, Proj => Project)); | |
44e1918a | 3493 | end if; |
cf161d66 | 3494 | end Check_Library_Attributes; |
19f0526a | 3495 | |
cf161d66 AC |
3496 | -------------------------- |
3497 | -- Check_Package_Naming -- | |
3498 | -------------------------- | |
19f0526a | 3499 | |
cf161d66 AC |
3500 | procedure Check_Package_Naming |
3501 | (Project : Project_Id; | |
3502 | Data : in out Tree_Processing_Data) | |
3503 | is | |
3504 | Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; | |
3505 | Naming_Id : constant Package_Id := | |
3506 | Util.Value_Of | |
3507 | (Name_Naming, Project.Decl.Packages, Shared); | |
3508 | Naming : Package_Element; | |
fbf5a39b | 3509 | |
cf161d66 | 3510 | Ada_Body_Suffix_Loc : Source_Ptr := No_Location; |
fbf5a39b | 3511 | |
cf161d66 AC |
3512 | procedure Check_Naming; |
3513 | -- Check the validity of the Naming package (suffixes valid, ...) | |
fbf5a39b | 3514 | |
cf161d66 AC |
3515 | procedure Check_Common |
3516 | (Dot_Replacement : in out File_Name_Type; | |
3517 | Casing : in out Casing_Type; | |
3518 | Casing_Defined : out Boolean; | |
3519 | Separate_Suffix : in out File_Name_Type; | |
3520 | Sep_Suffix_Loc : out Source_Ptr); | |
3521 | -- Check attributes common | |
fbf5a39b | 3522 | |
cf161d66 AC |
3523 | procedure Process_Exceptions_File_Based |
3524 | (Lang_Id : Language_Ptr; | |
3525 | Kind : Source_Kind); | |
3526 | procedure Process_Exceptions_Unit_Based | |
3527 | (Lang_Id : Language_Ptr; | |
3528 | Kind : Source_Kind); | |
3529 | -- Process the naming exceptions for the two types of languages | |
fbf5a39b | 3530 | |
cf161d66 AC |
3531 | procedure Initialize_Naming_Data; |
3532 | -- Initialize internal naming data for the various languages | |
fbf5a39b | 3533 | |
cf161d66 AC |
3534 | ------------------ |
3535 | -- Check_Common -- | |
3536 | ------------------ | |
44e1918a | 3537 | |
cf161d66 AC |
3538 | procedure Check_Common |
3539 | (Dot_Replacement : in out File_Name_Type; | |
3540 | Casing : in out Casing_Type; | |
3541 | Casing_Defined : out Boolean; | |
3542 | Separate_Suffix : in out File_Name_Type; | |
3543 | Sep_Suffix_Loc : out Source_Ptr) | |
3544 | is | |
3545 | Dot_Repl : constant Variable_Value := | |
3546 | Util.Value_Of | |
3547 | (Name_Dot_Replacement, | |
3548 | Naming.Decl.Attributes, | |
3549 | Shared); | |
3550 | Casing_String : constant Variable_Value := | |
3551 | Util.Value_Of | |
3552 | (Name_Casing, | |
3553 | Naming.Decl.Attributes, | |
3554 | Shared); | |
3555 | Sep_Suffix : constant Variable_Value := | |
3556 | Util.Value_Of | |
3557 | (Name_Separate_Suffix, | |
3558 | Naming.Decl.Attributes, | |
3559 | Shared); | |
3560 | Dot_Repl_Loc : Source_Ptr; | |
44e1918a | 3561 | |
cf161d66 AC |
3562 | begin |
3563 | Sep_Suffix_Loc := No_Location; | |
3564 | ||
3565 | if not Dot_Repl.Default then | |
3566 | pragma Assert | |
3567 | (Dot_Repl.Kind = Single, "Dot_Replacement is not a string"); | |
3568 | ||
3569 | if Length_Of_Name (Dot_Repl.Value) = 0 then | |
3570 | Error_Msg | |
3571 | (Data.Flags, "Dot_Replacement cannot be empty", | |
3572 | Dot_Repl.Location, Project); | |
3249690d | 3573 | end if; |
fbf5a39b | 3574 | |
cf161d66 AC |
3575 | Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value); |
3576 | Dot_Repl_Loc := Dot_Repl.Location; | |
f6cf5b85 | 3577 | |
cf161d66 AC |
3578 | declare |
3579 | Repl : constant String := Get_Name_String (Dot_Replacement); | |
3580 | ||
3581 | begin | |
3582 | -- Dot_Replacement cannot | |
3583 | -- - be empty | |
3584 | -- - start or end with an alphanumeric | |
3585 | -- - be a single '_' | |
3586 | -- - start with an '_' followed by an alphanumeric | |
3587 | -- - contain a '.' except if it is "." | |
3588 | ||
3589 | if Repl'Length = 0 | |
3590 | or else Is_Alphanumeric (Repl (Repl'First)) | |
3591 | or else Is_Alphanumeric (Repl (Repl'Last)) | |
3592 | or else (Repl (Repl'First) = '_' | |
3593 | and then | |
3594 | (Repl'Length = 1 | |
3595 | or else | |
3596 | Is_Alphanumeric (Repl (Repl'First + 1)))) | |
3597 | or else (Repl'Length > 1 | |
3598 | and then | |
3599 | Index (Source => Repl, Pattern => ".") /= 0) | |
3600 | then | |
3601 | Error_Msg | |
3602 | (Data.Flags, | |
3603 | '"' & Repl & | |
3604 | """ is illegal for Dot_Replacement.", | |
3605 | Dot_Repl_Loc, Project); | |
3606 | end if; | |
3607 | end; | |
3608 | end if; | |
3609 | ||
3610 | if Dot_Replacement /= No_File then | |
3611 | Write_Attr | |
3612 | ("Dot_Replacement", Get_Name_String (Dot_Replacement)); | |
3613 | end if; | |
fbf5a39b | 3614 | |
cf161d66 | 3615 | Casing_Defined := False; |
104e4daa | 3616 | |
cf161d66 AC |
3617 | if not Casing_String.Default then |
3618 | pragma Assert | |
3619 | (Casing_String.Kind = Single, "Casing is not a string"); | |
6f76a257 | 3620 | |
cf161d66 AC |
3621 | declare |
3622 | Casing_Image : constant String := | |
3623 | Get_Name_String (Casing_String.Value); | |
104e4daa | 3624 | |
cf161d66 AC |
3625 | begin |
3626 | if Casing_Image'Length = 0 then | |
6f76a257 AC |
3627 | Error_Msg |
3628 | (Data.Flags, | |
cf161d66 AC |
3629 | "Casing cannot be an empty string", |
3630 | Casing_String.Location, Project); | |
3631 | end if; | |
104e4daa | 3632 | |
cf161d66 AC |
3633 | Casing := Value (Casing_Image); |
3634 | Casing_Defined := True; | |
104e4daa | 3635 | |
cf161d66 AC |
3636 | exception |
3637 | when Constraint_Error => | |
3638 | Name_Len := Casing_Image'Length; | |
3639 | Name_Buffer (1 .. Name_Len) := Casing_Image; | |
3640 | Err_Vars.Error_Msg_Name_1 := Name_Find; | |
3641 | Error_Msg | |
3642 | (Data.Flags, | |
3643 | "%% is not a correct Casing", | |
3644 | Casing_String.Location, Project); | |
3645 | end; | |
3646 | end if; | |
6f76a257 | 3647 | |
cf161d66 | 3648 | Write_Attr ("Casing", Image (Casing)); |
6f76a257 | 3649 | |
cf161d66 AC |
3650 | if not Sep_Suffix.Default then |
3651 | if Length_Of_Name (Sep_Suffix.Value) = 0 then | |
3652 | Error_Msg | |
3653 | (Data.Flags, | |
3654 | "Separate_Suffix cannot be empty", | |
3655 | Sep_Suffix.Location, Project); | |
6f76a257 | 3656 | |
cf161d66 AC |
3657 | else |
3658 | Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value); | |
3659 | Sep_Suffix_Loc := Sep_Suffix.Location; | |
6f76a257 | 3660 | |
cf161d66 AC |
3661 | Check_Illegal_Suffix |
3662 | (Project, Separate_Suffix, | |
3663 | Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location, | |
3664 | Data); | |
3665 | end if; | |
3666 | end if; | |
6f76a257 | 3667 | |
cf161d66 AC |
3668 | if Separate_Suffix /= No_File then |
3669 | Write_Attr | |
3670 | ("Separate_Suffix", Get_Name_String (Separate_Suffix)); | |
3671 | end if; | |
3672 | end Check_Common; | |
6f76a257 | 3673 | |
cf161d66 AC |
3674 | ----------------------------------- |
3675 | -- Process_Exceptions_File_Based -- | |
3676 | ----------------------------------- | |
6f76a257 | 3677 | |
cf161d66 AC |
3678 | procedure Process_Exceptions_File_Based |
3679 | (Lang_Id : Language_Ptr; | |
3680 | Kind : Source_Kind) | |
3681 | is | |
3682 | Lang : constant Name_Id := Lang_Id.Name; | |
3683 | Exceptions : Array_Element_Id; | |
3684 | Exception_List : Variable_Value; | |
3685 | Element_Id : String_List_Id; | |
3686 | Element : String_Element; | |
3687 | File_Name : File_Name_Type; | |
3688 | Source : Source_Id; | |
6f76a257 | 3689 | |
cf161d66 AC |
3690 | begin |
3691 | case Kind is | |
3692 | when Impl | Sep => | |
3693 | Exceptions := | |
3694 | Value_Of | |
3695 | (Name_Implementation_Exceptions, | |
3696 | In_Arrays => Naming.Decl.Arrays, | |
3697 | Shared => Shared); | |
6f76a257 | 3698 | |
cf161d66 AC |
3699 | when Spec => |
3700 | Exceptions := | |
3701 | Value_Of | |
3702 | (Name_Specification_Exceptions, | |
3703 | In_Arrays => Naming.Decl.Arrays, | |
3704 | Shared => Shared); | |
3705 | end case; | |
66713d62 | 3706 | |
cf161d66 AC |
3707 | Exception_List := |
3708 | Value_Of | |
3709 | (Index => Lang, | |
3710 | In_Array => Exceptions, | |
3711 | Shared => Shared); | |
fbf5a39b | 3712 | |
cf161d66 AC |
3713 | if Exception_List /= Nil_Variable_Value then |
3714 | Element_Id := Exception_List.Values; | |
3715 | while Element_Id /= Nil_String loop | |
3716 | Element := Shared.String_Elements.Table (Element_Id); | |
3717 | File_Name := Canonical_Case_File_Name (Element.Value); | |
fbf5a39b | 3718 | |
cf161d66 AC |
3719 | Source := |
3720 | Source_Files_Htable.Get | |
3721 | (Data.Tree.Source_Files_HT, File_Name); | |
3722 | while Source /= No_Source | |
3723 | and then Source.Project /= Project | |
3724 | loop | |
3725 | Source := Source.Next_With_File_Name; | |
3726 | end loop; | |
6c1f47ee | 3727 | |
cf161d66 AC |
3728 | if Source = No_Source then |
3729 | Add_Source | |
3730 | (Id => Source, | |
3731 | Data => Data, | |
3732 | Project => Project, | |
3733 | Source_Dir_Rank => 0, | |
3734 | Lang_Id => Lang_Id, | |
3735 | Kind => Kind, | |
3736 | File_Name => File_Name, | |
3737 | Display_File => File_Name_Type (Element.Value), | |
9f55bc62 | 3738 | Naming_Exception => Yes, |
cf161d66 | 3739 | Location => Element.Location); |
6c1f47ee | 3740 | |
cf161d66 AC |
3741 | else |
3742 | -- Check if the file name is already recorded for another | |
3743 | -- language or another kind. | |
fbf5a39b | 3744 | |
cf161d66 AC |
3745 | if Source.Language /= Lang_Id then |
3746 | Error_Msg | |
3747 | (Data.Flags, | |
3748 | "the same file cannot be a source of two languages", | |
3749 | Element.Location, Project); | |
fbf5a39b | 3750 | |
cf161d66 AC |
3751 | elsif Source.Kind /= Kind then |
3752 | Error_Msg | |
3753 | (Data.Flags, | |
3754 | "the same file cannot be a source and a template", | |
3755 | Element.Location, Project); | |
3756 | end if; | |
fbf5a39b | 3757 | |
cf161d66 AC |
3758 | -- If the file is already recorded for the same |
3759 | -- language and the same kind, it means that the file | |
3760 | -- name appears several times in the *_Exceptions | |
3761 | -- attribute; so there is nothing to do. | |
68c3f02a VC |
3762 | end if; |
3763 | ||
cf161d66 AC |
3764 | Element_Id := Element.Next; |
3765 | end loop; | |
3766 | end if; | |
3767 | end Process_Exceptions_File_Based; | |
be21e9d8 | 3768 | |
cf161d66 AC |
3769 | ----------------------------------- |
3770 | -- Process_Exceptions_Unit_Based -- | |
3771 | ----------------------------------- | |
3772 | ||
3773 | procedure Process_Exceptions_Unit_Based | |
3774 | (Lang_Id : Language_Ptr; | |
3775 | Kind : Source_Kind) | |
3776 | is | |
3777 | Exceptions : Array_Element_Id; | |
3778 | Element : Array_Element; | |
3779 | Unit : Name_Id; | |
3780 | Index : Int; | |
3781 | File_Name : File_Name_Type; | |
3782 | Source : Source_Id; | |
3783 | ||
9f55bc62 AC |
3784 | Naming_Exception : Naming_Exception_Type; |
3785 | ||
cf161d66 AC |
3786 | begin |
3787 | case Kind is | |
3788 | when Impl | Sep => | |
3789 | Exceptions := | |
3790 | Value_Of | |
3791 | (Name_Body, | |
3792 | In_Arrays => Naming.Decl.Arrays, | |
3793 | Shared => Shared); | |
d8b962d8 | 3794 | |
cf161d66 AC |
3795 | if Exceptions = No_Array_Element then |
3796 | Exceptions := | |
3797 | Value_Of | |
3798 | (Name_Implementation, | |
3799 | In_Arrays => Naming.Decl.Arrays, | |
3800 | Shared => Shared); | |
68c3f02a VC |
3801 | end if; |
3802 | ||
cf161d66 AC |
3803 | when Spec => |
3804 | Exceptions := | |
3805 | Value_Of | |
3806 | (Name_Spec, | |
3807 | In_Arrays => Naming.Decl.Arrays, | |
3808 | Shared => Shared); | |
68c3f02a | 3809 | |
cf161d66 AC |
3810 | if Exceptions = No_Array_Element then |
3811 | Exceptions := | |
3812 | Value_Of | |
9f55bc62 | 3813 | (Name_Specification, |
cf161d66 AC |
3814 | In_Arrays => Naming.Decl.Arrays, |
3815 | Shared => Shared); | |
3816 | end if; | |
68c3f02a | 3817 | end case; |
fbf5a39b | 3818 | |
cf161d66 AC |
3819 | while Exceptions /= No_Array_Element loop |
3820 | Element := Shared.Array_Elements.Table (Exceptions); | |
9f55bc62 AC |
3821 | |
3822 | if Element.Restricted then | |
3823 | Naming_Exception := Inherited; | |
3824 | else | |
3825 | Naming_Exception := Yes; | |
3826 | end if; | |
3827 | ||
cf161d66 | 3828 | File_Name := Canonical_Case_File_Name (Element.Value.Value); |
104e4daa | 3829 | |
cf161d66 AC |
3830 | Get_Name_String (Element.Index); |
3831 | To_Lower (Name_Buffer (1 .. Name_Len)); | |
3832 | Index := Element.Value.Index; | |
104e4daa | 3833 | |
cf161d66 | 3834 | -- Check if it is a valid unit name |
f6cf5b85 | 3835 | |
cf161d66 AC |
3836 | Get_Name_String (Element.Index); |
3837 | Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit); | |
104e4daa | 3838 | |
cf161d66 AC |
3839 | if Unit = No_Name then |
3840 | Err_Vars.Error_Msg_Name_1 := Element.Index; | |
3841 | Error_Msg | |
3842 | (Data.Flags, | |
3843 | "%% is not a valid unit name.", | |
3844 | Element.Value.Location, Project); | |
3845 | end if; | |
104e4daa | 3846 | |
cf161d66 AC |
3847 | if Unit /= No_Name then |
3848 | Add_Source | |
3849 | (Id => Source, | |
3850 | Data => Data, | |
3851 | Project => Project, | |
3852 | Source_Dir_Rank => 0, | |
3853 | Lang_Id => Lang_Id, | |
3854 | Kind => Kind, | |
3855 | File_Name => File_Name, | |
3856 | Display_File => File_Name_Type (Element.Value.Value), | |
3857 | Unit => Unit, | |
3858 | Index => Index, | |
3859 | Location => Element.Value.Location, | |
9f55bc62 | 3860 | Naming_Exception => Naming_Exception); |
cf161d66 | 3861 | end if; |
104e4daa | 3862 | |
cf161d66 AC |
3863 | Exceptions := Element.Next; |
3864 | end loop; | |
3865 | end Process_Exceptions_Unit_Based; | |
104e4daa | 3866 | |
cf161d66 AC |
3867 | ------------------ |
3868 | -- Check_Naming -- | |
3869 | ------------------ | |
104e4daa | 3870 | |
cf161d66 AC |
3871 | procedure Check_Naming is |
3872 | Dot_Replacement : File_Name_Type := | |
3873 | File_Name_Type | |
3874 | (First_Name_Id + Character'Pos ('-')); | |
3875 | Separate_Suffix : File_Name_Type := No_File; | |
3876 | Casing : Casing_Type := All_Lower_Case; | |
3877 | Casing_Defined : Boolean; | |
3878 | Lang_Id : Language_Ptr; | |
3879 | Sep_Suffix_Loc : Source_Ptr; | |
3880 | Suffix : Variable_Value; | |
3881 | Lang : Name_Id; | |
104e4daa | 3882 | |
cf161d66 AC |
3883 | begin |
3884 | Check_Common | |
3885 | (Dot_Replacement => Dot_Replacement, | |
3886 | Casing => Casing, | |
3887 | Casing_Defined => Casing_Defined, | |
3888 | Separate_Suffix => Separate_Suffix, | |
3889 | Sep_Suffix_Loc => Sep_Suffix_Loc); | |
104e4daa | 3890 | |
cf161d66 AC |
3891 | -- For all unit based languages, if any, set the specified value |
3892 | -- of Dot_Replacement, Casing and/or Separate_Suffix. Do not | |
3893 | -- systematically overwrite, since the defaults come from the | |
3894 | -- configuration file. | |
104e4daa | 3895 | |
cf161d66 AC |
3896 | if Dot_Replacement /= No_File |
3897 | or else Casing_Defined | |
3898 | or else Separate_Suffix /= No_File | |
3899 | then | |
3900 | Lang_Id := Project.Languages; | |
3901 | while Lang_Id /= No_Language_Index loop | |
3902 | if Lang_Id.Config.Kind = Unit_Based then | |
3903 | if Dot_Replacement /= No_File then | |
3904 | Lang_Id.Config.Naming_Data.Dot_Replacement := | |
3905 | Dot_Replacement; | |
3906 | end if; | |
104e4daa | 3907 | |
cf161d66 AC |
3908 | if Casing_Defined then |
3909 | Lang_Id.Config.Naming_Data.Casing := Casing; | |
3910 | end if; | |
3911 | end if; | |
104e4daa | 3912 | |
cf161d66 AC |
3913 | Lang_Id := Lang_Id.Next; |
3914 | end loop; | |
3915 | end if; | |
66713d62 | 3916 | |
cf161d66 | 3917 | -- Next, get the spec and body suffixes |
104e4daa | 3918 | |
cf161d66 AC |
3919 | Lang_Id := Project.Languages; |
3920 | while Lang_Id /= No_Language_Index loop | |
3921 | Lang := Lang_Id.Name; | |
104e4daa | 3922 | |
cf161d66 | 3923 | -- Spec_Suffix |
104e4daa | 3924 | |
cf161d66 AC |
3925 | Suffix := Value_Of |
3926 | (Name => Lang, | |
3927 | Attribute_Or_Array_Name => Name_Spec_Suffix, | |
3928 | In_Package => Naming_Id, | |
3929 | Shared => Shared); | |
104e4daa | 3930 | |
cf161d66 AC |
3931 | if Suffix = Nil_Variable_Value then |
3932 | Suffix := Value_Of | |
3933 | (Name => Lang, | |
3934 | Attribute_Or_Array_Name => Name_Specification_Suffix, | |
3935 | In_Package => Naming_Id, | |
3936 | Shared => Shared); | |
3937 | end if; | |
104e4daa | 3938 | |
cf161d66 AC |
3939 | if Suffix /= Nil_Variable_Value then |
3940 | Lang_Id.Config.Naming_Data.Spec_Suffix := | |
3941 | File_Name_Type (Suffix.Value); | |
104e4daa | 3942 | |
cf161d66 AC |
3943 | Check_Illegal_Suffix |
3944 | (Project, | |
3945 | Lang_Id.Config.Naming_Data.Spec_Suffix, | |
3946 | Lang_Id.Config.Naming_Data.Dot_Replacement, | |
3947 | "Spec_Suffix", Suffix.Location, Data); | |
104e4daa | 3948 | |
cf161d66 AC |
3949 | Write_Attr |
3950 | ("Spec_Suffix", | |
3951 | Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix)); | |
104e4daa VC |
3952 | end if; |
3953 | ||
cf161d66 | 3954 | -- Body_Suffix |
fbf5a39b | 3955 | |
cf161d66 AC |
3956 | Suffix := |
3957 | Value_Of | |
3958 | (Name => Lang, | |
3959 | Attribute_Or_Array_Name => Name_Body_Suffix, | |
3960 | In_Package => Naming_Id, | |
3961 | Shared => Shared); | |
fbf5a39b | 3962 | |
cf161d66 AC |
3963 | if Suffix = Nil_Variable_Value then |
3964 | Suffix := | |
3965 | Value_Of | |
3966 | (Name => Lang, | |
3967 | Attribute_Or_Array_Name => Name_Implementation_Suffix, | |
3968 | In_Package => Naming_Id, | |
3969 | Shared => Shared); | |
44e1918a | 3970 | end if; |
fbf5a39b | 3971 | |
cf161d66 AC |
3972 | if Suffix /= Nil_Variable_Value then |
3973 | Lang_Id.Config.Naming_Data.Body_Suffix := | |
3974 | File_Name_Type (Suffix.Value); | |
fbf5a39b | 3975 | |
cf161d66 AC |
3976 | -- The default value of separate suffix should be the same as |
3977 | -- the body suffix, so we need to compute that first. | |
fbf5a39b | 3978 | |
cf161d66 AC |
3979 | if Separate_Suffix = No_File then |
3980 | Lang_Id.Config.Naming_Data.Separate_Suffix := | |
3981 | Lang_Id.Config.Naming_Data.Body_Suffix; | |
3982 | Write_Attr | |
3983 | ("Sep_Suffix", | |
3984 | Get_Name_String | |
3985 | (Lang_Id.Config.Naming_Data.Separate_Suffix)); | |
3986 | else | |
3987 | Lang_Id.Config.Naming_Data.Separate_Suffix := | |
3988 | Separate_Suffix; | |
3989 | end if; | |
fbf5a39b | 3990 | |
cf161d66 AC |
3991 | Check_Illegal_Suffix |
3992 | (Project, | |
3993 | Lang_Id.Config.Naming_Data.Body_Suffix, | |
3994 | Lang_Id.Config.Naming_Data.Dot_Replacement, | |
3995 | "Body_Suffix", Suffix.Location, Data); | |
fbf5a39b | 3996 | |
cf161d66 AC |
3997 | Write_Attr |
3998 | ("Body_Suffix", | |
3999 | Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)); | |
fbf5a39b | 4000 | |
cf161d66 AC |
4001 | elsif Separate_Suffix /= No_File then |
4002 | Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix; | |
4003 | end if; | |
fbf5a39b | 4004 | |
cf161d66 AC |
4005 | -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix, |
4006 | -- since that would cause a clear ambiguity. Note that we do allow | |
4007 | -- a Spec_Suffix to have the same termination as one of these, | |
4008 | -- which causes a potential ambiguity, but we resolve that by | |
4009 | -- matching the longest possible suffix. | |
fbf5a39b | 4010 | |
cf161d66 AC |
4011 | if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File |
4012 | and then Lang_Id.Config.Naming_Data.Spec_Suffix = | |
4013 | Lang_Id.Config.Naming_Data.Body_Suffix | |
4014 | then | |
4015 | Error_Msg | |
4016 | (Data.Flags, | |
4017 | "Body_Suffix (""" | |
4018 | & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix) | |
4019 | & """) cannot be the same as Spec_Suffix.", | |
4020 | Ada_Body_Suffix_Loc, Project); | |
4021 | end if; | |
fbf5a39b | 4022 | |
cf161d66 AC |
4023 | if Lang_Id.Config.Naming_Data.Body_Suffix /= |
4024 | Lang_Id.Config.Naming_Data.Separate_Suffix | |
4025 | and then Lang_Id.Config.Naming_Data.Spec_Suffix = | |
4026 | Lang_Id.Config.Naming_Data.Separate_Suffix | |
4027 | then | |
4028 | Error_Msg | |
4029 | (Data.Flags, | |
4030 | "Separate_Suffix (""" | |
4031 | & Get_Name_String | |
4032 | (Lang_Id.Config.Naming_Data.Separate_Suffix) | |
4033 | & """) cannot be the same as Spec_Suffix.", | |
4034 | Sep_Suffix_Loc, Project); | |
4035 | end if; | |
fbf5a39b | 4036 | |
cf161d66 AC |
4037 | Lang_Id := Lang_Id.Next; |
4038 | end loop; | |
3568b271 | 4039 | |
cf161d66 | 4040 | -- Get the naming exceptions for all languages |
3568b271 | 4041 | |
cf161d66 AC |
4042 | for Kind in Spec_Or_Body loop |
4043 | Lang_Id := Project.Languages; | |
4044 | while Lang_Id /= No_Language_Index loop | |
4045 | case Lang_Id.Config.Kind is | |
4046 | when File_Based => | |
4047 | Process_Exceptions_File_Based (Lang_Id, Kind); | |
3568b271 | 4048 | |
cf161d66 AC |
4049 | when Unit_Based => |
4050 | Process_Exceptions_Unit_Based (Lang_Id, Kind); | |
4051 | end case; | |
3568b271 | 4052 | |
cf161d66 AC |
4053 | Lang_Id := Lang_Id.Next; |
4054 | end loop; | |
4055 | end loop; | |
4056 | end Check_Naming; | |
fbf5a39b | 4057 | |
cf161d66 AC |
4058 | ---------------------------- |
4059 | -- Initialize_Naming_Data -- | |
4060 | ---------------------------- | |
ede007da | 4061 | |
cf161d66 AC |
4062 | procedure Initialize_Naming_Data is |
4063 | Specs : Array_Element_Id := | |
4064 | Util.Value_Of | |
4065 | (Name_Spec_Suffix, | |
4066 | Naming.Decl.Arrays, | |
4067 | Shared); | |
ede007da | 4068 | |
cf161d66 AC |
4069 | Impls : Array_Element_Id := |
4070 | Util.Value_Of | |
4071 | (Name_Body_Suffix, | |
4072 | Naming.Decl.Arrays, | |
4073 | Shared); | |
fbf5a39b | 4074 | |
cf161d66 AC |
4075 | Lang : Language_Ptr; |
4076 | Lang_Name : Name_Id; | |
4077 | Value : Variable_Value; | |
4078 | Extended : Project_Id; | |
ede007da | 4079 | |
cf161d66 AC |
4080 | begin |
4081 | -- At this stage, the project already contains the default extensions | |
4082 | -- for the various languages. We now merge those suffixes read in the | |
4083 | -- user project, and they override the default. | |
23ed6584 | 4084 | |
cf161d66 AC |
4085 | while Specs /= No_Array_Element loop |
4086 | Lang_Name := Shared.Array_Elements.Table (Specs).Index; | |
4087 | Lang := | |
4088 | Get_Language_From_Name | |
4089 | (Project, Name => Get_Name_String (Lang_Name)); | |
23ed6584 | 4090 | |
cf161d66 AC |
4091 | -- An extending project inherits its parent projects' languages |
4092 | -- so if needed we should create entries for those languages | |
23ed6584 | 4093 | |
cf161d66 AC |
4094 | if Lang = null then |
4095 | Extended := Project.Extends; | |
4096 | while Extended /= null loop | |
4097 | Lang := Get_Language_From_Name | |
4098 | (Extended, Name => Get_Name_String (Lang_Name)); | |
4099 | exit when Lang /= null; | |
23ed6584 | 4100 | |
cf161d66 AC |
4101 | Extended := Extended.Extends; |
4102 | end loop; | |
23ed6584 | 4103 | |
cf161d66 AC |
4104 | if Lang /= null then |
4105 | Lang := new Language_Data'(Lang.all); | |
4106 | Lang.First_Source := null; | |
4107 | Lang.Next := Project.Languages; | |
4108 | Project.Languages := Lang; | |
23ed6584 VC |
4109 | end if; |
4110 | end if; | |
23ed6584 | 4111 | |
cf161d66 AC |
4112 | -- If language was not found in project or the projects it extends |
4113 | ||
4114 | if Lang = null then | |
4115 | Debug_Output | |
4116 | ("ignoring spec naming data (lang. not in project): ", | |
4117 | Lang_Name); | |
3a4ec5cc | 4118 | |
cf161d66 AC |
4119 | else |
4120 | Value := Shared.Array_Elements.Table (Specs).Value; | |
3a4ec5cc | 4121 | |
cf161d66 AC |
4122 | if Value.Kind = Single then |
4123 | Lang.Config.Naming_Data.Spec_Suffix := | |
4124 | Canonical_Case_File_Name (Value.Value); | |
4125 | end if; | |
3a4ec5cc | 4126 | end if; |
cf161d66 AC |
4127 | |
4128 | Specs := Shared.Array_Elements.Table (Specs).Next; | |
3a4ec5cc | 4129 | end loop; |
3a4ec5cc | 4130 | |
cf161d66 AC |
4131 | while Impls /= No_Array_Element loop |
4132 | Lang_Name := Shared.Array_Elements.Table (Impls).Index; | |
4133 | Lang := | |
4134 | Get_Language_From_Name | |
4135 | (Project, Name => Get_Name_String (Lang_Name)); | |
3a4ec5cc | 4136 | |
cf161d66 AC |
4137 | if Lang = null then |
4138 | Debug_Output | |
4139 | ("ignoring impl naming data (lang. not in project): ", | |
4140 | Lang_Name); | |
4141 | else | |
4142 | Value := Shared.Array_Elements.Table (Impls).Value; | |
3a4ec5cc | 4143 | |
cf161d66 AC |
4144 | if Lang.Name = Name_Ada then |
4145 | Ada_Body_Suffix_Loc := Value.Location; | |
4146 | end if; | |
4147 | ||
4148 | if Value.Kind = Single then | |
4149 | Lang.Config.Naming_Data.Body_Suffix := | |
4150 | Canonical_Case_File_Name (Value.Value); | |
4151 | end if; | |
3a4ec5cc | 4152 | end if; |
cf161d66 AC |
4153 | |
4154 | Impls := Shared.Array_Elements.Table (Impls).Next; | |
3a4ec5cc | 4155 | end loop; |
cf161d66 | 4156 | end Initialize_Naming_Data; |
3a4ec5cc | 4157 | |
cf161d66 | 4158 | -- Start of processing for Check_Naming_Schemes |
3a4ec5cc | 4159 | |
cf161d66 AC |
4160 | begin |
4161 | -- No Naming package or parsing a configuration file? nothing to do | |
3a4ec5cc | 4162 | |
cf161d66 AC |
4163 | if Naming_Id /= No_Package |
4164 | and then Project.Qualifier /= Configuration | |
4165 | then | |
4166 | Naming := Shared.Packages.Table (Naming_Id); | |
4167 | Debug_Increase_Indent ("checking package Naming for ", Project.Name); | |
4168 | Initialize_Naming_Data; | |
4169 | Check_Naming; | |
4170 | Debug_Decrease_Indent ("done checking package naming"); | |
3a4ec5cc | 4171 | end if; |
cf161d66 | 4172 | end Check_Package_Naming; |
fbf5a39b | 4173 | |
44e1918a AC |
4174 | --------------------------------- |
4175 | -- Check_Programming_Languages -- | |
4176 | --------------------------------- | |
7324bf49 | 4177 | |
7e98a4c6 | 4178 | procedure Check_Programming_Languages |
fdd7e7bb EB |
4179 | (Project : Project_Id; |
4180 | Data : in out Tree_Processing_Data) | |
7e98a4c6 | 4181 | is |
40ecf2f5 EB |
4182 | Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; |
4183 | ||
1b685674 VC |
4184 | Languages : Variable_Value := Nil_Variable_Value; |
4185 | Def_Lang : Variable_Value := Nil_Variable_Value; | |
a70f5d82 | 4186 | Def_Lang_Id : Name_Id; |
0da2c8ac | 4187 | |
fadcf313 AC |
4188 | procedure Add_Language (Name, Display_Name : Name_Id); |
4189 | -- Add a new language to the list of languages for the project. | |
4190 | -- Nothing is done if the language has already been defined | |
4191 | ||
f6cf5b85 AC |
4192 | ------------------ |
4193 | -- Add_Language -- | |
4194 | ------------------ | |
4195 | ||
fadcf313 | 4196 | procedure Add_Language (Name, Display_Name : Name_Id) is |
f6cf5b85 AC |
4197 | Lang : Language_Ptr; |
4198 | ||
fadcf313 | 4199 | begin |
f6cf5b85 | 4200 | Lang := Project.Languages; |
fadcf313 AC |
4201 | while Lang /= No_Language_Index loop |
4202 | if Name = Lang.Name then | |
4203 | return; | |
4204 | end if; | |
4205 | ||
4206 | Lang := Lang.Next; | |
4207 | end loop; | |
4208 | ||
4209 | Lang := new Language_Data'(No_Language_Data); | |
4210 | Lang.Next := Project.Languages; | |
4211 | Project.Languages := Lang; | |
32404665 | 4212 | Lang.Name := Name; |
fadcf313 | 4213 | Lang.Display_Name := Display_Name; |
fadcf313 AC |
4214 | end Add_Language; |
4215 | ||
84157c9a RD |
4216 | -- Start of processing for Check_Programming_Languages |
4217 | ||
44e1918a | 4218 | begin |
fadcf313 | 4219 | Project.Languages := null; |
7e98a4c6 | 4220 | Languages := |
40ecf2f5 | 4221 | Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Shared); |
a70f5d82 VC |
4222 | Def_Lang := |
4223 | Prj.Util.Value_Of | |
40ecf2f5 | 4224 | (Name_Default_Language, Project.Decl.Attributes, Shared); |
e0697153 | 4225 | |
66713d62 | 4226 | if Project.Source_Dirs /= Nil_String then |
19f0526a | 4227 | |
ede007da VC |
4228 | -- Check if languages are specified in this project |
4229 | ||
4230 | if Languages.Default then | |
4231 | ||
7bccff24 | 4232 | -- Fail if there is no default language defined |
ede007da | 4233 | |
7bccff24 EB |
4234 | if Def_Lang.Default then |
4235 | Error_Msg | |
e2d9085b | 4236 | (Data.Flags, |
7bccff24 | 4237 | "no languages defined for this project", |
e2d9085b | 4238 | Project.Location, Project); |
7bccff24 | 4239 | Def_Lang_Id := No_Name; |
ede007da | 4240 | |
ede007da | 4241 | else |
7bccff24 EB |
4242 | Get_Name_String (Def_Lang.Value); |
4243 | To_Lower (Name_Buffer (1 .. Name_Len)); | |
4244 | Def_Lang_Id := Name_Find; | |
e0697153 | 4245 | end if; |
6c1f47ee | 4246 | |
e0697153 | 4247 | if Def_Lang_Id /= No_Name then |
e0697153 EB |
4248 | Get_Name_String (Def_Lang_Id); |
4249 | Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1)); | |
fadcf313 AC |
4250 | Add_Language |
4251 | (Name => Def_Lang_Id, | |
4252 | Display_Name => Name_Find); | |
ede007da VC |
4253 | end if; |
4254 | ||
4255 | else | |
4256 | declare | |
84157c9a RD |
4257 | Current : String_List_Id := Languages.Values; |
4258 | Element : String_Element; | |
ede007da VC |
4259 | |
4260 | begin | |
ede007da VC |
4261 | -- If there are no languages declared, there are no sources |
4262 | ||
4263 | if Current = Nil_String then | |
66713d62 | 4264 | Project.Source_Dirs := Nil_String; |
ede007da | 4265 | |
66713d62 | 4266 | if Project.Qualifier = Standard then |
68c3f02a | 4267 | Error_Msg |
e2d9085b | 4268 | (Data.Flags, |
bd0a4cab | 4269 | "a standard project must have at least one language", |
e2d9085b | 4270 | Languages.Location, Project); |
68c3f02a VC |
4271 | end if; |
4272 | ||
ede007da VC |
4273 | else |
4274 | -- Look through all the languages specified in attribute | |
4275 | -- Languages. | |
4276 | ||
4277 | while Current /= Nil_String loop | |
40ecf2f5 | 4278 | Element := Shared.String_Elements.Table (Current); |
ede007da VC |
4279 | Get_Name_String (Element.Value); |
4280 | To_Lower (Name_Buffer (1 .. Name_Len)); | |
ede007da | 4281 | |
fadcf313 AC |
4282 | Add_Language |
4283 | (Name => Name_Find, | |
4284 | Display_Name => Element.Value); | |
44e1918a | 4285 | |
ede007da VC |
4286 | Current := Element.Next; |
4287 | end loop; | |
4288 | end if; | |
44e1918a AC |
4289 | end; |
4290 | end if; | |
7324bf49 | 4291 | end if; |
44e1918a | 4292 | end Check_Programming_Languages; |
19f0526a | 4293 | |
44e1918a AC |
4294 | ------------------------------- |
4295 | -- Check_Stand_Alone_Library -- | |
4296 | ------------------------------- | |
4297 | ||
4298 | procedure Check_Stand_Alone_Library | |
c37845f8 AC |
4299 | (Project : Project_Id; |
4300 | Data : in out Tree_Processing_Data) | |
44e1918a | 4301 | is |
40ecf2f5 EB |
4302 | Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; |
4303 | ||
7a0ddd20 AC |
4304 | Lib_Name : constant Prj.Variable_Value := |
4305 | Prj.Util.Value_Of | |
4306 | (Snames.Name_Library_Name, | |
4307 | Project.Decl.Attributes, | |
4308 | Shared); | |
4309 | ||
44e1918a AC |
4310 | Lib_Interfaces : constant Prj.Variable_Value := |
4311 | Prj.Util.Value_Of | |
4312 | (Snames.Name_Library_Interface, | |
66713d62 | 4313 | Project.Decl.Attributes, |
40ecf2f5 | 4314 | Shared); |
44e1918a AC |
4315 | |
4316 | Lib_Auto_Init : constant Prj.Variable_Value := | |
4317 | Prj.Util.Value_Of | |
4318 | (Snames.Name_Library_Auto_Init, | |
66713d62 | 4319 | Project.Decl.Attributes, |
40ecf2f5 | 4320 | Shared); |
44e1918a AC |
4321 | |
4322 | Lib_Src_Dir : constant Prj.Variable_Value := | |
4323 | Prj.Util.Value_Of | |
4324 | (Snames.Name_Library_Src_Dir, | |
66713d62 | 4325 | Project.Decl.Attributes, |
40ecf2f5 | 4326 | Shared); |
44e1918a AC |
4327 | |
4328 | Lib_Symbol_File : constant Prj.Variable_Value := | |
4329 | Prj.Util.Value_Of | |
4330 | (Snames.Name_Library_Symbol_File, | |
66713d62 | 4331 | Project.Decl.Attributes, |
40ecf2f5 | 4332 | Shared); |
44e1918a AC |
4333 | |
4334 | Lib_Symbol_Policy : constant Prj.Variable_Value := | |
4335 | Prj.Util.Value_Of | |
4336 | (Snames.Name_Library_Symbol_Policy, | |
66713d62 | 4337 | Project.Decl.Attributes, |
40ecf2f5 | 4338 | Shared); |
44e1918a AC |
4339 | |
4340 | Lib_Ref_Symbol_File : constant Prj.Variable_Value := | |
4341 | Prj.Util.Value_Of | |
4342 | (Snames.Name_Library_Reference_Symbol_File, | |
66713d62 | 4343 | Project.Decl.Attributes, |
40ecf2f5 | 4344 | Shared); |
44e1918a | 4345 | |
ede007da | 4346 | Auto_Init_Supported : Boolean; |
ede007da | 4347 | OK : Boolean := True; |
ede007da VC |
4348 | Source : Source_Id; |
4349 | Next_Proj : Project_Id; | |
5eed512d | 4350 | Iter : Source_Iterator; |
44e1918a AC |
4351 | |
4352 | begin | |
7bccff24 | 4353 | Auto_Init_Supported := Project.Config.Auto_Init_Supported; |
ede007da | 4354 | |
44e1918a AC |
4355 | pragma Assert (Lib_Interfaces.Kind = List); |
4356 | ||
4357 | -- It is a stand-alone library project file if attribute | |
4358 | -- Library_Interface is defined. | |
4359 | ||
4360 | if not Lib_Interfaces.Default then | |
7a0ddd20 AC |
4361 | |
4362 | -- The name of a stand-alone library needs to have the syntax of an | |
4363 | -- Ada identifier. | |
4364 | ||
4365 | declare | |
4366 | Name : constant String := Get_Name_String (Project.Library_Name); | |
c5f5123f AC |
4367 | OK : Boolean := Is_Letter (Name (Name'First)); |
4368 | ||
7a0ddd20 | 4369 | Underline : Boolean := False; |
c5f5123f | 4370 | |
7a0ddd20 AC |
4371 | begin |
4372 | for J in Name'First + 1 .. Name'Last loop | |
4373 | exit when not OK; | |
4374 | ||
4375 | if Is_Alphanumeric (Name (J)) then | |
4376 | Underline := False; | |
4377 | ||
4378 | elsif Name (J) = '_' then | |
4379 | if Underline then | |
4380 | OK := False; | |
4381 | else | |
4382 | Underline := True; | |
4383 | end if; | |
4384 | ||
4385 | else | |
4386 | OK := False; | |
4387 | end if; | |
4388 | end loop; | |
4389 | ||
c5f5123f | 4390 | OK := OK and not Underline; |
7a0ddd20 AC |
4391 | |
4392 | if not OK then | |
4393 | Error_Msg | |
4394 | (Data.Flags, | |
4395 | "Incorrect library name for a Stand-Alone Library", | |
4396 | Lib_Name.Location, Project); | |
4397 | return; | |
4398 | end if; | |
4399 | end; | |
4400 | ||
7bccff24 | 4401 | declare |
44e1918a AC |
4402 | Interfaces : String_List_Id := Lib_Interfaces.Values; |
4403 | Interface_ALIs : String_List_Id := Nil_String; | |
4404 | Unit : Name_Id; | |
19f0526a | 4405 | |
7324bf49 | 4406 | begin |
66713d62 | 4407 | Project.Standalone_Library := True; |
19f0526a | 4408 | |
44e1918a | 4409 | -- Library_Interface cannot be an empty list |
19f0526a | 4410 | |
44e1918a | 4411 | if Interfaces = Nil_String then |
7324bf49 | 4412 | Error_Msg |
e2d9085b | 4413 | (Data.Flags, |
44e1918a | 4414 | "Library_Interface cannot be an empty list", |
e2d9085b | 4415 | Lib_Interfaces.Location, Project); |
7324bf49 | 4416 | end if; |
19f0526a | 4417 | |
44e1918a AC |
4418 | -- Process each unit name specified in the attribute |
4419 | -- Library_Interface. | |
19f0526a | 4420 | |
44e1918a AC |
4421 | while Interfaces /= Nil_String loop |
4422 | Get_Name_String | |
40ecf2f5 | 4423 | (Shared.String_Elements.Table (Interfaces).Value); |
44e1918a AC |
4424 | To_Lower (Name_Buffer (1 .. Name_Len)); |
4425 | ||
4426 | if Name_Len = 0 then | |
7324bf49 | 4427 | Error_Msg |
e2d9085b | 4428 | (Data.Flags, |
44e1918a | 4429 | "an interface cannot be an empty string", |
40ecf2f5 | 4430 | Shared.String_Elements.Table (Interfaces).Location, |
e2d9085b | 4431 | Project); |
19f0526a | 4432 | |
44e1918a AC |
4433 | else |
4434 | Unit := Name_Find; | |
4435 | Error_Msg_Name_1 := Unit; | |
19f0526a | 4436 | |
7bccff24 EB |
4437 | Next_Proj := Project.Extends; |
4438 | Iter := For_Each_Source (Data.Tree, Project); | |
4439 | loop | |
4440 | while Prj.Element (Iter) /= No_Source | |
4441 | and then | |
4442 | (Prj.Element (Iter).Unit = null | |
3c2815d8 | 4443 | or else Prj.Element (Iter).Unit.Name /= Unit) |
7bccff24 EB |
4444 | loop |
4445 | Next (Iter); | |
4446 | end loop; | |
fbf5a39b | 4447 | |
7bccff24 EB |
4448 | Source := Prj.Element (Iter); |
4449 | exit when Source /= No_Source | |
4450 | or else Next_Proj = No_Project; | |
b30668b7 | 4451 | |
7bccff24 EB |
4452 | Iter := For_Each_Source (Data.Tree, Next_Proj); |
4453 | Next_Proj := Next_Proj.Extends; | |
4454 | end loop; | |
32404665 | 4455 | |
7bccff24 EB |
4456 | if Source /= No_Source then |
4457 | if Source.Kind = Sep then | |
4458 | Source := No_Source; | |
32404665 | 4459 | |
7bccff24 EB |
4460 | elsif Source.Kind = Spec |
4461 | and then Other_Part (Source) /= No_Source | |
32404665 | 4462 | then |
7bccff24 | 4463 | Source := Other_Part (Source); |
ede007da | 4464 | end if; |
7bccff24 | 4465 | end if; |
fbf5a39b | 4466 | |
7bccff24 EB |
4467 | if Source /= No_Source then |
4468 | if Source.Project /= Project | |
4469 | and then not Is_Extending (Project, Source.Project) | |
4470 | then | |
4471 | Source := No_Source; | |
ede007da | 4472 | end if; |
7bccff24 | 4473 | end if; |
ede007da | 4474 | |
7bccff24 EB |
4475 | if Source = No_Source then |
4476 | Error_Msg | |
e2d9085b | 4477 | (Data.Flags, |
7bccff24 | 4478 | "%% is not a unit of this project", |
40ecf2f5 EB |
4479 | Shared.String_Elements.Table (Interfaces).Location, |
4480 | Project); | |
7bccff24 EB |
4481 | |
4482 | else | |
4483 | if Source.Kind = Spec | |
4484 | and then Other_Part (Source) /= No_Source | |
4485 | then | |
4486 | Source := Other_Part (Source); | |
44e1918a | 4487 | end if; |
7bccff24 EB |
4488 | |
4489 | String_Element_Table.Increment_Last | |
40ecf2f5 | 4490 | (Shared.String_Elements); |
7bccff24 | 4491 | |
40ecf2f5 EB |
4492 | Shared.String_Elements.Table |
4493 | (String_Element_Table.Last (Shared.String_Elements)) := | |
c5f5123f AC |
4494 | (Value => Name_Id (Source.Dep_Name), |
4495 | Index => 0, | |
4496 | Display_Value => Name_Id (Source.Dep_Name), | |
4497 | Location => | |
4498 | Shared.String_Elements.Table (Interfaces).Location, | |
4499 | Flag => False, | |
4500 | Next => Interface_ALIs); | |
7bccff24 EB |
4501 | |
4502 | Interface_ALIs := | |
40ecf2f5 | 4503 | String_Element_Table.Last (Shared.String_Elements); |
44e1918a | 4504 | end if; |
7324bf49 | 4505 | end if; |
b30668b7 | 4506 | |
40ecf2f5 | 4507 | Interfaces := Shared.String_Elements.Table (Interfaces).Next; |
44e1918a | 4508 | end loop; |
b30668b7 | 4509 | |
44e1918a | 4510 | -- Put the list of Interface ALIs in the project data |
fbf5a39b | 4511 | |
66713d62 | 4512 | Project.Lib_Interface_ALIs := Interface_ALIs; |
fbf5a39b | 4513 | |
44e1918a AC |
4514 | -- Check value of attribute Library_Auto_Init and set |
4515 | -- Lib_Auto_Init accordingly. | |
fbf5a39b | 4516 | |
44e1918a | 4517 | if Lib_Auto_Init.Default then |
fbf5a39b | 4518 | |
1b685674 VC |
4519 | -- If no attribute Library_Auto_Init is declared, then set auto |
4520 | -- init only if it is supported. | |
fbf5a39b | 4521 | |
66713d62 | 4522 | Project.Lib_Auto_Init := Auto_Init_Supported; |
b30668b7 | 4523 | |
44e1918a AC |
4524 | else |
4525 | Get_Name_String (Lib_Auto_Init.Value); | |
4526 | To_Lower (Name_Buffer (1 .. Name_Len)); | |
b30668b7 | 4527 | |
44e1918a | 4528 | if Name_Buffer (1 .. Name_Len) = "false" then |
66713d62 | 4529 | Project.Lib_Auto_Init := False; |
b30668b7 | 4530 | |
44e1918a AC |
4531 | elsif Name_Buffer (1 .. Name_Len) = "true" then |
4532 | if Auto_Init_Supported then | |
66713d62 | 4533 | Project.Lib_Auto_Init := True; |
b30668b7 | 4534 | |
44e1918a | 4535 | else |
1b685674 | 4536 | -- Library_Auto_Init cannot be "true" if auto init is not |
5d07d0cf | 4537 | -- supported. |
b30668b7 | 4538 | |
44e1918a | 4539 | Error_Msg |
e2d9085b | 4540 | (Data.Flags, |
44e1918a AC |
4541 | "library auto init not supported " & |
4542 | "on this platform", | |
e2d9085b | 4543 | Lib_Auto_Init.Location, Project); |
44e1918a | 4544 | end if; |
7324bf49 | 4545 | |
44e1918a AC |
4546 | else |
4547 | Error_Msg | |
e2d9085b | 4548 | (Data.Flags, |
44e1918a | 4549 | "invalid value for attribute Library_Auto_Init", |
e2d9085b | 4550 | Lib_Auto_Init.Location, Project); |
7324bf49 | 4551 | end if; |
b30668b7 | 4552 | end if; |
7bccff24 | 4553 | end; |
b30668b7 | 4554 | |
1b685674 VC |
4555 | -- If attribute Library_Src_Dir is defined and not the empty string, |
4556 | -- check if the directory exist and is not the object directory or | |
4557 | -- one of the source directories. This is the directory where copies | |
4558 | -- of the interface sources will be copied. Note that this directory | |
4559 | -- may be the library directory. | |
b30668b7 | 4560 | |
44e1918a AC |
4561 | if Lib_Src_Dir.Value /= Empty_String then |
4562 | declare | |
f6cf5b85 AC |
4563 | Dir_Id : constant File_Name_Type := |
4564 | File_Name_Type (Lib_Src_Dir.Value); | |
3249690d | 4565 | Dir_Exists : Boolean; |
b30668b7 | 4566 | |
44e1918a AC |
4567 | begin |
4568 | Locate_Directory | |
751089b2 | 4569 | (Project, |
751089b2 | 4570 | Dir_Id, |
3249690d AC |
4571 | Path => Project.Library_Src_Dir, |
4572 | Dir_Exists => Dir_Exists, | |
32404665 | 4573 | Data => Data, |
3249690d | 4574 | Must_Exist => False, |
a9872a59 | 4575 | Create => "library source copy", |
a9872a59 | 4576 | Location => Lib_Src_Dir.Location, |
66713d62 | 4577 | Externally_Built => Project.Externally_Built); |
b30668b7 | 4578 | |
44e1918a | 4579 | -- If directory does not exist, report an error |
b30668b7 | 4580 | |
3249690d | 4581 | if not Dir_Exists then |
f6cf5b85 | 4582 | |
1b685674 VC |
4583 | -- Get the absolute name of the library directory that does |
4584 | -- not exist, to report an error. | |
b30668b7 | 4585 | |
3249690d AC |
4586 | Err_Vars.Error_Msg_File_1 := |
4587 | File_Name_Type (Project.Library_Src_Dir.Display_Name); | |
4588 | Error_Msg | |
e2d9085b | 4589 | (Data.Flags, |
3249690d | 4590 | "Directory { does not exist", |
e2d9085b | 4591 | Lib_Src_Dir.Location, Project); |
44e1918a | 4592 | |
1b685674 | 4593 | -- Report error if it is the same as the object directory |
44e1918a | 4594 | |
66713d62 | 4595 | elsif Project.Library_Src_Dir = Project.Object_Directory then |
7324bf49 | 4596 | Error_Msg |
e2d9085b | 4597 | (Data.Flags, |
44e1918a AC |
4598 | "directory to copy interfaces cannot be " & |
4599 | "the object directory", | |
e2d9085b | 4600 | Lib_Src_Dir.Location, Project); |
66713d62 | 4601 | Project.Library_Src_Dir := No_Path_Information; |
44e1918a | 4602 | |
7324bf49 | 4603 | else |
44e1918a | 4604 | declare |
104e4daa | 4605 | Src_Dirs : String_List_Id; |
44e1918a | 4606 | Src_Dir : String_Element; |
66713d62 | 4607 | Pid : Project_List; |
7324bf49 | 4608 | |
44e1918a | 4609 | begin |
104e4daa VC |
4610 | -- Interface copy directory cannot be one of the source |
4611 | -- directory of the current project. | |
4612 | ||
66713d62 | 4613 | Src_Dirs := Project.Source_Dirs; |
44e1918a | 4614 | while Src_Dirs /= Nil_String loop |
40ecf2f5 | 4615 | Src_Dir := Shared.String_Elements.Table (Src_Dirs); |
b30668b7 | 4616 | |
44e1918a | 4617 | -- Report error if it is one of the source directories |
b30668b7 | 4618 | |
66713d62 | 4619 | if Project.Library_Src_Dir.Name = |
2c011ce1 | 4620 | Path_Name_Type (Src_Dir.Value) |
751089b2 | 4621 | then |
44e1918a | 4622 | Error_Msg |
e2d9085b | 4623 | (Data.Flags, |
44e1918a AC |
4624 | "directory to copy interfaces cannot " & |
4625 | "be one of the source directories", | |
e2d9085b | 4626 | Lib_Src_Dir.Location, Project); |
66713d62 | 4627 | Project.Library_Src_Dir := No_Path_Information; |
44e1918a AC |
4628 | exit; |
4629 | end if; | |
104e4daa VC |
4630 | |
4631 | Src_Dirs := Src_Dir.Next; | |
44e1918a | 4632 | end loop; |
104e4daa | 4633 | |
66713d62 | 4634 | if Project.Library_Src_Dir /= No_Path_Information then |
104e4daa VC |
4635 | |
4636 | -- It cannot be a source directory of any other | |
4637 | -- project either. | |
4638 | ||
fdd7e7bb | 4639 | Pid := Data.Tree.Projects; |
66713d62 AC |
4640 | Project_Loop : loop |
4641 | exit Project_Loop when Pid = null; | |
4642 | ||
4643 | Src_Dirs := Pid.Project.Source_Dirs; | |
104e4daa VC |
4644 | Dir_Loop : while Src_Dirs /= Nil_String loop |
4645 | Src_Dir := | |
40ecf2f5 | 4646 | Shared.String_Elements.Table (Src_Dirs); |
104e4daa VC |
4647 | |
4648 | -- Report error if it is one of the source | |
2c011ce1 | 4649 | -- directories. |
104e4daa | 4650 | |
66713d62 | 4651 | if Project.Library_Src_Dir.Name = |
ede007da | 4652 | Path_Name_Type (Src_Dir.Value) |
751089b2 VC |
4653 | then |
4654 | Error_Msg_File_1 := | |
4655 | File_Name_Type (Src_Dir.Value); | |
66713d62 | 4656 | Error_Msg_Name_1 := Pid.Project.Name; |
104e4daa | 4657 | Error_Msg |
e2d9085b | 4658 | (Data.Flags, |
104e4daa VC |
4659 | "directory to copy interfaces cannot " & |
4660 | "be the same as source directory { of " & | |
751089b2 | 4661 | "project %%", |
e2d9085b | 4662 | Lib_Src_Dir.Location, Project); |
66713d62 AC |
4663 | Project.Library_Src_Dir := |
4664 | No_Path_Information; | |
104e4daa VC |
4665 | exit Project_Loop; |
4666 | end if; | |
4667 | ||
4668 | Src_Dirs := Src_Dir.Next; | |
4669 | end loop Dir_Loop; | |
66713d62 AC |
4670 | |
4671 | Pid := Pid.Next; | |
104e4daa VC |
4672 | end loop Project_Loop; |
4673 | end if; | |
44e1918a | 4674 | end; |
b30668b7 | 4675 | |
7e98a4c6 VC |
4676 | -- In high verbosity, if there is a valid Library_Src_Dir, |
4677 | -- display its path name. | |
fbf5a39b | 4678 | |
66713d62 | 4679 | if Project.Library_Src_Dir /= No_Path_Information |
44e1918a AC |
4680 | and then Current_Verbosity = High |
4681 | then | |
347ab254 EB |
4682 | Write_Attr |
4683 | ("Directory to copy interfaces", | |
66713d62 | 4684 | Get_Name_String (Project.Library_Src_Dir.Name)); |
44e1918a AC |
4685 | end if; |
4686 | end if; | |
4687 | end; | |
4688 | end if; | |
b30668b7 | 4689 | |
7e98a4c6 VC |
4690 | -- Check the symbol related attributes |
4691 | ||
4692 | -- First, the symbol policy | |
4693 | ||
44e1918a AC |
4694 | if not Lib_Symbol_Policy.Default then |
4695 | declare | |
4696 | Value : constant String := | |
32404665 EB |
4697 | To_Lower |
4698 | (Get_Name_String (Lib_Symbol_Policy.Value)); | |
b30668b7 | 4699 | |
44e1918a | 4700 | begin |
7e98a4c6 VC |
4701 | -- Symbol policy must hove one of a limited number of values |
4702 | ||
44e1918a | 4703 | if Value = "autonomous" or else Value = "default" then |
66713d62 | 4704 | Project.Symbol_Data.Symbol_Policy := Autonomous; |
b30668b7 | 4705 | |
44e1918a | 4706 | elsif Value = "compliant" then |
66713d62 | 4707 | Project.Symbol_Data.Symbol_Policy := Compliant; |
b30668b7 | 4708 | |
44e1918a | 4709 | elsif Value = "controlled" then |
66713d62 | 4710 | Project.Symbol_Data.Symbol_Policy := Controlled; |
b30668b7 | 4711 | |
44e1918a | 4712 | elsif Value = "restricted" then |
66713d62 | 4713 | Project.Symbol_Data.Symbol_Policy := Restricted; |
44e1918a | 4714 | |
4f6447c5 | 4715 | elsif Value = "direct" then |
66713d62 | 4716 | Project.Symbol_Data.Symbol_Policy := Direct; |
4f6447c5 | 4717 | |
44e1918a AC |
4718 | else |
4719 | Error_Msg | |
e2d9085b | 4720 | (Data.Flags, |
44e1918a | 4721 | "illegal value for Library_Symbol_Policy", |
e2d9085b | 4722 | Lib_Symbol_Policy.Location, Project); |
44e1918a AC |
4723 | end if; |
4724 | end; | |
7324bf49 | 4725 | end if; |
b30668b7 | 4726 | |
7e98a4c6 | 4727 | -- If attribute Library_Symbol_File is not specified, symbol policy |
ede007da | 4728 | -- cannot be Restricted. |
7e98a4c6 | 4729 | |
44e1918a | 4730 | if Lib_Symbol_File.Default then |
66713d62 | 4731 | if Project.Symbol_Data.Symbol_Policy = Restricted then |
44e1918a | 4732 | Error_Msg |
e2d9085b | 4733 | (Data.Flags, |
44e1918a AC |
4734 | "Library_Symbol_File needs to be defined when " & |
4735 | "symbol policy is Restricted", | |
e2d9085b | 4736 | Lib_Symbol_Policy.Location, Project); |
44e1918a | 4737 | end if; |
b30668b7 | 4738 | |
44e1918a | 4739 | else |
6c1f47ee | 4740 | -- Library_Symbol_File is defined |
7e98a4c6 | 4741 | |
66713d62 | 4742 | Project.Symbol_Data.Symbol_File := |
ede007da | 4743 | Path_Name_Type (Lib_Symbol_File.Value); |
b30668b7 | 4744 | |
44e1918a | 4745 | Get_Name_String (Lib_Symbol_File.Value); |
b30668b7 | 4746 | |
44e1918a AC |
4747 | if Name_Len = 0 then |
4748 | Error_Msg | |
e2d9085b | 4749 | (Data.Flags, |
44e1918a | 4750 | "symbol file name cannot be an empty string", |
e2d9085b | 4751 | Lib_Symbol_File.Location, Project); |
7324bf49 | 4752 | |
ede007da VC |
4753 | else |
4754 | OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)); | |
7324bf49 | 4755 | |
ede007da VC |
4756 | if OK then |
4757 | for J in 1 .. Name_Len loop | |
4758 | if Name_Buffer (J) = '/' | |
4759 | or else Name_Buffer (J) = Directory_Separator | |
4760 | then | |
4761 | OK := False; | |
4762 | exit; | |
4763 | end if; | |
4764 | end loop; | |
4765 | end if; | |
7324bf49 | 4766 | |
ede007da VC |
4767 | if not OK then |
4768 | Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value); | |
4769 | Error_Msg | |
e2d9085b | 4770 | (Data.Flags, |
ede007da | 4771 | "symbol file name { is illegal. " & |
ad6b5b00 | 4772 | "Name cannot include directory info.", |
e2d9085b | 4773 | Lib_Symbol_File.Location, Project); |
ede007da | 4774 | end if; |
44e1918a AC |
4775 | end if; |
4776 | end if; | |
7324bf49 | 4777 | |
7e98a4c6 | 4778 | -- If attribute Library_Reference_Symbol_File is not defined, |
dec55d76 | 4779 | -- symbol policy cannot be Compliant or Controlled. |
7e98a4c6 | 4780 | |
44e1918a | 4781 | if Lib_Ref_Symbol_File.Default then |
66713d62 AC |
4782 | if Project.Symbol_Data.Symbol_Policy = Compliant |
4783 | or else Project.Symbol_Data.Symbol_Policy = Controlled | |
b30668b7 | 4784 | then |
44e1918a | 4785 | Error_Msg |
e2d9085b | 4786 | (Data.Flags, |
991395ab | 4787 | "a reference symbol file needs to be defined", |
e2d9085b | 4788 | Lib_Symbol_Policy.Location, Project); |
b30668b7 VC |
4789 | end if; |
4790 | ||
44e1918a | 4791 | else |
7e98a4c6 VC |
4792 | -- Library_Reference_Symbol_File is defined, check file exists |
4793 | ||
66713d62 | 4794 | Project.Symbol_Data.Reference := |
ede007da | 4795 | Path_Name_Type (Lib_Ref_Symbol_File.Value); |
b30668b7 | 4796 | |
44e1918a | 4797 | Get_Name_String (Lib_Ref_Symbol_File.Value); |
b30668b7 | 4798 | |
44e1918a AC |
4799 | if Name_Len = 0 then |
4800 | Error_Msg | |
e2d9085b | 4801 | (Data.Flags, |
44e1918a | 4802 | "reference symbol file name cannot be an empty string", |
e2d9085b | 4803 | Lib_Symbol_File.Location, Project); |
b30668b7 | 4804 | |
7324bf49 | 4805 | else |
4f6447c5 VC |
4806 | if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then |
4807 | Name_Len := 0; | |
3b3c0430 | 4808 | Add_Str_To_Name_Buffer |
66713d62 | 4809 | (Get_Name_String (Project.Directory.Name)); |
4f6447c5 VC |
4810 | Add_Str_To_Name_Buffer |
4811 | (Get_Name_String (Lib_Ref_Symbol_File.Value)); | |
66713d62 | 4812 | Project.Symbol_Data.Reference := Name_Find; |
b30668b7 | 4813 | end if; |
b30668b7 | 4814 | |
44e1918a | 4815 | if not Is_Regular_File |
32404665 | 4816 | (Get_Name_String (Project.Symbol_Data.Reference)) |
44e1918a | 4817 | then |
751089b2 VC |
4818 | Error_Msg_File_1 := |
4819 | File_Name_Type (Lib_Ref_Symbol_File.Value); | |
88664966 | 4820 | |
4f6447c5 VC |
4821 | -- For controlled and direct symbol policies, it is an error |
4822 | -- if the reference symbol file does not exist. For other | |
4823 | -- symbol policies, this is just a warning | |
88664966 | 4824 | |
3711d646 | 4825 | Error_Msg_Warn := |
66713d62 AC |
4826 | Project.Symbol_Data.Symbol_Policy /= Controlled |
4827 | and then Project.Symbol_Data.Symbol_Policy /= Direct; | |
88664966 | 4828 | |
3711d646 | 4829 | Error_Msg |
e2d9085b | 4830 | (Data.Flags, |
3711d646 | 4831 | "<library reference symbol file { does not exist", |
e2d9085b | 4832 | Lib_Ref_Symbol_File.Location, Project); |
88664966 | 4833 | |
3711d646 RD |
4834 | -- In addition in the non-controlled case, if symbol policy |
4835 | -- is Compliant, it is changed to Autonomous, because there | |
4836 | -- is no reference to check against, and we don't want to | |
4837 | -- fail in this case. | |
88664966 | 4838 | |
66713d62 AC |
4839 | if Project.Symbol_Data.Symbol_Policy /= Controlled then |
4840 | if Project.Symbol_Data.Symbol_Policy = Compliant then | |
4841 | Project.Symbol_Data.Symbol_Policy := Autonomous; | |
88664966 VC |
4842 | end if; |
4843 | end if; | |
44e1918a | 4844 | end if; |
4f6447c5 VC |
4845 | |
4846 | -- If both the reference symbol file and the symbol file are | |
4847 | -- defined, then check that they are not the same file. | |
4848 | ||
66713d62 AC |
4849 | if Project.Symbol_Data.Symbol_File /= No_Path then |
4850 | Get_Name_String (Project.Symbol_Data.Symbol_File); | |
4f6447c5 VC |
4851 | |
4852 | if Name_Len > 0 then | |
4853 | declare | |
32404665 EB |
4854 | -- We do not need to pass a Directory to |
4855 | -- Normalize_Pathname, since the path_information | |
4856 | -- already contains absolute information. | |
4857 | ||
4f6447c5 VC |
4858 | Symb_Path : constant String := |
4859 | Normalize_Pathname | |
4860 | (Get_Name_String | |
66713d62 | 4861 | (Project.Object_Directory.Name) & |
6c1f47ee | 4862 | Name_Buffer (1 .. Name_Len), |
32404665 | 4863 | Directory => "/", |
6c1f47ee EB |
4864 | Resolve_Links => |
4865 | Opt.Follow_Links_For_Files); | |
4f6447c5 VC |
4866 | Ref_Path : constant String := |
4867 | Normalize_Pathname | |
4868 | (Get_Name_String | |
66713d62 | 4869 | (Project.Symbol_Data.Reference), |
32404665 | 4870 | Directory => "/", |
6c1f47ee EB |
4871 | Resolve_Links => |
4872 | Opt.Follow_Links_For_Files); | |
4f6447c5 VC |
4873 | begin |
4874 | if Symb_Path = Ref_Path then | |
4875 | Error_Msg | |
e2d9085b | 4876 | (Data.Flags, |
4f6447c5 VC |
4877 | "library reference symbol file and library" & |
4878 | " symbol file cannot be the same file", | |
e2d9085b | 4879 | Lib_Ref_Symbol_File.Location, Project); |
4f6447c5 VC |
4880 | end if; |
4881 | end; | |
4882 | end if; | |
4883 | end if; | |
44e1918a AC |
4884 | end if; |
4885 | end if; | |
b30668b7 | 4886 | end if; |
44e1918a | 4887 | end Check_Stand_Alone_Library; |
7324bf49 | 4888 | |
cf161d66 AC |
4889 | --------------------- |
4890 | -- Check_Unit_Name -- | |
4891 | --------------------- | |
4892 | ||
4893 | procedure Check_Unit_Name (Name : String; Unit : out Name_Id) is | |
4894 | The_Name : String := Name; | |
4895 | Real_Name : Name_Id; | |
4896 | Need_Letter : Boolean := True; | |
4897 | Last_Underscore : Boolean := False; | |
4898 | OK : Boolean := The_Name'Length > 0; | |
4899 | First : Positive; | |
4900 | ||
4901 | function Is_Reserved (Name : Name_Id) return Boolean; | |
4902 | function Is_Reserved (S : String) return Boolean; | |
4903 | -- Check that the given name is not an Ada 95 reserved word. The reason | |
4904 | -- for the Ada 95 here is that we do not want to exclude the case of an | |
4905 | -- Ada 95 unit called Interface (for example). In Ada 2005, such a unit | |
4906 | -- name would be rejected anyway by the compiler. That means there is no | |
4907 | -- requirement that the project file parser reject this. | |
4908 | ||
4909 | ----------------- | |
4910 | -- Is_Reserved -- | |
4911 | ----------------- | |
4912 | ||
4913 | function Is_Reserved (S : String) return Boolean is | |
4914 | begin | |
4915 | Name_Len := 0; | |
4916 | Add_Str_To_Name_Buffer (S); | |
4917 | return Is_Reserved (Name_Find); | |
4918 | end Is_Reserved; | |
4919 | ||
4920 | ----------------- | |
4921 | -- Is_Reserved -- | |
4922 | ----------------- | |
4923 | ||
4924 | function Is_Reserved (Name : Name_Id) return Boolean is | |
4925 | begin | |
4926 | if Get_Name_Table_Byte (Name) /= 0 | |
4927 | and then Name /= Name_Project | |
4928 | and then Name /= Name_Extends | |
4929 | and then Name /= Name_External | |
4930 | and then Name not in Ada_2005_Reserved_Words | |
4931 | then | |
4932 | Unit := No_Name; | |
4933 | Debug_Output ("Ada reserved word: ", Name); | |
4934 | return True; | |
4935 | ||
4936 | else | |
4937 | return False; | |
4938 | end if; | |
4939 | end Is_Reserved; | |
4940 | ||
4941 | -- Start of processing for Check_Unit_Name | |
4942 | ||
4943 | begin | |
4944 | To_Lower (The_Name); | |
4945 | ||
4946 | Name_Len := The_Name'Length; | |
4947 | Name_Buffer (1 .. Name_Len) := The_Name; | |
4948 | ||
4949 | -- Special cases of children of packages A, G, I and S on VMS | |
4950 | ||
4951 | if OpenVMS_On_Target | |
4952 | and then Name_Len > 3 | |
4953 | and then Name_Buffer (2 .. 3) = "__" | |
4954 | and then | |
4955 | ((Name_Buffer (1) = 'a') or else | |
4956 | (Name_Buffer (1) = 'g') or else | |
4957 | (Name_Buffer (1) = 'i') or else | |
4958 | (Name_Buffer (1) = 's')) | |
4959 | then | |
4960 | Name_Buffer (2) := '.'; | |
4961 | Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len); | |
4962 | Name_Len := Name_Len - 1; | |
4963 | end if; | |
4964 | ||
4965 | Real_Name := Name_Find; | |
4966 | ||
4967 | if Is_Reserved (Real_Name) then | |
4968 | return; | |
4969 | end if; | |
4970 | ||
4971 | First := The_Name'First; | |
4972 | ||
4973 | for Index in The_Name'Range loop | |
4974 | if Need_Letter then | |
4975 | ||
4976 | -- We need a letter (at the beginning, and following a dot), | |
4977 | -- but we don't have one. | |
4978 | ||
4979 | if Is_Letter (The_Name (Index)) then | |
4980 | Need_Letter := False; | |
4981 | ||
4982 | else | |
4983 | OK := False; | |
4984 | ||
4985 | if Current_Verbosity = High then | |
4986 | Debug_Indent; | |
4987 | Write_Int (Types.Int (Index)); | |
4988 | Write_Str (": '"); | |
4989 | Write_Char (The_Name (Index)); | |
4990 | Write_Line ("' is not a letter."); | |
4991 | end if; | |
4992 | ||
4993 | exit; | |
4994 | end if; | |
4995 | ||
4996 | elsif Last_Underscore | |
4997 | and then (The_Name (Index) = '_' or else The_Name (Index) = '.') | |
4998 | then | |
4999 | -- Two underscores are illegal, and a dot cannot follow | |
5000 | -- an underscore. | |
5001 | ||
5002 | OK := False; | |
5003 | ||
5004 | if Current_Verbosity = High then | |
5005 | Debug_Indent; | |
5006 | Write_Int (Types.Int (Index)); | |
5007 | Write_Str (": '"); | |
5008 | Write_Char (The_Name (Index)); | |
5009 | Write_Line ("' is illegal here."); | |
5010 | end if; | |
5011 | ||
5012 | exit; | |
5013 | ||
5014 | elsif The_Name (Index) = '.' then | |
5015 | ||
5016 | -- First, check if the name before the dot is not a reserved word | |
5017 | ||
5018 | if Is_Reserved (The_Name (First .. Index - 1)) then | |
5019 | return; | |
5020 | end if; | |
5021 | ||
5022 | First := Index + 1; | |
5023 | ||
5024 | -- We need a letter after a dot | |
5025 | ||
5026 | Need_Letter := True; | |
5027 | ||
5028 | elsif The_Name (Index) = '_' then | |
5029 | Last_Underscore := True; | |
5030 | ||
5031 | else | |
5032 | -- We need an letter or a digit | |
5033 | ||
5034 | Last_Underscore := False; | |
5035 | ||
5036 | if not Is_Alphanumeric (The_Name (Index)) then | |
5037 | OK := False; | |
5038 | ||
5039 | if Current_Verbosity = High then | |
5040 | Debug_Indent; | |
5041 | Write_Int (Types.Int (Index)); | |
5042 | Write_Str (": '"); | |
5043 | Write_Char (The_Name (Index)); | |
5044 | Write_Line ("' is not alphanumeric."); | |
5045 | end if; | |
5046 | ||
5047 | exit; | |
5048 | end if; | |
5049 | end if; | |
5050 | end loop; | |
5051 | ||
5052 | -- Cannot end with an underscore or a dot | |
5053 | ||
5054 | OK := OK and then not Need_Letter and then not Last_Underscore; | |
5055 | ||
5056 | if OK then | |
5057 | if First /= Name'First and then | |
5058 | Is_Reserved (The_Name (First .. The_Name'Last)) | |
5059 | then | |
5060 | return; | |
5061 | end if; | |
5062 | ||
5063 | Unit := Real_Name; | |
5064 | ||
5065 | else | |
5066 | -- Signal a problem with No_Name | |
5067 | ||
5068 | Unit := No_Name; | |
5069 | end if; | |
5070 | end Check_Unit_Name; | |
5071 | ||
7324bf49 AC |
5072 | ---------------------------- |
5073 | -- Compute_Directory_Last -- | |
5074 | ---------------------------- | |
5075 | ||
5076 | function Compute_Directory_Last (Dir : String) return Natural is | |
5077 | begin | |
5078 | if Dir'Length > 1 | |
5079 | and then (Dir (Dir'Last - 1) = Directory_Separator | |
2c011ce1 RD |
5080 | or else |
5081 | Dir (Dir'Last - 1) = '/') | |
7324bf49 AC |
5082 | then |
5083 | return Dir'Last - 1; | |
5084 | else | |
5085 | return Dir'Last; | |
5086 | end if; | |
5087 | end Compute_Directory_Last; | |
b30668b7 | 5088 | |
44e1918a AC |
5089 | --------------------- |
5090 | -- Get_Directories -- | |
5091 | --------------------- | |
7324bf49 | 5092 | |
44e1918a | 5093 | procedure Get_Directories |
008f6fd3 AC |
5094 | (Project : Project_Id; |
5095 | Data : in out Tree_Processing_Data) | |
44e1918a | 5096 | is |
40ecf2f5 EB |
5097 | Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; |
5098 | ||
2f41ec1a VC |
5099 | Object_Dir : constant Variable_Value := |
5100 | Util.Value_Of | |
40ecf2f5 | 5101 | (Name_Object_Dir, Project.Decl.Attributes, Shared); |
7324bf49 | 5102 | |
1b685674 VC |
5103 | Exec_Dir : constant Variable_Value := |
5104 | Util.Value_Of | |
40ecf2f5 | 5105 | (Name_Exec_Dir, Project.Decl.Attributes, Shared); |
7324bf49 | 5106 | |
44e1918a AC |
5107 | Source_Dirs : constant Variable_Value := |
5108 | Util.Value_Of | |
40ecf2f5 | 5109 | (Name_Source_Dirs, Project.Decl.Attributes, Shared); |
7324bf49 | 5110 | |
e7efbe2f AC |
5111 | Ignore_Source_Sub_Dirs : constant Variable_Value := |
5112 | Util.Value_Of | |
5113 | (Name_Ignore_Source_Sub_Dirs, | |
5114 | Project.Decl.Attributes, | |
40ecf2f5 | 5115 | Shared); |
e7efbe2f | 5116 | |
1d7d0be6 | 5117 | Excluded_Source_Dirs : constant Variable_Value := |
4f6447c5 | 5118 | Util.Value_Of |
1d7d0be6 | 5119 | (Name_Excluded_Source_Dirs, |
66713d62 | 5120 | Project.Decl.Attributes, |
40ecf2f5 | 5121 | Shared); |
4f6447c5 | 5122 | |
ede007da VC |
5123 | Source_Files : constant Variable_Value := |
5124 | Util.Value_Of | |
fdd7e7bb | 5125 | (Name_Source_Files, |
40ecf2f5 | 5126 | Project.Decl.Attributes, Shared); |
ede007da | 5127 | |
75a64833 AC |
5128 | Last_Source_Dir : String_List_Id := Nil_String; |
5129 | Last_Src_Dir_Rank : Number_List_Index := No_Number_List; | |
618fb570 | 5130 | |
93bcda23 AC |
5131 | Languages : constant Variable_Value := |
5132 | Prj.Util.Value_Of | |
40ecf2f5 | 5133 | (Name_Languages, Project.Decl.Attributes, Shared); |
93bcda23 | 5134 | |
c5be6c3a | 5135 | Remove_Source_Dirs : Boolean := False; |
7324bf49 | 5136 | |
48b351d9 | 5137 | procedure Add_To_Or_Remove_From_Source_Dirs |
2c1b72d7 AC |
5138 | (Path : Path_Information; |
5139 | Rank : Natural); | |
48b351d9 AC |
5140 | -- When Removed = False, the directory Path_Id to the list of |
5141 | -- source_dirs if not already in the list. When Removed = True, | |
5142 | -- removed directory Path_Id if in the list. | |
5143 | ||
c5be6c3a EB |
5144 | procedure Find_Source_Dirs is new Expand_Subdirectory_Pattern |
5145 | (Add_To_Or_Remove_From_Source_Dirs); | |
5146 | ||
48b351d9 AC |
5147 | --------------------------------------- |
5148 | -- Add_To_Or_Remove_From_Source_Dirs -- | |
5149 | --------------------------------------- | |
5150 | ||
5151 | procedure Add_To_Or_Remove_From_Source_Dirs | |
2c1b72d7 AC |
5152 | (Path : Path_Information; |
5153 | Rank : Natural) | |
751089b2 | 5154 | is |
2c1b72d7 AC |
5155 | List : String_List_Id; |
5156 | Prev : String_List_Id; | |
5157 | Rank_List : Number_List_Index; | |
5158 | Prev_Rank : Number_List_Index; | |
5159 | Element : String_Element; | |
5f3f175d | 5160 | |
48b351d9 AC |
5161 | begin |
5162 | Prev := Nil_String; | |
5163 | Prev_Rank := No_Number_List; | |
5164 | List := Project.Source_Dirs; | |
5165 | Rank_List := Project.Source_Dir_Ranks; | |
5166 | while List /= Nil_String loop | |
40ecf2f5 | 5167 | Element := Shared.String_Elements.Table (List); |
76e3504f | 5168 | exit when Element.Value = Name_Id (Path.Name); |
48b351d9 AC |
5169 | Prev := List; |
5170 | List := Element.Next; | |
5171 | Prev_Rank := Rank_List; | |
40ecf2f5 | 5172 | Rank_List := Shared.Number_Lists.Table (Prev_Rank).Next; |
48b351d9 | 5173 | end loop; |
7324bf49 | 5174 | |
48b351d9 | 5175 | -- The directory is in the list if List is not Nil_String |
7324bf49 | 5176 | |
c5be6c3a | 5177 | if not Remove_Source_Dirs and then List = Nil_String then |
2598ee6d | 5178 | Debug_Output ("adding source dir=", Name_Id (Path.Display_Name)); |
69ba91ed | 5179 | |
40ecf2f5 | 5180 | String_Element_Table.Increment_Last (Shared.String_Elements); |
48b351d9 | 5181 | Element := |
76e3504f | 5182 | (Value => Name_Id (Path.Name), |
48b351d9 | 5183 | Index => 0, |
76e3504f | 5184 | Display_Value => Name_Id (Path.Display_Name), |
48b351d9 AC |
5185 | Location => No_Location, |
5186 | Flag => False, | |
5187 | Next => Nil_String); | |
b30668b7 | 5188 | |
40ecf2f5 | 5189 | Number_List_Table.Increment_Last (Shared.Number_Lists); |
aa720a54 | 5190 | |
48b351d9 | 5191 | if Last_Source_Dir = Nil_String then |
b30668b7 | 5192 | |
48b351d9 | 5193 | -- This is the first source directory |
b30668b7 | 5194 | |
48b351d9 | 5195 | Project.Source_Dirs := |
40ecf2f5 | 5196 | String_Element_Table.Last (Shared.String_Elements); |
48b351d9 | 5197 | Project.Source_Dir_Ranks := |
40ecf2f5 | 5198 | Number_List_Table.Last (Shared.Number_Lists); |
75a64833 | 5199 | |
48b351d9 AC |
5200 | else |
5201 | -- We already have source directories, link the previous | |
5202 | -- last to the new one. | |
5f3f175d | 5203 | |
40ecf2f5 EB |
5204 | Shared.String_Elements.Table (Last_Source_Dir).Next := |
5205 | String_Element_Table.Last (Shared.String_Elements); | |
5206 | Shared.Number_Lists.Table (Last_Src_Dir_Rank).Next := | |
5207 | Number_List_Table.Last (Shared.Number_Lists); | |
48b351d9 | 5208 | end if; |
5f3f175d | 5209 | |
48b351d9 | 5210 | -- And register this source directory as the new last |
b30668b7 | 5211 | |
48b351d9 | 5212 | Last_Source_Dir := |
40ecf2f5 EB |
5213 | String_Element_Table.Last (Shared.String_Elements); |
5214 | Shared.String_Elements.Table (Last_Source_Dir) := Element; | |
5215 | Last_Src_Dir_Rank := Number_List_Table.Last (Shared.Number_Lists); | |
5216 | Shared.Number_Lists.Table (Last_Src_Dir_Rank) := | |
48b351d9 | 5217 | (Number => Rank, Next => No_Number_List); |
b30668b7 | 5218 | |
c5be6c3a | 5219 | elsif Remove_Source_Dirs and then List /= Nil_String then |
07fc65c4 | 5220 | |
1aa23421 | 5221 | -- Remove source dir if present |
fbf5a39b | 5222 | |
48b351d9 | 5223 | if Prev = Nil_String then |
40ecf2f5 | 5224 | Project.Source_Dirs := Shared.String_Elements.Table (List).Next; |
48b351d9 | 5225 | Project.Source_Dir_Ranks := |
40ecf2f5 | 5226 | Shared.Number_Lists.Table (Rank_List).Next; |
4f6447c5 | 5227 | |
48b351d9 | 5228 | else |
40ecf2f5 EB |
5229 | Shared.String_Elements.Table (Prev).Next := |
5230 | Shared.String_Elements.Table (List).Next; | |
5231 | Shared.Number_Lists.Table (Prev_Rank).Next := | |
5232 | Shared.Number_Lists.Table (Rank_List).Next; | |
48b351d9 AC |
5233 | end if; |
5234 | end if; | |
5235 | end Add_To_Or_Remove_From_Source_Dirs; | |
69ba91ed | 5236 | |
39eb6542 AC |
5237 | -- Local declarations |
5238 | ||
3249690d AC |
5239 | Dir_Exists : Boolean; |
5240 | ||
9db0b232 | 5241 | No_Sources : constant Boolean := |
39eb6542 | 5242 | ((not Source_Files.Default |
67c86178 | 5243 | and then Source_Files.Values = Nil_String) |
86828d40 AC |
5244 | or else |
5245 | (not Source_Dirs.Default | |
67c86178 | 5246 | and then Source_Dirs.Values = Nil_String) |
86828d40 AC |
5247 | or else |
5248 | (not Languages.Default | |
67c86178 | 5249 | and then Languages.Values = Nil_String)) |
39eb6542 | 5250 | and then Project.Extends = No_Project; |
9db0b232 AC |
5251 | |
5252 | -- Start of processing for Get_Directories | |
5253 | ||
44e1918a | 5254 | begin |
2598ee6d | 5255 | Debug_Output ("starting to look for directories"); |
07fc65c4 | 5256 | |
93bcda23 AC |
5257 | -- Set the object directory to its default which may be nil, if there |
5258 | -- is no sources in the project. | |
91b1417d | 5259 | |
9db0b232 | 5260 | if No_Sources then |
66713d62 | 5261 | Project.Object_Directory := No_Path_Information; |
44e1918a | 5262 | else |
66713d62 | 5263 | Project.Object_Directory := Project.Directory; |
44e1918a | 5264 | end if; |
19235870 | 5265 | |
f7ca1d04 AC |
5266 | -- Check the object directory |
5267 | ||
f7ca1d04 AC |
5268 | if Object_Dir.Value /= Empty_String then |
5269 | Get_Name_String (Object_Dir.Value); | |
5270 | ||
5271 | if Name_Len = 0 then | |
5272 | Error_Msg | |
e2d9085b | 5273 | (Data.Flags, |
f7ca1d04 | 5274 | "Object_Dir cannot be empty", |
e2d9085b | 5275 | Object_Dir.Location, Project); |
f7ca1d04 | 5276 | |
9db0b232 | 5277 | elsif not No_Sources then |
39eb6542 | 5278 | |
3249690d AC |
5279 | -- We check that the specified object directory does exist. |
5280 | -- However, even when it doesn't exist, we set it to a default | |
5281 | -- value. This is for the benefit of tools that recover from | |
5282 | -- errors; for example, these tools could create the non existent | |
f6cf5b85 | 5283 | -- directory. We always return an absolute directory name though. |
f7ca1d04 AC |
5284 | |
5285 | Locate_Directory | |
5286 | (Project, | |
f7ca1d04 | 5287 | File_Name_Type (Object_Dir.Value), |
3249690d | 5288 | Path => Project.Object_Directory, |
f7ca1d04 | 5289 | Create => "object", |
3249690d | 5290 | Dir_Exists => Dir_Exists, |
fdd7e7bb | 5291 | Data => Data, |
f7ca1d04 | 5292 | Location => Object_Dir.Location, |
3249690d | 5293 | Must_Exist => False, |
66713d62 | 5294 | Externally_Built => Project.Externally_Built); |
f7ca1d04 | 5295 | |
86828d40 | 5296 | if not Dir_Exists and then not Project.Externally_Built then |
67c86178 | 5297 | |
39eb6542 AC |
5298 | -- The object directory does not exist, report an error if the |
5299 | -- project is not externally built. | |
f7ca1d04 | 5300 | |
3249690d AC |
5301 | Err_Vars.Error_Msg_File_1 := |
5302 | File_Name_Type (Object_Dir.Value); | |
e771c085 AC |
5303 | Error_Or_Warning |
5304 | (Data.Flags, Data.Flags.Require_Obj_Dirs, | |
5305 | "object directory { not found", Project.Location, Project); | |
f7ca1d04 AC |
5306 | end if; |
5307 | end if; | |
5308 | ||
9db0b232 | 5309 | elsif not No_Sources and then Subdirs /= null then |
f7ca1d04 AC |
5310 | Name_Len := 1; |
5311 | Name_Buffer (1) := '.'; | |
5312 | Locate_Directory | |
5313 | (Project, | |
f7ca1d04 | 5314 | Name_Find, |
3249690d | 5315 | Path => Project.Object_Directory, |
f7ca1d04 | 5316 | Create => "object", |
3249690d | 5317 | Dir_Exists => Dir_Exists, |
fdd7e7bb | 5318 | Data => Data, |
f7ca1d04 | 5319 | Location => Object_Dir.Location, |
66713d62 | 5320 | Externally_Built => Project.Externally_Built); |
f7ca1d04 AC |
5321 | end if; |
5322 | ||
5323 | if Current_Verbosity = High then | |
66713d62 | 5324 | if Project.Object_Directory = No_Path_Information then |
2598ee6d | 5325 | Debug_Output ("no object directory"); |
f7ca1d04 | 5326 | else |
347ab254 EB |
5327 | Write_Attr |
5328 | ("Object directory", | |
66713d62 | 5329 | Get_Name_String (Project.Object_Directory.Display_Name)); |
f7ca1d04 AC |
5330 | end if; |
5331 | end if; | |
5332 | ||
5333 | -- Check the exec directory | |
5334 | ||
f7ca1d04 AC |
5335 | -- We set the object directory to its default |
5336 | ||
86828d40 | 5337 | Project.Exec_Directory := Project.Object_Directory; |
f7ca1d04 AC |
5338 | |
5339 | if Exec_Dir.Value /= Empty_String then | |
5340 | Get_Name_String (Exec_Dir.Value); | |
5341 | ||
5342 | if Name_Len = 0 then | |
5343 | Error_Msg | |
e2d9085b | 5344 | (Data.Flags, |
f7ca1d04 | 5345 | "Exec_Dir cannot be empty", |
e2d9085b | 5346 | Exec_Dir.Location, Project); |
f7ca1d04 | 5347 | |
9db0b232 | 5348 | elsif not No_Sources then |
39eb6542 | 5349 | |
f7ca1d04 AC |
5350 | -- We check that the specified exec directory does exist |
5351 | ||
5352 | Locate_Directory | |
5353 | (Project, | |
f7ca1d04 | 5354 | File_Name_Type (Exec_Dir.Value), |
3249690d AC |
5355 | Path => Project.Exec_Directory, |
5356 | Dir_Exists => Dir_Exists, | |
fdd7e7bb | 5357 | Data => Data, |
f7ca1d04 AC |
5358 | Create => "exec", |
5359 | Location => Exec_Dir.Location, | |
66713d62 | 5360 | Externally_Built => Project.Externally_Built); |
f7ca1d04 | 5361 | |
3249690d | 5362 | if not Dir_Exists then |
f7ca1d04 | 5363 | Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value); |
0d901290 AC |
5364 | Error_Or_Warning |
5365 | (Data.Flags, Data.Flags.Missing_Source_Files, | |
5366 | "exec directory { not found", Project.Location, Project); | |
f7ca1d04 AC |
5367 | end if; |
5368 | end if; | |
5369 | end if; | |
5370 | ||
5371 | if Current_Verbosity = High then | |
66713d62 | 5372 | if Project.Exec_Directory = No_Path_Information then |
2598ee6d | 5373 | Debug_Output ("no exec directory"); |
f7ca1d04 | 5374 | else |
3e582869 | 5375 | Debug_Output |
2598ee6d | 5376 | ("exec directory: ", |
3e582869 | 5377 | Name_Id (Project.Exec_Directory.Display_Name)); |
f7ca1d04 AC |
5378 | end if; |
5379 | end if; | |
93bcda23 AC |
5380 | |
5381 | -- Look for the source directories | |
5382 | ||
2598ee6d | 5383 | Debug_Output ("starting to look for source directories"); |
93bcda23 AC |
5384 | |
5385 | pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list"); | |
5386 | ||
48b351d9 | 5387 | if not Source_Files.Default |
f6cf5b85 | 5388 | and then Source_Files.Values = Nil_String |
93bcda23 | 5389 | then |
66713d62 | 5390 | Project.Source_Dirs := Nil_String; |
93bcda23 | 5391 | |
66713d62 | 5392 | if Project.Qualifier = Standard then |
93bcda23 | 5393 | Error_Msg |
e2d9085b | 5394 | (Data.Flags, |
93bcda23 | 5395 | "a standard project cannot have no sources", |
e2d9085b | 5396 | Source_Files.Location, Project); |
93bcda23 AC |
5397 | end if; |
5398 | ||
5399 | elsif Source_Dirs.Default then | |
1aa23421 | 5400 | |
93bcda23 | 5401 | -- No Source_Dirs specified: the single source directory is the one |
f6cf5b85 | 5402 | -- containing the project file. |
93bcda23 | 5403 | |
c5be6c3a | 5404 | Remove_Source_Dirs := False; |
48b351d9 | 5405 | Add_To_Or_Remove_From_Source_Dirs |
86828d40 AC |
5406 | (Path => (Name => Project.Directory.Name, |
5407 | Display_Name => Project.Directory.Display_Name), | |
5408 | Rank => 1); | |
93bcda23 AC |
5409 | |
5410 | else | |
c5be6c3a EB |
5411 | Remove_Source_Dirs := False; |
5412 | Find_Source_Dirs | |
86828d40 AC |
5413 | (Project => Project, |
5414 | Data => Data, | |
5415 | Patterns => Source_Dirs.Values, | |
5416 | Ignore => Ignore_Source_Sub_Dirs.Values, | |
5417 | Search_For => Search_Directories, | |
5418 | Resolve_Links => Opt.Follow_Links_For_Dirs); | |
c5be6c3a EB |
5419 | |
5420 | if Project.Source_Dirs = Nil_String | |
5421 | and then Project.Qualifier = Standard | |
5422 | then | |
5423 | Error_Msg | |
5424 | (Data.Flags, | |
5425 | "a standard project cannot have no source directories", | |
5426 | Source_Dirs.Location, Project); | |
5427 | end if; | |
93bcda23 AC |
5428 | end if; |
5429 | ||
5430 | if not Excluded_Source_Dirs.Default | |
5431 | and then Excluded_Source_Dirs.Values /= Nil_String | |
5432 | then | |
c5be6c3a EB |
5433 | Remove_Source_Dirs := True; |
5434 | Find_Source_Dirs | |
86828d40 AC |
5435 | (Project => Project, |
5436 | Data => Data, | |
5437 | Patterns => Excluded_Source_Dirs.Values, | |
5438 | Ignore => Nil_String, | |
5439 | Search_For => Search_Directories, | |
5440 | Resolve_Links => Opt.Follow_Links_For_Dirs); | |
93bcda23 AC |
5441 | end if; |
5442 | ||
2598ee6d | 5443 | Debug_Output ("putting source directories in canonical cases"); |
93bcda23 AC |
5444 | |
5445 | declare | |
66713d62 | 5446 | Current : String_List_Id := Project.Source_Dirs; |
93bcda23 AC |
5447 | Element : String_Element; |
5448 | ||
5449 | begin | |
5450 | while Current /= Nil_String loop | |
40ecf2f5 | 5451 | Element := Shared.String_Elements.Table (Current); |
93bcda23 | 5452 | if Element.Value /= No_Name then |
347ab254 | 5453 | Element.Value := |
a8930b80 | 5454 | Name_Id (Canonical_Case_File_Name (Element.Value)); |
40ecf2f5 | 5455 | Shared.String_Elements.Table (Current) := Element; |
93bcda23 AC |
5456 | end if; |
5457 | ||
5458 | Current := Element.Next; | |
5459 | end loop; | |
5460 | end; | |
44e1918a | 5461 | end Get_Directories; |
19235870 | 5462 | |
44e1918a AC |
5463 | --------------- |
5464 | -- Get_Mains -- | |
5465 | --------------- | |
19235870 | 5466 | |
7e98a4c6 VC |
5467 | procedure Get_Mains |
5468 | (Project : Project_Id; | |
fdd7e7bb | 5469 | Data : in out Tree_Processing_Data) |
2f41ec1a | 5470 | is |
40ecf2f5 EB |
5471 | Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; |
5472 | ||
44e1918a | 5473 | Mains : constant Variable_Value := |
fdd7e7bb | 5474 | Prj.Util.Value_Of |
40ecf2f5 | 5475 | (Name_Main, Project.Decl.Attributes, Shared); |
ecc4ddde AC |
5476 | List : String_List_Id; |
5477 | Elem : String_Element; | |
19235870 | 5478 | |
44e1918a | 5479 | begin |
66713d62 | 5480 | Project.Mains := Mains.Values; |
19235870 | 5481 | |
4f6447c5 VC |
5482 | -- If no Mains were specified, and if we are an extending project, |
5483 | -- inherit the Mains from the project we are extending. | |
19235870 | 5484 | |
44e1918a | 5485 | if Mains.Default then |
66713d62 AC |
5486 | if not Project.Library and then Project.Extends /= No_Project then |
5487 | Project.Mains := Project.Extends.Mains; | |
44e1918a | 5488 | end if; |
fbf5a39b | 5489 | |
44e1918a | 5490 | -- In a library project file, Main cannot be specified |
07fc65c4 | 5491 | |
66713d62 | 5492 | elsif Project.Library then |
44e1918a | 5493 | Error_Msg |
e2d9085b | 5494 | (Data.Flags, |
44e1918a | 5495 | "a library project file cannot have Main specified", |
e2d9085b | 5496 | Mains.Location, Project); |
ecc4ddde AC |
5497 | |
5498 | else | |
5499 | List := Mains.Values; | |
5500 | while List /= Nil_String loop | |
40ecf2f5 | 5501 | Elem := Shared.String_Elements.Table (List); |
ecc4ddde AC |
5502 | |
5503 | if Length_Of_Name (Elem.Value) = 0 then | |
5504 | Error_Msg | |
e2d9085b | 5505 | (Data.Flags, |
ecc4ddde | 5506 | "?a main cannot have an empty name", |
e2d9085b | 5507 | Elem.Location, Project); |
ecc4ddde AC |
5508 | exit; |
5509 | end if; | |
5510 | ||
5511 | List := Elem.Next; | |
5512 | end loop; | |
44e1918a AC |
5513 | end if; |
5514 | end Get_Mains; | |
19235870 | 5515 | |
44e1918a AC |
5516 | --------------------------- |
5517 | -- Get_Sources_From_File -- | |
5518 | --------------------------- | |
fbf5a39b | 5519 | |
44e1918a AC |
5520 | procedure Get_Sources_From_File |
5521 | (Path : String; | |
5522 | Location : Source_Ptr; | |
fdd7e7bb EB |
5523 | Project : in out Project_Processing_Data; |
5524 | Data : in out Tree_Processing_Data) | |
44e1918a AC |
5525 | is |
5526 | File : Prj.Util.Text_File; | |
5527 | Line : String (1 .. 250); | |
5528 | Last : Natural; | |
751089b2 | 5529 | Source_Name : File_Name_Type; |
ede007da | 5530 | Name_Loc : Name_Location; |
19235870 | 5531 | |
44e1918a | 5532 | begin |
44e1918a | 5533 | if Current_Verbosity = High then |
2598ee6d | 5534 | Debug_Output ("opening """ & Path & '"'); |
44e1918a | 5535 | end if; |
fbf5a39b | 5536 | |
44e1918a | 5537 | -- Open the file |
fbf5a39b | 5538 | |
44e1918a | 5539 | Prj.Util.Open (File, Path); |
fbf5a39b | 5540 | |
44e1918a | 5541 | if not Prj.Util.Is_Valid (File) then |
e2d9085b EB |
5542 | Error_Msg |
5543 | (Data.Flags, "file does not exist", Location, Project.Project); | |
289176c9 | 5544 | |
44e1918a AC |
5545 | else |
5546 | -- Read the lines one by one | |
fbf5a39b | 5547 | |
44e1918a AC |
5548 | while not Prj.Util.End_Of_File (File) loop |
5549 | Prj.Util.Get_Line (File, Line, Last); | |
fbf5a39b | 5550 | |
44e1918a | 5551 | -- A non empty, non comment line should contain a file name |
555360a5 | 5552 | |
44e1918a AC |
5553 | if Last /= 0 |
5554 | and then (Last = 1 or else Line (1 .. 2) /= "--") | |
5555 | then | |
44e1918a AC |
5556 | Name_Len := Last; |
5557 | Name_Buffer (1 .. Name_Len) := Line (1 .. Last); | |
5558 | Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); | |
5559 | Source_Name := Name_Find; | |
6c1f47ee EB |
5560 | |
5561 | -- Check that there is no directory information | |
5562 | ||
5563 | for J in 1 .. Last loop | |
5564 | if Line (J) = '/' or else Line (J) = Directory_Separator then | |
5565 | Error_Msg_File_1 := Source_Name; | |
5566 | Error_Msg | |
e2d9085b | 5567 | (Data.Flags, |
6c1f47ee | 5568 | "file name cannot include directory information ({)", |
e2d9085b | 5569 | Location, Project.Project); |
6c1f47ee EB |
5570 | exit; |
5571 | end if; | |
5572 | end loop; | |
5573 | ||
fdd7e7bb EB |
5574 | Name_Loc := Source_Names_Htable.Get |
5575 | (Project.Source_Names, Source_Name); | |
ede007da VC |
5576 | |
5577 | if Name_Loc = No_Name_Location then | |
5578 | Name_Loc := | |
44e1918a AC |
5579 | (Name => Source_Name, |
5580 | Location => Location, | |
ede007da | 5581 | Source => No_Source, |
602a7ec0 | 5582 | Listed => True, |
ede007da | 5583 | Found => False); |
602a7ec0 AC |
5584 | |
5585 | else | |
5586 | Name_Loc.Listed := True; | |
ede007da VC |
5587 | end if; |
5588 | ||
fdd7e7bb EB |
5589 | Source_Names_Htable.Set |
5590 | (Project.Source_Names, Source_Name, Name_Loc); | |
44e1918a AC |
5591 | end if; |
5592 | end loop; | |
19235870 | 5593 | |
44e1918a | 5594 | Prj.Util.Close (File); |
19235870 | 5595 | |
44e1918a AC |
5596 | end if; |
5597 | end Get_Sources_From_File; | |
19235870 | 5598 | |
1f6439e3 AC |
5599 | ------------------ |
5600 | -- No_Space_Img -- | |
5601 | ------------------ | |
5602 | ||
5603 | function No_Space_Img (N : Natural) return String is | |
5604 | Image : constant String := N'Img; | |
5605 | begin | |
5606 | return Image (2 .. Image'Last); | |
5607 | end No_Space_Img; | |
5608 | ||
ce30eccb EB |
5609 | ----------------------- |
5610 | -- Compute_Unit_Name -- | |
5611 | ----------------------- | |
19235870 | 5612 | |
ce30eccb | 5613 | procedure Compute_Unit_Name |
84157c9a RD |
5614 | (File_Name : File_Name_Type; |
5615 | Naming : Lang_Naming_Data; | |
5616 | Kind : out Source_Kind; | |
5617 | Unit : out Name_Id; | |
fdd7e7bb | 5618 | Project : Project_Processing_Data; |
84157c9a | 5619 | In_Tree : Project_Tree_Ref) |
44e1918a | 5620 | is |
f6cf5b85 AC |
5621 | Filename : constant String := Get_Name_String (File_Name); |
5622 | Last : Integer := Filename'Last; | |
7bccff24 EB |
5623 | Sep_Len : Integer; |
5624 | Body_Len : Integer; | |
5625 | Spec_Len : Integer; | |
d9c0e057 AC |
5626 | |
5627 | Unit_Except : Unit_Exception; | |
5628 | Masked : Boolean := False; | |
84157c9a | 5629 | |
44e1918a | 5630 | begin |
ce30eccb EB |
5631 | Unit := No_Name; |
5632 | Kind := Spec; | |
19235870 | 5633 | |
7bccff24 EB |
5634 | if Naming.Separate_Suffix = No_File |
5635 | or else Naming.Body_Suffix = No_File | |
5636 | or else Naming.Spec_Suffix = No_File | |
5637 | then | |
5638 | return; | |
5639 | end if; | |
5640 | ||
fadcf313 | 5641 | if Naming.Dot_Replacement = No_File then |
2598ee6d | 5642 | Debug_Output ("no dot_replacement specified"); |
44e1918a AC |
5643 | return; |
5644 | end if; | |
19235870 | 5645 | |
7bccff24 EB |
5646 | Sep_Len := Integer (Length_Of_Name (Naming.Separate_Suffix)); |
5647 | Spec_Len := Integer (Length_Of_Name (Naming.Spec_Suffix)); | |
5648 | Body_Len := Integer (Length_Of_Name (Naming.Body_Suffix)); | |
5649 | ||
ce30eccb EB |
5650 | -- Choose the longest suffix that matches. If there are several matches, |
5651 | -- give priority to specs, then bodies, then separates. | |
6c1f47ee | 5652 | |
fadcf313 AC |
5653 | if Naming.Separate_Suffix /= Naming.Body_Suffix |
5654 | and then Suffix_Matches (Filename, Naming.Separate_Suffix) | |
ce30eccb EB |
5655 | then |
5656 | Last := Filename'Last - Sep_Len; | |
5657 | Kind := Sep; | |
5658 | end if; | |
fbf5a39b | 5659 | |
ce30eccb | 5660 | if Filename'Last - Body_Len <= Last |
fadcf313 | 5661 | and then Suffix_Matches (Filename, Naming.Body_Suffix) |
ce30eccb EB |
5662 | then |
5663 | Last := Natural'Min (Last, Filename'Last - Body_Len); | |
5664 | Kind := Impl; | |
5665 | end if; | |
19235870 | 5666 | |
ce30eccb | 5667 | if Filename'Last - Spec_Len <= Last |
fadcf313 | 5668 | and then Suffix_Matches (Filename, Naming.Spec_Suffix) |
ce30eccb EB |
5669 | then |
5670 | Last := Natural'Min (Last, Filename'Last - Spec_Len); | |
5671 | Kind := Spec; | |
5672 | end if; | |
19235870 | 5673 | |
ce30eccb | 5674 | if Last = Filename'Last then |
3e582869 | 5675 | Debug_Output ("no matching suffix"); |
ce30eccb EB |
5676 | return; |
5677 | end if; | |
19235870 | 5678 | |
ce30eccb | 5679 | -- Check that the casing matches |
19235870 | 5680 | |
ce30eccb | 5681 | if File_Names_Case_Sensitive then |
fadcf313 | 5682 | case Naming.Casing is |
ce30eccb | 5683 | when All_Lower_Case => |
d9c0e057 | 5684 | for J in Filename'First .. Last loop |
ce30eccb EB |
5685 | if Is_Letter (Filename (J)) |
5686 | and then not Is_Lower (Filename (J)) | |
6c1f47ee | 5687 | then |
2598ee6d | 5688 | Debug_Output ("invalid casing"); |
ce30eccb | 5689 | return; |
6c1f47ee | 5690 | end if; |
ce30eccb | 5691 | end loop; |
19235870 | 5692 | |
ce30eccb | 5693 | when All_Upper_Case => |
d9c0e057 | 5694 | for J in Filename'First .. Last loop |
ce30eccb EB |
5695 | if Is_Letter (Filename (J)) |
5696 | and then not Is_Upper (Filename (J)) | |
5697 | then | |
2598ee6d | 5698 | Debug_Output ("invalid casing"); |
ce30eccb | 5699 | return; |
6c1f47ee | 5700 | end if; |
ce30eccb | 5701 | end loop; |
19235870 | 5702 | |
ce30eccb EB |
5703 | when Mixed_Case | Unknown => |
5704 | null; | |
5705 | end case; | |
5706 | end if; | |
19235870 | 5707 | |
ce30eccb EB |
5708 | -- If Dot_Replacement is not a single dot, then there should not |
5709 | -- be any dot in the name. | |
19235870 | 5710 | |
ce30eccb | 5711 | declare |
fadcf313 | 5712 | Dot_Repl : constant String := |
84157c9a | 5713 | Get_Name_String (Naming.Dot_Replacement); |
d9c0e057 | 5714 | |
ce30eccb EB |
5715 | begin |
5716 | if Dot_Repl /= "." then | |
5717 | for Index in Filename'First .. Last loop | |
5718 | if Filename (Index) = '.' then | |
2598ee6d | 5719 | Debug_Output ("invalid name, contains dot"); |
44e1918a | 5720 | return; |
44e1918a AC |
5721 | end if; |
5722 | end loop; | |
19235870 | 5723 | |
ce30eccb EB |
5724 | Replace_Into_Name_Buffer |
5725 | (Filename (Filename'First .. Last), Dot_Repl, '.'); | |
84157c9a | 5726 | |
ce30eccb EB |
5727 | else |
5728 | Name_Len := Last - Filename'First + 1; | |
5729 | Name_Buffer (1 .. Name_Len) := Filename (Filename'First .. Last); | |
5730 | Fixed.Translate | |
5731 | (Source => Name_Buffer (1 .. Name_Len), | |
5732 | Mapping => Lower_Case_Map); | |
b30668b7 | 5733 | end if; |
ce30eccb | 5734 | end; |
19235870 | 5735 | |
ce30eccb EB |
5736 | -- In the standard GNAT naming scheme, check for special cases: children |
5737 | -- or separates of A, G, I or S, and run time sources. | |
19235870 | 5738 | |
7bccff24 EB |
5739 | if Is_Standard_GNAT_Naming (Naming) |
5740 | and then Name_Len >= 3 | |
5741 | then | |
44e1918a | 5742 | declare |
ce30eccb EB |
5743 | S1 : constant Character := Name_Buffer (1); |
5744 | S2 : constant Character := Name_Buffer (2); | |
5745 | S3 : constant Character := Name_Buffer (3); | |
79503fdd | 5746 | |
44e1918a | 5747 | begin |
84157c9a | 5748 | if S1 = 'a' |
ce30eccb EB |
5749 | or else S1 = 'g' |
5750 | or else S1 = 'i' | |
5751 | or else S1 = 's' | |
5752 | then | |
5753 | -- Children or separates of packages A, G, I or S. These names | |
5754 | -- are x__ ... or x~... (where x is a, g, i, or s). Both | |
5755 | -- versions (x__... and x~...) are allowed in all platforms, | |
5756 | -- because it is not possible to know the platform before | |
5757 | -- processing of the project files. | |
5758 | ||
5759 | if S2 = '_' and then S3 = '_' then | |
5760 | Name_Buffer (2) := '.'; | |
5761 | Name_Buffer (3 .. Name_Len - 1) := | |
5762 | Name_Buffer (4 .. Name_Len); | |
5763 | Name_Len := Name_Len - 1; | |
5764 | ||
5765 | elsif S2 = '~' then | |
5766 | Name_Buffer (2) := '.'; | |
5767 | ||
5768 | elsif S2 = '.' then | |
d9c0e057 | 5769 | |
7bccff24 | 5770 | -- If it is potentially a run time source |
d9c0e057 | 5771 | |
7bccff24 | 5772 | null; |
f7d7bb51 | 5773 | end if; |
44e1918a | 5774 | end if; |
ce30eccb EB |
5775 | end; |
5776 | end if; | |
79503fdd | 5777 | |
308e6f3a | 5778 | -- Name_Buffer contains the name of the unit in lower-cases. Check |
ce30eccb | 5779 | -- that this is a valid unit name |
79503fdd | 5780 | |
9b20e59b | 5781 | Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit); |
79503fdd | 5782 | |
d9c0e057 | 5783 | -- If there is a naming exception for the same unit, the file is not |
fdd7e7bb | 5784 | -- a source for the unit. |
d9c0e057 AC |
5785 | |
5786 | if Unit /= No_Name then | |
fdd7e7bb EB |
5787 | Unit_Except := |
5788 | Unit_Exceptions_Htable.Get (Project.Unit_Exceptions, Unit); | |
d9c0e057 AC |
5789 | |
5790 | if Kind = Spec then | |
5791 | Masked := Unit_Except.Spec /= No_File | |
f1eea135 EB |
5792 | and then |
5793 | Unit_Except.Spec /= File_Name; | |
d9c0e057 AC |
5794 | else |
5795 | Masked := Unit_Except.Impl /= No_File | |
f1eea135 EB |
5796 | and then |
5797 | Unit_Except.Impl /= File_Name; | |
d9c0e057 AC |
5798 | end if; |
5799 | ||
5800 | if Masked then | |
5801 | if Current_Verbosity = High then | |
3e582869 | 5802 | Debug_Indent; |
d9c0e057 AC |
5803 | Write_Str (" """ & Filename & """ contains the "); |
5804 | ||
5805 | if Kind = Spec then | |
5806 | Write_Str ("spec of a unit found in """); | |
5807 | Write_Str (Get_Name_String (Unit_Except.Spec)); | |
5808 | else | |
5809 | Write_Str ("body of a unit found in """); | |
5810 | Write_Str (Get_Name_String (Unit_Except.Impl)); | |
5811 | end if; | |
5812 | ||
5813 | Write_Line (""" (ignored)"); | |
5814 | end if; | |
5815 | ||
5816 | Unit := No_Name; | |
5817 | end if; | |
5818 | end if; | |
5819 | ||
ce30eccb EB |
5820 | if Unit /= No_Name |
5821 | and then Current_Verbosity = High | |
5822 | then | |
5823 | case Kind is | |
3e582869 AC |
5824 | when Spec => Debug_Output ("spec of", Unit); |
5825 | when Impl => Debug_Output ("body of", Unit); | |
5826 | when Sep => Debug_Output ("sep of", Unit); | |
ce30eccb | 5827 | end case; |
ce30eccb EB |
5828 | end if; |
5829 | end Compute_Unit_Name; | |
79503fdd | 5830 | |
fc2c32e2 EB |
5831 | -------------------------- |
5832 | -- Check_Illegal_Suffix -- | |
5833 | -------------------------- | |
19235870 | 5834 | |
fc2c32e2 EB |
5835 | procedure Check_Illegal_Suffix |
5836 | (Project : Project_Id; | |
fc2c32e2 EB |
5837 | Suffix : File_Name_Type; |
5838 | Dot_Replacement : File_Name_Type; | |
5839 | Attribute_Name : String; | |
fdd7e7bb EB |
5840 | Location : Source_Ptr; |
5841 | Data : in out Tree_Processing_Data) | |
44e1918a | 5842 | is |
d9c0e057 | 5843 | Suffix_Str : constant String := Get_Name_String (Suffix); |
f1eea135 | 5844 | |
44e1918a | 5845 | begin |
f91c36dc | 5846 | if Suffix_Str'Length = 0 then |
32404665 | 5847 | |
fc2c32e2 | 5848 | -- Always valid |
32404665 | 5849 | |
fc2c32e2 EB |
5850 | return; |
5851 | ||
f91c36dc | 5852 | elsif Index (Suffix_Str, ".") = 0 then |
fc2c32e2 EB |
5853 | Err_Vars.Error_Msg_File_1 := Suffix; |
5854 | Error_Msg | |
e2d9085b | 5855 | (Data.Flags, |
fc2c32e2 | 5856 | "{ is illegal for " & Attribute_Name & ": must have a dot", |
e2d9085b | 5857 | Location, Project); |
fc2c32e2 | 5858 | return; |
44e1918a | 5859 | end if; |
19235870 | 5860 | |
f91c36dc AC |
5861 | -- Case of dot replacement is a single dot, and first character of |
5862 | -- suffix is also a dot. | |
19235870 | 5863 | |
fc2c32e2 EB |
5864 | if Dot_Replacement /= No_File |
5865 | and then Get_Name_String (Dot_Replacement) = "." | |
d9c0e057 | 5866 | and then Suffix_Str (Suffix_Str'First) = '.' |
44e1918a | 5867 | then |
d9c0e057 | 5868 | for Index in Suffix_Str'First + 1 .. Suffix_Str'Last loop |
19235870 | 5869 | |
fc2c32e2 | 5870 | -- If there are multiple dots in the name |
19235870 | 5871 | |
d9c0e057 | 5872 | if Suffix_Str (Index) = '.' then |
b30668b7 | 5873 | |
44e1918a | 5874 | -- It is illegal to have a letter following the initial dot |
19235870 | 5875 | |
fc2c32e2 EB |
5876 | if Is_Letter (Suffix_Str (Suffix_Str'First + 1)) then |
5877 | Err_Vars.Error_Msg_File_1 := Suffix; | |
5878 | Error_Msg | |
e2d9085b | 5879 | (Data.Flags, |
fc2c32e2 EB |
5880 | "{ is illegal for " & Attribute_Name |
5881 | & ": ambiguous prefix when Dot_Replacement is a dot", | |
e2d9085b | 5882 | Location, Project); |
fc2c32e2 EB |
5883 | end if; |
5884 | return; | |
44e1918a AC |
5885 | end if; |
5886 | end loop; | |
5887 | end if; | |
fc2c32e2 | 5888 | end Check_Illegal_Suffix; |
b30668b7 | 5889 | |
44e1918a AC |
5890 | ---------------------- |
5891 | -- Locate_Directory -- | |
5892 | ---------------------- | |
19235870 | 5893 | |
44e1918a | 5894 | procedure Locate_Directory |
a9872a59 | 5895 | (Project : Project_Id; |
a9872a59 | 5896 | Name : File_Name_Type; |
3249690d AC |
5897 | Path : out Path_Information; |
5898 | Dir_Exists : out Boolean; | |
fdd7e7bb | 5899 | Data : in out Tree_Processing_Data; |
a9872a59 | 5900 | Create : String := ""; |
a9872a59 | 5901 | Location : Source_Ptr := No_Location; |
3249690d | 5902 | Must_Exist : Boolean := True; |
a9872a59 | 5903 | Externally_Built : Boolean := False) |
44e1918a | 5904 | is |
3249690d AC |
5905 | Parent : constant Path_Name_Type := |
5906 | Project.Directory.Display_Name; | |
ede007da | 5907 | The_Parent : constant String := |
fc2c32e2 | 5908 | Get_Name_String (Parent); |
44e1918a | 5909 | The_Parent_Last : constant Natural := |
2f41ec1a | 5910 | Compute_Directory_Last (The_Parent); |
ede007da | 5911 | Full_Name : File_Name_Type; |
68c3f02a VC |
5912 | The_Name : File_Name_Type; |
5913 | ||
44e1918a | 5914 | begin |
68c3f02a VC |
5915 | Get_Name_String (Name); |
5916 | ||
5917 | -- Add Subdirs.all if it is a directory that may be created and | |
5918 | -- Subdirs is not null; | |
5919 | ||
5920 | if Create /= "" and then Subdirs /= null then | |
5921 | if Name_Buffer (Name_Len) /= Directory_Separator then | |
5922 | Add_Char_To_Name_Buffer (Directory_Separator); | |
5923 | end if; | |
5924 | ||
5925 | Add_Str_To_Name_Buffer (Subdirs.all); | |
5926 | end if; | |
5927 | ||
ede007da VC |
5928 | -- Convert '/' to directory separator (for Windows) |
5929 | ||
68c3f02a VC |
5930 | for J in 1 .. Name_Len loop |
5931 | if Name_Buffer (J) = '/' then | |
5932 | Name_Buffer (J) := Directory_Separator; | |
ede007da VC |
5933 | end if; |
5934 | end loop; | |
5935 | ||
68c3f02a VC |
5936 | The_Name := Name_Find; |
5937 | ||
44e1918a | 5938 | if Current_Verbosity = High then |
3e582869 | 5939 | Debug_Indent; |
44e1918a | 5940 | Write_Str ("Locate_Directory ("""); |
68c3f02a | 5941 | Write_Str (Get_Name_String (The_Name)); |
3e582869 | 5942 | Write_Str (""", in """); |
44e1918a AC |
5943 | Write_Str (The_Parent); |
5944 | Write_Line (""")"); | |
5945 | end if; | |
19235870 | 5946 | |
3249690d AC |
5947 | Path := No_Path_Information; |
5948 | Dir_Exists := False; | |
b30668b7 | 5949 | |
68c3f02a VC |
5950 | if Is_Absolute_Path (Get_Name_String (The_Name)) then |
5951 | Full_Name := The_Name; | |
2f41ec1a VC |
5952 | |
5953 | else | |
5954 | Name_Len := 0; | |
5955 | Add_Str_To_Name_Buffer | |
5956 | (The_Parent (The_Parent'First .. The_Parent_Last)); | |
68c3f02a | 5957 | Add_Str_To_Name_Buffer (Get_Name_String (The_Name)); |
2f41ec1a VC |
5958 | Full_Name := Name_Find; |
5959 | end if; | |
5960 | ||
5961 | declare | |
a9872a59 VC |
5962 | Full_Path_Name : String_Access := |
5963 | new String'(Get_Name_String (Full_Name)); | |
2f41ec1a VC |
5964 | |
5965 | begin | |
68c3f02a VC |
5966 | if (Setup_Projects or else Subdirs /= null) |
5967 | and then Create'Length > 0 | |
2f41ec1a | 5968 | then |
a9872a59 | 5969 | if not Is_Directory (Full_Path_Name.all) then |
757240b3 | 5970 | |
a9872a59 VC |
5971 | -- If project is externally built, do not create a subdir, |
5972 | -- use the specified directory, without the subdir. | |
2f41ec1a | 5973 | |
a9872a59 VC |
5974 | if Externally_Built then |
5975 | if Is_Absolute_Path (Get_Name_String (Name)) then | |
5976 | Get_Name_String (Name); | |
2f41ec1a | 5977 | |
a9872a59 VC |
5978 | else |
5979 | Name_Len := 0; | |
5980 | Add_Str_To_Name_Buffer | |
5981 | (The_Parent (The_Parent'First .. The_Parent_Last)); | |
5982 | Add_Str_To_Name_Buffer (Get_Name_String (Name)); | |
5983 | end if; | |
5984 | ||
5985 | Full_Path_Name := new String'(Name_Buffer (1 .. Name_Len)); | |
5986 | ||
5987 | else | |
5988 | begin | |
5989 | Create_Path (Full_Path_Name.all); | |
5990 | ||
5991 | if not Quiet_Output then | |
5992 | Write_Str (Create); | |
5993 | Write_Str (" directory """); | |
5994 | Write_Str (Full_Path_Name.all); | |
c9e7bd8e AC |
5995 | Write_Str (""" created for project "); |
5996 | Write_Line (Get_Name_String (Project.Name)); | |
a9872a59 VC |
5997 | end if; |
5998 | ||
5999 | exception | |
6000 | when Use_Error => | |
6001 | Error_Msg | |
e2d9085b | 6002 | (Data.Flags, |
a9872a59 VC |
6003 | "could not create " & Create & |
6004 | " directory " & Full_Path_Name.all, | |
e2d9085b | 6005 | Location, Project); |
a9872a59 VC |
6006 | end; |
6007 | end if; | |
6008 | end if; | |
2f41ec1a | 6009 | end if; |
4f6447c5 | 6010 | |
3249690d AC |
6011 | Dir_Exists := Is_Directory (Full_Path_Name.all); |
6012 | ||
6013 | if not Must_Exist or else Dir_Exists then | |
44e1918a AC |
6014 | declare |
6015 | Normed : constant String := | |
6016 | Normalize_Pathname | |
a9872a59 | 6017 | (Full_Path_Name.all, |
3249690d AC |
6018 | Directory => |
6019 | The_Parent (The_Parent'First .. The_Parent_Last), | |
44e1918a AC |
6020 | Resolve_Links => False, |
6021 | Case_Sensitive => True); | |
fbf5a39b | 6022 | |
44e1918a AC |
6023 | Canonical_Path : constant String := |
6024 | Normalize_Pathname | |
6025 | (Normed, | |
3249690d AC |
6026 | Directory => |
6027 | The_Parent | |
6028 | (The_Parent'First .. The_Parent_Last), | |
6c1f47ee EB |
6029 | Resolve_Links => |
6030 | Opt.Follow_Links_For_Dirs, | |
44e1918a | 6031 | Case_Sensitive => False); |
fbf5a39b AC |
6032 | |
6033 | begin | |
44e1918a AC |
6034 | Name_Len := Normed'Length; |
6035 | Name_Buffer (1 .. Name_Len) := Normed; | |
fc2c32e2 EB |
6036 | |
6037 | -- Directories should always end with a directory separator | |
6038 | ||
6039 | if Name_Buffer (Name_Len) /= Directory_Separator then | |
6040 | Add_Char_To_Name_Buffer (Directory_Separator); | |
6041 | end if; | |
6042 | ||
3249690d | 6043 | Path.Display_Name := Name_Find; |
fbf5a39b | 6044 | |
44e1918a AC |
6045 | Name_Len := Canonical_Path'Length; |
6046 | Name_Buffer (1 .. Name_Len) := Canonical_Path; | |
fc2c32e2 EB |
6047 | |
6048 | if Name_Buffer (Name_Len) /= Directory_Separator then | |
6049 | Add_Char_To_Name_Buffer (Directory_Separator); | |
6050 | end if; | |
6051 | ||
3249690d | 6052 | Path.Name := Name_Find; |
fbf5a39b AC |
6053 | end; |
6054 | end if; | |
a9872a59 VC |
6055 | |
6056 | Free (Full_Path_Name); | |
2f41ec1a | 6057 | end; |
44e1918a | 6058 | end Locate_Directory; |
19235870 | 6059 | |
6c1f47ee EB |
6060 | --------------------------- |
6061 | -- Find_Excluded_Sources -- | |
6062 | --------------------------- | |
19235870 | 6063 | |
6c1f47ee | 6064 | procedure Find_Excluded_Sources |
32404665 EB |
6065 | (Project : in out Project_Processing_Data; |
6066 | Data : in out Tree_Processing_Data) | |
44e1918a | 6067 | is |
40ecf2f5 EB |
6068 | Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; |
6069 | ||
d9c0e057 AC |
6070 | Excluded_Source_List_File : constant Variable_Value := |
6071 | Util.Value_Of | |
6072 | (Name_Excluded_Source_List_File, | |
fdd7e7bb | 6073 | Project.Project.Decl.Attributes, |
40ecf2f5 | 6074 | Shared); |
347ab254 | 6075 | Excluded_Sources : Variable_Value := Util.Value_Of |
d9c0e057 | 6076 | (Name_Excluded_Source_Files, |
fdd7e7bb | 6077 | Project.Project.Decl.Attributes, |
40ecf2f5 | 6078 | Shared); |
d9c0e057 AC |
6079 | |
6080 | Current : String_List_Id; | |
6081 | Element : String_Element; | |
6082 | Location : Source_Ptr; | |
6083 | Name : File_Name_Type; | |
6084 | File : Prj.Util.Text_File; | |
6085 | Line : String (1 .. 300); | |
6086 | Last : Natural; | |
6087 | Locally_Removed : Boolean := False; | |
6088 | ||
6c1f47ee | 6089 | begin |
f6cf5b85 | 6090 | -- If Excluded_Source_Files is not declared, check Locally_Removed_Files |
4dff0aaf | 6091 | |
6c1f47ee | 6092 | if Excluded_Sources.Default then |
4dff0aaf | 6093 | Locally_Removed := True; |
6c1f47ee EB |
6094 | Excluded_Sources := |
6095 | Util.Value_Of | |
fdd7e7bb | 6096 | (Name_Locally_Removed_Files, |
40ecf2f5 | 6097 | Project.Project.Decl.Attributes, Shared); |
6c1f47ee | 6098 | end if; |
19235870 | 6099 | |
6c1f47ee | 6100 | -- If there are excluded sources, put them in the table |
19235870 | 6101 | |
6c1f47ee | 6102 | if not Excluded_Sources.Default then |
4dff0aaf VC |
6103 | if not Excluded_Source_List_File.Default then |
6104 | if Locally_Removed then | |
6105 | Error_Msg | |
e2d9085b | 6106 | (Data.Flags, |
4dff0aaf VC |
6107 | "?both attributes Locally_Removed_Files and " & |
6108 | "Excluded_Source_List_File are present", | |
e2d9085b | 6109 | Excluded_Source_List_File.Location, Project.Project); |
4dff0aaf VC |
6110 | else |
6111 | Error_Msg | |
e2d9085b | 6112 | (Data.Flags, |
4dff0aaf VC |
6113 | "?both attributes Excluded_Source_Files and " & |
6114 | "Excluded_Source_List_File are present", | |
e2d9085b | 6115 | Excluded_Source_List_File.Location, Project.Project); |
4dff0aaf VC |
6116 | end if; |
6117 | end if; | |
6118 | ||
6c1f47ee EB |
6119 | Current := Excluded_Sources.Values; |
6120 | while Current /= Nil_String loop | |
40ecf2f5 | 6121 | Element := Shared.String_Elements.Table (Current); |
347ab254 | 6122 | Name := Canonical_Case_File_Name (Element.Value); |
2f41ec1a | 6123 | |
757240b3 AC |
6124 | -- If the element has no location, then use the location of |
6125 | -- Excluded_Sources to report possible errors. | |
2f41ec1a | 6126 | |
6c1f47ee EB |
6127 | if Element.Location = No_Location then |
6128 | Location := Excluded_Sources.Location; | |
6129 | else | |
6130 | Location := Element.Location; | |
6131 | end if; | |
19235870 | 6132 | |
b0159fbe | 6133 | Excluded_Sources_Htable.Set |
1f6439e3 AC |
6134 | (Project.Excluded, Name, |
6135 | (Name, No_File, 0, False, Location)); | |
6c1f47ee EB |
6136 | Current := Element.Next; |
6137 | end loop; | |
4dff0aaf VC |
6138 | |
6139 | elsif not Excluded_Source_List_File.Default then | |
6140 | Location := Excluded_Source_List_File.Location; | |
6141 | ||
6142 | declare | |
1f6439e3 AC |
6143 | Source_File_Name : constant File_Name_Type := |
6144 | File_Name_Type | |
6145 | (Excluded_Source_List_File.Value); | |
6146 | Source_File_Line : Natural := 0; | |
6147 | ||
4dff0aaf VC |
6148 | Source_File_Path_Name : constant String := |
6149 | Path_Name_Of | |
1f6439e3 | 6150 | (Source_File_Name, |
fdd7e7bb | 6151 | Project.Project.Directory.Name); |
4dff0aaf VC |
6152 | |
6153 | begin | |
6154 | if Source_File_Path_Name'Length = 0 then | |
6155 | Err_Vars.Error_Msg_File_1 := | |
6156 | File_Name_Type (Excluded_Source_List_File.Value); | |
6157 | Error_Msg | |
e2d9085b | 6158 | (Data.Flags, |
4dff0aaf | 6159 | "file with excluded sources { does not exist", |
e2d9085b | 6160 | Excluded_Source_List_File.Location, Project.Project); |
4dff0aaf VC |
6161 | |
6162 | else | |
6163 | -- Open the file | |
6164 | ||
6165 | Prj.Util.Open (File, Source_File_Path_Name); | |
6166 | ||
6167 | if not Prj.Util.Is_Valid (File) then | |
6168 | Error_Msg | |
e2d9085b EB |
6169 | (Data.Flags, "file does not exist", |
6170 | Location, Project.Project); | |
4dff0aaf VC |
6171 | else |
6172 | -- Read the lines one by one | |
6173 | ||
6174 | while not Prj.Util.End_Of_File (File) loop | |
6175 | Prj.Util.Get_Line (File, Line, Last); | |
1f6439e3 | 6176 | Source_File_Line := Source_File_Line + 1; |
4dff0aaf | 6177 | |
757240b3 | 6178 | -- Non empty, non comment line should contain a file name |
4dff0aaf VC |
6179 | |
6180 | if Last /= 0 | |
6181 | and then (Last = 1 or else Line (1 .. 2) /= "--") | |
6182 | then | |
6183 | Name_Len := Last; | |
6184 | Name_Buffer (1 .. Name_Len) := Line (1 .. Last); | |
f6cf5b85 | 6185 | Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); |
4dff0aaf VC |
6186 | Name := Name_Find; |
6187 | ||
6188 | -- Check that there is no directory information | |
6189 | ||
6190 | for J in 1 .. Last loop | |
6191 | if Line (J) = '/' | |
6192 | or else Line (J) = Directory_Separator | |
6193 | then | |
6194 | Error_Msg_File_1 := Name; | |
6195 | Error_Msg | |
e2d9085b | 6196 | (Data.Flags, |
4dff0aaf VC |
6197 | "file name cannot include " & |
6198 | "directory information ({)", | |
e2d9085b | 6199 | Location, Project.Project); |
4dff0aaf VC |
6200 | exit; |
6201 | end if; | |
6202 | end loop; | |
6203 | ||
6204 | Excluded_Sources_Htable.Set | |
1f6439e3 AC |
6205 | (Project.Excluded, |
6206 | Name, | |
6207 | (Name, Source_File_Name, Source_File_Line, | |
6208 | False, Location)); | |
4dff0aaf VC |
6209 | end if; |
6210 | end loop; | |
6211 | ||
6212 | Prj.Util.Close (File); | |
6213 | end if; | |
6214 | end if; | |
6215 | end; | |
6c1f47ee EB |
6216 | end if; |
6217 | end Find_Excluded_Sources; | |
45d04cbb | 6218 | |
a7a3cf5c AC |
6219 | ------------------ |
6220 | -- Find_Sources -- | |
6221 | ------------------ | |
6c1f47ee | 6222 | |
a7a3cf5c | 6223 | procedure Find_Sources |
4d777a71 AC |
6224 | (Project : in out Project_Processing_Data; |
6225 | Data : in out Tree_Processing_Data) | |
6c1f47ee | 6226 | is |
40ecf2f5 EB |
6227 | Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; |
6228 | ||
f6cf5b85 AC |
6229 | Sources : constant Variable_Value := |
6230 | Util.Value_Of | |
6231 | (Name_Source_Files, | |
4d777a71 | 6232 | Project.Project.Decl.Attributes, |
40ecf2f5 | 6233 | Shared); |
f6cf5b85 | 6234 | |
6c1f47ee EB |
6235 | Source_List_File : constant Variable_Value := |
6236 | Util.Value_Of | |
6237 | (Name_Source_List_File, | |
fdd7e7bb | 6238 | Project.Project.Decl.Attributes, |
40ecf2f5 | 6239 | Shared); |
757240b3 | 6240 | |
f6cf5b85 | 6241 | Name_Loc : Name_Location; |
a7a3cf5c | 6242 | Has_Explicit_Sources : Boolean; |
45d04cbb | 6243 | |
6c1f47ee EB |
6244 | begin |
6245 | pragma Assert (Sources.Kind = List, "Source_Files is not a list"); | |
6246 | pragma Assert | |
6247 | (Source_List_File.Kind = Single, | |
6248 | "Source_List_File is not a single string"); | |
fbf5a39b | 6249 | |
fdd7e7bb EB |
6250 | Project.Source_List_File_Location := Source_List_File.Location; |
6251 | ||
f91c36dc | 6252 | -- If the user has specified a Source_Files attribute |
19235870 | 6253 | |
6c1f47ee EB |
6254 | if not Sources.Default then |
6255 | if not Source_List_File.Default then | |
6256 | Error_Msg | |
e2d9085b | 6257 | (Data.Flags, |
4dff0aaf | 6258 | "?both attributes source_files and " & |
6c1f47ee | 6259 | "source_list_file are present", |
e2d9085b | 6260 | Source_List_File.Location, Project.Project); |
6c1f47ee | 6261 | end if; |
19235870 | 6262 | |
6c1f47ee | 6263 | -- Sources is a list of file names |
19235870 | 6264 | |
6c1f47ee EB |
6265 | declare |
6266 | Current : String_List_Id := Sources.Values; | |
6267 | Element : String_Element; | |
6268 | Location : Source_Ptr; | |
6269 | Name : File_Name_Type; | |
19235870 | 6270 | |
6c1f47ee | 6271 | begin |
fdd7e7bb EB |
6272 | if Current = Nil_String then |
6273 | Project.Project.Languages := No_Language_Index; | |
07fc65c4 | 6274 | |
fdd7e7bb EB |
6275 | -- This project contains no source. For projects that don't |
6276 | -- extend other projects, this also means that there is no | |
6277 | -- need for an object directory, if not specified. | |
07fc65c4 | 6278 | |
fdd7e7bb | 6279 | if Project.Project.Extends = No_Project |
5415acbd AC |
6280 | and then |
6281 | Project.Project.Object_Directory = Project.Project.Directory | |
6282 | and then | |
6283 | not (Project.Project.Qualifier = Aggregate_Library) | |
fdd7e7bb EB |
6284 | then |
6285 | Project.Project.Object_Directory := No_Path_Information; | |
07fc65c4 | 6286 | end if; |
fdd7e7bb | 6287 | end if; |
19235870 | 6288 | |
6c1f47ee | 6289 | while Current /= Nil_String loop |
40ecf2f5 | 6290 | Element := Shared.String_Elements.Table (Current); |
347ab254 | 6291 | Name := Canonical_Case_File_Name (Element.Value); |
6c1f47ee | 6292 | Get_Name_String (Element.Value); |
19235870 | 6293 | |
757240b3 AC |
6294 | -- If the element has no location, then use the location of |
6295 | -- Sources to report possible errors. | |
fbf5a39b | 6296 | |
6c1f47ee EB |
6297 | if Element.Location = No_Location then |
6298 | Location := Sources.Location; | |
6299 | else | |
6300 | Location := Element.Location; | |
6301 | end if; | |
ede007da | 6302 | |
6c1f47ee | 6303 | -- Check that there is no directory information |
fbf5a39b | 6304 | |
6c1f47ee EB |
6305 | for J in 1 .. Name_Len loop |
6306 | if Name_Buffer (J) = '/' | |
6307 | or else Name_Buffer (J) = Directory_Separator | |
6308 | then | |
6309 | Error_Msg_File_1 := Name; | |
6310 | Error_Msg | |
e2d9085b | 6311 | (Data.Flags, |
6c1f47ee EB |
6312 | "file name cannot include directory " & |
6313 | "information ({)", | |
e2d9085b | 6314 | Location, Project.Project); |
6c1f47ee EB |
6315 | exit; |
6316 | end if; | |
6317 | end loop; | |
6318 | ||
fc2c32e2 EB |
6319 | -- Check whether the file is already there: the same file name |
6320 | -- may be in the list. If the source is missing, the error will | |
6321 | -- be on the first mention of the source file name. | |
6c1f47ee | 6322 | |
fdd7e7bb EB |
6323 | Name_Loc := Source_Names_Htable.Get |
6324 | (Project.Source_Names, Name); | |
6c1f47ee EB |
6325 | |
6326 | if Name_Loc = No_Name_Location then | |
6327 | Name_Loc := | |
6328 | (Name => Name, | |
6329 | Location => Location, | |
6330 | Source => No_Source, | |
602a7ec0 | 6331 | Listed => True, |
6c1f47ee | 6332 | Found => False); |
602a7ec0 AC |
6333 | |
6334 | else | |
6335 | Name_Loc.Listed := True; | |
6c1f47ee | 6336 | end if; |
07fc65c4 | 6337 | |
602a7ec0 AC |
6338 | Source_Names_Htable.Set |
6339 | (Project.Source_Names, Name, Name_Loc); | |
6340 | ||
6c1f47ee EB |
6341 | Current := Element.Next; |
6342 | end loop; | |
6343 | ||
a7a3cf5c | 6344 | Has_Explicit_Sources := True; |
6c1f47ee | 6345 | end; |
07fc65c4 | 6346 | |
6c1f47ee | 6347 | -- If we have no Source_Files attribute, check the Source_List_File |
757240b3 | 6348 | -- attribute. |
07fc65c4 | 6349 | |
6c1f47ee | 6350 | elsif not Source_List_File.Default then |
ede007da | 6351 | |
757240b3 AC |
6352 | -- Source_List_File is the name of the file that contains the source |
6353 | -- file names. | |
ede007da | 6354 | |
6c1f47ee EB |
6355 | declare |
6356 | Source_File_Path_Name : constant String := | |
86828d40 AC |
6357 | Path_Name_Of |
6358 | (File_Name_Type | |
6359 | (Source_List_File.Value), | |
6360 | Project.Project. | |
6361 | Directory.Display_Name); | |
ede007da VC |
6362 | |
6363 | begin | |
a7a3cf5c AC |
6364 | Has_Explicit_Sources := True; |
6365 | ||
6c1f47ee EB |
6366 | if Source_File_Path_Name'Length = 0 then |
6367 | Err_Vars.Error_Msg_File_1 := | |
6368 | File_Name_Type (Source_List_File.Value); | |
6369 | Error_Msg | |
e2d9085b | 6370 | (Data.Flags, |
6c1f47ee | 6371 | "file with sources { does not exist", |
e2d9085b | 6372 | Source_List_File.Location, Project.Project); |
ede007da | 6373 | |
6c1f47ee EB |
6374 | else |
6375 | Get_Sources_From_File | |
6376 | (Source_File_Path_Name, Source_List_File.Location, | |
fdd7e7bb | 6377 | Project, Data); |
6c1f47ee EB |
6378 | end if; |
6379 | end; | |
ede007da | 6380 | |
6c1f47ee | 6381 | else |
757240b3 AC |
6382 | -- Neither Source_Files nor Source_List_File has been specified. Find |
6383 | -- all the files that satisfy the naming scheme in all the source | |
6384 | -- directories. | |
6c1f47ee | 6385 | |
a7a3cf5c | 6386 | Has_Explicit_Sources := False; |
6c1f47ee | 6387 | end if; |
ede007da | 6388 | |
602a7ec0 AC |
6389 | -- Remove any exception that is not in the specified list of sources |
6390 | ||
6391 | if Has_Explicit_Sources then | |
6392 | declare | |
6393 | Source : Source_Id; | |
6394 | Iter : Source_Iterator; | |
6395 | NL : Name_Location; | |
6396 | Again : Boolean; | |
6397 | begin | |
6398 | Iter_Loop : | |
6399 | loop | |
6400 | Again := False; | |
6401 | Iter := For_Each_Source (Data.Tree, Project.Project); | |
6402 | ||
6403 | Source_Loop : | |
6404 | loop | |
6405 | Source := Prj.Element (Iter); | |
6406 | exit Source_Loop when Source = No_Source; | |
6407 | ||
9f55bc62 | 6408 | if Source.Naming_Exception /= No then |
602a7ec0 AC |
6409 | NL := Source_Names_Htable.Get |
6410 | (Project.Source_Names, Source.File); | |
6411 | ||
6412 | if NL /= No_Name_Location and then not NL.Listed then | |
6413 | -- Remove the exception | |
6414 | Source_Names_Htable.Set | |
6415 | (Project.Source_Names, | |
6416 | Source.File, | |
6417 | No_Name_Location); | |
72e9f2b9 | 6418 | Remove_Source (Data.Tree, Source, No_Source); |
602a7ec0 | 6419 | |
c6d5d1ac AC |
6420 | if Source.Naming_Exception = Yes then |
6421 | Error_Msg_Name_1 := Name_Id (Source.File); | |
6422 | Error_Msg | |
6423 | (Data.Flags, | |
6424 | "? unknown source file %%", | |
6425 | NL.Location, | |
6426 | Project.Project); | |
6427 | end if; | |
602a7ec0 AC |
6428 | |
6429 | Again := True; | |
6430 | exit Source_Loop; | |
6431 | end if; | |
6432 | end if; | |
6433 | ||
6434 | Next (Iter); | |
6435 | end loop Source_Loop; | |
6436 | ||
6437 | exit Iter_Loop when not Again; | |
6438 | end loop Iter_Loop; | |
6439 | end; | |
6440 | end if; | |
6441 | ||
fc2c32e2 | 6442 | Search_Directories |
fdd7e7bb EB |
6443 | (Project, |
6444 | Data => Data, | |
6445 | For_All_Sources => Sources.Default and then Source_List_File.Default); | |
4f469be3 | 6446 | |
c37845f8 | 6447 | -- Check if all exceptions have been found |
4f469be3 | 6448 | |
a7a3cf5c AC |
6449 | declare |
6450 | Source : Source_Id; | |
6451 | Iter : Source_Iterator; | |
47edeeab | 6452 | Found : Boolean := False; |
5eed512d | 6453 | |
a7a3cf5c | 6454 | begin |
fdd7e7bb | 6455 | Iter := For_Each_Source (Data.Tree, Project.Project); |
a7a3cf5c AC |
6456 | loop |
6457 | Source := Prj.Element (Iter); | |
6458 | exit when Source = No_Source; | |
5d07d0cf | 6459 | |
686d0984 AC |
6460 | -- If the full source path is unknown for this source_id, there |
6461 | -- could be several reasons: | |
6462 | -- * we simply did not find the file itself, this is an error | |
6463 | -- * we have a multi-unit source file. Another Source_Id from | |
6464 | -- the same file has received the full path, so we need to | |
6465 | -- propagate it. | |
6466 | ||
9f55bc62 AC |
6467 | if Source.Path = No_Path_Information then |
6468 | if Source.Naming_Exception = Yes then | |
6469 | if Source.Unit /= No_Unit_Index then | |
6470 | Found := False; | |
f6cf5b85 | 6471 | |
9f55bc62 AC |
6472 | if Source.Index /= 0 then -- Only multi-unit files |
6473 | declare | |
6474 | S : Source_Id := | |
9fdb5d21 RD |
6475 | Source_Files_Htable.Get |
6476 | (Data.Tree.Source_Files_HT, Source.File); | |
6477 | ||
9f55bc62 AC |
6478 | begin |
6479 | while S /= null loop | |
6480 | if S.Path /= No_Path_Information then | |
6481 | Source.Path := S.Path; | |
6482 | Found := True; | |
6483 | ||
6484 | if Current_Verbosity = High then | |
6485 | Debug_Output | |
6486 | ("setting full path for " | |
6487 | & Get_Name_String (Source.File) | |
6488 | & " at" & Source.Index'Img | |
6489 | & " to " | |
6490 | & Get_Name_String (Source.Path.Name)); | |
6491 | end if; | |
f6cf5b85 | 6492 | |
9f55bc62 | 6493 | exit; |
686d0984 | 6494 | end if; |
47edeeab | 6495 | |
9f55bc62 AC |
6496 | S := S.Next_With_File_Name; |
6497 | end loop; | |
6498 | end; | |
6499 | end if; | |
686d0984 | 6500 | |
9f55bc62 AC |
6501 | if not Found then |
6502 | Error_Msg_Name_1 := Name_Id (Source.Display_File); | |
6503 | Error_Msg_Name_2 := Source.Unit.Name; | |
6504 | Error_Or_Warning | |
6505 | (Data.Flags, Data.Flags.Missing_Source_Files, | |
6506 | "source file %% for unit %% not found", | |
6507 | No_Location, Project.Project); | |
6508 | end if; | |
47edeeab AC |
6509 | end if; |
6510 | ||
9f55bc62 AC |
6511 | if Source.Path = No_Path_Information then |
6512 | Remove_Source (Data.Tree, Source, No_Source); | |
f6cf5b85 | 6513 | end if; |
5eed512d | 6514 | |
9f55bc62 | 6515 | elsif Source.Naming_Exception = Inherited then |
72e9f2b9 | 6516 | Remove_Source (Data.Tree, Source, No_Source); |
fc2c32e2 | 6517 | end if; |
a7a3cf5c AC |
6518 | end if; |
6519 | ||
6520 | Next (Iter); | |
6521 | end loop; | |
6522 | end; | |
4f469be3 | 6523 | |
757240b3 AC |
6524 | -- It is an error if a source file name in a source list or in a source |
6525 | -- list file is not found. | |
4f469be3 | 6526 | |
a7a3cf5c | 6527 | if Has_Explicit_Sources then |
4f469be3 | 6528 | declare |
a7a3cf5c | 6529 | NL : Name_Location; |
757240b3 AC |
6530 | First_Error : Boolean; |
6531 | ||
4f469be3 | 6532 | begin |
fdd7e7bb | 6533 | NL := Source_Names_Htable.Get_First (Project.Source_Names); |
757240b3 | 6534 | First_Error := True; |
a7a3cf5c AC |
6535 | while NL /= No_Name_Location loop |
6536 | if not NL.Found then | |
6537 | Err_Vars.Error_Msg_File_1 := NL.Name; | |
e771c085 AC |
6538 | if First_Error then |
6539 | Error_Or_Warning | |
6540 | (Data.Flags, Data.Flags.Missing_Source_Files, | |
6541 | "source file { not found", | |
6542 | NL.Location, Project.Project); | |
6543 | First_Error := False; | |
6544 | else | |
6545 | Error_Or_Warning | |
6546 | (Data.Flags, Data.Flags.Missing_Source_Files, | |
6547 | "\source file { not found", | |
6548 | NL.Location, Project.Project); | |
6549 | end if; | |
4f469be3 VC |
6550 | end if; |
6551 | ||
fdd7e7bb | 6552 | NL := Source_Names_Htable.Get_Next (Project.Source_Names); |
4f469be3 VC |
6553 | end loop; |
6554 | end; | |
6c1f47ee | 6555 | end if; |
fdd7e7bb | 6556 | end Find_Sources; |
ede007da | 6557 | |
fdd7e7bb EB |
6558 | ---------------- |
6559 | -- Initialize -- | |
6560 | ---------------- | |
ede007da | 6561 | |
fdd7e7bb | 6562 | procedure Initialize |
a0a786e3 EB |
6563 | (Data : out Tree_Processing_Data; |
6564 | Tree : Project_Tree_Ref; | |
6565 | Node_Tree : Prj.Tree.Project_Node_Tree_Ref; | |
6566 | Flags : Prj.Processing_Flags) | |
2c011ce1 | 6567 | is |
fdd7e7bb | 6568 | begin |
a0a786e3 EB |
6569 | Data.Tree := Tree; |
6570 | Data.Node_Tree := Node_Tree; | |
6571 | Data.Flags := Flags; | |
fdd7e7bb EB |
6572 | end Initialize; |
6573 | ||
6574 | ---------- | |
6575 | -- Free -- | |
6576 | ---------- | |
6577 | ||
6578 | procedure Free (Data : in out Tree_Processing_Data) is | |
686d0984 | 6579 | pragma Unreferenced (Data); |
fdd7e7bb | 6580 | begin |
686d0984 | 6581 | null; |
fdd7e7bb | 6582 | end Free; |
ede007da | 6583 | |
e1c9f239 EB |
6584 | ---------------- |
6585 | -- Initialize -- | |
6586 | ---------------- | |
6587 | ||
fdd7e7bb EB |
6588 | procedure Initialize |
6589 | (Data : in out Project_Processing_Data; | |
2c011ce1 RD |
6590 | Project : Project_Id) |
6591 | is | |
e1c9f239 | 6592 | begin |
fdd7e7bb | 6593 | Data.Project := Project; |
e1c9f239 EB |
6594 | end Initialize; |
6595 | ||
6596 | ---------- | |
6597 | -- Free -- | |
6598 | ---------- | |
6599 | ||
fdd7e7bb | 6600 | procedure Free (Data : in out Project_Processing_Data) is |
e1c9f239 | 6601 | begin |
fdd7e7bb EB |
6602 | Source_Names_Htable.Reset (Data.Source_Names); |
6603 | Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions); | |
6604 | Excluded_Sources_Htable.Reset (Data.Excluded); | |
e1c9f239 EB |
6605 | end Free; |
6606 | ||
ce30eccb EB |
6607 | ------------------------------- |
6608 | -- Check_File_Naming_Schemes -- | |
6609 | ------------------------------- | |
6610 | ||
6611 | procedure Check_File_Naming_Schemes | |
6c1f47ee | 6612 | (In_Tree : Project_Tree_Ref; |
fdd7e7bb | 6613 | Project : Project_Processing_Data; |
6c1f47ee | 6614 | File_Name : File_Name_Type; |
e1c9f239 | 6615 | Alternate_Languages : out Language_List; |
e0697153 | 6616 | Language : out Language_Ptr; |
6c1f47ee EB |
6617 | Display_Language_Name : out Name_Id; |
6618 | Unit : out Name_Id; | |
6619 | Lang_Kind : out Language_Kind; | |
6620 | Kind : out Source_Kind) | |
6621 | is | |
f1eea135 EB |
6622 | Filename : constant String := Get_Name_String (File_Name); |
6623 | Config : Language_Config; | |
e0697153 | 6624 | Tmp_Lang : Language_Ptr; |
ce30eccb | 6625 | |
d9c0e057 | 6626 | Header_File : Boolean := False; |
ce30eccb EB |
6627 | -- True if we found at least one language for which the file is a header |
6628 | -- In such a case, we search for all possible languages where this is | |
6629 | -- also a header (C and C++ for instance), since the file might be used | |
6630 | -- for several such languages. | |
6631 | ||
6632 | procedure Check_File_Based_Lang; | |
6633 | -- Does the naming scheme test for file-based languages. For those, | |
6634 | -- there is no Unit. Just check if the file name has the implementation | |
6635 | -- or, if it is specified, the template suffix of the language. | |
6636 | -- | |
6637 | -- Returns True if the file belongs to the current language and we | |
6638 | -- should stop searching for matching languages. Not that a given header | |
6639 | -- file could belong to several languages (C and C++ for instance). Thus | |
349ff68f | 6640 | -- if we found a header we'll check whether it matches other languages. |
ce30eccb | 6641 | |
ce30eccb EB |
6642 | --------------------------- |
6643 | -- Check_File_Based_Lang -- | |
6644 | --------------------------- | |
d3132623 | 6645 | |
ce30eccb EB |
6646 | procedure Check_File_Based_Lang is |
6647 | begin | |
6648 | if not Header_File | |
6649 | and then Suffix_Matches (Filename, Config.Naming_Data.Body_Suffix) | |
6650 | then | |
6651 | Unit := No_Name; | |
6652 | Kind := Impl; | |
6653 | Language := Tmp_Lang; | |
b61ebe4f | 6654 | |
3e582869 | 6655 | Debug_Output |
2598ee6d | 6656 | ("implementation of language ", Display_Language_Name); |
ede007da | 6657 | |
ce30eccb | 6658 | elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then |
3e582869 | 6659 | Debug_Output |
2598ee6d | 6660 | ("header of language ", Display_Language_Name); |
4f6447c5 | 6661 | |
ce30eccb | 6662 | if Header_File then |
e1c9f239 | 6663 | Alternate_Languages := new Language_List_Element' |
ce30eccb EB |
6664 | (Language => Language, |
6665 | Next => Alternate_Languages); | |
d9c0e057 | 6666 | |
ce30eccb EB |
6667 | else |
6668 | Header_File := True; | |
6669 | Kind := Spec; | |
6670 | Unit := No_Name; | |
6671 | Language := Tmp_Lang; | |
6672 | end if; | |
6c1f47ee | 6673 | end if; |
ce30eccb | 6674 | end Check_File_Based_Lang; |
4f6447c5 | 6675 | |
f1eea135 EB |
6676 | -- Start of processing for Check_File_Naming_Schemes |
6677 | ||
ce30eccb EB |
6678 | begin |
6679 | Language := No_Language_Index; | |
e1c9f239 | 6680 | Alternate_Languages := null; |
ce30eccb EB |
6681 | Display_Language_Name := No_Name; |
6682 | Unit := No_Name; | |
6683 | Lang_Kind := File_Based; | |
6684 | Kind := Spec; | |
6c1f47ee | 6685 | |
fdd7e7bb | 6686 | Tmp_Lang := Project.Project.Languages; |
e0697153 | 6687 | while Tmp_Lang /= No_Language_Index loop |
ce30eccb | 6688 | if Current_Verbosity = High then |
3e582869 | 6689 | Debug_Output |
2598ee6d | 6690 | ("testing language " |
7dd1ab84 | 6691 | & Get_Name_String (Tmp_Lang.Name) |
ce30eccb EB |
6692 | & " Header_File=" & Header_File'Img); |
6693 | end if; | |
6c1f47ee | 6694 | |
e0697153 EB |
6695 | Display_Language_Name := Tmp_Lang.Display_Name; |
6696 | Config := Tmp_Lang.Config; | |
6697 | Lang_Kind := Config.Kind; | |
6698 | ||
6699 | case Config.Kind is | |
6700 | when File_Based => | |
6701 | Check_File_Based_Lang; | |
6702 | exit when Kind = Impl; | |
6703 | ||
6704 | when Unit_Based => | |
6705 | ||
6706 | -- We know it belongs to a least a file_based language, no | |
6707 | -- need to check unit-based ones. | |
6708 | ||
6709 | if not Header_File then | |
6710 | Compute_Unit_Name | |
6711 | (File_Name => File_Name, | |
fadcf313 | 6712 | Naming => Config.Naming_Data, |
e0697153 | 6713 | Kind => Kind, |
481f29eb | 6714 | Unit => Unit, |
fdd7e7bb | 6715 | Project => Project, |
481f29eb | 6716 | In_Tree => In_Tree); |
e0697153 EB |
6717 | |
6718 | if Unit /= No_Name then | |
6719 | Language := Tmp_Lang; | |
6720 | exit; | |
6c1f47ee | 6721 | end if; |
e0697153 EB |
6722 | end if; |
6723 | end case; | |
ede007da | 6724 | |
e0697153 | 6725 | Tmp_Lang := Tmp_Lang.Next; |
6c1f47ee EB |
6726 | end loop; |
6727 | ||
3e582869 AC |
6728 | if Language = No_Language_Index then |
6729 | Debug_Output ("not a source of any language"); | |
6c1f47ee | 6730 | end if; |
ce30eccb | 6731 | end Check_File_Naming_Schemes; |
ede007da | 6732 | |
95cd3246 AC |
6733 | ------------------- |
6734 | -- Override_Kind -- | |
6735 | ------------------- | |
6736 | ||
6737 | procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is | |
6738 | begin | |
1d24fc5e | 6739 | -- If the file was previously already associated with a unit, change it |
95cd3246 | 6740 | |
1d24fc5e | 6741 | if Source.Unit /= null |
95cd3246 | 6742 | and then Source.Kind in Spec_Or_Body |
1d24fc5e | 6743 | and then Source.Unit.File_Names (Source.Kind) /= null |
95cd3246 | 6744 | then |
1d24fc5e EB |
6745 | -- If we had another file referencing the same unit (for instance it |
6746 | -- was in an extended project), that source file is in fact invisible | |
5b900a45 | 6747 | -- from now on, and in particular doesn't belong to the same unit. |
9f55bc62 AC |
6748 | -- If the source is an inherited naming exception, then it may not |
6749 | -- really exist: the source potentially replaced is left untouched. | |
1d24fc5e EB |
6750 | |
6751 | if Source.Unit.File_Names (Source.Kind) /= Source then | |
6752 | Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index; | |
6753 | end if; | |
6754 | ||
6755 | Source.Unit.File_Names (Source.Kind) := null; | |
95cd3246 AC |
6756 | end if; |
6757 | ||
6758 | Source.Kind := Kind; | |
6759 | ||
e7f10ba9 EB |
6760 | if Current_Verbosity = High |
6761 | and then Source.File /= No_File | |
6762 | then | |
2598ee6d | 6763 | Debug_Output ("override kind for " |
3e582869 | 6764 | & Get_Name_String (Source.File) |
686d0984 | 6765 | & " idx=" & Source.Index'Img |
3e582869 | 6766 | & " kind=" & Source.Kind'Img); |
e7f10ba9 EB |
6767 | end if; |
6768 | ||
24a120ac AC |
6769 | if Source.Unit /= null then |
6770 | if Source.Kind = Spec then | |
6771 | Source.Unit.File_Names (Spec) := Source; | |
6772 | ||
6773 | else | |
6774 | Source.Unit.File_Names (Impl) := Source; | |
6775 | end if; | |
95cd3246 AC |
6776 | end if; |
6777 | end Override_Kind; | |
6778 | ||
6c1f47ee EB |
6779 | ---------------- |
6780 | -- Check_File -- | |
6781 | ---------------- | |
1b685674 | 6782 | |
6c1f47ee | 6783 | procedure Check_File |
fdd7e7bb EB |
6784 | (Project : in out Project_Processing_Data; |
6785 | Data : in out Tree_Processing_Data; | |
75a64833 | 6786 | Source_Dir_Rank : Natural; |
fdd7e7bb | 6787 | Path : Path_Name_Type; |
fcfb981b | 6788 | Display_Path : Path_Name_Type; |
fdd7e7bb EB |
6789 | File_Name : File_Name_Type; |
6790 | Display_File_Name : File_Name_Type; | |
6791 | Locally_Removed : Boolean; | |
6792 | For_All_Sources : Boolean) | |
6c1f47ee | 6793 | is |
fdd7e7bb | 6794 | Name_Loc : Name_Location := |
32404665 EB |
6795 | Source_Names_Htable.Get |
6796 | (Project.Source_Names, File_Name); | |
757240b3 | 6797 | Check_Name : Boolean := False; |
e1c9f239 | 6798 | Alternate_Languages : Language_List; |
757240b3 AC |
6799 | Language : Language_Ptr; |
6800 | Source : Source_Id; | |
757240b3 AC |
6801 | Src_Ind : Source_File_Index; |
6802 | Unit : Name_Id; | |
6c1f47ee EB |
6803 | Display_Language_Name : Name_Id; |
6804 | Lang_Kind : Language_Kind; | |
6805 | Kind : Source_Kind := Spec; | |
4f6447c5 | 6806 | |
44e1918a | 6807 | begin |
75a64833 | 6808 | if Current_Verbosity = High then |
3e582869 | 6809 | Debug_Increase_Indent |
2598ee6d | 6810 | ("checking file (rank=" & Source_Dir_Rank'Img & ")", |
35a1c212 | 6811 | Name_Id (Display_Path)); |
75a64833 AC |
6812 | end if; |
6813 | ||
6c1f47ee EB |
6814 | if Name_Loc = No_Name_Location then |
6815 | Check_Name := For_All_Sources; | |
07fc65c4 | 6816 | |
6c1f47ee EB |
6817 | else |
6818 | if Name_Loc.Found then | |
32404665 | 6819 | |
6c1f47ee EB |
6820 | -- Check if it is OK to have the same file name in several |
6821 | -- source directories. | |
b30668b7 | 6822 | |
75a64833 | 6823 | if Source_Dir_Rank = Name_Loc.Source.Source_Dir_Rank then |
6c1f47ee EB |
6824 | Error_Msg_File_1 := File_Name; |
6825 | Error_Msg | |
e2d9085b | 6826 | (Data.Flags, |
6c1f47ee | 6827 | "{ is found in several source directories", |
e2d9085b | 6828 | Name_Loc.Location, Project.Project); |
6c1f47ee | 6829 | end if; |
7324bf49 | 6830 | |
6c1f47ee EB |
6831 | else |
6832 | Name_Loc.Found := True; | |
6833 | ||
fdd7e7bb EB |
6834 | Source_Names_Htable.Set |
6835 | (Project.Source_Names, File_Name, Name_Loc); | |
4f469be3 | 6836 | |
6c1f47ee EB |
6837 | if Name_Loc.Source = No_Source then |
6838 | Check_Name := True; | |
6839 | ||
6840 | else | |
686d0984 AC |
6841 | -- Set the full path for the source_id (which might have been |
6842 | -- created when parsing the naming exceptions, and therefore | |
6843 | -- might not have the full path). | |
6844 | -- We only set this for this source_id, but not for other | |
6845 | -- source_id in the same file (case of multi-unit source files) | |
6846 | -- For the latter, they will be set in Find_Sources when we | |
6847 | -- check that all source_id have known full paths. | |
6848 | -- Doing this later saves one htable lookup per file in the | |
6849 | -- common case where the user is not using multi-unit files. | |
6850 | ||
fcfb981b | 6851 | Name_Loc.Source.Path := (Path, Display_Path); |
6c1f47ee EB |
6852 | |
6853 | Source_Paths_Htable.Set | |
686d0984 | 6854 | (Data.Tree.Source_Paths_HT, Path, Name_Loc.Source); |
6c1f47ee EB |
6855 | |
6856 | -- Check if this is a subunit | |
6857 | ||
5a66a766 | 6858 | if Name_Loc.Source.Unit /= No_Unit_Index |
5d07d0cf | 6859 | and then Name_Loc.Source.Kind = Impl |
6c1f47ee EB |
6860 | then |
6861 | Src_Ind := Sinput.P.Load_Project_File | |
8cce3d75 | 6862 | (Get_Name_String (Display_Path)); |
6c1f47ee EB |
6863 | |
6864 | if Sinput.P.Source_File_Is_Subunit (Src_Ind) then | |
95cd3246 | 6865 | Override_Kind (Name_Loc.Source, Sep); |
6c1f47ee | 6866 | end if; |
44e1918a | 6867 | end if; |
9f55bc62 AC |
6868 | |
6869 | -- If this is an inherited naming exception, make sure that | |
6870 | -- the naming exception it replaces is no longer a source. | |
6871 | ||
6872 | if Name_Loc.Source.Naming_Exception = Inherited then | |
6873 | declare | |
6874 | Proj : Project_Id := Name_Loc.Source.Project.Extends; | |
6875 | Iter : Source_Iterator; | |
6876 | Src : Source_Id; | |
6877 | begin | |
6878 | while Proj /= No_Project loop | |
6879 | Iter := For_Each_Source (Data.Tree, Proj); | |
6880 | Src := Prj.Element (Iter); | |
6881 | while Src /= No_Source loop | |
6882 | if Src.File = Name_Loc.Source.File then | |
6883 | Src.Replaced_By := Name_Loc.Source; | |
6884 | exit; | |
6885 | end if; | |
6886 | ||
6887 | Next (Iter); | |
6888 | Src := Prj.Element (Iter); | |
6889 | end loop; | |
6890 | ||
6891 | Proj := Proj.Extends; | |
6892 | end loop; | |
6893 | end; | |
6894 | ||
6895 | if Name_Loc.Source.Unit /= No_Unit_Index then | |
6896 | if Name_Loc.Source.Kind = Spec then | |
6897 | Name_Loc.Source.Unit.File_Names (Spec) := | |
6898 | Name_Loc.Source; | |
6899 | ||
6900 | elsif Name_Loc.Source.Kind = Impl then | |
6901 | Name_Loc.Source.Unit.File_Names (Impl) := | |
6902 | Name_Loc.Source; | |
6903 | end if; | |
6904 | ||
6905 | Units_Htable.Set | |
6906 | (Data.Tree.Units_HT, | |
6907 | Name_Loc.Source.Unit.Name, | |
6908 | Name_Loc.Source.Unit); | |
6909 | end if; | |
6910 | ||
6911 | end if; | |
6c1f47ee EB |
6912 | end if; |
6913 | end if; | |
6914 | end if; | |
7324bf49 | 6915 | |
6c1f47ee | 6916 | if Check_Name then |
ce30eccb | 6917 | Check_File_Naming_Schemes |
fdd7e7bb | 6918 | (In_Tree => Data.Tree, |
66713d62 | 6919 | Project => Project, |
6c1f47ee EB |
6920 | File_Name => File_Name, |
6921 | Alternate_Languages => Alternate_Languages, | |
6922 | Language => Language, | |
6c1f47ee EB |
6923 | Display_Language_Name => Display_Language_Name, |
6924 | Unit => Unit, | |
6925 | Lang_Kind => Lang_Kind, | |
6926 | Kind => Kind); | |
6927 | ||
6928 | if Language = No_Language_Index then | |
68c3f02a VC |
6929 | |
6930 | -- A file name in a list must be a source of a language | |
6931 | ||
32404665 EB |
6932 | if Data.Flags.Error_On_Unknown_Language |
6933 | and then Name_Loc.Found | |
6934 | then | |
6935 | Error_Msg_File_1 := File_Name; | |
6936 | Error_Msg | |
e2d9085b | 6937 | (Data.Flags, |
32404665 | 6938 | "language unknown for {", |
e2d9085b | 6939 | Name_Loc.Location, Project.Project); |
6c1f47ee | 6940 | end if; |
7324bf49 | 6941 | |
6c1f47ee | 6942 | else |
fc2c32e2 EB |
6943 | Add_Source |
6944 | (Id => Source, | |
fdd7e7bb | 6945 | Project => Project.Project, |
75a64833 | 6946 | Source_Dir_Rank => Source_Dir_Rank, |
fc2c32e2 EB |
6947 | Lang_Id => Language, |
6948 | Kind => Kind, | |
fdd7e7bb | 6949 | Data => Data, |
fc2c32e2 EB |
6950 | Alternate_Languages => Alternate_Languages, |
6951 | File_Name => File_Name, | |
6952 | Display_File => Display_File_Name, | |
6953 | Unit => Unit, | |
e2d9085b | 6954 | Locally_Removed => Locally_Removed, |
fcfb981b | 6955 | Path => (Path, Display_Path)); |
c471e2da AC |
6956 | |
6957 | -- If it is a source specified in a list, update the entry in | |
6958 | -- the Source_Names table. | |
6959 | ||
6960 | if Name_Loc.Found and then Name_Loc.Source = No_Source then | |
6961 | Name_Loc.Source := Source; | |
6962 | Source_Names_Htable.Set | |
6963 | (Project.Source_Names, File_Name, Name_Loc); | |
6964 | end if; | |
6c1f47ee EB |
6965 | end if; |
6966 | end if; | |
3e582869 AC |
6967 | |
6968 | Debug_Decrease_Indent; | |
6c1f47ee | 6969 | end Check_File; |
244e5a2c | 6970 | |
c5be6c3a EB |
6971 | --------------------------------- |
6972 | -- Expand_Subdirectory_Pattern -- | |
6973 | --------------------------------- | |
6974 | ||
6975 | procedure Expand_Subdirectory_Pattern | |
6976 | (Project : Project_Id; | |
6977 | Data : in out Tree_Processing_Data; | |
6978 | Patterns : String_List_Id; | |
e7efbe2f | 6979 | Ignore : String_List_Id; |
c5be6c3a EB |
6980 | Search_For : Search_Type; |
6981 | Resolve_Links : Boolean) | |
6982 | is | |
40ecf2f5 EB |
6983 | Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; |
6984 | ||
c5be6c3a EB |
6985 | package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable |
6986 | (Header_Num => Header_Num, | |
6987 | Element => Boolean, | |
6988 | No_Element => False, | |
6989 | Key => Path_Name_Type, | |
6990 | Hash => Hash, | |
6991 | Equal => "="); | |
6992 | -- Hash table stores recursive source directories, to avoid looking | |
6993 | -- several times, and to avoid cycles that may be introduced by symbolic | |
6994 | -- links. | |
6995 | ||
978ffe02 AC |
6996 | File_Pattern : GNAT.Regexp.Regexp; |
6997 | -- Pattern to use when matching file names | |
76e3504f | 6998 | |
c5be6c3a EB |
6999 | Visited : Recursive_Dirs.Instance; |
7000 | ||
7001 | procedure Find_Pattern | |
1aa23421 AC |
7002 | (Pattern_Id : Name_Id; |
7003 | Rank : Natural; | |
7004 | Location : Source_Ptr); | |
c5be6c3a EB |
7005 | -- Find a specific pattern |
7006 | ||
76e3504f | 7007 | function Recursive_Find_Dirs |
1aa23421 AC |
7008 | (Path : Path_Information; |
7009 | Rank : Natural) return Boolean; | |
76e3504f AC |
7010 | -- Search all the subdirectories (recursively) of Path. |
7011 | -- Return True if at least one file or directory was processed | |
7012 | ||
7013 | function Subdirectory_Matches | |
1aa23421 AC |
7014 | (Path : Path_Information; |
7015 | Rank : Natural) return Boolean; | |
76e3504f AC |
7016 | -- Called when a matching directory was found. If the user is in fact |
7017 | -- searching for files, we then search for those files matching the | |
7018 | -- pattern within the directory. | |
7019 | -- Return True if at least one file or directory was processed | |
c5be6c3a | 7020 | |
76e3504f AC |
7021 | -------------------------- |
7022 | -- Subdirectory_Matches -- | |
7023 | -------------------------- | |
7024 | ||
7025 | function Subdirectory_Matches | |
1aa23421 AC |
7026 | (Path : Path_Information; |
7027 | Rank : Natural) return Boolean | |
76e3504f AC |
7028 | is |
7029 | Dir : Dir_Type; | |
7030 | Name : String (1 .. 250); | |
7031 | Last : Natural; | |
7032 | Found : Path_Information; | |
7033 | Success : Boolean := False; | |
1aa23421 | 7034 | |
76e3504f AC |
7035 | begin |
7036 | case Search_For is | |
7037 | when Search_Directories => | |
7038 | Callback (Path, Rank); | |
7039 | return True; | |
7040 | ||
7041 | when Search_Files => | |
7042 | Open (Dir, Get_Name_String (Path.Display_Name)); | |
7043 | loop | |
7044 | Read (Dir, Name, Last); | |
7045 | exit when Last = 0; | |
7046 | ||
7047 | if Name (Name'First .. Last) /= "." | |
7048 | and then Name (Name'First .. Last) /= ".." | |
7049 | and then Match (Name (Name'First .. Last), File_Pattern) | |
7050 | then | |
7051 | Get_Name_String (Path.Display_Name); | |
7052 | Add_Str_To_Name_Buffer (Name (Name'First .. Last)); | |
7053 | ||
7054 | Found.Display_Name := Name_Find; | |
7055 | Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); | |
7056 | Found.Name := Name_Find; | |
7057 | ||
7058 | Callback (Found, Rank); | |
7059 | Success := True; | |
7060 | end if; | |
7061 | end loop; | |
7062 | ||
7063 | Close (Dir); | |
7064 | ||
7065 | return Success; | |
7066 | end case; | |
7067 | end Subdirectory_Matches; | |
eada5fd1 | 7068 | |
c5be6c3a EB |
7069 | ------------------------- |
7070 | -- Recursive_Find_Dirs -- | |
7071 | ------------------------- | |
7072 | ||
76e3504f | 7073 | function Recursive_Find_Dirs |
1aa23421 AC |
7074 | (Path : Path_Information; |
7075 | Rank : Natural) return Boolean | |
c5be6c3a | 7076 | is |
76e3504f AC |
7077 | Path_Str : constant String := Get_Name_String (Path.Display_Name); |
7078 | Dir : Dir_Type; | |
7079 | Name : String (1 .. 250); | |
7080 | Last : Natural; | |
7081 | Success : Boolean := False; | |
c5be6c3a EB |
7082 | |
7083 | begin | |
2598ee6d | 7084 | Debug_Output ("looking for subdirs of ", Name_Id (Path.Display_Name)); |
c5be6c3a | 7085 | |
76e3504f AC |
7086 | if Recursive_Dirs.Get (Visited, Path.Name) then |
7087 | return Success; | |
c5be6c3a EB |
7088 | end if; |
7089 | ||
76e3504f | 7090 | Recursive_Dirs.Set (Visited, Path.Name, True); |
c5be6c3a | 7091 | |
76e3504f | 7092 | Success := Subdirectory_Matches (Path, Rank) or Success; |
c5be6c3a | 7093 | |
76e3504f | 7094 | Open (Dir, Path_Str); |
c5be6c3a EB |
7095 | |
7096 | loop | |
7097 | Read (Dir, Name, Last); | |
7098 | exit when Last = 0; | |
7099 | ||
7100 | if Name (1 .. Last) /= "." | |
7101 | and then Name (1 .. Last) /= ".." | |
7102 | then | |
c5be6c3a EB |
7103 | declare |
7104 | Path_Name : constant String := | |
7105 | Normalize_Pathname | |
7106 | (Name => Name (1 .. Last), | |
76e3504f | 7107 | Directory => Path_Str, |
c5be6c3a EB |
7108 | Resolve_Links => Resolve_Links) |
7109 | & Directory_Separator; | |
1aa23421 | 7110 | Path2 : Path_Information; |
e7efbe2f | 7111 | OK : Boolean := True; |
1aa23421 | 7112 | |
c5be6c3a EB |
7113 | begin |
7114 | if Is_Directory (Path_Name) then | |
e7efbe2f AC |
7115 | if Ignore /= Nil_String then |
7116 | declare | |
7117 | Dir_Name : String := Name (1 .. Last); | |
468ee96a AC |
7118 | List : String_List_Id := Ignore; |
7119 | ||
e7efbe2f AC |
7120 | begin |
7121 | Canonical_Case_File_Name (Dir_Name); | |
76e3504f | 7122 | |
e7efbe2f AC |
7123 | while List /= Nil_String loop |
7124 | Get_Name_String | |
40ecf2f5 | 7125 | (Shared.String_Elements.Table (List).Value); |
e7efbe2f AC |
7126 | Canonical_Case_File_Name |
7127 | (Name_Buffer (1 .. Name_Len)); | |
7128 | OK := Name_Buffer (1 .. Name_Len) /= Dir_Name; | |
7129 | exit when not OK; | |
40ecf2f5 | 7130 | List := Shared.String_Elements.Table (List).Next; |
e7efbe2f AC |
7131 | end loop; |
7132 | end; | |
7133 | end if; | |
7134 | ||
7135 | if OK then | |
7136 | Name_Len := 0; | |
7137 | Add_Str_To_Name_Buffer (Path_Name); | |
7138 | Path2.Display_Name := Name_Find; | |
76e3504f | 7139 | |
e7efbe2f AC |
7140 | Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); |
7141 | Path2.Name := Name_Find; | |
7142 | ||
7143 | Success := | |
7144 | Recursive_Find_Dirs (Path2, Rank) or Success; | |
7145 | end if; | |
c5be6c3a EB |
7146 | end if; |
7147 | end; | |
7148 | end if; | |
7149 | end loop; | |
7150 | ||
7151 | Close (Dir); | |
7152 | ||
76e3504f AC |
7153 | return Success; |
7154 | ||
c5be6c3a EB |
7155 | exception |
7156 | when Directory_Error => | |
76e3504f | 7157 | return Success; |
c5be6c3a EB |
7158 | end Recursive_Find_Dirs; |
7159 | ||
76e3504f AC |
7160 | ------------------ |
7161 | -- Find_Pattern -- | |
7162 | ------------------ | |
eada5fd1 | 7163 | |
76e3504f | 7164 | procedure Find_Pattern |
1aa23421 AC |
7165 | (Pattern_Id : Name_Id; |
7166 | Rank : Natural; | |
7167 | Location : Source_Ptr) | |
eada5fd1 | 7168 | is |
76e3504f AC |
7169 | Pattern : constant String := Get_Name_String (Pattern_Id); |
7170 | Pattern_End : Natural := Pattern'Last; | |
7171 | Recursive : Boolean; | |
7172 | Dir : File_Name_Type; | |
7173 | Path_Name : Path_Information; | |
7174 | Dir_Exists : Boolean; | |
7175 | Has_Error : Boolean := False; | |
7176 | Success : Boolean; | |
1aa23421 | 7177 | |
eada5fd1 | 7178 | begin |
3e582869 | 7179 | Debug_Increase_Indent ("Find_Pattern", Pattern_Id); |
76e3504f AC |
7180 | |
7181 | -- If we are looking for files, find the pattern for the files | |
7182 | ||
7183 | if Search_For = Search_Files then | |
7184 | while Pattern_End >= Pattern'First | |
7185 | and then Pattern (Pattern_End) /= '/' | |
7186 | and then Pattern (Pattern_End) /= Directory_Separator | |
7187 | loop | |
7188 | Pattern_End := Pattern_End - 1; | |
7189 | end loop; | |
7190 | ||
7191 | if Pattern_End = Pattern'Last then | |
7192 | Err_Vars.Error_Msg_File_1 := File_Name_Type (Pattern_Id); | |
7193 | Error_Or_Warning | |
7194 | (Data.Flags, Data.Flags.Missing_Source_Files, | |
7195 | "Missing file name or pattern in {", Location, Project); | |
7196 | return; | |
7197 | end if; | |
7198 | ||
7199 | if Current_Verbosity = High then | |
3e582869 AC |
7200 | Debug_Indent; |
7201 | Write_Str ("file_pattern="); | |
7202 | Write_Str (Pattern (Pattern_End + 1 .. Pattern'Last)); | |
7203 | Write_Str (" dir_pattern="); | |
76e3504f AC |
7204 | Write_Line (Pattern (Pattern'First .. Pattern_End)); |
7205 | end if; | |
7206 | ||
7207 | File_Pattern := Compile | |
7208 | (Pattern (Pattern_End + 1 .. Pattern'Last), | |
7209 | Glob => True, | |
7210 | Case_Sensitive => File_Names_Case_Sensitive); | |
7211 | ||
7212 | -- If we had just "*.gpr", this is equivalent to "./*.gpr" | |
7213 | ||
7214 | if Pattern_End > Pattern'First then | |
7215 | Pattern_End := Pattern_End - 1; -- Skip directory separator | |
7216 | end if; | |
7217 | end if; | |
7218 | ||
7219 | Recursive := | |
7220 | Pattern_End - 1 >= Pattern'First | |
7221 | and then Pattern (Pattern_End - 1 .. Pattern_End) = "**" | |
7222 | and then (Pattern_End - 1 = Pattern'First | |
7223 | or else Pattern (Pattern_End - 2) = '/' | |
7224 | or else Pattern (Pattern_End - 2) = Directory_Separator); | |
7225 | ||
7226 | if Recursive then | |
7227 | Pattern_End := Pattern_End - 2; | |
7228 | if Pattern_End > Pattern'First then | |
7229 | Pattern_End := Pattern_End - 1; -- Skip '/' | |
7230 | end if; | |
7231 | end if; | |
7232 | ||
7233 | Name_Len := Pattern_End - Pattern'First + 1; | |
7234 | Name_Buffer (1 .. Name_Len) := Pattern (Pattern'First .. Pattern_End); | |
eada5fd1 EB |
7235 | Dir := Name_Find; |
7236 | ||
7237 | Locate_Directory | |
7238 | (Project => Project, | |
7239 | Name => Dir, | |
7240 | Path => Path_Name, | |
7241 | Dir_Exists => Dir_Exists, | |
7242 | Data => Data, | |
7243 | Must_Exist => False); | |
7244 | ||
7245 | if not Dir_Exists then | |
7246 | Err_Vars.Error_Msg_File_1 := Dir; | |
7247 | Error_Or_Warning | |
7248 | (Data.Flags, Data.Flags.Missing_Source_Files, | |
7249 | "{ is not a valid directory", Location, Project); | |
7250 | Has_Error := Data.Flags.Missing_Source_Files = Error; | |
7251 | end if; | |
7252 | ||
7253 | if not Has_Error then | |
7254 | -- Links have been resolved if necessary, and Path_Name | |
7255 | -- always ends with a directory separator. | |
7256 | ||
76e3504f AC |
7257 | if Recursive then |
7258 | Success := Recursive_Find_Dirs (Path_Name, Rank); | |
eada5fd1 | 7259 | else |
76e3504f | 7260 | Success := Subdirectory_Matches (Path_Name, Rank); |
eada5fd1 | 7261 | end if; |
eada5fd1 | 7262 | |
76e3504f AC |
7263 | if not Success then |
7264 | case Search_For is | |
7265 | when Search_Directories => | |
7266 | null; -- Error can't occur | |
c5be6c3a | 7267 | |
76e3504f AC |
7268 | when Search_Files => |
7269 | Err_Vars.Error_Msg_File_1 := File_Name_Type (Pattern_Id); | |
7270 | Error_Or_Warning | |
7271 | (Data.Flags, Data.Flags.Missing_Source_Files, | |
7272 | "file { not found", Location, Project); | |
7273 | end case; | |
c5be6c3a | 7274 | end if; |
c5be6c3a | 7275 | end if; |
3e582869 | 7276 | |
2598ee6d | 7277 | Debug_Decrease_Indent ("done Find_Pattern"); |
c5be6c3a EB |
7278 | end Find_Pattern; |
7279 | ||
1aa23421 | 7280 | -- Local variables |
c5be6c3a EB |
7281 | |
7282 | Pattern_Id : String_List_Id := Patterns; | |
7283 | Element : String_Element; | |
7284 | Rank : Natural := 1; | |
1aa23421 AC |
7285 | |
7286 | -- Start of processing for Expand_Subdirectory_Pattern | |
7287 | ||
c5be6c3a EB |
7288 | begin |
7289 | while Pattern_Id /= Nil_String loop | |
40ecf2f5 | 7290 | Element := Shared.String_Elements.Table (Pattern_Id); |
76e3504f | 7291 | Find_Pattern (Element.Value, Rank, Element.Location); |
c5be6c3a EB |
7292 | Rank := Rank + 1; |
7293 | Pattern_Id := Element.Next; | |
7294 | end loop; | |
7295 | ||
7296 | Recursive_Dirs.Reset (Visited); | |
7297 | end Expand_Subdirectory_Pattern; | |
7298 | ||
6c1f47ee EB |
7299 | ------------------------ |
7300 | -- Search_Directories -- | |
7301 | ------------------------ | |
7324bf49 | 7302 | |
6c1f47ee | 7303 | procedure Search_Directories |
fdd7e7bb EB |
7304 | (Project : in out Project_Processing_Data; |
7305 | Data : in out Tree_Processing_Data; | |
7306 | For_All_Sources : Boolean) | |
6c1f47ee | 7307 | is |
40ecf2f5 EB |
7308 | Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared; |
7309 | ||
6c1f47ee EB |
7310 | Source_Dir : String_List_Id; |
7311 | Element : String_Element; | |
75a64833 AC |
7312 | Src_Dir_Rank : Number_List_Index; |
7313 | Num_Nod : Number_Node; | |
6c1f47ee EB |
7314 | Dir : Dir_Type; |
7315 | Name : String (1 .. 1_000); | |
7316 | Last : Natural; | |
7317 | File_Name : File_Name_Type; | |
7318 | Display_File_Name : File_Name_Type; | |
7319 | ||
7320 | begin | |
2598ee6d | 7321 | Debug_Increase_Indent ("looking for sources of", Project.Project.Name); |
7324bf49 | 7322 | |
6c1f47ee | 7323 | -- Loop through subdirectories |
7324bf49 | 7324 | |
75a64833 | 7325 | Src_Dir_Rank := Project.Project.Source_Dir_Ranks; |
86828d40 | 7326 | |
67c86178 | 7327 | Source_Dir := Project.Project.Source_Dirs; |
6c1f47ee EB |
7328 | while Source_Dir /= Nil_String loop |
7329 | begin | |
40ecf2f5 EB |
7330 | Num_Nod := Shared.Number_Lists.Table (Src_Dir_Rank); |
7331 | Element := Shared.String_Elements.Table (Source_Dir); | |
75a64833 | 7332 | |
a548f9ff TQ |
7333 | -- Use Element.Value in this test, not Display_Value, because we |
7334 | -- want the symbolic links to be resolved when appropriate. | |
7335 | ||
6c1f47ee | 7336 | if Element.Value /= No_Name then |
44e1918a | 7337 | declare |
a548f9ff TQ |
7338 | Source_Directory : constant String := |
7339 | Get_Name_String (Element.Value) | |
7340 | & Directory_Separator; | |
7341 | ||
7342 | Dir_Last : constant Natural := | |
7343 | Compute_Directory_Last (Source_Directory); | |
7344 | ||
008f6fd3 AC |
7345 | Display_Source_Directory : constant String := |
7346 | Get_Name_String | |
7347 | (Element.Display_Value) | |
7348 | & Directory_Separator; | |
a548f9ff TQ |
7349 | -- Display_Source_Directory is to allow us to open a UTF-8 |
7350 | -- encoded directory on Windows. | |
7324bf49 | 7351 | |
244e5a2c | 7352 | begin |
6c1f47ee | 7353 | if Current_Verbosity = High then |
3e582869 AC |
7354 | Debug_Increase_Indent |
7355 | ("Source_Dir (node=" & Num_Nod.Number'Img & ") """ | |
7356 | & Source_Directory (Source_Directory'First .. Dir_Last) | |
7357 | & '"'); | |
44e1918a | 7358 | end if; |
7324bf49 | 7359 | |
6c1f47ee | 7360 | -- We look to every entry in the source directory |
7324bf49 | 7361 | |
008f6fd3 | 7362 | Open (Dir, Display_Source_Directory); |
7324bf49 | 7363 | |
6c1f47ee EB |
7364 | loop |
7365 | Read (Dir, Name, Last); | |
7324bf49 | 7366 | |
6c1f47ee | 7367 | exit when Last = 0; |
ede007da | 7368 | |
b8dfbe1e AC |
7369 | -- In fast project loading mode (without -eL), the user |
7370 | -- guarantees that no directory has a name which is a | |
7371 | -- valid source name, so we can avoid doing a system call | |
7372 | -- here. This provides a very significant speed up on | |
7373 | -- slow file systems (remote files for instance). | |
7374 | ||
7375 | if not Opt.Follow_Links_For_Files | |
7376 | or else Is_Regular_File | |
67c86178 | 7377 | (Display_Source_Directory & Name (1 .. Last)) |
6c1f47ee | 7378 | then |
6c1f47ee EB |
7379 | Name_Len := Last; |
7380 | Name_Buffer (1 .. Name_Len) := Name (1 .. Last); | |
7381 | Display_File_Name := Name_Find; | |
7382 | ||
7383 | if Osint.File_Names_Case_Sensitive then | |
7384 | File_Name := Display_File_Name; | |
7385 | else | |
7386 | Canonical_Case_File_Name | |
7387 | (Name_Buffer (1 .. Name_Len)); | |
7388 | File_Name := Name_Find; | |
7389 | end if; | |
7390 | ||
7391 | declare | |
3d164ffc AC |
7392 | Path_Name : constant String := |
7393 | Normalize_Pathname | |
7394 | (Name (1 .. Last), | |
7395 | Directory => | |
7396 | Source_Directory | |
7397 | (Source_Directory'First .. | |
7398 | Dir_Last), | |
7399 | Resolve_Links => | |
7400 | Opt.Follow_Links_For_Files, | |
7401 | Case_Sensitive => True); | |
7402 | ||
7403 | Path : Path_Name_Type; | |
7404 | FF : File_Found := | |
7405 | Excluded_Sources_Htable.Get | |
7406 | (Project.Excluded, File_Name); | |
7407 | To_Remove : Boolean := False; | |
7324bf49 | 7408 | |
6c1f47ee | 7409 | begin |
aca53298 AC |
7410 | Name_Len := Path_Name'Length; |
7411 | Name_Buffer (1 .. Name_Len) := Path_Name; | |
4d777a71 AC |
7412 | |
7413 | if Osint.File_Names_Case_Sensitive then | |
3d164ffc | 7414 | Path := Name_Find; |
4d777a71 AC |
7415 | else |
7416 | Canonical_Case_File_Name | |
7417 | (Name_Buffer (1 .. Name_Len)); | |
7418 | Path := Name_Find; | |
7419 | end if; | |
aca53298 | 7420 | |
6c1f47ee EB |
7421 | if FF /= No_File_Found then |
7422 | if not FF.Found then | |
7423 | FF.Found := True; | |
b0159fbe | 7424 | Excluded_Sources_Htable.Set |
fdd7e7bb | 7425 | (Project.Excluded, File_Name, FF); |
7324bf49 | 7426 | |
3e582869 | 7427 | Debug_Output |
2598ee6d | 7428 | ("excluded source ", |
3e582869 | 7429 | Name_Id (Display_File_Name)); |
7324bf49 | 7430 | |
fc2c32e2 EB |
7431 | -- Will mark the file as removed, but we |
7432 | -- still need to add it to the list: if we | |
7433 | -- don't, the file will not appear in the | |
7434 | -- mapping file and will cause the compiler | |
75a64833 | 7435 | -- to fail. |
fc2c32e2 EB |
7436 | |
7437 | To_Remove := True; | |
7438 | end if; | |
6c1f47ee | 7439 | end if; |
fc2c32e2 | 7440 | |
fcfb981b AC |
7441 | -- Preserve the user's original casing and use of |
7442 | -- links. The display_value (a directory) already | |
7443 | -- ends with a directory separator by construction, | |
7444 | -- so no need to add one. | |
7445 | ||
7446 | Get_Name_String (Element.Display_Value); | |
7447 | Get_Name_String_And_Append (Display_File_Name); | |
7448 | ||
fc2c32e2 | 7449 | Check_File |
fdd7e7bb | 7450 | (Project => Project, |
75a64833 | 7451 | Source_Dir_Rank => Num_Nod.Number, |
fdd7e7bb EB |
7452 | Data => Data, |
7453 | Path => Path, | |
3d164ffc | 7454 | Display_Path => Name_Find, |
fdd7e7bb EB |
7455 | File_Name => File_Name, |
7456 | Locally_Removed => To_Remove, | |
7457 | Display_File_Name => Display_File_Name, | |
7458 | For_All_Sources => For_All_Sources); | |
6c1f47ee | 7459 | end; |
3e582869 AC |
7460 | |
7461 | else | |
7462 | if Current_Verbosity = High then | |
2598ee6d | 7463 | Debug_Output ("ignore " & Name (1 .. Last)); |
3e582869 | 7464 | end if; |
751089b2 | 7465 | end if; |
6c1f47ee | 7466 | end loop; |
7324bf49 | 7467 | |
3e582869 | 7468 | Debug_Decrease_Indent; |
6c1f47ee EB |
7469 | Close (Dir); |
7470 | end; | |
7471 | end if; | |
7324bf49 | 7472 | |
6c1f47ee EB |
7473 | exception |
7474 | when Directory_Error => | |
7475 | null; | |
7476 | end; | |
4f469be3 | 7477 | |
6c1f47ee | 7478 | Source_Dir := Element.Next; |
75a64833 | 7479 | Src_Dir_Rank := Num_Nod.Next; |
6c1f47ee EB |
7480 | end loop; |
7481 | ||
2598ee6d | 7482 | Debug_Decrease_Indent ("end looking for sources."); |
6c1f47ee | 7483 | end Search_Directories; |
7324bf49 | 7484 | |
aa903780 EB |
7485 | ---------------------------- |
7486 | -- Load_Naming_Exceptions -- | |
7487 | ---------------------------- | |
7324bf49 | 7488 | |
aa903780 | 7489 | procedure Load_Naming_Exceptions |
32404665 EB |
7490 | (Project : in out Project_Processing_Data; |
7491 | Data : in out Tree_Processing_Data) | |
6c1f47ee | 7492 | is |
d9c0e057 | 7493 | Source : Source_Id; |
5eed512d | 7494 | Iter : Source_Iterator; |
d9c0e057 | 7495 | |
aa903780 | 7496 | begin |
fdd7e7bb | 7497 | Iter := For_Each_Source (Data.Tree, Project.Project); |
5eed512d EB |
7498 | loop |
7499 | Source := Prj.Element (Iter); | |
7500 | exit when Source = No_Source; | |
7501 | ||
aa903780 | 7502 | -- An excluded file cannot also be an exception file name |
7324bf49 | 7503 | |
fdd7e7bb | 7504 | if Excluded_Sources_Htable.Get (Project.Excluded, Source.File) /= |
32404665 | 7505 | No_File_Found |
b0159fbe | 7506 | then |
5d07d0cf | 7507 | Error_Msg_File_1 := Source.File; |
aa903780 | 7508 | Error_Msg |
e2d9085b | 7509 | (Data.Flags, |
aa903780 | 7510 | "{ cannot be both excluded and an exception file name", |
e2d9085b | 7511 | No_Location, Project.Project); |
aa903780 | 7512 | end if; |
4f469be3 | 7513 | |
3e582869 | 7514 | Debug_Output |
2598ee6d | 7515 | ("naming exception: adding source file to source_Names: ", |
3e582869 | 7516 | Name_Id (Source.File)); |
7324bf49 | 7517 | |
fdd7e7bb EB |
7518 | Source_Names_Htable.Set |
7519 | (Project.Source_Names, | |
7520 | K => Source.File, | |
aa903780 | 7521 | E => Name_Location' |
32404665 | 7522 | (Name => Source.File, |
602a7ec0 | 7523 | Location => Source.Location, |
32404665 | 7524 | Source => Source, |
602a7ec0 | 7525 | Listed => False, |
32404665 | 7526 | Found => False)); |
7324bf49 | 7527 | |
aa903780 | 7528 | -- If this is an Ada exception, record in table Unit_Exceptions |
7324bf49 | 7529 | |
5a66a766 | 7530 | if Source.Unit /= No_Unit_Index then |
aa903780 | 7531 | declare |
5d07d0cf | 7532 | Unit_Except : Unit_Exception := |
86828d40 AC |
7533 | Unit_Exceptions_Htable.Get |
7534 | (Project.Unit_Exceptions, Source.Unit.Name); | |
7324bf49 | 7535 | |
aa903780 | 7536 | begin |
5a66a766 | 7537 | Unit_Except.Name := Source.Unit.Name; |
751089b2 | 7538 | |
5d07d0cf EB |
7539 | if Source.Kind = Spec then |
7540 | Unit_Except.Spec := Source.File; | |
aa903780 | 7541 | else |
5d07d0cf | 7542 | Unit_Except.Impl := Source.File; |
aa903780 | 7543 | end if; |
751089b2 | 7544 | |
fdd7e7bb EB |
7545 | Unit_Exceptions_Htable.Set |
7546 | (Project.Unit_Exceptions, Source.Unit.Name, Unit_Except); | |
aa903780 EB |
7547 | end; |
7548 | end if; | |
7324bf49 | 7549 | |
5eed512d | 7550 | Next (Iter); |
aa903780 EB |
7551 | end loop; |
7552 | end Load_Naming_Exceptions; | |
6c1f47ee | 7553 | |
aa903780 EB |
7554 | ---------------------- |
7555 | -- Look_For_Sources -- | |
7556 | ---------------------- | |
6c1f47ee | 7557 | |
aa903780 | 7558 | procedure Look_For_Sources |
fdd7e7bb EB |
7559 | (Project : in out Project_Processing_Data; |
7560 | Data : in out Tree_Processing_Data) | |
aa903780 | 7561 | is |
32404665 | 7562 | Object_Files : Object_File_Names_Htable.Instance; |
dfa8a067 VC |
7563 | Iter : Source_Iterator; |
7564 | Src : Source_Id; | |
5eed512d | 7565 | |
32404665 EB |
7566 | procedure Check_Object (Src : Source_Id); |
7567 | -- Check if object file name of Src is already used in the project tree, | |
7568 | -- and report an error if so. | |
7569 | ||
7570 | procedure Check_Object_Files; | |
7571 | -- Check that no two sources of this project have the same object file | |
4f469be3 | 7572 | |
aa903780 EB |
7573 | procedure Mark_Excluded_Sources; |
7574 | -- Mark as such the sources that are declared as excluded | |
ede007da | 7575 | |
9d9f5f49 AC |
7576 | procedure Check_Missing_Sources; |
7577 | -- Check whether one of the languages has no sources, and report an | |
7578 | -- error when appropriate | |
7579 | ||
dfa8a067 | 7580 | procedure Get_Sources_From_Source_Info; |
308e6f3a | 7581 | -- Get the source information from the tables that were created when a |
686d0984 | 7582 | -- source info file was read. |
dfa8a067 | 7583 | |
9d9f5f49 AC |
7584 | --------------------------- |
7585 | -- Check_Missing_Sources -- | |
7586 | --------------------------- | |
7587 | ||
7588 | procedure Check_Missing_Sources is | |
7589 | Extending : constant Boolean := | |
86828d40 | 7590 | Project.Project.Extends /= No_Project; |
9d9f5f49 AC |
7591 | Language : Language_Ptr; |
7592 | Source : Source_Id; | |
7593 | Alt_Lang : Language_List; | |
7594 | Continuation : Boolean := False; | |
7595 | Iter : Source_Iterator; | |
7596 | begin | |
7597 | if not Project.Project.Externally_Built | |
7598 | and then not Extending | |
7599 | then | |
7600 | Language := Project.Project.Languages; | |
7601 | while Language /= No_Language_Index loop | |
7602 | ||
7603 | -- If there are no sources for this language, check if there | |
7604 | -- are sources for which this is an alternate language. | |
7605 | ||
7606 | if Language.First_Source = No_Source | |
7607 | and then (Data.Flags.Require_Sources_Other_Lang | |
7608 | or else Language.Name = Name_Ada) | |
7609 | then | |
7610 | Iter := For_Each_Source (In_Tree => Data.Tree, | |
7611 | Project => Project.Project); | |
7612 | Source_Loop : loop | |
7613 | Source := Element (Iter); | |
7614 | exit Source_Loop when Source = No_Source | |
7615 | or else Source.Language = Language; | |
7616 | ||
7617 | Alt_Lang := Source.Alternate_Languages; | |
7618 | while Alt_Lang /= null loop | |
7619 | exit Source_Loop when Alt_Lang.Language = Language; | |
7620 | Alt_Lang := Alt_Lang.Next; | |
7621 | end loop; | |
7622 | ||
7623 | Next (Iter); | |
7624 | end loop Source_Loop; | |
7625 | ||
7626 | if Source = No_Source then | |
7627 | Report_No_Sources | |
7628 | (Project.Project, | |
7629 | Get_Name_String (Language.Display_Name), | |
7630 | Data, | |
7631 | Project.Source_List_File_Location, | |
7632 | Continuation); | |
7633 | Continuation := True; | |
7634 | end if; | |
7635 | end if; | |
7636 | ||
7637 | Language := Language.Next; | |
7638 | end loop; | |
7639 | end if; | |
7640 | end Check_Missing_Sources; | |
7641 | ||
32404665 EB |
7642 | ------------------ |
7643 | -- Check_Object -- | |
7644 | ------------------ | |
7645 | ||
7646 | procedure Check_Object (Src : Source_Id) is | |
7647 | Source : Source_Id; | |
7648 | ||
7649 | begin | |
7650 | Source := Object_File_Names_Htable.Get (Object_Files, Src.Object); | |
7651 | ||
7652 | -- We cannot just check on "Source /= Src", since we might have | |
7653 | -- two different entries for the same file (and since that's | |
7654 | -- the same file it is expected that it has the same object) | |
7655 | ||
7656 | if Source /= No_Source | |
2ba1a7c7 | 7657 | and then Source.Replaced_By = No_Source |
32404665 | 7658 | and then Source.Path /= Src.Path |
2ba1a7c7 | 7659 | and then Is_Extending (Src.Project, Source.Project) |
32404665 EB |
7660 | then |
7661 | Error_Msg_File_1 := Src.File; | |
7662 | Error_Msg_File_2 := Source.File; | |
7663 | Error_Msg | |
e2d9085b | 7664 | (Data.Flags, |
32404665 | 7665 | "{ and { have the same object file name", |
e2d9085b | 7666 | No_Location, Project.Project); |
32404665 EB |
7667 | |
7668 | else | |
7669 | Object_File_Names_Htable.Set (Object_Files, Src.Object, Src); | |
7670 | end if; | |
7671 | end Check_Object; | |
7672 | ||
aa903780 EB |
7673 | --------------------------- |
7674 | -- Mark_Excluded_Sources -- | |
7675 | --------------------------- | |
ede007da | 7676 | |
aa903780 EB |
7677 | procedure Mark_Excluded_Sources is |
7678 | Source : Source_Id := No_Source; | |
95cd3246 | 7679 | Excluded : File_Found; |
b0159fbe | 7680 | Proj : Project_Id; |
32404665 | 7681 | |
aa903780 | 7682 | begin |
fb2e11ee AC |
7683 | -- Minor optimization: if there are no excluded files, no need to |
7684 | -- traverse the list of sources. We cannot however also check whether | |
7685 | -- the existing exceptions have ".Found" set to True (indicating we | |
7686 | -- found them before) because we need to do some final processing on | |
7687 | -- them in any case. | |
95cd3246 | 7688 | |
fdd7e7bb | 7689 | if Excluded_Sources_Htable.Get_First (Project.Excluded) /= |
32404665 | 7690 | No_File_Found |
fb2e11ee | 7691 | then |
fdd7e7bb | 7692 | Proj := Project.Project; |
fb2e11ee | 7693 | while Proj /= No_Project loop |
fdd7e7bb | 7694 | Iter := For_Each_Source (Data.Tree, Proj); |
fb2e11ee AC |
7695 | while Prj.Element (Iter) /= No_Source loop |
7696 | Source := Prj.Element (Iter); | |
7697 | Excluded := Excluded_Sources_Htable.Get | |
fdd7e7bb | 7698 | (Project.Excluded, Source.File); |
fb2e11ee AC |
7699 | |
7700 | if Excluded /= No_File_Found then | |
7701 | Source.Locally_Removed := True; | |
7702 | Source.In_Interfaces := False; | |
7703 | ||
7704 | if Current_Verbosity = High then | |
3e582869 | 7705 | Debug_Indent; |
2598ee6d | 7706 | Write_Str ("removing file "); |
fb2e11ee AC |
7707 | Write_Line |
7708 | (Get_Name_String (Excluded.File) | |
7709 | & " " & Get_Name_String (Source.Project.Name)); | |
7710 | end if; | |
7711 | ||
7712 | Excluded_Sources_Htable.Remove | |
fdd7e7bb | 7713 | (Project.Excluded, Source.File); |
b0159fbe | 7714 | end if; |
ede007da | 7715 | |
fb2e11ee AC |
7716 | Next (Iter); |
7717 | end loop; | |
d9c0e057 | 7718 | |
fb2e11ee | 7719 | Proj := Proj.Extends; |
b0159fbe | 7720 | end loop; |
fb2e11ee | 7721 | end if; |
aa903780 | 7722 | |
b0159fbe AC |
7723 | -- If we have any excluded element left, that means we did not find |
7724 | -- the source file | |
ede007da | 7725 | |
fdd7e7bb | 7726 | Excluded := Excluded_Sources_Htable.Get_First (Project.Excluded); |
b0159fbe | 7727 | while Excluded /= No_File_Found loop |
fb2e11ee | 7728 | if not Excluded.Found then |
c2369146 | 7729 | |
fb2e11ee AC |
7730 | -- Check if the file belongs to another imported project to |
7731 | -- provide a better error message. | |
aa903780 | 7732 | |
fb2e11ee | 7733 | Src := Find_Source |
fdd7e7bb EB |
7734 | (In_Tree => Data.Tree, |
7735 | Project => Project.Project, | |
fb2e11ee AC |
7736 | In_Imported_Only => True, |
7737 | Base_Name => Excluded.File); | |
5a66a766 | 7738 | |
fb2e11ee | 7739 | Err_Vars.Error_Msg_File_1 := Excluded.File; |
ede007da | 7740 | |
fb2e11ee | 7741 | if Src = No_Source then |
1f6439e3 AC |
7742 | if Excluded.Excl_File = No_File then |
7743 | Error_Msg | |
7744 | (Data.Flags, | |
7745 | "unknown file {", Excluded.Location, Project.Project); | |
7746 | ||
7747 | else | |
7748 | Error_Msg | |
e2d9085b | 7749 | (Data.Flags, |
1f6439e3 AC |
7750 | "in " & |
7751 | Get_Name_String (Excluded.Excl_File) & ":" & | |
7752 | No_Space_Img (Excluded.Excl_Line) & | |
7753 | ": unknown file {", Excluded.Location, Project.Project); | |
7754 | end if; | |
7755 | ||
fb2e11ee | 7756 | else |
1f6439e3 AC |
7757 | if Excluded.Excl_File = No_File then |
7758 | Error_Msg | |
7759 | (Data.Flags, | |
7760 | "cannot remove a source from an imported project: {", | |
7761 | Excluded.Location, Project.Project); | |
7762 | ||
7763 | else | |
7764 | Error_Msg | |
7765 | (Data.Flags, | |
7766 | "in " & | |
7767 | Get_Name_String (Excluded.Excl_File) & ":" & | |
7768 | No_Space_Img (Excluded.Excl_Line) & | |
7769 | ": cannot remove a source from an imported project: {", | |
7770 | Excluded.Location, Project.Project); | |
7771 | end if; | |
fb2e11ee | 7772 | end if; |
6c1f47ee | 7773 | end if; |
4f6447c5 | 7774 | |
fdd7e7bb | 7775 | Excluded := Excluded_Sources_Htable.Get_Next (Project.Excluded); |
6c1f47ee | 7776 | end loop; |
aa903780 EB |
7777 | end Mark_Excluded_Sources; |
7778 | ||
32404665 EB |
7779 | ------------------------ |
7780 | -- Check_Object_Files -- | |
7781 | ------------------------ | |
c7867d82 | 7782 | |
32404665 EB |
7783 | procedure Check_Object_Files is |
7784 | Iter : Source_Iterator; | |
7785 | Src_Id : Source_Id; | |
7786 | Src_Ind : Source_File_Index; | |
e1f3cb58 | 7787 | |
aa903780 | 7788 | begin |
32404665 EB |
7789 | Iter := For_Each_Source (Data.Tree); |
7790 | loop | |
7791 | Src_Id := Prj.Element (Iter); | |
7792 | exit when Src_Id = No_Source; | |
72a3d7c7 | 7793 | |
32404665 EB |
7794 | if Is_Compilable (Src_Id) |
7795 | and then Src_Id.Language.Config.Object_Generated | |
7796 | and then Is_Extending (Project.Project, Src_Id.Project) | |
7797 | then | |
7798 | if Src_Id.Unit = No_Unit_Index then | |
7799 | if Src_Id.Kind = Impl then | |
7800 | Check_Object (Src_Id); | |
7801 | end if; | |
c7867d82 VC |
7802 | |
7803 | else | |
32404665 EB |
7804 | case Src_Id.Kind is |
7805 | when Spec => | |
7806 | if Other_Part (Src_Id) = No_Source then | |
7807 | Check_Object (Src_Id); | |
7808 | end if; | |
c7867d82 | 7809 | |
32404665 EB |
7810 | when Sep => |
7811 | null; | |
5eed512d | 7812 | |
32404665 EB |
7813 | when Impl => |
7814 | if Other_Part (Src_Id) /= No_Source then | |
7815 | Check_Object (Src_Id); | |
c7867d82 | 7816 | |
32404665 EB |
7817 | else |
7818 | -- Check if it is a subunit | |
c7867d82 | 7819 | |
2c011ce1 RD |
7820 | Src_Ind := |
7821 | Sinput.P.Load_Project_File | |
8cce3d75 | 7822 | (Get_Name_String (Src_Id.Path.Display_Name)); |
ecc4ddde | 7823 | |
32404665 EB |
7824 | if Sinput.P.Source_File_Is_Subunit (Src_Ind) then |
7825 | Override_Kind (Src_Id, Sep); | |
5d07d0cf | 7826 | else |
32404665 | 7827 | Check_Object (Src_Id); |
5d07d0cf | 7828 | end if; |
32404665 EB |
7829 | end if; |
7830 | end case; | |
5d07d0cf | 7831 | end if; |
32404665 | 7832 | end if; |
5eed512d | 7833 | |
32404665 EB |
7834 | Next (Iter); |
7835 | end loop; | |
7836 | end Check_Object_Files; | |
ede007da | 7837 | |
dfa8a067 VC |
7838 | ---------------------------------- |
7839 | -- Get_Sources_From_Source_Info -- | |
7840 | ---------------------------------- | |
7841 | ||
7842 | procedure Get_Sources_From_Source_Info is | |
7843 | Iter : Source_Info_Iterator; | |
7844 | Src : Source_Info; | |
7845 | Id : Source_Id; | |
7846 | Lang_Id : Language_Ptr; | |
cf161d66 | 7847 | |
dfa8a067 VC |
7848 | begin |
7849 | Initialize (Iter, Project.Project.Name); | |
7850 | ||
7851 | loop | |
7852 | Src := Source_Info_Of (Iter); | |
7853 | ||
7854 | exit when Src = No_Source_Info; | |
7855 | ||
7856 | Id := new Source_Data; | |
7857 | ||
7858 | Id.Project := Project.Project; | |
7859 | ||
7860 | Lang_Id := Project.Project.Languages; | |
86828d40 AC |
7861 | while Lang_Id /= No_Language_Index |
7862 | and then Lang_Id.Name /= Src.Language | |
dfa8a067 VC |
7863 | loop |
7864 | Lang_Id := Lang_Id.Next; | |
7865 | end loop; | |
7866 | ||
7867 | if Lang_Id = No_Language_Index then | |
7868 | Prj.Com.Fail | |
7869 | ("unknown language " & | |
7870 | Get_Name_String (Src.Language) & | |
7871 | " for project " & | |
7872 | Get_Name_String (Src.Project) & | |
7873 | " in source info file"); | |
7874 | end if; | |
7875 | ||
86828d40 AC |
7876 | Id.Language := Lang_Id; |
7877 | Id.Kind := Src.Kind; | |
7878 | Id.Index := Src.Index; | |
dfa8a067 VC |
7879 | |
7880 | Id.Path := | |
7881 | (Path_Name_Type (Src.Display_Path_Name), | |
7882 | Path_Name_Type (Src.Path_Name)); | |
7883 | ||
7884 | Name_Len := 0; | |
7885 | Add_Str_To_Name_Buffer | |
86828d40 | 7886 | (Directories.Simple_Name (Get_Name_String (Src.Path_Name))); |
dfa8a067 VC |
7887 | Id.File := Name_Find; |
7888 | ||
468ee96a AC |
7889 | Id.Next_With_File_Name := |
7890 | Source_Files_Htable.Get (Data.Tree.Source_Files_HT, Id.File); | |
7891 | Source_Files_Htable.Set (Data.Tree.Source_Files_HT, Id.File, Id); | |
7892 | ||
dfa8a067 VC |
7893 | Name_Len := 0; |
7894 | Add_Str_To_Name_Buffer | |
86828d40 | 7895 | (Directories.Simple_Name |
dfa8a067 VC |
7896 | (Get_Name_String (Src.Display_Path_Name))); |
7897 | Id.Display_File := Name_Find; | |
7898 | ||
86828d40 AC |
7899 | Id.Dep_Name := |
7900 | Dependency_Name (Id.File, Id.Language.Config.Dependency_Kind); | |
7901 | Id.Naming_Exception := Src.Naming_Exception; | |
7902 | Id.Object := | |
7903 | Object_Name (Id.File, Id.Language.Config.Object_File_Suffix); | |
7904 | Id.Switches := Switches_Name (Id.File); | |
dfa8a067 VC |
7905 | |
7906 | -- Add the source id to the Unit_Sources_HT hash table, if the | |
7907 | -- unit name is not null. | |
7908 | ||
7909 | if Src.Kind /= Sep and then Src.Unit_Name /= No_Name then | |
7910 | ||
7911 | declare | |
7912 | UData : Unit_Index := | |
86828d40 AC |
7913 | Units_Htable.Get |
7914 | (Data.Tree.Units_HT, Src.Unit_Name); | |
dfa8a067 VC |
7915 | begin |
7916 | if UData = No_Unit_Index then | |
7917 | UData := new Unit_Data; | |
7918 | UData.Name := Src.Unit_Name; | |
7919 | Units_Htable.Set | |
7920 | (Data.Tree.Units_HT, Src.Unit_Name, UData); | |
7921 | end if; | |
7922 | ||
7923 | Id.Unit := UData; | |
7924 | end; | |
7925 | ||
7926 | -- Note that this updates Unit information as well | |
7927 | ||
7928 | Override_Kind (Id, Id.Kind); | |
7929 | end if; | |
7930 | ||
7931 | if Src.Index /= 0 then | |
7932 | Project.Project.Has_Multi_Unit_Sources := True; | |
7933 | end if; | |
7934 | ||
7935 | -- Add the source to the language list | |
7936 | ||
7937 | Id.Next_In_Lang := Id.Language.First_Source; | |
7938 | Id.Language.First_Source := Id; | |
7939 | ||
dfa8a067 VC |
7940 | Next (Iter); |
7941 | end loop; | |
7942 | end Get_Sources_From_Source_Info; | |
7943 | ||
6c1f47ee | 7944 | -- Start of processing for Look_For_Sources |
ede007da | 7945 | |
6c1f47ee | 7946 | begin |
dfa8a067 VC |
7947 | if Data.Tree.Source_Info_File_Exists then |
7948 | Get_Sources_From_Source_Info; | |
7949 | ||
7950 | else | |
7951 | if Project.Project.Source_Dirs /= Nil_String then | |
7952 | Find_Excluded_Sources (Project, Data); | |
7953 | ||
7954 | if Project.Project.Languages /= No_Language_Index then | |
7955 | Load_Naming_Exceptions (Project, Data); | |
7956 | Find_Sources (Project, Data); | |
7957 | Mark_Excluded_Sources; | |
7958 | Check_Object_Files; | |
7959 | Check_Missing_Sources; | |
7960 | end if; | |
9d9f5f49 | 7961 | end if; |
32404665 | 7962 | |
dfa8a067 VC |
7963 | Object_File_Names_Htable.Reset (Object_Files); |
7964 | end if; | |
44e1918a | 7965 | end Look_For_Sources; |
19235870 RK |
7966 | |
7967 | ------------------ | |
7968 | -- Path_Name_Of -- | |
7969 | ------------------ | |
7970 | ||
19235870 | 7971 | function Path_Name_Of |
751089b2 | 7972 | (File_Name : File_Name_Type; |
1b685674 | 7973 | Directory : Path_Name_Type) return String |
19235870 | 7974 | is |
c7867d82 | 7975 | Result : String_Access; |
19235870 RK |
7976 | The_Directory : constant String := Get_Name_String (Directory); |
7977 | ||
7978 | begin | |
2598ee6d | 7979 | Debug_Output ("Path_Name_Of file name=", Name_Id (File_Name)); |
fe0ec02f | 7980 | Debug_Output ("Path_Name_Of directory=", Name_Id (Directory)); |
fbf5a39b | 7981 | Get_Name_String (File_Name); |
c7867d82 VC |
7982 | Result := |
7983 | Locate_Regular_File | |
7984 | (File_Name => Name_Buffer (1 .. Name_Len), | |
7985 | Path => The_Directory); | |
19235870 RK |
7986 | |
7987 | if Result = null then | |
7988 | return ""; | |
7989 | else | |
b4763f5c | 7990 | declare |
0180fd26 | 7991 | R : constant String := Result.all; |
b4763f5c AC |
7992 | begin |
7993 | Free (Result); | |
b4763f5c AC |
7994 | return R; |
7995 | end; | |
19235870 RK |
7996 | end if; |
7997 | end Path_Name_Of; | |
7998 | ||
ede007da VC |
7999 | ------------------- |
8000 | -- Remove_Source -- | |
8001 | ------------------- | |
97b7ca6f | 8002 | |
ede007da | 8003 | procedure Remove_Source |
72e9f2b9 AC |
8004 | (Tree : Project_Tree_Ref; |
8005 | Id : Source_Id; | |
5d07d0cf | 8006 | Replaced_By : Source_Id) |
ede007da | 8007 | is |
757240b3 | 8008 | Source : Source_Id; |
ede007da VC |
8009 | |
8010 | begin | |
8011 | if Current_Verbosity = High then | |
3e582869 | 8012 | Debug_Indent; |
2598ee6d | 8013 | Write_Str ("removing source "); |
75a64833 AC |
8014 | Write_Str (Get_Name_String (Id.File)); |
8015 | ||
8016 | if Id.Index /= 0 then | |
8017 | Write_Str (" at" & Id.Index'Img); | |
8018 | end if; | |
8019 | ||
8020 | Write_Eol; | |
ede007da VC |
8021 | end if; |
8022 | ||
4f469be3 | 8023 | if Replaced_By /= No_Source then |
5d07d0cf EB |
8024 | Id.Replaced_By := Replaced_By; |
8025 | Replaced_By.Declared_In_Interfaces := Id.Declared_In_Interfaces; | |
72e9f2b9 AC |
8026 | |
8027 | if Id.File /= Replaced_By.File then | |
8028 | declare | |
8029 | Replacement : constant File_Name_Type := | |
fa8d6f07 AC |
8030 | Replaced_Source_HTable.Get |
8031 | (Tree.Replaced_Sources, Id.File); | |
8032 | ||
72e9f2b9 AC |
8033 | begin |
8034 | Replaced_Source_HTable.Set | |
8035 | (Tree.Replaced_Sources, Id.File, Replaced_By.File); | |
8036 | ||
8037 | if Replacement = No_File then | |
8038 | Tree.Replaced_Source_Number := | |
8039 | Tree.Replaced_Source_Number + 1; | |
8040 | end if; | |
8041 | end; | |
8042 | end if; | |
4f469be3 | 8043 | end if; |
4f6447c5 | 8044 | |
c2369146 AC |
8045 | Id.In_Interfaces := False; |
8046 | Id.Locally_Removed := True; | |
8047 | ||
8048 | -- ??? Should we remove the source from the unit ? The file is not used, | |
8049 | -- so probably should not be referenced from the unit. On the other hand | |
8050 | -- it might give useful additional info | |
8051 | -- if Id.Unit /= null then | |
8052 | -- Id.Unit.File_Names (Id.Kind) := null; | |
8053 | -- end if; | |
8054 | ||
5d07d0cf | 8055 | Source := Id.Language.First_Source; |
ede007da VC |
8056 | |
8057 | if Source = Id then | |
5d07d0cf | 8058 | Id.Language.First_Source := Id.Next_In_Lang; |
ede007da VC |
8059 | |
8060 | else | |
5d07d0cf EB |
8061 | while Source.Next_In_Lang /= Id loop |
8062 | Source := Source.Next_In_Lang; | |
ede007da VC |
8063 | end loop; |
8064 | ||
5d07d0cf | 8065 | Source.Next_In_Lang := Id.Next_In_Lang; |
ede007da | 8066 | end if; |
ede007da VC |
8067 | end Remove_Source; |
8068 | ||
8069 | ----------------------- | |
8070 | -- Report_No_Sources -- | |
8071 | ----------------------- | |
8072 | ||
8073 | procedure Report_No_Sources | |
4f469be3 VC |
8074 | (Project : Project_Id; |
8075 | Lang_Name : String; | |
fdd7e7bb | 8076 | Data : Tree_Processing_Data; |
4f469be3 VC |
8077 | Location : Source_Ptr; |
8078 | Continuation : Boolean := False) | |
97b7ca6f VC |
8079 | is |
8080 | begin | |
32404665 | 8081 | case Data.Flags.When_No_Sources is |
97b7ca6f VC |
8082 | when Silent => |
8083 | null; | |
8084 | ||
8085 | when Warning | Error => | |
4f469be3 VC |
8086 | declare |
8087 | Msg : constant String := | |
86828d40 AC |
8088 | "<there are no " |
8089 | & Lang_Name & " sources in this project"; | |
4f469be3 VC |
8090 | |
8091 | begin | |
32404665 | 8092 | Error_Msg_Warn := Data.Flags.When_No_Sources = Warning; |
4f469be3 VC |
8093 | |
8094 | if Continuation then | |
e2d9085b | 8095 | Error_Msg (Data.Flags, "\" & Msg, Location, Project); |
4f469be3 | 8096 | else |
e2d9085b | 8097 | Error_Msg (Data.Flags, Msg, Location, Project); |
4f469be3 VC |
8098 | end if; |
8099 | end; | |
97b7ca6f | 8100 | end case; |
ede007da | 8101 | end Report_No_Sources; |
97b7ca6f | 8102 | |
19235870 RK |
8103 | ---------------------- |
8104 | -- Show_Source_Dirs -- | |
8105 | ---------------------- | |
8106 | ||
7e98a4c6 | 8107 | procedure Show_Source_Dirs |
66713d62 | 8108 | (Project : Project_Id; |
40ecf2f5 | 8109 | Shared : Shared_Project_Tree_Data_Access) |
7e98a4c6 VC |
8110 | is |
8111 | Current : String_List_Id; | |
19235870 RK |
8112 | Element : String_Element; |
8113 | ||
8114 | begin | |
c4d67e2d | 8115 | if Project.Source_Dirs = Nil_String then |
2598ee6d | 8116 | Debug_Output ("no Source_Dirs"); |
c4d67e2d AC |
8117 | else |
8118 | Debug_Increase_Indent ("Source_Dirs:"); | |
8119 | ||
8120 | Current := Project.Source_Dirs; | |
8121 | while Current /= Nil_String loop | |
40ecf2f5 | 8122 | Element := Shared.String_Elements.Table (Current); |
c4d67e2d AC |
8123 | Debug_Output (Get_Name_String (Element.Display_Value)); |
8124 | Current := Element.Next; | |
8125 | end loop; | |
19235870 | 8126 | |
c4d67e2d AC |
8127 | Debug_Decrease_Indent ("end Source_Dirs."); |
8128 | end if; | |
19235870 | 8129 | end Show_Source_Dirs; |
32404665 EB |
8130 | |
8131 | --------------------------- | |
8132 | -- Process_Naming_Scheme -- | |
8133 | --------------------------- | |
8134 | ||
8135 | procedure Process_Naming_Scheme | |
8136 | (Tree : Project_Tree_Ref; | |
8137 | Root_Project : Project_Id; | |
a0a786e3 | 8138 | Node_Tree : Prj.Tree.Project_Node_Tree_Ref; |
32404665 EB |
8139 | Flags : Processing_Flags) |
8140 | is | |
8141 | procedure Recursive_Check | |
40ecf2f5 EB |
8142 | (Project : Project_Id; |
8143 | Prj_Tree : Project_Tree_Ref; | |
8144 | Data : in out Tree_Processing_Data); | |
32404665 EB |
8145 | -- Check_Naming_Scheme for the project |
8146 | ||
8147 | --------------------- | |
8148 | -- Recursive_Check -- | |
8149 | --------------------- | |
8150 | ||
8151 | procedure Recursive_Check | |
40ecf2f5 EB |
8152 | (Project : Project_Id; |
8153 | Prj_Tree : Project_Tree_Ref; | |
8154 | Data : in out Tree_Processing_Data) is | |
32404665 | 8155 | begin |
40ecf2f5 EB |
8156 | if Current_Verbosity = High then |
8157 | Debug_Increase_Indent | |
8158 | ("Processing_Naming_Scheme for project", Project.Name); | |
32404665 EB |
8159 | end if; |
8160 | ||
40ecf2f5 | 8161 | Data.Tree := Prj_Tree; |
32404665 | 8162 | Prj.Nmsc.Check (Project, Data); |
40ecf2f5 EB |
8163 | |
8164 | if Current_Verbosity = High then | |
2598ee6d | 8165 | Debug_Decrease_Indent ("done Processing_Naming_Scheme"); |
40ecf2f5 | 8166 | end if; |
32404665 EB |
8167 | end Recursive_Check; |
8168 | ||
8169 | procedure Check_All_Projects is new | |
8170 | For_Every_Project_Imported (Tree_Processing_Data, Recursive_Check); | |
8171 | ||
8172 | Data : Tree_Processing_Data; | |
2c011ce1 RD |
8173 | |
8174 | -- Start of processing for Process_Naming_Scheme | |
32404665 | 8175 | begin |
3b6d290a | 8176 | Lib_Data_Table.Init; |
a0a786e3 | 8177 | Initialize (Data, Tree => Tree, Node_Tree => Node_Tree, Flags => Flags); |
40ecf2f5 | 8178 | Check_All_Projects (Root_Project, Tree, Data, Imported_First => True); |
32404665 | 8179 | Free (Data); |
ee81cbe9 AC |
8180 | |
8181 | -- Adjust language configs for projects that are extended | |
8182 | ||
8183 | declare | |
8184 | List : Project_List; | |
8185 | Proj : Project_Id; | |
8186 | Exte : Project_Id; | |
8187 | Lang : Language_Ptr; | |
8188 | Elng : Language_Ptr; | |
8189 | ||
8190 | begin | |
8191 | List := Tree.Projects; | |
8192 | while List /= null loop | |
8193 | Proj := List.Project; | |
8194 | Exte := Proj; | |
8195 | while Exte.Extended_By /= No_Project loop | |
8196 | Exte := Exte.Extended_By; | |
8197 | end loop; | |
8198 | ||
8199 | if Exte /= Proj then | |
8200 | Lang := Proj.Languages; | |
8201 | ||
8202 | if Lang /= No_Language_Index then | |
8203 | loop | |
8204 | Elng := Get_Language_From_Name | |
8205 | (Exte, Get_Name_String (Lang.Name)); | |
8206 | exit when Elng /= No_Language_Index; | |
8207 | Exte := Exte.Extends; | |
8208 | end loop; | |
8209 | ||
8210 | if Elng /= Lang then | |
8211 | Lang.Config := Elng.Config; | |
8212 | end if; | |
8213 | end if; | |
8214 | end if; | |
8215 | ||
8216 | List := List.Next; | |
8217 | end loop; | |
8218 | end; | |
32404665 EB |
8219 | end Process_Naming_Scheme; |
8220 | ||
19235870 | 8221 | end Prj.Nmsc; |