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