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