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