Fix unused warnings.
[official-gcc/graphite-test-results.git] / gcc / ada / prj-nmsc.adb
blob246d28a5a7fc4e0adbbd97758502ecef98b22119
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-2010, 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 ------------------------------------------------------------------------------
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.Err; use Prj.Err;
32 with Prj.Util; use Prj.Util;
33 with Sinput.P;
34 with Snames; use Snames;
35 with Targparm; use Targparm;
37 with Ada.Characters.Handling; use Ada.Characters.Handling;
38 with Ada.Directories; use Ada.Directories;
39 with Ada.Strings; use Ada.Strings;
40 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
41 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
43 with GNAT.Case_Util; use GNAT.Case_Util;
44 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
45 with GNAT.Dynamic_HTables;
46 with GNAT.Regexp; use GNAT.Regexp;
47 with GNAT.Table;
49 package body Prj.Nmsc is
51 No_Continuation_String : aliased String := "";
52 Continuation_String : aliased String := "\";
53 -- Used in Check_Library for continuation error messages at the same
54 -- location.
56 type Name_Location is record
57 Name : File_Name_Type; -- ??? duplicates the key
58 Location : Source_Ptr;
59 Source : Source_Id := No_Source;
60 Listed : Boolean := False;
61 Found : Boolean := False;
62 end record;
64 No_Name_Location : constant Name_Location :=
65 (Name => No_File,
66 Location => No_Location,
67 Source => No_Source,
68 Listed => False,
69 Found => False);
71 package Source_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable
72 (Header_Num => Header_Num,
73 Element => Name_Location,
74 No_Element => No_Name_Location,
75 Key => File_Name_Type,
76 Hash => Hash,
77 Equal => "=");
78 -- File name information found in string list attribute (Source_Files or
79 -- Source_List_File). Except is set to True if source is a naming exception
80 -- in the project. Used to check that all referenced files were indeed
81 -- found on the disk.
83 type Unit_Exception is record
84 Name : Name_Id; -- ??? duplicates the key
85 Spec : File_Name_Type;
86 Impl : File_Name_Type;
87 end record;
89 No_Unit_Exception : constant Unit_Exception := (No_Name, No_File, No_File);
91 package Unit_Exceptions_Htable is new GNAT.Dynamic_HTables.Simple_HTable
92 (Header_Num => Header_Num,
93 Element => Unit_Exception,
94 No_Element => No_Unit_Exception,
95 Key => Name_Id,
96 Hash => Hash,
97 Equal => "=");
98 -- Record special naming schemes for Ada units (name of spec file and name
99 -- of implementation file). The elements in this list come from the naming
100 -- exceptions specified in the project files.
102 type File_Found is record
103 File : File_Name_Type := No_File;
104 Found : Boolean := False;
105 Location : Source_Ptr := No_Location;
106 end record;
108 No_File_Found : constant File_Found := (No_File, False, No_Location);
110 package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable
111 (Header_Num => Header_Num,
112 Element => File_Found,
113 No_Element => No_File_Found,
114 Key => File_Name_Type,
115 Hash => Hash,
116 Equal => "=");
117 -- A hash table to store the base names of excluded files, if any
119 package Object_File_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable
120 (Header_Num => Header_Num,
121 Element => Source_Id,
122 No_Element => No_Source,
123 Key => File_Name_Type,
124 Hash => Hash,
125 Equal => "=");
126 -- A hash table to store the object file names for a project, to check that
127 -- two different sources have different object file names.
129 type Project_Processing_Data is record
130 Project : Project_Id;
131 Source_Names : Source_Names_Htable.Instance;
132 Unit_Exceptions : Unit_Exceptions_Htable.Instance;
133 Excluded : Excluded_Sources_Htable.Instance;
135 Source_List_File_Location : Source_Ptr;
136 -- Location of the Source_List_File attribute, for error messages
137 end record;
138 -- This is similar to Tree_Processing_Data, but contains project-specific
139 -- information which is only useful while processing the project, and can
140 -- be discarded as soon as we have finished processing the project
142 package Files_Htable is new GNAT.Dynamic_HTables.Simple_HTable
143 (Header_Num => Header_Num,
144 Element => Source_Id,
145 No_Element => No_Source,
146 Key => File_Name_Type,
147 Hash => Hash,
148 Equal => "=");
149 -- Mapping from base file names to Source_Id (containing full info about
150 -- the source).
152 type Tree_Processing_Data is record
153 Tree : Project_Tree_Ref;
154 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
155 File_To_Source : Files_Htable.Instance;
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.
164 type Lib_Data is record
165 Name : Name_Id;
166 Proj : Project_Id;
167 end record;
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.
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
185 procedure Free (Data : in out Tree_Processing_Data);
186 -- Free the memory occupied by Data
188 procedure Check
189 (Project : Project_Id;
190 Data : in out Tree_Processing_Data);
191 -- Process the naming scheme for a single project
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
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.
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.
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.
216 type Search_Type is (Search_Files, Search_Directories);
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 -- Every time such a file or directory is found, the callback is called.
234 -- Resolve_Links indicates whether we should resolve links while
235 -- normalizing names.
236 -- In the callback, Pattern_Index is the index within Patterns where the
237 -- expanded pattern was found (1 for the first element of Patterns and
238 -- all its matching directories, then 2,...).
239 -- We use a generic and not an access-to-subprogram because in some cases
240 -- this code is compiled with the restriction No_Implicit_Dynamic_Code
242 procedure Add_Source
243 (Id : out Source_Id;
244 Data : in out Tree_Processing_Data;
245 Project : Project_Id;
246 Source_Dir_Rank : Natural;
247 Lang_Id : Language_Ptr;
248 Kind : Source_Kind;
249 File_Name : File_Name_Type;
250 Display_File : File_Name_Type;
251 Naming_Exception : Boolean := False;
252 Path : Path_Information := No_Path_Information;
253 Alternate_Languages : Language_List := null;
254 Unit : Name_Id := No_Name;
255 Index : Int := 0;
256 Locally_Removed : Boolean := False;
257 Location : Source_Ptr := No_Location);
258 -- Add a new source to the different lists: list of all sources in the
259 -- project tree, list of source of a project and list of sources of a
260 -- language.
262 -- If Path is specified, the file is also added to Source_Paths_HT.
264 -- Location is used for error messages
266 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type;
267 -- Same as Osint.Canonical_Case_File_Name but applies to Name_Id.
268 -- This alters Name_Buffer
270 function Suffix_Matches
271 (Filename : String;
272 Suffix : File_Name_Type) return Boolean;
273 -- True if the file name ends with the given suffix. Always returns False
274 -- if Suffix is No_Name.
276 procedure Replace_Into_Name_Buffer
277 (Str : String;
278 Pattern : String;
279 Replacement : Character);
280 -- Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is
281 -- converted to lower-case at the same time.
283 procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
284 -- Check that a name is a valid Ada unit name
286 procedure Check_Package_Naming
287 (Project : Project_Id;
288 Data : in out Tree_Processing_Data);
289 -- Check the naming scheme part of Data, and initialize the naming scheme
290 -- data in the config of the various languages.
292 procedure Check_Configuration
293 (Project : Project_Id;
294 Data : in out Tree_Processing_Data);
295 -- Check the configuration attributes for the project
297 procedure Check_If_Externally_Built
298 (Project : Project_Id;
299 Data : in out Tree_Processing_Data);
300 -- Check attribute Externally_Built of project Project in project tree
301 -- Data.Tree and modify its data Data if it has the value "true".
303 procedure Check_Interfaces
304 (Project : Project_Id;
305 Data : in out Tree_Processing_Data);
306 -- If a list of sources is specified in attribute Interfaces, set
307 -- In_Interfaces only for the sources specified in the list.
309 procedure Check_Library_Attributes
310 (Project : Project_Id;
311 Data : in out Tree_Processing_Data);
312 -- Check the library attributes of project Project in project tree
313 -- and modify its data Data accordingly.
315 procedure Check_Aggregate_Project
316 (Project : Project_Id;
317 Data : in out Tree_Processing_Data);
318 -- Check aggregate projects attributes, and find the list of aggregated
319 -- projects. They are stored as a "project_files" language in Project.
321 procedure Check_Abstract_Project
322 (Project : Project_Id;
323 Data : in out Tree_Processing_Data);
324 -- Check abstract projects attributes
326 procedure Check_Programming_Languages
327 (Project : Project_Id;
328 Data : in out Tree_Processing_Data);
329 -- Check attribute Languages for the project with data Data in project
330 -- tree Data.Tree and set the components of Data for all the programming
331 -- languages indicated in attribute Languages, if any.
333 procedure Check_Stand_Alone_Library
334 (Project : Project_Id;
335 Data : in out Tree_Processing_Data);
336 -- Check if project Project in project tree Data.Tree is a Stand-Alone
337 -- Library project, and modify its data Data accordingly if it is one.
339 function Compute_Directory_Last (Dir : String) return Natural;
340 -- Return the index of the last significant character in Dir. This is used
341 -- to avoid duplicate '/' (slash) characters at the end of directory names.
343 procedure Search_Directories
344 (Project : in out Project_Processing_Data;
345 Data : in out Tree_Processing_Data;
346 For_All_Sources : Boolean);
347 -- Search the source directories to find the sources. If For_All_Sources is
348 -- True, check each regular file name against the naming schemes of the
349 -- various languages. Otherwise consider only the file names in hash table
350 -- Source_Names. If Allow_Duplicate_Basenames then files with identical
351 -- base names are permitted within a project for source-based languages
352 -- (never for unit based languages).
354 procedure Check_File
355 (Project : in out Project_Processing_Data;
356 Data : in out Tree_Processing_Data;
357 Source_Dir_Rank : Natural;
358 Path : Path_Name_Type;
359 Display_Path : Path_Name_Type;
360 File_Name : File_Name_Type;
361 Display_File_Name : File_Name_Type;
362 Locally_Removed : Boolean;
363 For_All_Sources : Boolean);
364 -- Check if file File_Name is a valid source of the project. This is used
365 -- in multi-language mode only. When the file matches one of the naming
366 -- schemes, it is added to various htables through Add_Source and to
367 -- Source_Paths_Htable.
369 -- File_Name is the same as Display_File_Name, but has been normalized.
370 -- They do not include the directory information.
372 -- Path and Display_Path on the other hand are the full path to the file.
373 -- Path must have been normalized (canonical casing and possibly links
374 -- resolved).
376 -- Source_Directory is the directory in which the file was found. It is
377 -- neither normalized nor has had links resolved, and must not end with a
378 -- a directory separator, to avoid duplicates later on.
380 -- If For_All_Sources is True, then all possible file names are analyzed
381 -- otherwise only those currently set in the Source_Names hash table.
383 procedure Check_File_Naming_Schemes
384 (In_Tree : Project_Tree_Ref;
385 Project : Project_Processing_Data;
386 File_Name : File_Name_Type;
387 Alternate_Languages : out Language_List;
388 Language : out Language_Ptr;
389 Display_Language_Name : out Name_Id;
390 Unit : out Name_Id;
391 Lang_Kind : out Language_Kind;
392 Kind : out Source_Kind);
393 -- Check if the file name File_Name conforms to one of the naming schemes
394 -- of the project. If the file does not match one of the naming schemes,
395 -- set Language to No_Language_Index. Filename is the name of the file
396 -- being investigated. It has been normalized (case-folded). File_Name is
397 -- the same value.
399 procedure Get_Directories
400 (Project : Project_Id;
401 Data : in out Tree_Processing_Data);
402 -- Get the object directory, the exec directory and the source directories
403 -- of a project.
405 procedure Get_Mains
406 (Project : Project_Id;
407 Data : in out Tree_Processing_Data);
408 -- Get the mains of a project from attribute Main, if it exists, and put
409 -- them in the project data.
411 procedure Get_Sources_From_File
412 (Path : String;
413 Location : Source_Ptr;
414 Project : in out Project_Processing_Data;
415 Data : in out Tree_Processing_Data);
416 -- Get the list of sources from a text file and put them in hash table
417 -- Source_Names.
419 procedure Find_Sources
420 (Project : in out Project_Processing_Data;
421 Data : in out Tree_Processing_Data);
422 -- Process the Source_Files and Source_List_File attributes, and store the
423 -- list of source files into the Source_Names htable. When these attributes
424 -- are not defined, find all files matching the naming schemes in the
425 -- source directories. If Allow_Duplicate_Basenames, then files with the
426 -- same base names are authorized within a project for source-based
427 -- languages (never for unit based languages)
429 procedure Compute_Unit_Name
430 (File_Name : File_Name_Type;
431 Naming : Lang_Naming_Data;
432 Kind : out Source_Kind;
433 Unit : out Name_Id;
434 Project : Project_Processing_Data;
435 In_Tree : Project_Tree_Ref);
436 -- Check whether the file matches the naming scheme. If it does,
437 -- compute its unit name. If Unit is set to No_Name on exit, none of the
438 -- other out parameters are relevant.
440 procedure Check_Illegal_Suffix
441 (Project : Project_Id;
442 Suffix : File_Name_Type;
443 Dot_Replacement : File_Name_Type;
444 Attribute_Name : String;
445 Location : Source_Ptr;
446 Data : in out Tree_Processing_Data);
447 -- Display an error message if the given suffix is illegal for some reason.
448 -- The name of the attribute we are testing is specified in Attribute_Name,
449 -- which is used in the error message. Location is the location where the
450 -- suffix is defined.
452 procedure Locate_Directory
453 (Project : Project_Id;
454 Name : File_Name_Type;
455 Path : out Path_Information;
456 Dir_Exists : out Boolean;
457 Data : in out Tree_Processing_Data;
458 Create : String := "";
459 Location : Source_Ptr := No_Location;
460 Must_Exist : Boolean := True;
461 Externally_Built : Boolean := False);
462 -- Locate a directory. Name is the directory name. Relative paths are
463 -- resolved relative to the project's directory. If the directory does not
464 -- exist and Setup_Projects is True and Create is a non null string, an
465 -- attempt is made to create the directory. If the directory does not
466 -- exist, it is either created if Setup_Projects is False (and then
467 -- returned), or simply returned without checking for its existence (if
468 -- Must_Exist is False) or No_Path_Information is returned. In all cases,
469 -- Dir_Exists indicates whether the directory now exists. Create is also
470 -- used for debugging traces to show which path we are computing.
472 procedure Look_For_Sources
473 (Project : in out Project_Processing_Data;
474 Data : in out Tree_Processing_Data);
475 -- Find all the sources of project Project in project tree Data.Tree and
476 -- update its Data accordingly. This assumes that the special naming
477 -- exceptions have already been processed.
479 function Path_Name_Of
480 (File_Name : File_Name_Type;
481 Directory : Path_Name_Type) return String;
482 -- Returns the path name of a (non project) file. Returns an empty string
483 -- if file cannot be found.
485 procedure Remove_Source
486 (Tree : Project_Tree_Ref;
487 Id : Source_Id;
488 Replaced_By : Source_Id);
489 -- Remove a file from the list of sources of a project. This might be
490 -- because the file is replaced by another one in an extending project,
491 -- or because a file was added as a naming exception but was not found
492 -- in the end.
494 procedure Report_No_Sources
495 (Project : Project_Id;
496 Lang_Name : String;
497 Data : Tree_Processing_Data;
498 Location : Source_Ptr;
499 Continuation : Boolean := False);
500 -- Report an error or a warning depending on the value of When_No_Sources
501 -- when there are no sources for language Lang_Name.
503 procedure Show_Source_Dirs
504 (Project : Project_Id; In_Tree : Project_Tree_Ref);
505 -- List all the source directories of a project
507 procedure Write_Attr (Name, Value : String);
508 -- Debug print a value for a specific property. Does nothing when not in
509 -- debug mode
511 procedure Error_Or_Warning
512 (Flags : Processing_Flags;
513 Kind : Error_Warning;
514 Msg : String;
515 Location : Source_Ptr;
516 Project : Project_Id);
517 -- Emits either an error or warning message (or nothing), depending on Kind
519 ----------------------
520 -- Error_Or_Warning --
521 ----------------------
523 procedure Error_Or_Warning
524 (Flags : Processing_Flags;
525 Kind : Error_Warning;
526 Msg : String;
527 Location : Source_Ptr;
528 Project : Project_Id) is
529 begin
530 case Kind is
531 when Error => Error_Msg (Flags, Msg, Location, Project);
532 when Warning => Error_Msg (Flags, "?" & Msg, Location, Project);
533 when Silent => null;
534 end case;
535 end Error_Or_Warning;
537 ------------------------------
538 -- Replace_Into_Name_Buffer --
539 ------------------------------
541 procedure Replace_Into_Name_Buffer
542 (Str : String;
543 Pattern : String;
544 Replacement : Character)
546 Max : constant Integer := Str'Last - Pattern'Length + 1;
547 J : Positive;
549 begin
550 Name_Len := 0;
552 J := Str'First;
553 while J <= Str'Last loop
554 Name_Len := Name_Len + 1;
556 if J <= Max
557 and then Str (J .. J + Pattern'Length - 1) = Pattern
558 then
559 Name_Buffer (Name_Len) := Replacement;
560 J := J + Pattern'Length;
562 else
563 Name_Buffer (Name_Len) := GNAT.Case_Util.To_Lower (Str (J));
564 J := J + 1;
565 end if;
566 end loop;
567 end Replace_Into_Name_Buffer;
569 --------------------
570 -- Suffix_Matches --
571 --------------------
573 function Suffix_Matches
574 (Filename : String;
575 Suffix : File_Name_Type) return Boolean
577 Min_Prefix_Length : Natural := 0;
579 begin
580 if Suffix = No_File or else Suffix = Empty_File then
581 return False;
582 end if;
584 declare
585 Suf : String := Get_Name_String (Suffix);
587 begin
588 -- On non case-sensitive systems, use proper suffix casing
590 Canonical_Case_File_Name (Suf);
592 -- The file name must end with the suffix (which is not an extension)
593 -- For instance a suffix "configure.in" must match a file with the
594 -- same name. To avoid dummy cases, though, a suffix starting with
595 -- '.' requires a file that is at least one character longer ('.cpp'
596 -- should not match a file with the same name)
598 if Suf (Suf'First) = '.' then
599 Min_Prefix_Length := 1;
600 end if;
602 return Filename'Length >= Suf'Length + Min_Prefix_Length
603 and then Filename
604 (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;
605 end;
606 end Suffix_Matches;
608 ----------------
609 -- Write_Attr --
610 ----------------
612 procedure Write_Attr (Name, Value : String) is
613 begin
614 if Current_Verbosity = High then
615 Write_Str (" " & Name & " = """);
616 Write_Str (Value);
617 Write_Char ('"');
618 Write_Eol;
619 end if;
620 end Write_Attr;
622 ----------------
623 -- Add_Source --
624 ----------------
626 procedure Add_Source
627 (Id : out Source_Id;
628 Data : in out Tree_Processing_Data;
629 Project : Project_Id;
630 Source_Dir_Rank : Natural;
631 Lang_Id : Language_Ptr;
632 Kind : Source_Kind;
633 File_Name : File_Name_Type;
634 Display_File : File_Name_Type;
635 Naming_Exception : Boolean := False;
636 Path : Path_Information := No_Path_Information;
637 Alternate_Languages : Language_List := null;
638 Unit : Name_Id := No_Name;
639 Index : Int := 0;
640 Locally_Removed : Boolean := False;
641 Location : Source_Ptr := No_Location)
643 Config : constant Language_Config := Lang_Id.Config;
644 UData : Unit_Index;
645 Add_Src : Boolean;
646 Source : Source_Id;
647 Prev_Unit : Unit_Index := No_Unit_Index;
649 Source_To_Replace : Source_Id := No_Source;
651 begin
652 -- Check if the same file name or unit is used in the prj tree
654 Add_Src := True;
656 if Unit /= No_Name then
657 Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit);
658 end if;
660 if Prev_Unit /= No_Unit_Index
661 and then (Kind = Impl or else Kind = Spec)
662 and then Prev_Unit.File_Names (Kind) /= null
663 then
664 -- Suspicious, we need to check later whether this is authorized
666 Add_Src := False;
667 Source := Prev_Unit.File_Names (Kind);
669 else
670 Source := Files_Htable.Get (Data.File_To_Source, File_Name);
672 if Source /= No_Source
673 and then Source.Index = Index
674 then
675 Add_Src := False;
676 end if;
677 end if;
679 -- Duplication of file/unit in same project is allowed if order of
680 -- source directories is known.
682 if Add_Src = False then
683 Add_Src := True;
685 if Project = Source.Project then
686 if Prev_Unit = No_Unit_Index then
687 if Data.Flags.Allow_Duplicate_Basenames then
688 Add_Src := True;
690 elsif Source_Dir_Rank /= Source.Source_Dir_Rank then
691 Add_Src := False;
693 else
694 Error_Msg_File_1 := File_Name;
695 Error_Msg
696 (Data.Flags, "duplicate source file name {",
697 Location, Project);
698 Add_Src := False;
699 end if;
701 else
702 if Source_Dir_Rank /= Source.Source_Dir_Rank then
703 Add_Src := False;
705 -- We might be seeing the same file through a different path
706 -- (for instance because of symbolic links).
708 elsif Source.Path.Name /= Path.Name then
709 if not Source.Duplicate_Unit then
710 Error_Msg_Name_1 := Unit;
711 Error_Msg
712 (Data.Flags, "\duplicate unit %%", Location, Project);
713 Source.Duplicate_Unit := True;
714 end if;
716 Add_Src := False;
717 end if;
718 end if;
720 -- Do not allow the same unit name in different projects, except
721 -- if one is extending the other.
723 -- For a file based language, the same file name replaces a file
724 -- in a project being extended, but it is allowed to have the same
725 -- file name in unrelated projects.
727 elsif Is_Extending (Project, Source.Project) then
728 if not Locally_Removed then
729 Source_To_Replace := Source;
730 end if;
732 elsif Prev_Unit /= No_Unit_Index
733 and then Prev_Unit.File_Names (Kind) /= null
734 and then not Source.Locally_Removed
735 then
736 -- Path is set if this is a source we found on the disk, in which
737 -- case we can provide more explicit error message. Path is unset
738 -- when the source is added from one of the naming exceptions in
739 -- the project.
741 if Path /= No_Path_Information then
742 Error_Msg_Name_1 := Unit;
743 Error_Msg
744 (Data.Flags,
745 "unit %% cannot belong to several projects",
746 Location, Project);
748 Error_Msg_Name_1 := Project.Name;
749 Error_Msg_Name_2 := Name_Id (Path.Display_Name);
750 Error_Msg
751 (Data.Flags, "\ project %%, %%", Location, Project);
753 Error_Msg_Name_1 := Source.Project.Name;
754 Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);
755 Error_Msg
756 (Data.Flags, "\ project %%, %%", Location, Project);
758 else
759 Error_Msg_Name_1 := Unit;
760 Error_Msg_Name_2 := Source.Project.Name;
761 Error_Msg
762 (Data.Flags, "unit %% already belongs to project %%",
763 Location, Project);
764 end if;
766 Add_Src := False;
768 elsif not Source.Locally_Removed
769 and then not Data.Flags.Allow_Duplicate_Basenames
770 and then Lang_Id.Config.Kind = Unit_Based
771 and then Source.Language.Config.Kind = Unit_Based
772 then
773 Error_Msg_File_1 := File_Name;
774 Error_Msg_File_2 := File_Name_Type (Source.Project.Name);
775 Error_Msg
776 (Data.Flags,
777 "{ is already a source of project {", Location, Project);
779 -- Add the file anyway, to avoid further warnings like "language
780 -- unknown".
782 Add_Src := True;
783 end if;
784 end if;
786 if not Add_Src then
787 return;
788 end if;
790 -- Add the new file
792 Id := new Source_Data;
794 if Current_Verbosity = High then
795 Write_Str ("Adding source File: ");
796 Write_Str (Get_Name_String (Display_File));
798 if Index /= 0 then
799 Write_Str (" at" & Index'Img);
800 end if;
802 if Lang_Id.Config.Kind = Unit_Based then
803 Write_Str (" Unit: ");
805 -- ??? in gprclean, it seems we sometimes pass an empty Unit name
806 -- (see test extended_projects).
808 if Unit /= No_Name then
809 Write_Str (Get_Name_String (Unit));
810 end if;
812 Write_Str (" Kind: ");
813 Write_Str (Source_Kind'Image (Kind));
814 end if;
816 Write_Eol;
817 end if;
819 Id.Project := Project;
820 Id.Location := Location;
821 Id.Source_Dir_Rank := Source_Dir_Rank;
822 Id.Language := Lang_Id;
823 Id.Kind := Kind;
824 Id.Alternate_Languages := Alternate_Languages;
825 Id.Locally_Removed := Locally_Removed;
826 Id.Index := Index;
827 Id.File := File_Name;
828 Id.Display_File := Display_File;
829 Id.Dep_Name := Dependency_Name
830 (File_Name, Lang_Id.Config.Dependency_Kind);
831 Id.Naming_Exception := Naming_Exception;
832 Id.Object := Object_Name
833 (File_Name, Config.Object_File_Suffix);
834 Id.Switches := Switches_Name (File_Name);
836 -- Add the source id to the Unit_Sources_HT hash table, if the unit name
837 -- is not null.
839 if Unit /= No_Name then
841 -- Note: we might be creating a dummy unit here, when we in fact have
842 -- a separate. For instance, file file-bar.adb will initially be
843 -- assumed to be the IMPL of unit "file.bar". Only later on (in
844 -- Check_Object_Files) will we parse those units that only have an
845 -- impl and no spec to make sure whether we have a Separate in fact
846 -- (that significantly reduces the number of times we need to parse
847 -- the files, since we are then only interested in those with no
848 -- spec). We still need those dummy units in the table, since that's
849 -- the name we find in the ALI file
851 UData := Units_Htable.Get (Data.Tree.Units_HT, Unit);
853 if UData = No_Unit_Index then
854 UData := new Unit_Data;
855 UData.Name := Unit;
856 Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
857 end if;
859 Id.Unit := UData;
861 -- Note that this updates Unit information as well
863 Override_Kind (Id, Kind);
864 end if;
866 if Path /= No_Path_Information then
867 Id.Path := Path;
868 Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id);
869 end if;
871 Id.Next_With_File_Name :=
872 Source_Files_Htable.Get (Data.Tree.Source_Files_HT, File_Name);
873 Source_Files_Htable.Set (Data.Tree.Source_Files_HT, File_Name, Id);
875 if Index /= 0 then
876 Project.Has_Multi_Unit_Sources := True;
877 end if;
879 -- Add the source to the language list
881 Id.Next_In_Lang := Lang_Id.First_Source;
882 Lang_Id.First_Source := Id;
884 if Source_To_Replace /= No_Source then
885 Remove_Source (Data.Tree, Source_To_Replace, Id);
886 end if;
888 if Data.Tree.Replaced_Source_Number > 0 and then
889 Replaced_Source_HTable.Get (Data.Tree.Replaced_Sources, Id.File) /=
890 No_File
891 then
892 Replaced_Source_HTable.Remove (Data.Tree.Replaced_Sources, Id.File);
893 Data.Tree.Replaced_Source_Number :=
894 Data.Tree.Replaced_Source_Number - 1;
895 end if;
897 Files_Htable.Set (Data.File_To_Source, File_Name, Id);
898 end Add_Source;
900 ------------------------------
901 -- Canonical_Case_File_Name --
902 ------------------------------
904 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type is
905 begin
906 if Osint.File_Names_Case_Sensitive then
907 return File_Name_Type (Name);
908 else
909 Get_Name_String (Name);
910 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
911 return Name_Find;
912 end if;
913 end Canonical_Case_File_Name;
915 -----------------------------
916 -- Check_Aggregate_Project --
917 -----------------------------
919 procedure Check_Aggregate_Project
920 (Project : Project_Id;
921 Data : in out Tree_Processing_Data)
923 Project_Files : constant Prj.Variable_Value :=
924 Prj.Util.Value_Of
925 (Snames.Name_Project_Files,
926 Project.Decl.Attributes,
927 Data.Tree);
929 procedure Found_Project_File (Path : Path_Information; Rank : Natural);
930 -- Comments required ???
932 procedure Expand_Project_Files is
933 new Expand_Subdirectory_Pattern (Callback => Found_Project_File);
934 -- Comments required ???
936 ------------------------
937 -- Found_Project_File --
938 ------------------------
940 procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
941 pragma Unreferenced (Rank);
942 begin
943 if Current_Verbosity = High then
944 Write_Str (" Aggregates:");
945 Write_Line (Get_Name_String (Path.Display_Name));
946 end if;
947 end Found_Project_File;
949 -- Start of processing for Check_Aggregate_Project
951 begin
952 if Project_Files.Default then
953 Error_Msg_Name_1 := Snames.Name_Project_Files;
954 Error_Msg
955 (Data.Flags,
956 "Attribute %% must be specified in aggregate project",
957 Project.Location, Project);
958 return;
959 end if;
961 -- Look for aggregated projects. For similarity with source files and
962 -- dirs, the aggregated project files are not searched for on the
963 -- project path, and are only found through the path specified in
964 -- the Project_Files attribute.
966 Expand_Project_Files
967 (Project => Project,
968 Data => Data,
969 Patterns => Project_Files.Values,
970 Ignore => Nil_String,
971 Search_For => Search_Files,
972 Resolve_Links => Opt.Follow_Links_For_Files);
974 end Check_Aggregate_Project;
976 ----------------------------
977 -- Check_Abstract_Project --
978 ----------------------------
980 procedure Check_Abstract_Project
981 (Project : Project_Id;
982 Data : in out Tree_Processing_Data)
984 Source_Dirs : constant Variable_Value :=
985 Util.Value_Of
986 (Name_Source_Dirs,
987 Project.Decl.Attributes, Data.Tree);
988 Source_Files : constant Variable_Value :=
989 Util.Value_Of
990 (Name_Source_Files,
991 Project.Decl.Attributes, Data.Tree);
992 Source_List_File : constant Variable_Value :=
993 Util.Value_Of
994 (Name_Source_List_File,
995 Project.Decl.Attributes, Data.Tree);
996 Languages : constant Variable_Value :=
997 Util.Value_Of
998 (Name_Languages,
999 Project.Decl.Attributes, Data.Tree);
1001 begin
1002 if Project.Source_Dirs /= Nil_String then
1003 if Source_Dirs.Values = Nil_String
1004 and then Source_Files.Values = Nil_String
1005 and then Languages.Values = Nil_String
1006 and then Source_List_File.Default
1007 then
1008 Project.Source_Dirs := Nil_String;
1010 else
1011 Error_Msg
1012 (Data.Flags,
1013 "at least one of Source_Files, Source_Dirs or Languages "
1014 & "must be declared empty for an abstract project",
1015 Project.Location, Project);
1016 end if;
1017 end if;
1018 end Check_Abstract_Project;
1020 -----------
1021 -- Check --
1022 -----------
1024 procedure Check
1025 (Project : Project_Id;
1026 Data : in out Tree_Processing_Data)
1028 Prj_Data : Project_Processing_Data;
1030 begin
1031 Initialize (Prj_Data, Project);
1033 Check_If_Externally_Built (Project, Data);
1035 if Project.Qualifier /= Aggregate then
1036 Get_Directories (Project, Data);
1037 Check_Programming_Languages (Project, Data);
1039 if Current_Verbosity = High then
1040 Show_Source_Dirs (Project, Data.Tree);
1041 end if;
1042 end if;
1044 case Project.Qualifier is
1045 when Aggregate => Check_Aggregate_Project (Project, Data);
1046 when Dry => Check_Abstract_Project (Project, Data);
1047 when others => null;
1048 end case;
1050 -- Check configuration. This must be done even for gnatmake (even though
1051 -- no user configuration file was provided) since the default config we
1052 -- generate indicates whether libraries are supported for instance.
1054 Check_Configuration (Project, Data);
1056 if Project.Qualifier /= Aggregate then
1057 Check_Library_Attributes (Project, Data);
1058 Check_Package_Naming (Project, Data);
1059 Look_For_Sources (Prj_Data, Data);
1060 Check_Interfaces (Project, Data);
1062 if Project.Library then
1063 Check_Stand_Alone_Library (Project, Data);
1064 end if;
1066 Get_Mains (Project, Data);
1067 end if;
1069 Free (Prj_Data);
1070 end Check;
1072 --------------------
1073 -- Check_Ada_Name --
1074 --------------------
1076 procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is
1077 The_Name : String := Name;
1078 Real_Name : Name_Id;
1079 Need_Letter : Boolean := True;
1080 Last_Underscore : Boolean := False;
1081 OK : Boolean := The_Name'Length > 0;
1082 First : Positive;
1084 function Is_Reserved (Name : Name_Id) return Boolean;
1085 function Is_Reserved (S : String) return Boolean;
1086 -- Check that the given name is not an Ada 95 reserved word. The reason
1087 -- for the Ada 95 here is that we do not want to exclude the case of an
1088 -- Ada 95 unit called Interface (for example). In Ada 2005, such a unit
1089 -- name would be rejected anyway by the compiler. That means there is no
1090 -- requirement that the project file parser reject this.
1092 -----------------
1093 -- Is_Reserved --
1094 -----------------
1096 function Is_Reserved (S : String) return Boolean is
1097 begin
1098 Name_Len := 0;
1099 Add_Str_To_Name_Buffer (S);
1100 return Is_Reserved (Name_Find);
1101 end Is_Reserved;
1103 -----------------
1104 -- Is_Reserved --
1105 -----------------
1107 function Is_Reserved (Name : Name_Id) return Boolean is
1108 begin
1109 if Get_Name_Table_Byte (Name) /= 0
1110 and then Name /= Name_Project
1111 and then Name /= Name_Extends
1112 and then Name /= Name_External
1113 and then Name not in Ada_2005_Reserved_Words
1114 then
1115 Unit := No_Name;
1117 if Current_Verbosity = High then
1118 Write_Str (The_Name);
1119 Write_Line (" is an Ada reserved word.");
1120 end if;
1122 return True;
1124 else
1125 return False;
1126 end if;
1127 end Is_Reserved;
1129 -- Start of processing for Check_Ada_Name
1131 begin
1132 To_Lower (The_Name);
1134 Name_Len := The_Name'Length;
1135 Name_Buffer (1 .. Name_Len) := The_Name;
1137 -- Special cases of children of packages A, G, I and S on VMS
1139 if OpenVMS_On_Target
1140 and then Name_Len > 3
1141 and then Name_Buffer (2 .. 3) = "__"
1142 and then
1143 ((Name_Buffer (1) = 'a') or else
1144 (Name_Buffer (1) = 'g') or else
1145 (Name_Buffer (1) = 'i') or else
1146 (Name_Buffer (1) = 's'))
1147 then
1148 Name_Buffer (2) := '.';
1149 Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
1150 Name_Len := Name_Len - 1;
1151 end if;
1153 Real_Name := Name_Find;
1155 if Is_Reserved (Real_Name) then
1156 return;
1157 end if;
1159 First := The_Name'First;
1161 for Index in The_Name'Range loop
1162 if Need_Letter then
1164 -- We need a letter (at the beginning, and following a dot),
1165 -- but we don't have one.
1167 if Is_Letter (The_Name (Index)) then
1168 Need_Letter := False;
1170 else
1171 OK := False;
1173 if Current_Verbosity = High then
1174 Write_Int (Types.Int (Index));
1175 Write_Str (": '");
1176 Write_Char (The_Name (Index));
1177 Write_Line ("' is not a letter.");
1178 end if;
1180 exit;
1181 end if;
1183 elsif Last_Underscore
1184 and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
1185 then
1186 -- Two underscores are illegal, and a dot cannot follow
1187 -- an underscore.
1189 OK := False;
1191 if Current_Verbosity = High then
1192 Write_Int (Types.Int (Index));
1193 Write_Str (": '");
1194 Write_Char (The_Name (Index));
1195 Write_Line ("' is illegal here.");
1196 end if;
1198 exit;
1200 elsif The_Name (Index) = '.' then
1202 -- First, check if the name before the dot is not a reserved word
1204 if Is_Reserved (The_Name (First .. Index - 1)) then
1205 return;
1206 end if;
1208 First := Index + 1;
1210 -- We need a letter after a dot
1212 Need_Letter := True;
1214 elsif The_Name (Index) = '_' then
1215 Last_Underscore := True;
1217 else
1218 -- We need an letter or a digit
1220 Last_Underscore := False;
1222 if not Is_Alphanumeric (The_Name (Index)) then
1223 OK := False;
1225 if Current_Verbosity = High then
1226 Write_Int (Types.Int (Index));
1227 Write_Str (": '");
1228 Write_Char (The_Name (Index));
1229 Write_Line ("' is not alphanumeric.");
1230 end if;
1232 exit;
1233 end if;
1234 end if;
1235 end loop;
1237 -- Cannot end with an underscore or a dot
1239 OK := OK and then not Need_Letter and then not Last_Underscore;
1241 if OK then
1242 if First /= Name'First and then
1243 Is_Reserved (The_Name (First .. The_Name'Last))
1244 then
1245 return;
1246 end if;
1248 Unit := Real_Name;
1250 else
1251 -- Signal a problem with No_Name
1253 Unit := No_Name;
1254 end if;
1255 end Check_Ada_Name;
1257 -------------------------
1258 -- Check_Configuration --
1259 -------------------------
1261 procedure Check_Configuration
1262 (Project : Project_Id;
1263 Data : in out Tree_Processing_Data)
1265 Dot_Replacement : File_Name_Type := No_File;
1266 Casing : Casing_Type := All_Lower_Case;
1267 Separate_Suffix : File_Name_Type := No_File;
1269 Lang_Index : Language_Ptr := No_Language_Index;
1270 -- The index of the language data being checked
1272 Prev_Index : Language_Ptr := No_Language_Index;
1273 -- The index of the previous language
1275 procedure Process_Project_Level_Simple_Attributes;
1276 -- Process the simple attributes at the project level
1278 procedure Process_Project_Level_Array_Attributes;
1279 -- Process the associate array attributes at the project level
1281 procedure Process_Packages;
1282 -- Read the packages of the project
1284 ----------------------
1285 -- Process_Packages --
1286 ----------------------
1288 procedure Process_Packages is
1289 Packages : Package_Id;
1290 Element : Package_Element;
1292 procedure Process_Binder (Arrays : Array_Id);
1293 -- Process the associate array attributes of package Binder
1295 procedure Process_Builder (Attributes : Variable_Id);
1296 -- Process the simple attributes of package Builder
1298 procedure Process_Compiler (Arrays : Array_Id);
1299 -- Process the associate array attributes of package Compiler
1301 procedure Process_Naming (Attributes : Variable_Id);
1302 -- Process the simple attributes of package Naming
1304 procedure Process_Naming (Arrays : Array_Id);
1305 -- Process the associate array attributes of package Naming
1307 procedure Process_Linker (Attributes : Variable_Id);
1308 -- Process the simple attributes of package Linker of a
1309 -- configuration project.
1311 --------------------
1312 -- Process_Binder --
1313 --------------------
1315 procedure Process_Binder (Arrays : Array_Id) is
1316 Current_Array_Id : Array_Id;
1317 Current_Array : Array_Data;
1318 Element_Id : Array_Element_Id;
1319 Element : Array_Element;
1321 begin
1322 -- Process the associative array attribute of package Binder
1324 Current_Array_Id := Arrays;
1325 while Current_Array_Id /= No_Array loop
1326 Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
1328 Element_Id := Current_Array.Value;
1329 while Element_Id /= No_Array_Element loop
1330 Element := Data.Tree.Array_Elements.Table (Element_Id);
1332 if Element.Index /= All_Other_Names then
1334 -- Get the name of the language
1336 Lang_Index :=
1337 Get_Language_From_Name
1338 (Project, Get_Name_String (Element.Index));
1340 if Lang_Index /= No_Language_Index then
1341 case Current_Array.Name is
1342 when Name_Driver =>
1344 -- Attribute Driver (<language>)
1346 Lang_Index.Config.Binder_Driver :=
1347 File_Name_Type (Element.Value.Value);
1349 when Name_Required_Switches =>
1351 (Into_List =>
1352 Lang_Index.Config.Binder_Required_Switches,
1353 From_List => Element.Value.Values,
1354 In_Tree => Data.Tree);
1356 when Name_Prefix =>
1358 -- Attribute Prefix (<language>)
1360 Lang_Index.Config.Binder_Prefix :=
1361 Element.Value.Value;
1363 when Name_Objects_Path =>
1365 -- Attribute Objects_Path (<language>)
1367 Lang_Index.Config.Objects_Path :=
1368 Element.Value.Value;
1370 when Name_Objects_Path_File =>
1372 -- Attribute Objects_Path (<language>)
1374 Lang_Index.Config.Objects_Path_File :=
1375 Element.Value.Value;
1377 when others =>
1378 null;
1379 end case;
1380 end if;
1381 end if;
1383 Element_Id := Element.Next;
1384 end loop;
1386 Current_Array_Id := Current_Array.Next;
1387 end loop;
1388 end Process_Binder;
1390 ---------------------
1391 -- Process_Builder --
1392 ---------------------
1394 procedure Process_Builder (Attributes : Variable_Id) is
1395 Attribute_Id : Variable_Id;
1396 Attribute : Variable;
1398 begin
1399 -- Process non associated array attribute from package Builder
1401 Attribute_Id := Attributes;
1402 while Attribute_Id /= No_Variable loop
1403 Attribute :=
1404 Data.Tree.Variable_Elements.Table (Attribute_Id);
1406 if not Attribute.Value.Default then
1407 if Attribute.Name = Name_Executable_Suffix then
1409 -- Attribute Executable_Suffix: the suffix of the
1410 -- executables.
1412 Project.Config.Executable_Suffix :=
1413 Attribute.Value.Value;
1414 end if;
1415 end if;
1417 Attribute_Id := Attribute.Next;
1418 end loop;
1419 end Process_Builder;
1421 ----------------------
1422 -- Process_Compiler --
1423 ----------------------
1425 procedure Process_Compiler (Arrays : Array_Id) is
1426 Current_Array_Id : Array_Id;
1427 Current_Array : Array_Data;
1428 Element_Id : Array_Element_Id;
1429 Element : Array_Element;
1430 List : String_List_Id;
1432 begin
1433 -- Process the associative array attribute of package Compiler
1435 Current_Array_Id := Arrays;
1436 while Current_Array_Id /= No_Array loop
1437 Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
1439 Element_Id := Current_Array.Value;
1440 while Element_Id /= No_Array_Element loop
1441 Element := Data.Tree.Array_Elements.Table (Element_Id);
1443 if Element.Index /= All_Other_Names then
1445 -- Get the name of the language
1447 Lang_Index := Get_Language_From_Name
1448 (Project, Get_Name_String (Element.Index));
1450 if Lang_Index /= No_Language_Index then
1451 case Current_Array.Name is
1452 when Name_Dependency_Switches =>
1454 -- Attribute Dependency_Switches (<language>)
1456 if Lang_Index.Config.Dependency_Kind = None then
1457 Lang_Index.Config.Dependency_Kind := Makefile;
1458 end if;
1460 List := Element.Value.Values;
1462 if List /= Nil_String then
1463 Put (Into_List =>
1464 Lang_Index.Config.Dependency_Option,
1465 From_List => List,
1466 In_Tree => Data.Tree);
1467 end if;
1469 when Name_Dependency_Driver =>
1471 -- Attribute Dependency_Driver (<language>)
1473 if Lang_Index.Config.Dependency_Kind = None then
1474 Lang_Index.Config.Dependency_Kind := Makefile;
1475 end if;
1477 List := Element.Value.Values;
1479 if List /= Nil_String then
1480 Put (Into_List =>
1481 Lang_Index.Config.Compute_Dependency,
1482 From_List => List,
1483 In_Tree => Data.Tree);
1484 end if;
1486 when Name_Include_Switches =>
1488 -- Attribute Include_Switches (<language>)
1490 List := Element.Value.Values;
1492 if List = Nil_String then
1493 Error_Msg
1494 (Data.Flags, "include option cannot be null",
1495 Element.Value.Location, Project);
1496 end if;
1498 Put (Into_List => Lang_Index.Config.Include_Option,
1499 From_List => List,
1500 In_Tree => Data.Tree);
1502 when Name_Include_Path =>
1504 -- Attribute Include_Path (<language>)
1506 Lang_Index.Config.Include_Path :=
1507 Element.Value.Value;
1509 when Name_Include_Path_File =>
1511 -- Attribute Include_Path_File (<language>)
1513 Lang_Index.Config.Include_Path_File :=
1514 Element.Value.Value;
1516 when Name_Driver =>
1518 -- Attribute Driver (<language>)
1520 Lang_Index.Config.Compiler_Driver :=
1521 File_Name_Type (Element.Value.Value);
1523 when Name_Required_Switches |
1524 Name_Leading_Required_Switches =>
1525 Put (Into_List =>
1526 Lang_Index.Config.
1527 Compiler_Leading_Required_Switches,
1528 From_List => Element.Value.Values,
1529 In_Tree => Data.Tree);
1531 when Name_Trailing_Required_Switches =>
1532 Put (Into_List =>
1533 Lang_Index.Config.
1534 Compiler_Trailing_Required_Switches,
1535 From_List => Element.Value.Values,
1536 In_Tree => Data.Tree);
1538 when Name_Multi_Unit_Switches =>
1539 Put (Into_List =>
1540 Lang_Index.Config.Multi_Unit_Switches,
1541 From_List => Element.Value.Values,
1542 In_Tree => Data.Tree);
1544 when Name_Multi_Unit_Object_Separator =>
1545 Get_Name_String (Element.Value.Value);
1547 if Name_Len /= 1 then
1548 Error_Msg
1549 (Data.Flags,
1550 "multi-unit object separator must have " &
1551 "a single character",
1552 Element.Value.Location, Project);
1554 elsif Name_Buffer (1) = ' ' then
1555 Error_Msg
1556 (Data.Flags,
1557 "multi-unit object separator cannot be " &
1558 "a space",
1559 Element.Value.Location, Project);
1561 else
1562 Lang_Index.Config.Multi_Unit_Object_Separator :=
1563 Name_Buffer (1);
1564 end if;
1566 when Name_Path_Syntax =>
1567 begin
1568 Lang_Index.Config.Path_Syntax :=
1569 Path_Syntax_Kind'Value
1570 (Get_Name_String (Element.Value.Value));
1572 exception
1573 when Constraint_Error =>
1574 Error_Msg
1575 (Data.Flags,
1576 "invalid value for Path_Syntax",
1577 Element.Value.Location, Project);
1578 end;
1580 when Name_Object_File_Suffix =>
1581 if Get_Name_String (Element.Value.Value) = "" then
1582 Error_Msg
1583 (Data.Flags,
1584 "object file suffix cannot be empty",
1585 Element.Value.Location, Project);
1587 else
1588 Lang_Index.Config.Object_File_Suffix :=
1589 Element.Value.Value;
1590 end if;
1592 when Name_Object_File_Switches =>
1593 Put (Into_List =>
1594 Lang_Index.Config.Object_File_Switches,
1595 From_List => Element.Value.Values,
1596 In_Tree => Data.Tree);
1598 when Name_Pic_Option =>
1600 -- Attribute Compiler_Pic_Option (<language>)
1602 List := Element.Value.Values;
1604 if List = Nil_String then
1605 Error_Msg
1606 (Data.Flags,
1607 "compiler PIC option cannot be null",
1608 Element.Value.Location, Project);
1609 end if;
1611 Put (Into_List =>
1612 Lang_Index.Config.Compilation_PIC_Option,
1613 From_List => List,
1614 In_Tree => Data.Tree);
1616 when Name_Mapping_File_Switches =>
1618 -- Attribute Mapping_File_Switches (<language>)
1620 List := Element.Value.Values;
1622 if List = Nil_String then
1623 Error_Msg
1624 (Data.Flags,
1625 "mapping file switches cannot be null",
1626 Element.Value.Location, Project);
1627 end if;
1629 Put (Into_List =>
1630 Lang_Index.Config.Mapping_File_Switches,
1631 From_List => List,
1632 In_Tree => Data.Tree);
1634 when Name_Mapping_Spec_Suffix =>
1636 -- Attribute Mapping_Spec_Suffix (<language>)
1638 Lang_Index.Config.Mapping_Spec_Suffix :=
1639 File_Name_Type (Element.Value.Value);
1641 when Name_Mapping_Body_Suffix =>
1643 -- Attribute Mapping_Body_Suffix (<language>)
1645 Lang_Index.Config.Mapping_Body_Suffix :=
1646 File_Name_Type (Element.Value.Value);
1648 when Name_Config_File_Switches =>
1650 -- Attribute Config_File_Switches (<language>)
1652 List := Element.Value.Values;
1654 if List = Nil_String then
1655 Error_Msg
1656 (Data.Flags,
1657 "config file switches cannot be null",
1658 Element.Value.Location, Project);
1659 end if;
1661 Put (Into_List =>
1662 Lang_Index.Config.Config_File_Switches,
1663 From_List => List,
1664 In_Tree => Data.Tree);
1666 when Name_Objects_Path =>
1668 -- Attribute Objects_Path (<language>)
1670 Lang_Index.Config.Objects_Path :=
1671 Element.Value.Value;
1673 when Name_Objects_Path_File =>
1675 -- Attribute Objects_Path_File (<language>)
1677 Lang_Index.Config.Objects_Path_File :=
1678 Element.Value.Value;
1680 when Name_Config_Body_File_Name =>
1682 -- Attribute Config_Body_File_Name (<language>)
1684 Lang_Index.Config.Config_Body :=
1685 Element.Value.Value;
1687 when Name_Config_Body_File_Name_Index =>
1689 -- Attribute Config_Body_File_Name_Index
1690 -- ( < Language > )
1692 Lang_Index.Config.Config_Body_Index :=
1693 Element.Value.Value;
1695 when Name_Config_Body_File_Name_Pattern =>
1697 -- Attribute Config_Body_File_Name_Pattern
1698 -- (<language>)
1700 Lang_Index.Config.Config_Body_Pattern :=
1701 Element.Value.Value;
1703 when Name_Config_Spec_File_Name =>
1705 -- Attribute Config_Spec_File_Name (<language>)
1707 Lang_Index.Config.Config_Spec :=
1708 Element.Value.Value;
1710 when Name_Config_Spec_File_Name_Index =>
1712 -- Attribute Config_Spec_File_Name_Index
1713 -- ( < Language > )
1715 Lang_Index.Config.Config_Spec_Index :=
1716 Element.Value.Value;
1718 when Name_Config_Spec_File_Name_Pattern =>
1720 -- Attribute Config_Spec_File_Name_Pattern
1721 -- (<language>)
1723 Lang_Index.Config.Config_Spec_Pattern :=
1724 Element.Value.Value;
1726 when Name_Config_File_Unique =>
1728 -- Attribute Config_File_Unique (<language>)
1730 begin
1731 Lang_Index.Config.Config_File_Unique :=
1732 Boolean'Value
1733 (Get_Name_String (Element.Value.Value));
1734 exception
1735 when Constraint_Error =>
1736 Error_Msg
1737 (Data.Flags,
1738 "illegal value for Config_File_Unique",
1739 Element.Value.Location, Project);
1740 end;
1742 when others =>
1743 null;
1744 end case;
1745 end if;
1746 end if;
1748 Element_Id := Element.Next;
1749 end loop;
1751 Current_Array_Id := Current_Array.Next;
1752 end loop;
1753 end Process_Compiler;
1755 --------------------
1756 -- Process_Naming --
1757 --------------------
1759 procedure Process_Naming (Attributes : Variable_Id) is
1760 Attribute_Id : Variable_Id;
1761 Attribute : Variable;
1763 begin
1764 -- Process non associated array attribute from package Naming
1766 Attribute_Id := Attributes;
1767 while Attribute_Id /= No_Variable loop
1768 Attribute := Data.Tree.Variable_Elements.Table (Attribute_Id);
1770 if not Attribute.Value.Default then
1771 if Attribute.Name = Name_Separate_Suffix then
1773 -- Attribute Separate_Suffix
1775 Get_Name_String (Attribute.Value.Value);
1776 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1777 Separate_Suffix := Name_Find;
1779 elsif Attribute.Name = Name_Casing then
1781 -- Attribute Casing
1783 begin
1784 Casing :=
1785 Value (Get_Name_String (Attribute.Value.Value));
1787 exception
1788 when Constraint_Error =>
1789 Error_Msg
1790 (Data.Flags,
1791 "invalid value for Casing",
1792 Attribute.Value.Location, Project);
1793 end;
1795 elsif Attribute.Name = Name_Dot_Replacement then
1797 -- Attribute Dot_Replacement
1799 Dot_Replacement := File_Name_Type (Attribute.Value.Value);
1801 end if;
1802 end if;
1804 Attribute_Id := Attribute.Next;
1805 end loop;
1806 end Process_Naming;
1808 procedure Process_Naming (Arrays : Array_Id) is
1809 Current_Array_Id : Array_Id;
1810 Current_Array : Array_Data;
1811 Element_Id : Array_Element_Id;
1812 Element : Array_Element;
1814 begin
1815 -- Process the associative array attribute of package Naming
1817 Current_Array_Id := Arrays;
1818 while Current_Array_Id /= No_Array loop
1819 Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
1821 Element_Id := Current_Array.Value;
1822 while Element_Id /= No_Array_Element loop
1823 Element := Data.Tree.Array_Elements.Table (Element_Id);
1825 -- Get the name of the language
1827 Lang_Index := Get_Language_From_Name
1828 (Project, Get_Name_String (Element.Index));
1830 if Lang_Index /= No_Language_Index then
1831 case Current_Array.Name is
1832 when Name_Spec_Suffix | Name_Specification_Suffix =>
1834 -- Attribute Spec_Suffix (<language>)
1836 Get_Name_String (Element.Value.Value);
1837 Canonical_Case_File_Name
1838 (Name_Buffer (1 .. Name_Len));
1839 Lang_Index.Config.Naming_Data.Spec_Suffix :=
1840 Name_Find;
1842 when Name_Implementation_Suffix | Name_Body_Suffix =>
1844 Get_Name_String (Element.Value.Value);
1845 Canonical_Case_File_Name
1846 (Name_Buffer (1 .. Name_Len));
1848 -- Attribute Body_Suffix (<language>)
1850 Lang_Index.Config.Naming_Data.Body_Suffix :=
1851 Name_Find;
1852 Lang_Index.Config.Naming_Data.Separate_Suffix :=
1853 Lang_Index.Config.Naming_Data.Body_Suffix;
1855 when others =>
1856 null;
1857 end case;
1858 end if;
1860 Element_Id := Element.Next;
1861 end loop;
1863 Current_Array_Id := Current_Array.Next;
1864 end loop;
1865 end Process_Naming;
1867 --------------------
1868 -- Process_Linker --
1869 --------------------
1871 procedure Process_Linker (Attributes : Variable_Id) is
1872 Attribute_Id : Variable_Id;
1873 Attribute : Variable;
1875 begin
1876 -- Process non associated array attribute from package Linker
1878 Attribute_Id := Attributes;
1879 while Attribute_Id /= No_Variable loop
1880 Attribute :=
1881 Data.Tree.Variable_Elements.Table (Attribute_Id);
1883 if not Attribute.Value.Default then
1884 if Attribute.Name = Name_Driver then
1886 -- Attribute Linker'Driver: the default linker to use
1888 Project.Config.Linker :=
1889 Path_Name_Type (Attribute.Value.Value);
1891 -- Linker'Driver is also used to link shared libraries
1892 -- if the obsolescent attribute Library_GCC has not been
1893 -- specified.
1895 if Project.Config.Shared_Lib_Driver = No_File then
1896 Project.Config.Shared_Lib_Driver :=
1897 File_Name_Type (Attribute.Value.Value);
1898 end if;
1900 elsif Attribute.Name = Name_Required_Switches then
1902 -- Attribute Required_Switches: the minimum trailing
1903 -- options to use when invoking the linker
1905 Put (Into_List =>
1906 Project.Config.Trailing_Linker_Required_Switches,
1907 From_List => Attribute.Value.Values,
1908 In_Tree => Data.Tree);
1910 elsif Attribute.Name = Name_Map_File_Option then
1911 Project.Config.Map_File_Option := Attribute.Value.Value;
1913 elsif Attribute.Name = Name_Max_Command_Line_Length then
1914 begin
1915 Project.Config.Max_Command_Line_Length :=
1916 Natural'Value (Get_Name_String
1917 (Attribute.Value.Value));
1919 exception
1920 when Constraint_Error =>
1921 Error_Msg
1922 (Data.Flags,
1923 "value must be positive or equal to 0",
1924 Attribute.Value.Location, Project);
1925 end;
1927 elsif Attribute.Name = Name_Response_File_Format then
1928 declare
1929 Name : Name_Id;
1931 begin
1932 Get_Name_String (Attribute.Value.Value);
1933 To_Lower (Name_Buffer (1 .. Name_Len));
1934 Name := Name_Find;
1936 if Name = Name_None then
1937 Project.Config.Resp_File_Format := None;
1939 elsif Name = Name_Gnu then
1940 Project.Config.Resp_File_Format := GNU;
1942 elsif Name = Name_Object_List then
1943 Project.Config.Resp_File_Format := Object_List;
1945 elsif Name = Name_Option_List then
1946 Project.Config.Resp_File_Format := Option_List;
1948 elsif Name_Buffer (1 .. Name_Len) = "gcc" then
1949 Project.Config.Resp_File_Format := GCC;
1951 elsif Name_Buffer (1 .. Name_Len) = "gcc_gnu" then
1952 Project.Config.Resp_File_Format := GCC_GNU;
1954 elsif
1955 Name_Buffer (1 .. Name_Len) = "gcc_option_list"
1956 then
1957 Project.Config.Resp_File_Format := GCC_Option_List;
1959 elsif
1960 Name_Buffer (1 .. Name_Len) = "gcc_object_list"
1961 then
1962 Project.Config.Resp_File_Format := GCC_Object_List;
1964 else
1965 Error_Msg
1966 (Data.Flags,
1967 "illegal response file format",
1968 Attribute.Value.Location, Project);
1969 end if;
1970 end;
1972 elsif Attribute.Name = Name_Response_File_Switches then
1973 Put (Into_List => Project.Config.Resp_File_Options,
1974 From_List => Attribute.Value.Values,
1975 In_Tree => Data.Tree);
1976 end if;
1977 end if;
1979 Attribute_Id := Attribute.Next;
1980 end loop;
1981 end Process_Linker;
1983 -- Start of processing for Process_Packages
1985 begin
1986 Packages := Project.Decl.Packages;
1987 while Packages /= No_Package loop
1988 Element := Data.Tree.Packages.Table (Packages);
1990 case Element.Name is
1991 when Name_Binder =>
1993 -- Process attributes of package Binder
1995 Process_Binder (Element.Decl.Arrays);
1997 when Name_Builder =>
1999 -- Process attributes of package Builder
2001 Process_Builder (Element.Decl.Attributes);
2003 when Name_Compiler =>
2005 -- Process attributes of package Compiler
2007 Process_Compiler (Element.Decl.Arrays);
2009 when Name_Linker =>
2011 -- Process attributes of package Linker
2013 Process_Linker (Element.Decl.Attributes);
2015 when Name_Naming =>
2017 -- Process attributes of package Naming
2019 Process_Naming (Element.Decl.Attributes);
2020 Process_Naming (Element.Decl.Arrays);
2022 when others =>
2023 null;
2024 end case;
2026 Packages := Element.Next;
2027 end loop;
2028 end Process_Packages;
2030 ---------------------------------------------
2031 -- Process_Project_Level_Simple_Attributes --
2032 ---------------------------------------------
2034 procedure Process_Project_Level_Simple_Attributes is
2035 Attribute_Id : Variable_Id;
2036 Attribute : Variable;
2037 List : String_List_Id;
2039 begin
2040 -- Process non associated array attribute at project level
2042 Attribute_Id := Project.Decl.Attributes;
2043 while Attribute_Id /= No_Variable loop
2044 Attribute :=
2045 Data.Tree.Variable_Elements.Table (Attribute_Id);
2047 if not Attribute.Value.Default then
2048 if Attribute.Name = Name_Target then
2050 -- Attribute Target: the target specified
2052 Project.Config.Target := Attribute.Value.Value;
2054 elsif Attribute.Name = Name_Library_Builder then
2056 -- Attribute Library_Builder: the application to invoke
2057 -- to build libraries.
2059 Project.Config.Library_Builder :=
2060 Path_Name_Type (Attribute.Value.Value);
2062 elsif Attribute.Name = Name_Archive_Builder then
2064 -- Attribute Archive_Builder: the archive builder
2065 -- (usually "ar") and its minimum options (usually "cr").
2067 List := Attribute.Value.Values;
2069 if List = Nil_String then
2070 Error_Msg
2071 (Data.Flags,
2072 "archive builder cannot be null",
2073 Attribute.Value.Location, Project);
2074 end if;
2076 Put (Into_List => Project.Config.Archive_Builder,
2077 From_List => List,
2078 In_Tree => Data.Tree);
2080 elsif Attribute.Name = Name_Archive_Builder_Append_Option then
2082 -- Attribute Archive_Builder: the archive builder
2083 -- (usually "ar") and its minimum options (usually "cr").
2085 List := Attribute.Value.Values;
2087 if List /= Nil_String then
2089 (Into_List =>
2090 Project.Config.Archive_Builder_Append_Option,
2091 From_List => List,
2092 In_Tree => Data.Tree);
2093 end if;
2095 elsif Attribute.Name = Name_Archive_Indexer then
2097 -- Attribute Archive_Indexer: the optional archive
2098 -- indexer (usually "ranlib") with its minimum options
2099 -- (usually none).
2101 List := Attribute.Value.Values;
2103 if List = Nil_String then
2104 Error_Msg
2105 (Data.Flags,
2106 "archive indexer cannot be null",
2107 Attribute.Value.Location, Project);
2108 end if;
2110 Put (Into_List => Project.Config.Archive_Indexer,
2111 From_List => List,
2112 In_Tree => Data.Tree);
2114 elsif Attribute.Name = Name_Library_Partial_Linker then
2116 -- Attribute Library_Partial_Linker: the optional linker
2117 -- driver with its minimum options, to partially link
2118 -- archives.
2120 List := Attribute.Value.Values;
2122 if List = Nil_String then
2123 Error_Msg
2124 (Data.Flags,
2125 "partial linker cannot be null",
2126 Attribute.Value.Location, Project);
2127 end if;
2129 Put (Into_List => Project.Config.Lib_Partial_Linker,
2130 From_List => List,
2131 In_Tree => Data.Tree);
2133 elsif Attribute.Name = Name_Library_GCC then
2134 Project.Config.Shared_Lib_Driver :=
2135 File_Name_Type (Attribute.Value.Value);
2136 Error_Msg
2137 (Data.Flags,
2138 "?Library_'G'C'C is an obsolescent attribute, " &
2139 "use Linker''Driver instead",
2140 Attribute.Value.Location, Project);
2142 elsif Attribute.Name = Name_Archive_Suffix then
2143 Project.Config.Archive_Suffix :=
2144 File_Name_Type (Attribute.Value.Value);
2146 elsif Attribute.Name = Name_Linker_Executable_Option then
2148 -- Attribute Linker_Executable_Option: optional options
2149 -- to specify an executable name. Defaults to "-o".
2151 List := Attribute.Value.Values;
2153 if List = Nil_String then
2154 Error_Msg
2155 (Data.Flags,
2156 "linker executable option cannot be null",
2157 Attribute.Value.Location, Project);
2158 end if;
2160 Put (Into_List => Project.Config.Linker_Executable_Option,
2161 From_List => List,
2162 In_Tree => Data.Tree);
2164 elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
2166 -- Attribute Linker_Lib_Dir_Option: optional options
2167 -- to specify a library search directory. Defaults to
2168 -- "-L".
2170 Get_Name_String (Attribute.Value.Value);
2172 if Name_Len = 0 then
2173 Error_Msg
2174 (Data.Flags,
2175 "linker library directory option cannot be empty",
2176 Attribute.Value.Location, Project);
2177 end if;
2179 Project.Config.Linker_Lib_Dir_Option :=
2180 Attribute.Value.Value;
2182 elsif Attribute.Name = Name_Linker_Lib_Name_Option then
2184 -- Attribute Linker_Lib_Name_Option: optional options
2185 -- to specify the name of a library to be linked in.
2186 -- Defaults to "-l".
2188 Get_Name_String (Attribute.Value.Value);
2190 if Name_Len = 0 then
2191 Error_Msg
2192 (Data.Flags,
2193 "linker library name option cannot be empty",
2194 Attribute.Value.Location, Project);
2195 end if;
2197 Project.Config.Linker_Lib_Name_Option :=
2198 Attribute.Value.Value;
2200 elsif Attribute.Name = Name_Run_Path_Option then
2202 -- Attribute Run_Path_Option: optional options to
2203 -- specify a path for libraries.
2205 List := Attribute.Value.Values;
2207 if List /= Nil_String then
2208 Put (Into_List => Project.Config.Run_Path_Option,
2209 From_List => List,
2210 In_Tree => Data.Tree);
2211 end if;
2213 elsif Attribute.Name = Name_Run_Path_Origin then
2214 Get_Name_String (Attribute.Value.Value);
2216 if Name_Len = 0 then
2217 Error_Msg
2218 (Data.Flags,
2219 "run path origin cannot be empty",
2220 Attribute.Value.Location, Project);
2221 end if;
2223 Project.Config.Run_Path_Origin := Attribute.Value.Value;
2225 elsif Attribute.Name = Name_Library_Install_Name_Option then
2226 Project.Config.Library_Install_Name_Option :=
2227 Attribute.Value.Value;
2229 elsif Attribute.Name = Name_Separate_Run_Path_Options then
2230 declare
2231 pragma Unsuppress (All_Checks);
2232 begin
2233 Project.Config.Separate_Run_Path_Options :=
2234 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2235 exception
2236 when Constraint_Error =>
2237 Error_Msg
2238 (Data.Flags,
2239 "invalid value """ &
2240 Get_Name_String (Attribute.Value.Value) &
2241 """ for Separate_Run_Path_Options",
2242 Attribute.Value.Location, Project);
2243 end;
2245 elsif Attribute.Name = Name_Library_Support then
2246 declare
2247 pragma Unsuppress (All_Checks);
2248 begin
2249 Project.Config.Lib_Support :=
2250 Library_Support'Value (Get_Name_String
2251 (Attribute.Value.Value));
2252 exception
2253 when Constraint_Error =>
2254 Error_Msg
2255 (Data.Flags,
2256 "invalid value """ &
2257 Get_Name_String (Attribute.Value.Value) &
2258 """ for Library_Support",
2259 Attribute.Value.Location, Project);
2260 end;
2262 elsif Attribute.Name = Name_Shared_Library_Prefix then
2263 Project.Config.Shared_Lib_Prefix :=
2264 File_Name_Type (Attribute.Value.Value);
2266 elsif Attribute.Name = Name_Shared_Library_Suffix then
2267 Project.Config.Shared_Lib_Suffix :=
2268 File_Name_Type (Attribute.Value.Value);
2270 elsif Attribute.Name = Name_Symbolic_Link_Supported then
2271 declare
2272 pragma Unsuppress (All_Checks);
2273 begin
2274 Project.Config.Symbolic_Link_Supported :=
2275 Boolean'Value (Get_Name_String
2276 (Attribute.Value.Value));
2277 exception
2278 when Constraint_Error =>
2279 Error_Msg
2280 (Data.Flags,
2281 "invalid value """
2282 & Get_Name_String (Attribute.Value.Value)
2283 & """ for Symbolic_Link_Supported",
2284 Attribute.Value.Location, Project);
2285 end;
2287 elsif
2288 Attribute.Name = Name_Library_Major_Minor_Id_Supported
2289 then
2290 declare
2291 pragma Unsuppress (All_Checks);
2292 begin
2293 Project.Config.Lib_Maj_Min_Id_Supported :=
2294 Boolean'Value (Get_Name_String
2295 (Attribute.Value.Value));
2296 exception
2297 when Constraint_Error =>
2298 Error_Msg
2299 (Data.Flags,
2300 "invalid value """ &
2301 Get_Name_String (Attribute.Value.Value) &
2302 """ for Library_Major_Minor_Id_Supported",
2303 Attribute.Value.Location, Project);
2304 end;
2306 elsif Attribute.Name = Name_Library_Auto_Init_Supported then
2307 declare
2308 pragma Unsuppress (All_Checks);
2309 begin
2310 Project.Config.Auto_Init_Supported :=
2311 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2312 exception
2313 when Constraint_Error =>
2314 Error_Msg
2315 (Data.Flags,
2316 "invalid value """
2317 & Get_Name_String (Attribute.Value.Value)
2318 & """ for Library_Auto_Init_Supported",
2319 Attribute.Value.Location, Project);
2320 end;
2322 elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
2323 List := Attribute.Value.Values;
2325 if List /= Nil_String then
2326 Put (Into_List => Project.Config.Shared_Lib_Min_Options,
2327 From_List => List,
2328 In_Tree => Data.Tree);
2329 end if;
2331 elsif Attribute.Name = Name_Library_Version_Switches then
2332 List := Attribute.Value.Values;
2334 if List /= Nil_String then
2335 Put (Into_List => Project.Config.Lib_Version_Options,
2336 From_List => List,
2337 In_Tree => Data.Tree);
2338 end if;
2339 end if;
2340 end if;
2342 Attribute_Id := Attribute.Next;
2343 end loop;
2344 end Process_Project_Level_Simple_Attributes;
2346 --------------------------------------------
2347 -- Process_Project_Level_Array_Attributes --
2348 --------------------------------------------
2350 procedure Process_Project_Level_Array_Attributes is
2351 Current_Array_Id : Array_Id;
2352 Current_Array : Array_Data;
2353 Element_Id : Array_Element_Id;
2354 Element : Array_Element;
2355 List : String_List_Id;
2357 begin
2358 -- Process the associative array attributes at project level
2360 Current_Array_Id := Project.Decl.Arrays;
2361 while Current_Array_Id /= No_Array loop
2362 Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
2364 Element_Id := Current_Array.Value;
2365 while Element_Id /= No_Array_Element loop
2366 Element := Data.Tree.Array_Elements.Table (Element_Id);
2368 -- Get the name of the language
2370 Lang_Index :=
2371 Get_Language_From_Name
2372 (Project, Get_Name_String (Element.Index));
2374 if Lang_Index /= No_Language_Index then
2375 case Current_Array.Name is
2376 when Name_Inherit_Source_Path =>
2377 List := Element.Value.Values;
2379 if List /= Nil_String then
2381 (Into_List =>
2382 Lang_Index.Config.Include_Compatible_Languages,
2383 From_List => List,
2384 In_Tree => Data.Tree,
2385 Lower_Case => True);
2386 end if;
2388 when Name_Toolchain_Description =>
2390 -- Attribute Toolchain_Description (<language>)
2392 Lang_Index.Config.Toolchain_Description :=
2393 Element.Value.Value;
2395 when Name_Toolchain_Version =>
2397 -- Attribute Toolchain_Version (<language>)
2399 Lang_Index.Config.Toolchain_Version :=
2400 Element.Value.Value;
2402 when Name_Runtime_Library_Dir =>
2404 -- Attribute Runtime_Library_Dir (<language>)
2406 Lang_Index.Config.Runtime_Library_Dir :=
2407 Element.Value.Value;
2409 when Name_Runtime_Source_Dir =>
2411 -- Attribute Runtime_Library_Dir (<language>)
2413 Lang_Index.Config.Runtime_Source_Dir :=
2414 Element.Value.Value;
2416 when Name_Object_Generated =>
2417 declare
2418 pragma Unsuppress (All_Checks);
2419 Value : Boolean;
2421 begin
2422 Value :=
2423 Boolean'Value
2424 (Get_Name_String (Element.Value.Value));
2426 Lang_Index.Config.Object_Generated := Value;
2428 -- If no object is generated, no object may be
2429 -- linked.
2431 if not Value then
2432 Lang_Index.Config.Objects_Linked := False;
2433 end if;
2435 exception
2436 when Constraint_Error =>
2437 Error_Msg
2438 (Data.Flags,
2439 "invalid value """
2440 & Get_Name_String (Element.Value.Value)
2441 & """ for Object_Generated",
2442 Element.Value.Location, Project);
2443 end;
2445 when Name_Objects_Linked =>
2446 declare
2447 pragma Unsuppress (All_Checks);
2448 Value : Boolean;
2450 begin
2451 Value :=
2452 Boolean'Value
2453 (Get_Name_String (Element.Value.Value));
2455 -- No change if Object_Generated is False, as this
2456 -- forces Objects_Linked to be False too.
2458 if Lang_Index.Config.Object_Generated then
2459 Lang_Index.Config.Objects_Linked := Value;
2460 end if;
2462 exception
2463 when Constraint_Error =>
2464 Error_Msg
2465 (Data.Flags,
2466 "invalid value """
2467 & Get_Name_String (Element.Value.Value)
2468 & """ for Objects_Linked",
2469 Element.Value.Location, Project);
2470 end;
2471 when others =>
2472 null;
2473 end case;
2474 end if;
2476 Element_Id := Element.Next;
2477 end loop;
2479 Current_Array_Id := Current_Array.Next;
2480 end loop;
2481 end Process_Project_Level_Array_Attributes;
2483 -- Start of processing for Check_Configuration
2485 begin
2486 Process_Project_Level_Simple_Attributes;
2487 Process_Project_Level_Array_Attributes;
2488 Process_Packages;
2490 -- For unit based languages, set Casing, Dot_Replacement and
2491 -- Separate_Suffix in Naming_Data.
2493 Lang_Index := Project.Languages;
2494 while Lang_Index /= No_Language_Index loop
2495 if Lang_Index.Name = Name_Ada then
2496 Lang_Index.Config.Naming_Data.Casing := Casing;
2497 Lang_Index.Config.Naming_Data.Dot_Replacement := Dot_Replacement;
2499 if Separate_Suffix /= No_File then
2500 Lang_Index.Config.Naming_Data.Separate_Suffix :=
2501 Separate_Suffix;
2502 end if;
2504 exit;
2505 end if;
2507 Lang_Index := Lang_Index.Next;
2508 end loop;
2510 -- Give empty names to various prefixes/suffixes, if they have not
2511 -- been specified in the configuration.
2513 if Project.Config.Archive_Suffix = No_File then
2514 Project.Config.Archive_Suffix := Empty_File;
2515 end if;
2517 if Project.Config.Shared_Lib_Prefix = No_File then
2518 Project.Config.Shared_Lib_Prefix := Empty_File;
2519 end if;
2521 if Project.Config.Shared_Lib_Suffix = No_File then
2522 Project.Config.Shared_Lib_Suffix := Empty_File;
2523 end if;
2525 Lang_Index := Project.Languages;
2526 while Lang_Index /= No_Language_Index loop
2528 -- For all languages, Compiler_Driver needs to be specified. This is
2529 -- only needed if we do intend to compile (not in GPS for instance).
2531 if Data.Flags.Compiler_Driver_Mandatory
2532 and then Lang_Index.Config.Compiler_Driver = No_File
2533 then
2534 Error_Msg_Name_1 := Lang_Index.Display_Name;
2535 Error_Msg
2536 (Data.Flags,
2537 "?no compiler specified for language %%" &
2538 ", ignoring all its sources",
2539 No_Location, Project);
2541 if Lang_Index = Project.Languages then
2542 Project.Languages := Lang_Index.Next;
2543 else
2544 Prev_Index.Next := Lang_Index.Next;
2545 end if;
2547 elsif Lang_Index.Name = Name_Ada then
2548 Prev_Index := Lang_Index;
2550 -- For unit based languages, Dot_Replacement, Spec_Suffix and
2551 -- Body_Suffix need to be specified.
2553 if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then
2554 Error_Msg
2555 (Data.Flags,
2556 "Dot_Replacement not specified for Ada",
2557 No_Location, Project);
2558 end if;
2560 if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
2561 Error_Msg
2562 (Data.Flags,
2563 "Spec_Suffix not specified for Ada",
2564 No_Location, Project);
2565 end if;
2567 if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
2568 Error_Msg
2569 (Data.Flags,
2570 "Body_Suffix not specified for Ada",
2571 No_Location, Project);
2572 end if;
2574 else
2575 Prev_Index := Lang_Index;
2577 -- For file based languages, either Spec_Suffix or Body_Suffix
2578 -- need to be specified.
2580 if Data.Flags.Require_Sources_Other_Lang
2581 and then Lang_Index.Config.Naming_Data.Spec_Suffix = No_File
2582 and then Lang_Index.Config.Naming_Data.Body_Suffix = No_File
2583 then
2584 Error_Msg_Name_1 := Lang_Index.Display_Name;
2585 Error_Msg
2586 (Data.Flags,
2587 "no suffixes specified for %%",
2588 No_Location, Project);
2589 end if;
2590 end if;
2592 Lang_Index := Lang_Index.Next;
2593 end loop;
2594 end Check_Configuration;
2596 -------------------------------
2597 -- Check_If_Externally_Built --
2598 -------------------------------
2600 procedure Check_If_Externally_Built
2601 (Project : Project_Id;
2602 Data : in out Tree_Processing_Data)
2604 Externally_Built : constant Variable_Value :=
2605 Util.Value_Of
2606 (Name_Externally_Built,
2607 Project.Decl.Attributes, Data.Tree);
2609 begin
2610 if not Externally_Built.Default then
2611 Get_Name_String (Externally_Built.Value);
2612 To_Lower (Name_Buffer (1 .. Name_Len));
2614 if Name_Buffer (1 .. Name_Len) = "true" then
2615 Project.Externally_Built := True;
2617 elsif Name_Buffer (1 .. Name_Len) /= "false" then
2618 Error_Msg (Data.Flags,
2619 "Externally_Built may only be true or false",
2620 Externally_Built.Location, Project);
2621 end if;
2622 end if;
2624 -- A virtual project extending an externally built project is itself
2625 -- externally built.
2627 if Project.Virtual and then Project.Extends /= No_Project then
2628 Project.Externally_Built := Project.Extends.Externally_Built;
2629 end if;
2631 if Current_Verbosity = High then
2632 Write_Str ("Project is ");
2634 if not Project.Externally_Built then
2635 Write_Str ("not ");
2636 end if;
2638 Write_Line ("externally built.");
2639 end if;
2640 end Check_If_Externally_Built;
2642 ----------------------
2643 -- Check_Interfaces --
2644 ----------------------
2646 procedure Check_Interfaces
2647 (Project : Project_Id;
2648 Data : in out Tree_Processing_Data)
2650 Interfaces : constant Prj.Variable_Value :=
2651 Prj.Util.Value_Of
2652 (Snames.Name_Interfaces,
2653 Project.Decl.Attributes,
2654 Data.Tree);
2656 Library_Interface : constant Prj.Variable_Value :=
2657 Prj.Util.Value_Of
2658 (Snames.Name_Library_Interface,
2659 Project.Decl.Attributes,
2660 Data.Tree);
2662 List : String_List_Id;
2663 Element : String_Element;
2664 Name : File_Name_Type;
2665 Iter : Source_Iterator;
2666 Source : Source_Id;
2667 Project_2 : Project_Id;
2668 Other : Source_Id;
2670 begin
2671 if not Interfaces.Default then
2673 -- Set In_Interfaces to False for all sources. It will be set to True
2674 -- later for the sources in the Interfaces list.
2676 Project_2 := Project;
2677 while Project_2 /= No_Project loop
2678 Iter := For_Each_Source (Data.Tree, Project_2);
2679 loop
2680 Source := Prj.Element (Iter);
2681 exit when Source = No_Source;
2682 Source.In_Interfaces := False;
2683 Next (Iter);
2684 end loop;
2686 Project_2 := Project_2.Extends;
2687 end loop;
2689 List := Interfaces.Values;
2690 while List /= Nil_String loop
2691 Element := Data.Tree.String_Elements.Table (List);
2692 Name := Canonical_Case_File_Name (Element.Value);
2694 Project_2 := Project;
2695 Big_Loop :
2696 while Project_2 /= No_Project loop
2697 Iter := For_Each_Source (Data.Tree, Project_2);
2699 loop
2700 Source := Prj.Element (Iter);
2701 exit when Source = No_Source;
2703 if Source.File = Name then
2704 if not Source.Locally_Removed then
2705 Source.In_Interfaces := True;
2706 Source.Declared_In_Interfaces := True;
2708 Other := Other_Part (Source);
2710 if Other /= No_Source then
2711 Other.In_Interfaces := True;
2712 Other.Declared_In_Interfaces := True;
2713 end if;
2715 if Current_Verbosity = High then
2716 Write_Str (" interface: ");
2717 Write_Line (Get_Name_String (Source.Path.Name));
2718 end if;
2719 end if;
2721 exit Big_Loop;
2722 end if;
2724 Next (Iter);
2725 end loop;
2727 Project_2 := Project_2.Extends;
2728 end loop Big_Loop;
2730 if Source = No_Source then
2731 Error_Msg_File_1 := File_Name_Type (Element.Value);
2732 Error_Msg_Name_1 := Project.Name;
2734 Error_Msg
2735 (Data.Flags,
2736 "{ cannot be an interface of project %% "
2737 & "as it is not one of its sources",
2738 Element.Location, Project);
2739 end if;
2741 List := Element.Next;
2742 end loop;
2744 Project.Interfaces_Defined := True;
2746 elsif Project.Library and then not Library_Interface.Default then
2748 -- Set In_Interfaces to False for all sources. It will be set to True
2749 -- later for the sources in the Library_Interface list.
2751 Project_2 := Project;
2752 while Project_2 /= No_Project loop
2753 Iter := For_Each_Source (Data.Tree, Project_2);
2754 loop
2755 Source := Prj.Element (Iter);
2756 exit when Source = No_Source;
2757 Source.In_Interfaces := False;
2758 Next (Iter);
2759 end loop;
2761 Project_2 := Project_2.Extends;
2762 end loop;
2764 List := Library_Interface.Values;
2765 while List /= Nil_String loop
2766 Element := Data.Tree.String_Elements.Table (List);
2767 Get_Name_String (Element.Value);
2768 To_Lower (Name_Buffer (1 .. Name_Len));
2769 Name := Name_Find;
2771 Project_2 := Project;
2772 Big_Loop_2 :
2773 while Project_2 /= No_Project loop
2774 Iter := For_Each_Source (Data.Tree, Project_2);
2776 loop
2777 Source := Prj.Element (Iter);
2778 exit when Source = No_Source;
2780 if Source.Unit /= No_Unit_Index and then
2781 Source.Unit.Name = Name_Id (Name)
2782 then
2783 if not Source.Locally_Removed then
2784 Source.In_Interfaces := True;
2785 Source.Declared_In_Interfaces := True;
2787 Other := Other_Part (Source);
2789 if Other /= No_Source then
2790 Other.In_Interfaces := True;
2791 Other.Declared_In_Interfaces := True;
2792 end if;
2794 if Current_Verbosity = High then
2795 Write_Str (" interface: ");
2796 Write_Line (Get_Name_String (Source.Path.Name));
2797 end if;
2798 end if;
2800 exit Big_Loop_2;
2801 end if;
2803 Next (Iter);
2804 end loop;
2806 Project_2 := Project_2.Extends;
2807 end loop Big_Loop_2;
2809 List := Element.Next;
2810 end loop;
2812 Project.Interfaces_Defined := True;
2814 elsif Project.Extends /= No_Project
2815 and then Project.Extends.Interfaces_Defined
2816 then
2817 Project.Interfaces_Defined := True;
2819 Iter := For_Each_Source (Data.Tree, Project);
2820 loop
2821 Source := Prj.Element (Iter);
2822 exit when Source = No_Source;
2824 if not Source.Declared_In_Interfaces then
2825 Source.In_Interfaces := False;
2826 end if;
2828 Next (Iter);
2829 end loop;
2830 end if;
2831 end Check_Interfaces;
2833 --------------------------
2834 -- Check_Package_Naming --
2835 --------------------------
2837 procedure Check_Package_Naming
2838 (Project : Project_Id;
2839 Data : in out Tree_Processing_Data)
2841 Naming_Id : constant Package_Id :=
2842 Util.Value_Of
2843 (Name_Naming, Project.Decl.Packages, Data.Tree);
2844 Naming : Package_Element;
2846 Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
2848 procedure Check_Naming;
2849 -- Check the validity of the Naming package (suffixes valid, ...)
2851 procedure Check_Common
2852 (Dot_Replacement : in out File_Name_Type;
2853 Casing : in out Casing_Type;
2854 Casing_Defined : out Boolean;
2855 Separate_Suffix : in out File_Name_Type;
2856 Sep_Suffix_Loc : out Source_Ptr);
2857 -- Check attributes common
2859 procedure Process_Exceptions_File_Based
2860 (Lang_Id : Language_Ptr;
2861 Kind : Source_Kind);
2862 procedure Process_Exceptions_Unit_Based
2863 (Lang_Id : Language_Ptr;
2864 Kind : Source_Kind);
2865 -- Process the naming exceptions for the two types of languages
2867 procedure Initialize_Naming_Data;
2868 -- Initialize internal naming data for the various languages
2870 ------------------
2871 -- Check_Common --
2872 ------------------
2874 procedure Check_Common
2875 (Dot_Replacement : in out File_Name_Type;
2876 Casing : in out Casing_Type;
2877 Casing_Defined : out Boolean;
2878 Separate_Suffix : in out File_Name_Type;
2879 Sep_Suffix_Loc : out Source_Ptr)
2881 Dot_Repl : constant Variable_Value :=
2882 Util.Value_Of
2883 (Name_Dot_Replacement,
2884 Naming.Decl.Attributes,
2885 Data.Tree);
2886 Casing_String : constant Variable_Value :=
2887 Util.Value_Of
2888 (Name_Casing,
2889 Naming.Decl.Attributes,
2890 Data.Tree);
2891 Sep_Suffix : constant Variable_Value :=
2892 Util.Value_Of
2893 (Name_Separate_Suffix,
2894 Naming.Decl.Attributes,
2895 Data.Tree);
2896 Dot_Repl_Loc : Source_Ptr;
2898 begin
2899 Sep_Suffix_Loc := No_Location;
2901 if not Dot_Repl.Default then
2902 pragma Assert
2903 (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
2905 if Length_Of_Name (Dot_Repl.Value) = 0 then
2906 Error_Msg
2907 (Data.Flags, "Dot_Replacement cannot be empty",
2908 Dot_Repl.Location, Project);
2909 end if;
2911 Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
2912 Dot_Repl_Loc := Dot_Repl.Location;
2914 declare
2915 Repl : constant String := Get_Name_String (Dot_Replacement);
2917 begin
2918 -- Dot_Replacement cannot
2919 -- - be empty
2920 -- - start or end with an alphanumeric
2921 -- - be a single '_'
2922 -- - start with an '_' followed by an alphanumeric
2923 -- - contain a '.' except if it is "."
2925 if Repl'Length = 0
2926 or else Is_Alphanumeric (Repl (Repl'First))
2927 or else Is_Alphanumeric (Repl (Repl'Last))
2928 or else (Repl (Repl'First) = '_'
2929 and then
2930 (Repl'Length = 1
2931 or else
2932 Is_Alphanumeric (Repl (Repl'First + 1))))
2933 or else (Repl'Length > 1
2934 and then
2935 Index (Source => Repl, Pattern => ".") /= 0)
2936 then
2937 Error_Msg
2938 (Data.Flags,
2939 '"' & Repl &
2940 """ is illegal for Dot_Replacement.",
2941 Dot_Repl_Loc, Project);
2942 end if;
2943 end;
2944 end if;
2946 if Dot_Replacement /= No_File then
2947 Write_Attr
2948 ("Dot_Replacement", Get_Name_String (Dot_Replacement));
2949 end if;
2951 Casing_Defined := False;
2953 if not Casing_String.Default then
2954 pragma Assert
2955 (Casing_String.Kind = Single, "Casing is not a string");
2957 declare
2958 Casing_Image : constant String :=
2959 Get_Name_String (Casing_String.Value);
2961 begin
2962 if Casing_Image'Length = 0 then
2963 Error_Msg
2964 (Data.Flags,
2965 "Casing cannot be an empty string",
2966 Casing_String.Location, Project);
2967 end if;
2969 Casing := Value (Casing_Image);
2970 Casing_Defined := True;
2972 exception
2973 when Constraint_Error =>
2974 Name_Len := Casing_Image'Length;
2975 Name_Buffer (1 .. Name_Len) := Casing_Image;
2976 Err_Vars.Error_Msg_Name_1 := Name_Find;
2977 Error_Msg
2978 (Data.Flags,
2979 "%% is not a correct Casing",
2980 Casing_String.Location, Project);
2981 end;
2982 end if;
2984 Write_Attr ("Casing", Image (Casing));
2986 if not Sep_Suffix.Default then
2987 if Length_Of_Name (Sep_Suffix.Value) = 0 then
2988 Error_Msg
2989 (Data.Flags,
2990 "Separate_Suffix cannot be empty",
2991 Sep_Suffix.Location, Project);
2993 else
2994 Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
2995 Sep_Suffix_Loc := Sep_Suffix.Location;
2997 Check_Illegal_Suffix
2998 (Project, Separate_Suffix,
2999 Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location,
3000 Data);
3001 end if;
3002 end if;
3004 if Separate_Suffix /= No_File then
3005 Write_Attr
3006 ("Separate_Suffix", Get_Name_String (Separate_Suffix));
3007 end if;
3008 end Check_Common;
3010 -----------------------------------
3011 -- Process_Exceptions_File_Based --
3012 -----------------------------------
3014 procedure Process_Exceptions_File_Based
3015 (Lang_Id : Language_Ptr;
3016 Kind : Source_Kind)
3018 Lang : constant Name_Id := Lang_Id.Name;
3019 Exceptions : Array_Element_Id;
3020 Exception_List : Variable_Value;
3021 Element_Id : String_List_Id;
3022 Element : String_Element;
3023 File_Name : File_Name_Type;
3024 Source : Source_Id;
3026 begin
3027 case Kind is
3028 when Impl | Sep =>
3029 Exceptions :=
3030 Value_Of
3031 (Name_Implementation_Exceptions,
3032 In_Arrays => Naming.Decl.Arrays,
3033 In_Tree => Data.Tree);
3035 when Spec =>
3036 Exceptions :=
3037 Value_Of
3038 (Name_Specification_Exceptions,
3039 In_Arrays => Naming.Decl.Arrays,
3040 In_Tree => Data.Tree);
3041 end case;
3043 Exception_List :=
3044 Value_Of
3045 (Index => Lang,
3046 In_Array => Exceptions,
3047 In_Tree => Data.Tree);
3049 if Exception_List /= Nil_Variable_Value then
3050 Element_Id := Exception_List.Values;
3051 while Element_Id /= Nil_String loop
3052 Element := Data.Tree.String_Elements.Table (Element_Id);
3053 File_Name := Canonical_Case_File_Name (Element.Value);
3055 Source :=
3056 Source_Files_Htable.Get
3057 (Data.Tree.Source_Files_HT, File_Name);
3058 while Source /= No_Source
3059 and then Source.Project /= Project
3060 loop
3061 Source := Source.Next_With_File_Name;
3062 end loop;
3064 if Source = No_Source then
3065 Add_Source
3066 (Id => Source,
3067 Data => Data,
3068 Project => Project,
3069 Source_Dir_Rank => 0,
3070 Lang_Id => Lang_Id,
3071 Kind => Kind,
3072 File_Name => File_Name,
3073 Display_File => File_Name_Type (Element.Value),
3074 Naming_Exception => True,
3075 Location => Element.Location);
3077 else
3078 -- Check if the file name is already recorded for another
3079 -- language or another kind.
3081 if Source.Language /= Lang_Id then
3082 Error_Msg
3083 (Data.Flags,
3084 "the same file cannot be a source of two languages",
3085 Element.Location, Project);
3087 elsif Source.Kind /= Kind then
3088 Error_Msg
3089 (Data.Flags,
3090 "the same file cannot be a source and a template",
3091 Element.Location, Project);
3092 end if;
3094 -- If the file is already recorded for the same
3095 -- language and the same kind, it means that the file
3096 -- name appears several times in the *_Exceptions
3097 -- attribute; so there is nothing to do.
3098 end if;
3100 Element_Id := Element.Next;
3101 end loop;
3102 end if;
3103 end Process_Exceptions_File_Based;
3105 -----------------------------------
3106 -- Process_Exceptions_Unit_Based --
3107 -----------------------------------
3109 procedure Process_Exceptions_Unit_Based
3110 (Lang_Id : Language_Ptr;
3111 Kind : Source_Kind)
3113 Lang : constant Name_Id := Lang_Id.Name;
3114 Exceptions : Array_Element_Id;
3115 Element : Array_Element;
3116 Unit : Name_Id;
3117 Index : Int;
3118 File_Name : File_Name_Type;
3119 Source : Source_Id;
3121 begin
3122 case Kind is
3123 when Impl | Sep =>
3124 Exceptions :=
3125 Value_Of
3126 (Name_Body,
3127 In_Arrays => Naming.Decl.Arrays,
3128 In_Tree => Data.Tree);
3130 if Exceptions = No_Array_Element then
3131 Exceptions :=
3132 Value_Of
3133 (Name_Implementation,
3134 In_Arrays => Naming.Decl.Arrays,
3135 In_Tree => Data.Tree);
3136 end if;
3138 when Spec =>
3139 Exceptions :=
3140 Value_Of
3141 (Name_Spec,
3142 In_Arrays => Naming.Decl.Arrays,
3143 In_Tree => Data.Tree);
3145 if Exceptions = No_Array_Element then
3146 Exceptions :=
3147 Value_Of
3148 (Name_Spec,
3149 In_Arrays => Naming.Decl.Arrays,
3150 In_Tree => Data.Tree);
3151 end if;
3152 end case;
3154 while Exceptions /= No_Array_Element loop
3155 Element := Data.Tree.Array_Elements.Table (Exceptions);
3156 File_Name := Canonical_Case_File_Name (Element.Value.Value);
3158 Get_Name_String (Element.Index);
3159 To_Lower (Name_Buffer (1 .. Name_Len));
3160 Unit := Name_Find;
3161 Index := Element.Value.Index;
3163 -- For Ada, check if it is a valid unit name
3165 if Lang = Name_Ada then
3166 Get_Name_String (Element.Index);
3167 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
3169 if Unit = No_Name then
3170 Err_Vars.Error_Msg_Name_1 := Element.Index;
3171 Error_Msg
3172 (Data.Flags,
3173 "%% is not a valid unit name.",
3174 Element.Value.Location, Project);
3175 end if;
3176 end if;
3178 if Unit /= No_Name then
3179 Add_Source
3180 (Id => Source,
3181 Data => Data,
3182 Project => Project,
3183 Source_Dir_Rank => 0,
3184 Lang_Id => Lang_Id,
3185 Kind => Kind,
3186 File_Name => File_Name,
3187 Display_File => File_Name_Type (Element.Value.Value),
3188 Unit => Unit,
3189 Index => Index,
3190 Location => Element.Value.Location,
3191 Naming_Exception => True);
3192 end if;
3194 Exceptions := Element.Next;
3195 end loop;
3196 end Process_Exceptions_Unit_Based;
3198 ------------------
3199 -- Check_Naming --
3200 ------------------
3202 procedure Check_Naming is
3203 Dot_Replacement : File_Name_Type :=
3204 File_Name_Type
3205 (First_Name_Id + Character'Pos ('-'));
3206 Separate_Suffix : File_Name_Type := No_File;
3207 Casing : Casing_Type := All_Lower_Case;
3208 Casing_Defined : Boolean;
3209 Lang_Id : Language_Ptr;
3210 Sep_Suffix_Loc : Source_Ptr;
3211 Suffix : Variable_Value;
3212 Lang : Name_Id;
3214 begin
3215 Check_Common
3216 (Dot_Replacement => Dot_Replacement,
3217 Casing => Casing,
3218 Casing_Defined => Casing_Defined,
3219 Separate_Suffix => Separate_Suffix,
3220 Sep_Suffix_Loc => Sep_Suffix_Loc);
3222 -- For all unit based languages, if any, set the specified value
3223 -- of Dot_Replacement, Casing and/or Separate_Suffix. Do not
3224 -- systematically overwrite, since the defaults come from the
3225 -- configuration file.
3227 if Dot_Replacement /= No_File
3228 or else Casing_Defined
3229 or else Separate_Suffix /= No_File
3230 then
3231 Lang_Id := Project.Languages;
3232 while Lang_Id /= No_Language_Index loop
3233 if Lang_Id.Config.Kind = Unit_Based then
3234 if Dot_Replacement /= No_File then
3235 Lang_Id.Config.Naming_Data.Dot_Replacement :=
3236 Dot_Replacement;
3237 end if;
3239 if Casing_Defined then
3240 Lang_Id.Config.Naming_Data.Casing := Casing;
3241 end if;
3242 end if;
3244 Lang_Id := Lang_Id.Next;
3245 end loop;
3246 end if;
3248 -- Next, get the spec and body suffixes
3250 Lang_Id := Project.Languages;
3251 while Lang_Id /= No_Language_Index loop
3252 Lang := Lang_Id.Name;
3254 -- Spec_Suffix
3256 Suffix := Value_Of
3257 (Name => Lang,
3258 Attribute_Or_Array_Name => Name_Spec_Suffix,
3259 In_Package => Naming_Id,
3260 In_Tree => Data.Tree);
3262 if Suffix = Nil_Variable_Value then
3263 Suffix := Value_Of
3264 (Name => Lang,
3265 Attribute_Or_Array_Name => Name_Specification_Suffix,
3266 In_Package => Naming_Id,
3267 In_Tree => Data.Tree);
3268 end if;
3270 if Suffix /= Nil_Variable_Value then
3271 Lang_Id.Config.Naming_Data.Spec_Suffix :=
3272 File_Name_Type (Suffix.Value);
3274 Check_Illegal_Suffix
3275 (Project,
3276 Lang_Id.Config.Naming_Data.Spec_Suffix,
3277 Lang_Id.Config.Naming_Data.Dot_Replacement,
3278 "Spec_Suffix", Suffix.Location, Data);
3280 Write_Attr
3281 ("Spec_Suffix",
3282 Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix));
3283 end if;
3285 -- Body_Suffix
3287 Suffix :=
3288 Value_Of
3289 (Name => Lang,
3290 Attribute_Or_Array_Name => Name_Body_Suffix,
3291 In_Package => Naming_Id,
3292 In_Tree => Data.Tree);
3294 if Suffix = Nil_Variable_Value then
3295 Suffix :=
3296 Value_Of
3297 (Name => Lang,
3298 Attribute_Or_Array_Name => Name_Implementation_Suffix,
3299 In_Package => Naming_Id,
3300 In_Tree => Data.Tree);
3301 end if;
3303 if Suffix /= Nil_Variable_Value then
3304 Lang_Id.Config.Naming_Data.Body_Suffix :=
3305 File_Name_Type (Suffix.Value);
3307 -- The default value of separate suffix should be the same as
3308 -- the body suffix, so we need to compute that first.
3310 if Separate_Suffix = No_File then
3311 Lang_Id.Config.Naming_Data.Separate_Suffix :=
3312 Lang_Id.Config.Naming_Data.Body_Suffix;
3313 Write_Attr
3314 ("Sep_Suffix",
3315 Get_Name_String
3316 (Lang_Id.Config.Naming_Data.Separate_Suffix));
3317 else
3318 Lang_Id.Config.Naming_Data.Separate_Suffix :=
3319 Separate_Suffix;
3320 end if;
3322 Check_Illegal_Suffix
3323 (Project,
3324 Lang_Id.Config.Naming_Data.Body_Suffix,
3325 Lang_Id.Config.Naming_Data.Dot_Replacement,
3326 "Body_Suffix", Suffix.Location, Data);
3328 Write_Attr
3329 ("Body_Suffix",
3330 Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix));
3332 elsif Separate_Suffix /= No_File then
3333 Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix;
3334 end if;
3336 -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
3337 -- since that would cause a clear ambiguity. Note that we do allow
3338 -- a Spec_Suffix to have the same termination as one of these,
3339 -- which causes a potential ambiguity, but we resolve that by
3340 -- matching the longest possible suffix.
3342 if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
3343 and then Lang_Id.Config.Naming_Data.Spec_Suffix =
3344 Lang_Id.Config.Naming_Data.Body_Suffix
3345 then
3346 Error_Msg
3347 (Data.Flags,
3348 "Body_Suffix ("""
3349 & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)
3350 & """) cannot be the same as Spec_Suffix.",
3351 Ada_Body_Suffix_Loc, Project);
3352 end if;
3354 if Lang_Id.Config.Naming_Data.Body_Suffix /=
3355 Lang_Id.Config.Naming_Data.Separate_Suffix
3356 and then Lang_Id.Config.Naming_Data.Spec_Suffix =
3357 Lang_Id.Config.Naming_Data.Separate_Suffix
3358 then
3359 Error_Msg
3360 (Data.Flags,
3361 "Separate_Suffix ("""
3362 & Get_Name_String
3363 (Lang_Id.Config.Naming_Data.Separate_Suffix)
3364 & """) cannot be the same as Spec_Suffix.",
3365 Sep_Suffix_Loc, Project);
3366 end if;
3368 Lang_Id := Lang_Id.Next;
3369 end loop;
3371 -- Get the naming exceptions for all languages
3373 for Kind in Spec_Or_Body loop
3374 Lang_Id := Project.Languages;
3375 while Lang_Id /= No_Language_Index loop
3376 case Lang_Id.Config.Kind is
3377 when File_Based =>
3378 Process_Exceptions_File_Based (Lang_Id, Kind);
3380 when Unit_Based =>
3381 Process_Exceptions_Unit_Based (Lang_Id, Kind);
3382 end case;
3384 Lang_Id := Lang_Id.Next;
3385 end loop;
3386 end loop;
3387 end Check_Naming;
3389 ----------------------------
3390 -- Initialize_Naming_Data --
3391 ----------------------------
3393 procedure Initialize_Naming_Data is
3394 Specs : Array_Element_Id :=
3395 Util.Value_Of
3396 (Name_Spec_Suffix,
3397 Naming.Decl.Arrays,
3398 Data.Tree);
3400 Impls : Array_Element_Id :=
3401 Util.Value_Of
3402 (Name_Body_Suffix,
3403 Naming.Decl.Arrays,
3404 Data.Tree);
3406 Lang : Language_Ptr;
3407 Lang_Name : Name_Id;
3408 Value : Variable_Value;
3409 Extended : Project_Id;
3411 begin
3412 -- At this stage, the project already contains the default extensions
3413 -- for the various languages. We now merge those suffixes read in the
3414 -- user project, and they override the default.
3416 while Specs /= No_Array_Element loop
3417 Lang_Name := Data.Tree.Array_Elements.Table (Specs).Index;
3418 Lang :=
3419 Get_Language_From_Name
3420 (Project, Name => Get_Name_String (Lang_Name));
3422 -- An extending project inherits its parent projects' languages
3423 -- so if needed we should create entries for those languages
3425 if Lang = null then
3426 Extended := Project.Extends;
3427 while Extended /= null loop
3428 Lang := Get_Language_From_Name
3429 (Extended, Name => Get_Name_String (Lang_Name));
3430 exit when Lang /= null;
3432 Extended := Extended.Extends;
3433 end loop;
3435 if Lang /= null then
3436 Lang := new Language_Data'(Lang.all);
3437 Lang.First_Source := null;
3438 Lang.Next := Project.Languages;
3439 Project.Languages := Lang;
3440 end if;
3441 end if;
3443 -- If language was not found in project or the projects it extends
3445 if Lang = null then
3446 if Current_Verbosity = High then
3447 Write_Line
3448 ("Ignoring spec naming data for "
3449 & Get_Name_String (Lang_Name)
3450 & " since language is not defined for this project");
3451 end if;
3453 else
3454 Value := Data.Tree.Array_Elements.Table (Specs).Value;
3456 if Value.Kind = Single then
3457 Lang.Config.Naming_Data.Spec_Suffix :=
3458 Canonical_Case_File_Name (Value.Value);
3459 end if;
3460 end if;
3462 Specs := Data.Tree.Array_Elements.Table (Specs).Next;
3463 end loop;
3465 while Impls /= No_Array_Element loop
3466 Lang_Name := Data.Tree.Array_Elements.Table (Impls).Index;
3467 Lang :=
3468 Get_Language_From_Name
3469 (Project, Name => Get_Name_String (Lang_Name));
3471 if Lang = null then
3472 if Current_Verbosity = High then
3473 Write_Line
3474 ("Ignoring impl naming data for "
3475 & Get_Name_String (Lang_Name)
3476 & " since language is not defined for this project");
3477 end if;
3478 else
3479 Value := Data.Tree.Array_Elements.Table (Impls).Value;
3481 if Lang.Name = Name_Ada then
3482 Ada_Body_Suffix_Loc := Value.Location;
3483 end if;
3485 if Value.Kind = Single then
3486 Lang.Config.Naming_Data.Body_Suffix :=
3487 Canonical_Case_File_Name (Value.Value);
3488 end if;
3489 end if;
3491 Impls := Data.Tree.Array_Elements.Table (Impls).Next;
3492 end loop;
3493 end Initialize_Naming_Data;
3495 -- Start of processing for Check_Naming_Schemes
3497 begin
3498 -- No Naming package or parsing a configuration file? nothing to do
3500 if Naming_Id /= No_Package
3501 and then Project.Qualifier /= Configuration
3502 then
3503 Naming := Data.Tree.Packages.Table (Naming_Id);
3505 if Current_Verbosity = High then
3506 Write_Line ("Checking package Naming for project "
3507 & Get_Name_String (Project.Name));
3508 end if;
3510 Initialize_Naming_Data;
3511 Check_Naming;
3512 end if;
3513 end Check_Package_Naming;
3515 ------------------------------
3516 -- Check_Library_Attributes --
3517 ------------------------------
3519 procedure Check_Library_Attributes
3520 (Project : Project_Id;
3521 Data : in out Tree_Processing_Data)
3523 Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
3525 Lib_Dir : constant Prj.Variable_Value :=
3526 Prj.Util.Value_Of
3527 (Snames.Name_Library_Dir, Attributes, Data.Tree);
3529 Lib_Name : constant Prj.Variable_Value :=
3530 Prj.Util.Value_Of
3531 (Snames.Name_Library_Name, Attributes, Data.Tree);
3533 Lib_Version : constant Prj.Variable_Value :=
3534 Prj.Util.Value_Of
3535 (Snames.Name_Library_Version, Attributes, Data.Tree);
3537 Lib_ALI_Dir : constant Prj.Variable_Value :=
3538 Prj.Util.Value_Of
3539 (Snames.Name_Library_Ali_Dir, Attributes, Data.Tree);
3541 Lib_GCC : constant Prj.Variable_Value :=
3542 Prj.Util.Value_Of
3543 (Snames.Name_Library_GCC, Attributes, Data.Tree);
3545 The_Lib_Kind : constant Prj.Variable_Value :=
3546 Prj.Util.Value_Of
3547 (Snames.Name_Library_Kind, Attributes, Data.Tree);
3549 Imported_Project_List : Project_List;
3551 Continuation : String_Access := No_Continuation_String'Access;
3553 Support_For_Libraries : Library_Support;
3555 Library_Directory_Present : Boolean;
3557 procedure Check_Library (Proj : Project_Id; Extends : Boolean);
3558 -- Check if an imported or extended project if also a library project
3560 -------------------
3561 -- Check_Library --
3562 -------------------
3564 procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
3565 Src_Id : Source_Id;
3566 Iter : Source_Iterator;
3568 begin
3569 if Proj /= No_Project then
3570 if not Proj.Library then
3572 -- The only not library projects that are OK are those that
3573 -- have no sources. However, header files from non-Ada
3574 -- languages are OK, as there is nothing to compile.
3576 Iter := For_Each_Source (Data.Tree, Proj);
3577 loop
3578 Src_Id := Prj.Element (Iter);
3579 exit when Src_Id = No_Source
3580 or else Src_Id.Language.Config.Kind /= File_Based
3581 or else Src_Id.Kind /= Spec;
3582 Next (Iter);
3583 end loop;
3585 if Src_Id /= No_Source then
3586 Error_Msg_Name_1 := Project.Name;
3587 Error_Msg_Name_2 := Proj.Name;
3589 if Extends then
3590 if Project.Library_Kind /= Static then
3591 Error_Msg
3592 (Data.Flags,
3593 Continuation.all &
3594 "shared library project %% cannot extend " &
3595 "project %% that is not a library project",
3596 Project.Location, Project);
3597 Continuation := Continuation_String'Access;
3598 end if;
3600 elsif (not Unchecked_Shared_Lib_Imports)
3601 and then Project.Library_Kind /= Static
3602 then
3603 Error_Msg
3604 (Data.Flags,
3605 Continuation.all &
3606 "shared library project %% cannot import project %% " &
3607 "that is not a shared library project",
3608 Project.Location, Project);
3609 Continuation := Continuation_String'Access;
3610 end if;
3611 end if;
3613 elsif Project.Library_Kind /= Static and then
3614 Proj.Library_Kind = Static
3615 then
3616 Error_Msg_Name_1 := Project.Name;
3617 Error_Msg_Name_2 := Proj.Name;
3619 if Extends then
3620 Error_Msg
3621 (Data.Flags,
3622 Continuation.all &
3623 "shared library project %% cannot extend static " &
3624 "library project %%",
3625 Project.Location, Project);
3626 Continuation := Continuation_String'Access;
3628 elsif not Unchecked_Shared_Lib_Imports then
3629 Error_Msg
3630 (Data.Flags,
3631 Continuation.all &
3632 "shared library project %% cannot import static " &
3633 "library project %%",
3634 Project.Location, Project);
3635 Continuation := Continuation_String'Access;
3636 end if;
3638 end if;
3639 end if;
3640 end Check_Library;
3642 Dir_Exists : Boolean;
3644 -- Start of processing for Check_Library_Attributes
3646 begin
3647 Library_Directory_Present := Lib_Dir.Value /= Empty_String;
3649 -- Special case of extending project
3651 if Project.Extends /= No_Project then
3653 -- If the project extended is a library project, we inherit the
3654 -- library name, if it is not redefined; we check that the library
3655 -- directory is specified.
3657 if Project.Extends.Library then
3658 if Project.Qualifier = Standard then
3659 Error_Msg
3660 (Data.Flags,
3661 "a standard project cannot extend a library project",
3662 Project.Location, Project);
3664 else
3665 if Lib_Name.Default then
3666 Project.Library_Name := Project.Extends.Library_Name;
3667 end if;
3669 if Lib_Dir.Default then
3670 if not Project.Virtual then
3671 Error_Msg
3672 (Data.Flags,
3673 "a project extending a library project must " &
3674 "specify an attribute Library_Dir",
3675 Project.Location, Project);
3677 else
3678 -- For a virtual project extending a library project,
3679 -- inherit library directory.
3681 Project.Library_Dir := Project.Extends.Library_Dir;
3682 Library_Directory_Present := True;
3683 end if;
3684 end if;
3685 end if;
3686 end if;
3687 end if;
3689 pragma Assert (Lib_Name.Kind = Single);
3691 if Lib_Name.Value = Empty_String then
3692 if Current_Verbosity = High
3693 and then Project.Library_Name = No_Name
3694 then
3695 Write_Line ("No library name");
3696 end if;
3698 else
3699 -- There is no restriction on the syntax of library names
3701 Project.Library_Name := Lib_Name.Value;
3702 end if;
3704 if Project.Library_Name /= No_Name then
3705 if Current_Verbosity = High then
3706 Write_Attr
3707 ("Library name", Get_Name_String (Project.Library_Name));
3708 end if;
3710 pragma Assert (Lib_Dir.Kind = Single);
3712 if not Library_Directory_Present then
3713 if Current_Verbosity = High then
3714 Write_Line ("No library directory");
3715 end if;
3717 else
3718 -- Find path name (unless inherited), check that it is a directory
3720 if Project.Library_Dir = No_Path_Information then
3721 Locate_Directory
3722 (Project,
3723 File_Name_Type (Lib_Dir.Value),
3724 Path => Project.Library_Dir,
3725 Dir_Exists => Dir_Exists,
3726 Data => Data,
3727 Create => "library",
3728 Must_Exist => False,
3729 Location => Lib_Dir.Location,
3730 Externally_Built => Project.Externally_Built);
3732 else
3733 Dir_Exists :=
3734 Is_Directory
3735 (Get_Name_String
3736 (Project.Library_Dir.Display_Name));
3737 end if;
3739 if not Dir_Exists then
3741 -- Get the absolute name of the library directory that
3742 -- does not exist, to report an error.
3744 Err_Vars.Error_Msg_File_1 :=
3745 File_Name_Type (Project.Library_Dir.Display_Name);
3746 Error_Msg
3747 (Data.Flags,
3748 "library directory { does not exist",
3749 Lib_Dir.Location, Project);
3751 elsif not Project.Externally_Built then
3753 -- The library directory cannot be the same as the Object
3754 -- directory.
3756 if Project.Library_Dir.Name = Project.Object_Directory.Name then
3757 Error_Msg
3758 (Data.Flags,
3759 "library directory cannot be the same " &
3760 "as object directory",
3761 Lib_Dir.Location, Project);
3762 Project.Library_Dir := No_Path_Information;
3764 else
3765 declare
3766 OK : Boolean := True;
3767 Dirs_Id : String_List_Id;
3768 Dir_Elem : String_Element;
3769 Pid : Project_List;
3771 begin
3772 -- The library directory cannot be the same as a source
3773 -- directory of the current project.
3775 Dirs_Id := Project.Source_Dirs;
3776 while Dirs_Id /= Nil_String loop
3777 Dir_Elem := Data.Tree.String_Elements.Table (Dirs_Id);
3778 Dirs_Id := Dir_Elem.Next;
3780 if Project.Library_Dir.Name =
3781 Path_Name_Type (Dir_Elem.Value)
3782 then
3783 Err_Vars.Error_Msg_File_1 :=
3784 File_Name_Type (Dir_Elem.Value);
3785 Error_Msg
3786 (Data.Flags,
3787 "library directory cannot be the same " &
3788 "as source directory {",
3789 Lib_Dir.Location, Project);
3790 OK := False;
3791 exit;
3792 end if;
3793 end loop;
3795 if OK then
3797 -- The library directory cannot be the same as a
3798 -- source directory of another project either.
3800 Pid := Data.Tree.Projects;
3801 Project_Loop : loop
3802 exit Project_Loop when Pid = null;
3804 if Pid.Project /= Project then
3805 Dirs_Id := Pid.Project.Source_Dirs;
3807 Dir_Loop : while Dirs_Id /= Nil_String loop
3808 Dir_Elem :=
3809 Data.Tree.String_Elements.Table (Dirs_Id);
3810 Dirs_Id := Dir_Elem.Next;
3812 if Project.Library_Dir.Name =
3813 Path_Name_Type (Dir_Elem.Value)
3814 then
3815 Err_Vars.Error_Msg_File_1 :=
3816 File_Name_Type (Dir_Elem.Value);
3817 Err_Vars.Error_Msg_Name_1 :=
3818 Pid.Project.Name;
3820 Error_Msg
3821 (Data.Flags,
3822 "library directory cannot be the same" &
3823 " as source directory { of project %%",
3824 Lib_Dir.Location, Project);
3825 OK := False;
3826 exit Project_Loop;
3827 end if;
3828 end loop Dir_Loop;
3829 end if;
3831 Pid := Pid.Next;
3832 end loop Project_Loop;
3833 end if;
3835 if not OK then
3836 Project.Library_Dir := No_Path_Information;
3838 elsif Current_Verbosity = High then
3840 -- Display the Library directory in high verbosity
3842 Write_Attr
3843 ("Library directory",
3844 Get_Name_String (Project.Library_Dir.Display_Name));
3845 end if;
3846 end;
3847 end if;
3848 end if;
3849 end if;
3851 end if;
3853 Project.Library :=
3854 Project.Library_Dir /= No_Path_Information
3855 and then Project.Library_Name /= No_Name;
3857 if Project.Extends = No_Project then
3858 case Project.Qualifier is
3859 when Standard =>
3860 if Project.Library then
3861 Error_Msg
3862 (Data.Flags,
3863 "a standard project cannot be a library project",
3864 Lib_Name.Location, Project);
3865 end if;
3867 when Library =>
3868 if not Project.Library then
3869 if Project.Library_Dir = No_Path_Information then
3870 Error_Msg
3871 (Data.Flags,
3872 "\attribute Library_Dir not declared",
3873 Project.Location, Project);
3874 end if;
3876 if Project.Library_Name = No_Name then
3877 Error_Msg
3878 (Data.Flags,
3879 "\attribute Library_Name not declared",
3880 Project.Location, Project);
3881 end if;
3882 end if;
3884 when others =>
3885 null;
3887 end case;
3888 end if;
3890 if Project.Library then
3891 Support_For_Libraries := Project.Config.Lib_Support;
3893 if Support_For_Libraries = Prj.None then
3894 Error_Msg
3895 (Data.Flags,
3896 "?libraries are not supported on this platform",
3897 Lib_Name.Location, Project);
3898 Project.Library := False;
3900 else
3901 if Lib_ALI_Dir.Value = Empty_String then
3902 if Current_Verbosity = High then
3903 Write_Line ("No library ALI directory specified");
3904 end if;
3906 Project.Library_ALI_Dir := Project.Library_Dir;
3908 else
3909 -- Find path name, check that it is a directory
3911 Locate_Directory
3912 (Project,
3913 File_Name_Type (Lib_ALI_Dir.Value),
3914 Path => Project.Library_ALI_Dir,
3915 Create => "library ALI",
3916 Dir_Exists => Dir_Exists,
3917 Data => Data,
3918 Must_Exist => False,
3919 Location => Lib_ALI_Dir.Location,
3920 Externally_Built => Project.Externally_Built);
3922 if not Dir_Exists then
3924 -- Get the absolute name of the library ALI directory that
3925 -- does not exist, to report an error.
3927 Err_Vars.Error_Msg_File_1 :=
3928 File_Name_Type (Project.Library_ALI_Dir.Display_Name);
3929 Error_Msg
3930 (Data.Flags,
3931 "library 'A'L'I directory { does not exist",
3932 Lib_ALI_Dir.Location, Project);
3933 end if;
3935 if (not Project.Externally_Built) and then
3936 Project.Library_ALI_Dir /= Project.Library_Dir
3937 then
3938 -- The library ALI directory cannot be the same as the
3939 -- Object directory.
3941 if Project.Library_ALI_Dir = Project.Object_Directory then
3942 Error_Msg
3943 (Data.Flags,
3944 "library 'A'L'I directory cannot be the same " &
3945 "as object directory",
3946 Lib_ALI_Dir.Location, Project);
3947 Project.Library_ALI_Dir := No_Path_Information;
3949 else
3950 declare
3951 OK : Boolean := True;
3952 Dirs_Id : String_List_Id;
3953 Dir_Elem : String_Element;
3954 Pid : Project_List;
3956 begin
3957 -- The library ALI directory cannot be the same as
3958 -- a source directory of the current project.
3960 Dirs_Id := Project.Source_Dirs;
3961 while Dirs_Id /= Nil_String loop
3962 Dir_Elem :=
3963 Data.Tree.String_Elements.Table (Dirs_Id);
3964 Dirs_Id := Dir_Elem.Next;
3966 if Project.Library_ALI_Dir.Name =
3967 Path_Name_Type (Dir_Elem.Value)
3968 then
3969 Err_Vars.Error_Msg_File_1 :=
3970 File_Name_Type (Dir_Elem.Value);
3971 Error_Msg
3972 (Data.Flags,
3973 "library 'A'L'I directory cannot be " &
3974 "the same as source directory {",
3975 Lib_ALI_Dir.Location, Project);
3976 OK := False;
3977 exit;
3978 end if;
3979 end loop;
3981 if OK then
3983 -- The library ALI directory cannot be the same as
3984 -- a source directory of another project either.
3986 Pid := Data.Tree.Projects;
3987 ALI_Project_Loop : loop
3988 exit ALI_Project_Loop when Pid = null;
3990 if Pid.Project /= Project then
3991 Dirs_Id := Pid.Project.Source_Dirs;
3993 ALI_Dir_Loop :
3994 while Dirs_Id /= Nil_String loop
3995 Dir_Elem :=
3996 Data.Tree.String_Elements.Table
3997 (Dirs_Id);
3998 Dirs_Id := Dir_Elem.Next;
4000 if Project.Library_ALI_Dir.Name =
4001 Path_Name_Type (Dir_Elem.Value)
4002 then
4003 Err_Vars.Error_Msg_File_1 :=
4004 File_Name_Type (Dir_Elem.Value);
4005 Err_Vars.Error_Msg_Name_1 :=
4006 Pid.Project.Name;
4008 Error_Msg
4009 (Data.Flags,
4010 "library 'A'L'I directory cannot " &
4011 "be the same as source directory " &
4012 "{ of project %%",
4013 Lib_ALI_Dir.Location, Project);
4014 OK := False;
4015 exit ALI_Project_Loop;
4016 end if;
4017 end loop ALI_Dir_Loop;
4018 end if;
4019 Pid := Pid.Next;
4020 end loop ALI_Project_Loop;
4021 end if;
4023 if not OK then
4024 Project.Library_ALI_Dir := No_Path_Information;
4026 elsif Current_Verbosity = High then
4028 -- Display Library ALI directory in high verbosity
4030 Write_Attr
4031 ("Library ALI dir",
4032 Get_Name_String
4033 (Project.Library_ALI_Dir.Display_Name));
4034 end if;
4035 end;
4036 end if;
4037 end if;
4038 end if;
4040 pragma Assert (Lib_Version.Kind = Single);
4042 if Lib_Version.Value = Empty_String then
4043 if Current_Verbosity = High then
4044 Write_Line ("No library version specified");
4045 end if;
4047 else
4048 Project.Lib_Internal_Name := Lib_Version.Value;
4049 end if;
4051 pragma Assert (The_Lib_Kind.Kind = Single);
4053 if The_Lib_Kind.Value = Empty_String then
4054 if Current_Verbosity = High then
4055 Write_Line ("No library kind specified");
4056 end if;
4058 else
4059 Get_Name_String (The_Lib_Kind.Value);
4061 declare
4062 Kind_Name : constant String :=
4063 To_Lower (Name_Buffer (1 .. Name_Len));
4065 OK : Boolean := True;
4067 begin
4068 if Kind_Name = "static" then
4069 Project.Library_Kind := Static;
4071 elsif Kind_Name = "dynamic" then
4072 Project.Library_Kind := Dynamic;
4074 elsif Kind_Name = "relocatable" then
4075 Project.Library_Kind := Relocatable;
4077 else
4078 Error_Msg
4079 (Data.Flags,
4080 "illegal value for Library_Kind",
4081 The_Lib_Kind.Location, Project);
4082 OK := False;
4083 end if;
4085 if Current_Verbosity = High and then OK then
4086 Write_Attr ("Library kind", Kind_Name);
4087 end if;
4089 if Project.Library_Kind /= Static then
4090 if Support_For_Libraries = Prj.Static_Only then
4091 Error_Msg
4092 (Data.Flags,
4093 "only static libraries are supported " &
4094 "on this platform",
4095 The_Lib_Kind.Location, Project);
4096 Project.Library := False;
4098 else
4099 -- Check if (obsolescent) attribute Library_GCC or
4100 -- Linker'Driver is declared.
4102 if Lib_GCC.Value /= Empty_String then
4103 Error_Msg
4104 (Data.Flags,
4105 "?Library_'G'C'C is an obsolescent attribute, " &
4106 "use Linker''Driver instead",
4107 Lib_GCC.Location, Project);
4108 Project.Config.Shared_Lib_Driver :=
4109 File_Name_Type (Lib_GCC.Value);
4111 else
4112 declare
4113 Linker : constant Package_Id :=
4114 Value_Of
4115 (Name_Linker,
4116 Project.Decl.Packages,
4117 Data.Tree);
4118 Driver : constant Variable_Value :=
4119 Value_Of
4120 (Name => No_Name,
4121 Attribute_Or_Array_Name =>
4122 Name_Driver,
4123 In_Package => Linker,
4124 In_Tree => Data.Tree);
4126 begin
4127 if Driver /= Nil_Variable_Value
4128 and then Driver.Value /= Empty_String
4129 then
4130 Project.Config.Shared_Lib_Driver :=
4131 File_Name_Type (Driver.Value);
4132 end if;
4133 end;
4134 end if;
4135 end if;
4136 end if;
4137 end;
4138 end if;
4140 if Project.Library then
4141 if Current_Verbosity = High then
4142 Write_Line ("This is a library project file");
4143 end if;
4145 Check_Library (Project.Extends, Extends => True);
4147 Imported_Project_List := Project.Imported_Projects;
4148 while Imported_Project_List /= null loop
4149 Check_Library
4150 (Imported_Project_List.Project,
4151 Extends => False);
4152 Imported_Project_List := Imported_Project_List.Next;
4153 end loop;
4154 end if;
4156 end if;
4157 end if;
4159 -- Check if Linker'Switches or Linker'Default_Switches are declared.
4160 -- Warn if they are declared, as it is a common error to think that
4161 -- library are "linked" with Linker switches.
4163 if Project.Library then
4164 declare
4165 Linker_Package_Id : constant Package_Id :=
4166 Util.Value_Of
4167 (Name_Linker,
4168 Project.Decl.Packages, Data.Tree);
4169 Linker_Package : Package_Element;
4170 Switches : Array_Element_Id := No_Array_Element;
4172 begin
4173 if Linker_Package_Id /= No_Package then
4174 Linker_Package := Data.Tree.Packages.Table (Linker_Package_Id);
4176 Switches :=
4177 Value_Of
4178 (Name => Name_Switches,
4179 In_Arrays => Linker_Package.Decl.Arrays,
4180 In_Tree => Data.Tree);
4182 if Switches = No_Array_Element then
4183 Switches :=
4184 Value_Of
4185 (Name => Name_Default_Switches,
4186 In_Arrays => Linker_Package.Decl.Arrays,
4187 In_Tree => Data.Tree);
4188 end if;
4190 if Switches /= No_Array_Element then
4191 Error_Msg
4192 (Data.Flags,
4193 "?Linker switches not taken into account in library " &
4194 "projects",
4195 No_Location, Project);
4196 end if;
4197 end if;
4198 end;
4199 end if;
4201 if Project.Extends /= No_Project and then Project.Extends.Library then
4203 -- Remove the library name from Lib_Data_Table
4205 for J in 1 .. Lib_Data_Table.Last loop
4206 if Lib_Data_Table.Table (J).Proj = Project.Extends then
4207 Lib_Data_Table.Table (J) :=
4208 Lib_Data_Table.Table (Lib_Data_Table.Last);
4209 Lib_Data_Table.Set_Last (Lib_Data_Table.Last - 1);
4210 exit;
4211 end if;
4212 end loop;
4214 Project.Extends.Library := False;
4215 end if;
4217 if Project.Library and then not Lib_Name.Default then
4219 -- Check if the same library name is used in an other library project
4221 for J in 1 .. Lib_Data_Table.Last loop
4222 if Lib_Data_Table.Table (J).Name = Project.Library_Name then
4223 Error_Msg_Name_1 := Lib_Data_Table.Table (J).Proj.Name;
4224 Error_Msg
4225 (Data.Flags,
4226 "Library name cannot be the same as in project %%",
4227 Lib_Name.Location, Project);
4228 Project.Library := False;
4229 exit;
4230 end if;
4231 end loop;
4232 end if;
4234 if Project.Library then
4236 -- Record the library name
4238 Lib_Data_Table.Append
4239 ((Name => Project.Library_Name, Proj => Project));
4240 end if;
4241 end Check_Library_Attributes;
4243 ---------------------------------
4244 -- Check_Programming_Languages --
4245 ---------------------------------
4247 procedure Check_Programming_Languages
4248 (Project : Project_Id;
4249 Data : in out Tree_Processing_Data)
4251 Languages : Variable_Value := Nil_Variable_Value;
4252 Def_Lang : Variable_Value := Nil_Variable_Value;
4253 Def_Lang_Id : Name_Id;
4255 procedure Add_Language (Name, Display_Name : Name_Id);
4256 -- Add a new language to the list of languages for the project.
4257 -- Nothing is done if the language has already been defined
4259 ------------------
4260 -- Add_Language --
4261 ------------------
4263 procedure Add_Language (Name, Display_Name : Name_Id) is
4264 Lang : Language_Ptr;
4266 begin
4267 Lang := Project.Languages;
4268 while Lang /= No_Language_Index loop
4269 if Name = Lang.Name then
4270 return;
4271 end if;
4273 Lang := Lang.Next;
4274 end loop;
4276 Lang := new Language_Data'(No_Language_Data);
4277 Lang.Next := Project.Languages;
4278 Project.Languages := Lang;
4279 Lang.Name := Name;
4280 Lang.Display_Name := Display_Name;
4282 if Name = Name_Ada then
4283 Lang.Config.Kind := Unit_Based;
4284 Lang.Config.Dependency_Kind := ALI_File;
4285 else
4286 Lang.Config.Kind := File_Based;
4287 end if;
4288 end Add_Language;
4290 -- Start of processing for Check_Programming_Languages
4292 begin
4293 Project.Languages := null;
4294 Languages :=
4295 Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Data.Tree);
4296 Def_Lang :=
4297 Prj.Util.Value_Of
4298 (Name_Default_Language, Project.Decl.Attributes, Data.Tree);
4300 if Project.Source_Dirs /= Nil_String then
4302 -- Check if languages are specified in this project
4304 if Languages.Default then
4306 -- Fail if there is no default language defined
4308 if Def_Lang.Default then
4309 Error_Msg
4310 (Data.Flags,
4311 "no languages defined for this project",
4312 Project.Location, Project);
4313 Def_Lang_Id := No_Name;
4315 else
4316 Get_Name_String (Def_Lang.Value);
4317 To_Lower (Name_Buffer (1 .. Name_Len));
4318 Def_Lang_Id := Name_Find;
4319 end if;
4321 if Def_Lang_Id /= No_Name then
4322 Get_Name_String (Def_Lang_Id);
4323 Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
4324 Add_Language
4325 (Name => Def_Lang_Id,
4326 Display_Name => Name_Find);
4327 end if;
4329 else
4330 declare
4331 Current : String_List_Id := Languages.Values;
4332 Element : String_Element;
4334 begin
4335 -- If there are no languages declared, there are no sources
4337 if Current = Nil_String then
4338 Project.Source_Dirs := Nil_String;
4340 if Project.Qualifier = Standard then
4341 Error_Msg
4342 (Data.Flags,
4343 "a standard project must have at least one language",
4344 Languages.Location, Project);
4345 end if;
4347 else
4348 -- Look through all the languages specified in attribute
4349 -- Languages.
4351 while Current /= Nil_String loop
4352 Element := Data.Tree.String_Elements.Table (Current);
4353 Get_Name_String (Element.Value);
4354 To_Lower (Name_Buffer (1 .. Name_Len));
4356 Add_Language
4357 (Name => Name_Find,
4358 Display_Name => Element.Value);
4360 Current := Element.Next;
4361 end loop;
4362 end if;
4363 end;
4364 end if;
4365 end if;
4366 end Check_Programming_Languages;
4368 -------------------------------
4369 -- Check_Stand_Alone_Library --
4370 -------------------------------
4372 procedure Check_Stand_Alone_Library
4373 (Project : Project_Id;
4374 Data : in out Tree_Processing_Data)
4376 Lib_Interfaces : constant Prj.Variable_Value :=
4377 Prj.Util.Value_Of
4378 (Snames.Name_Library_Interface,
4379 Project.Decl.Attributes,
4380 Data.Tree);
4382 Lib_Auto_Init : constant Prj.Variable_Value :=
4383 Prj.Util.Value_Of
4384 (Snames.Name_Library_Auto_Init,
4385 Project.Decl.Attributes,
4386 Data.Tree);
4388 Lib_Src_Dir : constant Prj.Variable_Value :=
4389 Prj.Util.Value_Of
4390 (Snames.Name_Library_Src_Dir,
4391 Project.Decl.Attributes,
4392 Data.Tree);
4394 Lib_Symbol_File : constant Prj.Variable_Value :=
4395 Prj.Util.Value_Of
4396 (Snames.Name_Library_Symbol_File,
4397 Project.Decl.Attributes,
4398 Data.Tree);
4400 Lib_Symbol_Policy : constant Prj.Variable_Value :=
4401 Prj.Util.Value_Of
4402 (Snames.Name_Library_Symbol_Policy,
4403 Project.Decl.Attributes,
4404 Data.Tree);
4406 Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
4407 Prj.Util.Value_Of
4408 (Snames.Name_Library_Reference_Symbol_File,
4409 Project.Decl.Attributes,
4410 Data.Tree);
4412 Auto_Init_Supported : Boolean;
4413 OK : Boolean := True;
4414 Source : Source_Id;
4415 Next_Proj : Project_Id;
4416 Iter : Source_Iterator;
4418 begin
4419 Auto_Init_Supported := Project.Config.Auto_Init_Supported;
4421 pragma Assert (Lib_Interfaces.Kind = List);
4423 -- It is a stand-alone library project file if attribute
4424 -- Library_Interface is defined.
4426 if not Lib_Interfaces.Default then
4427 declare
4428 Interfaces : String_List_Id := Lib_Interfaces.Values;
4429 Interface_ALIs : String_List_Id := Nil_String;
4430 Unit : Name_Id;
4432 begin
4433 Project.Standalone_Library := True;
4435 -- Library_Interface cannot be an empty list
4437 if Interfaces = Nil_String then
4438 Error_Msg
4439 (Data.Flags,
4440 "Library_Interface cannot be an empty list",
4441 Lib_Interfaces.Location, Project);
4442 end if;
4444 -- Process each unit name specified in the attribute
4445 -- Library_Interface.
4447 while Interfaces /= Nil_String loop
4448 Get_Name_String
4449 (Data.Tree.String_Elements.Table (Interfaces).Value);
4450 To_Lower (Name_Buffer (1 .. Name_Len));
4452 if Name_Len = 0 then
4453 Error_Msg
4454 (Data.Flags,
4455 "an interface cannot be an empty string",
4456 Data.Tree.String_Elements.Table (Interfaces).Location,
4457 Project);
4459 else
4460 Unit := Name_Find;
4461 Error_Msg_Name_1 := Unit;
4463 Next_Proj := Project.Extends;
4464 Iter := For_Each_Source (Data.Tree, Project);
4465 loop
4466 while Prj.Element (Iter) /= No_Source
4467 and then
4468 (Prj.Element (Iter).Unit = null
4469 or else Prj.Element (Iter).Unit.Name /= Unit)
4470 loop
4471 Next (Iter);
4472 end loop;
4474 Source := Prj.Element (Iter);
4475 exit when Source /= No_Source
4476 or else Next_Proj = No_Project;
4478 Iter := For_Each_Source (Data.Tree, Next_Proj);
4479 Next_Proj := Next_Proj.Extends;
4480 end loop;
4482 if Source /= No_Source then
4483 if Source.Kind = Sep then
4484 Source := No_Source;
4486 elsif Source.Kind = Spec
4487 and then Other_Part (Source) /= No_Source
4488 then
4489 Source := Other_Part (Source);
4490 end if;
4491 end if;
4493 if Source /= No_Source then
4494 if Source.Project /= Project
4495 and then not Is_Extending (Project, Source.Project)
4496 then
4497 Source := No_Source;
4498 end if;
4499 end if;
4501 if Source = No_Source then
4502 Error_Msg
4503 (Data.Flags,
4504 "%% is not a unit of this project",
4505 Data.Tree.String_Elements.Table
4506 (Interfaces).Location, Project);
4508 else
4509 if Source.Kind = Spec
4510 and then Other_Part (Source) /= No_Source
4511 then
4512 Source := Other_Part (Source);
4513 end if;
4515 String_Element_Table.Increment_Last
4516 (Data.Tree.String_Elements);
4518 Data.Tree.String_Elements.Table
4519 (String_Element_Table.Last
4520 (Data.Tree.String_Elements)) :=
4521 (Value => Name_Id (Source.Dep_Name),
4522 Index => 0,
4523 Display_Value => Name_Id (Source.Dep_Name),
4524 Location =>
4525 Data.Tree.String_Elements.Table
4526 (Interfaces).Location,
4527 Flag => False,
4528 Next => Interface_ALIs);
4530 Interface_ALIs :=
4531 String_Element_Table.Last
4532 (Data.Tree.String_Elements);
4533 end if;
4534 end if;
4536 Interfaces := Data.Tree.String_Elements.Table (Interfaces).Next;
4537 end loop;
4539 -- Put the list of Interface ALIs in the project data
4541 Project.Lib_Interface_ALIs := Interface_ALIs;
4543 -- Check value of attribute Library_Auto_Init and set
4544 -- Lib_Auto_Init accordingly.
4546 if Lib_Auto_Init.Default then
4548 -- If no attribute Library_Auto_Init is declared, then set auto
4549 -- init only if it is supported.
4551 Project.Lib_Auto_Init := Auto_Init_Supported;
4553 else
4554 Get_Name_String (Lib_Auto_Init.Value);
4555 To_Lower (Name_Buffer (1 .. Name_Len));
4557 if Name_Buffer (1 .. Name_Len) = "false" then
4558 Project.Lib_Auto_Init := False;
4560 elsif Name_Buffer (1 .. Name_Len) = "true" then
4561 if Auto_Init_Supported then
4562 Project.Lib_Auto_Init := True;
4564 else
4565 -- Library_Auto_Init cannot be "true" if auto init is not
4566 -- supported.
4568 Error_Msg
4569 (Data.Flags,
4570 "library auto init not supported " &
4571 "on this platform",
4572 Lib_Auto_Init.Location, Project);
4573 end if;
4575 else
4576 Error_Msg
4577 (Data.Flags,
4578 "invalid value for attribute Library_Auto_Init",
4579 Lib_Auto_Init.Location, Project);
4580 end if;
4581 end if;
4582 end;
4584 -- If attribute Library_Src_Dir is defined and not the empty string,
4585 -- check if the directory exist and is not the object directory or
4586 -- one of the source directories. This is the directory where copies
4587 -- of the interface sources will be copied. Note that this directory
4588 -- may be the library directory.
4590 if Lib_Src_Dir.Value /= Empty_String then
4591 declare
4592 Dir_Id : constant File_Name_Type :=
4593 File_Name_Type (Lib_Src_Dir.Value);
4594 Dir_Exists : Boolean;
4596 begin
4597 Locate_Directory
4598 (Project,
4599 Dir_Id,
4600 Path => Project.Library_Src_Dir,
4601 Dir_Exists => Dir_Exists,
4602 Data => Data,
4603 Must_Exist => False,
4604 Create => "library source copy",
4605 Location => Lib_Src_Dir.Location,
4606 Externally_Built => Project.Externally_Built);
4608 -- If directory does not exist, report an error
4610 if not Dir_Exists then
4612 -- Get the absolute name of the library directory that does
4613 -- not exist, to report an error.
4615 Err_Vars.Error_Msg_File_1 :=
4616 File_Name_Type (Project.Library_Src_Dir.Display_Name);
4617 Error_Msg
4618 (Data.Flags,
4619 "Directory { does not exist",
4620 Lib_Src_Dir.Location, Project);
4622 -- Report error if it is the same as the object directory
4624 elsif Project.Library_Src_Dir = Project.Object_Directory then
4625 Error_Msg
4626 (Data.Flags,
4627 "directory to copy interfaces cannot be " &
4628 "the object directory",
4629 Lib_Src_Dir.Location, Project);
4630 Project.Library_Src_Dir := No_Path_Information;
4632 else
4633 declare
4634 Src_Dirs : String_List_Id;
4635 Src_Dir : String_Element;
4636 Pid : Project_List;
4638 begin
4639 -- Interface copy directory cannot be one of the source
4640 -- directory of the current project.
4642 Src_Dirs := Project.Source_Dirs;
4643 while Src_Dirs /= Nil_String loop
4644 Src_Dir := Data.Tree.String_Elements.Table (Src_Dirs);
4646 -- Report error if it is one of the source directories
4648 if Project.Library_Src_Dir.Name =
4649 Path_Name_Type (Src_Dir.Value)
4650 then
4651 Error_Msg
4652 (Data.Flags,
4653 "directory to copy interfaces cannot " &
4654 "be one of the source directories",
4655 Lib_Src_Dir.Location, Project);
4656 Project.Library_Src_Dir := No_Path_Information;
4657 exit;
4658 end if;
4660 Src_Dirs := Src_Dir.Next;
4661 end loop;
4663 if Project.Library_Src_Dir /= No_Path_Information then
4665 -- It cannot be a source directory of any other
4666 -- project either.
4668 Pid := Data.Tree.Projects;
4669 Project_Loop : loop
4670 exit Project_Loop when Pid = null;
4672 Src_Dirs := Pid.Project.Source_Dirs;
4673 Dir_Loop : while Src_Dirs /= Nil_String loop
4674 Src_Dir :=
4675 Data.Tree.String_Elements.Table (Src_Dirs);
4677 -- Report error if it is one of the source
4678 -- directories.
4680 if Project.Library_Src_Dir.Name =
4681 Path_Name_Type (Src_Dir.Value)
4682 then
4683 Error_Msg_File_1 :=
4684 File_Name_Type (Src_Dir.Value);
4685 Error_Msg_Name_1 := Pid.Project.Name;
4686 Error_Msg
4687 (Data.Flags,
4688 "directory to copy interfaces cannot " &
4689 "be the same as source directory { of " &
4690 "project %%",
4691 Lib_Src_Dir.Location, Project);
4692 Project.Library_Src_Dir :=
4693 No_Path_Information;
4694 exit Project_Loop;
4695 end if;
4697 Src_Dirs := Src_Dir.Next;
4698 end loop Dir_Loop;
4700 Pid := Pid.Next;
4701 end loop Project_Loop;
4702 end if;
4703 end;
4705 -- In high verbosity, if there is a valid Library_Src_Dir,
4706 -- display its path name.
4708 if Project.Library_Src_Dir /= No_Path_Information
4709 and then Current_Verbosity = High
4710 then
4711 Write_Attr
4712 ("Directory to copy interfaces",
4713 Get_Name_String (Project.Library_Src_Dir.Name));
4714 end if;
4715 end if;
4716 end;
4717 end if;
4719 -- Check the symbol related attributes
4721 -- First, the symbol policy
4723 if not Lib_Symbol_Policy.Default then
4724 declare
4725 Value : constant String :=
4726 To_Lower
4727 (Get_Name_String (Lib_Symbol_Policy.Value));
4729 begin
4730 -- Symbol policy must hove one of a limited number of values
4732 if Value = "autonomous" or else Value = "default" then
4733 Project.Symbol_Data.Symbol_Policy := Autonomous;
4735 elsif Value = "compliant" then
4736 Project.Symbol_Data.Symbol_Policy := Compliant;
4738 elsif Value = "controlled" then
4739 Project.Symbol_Data.Symbol_Policy := Controlled;
4741 elsif Value = "restricted" then
4742 Project.Symbol_Data.Symbol_Policy := Restricted;
4744 elsif Value = "direct" then
4745 Project.Symbol_Data.Symbol_Policy := Direct;
4747 else
4748 Error_Msg
4749 (Data.Flags,
4750 "illegal value for Library_Symbol_Policy",
4751 Lib_Symbol_Policy.Location, Project);
4752 end if;
4753 end;
4754 end if;
4756 -- If attribute Library_Symbol_File is not specified, symbol policy
4757 -- cannot be Restricted.
4759 if Lib_Symbol_File.Default then
4760 if Project.Symbol_Data.Symbol_Policy = Restricted then
4761 Error_Msg
4762 (Data.Flags,
4763 "Library_Symbol_File needs to be defined when " &
4764 "symbol policy is Restricted",
4765 Lib_Symbol_Policy.Location, Project);
4766 end if;
4768 else
4769 -- Library_Symbol_File is defined
4771 Project.Symbol_Data.Symbol_File :=
4772 Path_Name_Type (Lib_Symbol_File.Value);
4774 Get_Name_String (Lib_Symbol_File.Value);
4776 if Name_Len = 0 then
4777 Error_Msg
4778 (Data.Flags,
4779 "symbol file name cannot be an empty string",
4780 Lib_Symbol_File.Location, Project);
4782 else
4783 OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
4785 if OK then
4786 for J in 1 .. Name_Len loop
4787 if Name_Buffer (J) = '/'
4788 or else Name_Buffer (J) = Directory_Separator
4789 then
4790 OK := False;
4791 exit;
4792 end if;
4793 end loop;
4794 end if;
4796 if not OK then
4797 Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
4798 Error_Msg
4799 (Data.Flags,
4800 "symbol file name { is illegal. " &
4801 "Name cannot include directory info.",
4802 Lib_Symbol_File.Location, Project);
4803 end if;
4804 end if;
4805 end if;
4807 -- If attribute Library_Reference_Symbol_File is not defined,
4808 -- symbol policy cannot be Compliant or Controlled.
4810 if Lib_Ref_Symbol_File.Default then
4811 if Project.Symbol_Data.Symbol_Policy = Compliant
4812 or else Project.Symbol_Data.Symbol_Policy = Controlled
4813 then
4814 Error_Msg
4815 (Data.Flags,
4816 "a reference symbol file needs to be defined",
4817 Lib_Symbol_Policy.Location, Project);
4818 end if;
4820 else
4821 -- Library_Reference_Symbol_File is defined, check file exists
4823 Project.Symbol_Data.Reference :=
4824 Path_Name_Type (Lib_Ref_Symbol_File.Value);
4826 Get_Name_String (Lib_Ref_Symbol_File.Value);
4828 if Name_Len = 0 then
4829 Error_Msg
4830 (Data.Flags,
4831 "reference symbol file name cannot be an empty string",
4832 Lib_Symbol_File.Location, Project);
4834 else
4835 if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
4836 Name_Len := 0;
4837 Add_Str_To_Name_Buffer
4838 (Get_Name_String (Project.Directory.Name));
4839 Add_Str_To_Name_Buffer
4840 (Get_Name_String (Lib_Ref_Symbol_File.Value));
4841 Project.Symbol_Data.Reference := Name_Find;
4842 end if;
4844 if not Is_Regular_File
4845 (Get_Name_String (Project.Symbol_Data.Reference))
4846 then
4847 Error_Msg_File_1 :=
4848 File_Name_Type (Lib_Ref_Symbol_File.Value);
4850 -- For controlled and direct symbol policies, it is an error
4851 -- if the reference symbol file does not exist. For other
4852 -- symbol policies, this is just a warning
4854 Error_Msg_Warn :=
4855 Project.Symbol_Data.Symbol_Policy /= Controlled
4856 and then Project.Symbol_Data.Symbol_Policy /= Direct;
4858 Error_Msg
4859 (Data.Flags,
4860 "<library reference symbol file { does not exist",
4861 Lib_Ref_Symbol_File.Location, Project);
4863 -- In addition in the non-controlled case, if symbol policy
4864 -- is Compliant, it is changed to Autonomous, because there
4865 -- is no reference to check against, and we don't want to
4866 -- fail in this case.
4868 if Project.Symbol_Data.Symbol_Policy /= Controlled then
4869 if Project.Symbol_Data.Symbol_Policy = Compliant then
4870 Project.Symbol_Data.Symbol_Policy := Autonomous;
4871 end if;
4872 end if;
4873 end if;
4875 -- If both the reference symbol file and the symbol file are
4876 -- defined, then check that they are not the same file.
4878 if Project.Symbol_Data.Symbol_File /= No_Path then
4879 Get_Name_String (Project.Symbol_Data.Symbol_File);
4881 if Name_Len > 0 then
4882 declare
4883 -- We do not need to pass a Directory to
4884 -- Normalize_Pathname, since the path_information
4885 -- already contains absolute information.
4887 Symb_Path : constant String :=
4888 Normalize_Pathname
4889 (Get_Name_String
4890 (Project.Object_Directory.Name) &
4891 Name_Buffer (1 .. Name_Len),
4892 Directory => "/",
4893 Resolve_Links =>
4894 Opt.Follow_Links_For_Files);
4895 Ref_Path : constant String :=
4896 Normalize_Pathname
4897 (Get_Name_String
4898 (Project.Symbol_Data.Reference),
4899 Directory => "/",
4900 Resolve_Links =>
4901 Opt.Follow_Links_For_Files);
4902 begin
4903 if Symb_Path = Ref_Path then
4904 Error_Msg
4905 (Data.Flags,
4906 "library reference symbol file and library" &
4907 " symbol file cannot be the same file",
4908 Lib_Ref_Symbol_File.Location, Project);
4909 end if;
4910 end;
4911 end if;
4912 end if;
4913 end if;
4914 end if;
4915 end if;
4916 end Check_Stand_Alone_Library;
4918 ----------------------------
4919 -- Compute_Directory_Last --
4920 ----------------------------
4922 function Compute_Directory_Last (Dir : String) return Natural is
4923 begin
4924 if Dir'Length > 1
4925 and then (Dir (Dir'Last - 1) = Directory_Separator
4926 or else
4927 Dir (Dir'Last - 1) = '/')
4928 then
4929 return Dir'Last - 1;
4930 else
4931 return Dir'Last;
4932 end if;
4933 end Compute_Directory_Last;
4935 ---------------------
4936 -- Get_Directories --
4937 ---------------------
4939 procedure Get_Directories
4940 (Project : Project_Id;
4941 Data : in out Tree_Processing_Data)
4943 Object_Dir : constant Variable_Value :=
4944 Util.Value_Of
4945 (Name_Object_Dir, Project.Decl.Attributes, Data.Tree);
4947 Exec_Dir : constant Variable_Value :=
4948 Util.Value_Of
4949 (Name_Exec_Dir, Project.Decl.Attributes, Data.Tree);
4951 Source_Dirs : constant Variable_Value :=
4952 Util.Value_Of
4953 (Name_Source_Dirs, Project.Decl.Attributes, Data.Tree);
4955 Ignore_Source_Sub_Dirs : constant Variable_Value :=
4956 Util.Value_Of
4957 (Name_Ignore_Source_Sub_Dirs,
4958 Project.Decl.Attributes,
4959 Data.Tree);
4961 Excluded_Source_Dirs : constant Variable_Value :=
4962 Util.Value_Of
4963 (Name_Excluded_Source_Dirs,
4964 Project.Decl.Attributes,
4965 Data.Tree);
4967 Source_Files : constant Variable_Value :=
4968 Util.Value_Of
4969 (Name_Source_Files,
4970 Project.Decl.Attributes, Data.Tree);
4972 Last_Source_Dir : String_List_Id := Nil_String;
4973 Last_Src_Dir_Rank : Number_List_Index := No_Number_List;
4975 Languages : constant Variable_Value :=
4976 Prj.Util.Value_Of
4977 (Name_Languages, Project.Decl.Attributes, Data.Tree);
4979 Remove_Source_Dirs : Boolean := False;
4981 procedure Add_To_Or_Remove_From_Source_Dirs
4982 (Path : Path_Information;
4983 Rank : Natural);
4984 -- When Removed = False, the directory Path_Id to the list of
4985 -- source_dirs if not already in the list. When Removed = True,
4986 -- removed directory Path_Id if in the list.
4988 procedure Find_Source_Dirs is new Expand_Subdirectory_Pattern
4989 (Add_To_Or_Remove_From_Source_Dirs);
4991 ---------------------------------------
4992 -- Add_To_Or_Remove_From_Source_Dirs --
4993 ---------------------------------------
4995 procedure Add_To_Or_Remove_From_Source_Dirs
4996 (Path : Path_Information;
4997 Rank : Natural)
4999 List : String_List_Id;
5000 Prev : String_List_Id;
5001 Rank_List : Number_List_Index;
5002 Prev_Rank : Number_List_Index;
5003 Element : String_Element;
5005 begin
5006 Prev := Nil_String;
5007 Prev_Rank := No_Number_List;
5008 List := Project.Source_Dirs;
5009 Rank_List := Project.Source_Dir_Ranks;
5010 while List /= Nil_String loop
5011 Element := Data.Tree.String_Elements.Table (List);
5012 exit when Element.Value = Name_Id (Path.Name);
5013 Prev := List;
5014 List := Element.Next;
5015 Prev_Rank := Rank_List;
5016 Rank_List := Data.Tree.Number_Lists.Table (Prev_Rank).Next;
5017 end loop;
5019 -- The directory is in the list if List is not Nil_String
5021 if not Remove_Source_Dirs and then List = Nil_String then
5022 if Current_Verbosity = High then
5023 Write_Str (" Adding Source Dir=");
5024 Write_Line (Get_Name_String (Path.Display_Name));
5025 end if;
5027 String_Element_Table.Increment_Last (Data.Tree.String_Elements);
5028 Element :=
5029 (Value => Name_Id (Path.Name),
5030 Index => 0,
5031 Display_Value => Name_Id (Path.Display_Name),
5032 Location => No_Location,
5033 Flag => False,
5034 Next => Nil_String);
5036 Number_List_Table.Increment_Last (Data.Tree.Number_Lists);
5038 if Last_Source_Dir = Nil_String then
5040 -- This is the first source directory
5042 Project.Source_Dirs :=
5043 String_Element_Table.Last (Data.Tree.String_Elements);
5044 Project.Source_Dir_Ranks :=
5045 Number_List_Table.Last (Data.Tree.Number_Lists);
5047 else
5048 -- We already have source directories, link the previous
5049 -- last to the new one.
5051 Data.Tree.String_Elements.Table (Last_Source_Dir).Next :=
5052 String_Element_Table.Last (Data.Tree.String_Elements);
5053 Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank).Next :=
5054 Number_List_Table.Last (Data.Tree.Number_Lists);
5055 end if;
5057 -- And register this source directory as the new last
5059 Last_Source_Dir :=
5060 String_Element_Table.Last (Data.Tree.String_Elements);
5061 Data.Tree.String_Elements.Table (Last_Source_Dir) := Element;
5062 Last_Src_Dir_Rank :=
5063 Number_List_Table.Last (Data.Tree.Number_Lists);
5064 Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank) :=
5065 (Number => Rank, Next => No_Number_List);
5067 elsif Remove_Source_Dirs and then List /= Nil_String then
5069 -- Remove source dir if present
5071 if Prev = Nil_String then
5072 Project.Source_Dirs :=
5073 Data.Tree.String_Elements.Table (List).Next;
5074 Project.Source_Dir_Ranks :=
5075 Data.Tree.Number_Lists.Table (Rank_List).Next;
5077 else
5078 Data.Tree.String_Elements.Table (Prev).Next :=
5079 Data.Tree.String_Elements.Table (List).Next;
5080 Data.Tree.Number_Lists.Table (Prev_Rank).Next :=
5081 Data.Tree.Number_Lists.Table (Rank_List).Next;
5082 end if;
5083 end if;
5084 end Add_To_Or_Remove_From_Source_Dirs;
5086 -- Local declarations
5088 Dir_Exists : Boolean;
5090 No_Sources : constant Boolean :=
5091 ((not Source_Files.Default
5092 and then Source_Files.Values = Nil_String)
5093 or else
5094 (not Source_Dirs.Default
5095 and then Source_Dirs.Values = Nil_String)
5096 or else
5097 (not Languages.Default
5098 and then Languages.Values = Nil_String))
5099 and then Project.Extends = No_Project;
5101 -- Start of processing for Get_Directories
5103 begin
5104 if Current_Verbosity = High then
5105 Write_Line ("Starting to look for directories");
5106 end if;
5108 -- Set the object directory to its default which may be nil, if there
5109 -- is no sources in the project.
5111 if No_Sources then
5112 Project.Object_Directory := No_Path_Information;
5113 else
5114 Project.Object_Directory := Project.Directory;
5115 end if;
5117 -- Check the object directory
5119 if Object_Dir.Value /= Empty_String then
5120 Get_Name_String (Object_Dir.Value);
5122 if Name_Len = 0 then
5123 Error_Msg
5124 (Data.Flags,
5125 "Object_Dir cannot be empty",
5126 Object_Dir.Location, Project);
5128 elsif not No_Sources then
5130 -- We check that the specified object directory does exist.
5131 -- However, even when it doesn't exist, we set it to a default
5132 -- value. This is for the benefit of tools that recover from
5133 -- errors; for example, these tools could create the non existent
5134 -- directory. We always return an absolute directory name though.
5136 Locate_Directory
5137 (Project,
5138 File_Name_Type (Object_Dir.Value),
5139 Path => Project.Object_Directory,
5140 Create => "object",
5141 Dir_Exists => Dir_Exists,
5142 Data => Data,
5143 Location => Object_Dir.Location,
5144 Must_Exist => False,
5145 Externally_Built => Project.Externally_Built);
5147 if not Dir_Exists
5148 and then not Project.Externally_Built
5149 then
5150 -- The object directory does not exist, report an error if the
5151 -- project is not externally built.
5153 Err_Vars.Error_Msg_File_1 :=
5154 File_Name_Type (Object_Dir.Value);
5155 Error_Or_Warning
5156 (Data.Flags, Data.Flags.Require_Obj_Dirs,
5157 "object directory { not found", Project.Location, Project);
5158 end if;
5159 end if;
5161 elsif not No_Sources and then Subdirs /= null then
5162 Name_Len := 1;
5163 Name_Buffer (1) := '.';
5164 Locate_Directory
5165 (Project,
5166 Name_Find,
5167 Path => Project.Object_Directory,
5168 Create => "object",
5169 Dir_Exists => Dir_Exists,
5170 Data => Data,
5171 Location => Object_Dir.Location,
5172 Externally_Built => Project.Externally_Built);
5173 end if;
5175 if Current_Verbosity = High then
5176 if Project.Object_Directory = No_Path_Information then
5177 Write_Line ("No object directory");
5178 else
5179 Write_Attr
5180 ("Object directory",
5181 Get_Name_String (Project.Object_Directory.Display_Name));
5182 end if;
5183 end if;
5185 -- Check the exec directory
5187 -- We set the object directory to its default
5189 Project.Exec_Directory := Project.Object_Directory;
5191 if Exec_Dir.Value /= Empty_String then
5192 Get_Name_String (Exec_Dir.Value);
5194 if Name_Len = 0 then
5195 Error_Msg
5196 (Data.Flags,
5197 "Exec_Dir cannot be empty",
5198 Exec_Dir.Location, Project);
5200 elsif not No_Sources then
5202 -- We check that the specified exec directory does exist
5204 Locate_Directory
5205 (Project,
5206 File_Name_Type (Exec_Dir.Value),
5207 Path => Project.Exec_Directory,
5208 Dir_Exists => Dir_Exists,
5209 Data => Data,
5210 Create => "exec",
5211 Location => Exec_Dir.Location,
5212 Externally_Built => Project.Externally_Built);
5214 if not Dir_Exists then
5215 Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
5216 Error_Or_Warning
5217 (Data.Flags, Data.Flags.Missing_Source_Files,
5218 "exec directory { not found", Project.Location, Project);
5219 end if;
5220 end if;
5221 end if;
5223 if Current_Verbosity = High then
5224 if Project.Exec_Directory = No_Path_Information then
5225 Write_Line ("No exec directory");
5226 else
5227 Write_Str ("Exec directory: """);
5228 Write_Str (Get_Name_String (Project.Exec_Directory.Display_Name));
5229 Write_Line ("""");
5230 end if;
5231 end if;
5233 -- Look for the source directories
5235 if Current_Verbosity = High then
5236 Write_Line ("Starting to look for source directories");
5237 end if;
5239 pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
5241 if not Source_Files.Default
5242 and then Source_Files.Values = Nil_String
5243 then
5244 Project.Source_Dirs := Nil_String;
5246 if Project.Qualifier = Standard then
5247 Error_Msg
5248 (Data.Flags,
5249 "a standard project cannot have no sources",
5250 Source_Files.Location, Project);
5251 end if;
5253 elsif Source_Dirs.Default then
5255 -- No Source_Dirs specified: the single source directory is the one
5256 -- containing the project file.
5258 Remove_Source_Dirs := False;
5259 Add_To_Or_Remove_From_Source_Dirs
5260 (Path => (Name => Project.Directory.Name,
5261 Display_Name => Project.Directory.Display_Name),
5262 Rank => 1);
5264 else
5265 Remove_Source_Dirs := False;
5266 Find_Source_Dirs
5267 (Project => Project,
5268 Data => Data,
5269 Patterns => Source_Dirs.Values,
5270 Ignore => Ignore_Source_Sub_Dirs.Values,
5271 Search_For => Search_Directories,
5272 Resolve_Links => Opt.Follow_Links_For_Dirs);
5274 if Project.Source_Dirs = Nil_String
5275 and then Project.Qualifier = Standard
5276 then
5277 Error_Msg
5278 (Data.Flags,
5279 "a standard project cannot have no source directories",
5280 Source_Dirs.Location, Project);
5281 end if;
5282 end if;
5284 if not Excluded_Source_Dirs.Default
5285 and then Excluded_Source_Dirs.Values /= Nil_String
5286 then
5287 Remove_Source_Dirs := True;
5288 Find_Source_Dirs
5289 (Project => Project,
5290 Data => Data,
5291 Patterns => Excluded_Source_Dirs.Values,
5292 Ignore => Nil_String,
5293 Search_For => Search_Directories,
5294 Resolve_Links => Opt.Follow_Links_For_Dirs);
5295 end if;
5297 if Current_Verbosity = High then
5298 Write_Line ("Putting source directories in canonical cases");
5299 end if;
5301 declare
5302 Current : String_List_Id := Project.Source_Dirs;
5303 Element : String_Element;
5305 begin
5306 while Current /= Nil_String loop
5307 Element := Data.Tree.String_Elements.Table (Current);
5308 if Element.Value /= No_Name then
5309 Element.Value :=
5310 Name_Id (Canonical_Case_File_Name (Element.Value));
5311 Data.Tree.String_Elements.Table (Current) := Element;
5312 end if;
5314 Current := Element.Next;
5315 end loop;
5316 end;
5317 end Get_Directories;
5319 ---------------
5320 -- Get_Mains --
5321 ---------------
5323 procedure Get_Mains
5324 (Project : Project_Id;
5325 Data : in out Tree_Processing_Data)
5327 Mains : constant Variable_Value :=
5328 Prj.Util.Value_Of
5329 (Name_Main, Project.Decl.Attributes, Data.Tree);
5330 List : String_List_Id;
5331 Elem : String_Element;
5333 begin
5334 Project.Mains := Mains.Values;
5336 -- If no Mains were specified, and if we are an extending project,
5337 -- inherit the Mains from the project we are extending.
5339 if Mains.Default then
5340 if not Project.Library and then Project.Extends /= No_Project then
5341 Project.Mains := Project.Extends.Mains;
5342 end if;
5344 -- In a library project file, Main cannot be specified
5346 elsif Project.Library then
5347 Error_Msg
5348 (Data.Flags,
5349 "a library project file cannot have Main specified",
5350 Mains.Location, Project);
5352 else
5353 List := Mains.Values;
5354 while List /= Nil_String loop
5355 Elem := Data.Tree.String_Elements.Table (List);
5357 if Length_Of_Name (Elem.Value) = 0 then
5358 Error_Msg
5359 (Data.Flags,
5360 "?a main cannot have an empty name",
5361 Elem.Location, Project);
5362 exit;
5363 end if;
5365 List := Elem.Next;
5366 end loop;
5367 end if;
5368 end Get_Mains;
5370 ---------------------------
5371 -- Get_Sources_From_File --
5372 ---------------------------
5374 procedure Get_Sources_From_File
5375 (Path : String;
5376 Location : Source_Ptr;
5377 Project : in out Project_Processing_Data;
5378 Data : in out Tree_Processing_Data)
5380 File : Prj.Util.Text_File;
5381 Line : String (1 .. 250);
5382 Last : Natural;
5383 Source_Name : File_Name_Type;
5384 Name_Loc : Name_Location;
5386 begin
5387 if Current_Verbosity = High then
5388 Write_Str ("Opening """);
5389 Write_Str (Path);
5390 Write_Line (""".");
5391 end if;
5393 -- Open the file
5395 Prj.Util.Open (File, Path);
5397 if not Prj.Util.Is_Valid (File) then
5398 Error_Msg
5399 (Data.Flags, "file does not exist", Location, Project.Project);
5401 else
5402 -- Read the lines one by one
5404 while not Prj.Util.End_Of_File (File) loop
5405 Prj.Util.Get_Line (File, Line, Last);
5407 -- A non empty, non comment line should contain a file name
5409 if Last /= 0
5410 and then (Last = 1 or else Line (1 .. 2) /= "--")
5411 then
5412 Name_Len := Last;
5413 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
5414 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
5415 Source_Name := Name_Find;
5417 -- Check that there is no directory information
5419 for J in 1 .. Last loop
5420 if Line (J) = '/' or else Line (J) = Directory_Separator then
5421 Error_Msg_File_1 := Source_Name;
5422 Error_Msg
5423 (Data.Flags,
5424 "file name cannot include directory information ({)",
5425 Location, Project.Project);
5426 exit;
5427 end if;
5428 end loop;
5430 Name_Loc := Source_Names_Htable.Get
5431 (Project.Source_Names, Source_Name);
5433 if Name_Loc = No_Name_Location then
5434 Name_Loc :=
5435 (Name => Source_Name,
5436 Location => Location,
5437 Source => No_Source,
5438 Listed => True,
5439 Found => False);
5441 else
5442 Name_Loc.Listed := True;
5443 end if;
5445 Source_Names_Htable.Set
5446 (Project.Source_Names, Source_Name, Name_Loc);
5447 end if;
5448 end loop;
5450 Prj.Util.Close (File);
5452 end if;
5453 end Get_Sources_From_File;
5455 -----------------------
5456 -- Compute_Unit_Name --
5457 -----------------------
5459 procedure Compute_Unit_Name
5460 (File_Name : File_Name_Type;
5461 Naming : Lang_Naming_Data;
5462 Kind : out Source_Kind;
5463 Unit : out Name_Id;
5464 Project : Project_Processing_Data;
5465 In_Tree : Project_Tree_Ref)
5467 Filename : constant String := Get_Name_String (File_Name);
5468 Last : Integer := Filename'Last;
5469 Sep_Len : Integer;
5470 Body_Len : Integer;
5471 Spec_Len : Integer;
5473 Unit_Except : Unit_Exception;
5474 Masked : Boolean := False;
5476 begin
5477 Unit := No_Name;
5478 Kind := Spec;
5480 if Naming.Separate_Suffix = No_File
5481 or else Naming.Body_Suffix = No_File
5482 or else Naming.Spec_Suffix = No_File
5483 then
5484 return;
5485 end if;
5487 if Naming.Dot_Replacement = No_File then
5488 if Current_Verbosity = High then
5489 Write_Line (" No dot_replacement specified");
5490 end if;
5492 return;
5493 end if;
5495 Sep_Len := Integer (Length_Of_Name (Naming.Separate_Suffix));
5496 Spec_Len := Integer (Length_Of_Name (Naming.Spec_Suffix));
5497 Body_Len := Integer (Length_Of_Name (Naming.Body_Suffix));
5499 -- Choose the longest suffix that matches. If there are several matches,
5500 -- give priority to specs, then bodies, then separates.
5502 if Naming.Separate_Suffix /= Naming.Body_Suffix
5503 and then Suffix_Matches (Filename, Naming.Separate_Suffix)
5504 then
5505 Last := Filename'Last - Sep_Len;
5506 Kind := Sep;
5507 end if;
5509 if Filename'Last - Body_Len <= Last
5510 and then Suffix_Matches (Filename, Naming.Body_Suffix)
5511 then
5512 Last := Natural'Min (Last, Filename'Last - Body_Len);
5513 Kind := Impl;
5514 end if;
5516 if Filename'Last - Spec_Len <= Last
5517 and then Suffix_Matches (Filename, Naming.Spec_Suffix)
5518 then
5519 Last := Natural'Min (Last, Filename'Last - Spec_Len);
5520 Kind := Spec;
5521 end if;
5523 if Last = Filename'Last then
5524 if Current_Verbosity = High then
5525 Write_Line (" no matching suffix");
5526 end if;
5528 return;
5529 end if;
5531 -- Check that the casing matches
5533 if File_Names_Case_Sensitive then
5534 case Naming.Casing is
5535 when All_Lower_Case =>
5536 for J in Filename'First .. Last loop
5537 if Is_Letter (Filename (J))
5538 and then not Is_Lower (Filename (J))
5539 then
5540 if Current_Verbosity = High then
5541 Write_Line (" Invalid casing");
5542 end if;
5544 return;
5545 end if;
5546 end loop;
5548 when All_Upper_Case =>
5549 for J in Filename'First .. Last loop
5550 if Is_Letter (Filename (J))
5551 and then not Is_Upper (Filename (J))
5552 then
5553 if Current_Verbosity = High then
5554 Write_Line (" Invalid casing");
5555 end if;
5557 return;
5558 end if;
5559 end loop;
5561 when Mixed_Case | Unknown =>
5562 null;
5563 end case;
5564 end if;
5566 -- If Dot_Replacement is not a single dot, then there should not
5567 -- be any dot in the name.
5569 declare
5570 Dot_Repl : constant String :=
5571 Get_Name_String (Naming.Dot_Replacement);
5573 begin
5574 if Dot_Repl /= "." then
5575 for Index in Filename'First .. Last loop
5576 if Filename (Index) = '.' then
5577 if Current_Verbosity = High then
5578 Write_Line (" Invalid name, contains dot");
5579 end if;
5581 return;
5582 end if;
5583 end loop;
5585 Replace_Into_Name_Buffer
5586 (Filename (Filename'First .. Last), Dot_Repl, '.');
5588 else
5589 Name_Len := Last - Filename'First + 1;
5590 Name_Buffer (1 .. Name_Len) := Filename (Filename'First .. Last);
5591 Fixed.Translate
5592 (Source => Name_Buffer (1 .. Name_Len),
5593 Mapping => Lower_Case_Map);
5594 end if;
5595 end;
5597 -- In the standard GNAT naming scheme, check for special cases: children
5598 -- or separates of A, G, I or S, and run time sources.
5600 if Is_Standard_GNAT_Naming (Naming)
5601 and then Name_Len >= 3
5602 then
5603 declare
5604 S1 : constant Character := Name_Buffer (1);
5605 S2 : constant Character := Name_Buffer (2);
5606 S3 : constant Character := Name_Buffer (3);
5608 begin
5609 if S1 = 'a'
5610 or else S1 = 'g'
5611 or else S1 = 'i'
5612 or else S1 = 's'
5613 then
5614 -- Children or separates of packages A, G, I or S. These names
5615 -- are x__ ... or x~... (where x is a, g, i, or s). Both
5616 -- versions (x__... and x~...) are allowed in all platforms,
5617 -- because it is not possible to know the platform before
5618 -- processing of the project files.
5620 if S2 = '_' and then S3 = '_' then
5621 Name_Buffer (2) := '.';
5622 Name_Buffer (3 .. Name_Len - 1) :=
5623 Name_Buffer (4 .. Name_Len);
5624 Name_Len := Name_Len - 1;
5626 elsif S2 = '~' then
5627 Name_Buffer (2) := '.';
5629 elsif S2 = '.' then
5631 -- If it is potentially a run time source
5633 null;
5634 end if;
5635 end if;
5636 end;
5637 end if;
5639 -- Name_Buffer contains the name of the the unit in lower-cases. Check
5640 -- that this is a valid unit name
5642 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
5644 -- If there is a naming exception for the same unit, the file is not
5645 -- a source for the unit.
5647 if Unit /= No_Name then
5648 Unit_Except :=
5649 Unit_Exceptions_Htable.Get (Project.Unit_Exceptions, Unit);
5651 if Kind = Spec then
5652 Masked := Unit_Except.Spec /= No_File
5653 and then
5654 Unit_Except.Spec /= File_Name;
5655 else
5656 Masked := Unit_Except.Impl /= No_File
5657 and then
5658 Unit_Except.Impl /= File_Name;
5659 end if;
5661 if Masked then
5662 if Current_Verbosity = High then
5663 Write_Str (" """ & Filename & """ contains the ");
5665 if Kind = Spec then
5666 Write_Str ("spec of a unit found in """);
5667 Write_Str (Get_Name_String (Unit_Except.Spec));
5668 else
5669 Write_Str ("body of a unit found in """);
5670 Write_Str (Get_Name_String (Unit_Except.Impl));
5671 end if;
5673 Write_Line (""" (ignored)");
5674 end if;
5676 Unit := No_Name;
5677 end if;
5678 end if;
5680 if Unit /= No_Name
5681 and then Current_Verbosity = High
5682 then
5683 case Kind is
5684 when Spec => Write_Str (" spec of ");
5685 when Impl => Write_Str (" body of ");
5686 when Sep => Write_Str (" sep of ");
5687 end case;
5689 Write_Line (Get_Name_String (Unit));
5690 end if;
5691 end Compute_Unit_Name;
5693 --------------------------
5694 -- Check_Illegal_Suffix --
5695 --------------------------
5697 procedure Check_Illegal_Suffix
5698 (Project : Project_Id;
5699 Suffix : File_Name_Type;
5700 Dot_Replacement : File_Name_Type;
5701 Attribute_Name : String;
5702 Location : Source_Ptr;
5703 Data : in out Tree_Processing_Data)
5705 Suffix_Str : constant String := Get_Name_String (Suffix);
5707 begin
5708 if Suffix_Str'Length = 0 then
5710 -- Always valid
5712 return;
5714 elsif Index (Suffix_Str, ".") = 0 then
5715 Err_Vars.Error_Msg_File_1 := Suffix;
5716 Error_Msg
5717 (Data.Flags,
5718 "{ is illegal for " & Attribute_Name & ": must have a dot",
5719 Location, Project);
5720 return;
5721 end if;
5723 -- Case of dot replacement is a single dot, and first character of
5724 -- suffix is also a dot.
5726 if Dot_Replacement /= No_File
5727 and then Get_Name_String (Dot_Replacement) = "."
5728 and then Suffix_Str (Suffix_Str'First) = '.'
5729 then
5730 for Index in Suffix_Str'First + 1 .. Suffix_Str'Last loop
5732 -- If there are multiple dots in the name
5734 if Suffix_Str (Index) = '.' then
5736 -- It is illegal to have a letter following the initial dot
5738 if Is_Letter (Suffix_Str (Suffix_Str'First + 1)) then
5739 Err_Vars.Error_Msg_File_1 := Suffix;
5740 Error_Msg
5741 (Data.Flags,
5742 "{ is illegal for " & Attribute_Name
5743 & ": ambiguous prefix when Dot_Replacement is a dot",
5744 Location, Project);
5745 end if;
5746 return;
5747 end if;
5748 end loop;
5749 end if;
5750 end Check_Illegal_Suffix;
5752 ----------------------
5753 -- Locate_Directory --
5754 ----------------------
5756 procedure Locate_Directory
5757 (Project : Project_Id;
5758 Name : File_Name_Type;
5759 Path : out Path_Information;
5760 Dir_Exists : out Boolean;
5761 Data : in out Tree_Processing_Data;
5762 Create : String := "";
5763 Location : Source_Ptr := No_Location;
5764 Must_Exist : Boolean := True;
5765 Externally_Built : Boolean := False)
5767 Parent : constant Path_Name_Type :=
5768 Project.Directory.Display_Name;
5769 The_Parent : constant String :=
5770 Get_Name_String (Parent);
5771 The_Parent_Last : constant Natural :=
5772 Compute_Directory_Last (The_Parent);
5773 Full_Name : File_Name_Type;
5774 The_Name : File_Name_Type;
5776 begin
5777 Get_Name_String (Name);
5779 -- Add Subdirs.all if it is a directory that may be created and
5780 -- Subdirs is not null;
5782 if Create /= "" and then Subdirs /= null then
5783 if Name_Buffer (Name_Len) /= Directory_Separator then
5784 Add_Char_To_Name_Buffer (Directory_Separator);
5785 end if;
5787 Add_Str_To_Name_Buffer (Subdirs.all);
5788 end if;
5790 -- Convert '/' to directory separator (for Windows)
5792 for J in 1 .. Name_Len loop
5793 if Name_Buffer (J) = '/' then
5794 Name_Buffer (J) := Directory_Separator;
5795 end if;
5796 end loop;
5798 The_Name := Name_Find;
5800 if Current_Verbosity = High then
5801 Write_Str ("Locate_Directory (""");
5802 Write_Str (Get_Name_String (The_Name));
5803 Write_Str (""", """);
5804 Write_Str (The_Parent);
5805 Write_Line (""")");
5806 end if;
5808 Path := No_Path_Information;
5809 Dir_Exists := False;
5811 if Is_Absolute_Path (Get_Name_String (The_Name)) then
5812 Full_Name := The_Name;
5814 else
5815 Name_Len := 0;
5816 Add_Str_To_Name_Buffer
5817 (The_Parent (The_Parent'First .. The_Parent_Last));
5818 Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
5819 Full_Name := Name_Find;
5820 end if;
5822 declare
5823 Full_Path_Name : String_Access :=
5824 new String'(Get_Name_String (Full_Name));
5826 begin
5827 if (Setup_Projects or else Subdirs /= null)
5828 and then Create'Length > 0
5829 then
5830 if not Is_Directory (Full_Path_Name.all) then
5832 -- If project is externally built, do not create a subdir,
5833 -- use the specified directory, without the subdir.
5835 if Externally_Built then
5836 if Is_Absolute_Path (Get_Name_String (Name)) then
5837 Get_Name_String (Name);
5839 else
5840 Name_Len := 0;
5841 Add_Str_To_Name_Buffer
5842 (The_Parent (The_Parent'First .. The_Parent_Last));
5843 Add_Str_To_Name_Buffer (Get_Name_String (Name));
5844 end if;
5846 Full_Path_Name := new String'(Name_Buffer (1 .. Name_Len));
5848 else
5849 begin
5850 Create_Path (Full_Path_Name.all);
5852 if not Quiet_Output then
5853 Write_Str (Create);
5854 Write_Str (" directory """);
5855 Write_Str (Full_Path_Name.all);
5856 Write_Str (""" created for project ");
5857 Write_Line (Get_Name_String (Project.Name));
5858 end if;
5860 exception
5861 when Use_Error =>
5862 Error_Msg
5863 (Data.Flags,
5864 "could not create " & Create &
5865 " directory " & Full_Path_Name.all,
5866 Location, Project);
5867 end;
5868 end if;
5869 end if;
5870 end if;
5872 Dir_Exists := Is_Directory (Full_Path_Name.all);
5874 if not Must_Exist or else Dir_Exists then
5875 declare
5876 Normed : constant String :=
5877 Normalize_Pathname
5878 (Full_Path_Name.all,
5879 Directory =>
5880 The_Parent (The_Parent'First .. The_Parent_Last),
5881 Resolve_Links => False,
5882 Case_Sensitive => True);
5884 Canonical_Path : constant String :=
5885 Normalize_Pathname
5886 (Normed,
5887 Directory =>
5888 The_Parent
5889 (The_Parent'First .. The_Parent_Last),
5890 Resolve_Links =>
5891 Opt.Follow_Links_For_Dirs,
5892 Case_Sensitive => False);
5894 begin
5895 Name_Len := Normed'Length;
5896 Name_Buffer (1 .. Name_Len) := Normed;
5898 -- Directories should always end with a directory separator
5900 if Name_Buffer (Name_Len) /= Directory_Separator then
5901 Add_Char_To_Name_Buffer (Directory_Separator);
5902 end if;
5904 Path.Display_Name := Name_Find;
5906 Name_Len := Canonical_Path'Length;
5907 Name_Buffer (1 .. Name_Len) := Canonical_Path;
5909 if Name_Buffer (Name_Len) /= Directory_Separator then
5910 Add_Char_To_Name_Buffer (Directory_Separator);
5911 end if;
5913 Path.Name := Name_Find;
5914 end;
5915 end if;
5917 Free (Full_Path_Name);
5918 end;
5919 end Locate_Directory;
5921 ---------------------------
5922 -- Find_Excluded_Sources --
5923 ---------------------------
5925 procedure Find_Excluded_Sources
5926 (Project : in out Project_Processing_Data;
5927 Data : in out Tree_Processing_Data)
5929 Excluded_Source_List_File : constant Variable_Value :=
5930 Util.Value_Of
5931 (Name_Excluded_Source_List_File,
5932 Project.Project.Decl.Attributes,
5933 Data.Tree);
5934 Excluded_Sources : Variable_Value := Util.Value_Of
5935 (Name_Excluded_Source_Files,
5936 Project.Project.Decl.Attributes,
5937 Data.Tree);
5939 Current : String_List_Id;
5940 Element : String_Element;
5941 Location : Source_Ptr;
5942 Name : File_Name_Type;
5943 File : Prj.Util.Text_File;
5944 Line : String (1 .. 300);
5945 Last : Natural;
5946 Locally_Removed : Boolean := False;
5948 begin
5949 -- If Excluded_Source_Files is not declared, check Locally_Removed_Files
5951 if Excluded_Sources.Default then
5952 Locally_Removed := True;
5953 Excluded_Sources :=
5954 Util.Value_Of
5955 (Name_Locally_Removed_Files,
5956 Project.Project.Decl.Attributes, Data.Tree);
5957 end if;
5959 -- If there are excluded sources, put them in the table
5961 if not Excluded_Sources.Default then
5962 if not Excluded_Source_List_File.Default then
5963 if Locally_Removed then
5964 Error_Msg
5965 (Data.Flags,
5966 "?both attributes Locally_Removed_Files and " &
5967 "Excluded_Source_List_File are present",
5968 Excluded_Source_List_File.Location, Project.Project);
5969 else
5970 Error_Msg
5971 (Data.Flags,
5972 "?both attributes Excluded_Source_Files and " &
5973 "Excluded_Source_List_File are present",
5974 Excluded_Source_List_File.Location, Project.Project);
5975 end if;
5976 end if;
5978 Current := Excluded_Sources.Values;
5979 while Current /= Nil_String loop
5980 Element := Data.Tree.String_Elements.Table (Current);
5981 Name := Canonical_Case_File_Name (Element.Value);
5983 -- If the element has no location, then use the location of
5984 -- Excluded_Sources to report possible errors.
5986 if Element.Location = No_Location then
5987 Location := Excluded_Sources.Location;
5988 else
5989 Location := Element.Location;
5990 end if;
5992 Excluded_Sources_Htable.Set
5993 (Project.Excluded, Name, (Name, False, Location));
5994 Current := Element.Next;
5995 end loop;
5997 elsif not Excluded_Source_List_File.Default then
5998 Location := Excluded_Source_List_File.Location;
6000 declare
6001 Source_File_Path_Name : constant String :=
6002 Path_Name_Of
6003 (File_Name_Type
6004 (Excluded_Source_List_File.Value),
6005 Project.Project.Directory.Name);
6007 begin
6008 if Source_File_Path_Name'Length = 0 then
6009 Err_Vars.Error_Msg_File_1 :=
6010 File_Name_Type (Excluded_Source_List_File.Value);
6011 Error_Msg
6012 (Data.Flags,
6013 "file with excluded sources { does not exist",
6014 Excluded_Source_List_File.Location, Project.Project);
6016 else
6017 -- Open the file
6019 Prj.Util.Open (File, Source_File_Path_Name);
6021 if not Prj.Util.Is_Valid (File) then
6022 Error_Msg
6023 (Data.Flags, "file does not exist",
6024 Location, Project.Project);
6025 else
6026 -- Read the lines one by one
6028 while not Prj.Util.End_Of_File (File) loop
6029 Prj.Util.Get_Line (File, Line, Last);
6031 -- Non empty, non comment line should contain a file name
6033 if Last /= 0
6034 and then (Last = 1 or else Line (1 .. 2) /= "--")
6035 then
6036 Name_Len := Last;
6037 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6038 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6039 Name := Name_Find;
6041 -- Check that there is no directory information
6043 for J in 1 .. Last loop
6044 if Line (J) = '/'
6045 or else Line (J) = Directory_Separator
6046 then
6047 Error_Msg_File_1 := Name;
6048 Error_Msg
6049 (Data.Flags,
6050 "file name cannot include " &
6051 "directory information ({)",
6052 Location, Project.Project);
6053 exit;
6054 end if;
6055 end loop;
6057 Excluded_Sources_Htable.Set
6058 (Project.Excluded, Name, (Name, False, Location));
6059 end if;
6060 end loop;
6062 Prj.Util.Close (File);
6063 end if;
6064 end if;
6065 end;
6066 end if;
6067 end Find_Excluded_Sources;
6069 ------------------
6070 -- Find_Sources --
6071 ------------------
6073 procedure Find_Sources
6074 (Project : in out Project_Processing_Data;
6075 Data : in out Tree_Processing_Data)
6077 Sources : constant Variable_Value :=
6078 Util.Value_Of
6079 (Name_Source_Files,
6080 Project.Project.Decl.Attributes,
6081 Data.Tree);
6083 Source_List_File : constant Variable_Value :=
6084 Util.Value_Of
6085 (Name_Source_List_File,
6086 Project.Project.Decl.Attributes,
6087 Data.Tree);
6089 Name_Loc : Name_Location;
6090 Has_Explicit_Sources : Boolean;
6092 begin
6093 pragma Assert (Sources.Kind = List, "Source_Files is not a list");
6094 pragma Assert
6095 (Source_List_File.Kind = Single,
6096 "Source_List_File is not a single string");
6098 Project.Source_List_File_Location := Source_List_File.Location;
6100 -- If the user has specified a Source_Files attribute
6102 if not Sources.Default then
6103 if not Source_List_File.Default then
6104 Error_Msg
6105 (Data.Flags,
6106 "?both attributes source_files and " &
6107 "source_list_file are present",
6108 Source_List_File.Location, Project.Project);
6109 end if;
6111 -- Sources is a list of file names
6113 declare
6114 Current : String_List_Id := Sources.Values;
6115 Element : String_Element;
6116 Location : Source_Ptr;
6117 Name : File_Name_Type;
6119 begin
6120 if Current = Nil_String then
6121 Project.Project.Languages := No_Language_Index;
6123 -- This project contains no source. For projects that don't
6124 -- extend other projects, this also means that there is no
6125 -- need for an object directory, if not specified.
6127 if Project.Project.Extends = No_Project
6128 and then Project.Project.Object_Directory =
6129 Project.Project.Directory
6130 then
6131 Project.Project.Object_Directory := No_Path_Information;
6132 end if;
6133 end if;
6135 while Current /= Nil_String loop
6136 Element := Data.Tree.String_Elements.Table (Current);
6137 Name := Canonical_Case_File_Name (Element.Value);
6138 Get_Name_String (Element.Value);
6140 -- If the element has no location, then use the location of
6141 -- Sources to report possible errors.
6143 if Element.Location = No_Location then
6144 Location := Sources.Location;
6145 else
6146 Location := Element.Location;
6147 end if;
6149 -- Check that there is no directory information
6151 for J in 1 .. Name_Len loop
6152 if Name_Buffer (J) = '/'
6153 or else Name_Buffer (J) = Directory_Separator
6154 then
6155 Error_Msg_File_1 := Name;
6156 Error_Msg
6157 (Data.Flags,
6158 "file name cannot include directory " &
6159 "information ({)",
6160 Location, Project.Project);
6161 exit;
6162 end if;
6163 end loop;
6165 -- Check whether the file is already there: the same file name
6166 -- may be in the list. If the source is missing, the error will
6167 -- be on the first mention of the source file name.
6169 Name_Loc := Source_Names_Htable.Get
6170 (Project.Source_Names, Name);
6172 if Name_Loc = No_Name_Location then
6173 Name_Loc :=
6174 (Name => Name,
6175 Location => Location,
6176 Source => No_Source,
6177 Listed => True,
6178 Found => False);
6180 else
6181 Name_Loc.Listed := True;
6182 end if;
6184 Source_Names_Htable.Set
6185 (Project.Source_Names, Name, Name_Loc);
6187 Current := Element.Next;
6188 end loop;
6190 Has_Explicit_Sources := True;
6191 end;
6193 -- If we have no Source_Files attribute, check the Source_List_File
6194 -- attribute.
6196 elsif not Source_List_File.Default then
6198 -- Source_List_File is the name of the file that contains the source
6199 -- file names.
6201 declare
6202 Source_File_Path_Name : constant String :=
6203 Path_Name_Of
6204 (File_Name_Type (Source_List_File.Value),
6205 Project.Project.Directory.Name);
6207 begin
6208 Has_Explicit_Sources := True;
6210 if Source_File_Path_Name'Length = 0 then
6211 Err_Vars.Error_Msg_File_1 :=
6212 File_Name_Type (Source_List_File.Value);
6213 Error_Msg
6214 (Data.Flags,
6215 "file with sources { does not exist",
6216 Source_List_File.Location, Project.Project);
6218 else
6219 Get_Sources_From_File
6220 (Source_File_Path_Name, Source_List_File.Location,
6221 Project, Data);
6222 end if;
6223 end;
6225 else
6226 -- Neither Source_Files nor Source_List_File has been specified. Find
6227 -- all the files that satisfy the naming scheme in all the source
6228 -- directories.
6230 Has_Explicit_Sources := False;
6231 end if;
6233 -- Remove any exception that is not in the specified list of sources
6235 if Has_Explicit_Sources then
6236 declare
6237 Source : Source_Id;
6238 Iter : Source_Iterator;
6239 NL : Name_Location;
6240 Again : Boolean;
6241 begin
6242 Iter_Loop :
6243 loop
6244 Again := False;
6245 Iter := For_Each_Source (Data.Tree, Project.Project);
6247 Source_Loop :
6248 loop
6249 Source := Prj.Element (Iter);
6250 exit Source_Loop when Source = No_Source;
6252 if Source.Naming_Exception then
6253 NL := Source_Names_Htable.Get
6254 (Project.Source_Names, Source.File);
6256 if NL /= No_Name_Location and then not NL.Listed then
6257 -- Remove the exception
6258 Source_Names_Htable.Set
6259 (Project.Source_Names,
6260 Source.File,
6261 No_Name_Location);
6262 Remove_Source (Data.Tree, Source, No_Source);
6264 Error_Msg_Name_1 := Name_Id (Source.File);
6265 Error_Msg
6266 (Data.Flags,
6267 "? unknown source file %%",
6268 NL.Location,
6269 Project.Project);
6271 Again := True;
6272 exit Source_Loop;
6273 end if;
6274 end if;
6276 Next (Iter);
6277 end loop Source_Loop;
6279 exit Iter_Loop when not Again;
6280 end loop Iter_Loop;
6281 end;
6282 end if;
6284 Search_Directories
6285 (Project,
6286 Data => Data,
6287 For_All_Sources => Sources.Default and then Source_List_File.Default);
6289 -- Check if all exceptions have been found
6291 declare
6292 Source : Source_Id;
6293 Iter : Source_Iterator;
6294 Found : Boolean := False;
6295 Path : Path_Information;
6297 begin
6298 Iter := For_Each_Source (Data.Tree, Project.Project);
6299 loop
6300 Source := Prj.Element (Iter);
6301 exit when Source = No_Source;
6303 if Source.Naming_Exception
6304 and then Source.Path = No_Path_Information
6305 then
6306 if Source.Unit /= No_Unit_Index then
6307 Found := False;
6309 -- For multi-unit source files, source_id gets duplicated
6310 -- once for every unit. Only the first source_id got its
6311 -- full path set.
6313 if Source.Index /= 0 then
6314 Path := Files_Htable.Get
6315 (Data.File_To_Source, Source.File).Path;
6317 if Path /= No_Path_Information then
6318 Found := True;
6319 end if;
6320 end if;
6322 if not Found then
6323 Error_Msg_Name_1 := Name_Id (Source.Display_File);
6324 Error_Msg_Name_2 := Source.Unit.Name;
6325 Error_Or_Warning
6326 (Data.Flags, Data.Flags.Missing_Source_Files,
6327 "source file %% for unit %% not found",
6328 No_Location, Project.Project);
6330 else
6331 Source.Path := Path;
6333 if Current_Verbosity = High then
6334 if Source.Path /= No_Path_Information then
6335 Write_Line ("Setting full path for "
6336 & Get_Name_String (Source.File)
6337 & " at" & Source.Index'Img
6338 & " to "
6339 & Get_Name_String (Path.Name));
6340 end if;
6341 end if;
6342 end if;
6343 end if;
6345 if Source.Path = No_Path_Information then
6346 Remove_Source (Data.Tree, Source, No_Source);
6347 end if;
6348 end if;
6350 Next (Iter);
6351 end loop;
6352 end;
6354 -- It is an error if a source file name in a source list or in a source
6355 -- list file is not found.
6357 if Has_Explicit_Sources then
6358 declare
6359 NL : Name_Location;
6360 First_Error : Boolean;
6362 begin
6363 NL := Source_Names_Htable.Get_First (Project.Source_Names);
6364 First_Error := True;
6365 while NL /= No_Name_Location loop
6366 if not NL.Found then
6367 Err_Vars.Error_Msg_File_1 := NL.Name;
6368 if First_Error then
6369 Error_Or_Warning
6370 (Data.Flags, Data.Flags.Missing_Source_Files,
6371 "source file { not found",
6372 NL.Location, Project.Project);
6373 First_Error := False;
6374 else
6375 Error_Or_Warning
6376 (Data.Flags, Data.Flags.Missing_Source_Files,
6377 "\source file { not found",
6378 NL.Location, Project.Project);
6379 end if;
6380 end if;
6382 NL := Source_Names_Htable.Get_Next (Project.Source_Names);
6383 end loop;
6384 end;
6385 end if;
6386 end Find_Sources;
6388 ----------------
6389 -- Initialize --
6390 ----------------
6392 procedure Initialize
6393 (Data : out Tree_Processing_Data;
6394 Tree : Project_Tree_Ref;
6395 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
6396 Flags : Prj.Processing_Flags)
6398 begin
6399 Files_Htable.Reset (Data.File_To_Source);
6400 Data.Tree := Tree;
6401 Data.Node_Tree := Node_Tree;
6402 Data.Flags := Flags;
6403 end Initialize;
6405 ----------
6406 -- Free --
6407 ----------
6409 procedure Free (Data : in out Tree_Processing_Data) is
6410 begin
6411 Files_Htable.Reset (Data.File_To_Source);
6412 end Free;
6414 ----------------
6415 -- Initialize --
6416 ----------------
6418 procedure Initialize
6419 (Data : in out Project_Processing_Data;
6420 Project : Project_Id)
6422 begin
6423 Data.Project := Project;
6424 end Initialize;
6426 ----------
6427 -- Free --
6428 ----------
6430 procedure Free (Data : in out Project_Processing_Data) is
6431 begin
6432 Source_Names_Htable.Reset (Data.Source_Names);
6433 Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions);
6434 Excluded_Sources_Htable.Reset (Data.Excluded);
6435 end Free;
6437 -------------------------------
6438 -- Check_File_Naming_Schemes --
6439 -------------------------------
6441 procedure Check_File_Naming_Schemes
6442 (In_Tree : Project_Tree_Ref;
6443 Project : Project_Processing_Data;
6444 File_Name : File_Name_Type;
6445 Alternate_Languages : out Language_List;
6446 Language : out Language_Ptr;
6447 Display_Language_Name : out Name_Id;
6448 Unit : out Name_Id;
6449 Lang_Kind : out Language_Kind;
6450 Kind : out Source_Kind)
6452 Filename : constant String := Get_Name_String (File_Name);
6453 Config : Language_Config;
6454 Tmp_Lang : Language_Ptr;
6456 Header_File : Boolean := False;
6457 -- True if we found at least one language for which the file is a header
6458 -- In such a case, we search for all possible languages where this is
6459 -- also a header (C and C++ for instance), since the file might be used
6460 -- for several such languages.
6462 procedure Check_File_Based_Lang;
6463 -- Does the naming scheme test for file-based languages. For those,
6464 -- there is no Unit. Just check if the file name has the implementation
6465 -- or, if it is specified, the template suffix of the language.
6467 -- Returns True if the file belongs to the current language and we
6468 -- should stop searching for matching languages. Not that a given header
6469 -- file could belong to several languages (C and C++ for instance). Thus
6470 -- if we found a header we'll check whether it matches other languages.
6472 ---------------------------
6473 -- Check_File_Based_Lang --
6474 ---------------------------
6476 procedure Check_File_Based_Lang is
6477 begin
6478 if not Header_File
6479 and then Suffix_Matches (Filename, Config.Naming_Data.Body_Suffix)
6480 then
6481 Unit := No_Name;
6482 Kind := Impl;
6483 Language := Tmp_Lang;
6485 if Current_Verbosity = High then
6486 Write_Str (" implementation of language ");
6487 Write_Line (Get_Name_String (Display_Language_Name));
6488 end if;
6490 elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
6491 if Current_Verbosity = High then
6492 Write_Str (" header of language ");
6493 Write_Line (Get_Name_String (Display_Language_Name));
6494 end if;
6496 if Header_File then
6497 Alternate_Languages := new Language_List_Element'
6498 (Language => Language,
6499 Next => Alternate_Languages);
6501 else
6502 Header_File := True;
6503 Kind := Spec;
6504 Unit := No_Name;
6505 Language := Tmp_Lang;
6506 end if;
6507 end if;
6508 end Check_File_Based_Lang;
6510 -- Start of processing for Check_File_Naming_Schemes
6512 begin
6513 Language := No_Language_Index;
6514 Alternate_Languages := null;
6515 Display_Language_Name := No_Name;
6516 Unit := No_Name;
6517 Lang_Kind := File_Based;
6518 Kind := Spec;
6520 Tmp_Lang := Project.Project.Languages;
6521 while Tmp_Lang /= No_Language_Index loop
6522 if Current_Verbosity = High then
6523 Write_Line
6524 (" Testing language "
6525 & Get_Name_String (Tmp_Lang.Name)
6526 & " Header_File=" & Header_File'Img);
6527 end if;
6529 Display_Language_Name := Tmp_Lang.Display_Name;
6530 Config := Tmp_Lang.Config;
6531 Lang_Kind := Config.Kind;
6533 case Config.Kind is
6534 when File_Based =>
6535 Check_File_Based_Lang;
6536 exit when Kind = Impl;
6538 when Unit_Based =>
6540 -- We know it belongs to a least a file_based language, no
6541 -- need to check unit-based ones.
6543 if not Header_File then
6544 Compute_Unit_Name
6545 (File_Name => File_Name,
6546 Naming => Config.Naming_Data,
6547 Kind => Kind,
6548 Unit => Unit,
6549 Project => Project,
6550 In_Tree => In_Tree);
6552 if Unit /= No_Name then
6553 Language := Tmp_Lang;
6554 exit;
6555 end if;
6556 end if;
6557 end case;
6559 Tmp_Lang := Tmp_Lang.Next;
6560 end loop;
6562 if Language = No_Language_Index
6563 and then Current_Verbosity = High
6564 then
6565 Write_Line (" not a source of any language");
6566 end if;
6567 end Check_File_Naming_Schemes;
6569 -------------------
6570 -- Override_Kind --
6571 -------------------
6573 procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is
6574 begin
6575 -- If the file was previously already associated with a unit, change it
6577 if Source.Unit /= null
6578 and then Source.Kind in Spec_Or_Body
6579 and then Source.Unit.File_Names (Source.Kind) /= null
6580 then
6581 -- If we had another file referencing the same unit (for instance it
6582 -- was in an extended project), that source file is in fact invisible
6583 -- from now on, and in particular doesn't belong to the same unit.
6585 if Source.Unit.File_Names (Source.Kind) /= Source then
6586 Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
6587 end if;
6589 Source.Unit.File_Names (Source.Kind) := null;
6590 end if;
6592 Source.Kind := Kind;
6594 if Current_Verbosity = High
6595 and then Source.File /= No_File
6596 then
6597 Write_Line ("Override kind for "
6598 & Get_Name_String (Source.File)
6599 & " kind=" & Source.Kind'Img);
6600 end if;
6602 if Source.Kind in Spec_Or_Body and then Source.Unit /= null then
6603 Source.Unit.File_Names (Source.Kind) := Source;
6604 end if;
6605 end Override_Kind;
6607 ----------------
6608 -- Check_File --
6609 ----------------
6611 procedure Check_File
6612 (Project : in out Project_Processing_Data;
6613 Data : in out Tree_Processing_Data;
6614 Source_Dir_Rank : Natural;
6615 Path : Path_Name_Type;
6616 Display_Path : Path_Name_Type;
6617 File_Name : File_Name_Type;
6618 Display_File_Name : File_Name_Type;
6619 Locally_Removed : Boolean;
6620 For_All_Sources : Boolean)
6622 Name_Loc : Name_Location :=
6623 Source_Names_Htable.Get
6624 (Project.Source_Names, File_Name);
6625 Check_Name : Boolean := False;
6626 Alternate_Languages : Language_List;
6627 Language : Language_Ptr;
6628 Source : Source_Id;
6629 Src_Ind : Source_File_Index;
6630 Unit : Name_Id;
6631 Display_Language_Name : Name_Id;
6632 Lang_Kind : Language_Kind;
6633 Kind : Source_Kind := Spec;
6635 begin
6636 if Current_Verbosity = High then
6637 Write_Line ("Checking file:");
6638 Write_Str (" Path = ");
6639 Write_Line (Get_Name_String (Path));
6640 Write_Str (" Rank =");
6641 Write_Line (Source_Dir_Rank'Img);
6642 end if;
6644 if Name_Loc = No_Name_Location then
6645 Check_Name := For_All_Sources;
6647 else
6648 if Name_Loc.Found then
6650 -- Check if it is OK to have the same file name in several
6651 -- source directories.
6653 if Source_Dir_Rank = Name_Loc.Source.Source_Dir_Rank then
6654 Error_Msg_File_1 := File_Name;
6655 Error_Msg
6656 (Data.Flags,
6657 "{ is found in several source directories",
6658 Name_Loc.Location, Project.Project);
6659 end if;
6661 else
6662 Name_Loc.Found := True;
6664 Source_Names_Htable.Set
6665 (Project.Source_Names, File_Name, Name_Loc);
6667 if Name_Loc.Source = No_Source then
6668 Check_Name := True;
6670 else
6671 Name_Loc.Source.Path := (Path, Display_Path);
6673 Source_Paths_Htable.Set
6674 (Data.Tree.Source_Paths_HT,
6675 Path,
6676 Name_Loc.Source);
6678 -- Check if this is a subunit
6680 if Name_Loc.Source.Unit /= No_Unit_Index
6681 and then Name_Loc.Source.Kind = Impl
6682 then
6683 Src_Ind := Sinput.P.Load_Project_File
6684 (Get_Name_String (Display_Path));
6686 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
6687 Override_Kind (Name_Loc.Source, Sep);
6688 end if;
6689 end if;
6691 Files_Htable.Set
6692 (Data.File_To_Source, File_Name, Name_Loc.Source);
6693 end if;
6694 end if;
6695 end if;
6697 if Check_Name then
6698 Check_File_Naming_Schemes
6699 (In_Tree => Data.Tree,
6700 Project => Project,
6701 File_Name => File_Name,
6702 Alternate_Languages => Alternate_Languages,
6703 Language => Language,
6704 Display_Language_Name => Display_Language_Name,
6705 Unit => Unit,
6706 Lang_Kind => Lang_Kind,
6707 Kind => Kind);
6709 if Language = No_Language_Index then
6711 -- A file name in a list must be a source of a language
6713 if Data.Flags.Error_On_Unknown_Language
6714 and then Name_Loc.Found
6715 then
6716 Error_Msg_File_1 := File_Name;
6717 Error_Msg
6718 (Data.Flags,
6719 "language unknown for {",
6720 Name_Loc.Location, Project.Project);
6721 end if;
6723 else
6724 Add_Source
6725 (Id => Source,
6726 Project => Project.Project,
6727 Source_Dir_Rank => Source_Dir_Rank,
6728 Lang_Id => Language,
6729 Kind => Kind,
6730 Data => Data,
6731 Alternate_Languages => Alternate_Languages,
6732 File_Name => File_Name,
6733 Display_File => Display_File_Name,
6734 Unit => Unit,
6735 Locally_Removed => Locally_Removed,
6736 Path => (Path, Display_Path));
6738 -- If it is a source specified in a list, update the entry in
6739 -- the Source_Names table.
6741 if Name_Loc.Found and then Name_Loc.Source = No_Source then
6742 Name_Loc.Source := Source;
6743 Source_Names_Htable.Set
6744 (Project.Source_Names, File_Name, Name_Loc);
6745 end if;
6746 end if;
6747 end if;
6748 end Check_File;
6750 ---------------------------------
6751 -- Expand_Subdirectory_Pattern --
6752 ---------------------------------
6754 procedure Expand_Subdirectory_Pattern
6755 (Project : Project_Id;
6756 Data : in out Tree_Processing_Data;
6757 Patterns : String_List_Id;
6758 Ignore : String_List_Id;
6759 Search_For : Search_Type;
6760 Resolve_Links : Boolean)
6762 package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable
6763 (Header_Num => Header_Num,
6764 Element => Boolean,
6765 No_Element => False,
6766 Key => Path_Name_Type,
6767 Hash => Hash,
6768 Equal => "=");
6769 -- Hash table stores recursive source directories, to avoid looking
6770 -- several times, and to avoid cycles that may be introduced by symbolic
6771 -- links.
6773 File_Pattern : GNAT.Regexp.Regexp;
6774 -- Pattern to use when matching file names.
6776 Visited : Recursive_Dirs.Instance;
6778 procedure Find_Pattern
6779 (Pattern_Id : Name_Id;
6780 Rank : Natural;
6781 Location : Source_Ptr);
6782 -- Find a specific pattern
6784 function Recursive_Find_Dirs
6785 (Path : Path_Information;
6786 Rank : Natural) return Boolean;
6787 -- Search all the subdirectories (recursively) of Path.
6788 -- Return True if at least one file or directory was processed
6790 function Subdirectory_Matches
6791 (Path : Path_Information;
6792 Rank : Natural) return Boolean;
6793 -- Called when a matching directory was found. If the user is in fact
6794 -- searching for files, we then search for those files matching the
6795 -- pattern within the directory.
6796 -- Return True if at least one file or directory was processed
6798 --------------------------
6799 -- Subdirectory_Matches --
6800 --------------------------
6802 function Subdirectory_Matches
6803 (Path : Path_Information;
6804 Rank : Natural) return Boolean
6806 Dir : Dir_Type;
6807 Name : String (1 .. 250);
6808 Last : Natural;
6809 Found : Path_Information;
6810 Success : Boolean := False;
6812 begin
6813 case Search_For is
6814 when Search_Directories =>
6815 Callback (Path, Rank);
6816 return True;
6818 when Search_Files =>
6819 Open (Dir, Get_Name_String (Path.Display_Name));
6820 loop
6821 Read (Dir, Name, Last);
6822 exit when Last = 0;
6824 if Name (Name'First .. Last) /= "."
6825 and then Name (Name'First .. Last) /= ".."
6826 and then Match (Name (Name'First .. Last), File_Pattern)
6827 then
6828 Get_Name_String (Path.Display_Name);
6829 Add_Str_To_Name_Buffer (Name (Name'First .. Last));
6831 Found.Display_Name := Name_Find;
6832 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6833 Found.Name := Name_Find;
6835 Callback (Found, Rank);
6836 Success := True;
6837 end if;
6838 end loop;
6840 Close (Dir);
6842 return Success;
6843 end case;
6844 end Subdirectory_Matches;
6846 -------------------------
6847 -- Recursive_Find_Dirs --
6848 -------------------------
6850 function Recursive_Find_Dirs
6851 (Path : Path_Information;
6852 Rank : Natural) return Boolean
6854 Path_Str : constant String := Get_Name_String (Path.Display_Name);
6855 Dir : Dir_Type;
6856 Name : String (1 .. 250);
6857 Last : Natural;
6858 Success : Boolean := False;
6860 begin
6861 if Current_Verbosity = High then
6862 Write_Str (" Looking for subdirs of """);
6863 Write_Str (Path_Str);
6864 Write_Line ("""");
6865 end if;
6867 if Recursive_Dirs.Get (Visited, Path.Name) then
6868 return Success;
6869 end if;
6871 Recursive_Dirs.Set (Visited, Path.Name, True);
6873 Success := Subdirectory_Matches (Path, Rank) or Success;
6875 Open (Dir, Path_Str);
6877 loop
6878 Read (Dir, Name, Last);
6879 exit when Last = 0;
6881 if Name (1 .. Last) /= "."
6882 and then Name (1 .. Last) /= ".."
6883 then
6884 declare
6885 Path_Name : constant String :=
6886 Normalize_Pathname
6887 (Name => Name (1 .. Last),
6888 Directory => Path_Str,
6889 Resolve_Links => Resolve_Links)
6890 & Directory_Separator;
6891 Path2 : Path_Information;
6892 OK : Boolean := True;
6894 begin
6895 if Is_Directory (Path_Name) then
6896 if Ignore /= Nil_String then
6897 declare
6898 Dir_Name : String := Name (1 .. Last);
6899 List : String_List_Id := Ignore;
6901 begin
6902 Canonical_Case_File_Name (Dir_Name);
6904 while List /= Nil_String loop
6905 Get_Name_String
6906 (Data.Tree.String_Elements.Table (List).Value);
6907 Canonical_Case_File_Name
6908 (Name_Buffer (1 .. Name_Len));
6909 OK := Name_Buffer (1 .. Name_Len) /= Dir_Name;
6910 exit when not OK;
6911 List :=
6912 Data.Tree.String_Elements.Table (List).Next;
6913 end loop;
6914 end;
6915 end if;
6917 if OK then
6918 Name_Len := 0;
6919 Add_Str_To_Name_Buffer (Path_Name);
6920 Path2.Display_Name := Name_Find;
6922 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6923 Path2.Name := Name_Find;
6925 Success :=
6926 Recursive_Find_Dirs (Path2, Rank) or Success;
6927 end if;
6928 end if;
6929 end;
6930 end if;
6931 end loop;
6933 Close (Dir);
6935 return Success;
6937 exception
6938 when Directory_Error =>
6939 return Success;
6940 end Recursive_Find_Dirs;
6942 ------------------
6943 -- Find_Pattern --
6944 ------------------
6946 procedure Find_Pattern
6947 (Pattern_Id : Name_Id;
6948 Rank : Natural;
6949 Location : Source_Ptr)
6951 Pattern : constant String := Get_Name_String (Pattern_Id);
6952 Pattern_End : Natural := Pattern'Last;
6953 Recursive : Boolean;
6954 Dir : File_Name_Type;
6955 Path_Name : Path_Information;
6956 Dir_Exists : Boolean;
6957 Has_Error : Boolean := False;
6958 Success : Boolean;
6960 begin
6961 if Current_Verbosity = High then
6962 Write_Str ("Expand_Subdirectory_Pattern (""");
6963 Write_Str (Pattern);
6964 Write_Line (""")");
6965 end if;
6967 -- If we are looking for files, find the pattern for the files
6969 if Search_For = Search_Files then
6970 while Pattern_End >= Pattern'First
6971 and then Pattern (Pattern_End) /= '/'
6972 and then Pattern (Pattern_End) /= Directory_Separator
6973 loop
6974 Pattern_End := Pattern_End - 1;
6975 end loop;
6977 if Pattern_End = Pattern'Last then
6978 Err_Vars.Error_Msg_File_1 := File_Name_Type (Pattern_Id);
6979 Error_Or_Warning
6980 (Data.Flags, Data.Flags.Missing_Source_Files,
6981 "Missing file name or pattern in {", Location, Project);
6982 return;
6983 end if;
6985 if Current_Verbosity = High then
6986 Write_Str (" file pattern=");
6987 Write_Line (Pattern (Pattern_End + 1 .. Pattern'Last));
6988 Write_Str (" Expand directory pattern=");
6989 Write_Line (Pattern (Pattern'First .. Pattern_End));
6990 end if;
6992 File_Pattern := Compile
6993 (Pattern (Pattern_End + 1 .. Pattern'Last),
6994 Glob => True,
6995 Case_Sensitive => File_Names_Case_Sensitive);
6997 -- If we had just "*.gpr", this is equivalent to "./*.gpr"
6999 if Pattern_End > Pattern'First then
7000 Pattern_End := Pattern_End - 1; -- Skip directory separator
7001 end if;
7002 end if;
7004 Recursive :=
7005 Pattern_End - 1 >= Pattern'First
7006 and then Pattern (Pattern_End - 1 .. Pattern_End) = "**"
7007 and then (Pattern_End - 1 = Pattern'First
7008 or else Pattern (Pattern_End - 2) = '/'
7009 or else Pattern (Pattern_End - 2) = Directory_Separator);
7011 if Recursive then
7012 Pattern_End := Pattern_End - 2;
7013 if Pattern_End > Pattern'First then
7014 Pattern_End := Pattern_End - 1; -- Skip '/'
7015 end if;
7016 end if;
7018 Name_Len := Pattern_End - Pattern'First + 1;
7019 Name_Buffer (1 .. Name_Len) := Pattern (Pattern'First .. Pattern_End);
7020 Dir := Name_Find;
7022 Locate_Directory
7023 (Project => Project,
7024 Name => Dir,
7025 Path => Path_Name,
7026 Dir_Exists => Dir_Exists,
7027 Data => Data,
7028 Must_Exist => False);
7030 if not Dir_Exists then
7031 Err_Vars.Error_Msg_File_1 := Dir;
7032 Error_Or_Warning
7033 (Data.Flags, Data.Flags.Missing_Source_Files,
7034 "{ is not a valid directory", Location, Project);
7035 Has_Error := Data.Flags.Missing_Source_Files = Error;
7036 end if;
7038 if not Has_Error then
7039 -- Links have been resolved if necessary, and Path_Name
7040 -- always ends with a directory separator.
7042 if Recursive then
7043 Success := Recursive_Find_Dirs (Path_Name, Rank);
7044 else
7045 Success := Subdirectory_Matches (Path_Name, Rank);
7046 end if;
7048 if not Success then
7049 case Search_For is
7050 when Search_Directories =>
7051 null; -- Error can't occur
7053 when Search_Files =>
7054 Err_Vars.Error_Msg_File_1 := File_Name_Type (Pattern_Id);
7055 Error_Or_Warning
7056 (Data.Flags, Data.Flags.Missing_Source_Files,
7057 "file { not found", Location, Project);
7058 end case;
7059 end if;
7060 end if;
7061 end Find_Pattern;
7063 -- Local variables
7065 Pattern_Id : String_List_Id := Patterns;
7066 Element : String_Element;
7067 Rank : Natural := 1;
7069 -- Start of processing for Expand_Subdirectory_Pattern
7071 begin
7072 while Pattern_Id /= Nil_String loop
7073 Element := Data.Tree.String_Elements.Table (Pattern_Id);
7074 Find_Pattern (Element.Value, Rank, Element.Location);
7075 Rank := Rank + 1;
7076 Pattern_Id := Element.Next;
7077 end loop;
7079 Recursive_Dirs.Reset (Visited);
7080 end Expand_Subdirectory_Pattern;
7082 ------------------------
7083 -- Search_Directories --
7084 ------------------------
7086 procedure Search_Directories
7087 (Project : in out Project_Processing_Data;
7088 Data : in out Tree_Processing_Data;
7089 For_All_Sources : Boolean)
7091 Source_Dir : String_List_Id;
7092 Element : String_Element;
7093 Src_Dir_Rank : Number_List_Index;
7094 Num_Nod : Number_Node;
7095 Dir : Dir_Type;
7096 Name : String (1 .. 1_000);
7097 Last : Natural;
7098 File_Name : File_Name_Type;
7099 Display_File_Name : File_Name_Type;
7101 begin
7102 if Current_Verbosity = High then
7103 Write_Line ("Looking for sources:");
7104 end if;
7106 -- Loop through subdirectories
7108 Source_Dir := Project.Project.Source_Dirs;
7109 Src_Dir_Rank := Project.Project.Source_Dir_Ranks;
7110 while Source_Dir /= Nil_String loop
7111 begin
7112 Num_Nod := Data.Tree.Number_Lists.Table (Src_Dir_Rank);
7113 Element := Data.Tree.String_Elements.Table (Source_Dir);
7115 -- Use Element.Value in this test, not Display_Value, because we
7116 -- want the symbolic links to be resolved when appropriate.
7118 if Element.Value /= No_Name then
7119 declare
7120 Source_Directory : constant String :=
7121 Get_Name_String (Element.Value)
7122 & Directory_Separator;
7124 Dir_Last : constant Natural :=
7125 Compute_Directory_Last (Source_Directory);
7127 Display_Source_Directory : constant String :=
7128 Get_Name_String
7129 (Element.Display_Value)
7130 & Directory_Separator;
7131 -- Display_Source_Directory is to allow us to open a UTF-8
7132 -- encoded directory on Windows.
7134 begin
7135 if Current_Verbosity = High then
7136 Write_Attr
7137 ("Source_Dir",
7138 Source_Directory (Source_Directory'First .. Dir_Last));
7139 Write_Line (Num_Nod.Number'Img);
7140 end if;
7142 -- We look to every entry in the source directory
7144 Open (Dir, Display_Source_Directory);
7146 loop
7147 Read (Dir, Name, Last);
7149 exit when Last = 0;
7151 -- In fast project loading mode (without -eL), the user
7152 -- guarantees that no directory has a name which is a
7153 -- valid source name, so we can avoid doing a system call
7154 -- here. This provides a very significant speed up on
7155 -- slow file systems (remote files for instance).
7157 if not Opt.Follow_Links_For_Files
7158 or else Is_Regular_File
7159 (Display_Source_Directory & Name (1 .. Last))
7160 then
7161 if Current_Verbosity = High then
7162 Write_Str (" Checking ");
7163 Write_Line (Name (1 .. Last));
7164 end if;
7166 Name_Len := Last;
7167 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
7168 Display_File_Name := Name_Find;
7170 if Osint.File_Names_Case_Sensitive then
7171 File_Name := Display_File_Name;
7172 else
7173 Canonical_Case_File_Name
7174 (Name_Buffer (1 .. Name_Len));
7175 File_Name := Name_Find;
7176 end if;
7178 declare
7179 Path_Name : constant String :=
7180 Normalize_Pathname
7181 (Name (1 .. Last),
7182 Directory =>
7183 Source_Directory
7184 (Source_Directory'First ..
7185 Dir_Last),
7186 Resolve_Links =>
7187 Opt.Follow_Links_For_Files,
7188 Case_Sensitive => True);
7190 Path : Path_Name_Type;
7191 FF : File_Found :=
7192 Excluded_Sources_Htable.Get
7193 (Project.Excluded, File_Name);
7194 To_Remove : Boolean := False;
7196 begin
7197 Name_Len := Path_Name'Length;
7198 Name_Buffer (1 .. Name_Len) := Path_Name;
7200 if Osint.File_Names_Case_Sensitive then
7201 Path := Name_Find;
7202 else
7203 Canonical_Case_File_Name
7204 (Name_Buffer (1 .. Name_Len));
7205 Path := Name_Find;
7206 end if;
7208 if FF /= No_File_Found then
7209 if not FF.Found then
7210 FF.Found := True;
7211 Excluded_Sources_Htable.Set
7212 (Project.Excluded, File_Name, FF);
7214 if Current_Verbosity = High then
7215 Write_Str (" excluded source """);
7216 Write_Str
7217 (Get_Name_String (Display_File_Name));
7218 Write_Line ("""");
7219 end if;
7221 -- Will mark the file as removed, but we
7222 -- still need to add it to the list: if we
7223 -- don't, the file will not appear in the
7224 -- mapping file and will cause the compiler
7225 -- to fail.
7227 To_Remove := True;
7228 end if;
7229 end if;
7231 -- Preserve the user's original casing and use of
7232 -- links. The display_value (a directory) already
7233 -- ends with a directory separator by construction,
7234 -- so no need to add one.
7236 Get_Name_String (Element.Display_Value);
7237 Get_Name_String_And_Append (Display_File_Name);
7239 Check_File
7240 (Project => Project,
7241 Source_Dir_Rank => Num_Nod.Number,
7242 Data => Data,
7243 Path => Path,
7244 Display_Path => Name_Find,
7245 File_Name => File_Name,
7246 Locally_Removed => To_Remove,
7247 Display_File_Name => Display_File_Name,
7248 For_All_Sources => For_All_Sources);
7249 end;
7250 end if;
7251 end loop;
7253 Close (Dir);
7254 end;
7255 end if;
7257 exception
7258 when Directory_Error =>
7259 null;
7260 end;
7262 Source_Dir := Element.Next;
7263 Src_Dir_Rank := Num_Nod.Next;
7264 end loop;
7266 if Current_Verbosity = High then
7267 Write_Line ("end Looking for sources.");
7268 end if;
7269 end Search_Directories;
7271 ----------------------------
7272 -- Load_Naming_Exceptions --
7273 ----------------------------
7275 procedure Load_Naming_Exceptions
7276 (Project : in out Project_Processing_Data;
7277 Data : in out Tree_Processing_Data)
7279 Source : Source_Id;
7280 Iter : Source_Iterator;
7282 begin
7283 Iter := For_Each_Source (Data.Tree, Project.Project);
7284 loop
7285 Source := Prj.Element (Iter);
7286 exit when Source = No_Source;
7288 -- An excluded file cannot also be an exception file name
7290 if Excluded_Sources_Htable.Get (Project.Excluded, Source.File) /=
7291 No_File_Found
7292 then
7293 Error_Msg_File_1 := Source.File;
7294 Error_Msg
7295 (Data.Flags,
7296 "{ cannot be both excluded and an exception file name",
7297 No_Location, Project.Project);
7298 end if;
7300 if Current_Verbosity = High then
7301 Write_Str ("Naming exception: Putting source file ");
7302 Write_Str (Get_Name_String (Source.File));
7303 Write_Line (" in Source_Names");
7304 end if;
7306 Source_Names_Htable.Set
7307 (Project.Source_Names,
7308 K => Source.File,
7309 E => Name_Location'
7310 (Name => Source.File,
7311 Location => Source.Location,
7312 Source => Source,
7313 Listed => False,
7314 Found => False));
7316 -- If this is an Ada exception, record in table Unit_Exceptions
7318 if Source.Unit /= No_Unit_Index then
7319 declare
7320 Unit_Except : Unit_Exception :=
7321 Unit_Exceptions_Htable.Get
7322 (Project.Unit_Exceptions, Source.Unit.Name);
7324 begin
7325 Unit_Except.Name := Source.Unit.Name;
7327 if Source.Kind = Spec then
7328 Unit_Except.Spec := Source.File;
7329 else
7330 Unit_Except.Impl := Source.File;
7331 end if;
7333 Unit_Exceptions_Htable.Set
7334 (Project.Unit_Exceptions, Source.Unit.Name, Unit_Except);
7335 end;
7336 end if;
7338 Next (Iter);
7339 end loop;
7340 end Load_Naming_Exceptions;
7342 ----------------------
7343 -- Look_For_Sources --
7344 ----------------------
7346 procedure Look_For_Sources
7347 (Project : in out Project_Processing_Data;
7348 Data : in out Tree_Processing_Data)
7350 Object_Files : Object_File_Names_Htable.Instance;
7351 Iter : Source_Iterator;
7352 Src : Source_Id;
7354 procedure Check_Object (Src : Source_Id);
7355 -- Check if object file name of Src is already used in the project tree,
7356 -- and report an error if so.
7358 procedure Check_Object_Files;
7359 -- Check that no two sources of this project have the same object file
7361 procedure Mark_Excluded_Sources;
7362 -- Mark as such the sources that are declared as excluded
7364 procedure Check_Missing_Sources;
7365 -- Check whether one of the languages has no sources, and report an
7366 -- error when appropriate
7368 procedure Get_Sources_From_Source_Info;
7369 -- Get the source information from the tabes that were created when a
7370 -- source info fie was read.
7372 ---------------------------
7373 -- Check_Missing_Sources --
7374 ---------------------------
7376 procedure Check_Missing_Sources is
7377 Extending : constant Boolean :=
7378 Project.Project.Extends /= No_Project;
7379 Language : Language_Ptr;
7380 Source : Source_Id;
7381 Alt_Lang : Language_List;
7382 Continuation : Boolean := False;
7383 Iter : Source_Iterator;
7384 begin
7385 if not Project.Project.Externally_Built
7386 and then not Extending
7387 then
7388 Language := Project.Project.Languages;
7389 while Language /= No_Language_Index loop
7391 -- If there are no sources for this language, check if there
7392 -- are sources for which this is an alternate language.
7394 if Language.First_Source = No_Source
7395 and then (Data.Flags.Require_Sources_Other_Lang
7396 or else Language.Name = Name_Ada)
7397 then
7398 Iter := For_Each_Source (In_Tree => Data.Tree,
7399 Project => Project.Project);
7400 Source_Loop : loop
7401 Source := Element (Iter);
7402 exit Source_Loop when Source = No_Source
7403 or else Source.Language = Language;
7405 Alt_Lang := Source.Alternate_Languages;
7406 while Alt_Lang /= null loop
7407 exit Source_Loop when Alt_Lang.Language = Language;
7408 Alt_Lang := Alt_Lang.Next;
7409 end loop;
7411 Next (Iter);
7412 end loop Source_Loop;
7414 if Source = No_Source then
7415 Report_No_Sources
7416 (Project.Project,
7417 Get_Name_String (Language.Display_Name),
7418 Data,
7419 Project.Source_List_File_Location,
7420 Continuation);
7421 Continuation := True;
7422 end if;
7423 end if;
7425 Language := Language.Next;
7426 end loop;
7427 end if;
7428 end Check_Missing_Sources;
7430 ------------------
7431 -- Check_Object --
7432 ------------------
7434 procedure Check_Object (Src : Source_Id) is
7435 Source : Source_Id;
7437 begin
7438 Source := Object_File_Names_Htable.Get (Object_Files, Src.Object);
7440 -- We cannot just check on "Source /= Src", since we might have
7441 -- two different entries for the same file (and since that's
7442 -- the same file it is expected that it has the same object)
7444 if Source /= No_Source
7445 and then Source.Path /= Src.Path
7446 then
7447 Error_Msg_File_1 := Src.File;
7448 Error_Msg_File_2 := Source.File;
7449 Error_Msg
7450 (Data.Flags,
7451 "{ and { have the same object file name",
7452 No_Location, Project.Project);
7454 else
7455 Object_File_Names_Htable.Set (Object_Files, Src.Object, Src);
7456 end if;
7457 end Check_Object;
7459 ---------------------------
7460 -- Mark_Excluded_Sources --
7461 ---------------------------
7463 procedure Mark_Excluded_Sources is
7464 Source : Source_Id := No_Source;
7465 Excluded : File_Found;
7466 Proj : Project_Id;
7468 begin
7469 -- Minor optimization: if there are no excluded files, no need to
7470 -- traverse the list of sources. We cannot however also check whether
7471 -- the existing exceptions have ".Found" set to True (indicating we
7472 -- found them before) because we need to do some final processing on
7473 -- them in any case.
7475 if Excluded_Sources_Htable.Get_First (Project.Excluded) /=
7476 No_File_Found
7477 then
7478 Proj := Project.Project;
7479 while Proj /= No_Project loop
7480 Iter := For_Each_Source (Data.Tree, Proj);
7481 while Prj.Element (Iter) /= No_Source loop
7482 Source := Prj.Element (Iter);
7483 Excluded := Excluded_Sources_Htable.Get
7484 (Project.Excluded, Source.File);
7486 if Excluded /= No_File_Found then
7487 Source.Locally_Removed := True;
7488 Source.In_Interfaces := False;
7490 if Current_Verbosity = High then
7491 Write_Str ("Removing file ");
7492 Write_Line
7493 (Get_Name_String (Excluded.File)
7494 & " " & Get_Name_String (Source.Project.Name));
7495 end if;
7497 Excluded_Sources_Htable.Remove
7498 (Project.Excluded, Source.File);
7499 end if;
7501 Next (Iter);
7502 end loop;
7504 Proj := Proj.Extends;
7505 end loop;
7506 end if;
7508 -- If we have any excluded element left, that means we did not find
7509 -- the source file
7511 Excluded := Excluded_Sources_Htable.Get_First (Project.Excluded);
7512 while Excluded /= No_File_Found loop
7513 if not Excluded.Found then
7515 -- Check if the file belongs to another imported project to
7516 -- provide a better error message.
7518 Src := Find_Source
7519 (In_Tree => Data.Tree,
7520 Project => Project.Project,
7521 In_Imported_Only => True,
7522 Base_Name => Excluded.File);
7524 Err_Vars.Error_Msg_File_1 := Excluded.File;
7526 if Src = No_Source then
7527 Error_Msg
7528 (Data.Flags,
7529 "unknown file {", Excluded.Location, Project.Project);
7530 else
7531 Error_Msg
7532 (Data.Flags,
7533 "cannot remove a source from an imported project: {",
7534 Excluded.Location, Project.Project);
7535 end if;
7536 end if;
7538 Excluded := Excluded_Sources_Htable.Get_Next (Project.Excluded);
7539 end loop;
7540 end Mark_Excluded_Sources;
7542 ------------------------
7543 -- Check_Object_Files --
7544 ------------------------
7546 procedure Check_Object_Files is
7547 Iter : Source_Iterator;
7548 Src_Id : Source_Id;
7549 Src_Ind : Source_File_Index;
7551 begin
7552 Iter := For_Each_Source (Data.Tree);
7553 loop
7554 Src_Id := Prj.Element (Iter);
7555 exit when Src_Id = No_Source;
7557 if Is_Compilable (Src_Id)
7558 and then Src_Id.Language.Config.Object_Generated
7559 and then Is_Extending (Project.Project, Src_Id.Project)
7560 then
7561 if Src_Id.Unit = No_Unit_Index then
7562 if Src_Id.Kind = Impl then
7563 Check_Object (Src_Id);
7564 end if;
7566 else
7567 case Src_Id.Kind is
7568 when Spec =>
7569 if Other_Part (Src_Id) = No_Source then
7570 Check_Object (Src_Id);
7571 end if;
7573 when Sep =>
7574 null;
7576 when Impl =>
7577 if Other_Part (Src_Id) /= No_Source then
7578 Check_Object (Src_Id);
7580 else
7581 -- Check if it is a subunit
7583 Src_Ind :=
7584 Sinput.P.Load_Project_File
7585 (Get_Name_String (Src_Id.Path.Display_Name));
7587 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
7588 Override_Kind (Src_Id, Sep);
7589 else
7590 Check_Object (Src_Id);
7591 end if;
7592 end if;
7593 end case;
7594 end if;
7595 end if;
7597 Next (Iter);
7598 end loop;
7599 end Check_Object_Files;
7601 ----------------------------------
7602 -- Get_Sources_From_Source_Info --
7603 ----------------------------------
7605 procedure Get_Sources_From_Source_Info is
7606 Iter : Source_Info_Iterator;
7607 Src : Source_Info;
7608 Id : Source_Id;
7609 Lang_Id : Language_Ptr;
7610 begin
7611 Initialize (Iter, Project.Project.Name);
7613 loop
7614 Src := Source_Info_Of (Iter);
7616 exit when Src = No_Source_Info;
7618 Id := new Source_Data;
7620 Id.Project := Project.Project;
7622 Lang_Id := Project.Project.Languages;
7623 while Lang_Id /= No_Language_Index and then
7624 Lang_Id.Name /= Src.Language
7625 loop
7626 Lang_Id := Lang_Id.Next;
7627 end loop;
7629 if Lang_Id = No_Language_Index then
7630 Prj.Com.Fail
7631 ("unknown language " &
7632 Get_Name_String (Src.Language) &
7633 " for project " &
7634 Get_Name_String (Src.Project) &
7635 " in source info file");
7636 end if;
7638 Id.Language := Lang_Id;
7639 Id.Kind := Src.Kind;
7641 Id.Index := Src.Index;
7643 Id.Path :=
7644 (Path_Name_Type (Src.Display_Path_Name),
7645 Path_Name_Type (Src.Path_Name));
7647 Name_Len := 0;
7648 Add_Str_To_Name_Buffer
7649 (Ada.Directories.Simple_Name
7650 (Get_Name_String (Src.Path_Name)));
7651 Id.File := Name_Find;
7653 Id.Next_With_File_Name :=
7654 Source_Files_Htable.Get (Data.Tree.Source_Files_HT, Id.File);
7655 Source_Files_Htable.Set (Data.Tree.Source_Files_HT, Id.File, Id);
7657 Name_Len := 0;
7658 Add_Str_To_Name_Buffer
7659 (Ada.Directories.Simple_Name
7660 (Get_Name_String (Src.Display_Path_Name)));
7661 Id.Display_File := Name_Find;
7663 Id.Dep_Name := Dependency_Name
7664 (Id.File, Id.Language.Config.Dependency_Kind);
7665 Id.Naming_Exception := Src.Naming_Exception;
7666 Id.Object := Object_Name
7667 (Id.File, Id.Language.Config.Object_File_Suffix);
7668 Id.Switches := Switches_Name (Id.File);
7670 -- Add the source id to the Unit_Sources_HT hash table, if the
7671 -- unit name is not null.
7673 if Src.Kind /= Sep and then Src.Unit_Name /= No_Name then
7675 declare
7676 UData : Unit_Index :=
7677 Units_Htable.Get (Data.Tree.Units_HT, Src.Unit_Name);
7678 begin
7679 if UData = No_Unit_Index then
7680 UData := new Unit_Data;
7681 UData.Name := Src.Unit_Name;
7682 Units_Htable.Set
7683 (Data.Tree.Units_HT, Src.Unit_Name, UData);
7684 end if;
7686 Id.Unit := UData;
7687 end;
7689 -- Note that this updates Unit information as well
7691 Override_Kind (Id, Id.Kind);
7692 end if;
7694 if Src.Index /= 0 then
7695 Project.Project.Has_Multi_Unit_Sources := True;
7696 end if;
7698 -- Add the source to the language list
7700 Id.Next_In_Lang := Id.Language.First_Source;
7701 Id.Language.First_Source := Id;
7703 Files_Htable.Set (Data.File_To_Source, Id.File, Id);
7705 Next (Iter);
7706 end loop;
7707 end Get_Sources_From_Source_Info;
7709 -- Start of processing for Look_For_Sources
7711 begin
7712 if Data.Tree.Source_Info_File_Exists then
7713 Get_Sources_From_Source_Info;
7715 else
7716 if Project.Project.Source_Dirs /= Nil_String then
7717 Find_Excluded_Sources (Project, Data);
7719 if Project.Project.Languages /= No_Language_Index then
7720 Load_Naming_Exceptions (Project, Data);
7721 Find_Sources (Project, Data);
7722 Mark_Excluded_Sources;
7723 Check_Object_Files;
7724 Check_Missing_Sources;
7725 end if;
7726 end if;
7728 Object_File_Names_Htable.Reset (Object_Files);
7729 end if;
7730 end Look_For_Sources;
7732 ------------------
7733 -- Path_Name_Of --
7734 ------------------
7736 function Path_Name_Of
7737 (File_Name : File_Name_Type;
7738 Directory : Path_Name_Type) return String
7740 Result : String_Access;
7741 The_Directory : constant String := Get_Name_String (Directory);
7743 begin
7744 Get_Name_String (File_Name);
7745 Result :=
7746 Locate_Regular_File
7747 (File_Name => Name_Buffer (1 .. Name_Len),
7748 Path => The_Directory);
7750 if Result = null then
7751 return "";
7752 else
7753 declare
7754 R : String := Result.all;
7755 begin
7756 Free (Result);
7757 Canonical_Case_File_Name (R);
7758 return R;
7759 end;
7760 end if;
7761 end Path_Name_Of;
7763 -------------------
7764 -- Remove_Source --
7765 -------------------
7767 procedure Remove_Source
7768 (Tree : Project_Tree_Ref;
7769 Id : Source_Id;
7770 Replaced_By : Source_Id)
7772 Source : Source_Id;
7774 begin
7775 if Current_Verbosity = High then
7776 Write_Str ("Removing source ");
7777 Write_Str (Get_Name_String (Id.File));
7779 if Id.Index /= 0 then
7780 Write_Str (" at" & Id.Index'Img);
7781 end if;
7783 Write_Eol;
7784 end if;
7786 if Replaced_By /= No_Source then
7787 Id.Replaced_By := Replaced_By;
7788 Replaced_By.Declared_In_Interfaces := Id.Declared_In_Interfaces;
7790 if Id.File /= Replaced_By.File then
7791 declare
7792 Replacement : constant File_Name_Type :=
7793 Replaced_Source_HTable.Get
7794 (Tree.Replaced_Sources, Id.File);
7796 begin
7797 Replaced_Source_HTable.Set
7798 (Tree.Replaced_Sources, Id.File, Replaced_By.File);
7800 if Replacement = No_File then
7801 Tree.Replaced_Source_Number :=
7802 Tree.Replaced_Source_Number + 1;
7803 end if;
7804 end;
7805 end if;
7806 end if;
7808 Id.In_Interfaces := False;
7809 Id.Locally_Removed := True;
7811 -- ??? Should we remove the source from the unit ? The file is not used,
7812 -- so probably should not be referenced from the unit. On the other hand
7813 -- it might give useful additional info
7814 -- if Id.Unit /= null then
7815 -- Id.Unit.File_Names (Id.Kind) := null;
7816 -- end if;
7818 Source := Id.Language.First_Source;
7820 if Source = Id then
7821 Id.Language.First_Source := Id.Next_In_Lang;
7823 else
7824 while Source.Next_In_Lang /= Id loop
7825 Source := Source.Next_In_Lang;
7826 end loop;
7828 Source.Next_In_Lang := Id.Next_In_Lang;
7829 end if;
7830 end Remove_Source;
7832 -----------------------
7833 -- Report_No_Sources --
7834 -----------------------
7836 procedure Report_No_Sources
7837 (Project : Project_Id;
7838 Lang_Name : String;
7839 Data : Tree_Processing_Data;
7840 Location : Source_Ptr;
7841 Continuation : Boolean := False)
7843 begin
7844 case Data.Flags.When_No_Sources is
7845 when Silent =>
7846 null;
7848 when Warning | Error =>
7849 declare
7850 Msg : constant String :=
7851 "<there are no " &
7852 Lang_Name &
7853 " sources in this project";
7855 begin
7856 Error_Msg_Warn := Data.Flags.When_No_Sources = Warning;
7858 if Continuation then
7859 Error_Msg (Data.Flags, "\" & Msg, Location, Project);
7860 else
7861 Error_Msg (Data.Flags, Msg, Location, Project);
7862 end if;
7863 end;
7864 end case;
7865 end Report_No_Sources;
7867 ----------------------
7868 -- Show_Source_Dirs --
7869 ----------------------
7871 procedure Show_Source_Dirs
7872 (Project : Project_Id;
7873 In_Tree : Project_Tree_Ref)
7875 Current : String_List_Id;
7876 Element : String_Element;
7878 begin
7879 Write_Line ("Source_Dirs:");
7881 Current := Project.Source_Dirs;
7882 while Current /= Nil_String loop
7883 Element := In_Tree.String_Elements.Table (Current);
7884 Write_Str (" ");
7885 Write_Line (Get_Name_String (Element.Display_Value));
7886 Current := Element.Next;
7887 end loop;
7889 Write_Line ("end Source_Dirs.");
7890 end Show_Source_Dirs;
7892 ---------------------------
7893 -- Process_Naming_Scheme --
7894 ---------------------------
7896 procedure Process_Naming_Scheme
7897 (Tree : Project_Tree_Ref;
7898 Root_Project : Project_Id;
7899 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
7900 Flags : Processing_Flags)
7902 procedure Recursive_Check
7903 (Project : Project_Id;
7904 Data : in out Tree_Processing_Data);
7905 -- Check_Naming_Scheme for the project
7907 ---------------------
7908 -- Recursive_Check --
7909 ---------------------
7911 procedure Recursive_Check
7912 (Project : Project_Id;
7913 Data : in out Tree_Processing_Data)
7915 begin
7916 if Verbose_Mode then
7917 Write_Str ("Processing_Naming_Scheme for project """);
7918 Write_Str (Get_Name_String (Project.Name));
7919 Write_Line ("""");
7920 end if;
7922 Prj.Nmsc.Check (Project, Data);
7923 end Recursive_Check;
7925 procedure Check_All_Projects is new
7926 For_Every_Project_Imported (Tree_Processing_Data, Recursive_Check);
7928 Data : Tree_Processing_Data;
7930 -- Start of processing for Process_Naming_Scheme
7931 begin
7932 Lib_Data_Table.Init;
7933 Initialize (Data, Tree => Tree, Node_Tree => Node_Tree, Flags => Flags);
7934 Check_All_Projects (Root_Project, Data, Imported_First => True);
7935 Free (Data);
7937 -- Adjust language configs for projects that are extended
7939 declare
7940 List : Project_List;
7941 Proj : Project_Id;
7942 Exte : Project_Id;
7943 Lang : Language_Ptr;
7944 Elng : Language_Ptr;
7946 begin
7947 List := Tree.Projects;
7948 while List /= null loop
7949 Proj := List.Project;
7950 Exte := Proj;
7951 while Exte.Extended_By /= No_Project loop
7952 Exte := Exte.Extended_By;
7953 end loop;
7955 if Exte /= Proj then
7956 Lang := Proj.Languages;
7958 if Lang /= No_Language_Index then
7959 loop
7960 Elng := Get_Language_From_Name
7961 (Exte, Get_Name_String (Lang.Name));
7962 exit when Elng /= No_Language_Index;
7963 Exte := Exte.Extends;
7964 end loop;
7966 if Elng /= Lang then
7967 Lang.Config := Elng.Config;
7968 end if;
7969 end if;
7970 end if;
7972 List := List.Next;
7973 end loop;
7974 end;
7975 end Process_Naming_Scheme;
7977 end Prj.Nmsc;