]> gcc.gnu.org Git - gcc.git/blame - gcc/ada/prj-nmsc.adb
[multiple changes]
[gcc.git] / gcc / ada / prj-nmsc.adb
CommitLineData
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 26with Err_Vars; use Err_Vars;
2f41ec1a 27with Opt; use Opt;
07fc65c4
GB
28with Osint; use Osint;
29with Output; use Output;
dfa8a067 30with Prj.Com;
a96ca600 31with Prj.Env; use Prj.Env;
e2d9085b 32with Prj.Err; use Prj.Err;
c4d67e2d 33with Prj.Tree; use Prj.Tree;
07fc65c4 34with Prj.Util; use Prj.Util;
fbf5a39b 35with Sinput.P;
07fc65c4 36with Snames; use Snames;
bb4daba3 37with Targparm; use Targparm;
07fc65c4 38
b30668b7 39with Ada.Characters.Handling; use Ada.Characters.Handling;
2f41ec1a 40with Ada.Directories; use Ada.Directories;
b30668b7
VC
41with Ada.Strings; use Ada.Strings;
42with Ada.Strings.Fixed; use Ada.Strings.Fixed;
19235870 43with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
07fc65c4 44
3ce5ca75
RD
45with GNAT.Case_Util; use GNAT.Case_Util;
46with GNAT.Directory_Operations; use GNAT.Directory_Operations;
47with GNAT.Dynamic_HTables;
1aa23421 48with GNAT.Regexp; use GNAT.Regexp;
3ce5ca75
RD
49with GNAT.Table;
50
19235870
RK
51package 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 8065end Prj.Nmsc;
This page took 4.133231 seconds and 5 git commands to generate.