1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2000-2011, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Err_Vars; use Err_Vars;
28 with Osint; use Osint;
29 with Output; use Output;
31 with Prj.Env; use Prj.Env;
32 with Prj.Err; use Prj.Err;
33 with Prj.Tree; use Prj.Tree;
34 with Prj.Util; use Prj.Util;
36 with Snames; use Snames;
37 with Targparm; use Targparm;
39 with Ada.Characters.Handling; use Ada.Characters.Handling;
40 with Ada.Directories; use Ada.Directories;
41 with Ada.Strings; use Ada.Strings;
42 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
43 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
45 with GNAT.Case_Util; use GNAT.Case_Util;
46 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
47 with GNAT.Dynamic_HTables;
48 with GNAT.Regexp; use GNAT.Regexp;
51 package body Prj.Nmsc is
53 No_Continuation_String : aliased String := "";
54 Continuation_String : aliased String := "\";
55 -- Used in Check_Library for continuation error messages at the same
58 type Name_Location is record
59 Name : File_Name_Type;
60 -- Key is duplicated, so that it is known when using functions Get_First
61 -- and Get_Next, as these functions only return an Element.
63 Location : Source_Ptr;
64 Source : Source_Id := No_Source;
65 Listed : Boolean := False;
66 Found : Boolean := False;
69 No_Name_Location : constant Name_Location :=
71 Location => No_Location,
76 package Source_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable
77 (Header_Num => Header_Num,
78 Element => Name_Location,
79 No_Element => No_Name_Location,
80 Key => File_Name_Type,
83 -- File name information found in string list attribute (Source_Files or
84 -- Source_List_File). Except is set to True if source is a naming exception
85 -- in the project. Used to check that all referenced files were indeed
88 type Unit_Exception is record
90 -- Key is duplicated, so that it is known when using functions Get_First
91 -- and Get_Next, as these functions only return an Element.
93 Spec : File_Name_Type;
94 Impl : File_Name_Type;
97 No_Unit_Exception : constant Unit_Exception := (No_Name, No_File, No_File);
99 package Unit_Exceptions_Htable is new GNAT.Dynamic_HTables.Simple_HTable
100 (Header_Num => Header_Num,
101 Element => Unit_Exception,
102 No_Element => No_Unit_Exception,
106 -- Record special naming schemes for Ada units (name of spec file and name
107 -- of implementation file). The elements in this list come from the naming
108 -- exceptions specified in the project files.
110 type File_Found is record
111 File : File_Name_Type := No_File;
112 Excl_File : File_Name_Type := No_File;
113 Excl_Line : Natural := 0;
114 Found : Boolean := False;
115 Location : Source_Ptr := No_Location;
118 No_File_Found : constant File_Found :=
119 (No_File, No_File, 0, False, No_Location);
121 package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable
122 (Header_Num => Header_Num,
123 Element => File_Found,
124 No_Element => No_File_Found,
125 Key => File_Name_Type,
128 -- A hash table to store the base names of excluded files, if any
130 package Object_File_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable
131 (Header_Num => Header_Num,
132 Element => Source_Id,
133 No_Element => No_Source,
134 Key => File_Name_Type,
137 -- A hash table to store the object file names for a project, to check that
138 -- two different sources have different object file names.
140 type Project_Processing_Data is record
141 Project : Project_Id;
142 Source_Names : Source_Names_Htable.Instance;
143 Unit_Exceptions : Unit_Exceptions_Htable.Instance;
144 Excluded : Excluded_Sources_Htable.Instance;
146 Source_List_File_Location : Source_Ptr;
147 -- Location of the Source_List_File attribute, for error messages
149 -- This is similar to Tree_Processing_Data, but contains project-specific
150 -- information which is only useful while processing the project, and can
151 -- be discarded as soon as we have finished processing the project
153 type Tree_Processing_Data is record
154 Tree : Project_Tree_Ref;
155 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
156 Flags : Prj.Processing_Flags;
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
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,
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.
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);
185 procedure Free (Data : in out Tree_Processing_Data);
186 -- Free the memory occupied by Data
189 (Project : Project_Id;
190 Data : in out Tree_Processing_Data);
191 -- Process the naming scheme for a single project
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
216 type Search_Type is (Search_Files, Search_Directories);
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.
234 -- Every time such a file or directory is found, the callback is called.
235 -- Resolve_Links indicates whether we should resolve links while
236 -- normalizing names.
238 -- In the callback, Pattern_Index is the index within Patterns where the
239 -- expanded pattern was found (1 for the first element of Patterns and
240 -- all its matching directories, then 2,...).
242 -- We use a generic and not an access-to-subprogram because in some cases
243 -- this code is compiled with the restriction No_Implicit_Dynamic_Code.
244 -- An error message is raised if a pattern does not match any file.
248 Data : in out Tree_Processing_Data;
249 Project : Project_Id;
250 Source_Dir_Rank : Natural;
251 Lang_Id : Language_Ptr;
253 File_Name : File_Name_Type;
254 Display_File : File_Name_Type;
255 Naming_Exception : Boolean := False;
256 Path : Path_Information := No_Path_Information;
257 Alternate_Languages : Language_List := null;
258 Unit : Name_Id := No_Name;
260 Locally_Removed : Boolean := False;
261 Location : Source_Ptr := No_Location);
262 -- Add a new source to the different lists: list of all sources in the
263 -- project tree, list of source of a project and list of sources of a
264 -- language. If Path is specified, the file is also added to
265 -- Source_Paths_HT. Location is used for error messages
267 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type;
268 -- Same as Osint.Canonical_Case_File_Name but applies to Name_Id.
269 -- This alters Name_Buffer.
271 function Suffix_Matches
273 Suffix : File_Name_Type) return Boolean;
274 -- True if the file name ends with the given suffix. Always returns False
275 -- if Suffix is No_Name.
277 procedure Replace_Into_Name_Buffer
280 Replacement : Character);
281 -- Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is
282 -- converted to lower-case at the same time.
284 procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
285 -- Check that a name is a valid Ada unit name
287 procedure Check_Package_Naming
288 (Project : Project_Id;
289 Data : in out Tree_Processing_Data);
290 -- Check the naming scheme part of Data, and initialize the naming scheme
291 -- data in the config of the various languages.
293 procedure Check_Configuration
294 (Project : Project_Id;
295 Data : in out Tree_Processing_Data);
296 -- Check the configuration attributes for the project
298 procedure Check_If_Externally_Built
299 (Project : Project_Id;
300 Data : in out Tree_Processing_Data);
301 -- Check attribute Externally_Built of project Project in project tree
302 -- Data.Tree and modify its data Data if it has the value "true".
304 procedure Check_Interfaces
305 (Project : Project_Id;
306 Data : in out Tree_Processing_Data);
307 -- If a list of sources is specified in attribute Interfaces, set
308 -- In_Interfaces only for the sources specified in the list.
310 procedure Check_Library_Attributes
311 (Project : Project_Id;
312 Data : in out Tree_Processing_Data);
313 -- Check the library attributes of project Project in project tree
314 -- and modify its data Data accordingly.
316 procedure Check_Abstract_Project
317 (Project : Project_Id;
318 Data : in out Tree_Processing_Data);
319 -- Check abstract projects attributes
321 procedure Check_Programming_Languages
322 (Project : Project_Id;
323 Data : in out Tree_Processing_Data);
324 -- Check attribute Languages for the project with data Data in project
325 -- tree Data.Tree and set the components of Data for all the programming
326 -- languages indicated in attribute Languages, if any.
328 procedure Check_Stand_Alone_Library
329 (Project : Project_Id;
330 Data : in out Tree_Processing_Data);
331 -- Check if project Project in project tree Data.Tree is a Stand-Alone
332 -- Library project, and modify its data Data accordingly if it is one.
334 function Compute_Directory_Last (Dir : String) return Natural;
335 -- Return the index of the last significant character in Dir. This is used
336 -- to avoid duplicate '/' (slash) characters at the end of directory names.
338 procedure Search_Directories
339 (Project : in out Project_Processing_Data;
340 Data : in out Tree_Processing_Data;
341 For_All_Sources : Boolean);
342 -- Search the source directories to find the sources. If For_All_Sources is
343 -- True, check each regular file name against the naming schemes of the
344 -- various languages. Otherwise consider only the file names in hash table
345 -- Source_Names. If Allow_Duplicate_Basenames then files with identical
346 -- base names are permitted within a project for source-based languages
347 -- (never for unit based languages).
350 (Project : in out Project_Processing_Data;
351 Data : in out Tree_Processing_Data;
352 Source_Dir_Rank : Natural;
353 Path : Path_Name_Type;
354 Display_Path : Path_Name_Type;
355 File_Name : File_Name_Type;
356 Display_File_Name : File_Name_Type;
357 Locally_Removed : Boolean;
358 For_All_Sources : Boolean);
359 -- Check if file File_Name is a valid source of the project. This is used
360 -- in multi-language mode only. When the file matches one of the naming
361 -- schemes, it is added to various htables through Add_Source and to
362 -- Source_Paths_Htable.
364 -- File_Name is the same as Display_File_Name, but has been normalized.
365 -- They do not include the directory information.
367 -- Path and Display_Path on the other hand are the full path to the file.
368 -- Path must have been normalized (canonical casing and possibly links
371 -- Source_Directory is the directory in which the file was found. It is
372 -- neither normalized nor has had links resolved, and must not end with a
373 -- a directory separator, to avoid duplicates later on.
375 -- If For_All_Sources is True, then all possible file names are analyzed
376 -- otherwise only those currently set in the Source_Names hash table.
378 procedure Check_File_Naming_Schemes
379 (In_Tree : Project_Tree_Ref;
380 Project : Project_Processing_Data;
381 File_Name : File_Name_Type;
382 Alternate_Languages : out Language_List;
383 Language : out Language_Ptr;
384 Display_Language_Name : out Name_Id;
386 Lang_Kind : out Language_Kind;
387 Kind : out Source_Kind);
388 -- Check if the file name File_Name conforms to one of the naming schemes
389 -- of the project. If the file does not match one of the naming schemes,
390 -- set Language to No_Language_Index. Filename is the name of the file
391 -- being investigated. It has been normalized (case-folded). File_Name is
394 procedure Get_Directories
395 (Project : Project_Id;
396 Data : in out Tree_Processing_Data);
397 -- Get the object directory, the exec directory and the source directories
401 (Project : Project_Id;
402 Data : in out Tree_Processing_Data);
403 -- Get the mains of a project from attribute Main, if it exists, and put
404 -- them in the project data.
406 procedure Get_Sources_From_File
408 Location : Source_Ptr;
409 Project : in out Project_Processing_Data;
410 Data : in out Tree_Processing_Data);
411 -- Get the list of sources from a text file and put them in hash table
414 procedure Find_Sources
415 (Project : in out Project_Processing_Data;
416 Data : in out Tree_Processing_Data);
417 -- Process the Source_Files and Source_List_File attributes, and store the
418 -- list of source files into the Source_Names htable. When these attributes
419 -- are not defined, find all files matching the naming schemes in the
420 -- source directories. If Allow_Duplicate_Basenames, then files with the
421 -- same base names are authorized within a project for source-based
422 -- languages (never for unit based languages)
424 procedure Compute_Unit_Name
425 (File_Name : File_Name_Type;
426 Naming : Lang_Naming_Data;
427 Kind : out Source_Kind;
429 Project : Project_Processing_Data;
430 In_Tree : Project_Tree_Ref);
431 -- Check whether the file matches the naming scheme. If it does,
432 -- compute its unit name. If Unit is set to No_Name on exit, none of the
433 -- other out parameters are relevant.
435 procedure Check_Illegal_Suffix
436 (Project : Project_Id;
437 Suffix : File_Name_Type;
438 Dot_Replacement : File_Name_Type;
439 Attribute_Name : String;
440 Location : Source_Ptr;
441 Data : in out Tree_Processing_Data);
442 -- Display an error message if the given suffix is illegal for some reason.
443 -- The name of the attribute we are testing is specified in Attribute_Name,
444 -- which is used in the error message. Location is the location where the
445 -- suffix is defined.
447 procedure Locate_Directory
448 (Project : Project_Id;
449 Name : File_Name_Type;
450 Path : out Path_Information;
451 Dir_Exists : out Boolean;
452 Data : in out Tree_Processing_Data;
453 Create : String := "";
454 Location : Source_Ptr := No_Location;
455 Must_Exist : Boolean := True;
456 Externally_Built : Boolean := False);
457 -- Locate a directory. Name is the directory name. Relative paths are
458 -- resolved relative to the project's directory. If the directory does not
459 -- exist and Setup_Projects is True and Create is a non null string, an
460 -- attempt is made to create the directory. If the directory does not
461 -- exist, it is either created if Setup_Projects is False (and then
462 -- returned), or simply returned without checking for its existence (if
463 -- Must_Exist is False) or No_Path_Information is returned. In all cases,
464 -- Dir_Exists indicates whether the directory now exists. Create is also
465 -- used for debugging traces to show which path we are computing.
467 procedure Look_For_Sources
468 (Project : in out Project_Processing_Data;
469 Data : in out Tree_Processing_Data);
470 -- Find all the sources of project Project in project tree Data.Tree and
471 -- update its Data accordingly. This assumes that the special naming
472 -- exceptions have already been processed.
474 function Path_Name_Of
475 (File_Name : File_Name_Type;
476 Directory : Path_Name_Type) return String;
477 -- Returns the path name of a (non project) file. Returns an empty string
478 -- if file cannot be found.
480 procedure Remove_Source
481 (Tree : Project_Tree_Ref;
483 Replaced_By : Source_Id);
484 -- Remove a file from the list of sources of a project. This might be
485 -- because the file is replaced by another one in an extending project,
486 -- or because a file was added as a naming exception but was not found
489 procedure Report_No_Sources
490 (Project : Project_Id;
492 Data : Tree_Processing_Data;
493 Location : Source_Ptr;
494 Continuation : Boolean := False);
495 -- Report an error or a warning depending on the value of When_No_Sources
496 -- when there are no sources for language Lang_Name.
498 procedure Show_Source_Dirs
499 (Project : Project_Id;
500 Shared : Shared_Project_Tree_Data_Access);
501 -- List all the source directories of a project
503 procedure Write_Attr (Name, Value : String);
504 -- Debug print a value for a specific property. Does nothing when not in
507 procedure Error_Or_Warning
508 (Flags : Processing_Flags;
509 Kind : Error_Warning;
511 Location : Source_Ptr;
512 Project : Project_Id);
513 -- Emits either an error or warning message (or nothing), depending on Kind
515 function No_Space_Img (N : Natural) return String;
516 -- Image of a Natural without the initial space
518 ----------------------
519 -- Error_Or_Warning --
520 ----------------------
522 procedure Error_Or_Warning
523 (Flags : Processing_Flags;
524 Kind : Error_Warning;
526 Location : Source_Ptr;
527 Project : Project_Id) is
530 when Error => Error_Msg (Flags, Msg, Location, Project);
531 when Warning => Error_Msg (Flags, "?" & Msg, Location, Project);
534 end Error_Or_Warning;
536 ------------------------------
537 -- Replace_Into_Name_Buffer --
538 ------------------------------
540 procedure Replace_Into_Name_Buffer
543 Replacement : Character)
545 Max : constant Integer := Str'Last - Pattern'Length + 1;
552 while J <= Str'Last loop
553 Name_Len := Name_Len + 1;
556 and then Str (J .. J + Pattern'Length - 1) = Pattern
558 Name_Buffer (Name_Len) := Replacement;
559 J := J + Pattern'Length;
562 Name_Buffer (Name_Len) := GNAT.Case_Util.To_Lower (Str (J));
566 end Replace_Into_Name_Buffer;
572 function Suffix_Matches
574 Suffix : File_Name_Type) return Boolean
576 Min_Prefix_Length : Natural := 0;
579 if Suffix = No_File or else Suffix = Empty_File then
584 Suf : String := Get_Name_String (Suffix);
587 -- On non case-sensitive systems, use proper suffix casing
589 Canonical_Case_File_Name (Suf);
591 -- The file name must end with the suffix (which is not an extension)
592 -- For instance a suffix "configure.in" must match a file with the
593 -- same name. To avoid dummy cases, though, a suffix starting with
594 -- '.' requires a file that is at least one character longer ('.cpp'
595 -- should not match a file with the same name)
597 if Suf (Suf'First) = '.' then
598 Min_Prefix_Length := 1;
601 return Filename'Length >= Suf'Length + Min_Prefix_Length
603 (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;
611 procedure Write_Attr (Name, Value : String) is
613 if Current_Verbosity = High then
614 Debug_Output (Name & " = """ & Value & '"');
624 Data : in out Tree_Processing_Data;
625 Project : Project_Id;
626 Source_Dir_Rank : Natural;
627 Lang_Id : Language_Ptr;
629 File_Name : File_Name_Type;
630 Display_File : File_Name_Type;
631 Naming_Exception : Boolean := False;
632 Path : Path_Information := No_Path_Information;
633 Alternate_Languages : Language_List := null;
634 Unit : Name_Id := No_Name;
636 Locally_Removed : Boolean := False;
637 Location : Source_Ptr := No_Location)
639 Config : constant Language_Config := Lang_Id.Config;
643 Prev_Unit : Unit_Index := No_Unit_Index;
644 Source_To_Replace : Source_Id := No_Source;
647 -- Check if the same file name or unit is used in the prj tree
651 if Unit /= No_Name then
652 Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit);
655 if Prev_Unit /= No_Unit_Index
656 and then (Kind = Impl or else Kind = Spec)
657 and then Prev_Unit.File_Names (Kind) /= null
659 -- Suspicious, we need to check later whether this is authorized
662 Source := Prev_Unit.File_Names (Kind);
665 Source := Source_Files_Htable.Get
666 (Data.Tree.Source_Files_HT, File_Name);
668 if Source /= No_Source
669 and then Source.Index = Index
675 -- Duplication of file/unit in same project is allowed if order of
676 -- source directories is known.
678 if Add_Src = False then
681 if Project = Source.Project then
682 if Prev_Unit = No_Unit_Index then
683 if Data.Flags.Allow_Duplicate_Basenames then
686 elsif Source_Dir_Rank /= Source.Source_Dir_Rank then
690 Error_Msg_File_1 := File_Name;
692 (Data.Flags, "duplicate source file name {",
698 if Source_Dir_Rank /= Source.Source_Dir_Rank then
701 -- We might be seeing the same file through a different path
702 -- (for instance because of symbolic links).
704 elsif Source.Path.Name /= Path.Name then
705 if not Source.Duplicate_Unit then
706 Error_Msg_Name_1 := Unit;
708 (Data.Flags, "\duplicate unit %%", Location, Project);
709 Source.Duplicate_Unit := True;
716 -- Do not allow the same unit name in different projects, except
717 -- if one is extending the other.
719 -- For a file based language, the same file name replaces a file
720 -- in a project being extended, but it is allowed to have the same
721 -- file name in unrelated projects.
723 elsif Is_Extending (Project, Source.Project) then
724 if not Locally_Removed then
725 Source_To_Replace := Source;
728 elsif Prev_Unit /= No_Unit_Index
729 and then Prev_Unit.File_Names (Kind) /= null
730 and then not Source.Locally_Removed
732 -- Path is set if this is a source we found on the disk, in which
733 -- case we can provide more explicit error message. Path is unset
734 -- when the source is added from one of the naming exceptions in
737 if Path /= No_Path_Information then
738 Error_Msg_Name_1 := Unit;
741 "unit %% cannot belong to several projects",
744 Error_Msg_Name_1 := Project.Name;
745 Error_Msg_Name_2 := Name_Id (Path.Display_Name);
747 (Data.Flags, "\ project %%, %%", Location, Project);
749 Error_Msg_Name_1 := Source.Project.Name;
750 Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);
752 (Data.Flags, "\ project %%, %%", Location, Project);
755 Error_Msg_Name_1 := Unit;
756 Error_Msg_Name_2 := Source.Project.Name;
758 (Data.Flags, "unit %% already belongs to project %%",
764 elsif not Source.Locally_Removed
765 and then not Data.Flags.Allow_Duplicate_Basenames
766 and then Lang_Id.Config.Kind = Unit_Based
767 and then Source.Language.Config.Kind = Unit_Based
769 Error_Msg_File_1 := File_Name;
770 Error_Msg_File_2 := File_Name_Type (Source.Project.Name);
773 "{ is already a source of project {", Location, Project);
775 -- Add the file anyway, to avoid further warnings like "language
788 Id := new Source_Data;
790 if Current_Verbosity = High then
792 Write_Str ("Adding source File: ");
793 Write_Str (Get_Name_String (Display_File));
796 Write_Str (" at" & Index'Img);
799 if Lang_Id.Config.Kind = Unit_Based then
800 Write_Str (" Unit: ");
802 -- ??? in gprclean, it seems we sometimes pass an empty Unit name
803 -- (see test extended_projects).
805 if Unit /= No_Name then
806 Write_Str (Get_Name_String (Unit));
809 Write_Str (" Kind: ");
810 Write_Str (Source_Kind'Image (Kind));
816 Id.Project := Project;
817 Id.Location := Location;
818 Id.Source_Dir_Rank := Source_Dir_Rank;
819 Id.Language := Lang_Id;
821 Id.Alternate_Languages := Alternate_Languages;
822 Id.Locally_Removed := Locally_Removed;
824 Id.File := File_Name;
825 Id.Display_File := Display_File;
826 Id.Dep_Name := Dependency_Name
827 (File_Name, Lang_Id.Config.Dependency_Kind);
828 Id.Naming_Exception := Naming_Exception;
829 Id.Object := Object_Name
830 (File_Name, Config.Object_File_Suffix);
831 Id.Switches := Switches_Name (File_Name);
833 -- Add the source id to the Unit_Sources_HT hash table, if the unit name
836 if Unit /= No_Name then
838 -- Note: we might be creating a dummy unit here, when we in fact have
839 -- a separate. For instance, file file-bar.adb will initially be
840 -- assumed to be the IMPL of unit "file.bar". Only later on (in
841 -- Check_Object_Files) will we parse those units that only have an
842 -- impl and no spec to make sure whether we have a Separate in fact
843 -- (that significantly reduces the number of times we need to parse
844 -- the files, since we are then only interested in those with no
845 -- spec). We still need those dummy units in the table, since that's
846 -- the name we find in the ALI file
848 UData := Units_Htable.Get (Data.Tree.Units_HT, Unit);
850 if UData = No_Unit_Index then
851 UData := new Unit_Data;
853 Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
858 -- Note that this updates Unit information as well
860 Override_Kind (Id, Kind);
863 if Path /= No_Path_Information then
865 Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id);
868 Id.Next_With_File_Name :=
869 Source_Files_Htable.Get (Data.Tree.Source_Files_HT, File_Name);
870 Source_Files_Htable.Set (Data.Tree.Source_Files_HT, File_Name, Id);
873 Project.Has_Multi_Unit_Sources := True;
876 -- Add the source to the language list
878 Id.Next_In_Lang := Lang_Id.First_Source;
879 Lang_Id.First_Source := Id;
881 if Source_To_Replace /= No_Source then
882 Remove_Source (Data.Tree, Source_To_Replace, Id);
885 if Data.Tree.Replaced_Source_Number > 0 and then
886 Replaced_Source_HTable.Get (Data.Tree.Replaced_Sources, Id.File) /=
889 Replaced_Source_HTable.Remove (Data.Tree.Replaced_Sources, Id.File);
890 Data.Tree.Replaced_Source_Number :=
891 Data.Tree.Replaced_Source_Number - 1;
895 ------------------------------
896 -- Canonical_Case_File_Name --
897 ------------------------------
899 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type is
901 if Osint.File_Names_Case_Sensitive then
902 return File_Name_Type (Name);
904 Get_Name_String (Name);
905 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
908 end Canonical_Case_File_Name;
910 ---------------------------------
911 -- Process_Aggregated_Projects --
912 ---------------------------------
914 procedure Process_Aggregated_Projects
915 (Tree : Project_Tree_Ref;
916 Project : Project_Id;
917 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
918 Flags : Processing_Flags)
920 Data : Tree_Processing_Data :=
922 Node_Tree => Node_Tree,
925 Project_Files : constant Prj.Variable_Value :=
927 (Snames.Name_Project_Files,
928 Project.Decl.Attributes,
931 Project_Path_For_Aggregate : Prj.Env.Project_Search_Path;
933 procedure Found_Project_File (Path : Path_Information; Rank : Natural);
934 -- Called for each project file aggregated by Project
936 procedure Expand_Project_Files is
937 new Expand_Subdirectory_Pattern (Callback => Found_Project_File);
938 -- Search for all project files referenced by the patterns given in
939 -- parameter. Calls Found_Project_File for each of them.
941 ------------------------
942 -- Found_Project_File --
943 ------------------------
945 procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
946 pragma Unreferenced (Rank);
948 if Path.Name /= Project.Path.Name then
949 Debug_Output ("Aggregates: ", Name_Id (Path.Display_Name));
951 -- For usual "with" statement, this phase will have been done when
952 -- parsing the project itself. However, for aggregate projects, we
953 -- can only do this when processing the aggregate project, since
954 -- the exact list of project files or project directories can
955 -- depend on scenario variables.
957 -- We only load the projects explicitly here, but do not process
958 -- them. For the processing, Prj.Proc will take care of processing
959 -- them, within the same call to Recursive_Process (thus avoiding
960 -- the processing of a given project multiple times).
962 -- ??? We might already have loaded the project
964 Add_Aggregated_Project (Project, Path => Path.Name);
967 Debug_Output ("Pattern returned the aggregate itself, ignored");
969 end Found_Project_File;
971 -- Start of processing for Check_Aggregate_Project
974 pragma Assert (Project.Qualifier = Aggregate);
976 if Project_Files.Default then
977 Error_Msg_Name_1 := Snames.Name_Project_Files;
980 "Attribute %% must be specified in aggregate project",
981 Project.Location, Project);
985 -- The aggregated projects are only searched relative to the directory
986 -- of the aggregate project, not in the default project path.
988 Initialize_Empty (Project_Path_For_Aggregate);
990 Free (Project.Aggregated_Projects);
992 -- Look for aggregated projects. For similarity with source files and
993 -- dirs, the aggregated project files are not searched for on the
994 -- project path, and are only found through the path specified in
995 -- the Project_Files attribute.
1000 Patterns => Project_Files.Values,
1001 Ignore => Nil_String,
1002 Search_For => Search_Files,
1003 Resolve_Links => Opt.Follow_Links_For_Files);
1005 Free (Project_Path_For_Aggregate);
1006 end Process_Aggregated_Projects;
1008 ----------------------------
1009 -- Check_Abstract_Project --
1010 ----------------------------
1012 procedure Check_Abstract_Project
1013 (Project : Project_Id;
1014 Data : in out Tree_Processing_Data)
1016 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
1018 Source_Dirs : constant Variable_Value :=
1021 Project.Decl.Attributes, Shared);
1022 Source_Files : constant Variable_Value :=
1025 Project.Decl.Attributes, Shared);
1026 Source_List_File : constant Variable_Value :=
1028 (Name_Source_List_File,
1029 Project.Decl.Attributes, Shared);
1030 Languages : constant Variable_Value :=
1033 Project.Decl.Attributes, Shared);
1036 if Project.Source_Dirs /= Nil_String then
1037 if Source_Dirs.Values = Nil_String
1038 and then Source_Files.Values = Nil_String
1039 and then Languages.Values = Nil_String
1040 and then Source_List_File.Default
1042 Project.Source_Dirs := Nil_String;
1047 "at least one of Source_Files, Source_Dirs or Languages "
1048 & "must be declared empty for an abstract project",
1049 Project.Location, Project);
1052 end Check_Abstract_Project;
1059 (Project : Project_Id;
1060 Data : in out Tree_Processing_Data)
1062 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
1063 Prj_Data : Project_Processing_Data;
1066 Debug_Increase_Indent ("Check", Project.Name);
1068 Initialize (Prj_Data, Project);
1070 Check_If_Externally_Built (Project, Data);
1072 if Project.Qualifier /= Aggregate then
1073 Get_Directories (Project, Data);
1074 Check_Programming_Languages (Project, Data);
1076 if Current_Verbosity = High then
1077 Show_Source_Dirs (Project, Shared);
1081 case Project.Qualifier is
1082 when Dry => Check_Abstract_Project (Project, Data);
1083 when others => null;
1086 -- Check configuration. This must be done even for gnatmake (even though
1087 -- no user configuration file was provided) since the default config we
1088 -- generate indicates whether libraries are supported for instance.
1090 Check_Configuration (Project, Data);
1092 if Project.Qualifier /= Aggregate then
1093 Check_Library_Attributes (Project, Data);
1094 Check_Package_Naming (Project, Data);
1095 Look_For_Sources (Prj_Data, Data);
1096 Check_Interfaces (Project, Data);
1098 if Project.Library then
1099 Check_Stand_Alone_Library (Project, Data);
1102 Get_Mains (Project, Data);
1107 Debug_Decrease_Indent ("Done Check");
1110 --------------------
1111 -- Check_Ada_Name --
1112 --------------------
1114 procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is
1115 The_Name : String := Name;
1116 Real_Name : Name_Id;
1117 Need_Letter : Boolean := True;
1118 Last_Underscore : Boolean := False;
1119 OK : Boolean := The_Name'Length > 0;
1122 function Is_Reserved (Name : Name_Id) return Boolean;
1123 function Is_Reserved (S : String) return Boolean;
1124 -- Check that the given name is not an Ada 95 reserved word. The reason
1125 -- for the Ada 95 here is that we do not want to exclude the case of an
1126 -- Ada 95 unit called Interface (for example). In Ada 2005, such a unit
1127 -- name would be rejected anyway by the compiler. That means there is no
1128 -- requirement that the project file parser reject this.
1134 function Is_Reserved (S : String) return Boolean is
1137 Add_Str_To_Name_Buffer (S);
1138 return Is_Reserved (Name_Find);
1145 function Is_Reserved (Name : Name_Id) return Boolean is
1147 if Get_Name_Table_Byte (Name) /= 0
1148 and then Name /= Name_Project
1149 and then Name /= Name_Extends
1150 and then Name /= Name_External
1151 and then Name not in Ada_2005_Reserved_Words
1154 Debug_Output ("Ada reserved word: ", Name);
1162 -- Start of processing for Check_Ada_Name
1165 To_Lower (The_Name);
1167 Name_Len := The_Name'Length;
1168 Name_Buffer (1 .. Name_Len) := The_Name;
1170 -- Special cases of children of packages A, G, I and S on VMS
1172 if OpenVMS_On_Target
1173 and then Name_Len > 3
1174 and then Name_Buffer (2 .. 3) = "__"
1176 ((Name_Buffer (1) = 'a') or else
1177 (Name_Buffer (1) = 'g') or else
1178 (Name_Buffer (1) = 'i') or else
1179 (Name_Buffer (1) = 's'))
1181 Name_Buffer (2) := '.';
1182 Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
1183 Name_Len := Name_Len - 1;
1186 Real_Name := Name_Find;
1188 if Is_Reserved (Real_Name) then
1192 First := The_Name'First;
1194 for Index in The_Name'Range loop
1197 -- We need a letter (at the beginning, and following a dot),
1198 -- but we don't have one.
1200 if Is_Letter (The_Name (Index)) then
1201 Need_Letter := False;
1206 if Current_Verbosity = High then
1208 Write_Int (Types.Int (Index));
1210 Write_Char (The_Name (Index));
1211 Write_Line ("' is not a letter.");
1217 elsif Last_Underscore
1218 and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
1220 -- Two underscores are illegal, and a dot cannot follow
1225 if Current_Verbosity = High then
1227 Write_Int (Types.Int (Index));
1229 Write_Char (The_Name (Index));
1230 Write_Line ("' is illegal here.");
1235 elsif The_Name (Index) = '.' then
1237 -- First, check if the name before the dot is not a reserved word
1239 if Is_Reserved (The_Name (First .. Index - 1)) then
1245 -- We need a letter after a dot
1247 Need_Letter := True;
1249 elsif The_Name (Index) = '_' then
1250 Last_Underscore := True;
1253 -- We need an letter or a digit
1255 Last_Underscore := False;
1257 if not Is_Alphanumeric (The_Name (Index)) then
1260 if Current_Verbosity = High then
1262 Write_Int (Types.Int (Index));
1264 Write_Char (The_Name (Index));
1265 Write_Line ("' is not alphanumeric.");
1273 -- Cannot end with an underscore or a dot
1275 OK := OK and then not Need_Letter and then not Last_Underscore;
1278 if First /= Name'First and then
1279 Is_Reserved (The_Name (First .. The_Name'Last))
1287 -- Signal a problem with No_Name
1293 -------------------------
1294 -- Check_Configuration --
1295 -------------------------
1297 procedure Check_Configuration
1298 (Project : Project_Id;
1299 Data : in out Tree_Processing_Data)
1301 Shared : constant Shared_Project_Tree_Data_Access :=
1304 Dot_Replacement : File_Name_Type := No_File;
1305 Casing : Casing_Type := All_Lower_Case;
1306 Separate_Suffix : File_Name_Type := No_File;
1308 Lang_Index : Language_Ptr := No_Language_Index;
1309 -- The index of the language data being checked
1311 Prev_Index : Language_Ptr := No_Language_Index;
1312 -- The index of the previous language
1314 procedure Process_Project_Level_Simple_Attributes;
1315 -- Process the simple attributes at the project level
1317 procedure Process_Project_Level_Array_Attributes;
1318 -- Process the associate array attributes at the project level
1320 procedure Process_Packages;
1321 -- Read the packages of the project
1323 ----------------------
1324 -- Process_Packages --
1325 ----------------------
1327 procedure Process_Packages is
1328 Packages : Package_Id;
1329 Element : Package_Element;
1331 procedure Process_Binder (Arrays : Array_Id);
1332 -- Process the associate array attributes of package Binder
1334 procedure Process_Builder (Attributes : Variable_Id);
1335 -- Process the simple attributes of package Builder
1337 procedure Process_Compiler (Arrays : Array_Id);
1338 -- Process the associate array attributes of package Compiler
1340 procedure Process_Naming (Attributes : Variable_Id);
1341 -- Process the simple attributes of package Naming
1343 procedure Process_Naming (Arrays : Array_Id);
1344 -- Process the associate array attributes of package Naming
1346 procedure Process_Linker (Attributes : Variable_Id);
1347 -- Process the simple attributes of package Linker of a
1348 -- configuration project.
1350 --------------------
1351 -- Process_Binder --
1352 --------------------
1354 procedure Process_Binder (Arrays : Array_Id) is
1355 Current_Array_Id : Array_Id;
1356 Current_Array : Array_Data;
1357 Element_Id : Array_Element_Id;
1358 Element : Array_Element;
1361 -- Process the associative array attribute of package Binder
1363 Current_Array_Id := Arrays;
1364 while Current_Array_Id /= No_Array loop
1365 Current_Array := Shared.Arrays.Table (Current_Array_Id);
1367 Element_Id := Current_Array.Value;
1368 while Element_Id /= No_Array_Element loop
1369 Element := Shared.Array_Elements.Table (Element_Id);
1371 if Element.Index /= All_Other_Names then
1373 -- Get the name of the language
1376 Get_Language_From_Name
1377 (Project, Get_Name_String (Element.Index));
1379 if Lang_Index /= No_Language_Index then
1380 case Current_Array.Name is
1383 -- Attribute Driver (<language>)
1385 Lang_Index.Config.Binder_Driver :=
1386 File_Name_Type (Element.Value.Value);
1388 when Name_Required_Switches =>
1391 Lang_Index.Config.Binder_Required_Switches,
1392 From_List => Element.Value.Values,
1393 In_Tree => Data.Tree);
1397 -- Attribute Prefix (<language>)
1399 Lang_Index.Config.Binder_Prefix :=
1400 Element.Value.Value;
1402 when Name_Objects_Path =>
1404 -- Attribute Objects_Path (<language>)
1406 Lang_Index.Config.Objects_Path :=
1407 Element.Value.Value;
1409 when Name_Objects_Path_File =>
1411 -- Attribute Objects_Path (<language>)
1413 Lang_Index.Config.Objects_Path_File :=
1414 Element.Value.Value;
1422 Element_Id := Element.Next;
1425 Current_Array_Id := Current_Array.Next;
1429 ---------------------
1430 -- Process_Builder --
1431 ---------------------
1433 procedure Process_Builder (Attributes : Variable_Id) is
1434 Attribute_Id : Variable_Id;
1435 Attribute : Variable;
1438 -- Process non associated array attribute from package Builder
1440 Attribute_Id := Attributes;
1441 while Attribute_Id /= No_Variable loop
1442 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1444 if not Attribute.Value.Default then
1445 if Attribute.Name = Name_Executable_Suffix then
1447 -- Attribute Executable_Suffix: the suffix of the
1450 Project.Config.Executable_Suffix :=
1451 Attribute.Value.Value;
1455 Attribute_Id := Attribute.Next;
1457 end Process_Builder;
1459 ----------------------
1460 -- Process_Compiler --
1461 ----------------------
1463 procedure Process_Compiler (Arrays : Array_Id) is
1464 Current_Array_Id : Array_Id;
1465 Current_Array : Array_Data;
1466 Element_Id : Array_Element_Id;
1467 Element : Array_Element;
1468 List : String_List_Id;
1471 -- Process the associative array attribute of package Compiler
1473 Current_Array_Id := Arrays;
1474 while Current_Array_Id /= No_Array loop
1475 Current_Array := Shared.Arrays.Table (Current_Array_Id);
1477 Element_Id := Current_Array.Value;
1478 while Element_Id /= No_Array_Element loop
1479 Element := Shared.Array_Elements.Table (Element_Id);
1481 if Element.Index /= All_Other_Names then
1483 -- Get the name of the language
1485 Lang_Index := Get_Language_From_Name
1486 (Project, Get_Name_String (Element.Index));
1488 if Lang_Index /= No_Language_Index then
1489 case Current_Array.Name is
1490 when Name_Dependency_Switches =>
1492 -- Attribute Dependency_Switches (<language>)
1494 if Lang_Index.Config.Dependency_Kind = None then
1495 Lang_Index.Config.Dependency_Kind := Makefile;
1498 List := Element.Value.Values;
1500 if List /= Nil_String then
1502 Lang_Index.Config.Dependency_Option,
1504 In_Tree => Data.Tree);
1507 when Name_Dependency_Driver =>
1509 -- Attribute Dependency_Driver (<language>)
1511 if Lang_Index.Config.Dependency_Kind = None then
1512 Lang_Index.Config.Dependency_Kind := Makefile;
1515 List := Element.Value.Values;
1517 if List /= Nil_String then
1519 Lang_Index.Config.Compute_Dependency,
1521 In_Tree => Data.Tree);
1524 when Name_Include_Switches =>
1526 -- Attribute Include_Switches (<language>)
1528 List := Element.Value.Values;
1530 if List = Nil_String then
1532 (Data.Flags, "include option cannot be null",
1533 Element.Value.Location, Project);
1536 Put (Into_List => Lang_Index.Config.Include_Option,
1538 In_Tree => Data.Tree);
1540 when Name_Include_Path =>
1542 -- Attribute Include_Path (<language>)
1544 Lang_Index.Config.Include_Path :=
1545 Element.Value.Value;
1547 when Name_Include_Path_File =>
1549 -- Attribute Include_Path_File (<language>)
1551 Lang_Index.Config.Include_Path_File :=
1552 Element.Value.Value;
1556 -- Attribute Driver (<language>)
1558 Lang_Index.Config.Compiler_Driver :=
1559 File_Name_Type (Element.Value.Value);
1561 when Name_Required_Switches |
1562 Name_Leading_Required_Switches =>
1565 Compiler_Leading_Required_Switches,
1566 From_List => Element.Value.Values,
1567 In_Tree => Data.Tree);
1569 when Name_Trailing_Required_Switches =>
1572 Compiler_Trailing_Required_Switches,
1573 From_List => Element.Value.Values,
1574 In_Tree => Data.Tree);
1576 when Name_Multi_Unit_Switches =>
1578 Lang_Index.Config.Multi_Unit_Switches,
1579 From_List => Element.Value.Values,
1580 In_Tree => Data.Tree);
1582 when Name_Multi_Unit_Object_Separator =>
1583 Get_Name_String (Element.Value.Value);
1585 if Name_Len /= 1 then
1588 "multi-unit object separator must have " &
1589 "a single character",
1590 Element.Value.Location, Project);
1592 elsif Name_Buffer (1) = ' ' then
1595 "multi-unit object separator cannot be " &
1597 Element.Value.Location, Project);
1600 Lang_Index.Config.Multi_Unit_Object_Separator :=
1604 when Name_Path_Syntax =>
1606 Lang_Index.Config.Path_Syntax :=
1607 Path_Syntax_Kind'Value
1608 (Get_Name_String (Element.Value.Value));
1611 when Constraint_Error =>
1614 "invalid value for Path_Syntax",
1615 Element.Value.Location, Project);
1618 when Name_Object_File_Suffix =>
1619 if Get_Name_String (Element.Value.Value) = "" then
1622 "object file suffix cannot be empty",
1623 Element.Value.Location, Project);
1626 Lang_Index.Config.Object_File_Suffix :=
1627 Element.Value.Value;
1630 when Name_Object_File_Switches =>
1632 Lang_Index.Config.Object_File_Switches,
1633 From_List => Element.Value.Values,
1634 In_Tree => Data.Tree);
1636 when Name_Pic_Option =>
1638 -- Attribute Compiler_Pic_Option (<language>)
1640 List := Element.Value.Values;
1642 if List = Nil_String then
1645 "compiler PIC option cannot be null",
1646 Element.Value.Location, Project);
1650 Lang_Index.Config.Compilation_PIC_Option,
1652 In_Tree => Data.Tree);
1654 when Name_Mapping_File_Switches =>
1656 -- Attribute Mapping_File_Switches (<language>)
1658 List := Element.Value.Values;
1660 if List = Nil_String then
1663 "mapping file switches cannot be null",
1664 Element.Value.Location, Project);
1668 Lang_Index.Config.Mapping_File_Switches,
1670 In_Tree => Data.Tree);
1672 when Name_Mapping_Spec_Suffix =>
1674 -- Attribute Mapping_Spec_Suffix (<language>)
1676 Lang_Index.Config.Mapping_Spec_Suffix :=
1677 File_Name_Type (Element.Value.Value);
1679 when Name_Mapping_Body_Suffix =>
1681 -- Attribute Mapping_Body_Suffix (<language>)
1683 Lang_Index.Config.Mapping_Body_Suffix :=
1684 File_Name_Type (Element.Value.Value);
1686 when Name_Config_File_Switches =>
1688 -- Attribute Config_File_Switches (<language>)
1690 List := Element.Value.Values;
1692 if List = Nil_String then
1695 "config file switches cannot be null",
1696 Element.Value.Location, Project);
1700 Lang_Index.Config.Config_File_Switches,
1702 In_Tree => Data.Tree);
1704 when Name_Objects_Path =>
1706 -- Attribute Objects_Path (<language>)
1708 Lang_Index.Config.Objects_Path :=
1709 Element.Value.Value;
1711 when Name_Objects_Path_File =>
1713 -- Attribute Objects_Path_File (<language>)
1715 Lang_Index.Config.Objects_Path_File :=
1716 Element.Value.Value;
1718 when Name_Config_Body_File_Name =>
1720 -- Attribute Config_Body_File_Name (<language>)
1722 Lang_Index.Config.Config_Body :=
1723 Element.Value.Value;
1725 when Name_Config_Body_File_Name_Index =>
1727 -- Attribute Config_Body_File_Name_Index
1730 Lang_Index.Config.Config_Body_Index :=
1731 Element.Value.Value;
1733 when Name_Config_Body_File_Name_Pattern =>
1735 -- Attribute Config_Body_File_Name_Pattern
1738 Lang_Index.Config.Config_Body_Pattern :=
1739 Element.Value.Value;
1741 when Name_Config_Spec_File_Name =>
1743 -- Attribute Config_Spec_File_Name (<language>)
1745 Lang_Index.Config.Config_Spec :=
1746 Element.Value.Value;
1748 when Name_Config_Spec_File_Name_Index =>
1750 -- Attribute Config_Spec_File_Name_Index
1753 Lang_Index.Config.Config_Spec_Index :=
1754 Element.Value.Value;
1756 when Name_Config_Spec_File_Name_Pattern =>
1758 -- Attribute Config_Spec_File_Name_Pattern
1761 Lang_Index.Config.Config_Spec_Pattern :=
1762 Element.Value.Value;
1764 when Name_Config_File_Unique =>
1766 -- Attribute Config_File_Unique (<language>)
1769 Lang_Index.Config.Config_File_Unique :=
1771 (Get_Name_String (Element.Value.Value));
1773 when Constraint_Error =>
1776 "illegal value for Config_File_Unique",
1777 Element.Value.Location, Project);
1786 Element_Id := Element.Next;
1789 Current_Array_Id := Current_Array.Next;
1791 end Process_Compiler;
1793 --------------------
1794 -- Process_Naming --
1795 --------------------
1797 procedure Process_Naming (Attributes : Variable_Id) is
1798 Attribute_Id : Variable_Id;
1799 Attribute : Variable;
1802 -- Process non associated array attribute from package Naming
1804 Attribute_Id := Attributes;
1805 while Attribute_Id /= No_Variable loop
1806 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1808 if not Attribute.Value.Default then
1809 if Attribute.Name = Name_Separate_Suffix then
1811 -- Attribute Separate_Suffix
1813 Get_Name_String (Attribute.Value.Value);
1814 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1815 Separate_Suffix := Name_Find;
1817 elsif Attribute.Name = Name_Casing then
1823 Value (Get_Name_String (Attribute.Value.Value));
1826 when Constraint_Error =>
1829 "invalid value for Casing",
1830 Attribute.Value.Location, Project);
1833 elsif Attribute.Name = Name_Dot_Replacement then
1835 -- Attribute Dot_Replacement
1837 Dot_Replacement := File_Name_Type (Attribute.Value.Value);
1842 Attribute_Id := Attribute.Next;
1846 procedure Process_Naming (Arrays : Array_Id) is
1847 Current_Array_Id : Array_Id;
1848 Current_Array : Array_Data;
1849 Element_Id : Array_Element_Id;
1850 Element : Array_Element;
1853 -- Process the associative array attribute of package Naming
1855 Current_Array_Id := Arrays;
1856 while Current_Array_Id /= No_Array loop
1857 Current_Array := Shared.Arrays.Table (Current_Array_Id);
1859 Element_Id := Current_Array.Value;
1860 while Element_Id /= No_Array_Element loop
1861 Element := Shared.Array_Elements.Table (Element_Id);
1863 -- Get the name of the language
1865 Lang_Index := Get_Language_From_Name
1866 (Project, Get_Name_String (Element.Index));
1868 if Lang_Index /= No_Language_Index then
1869 case Current_Array.Name is
1870 when Name_Spec_Suffix | Name_Specification_Suffix =>
1872 -- Attribute Spec_Suffix (<language>)
1874 Get_Name_String (Element.Value.Value);
1875 Canonical_Case_File_Name
1876 (Name_Buffer (1 .. Name_Len));
1877 Lang_Index.Config.Naming_Data.Spec_Suffix :=
1880 when Name_Implementation_Suffix | Name_Body_Suffix =>
1882 Get_Name_String (Element.Value.Value);
1883 Canonical_Case_File_Name
1884 (Name_Buffer (1 .. Name_Len));
1886 -- Attribute Body_Suffix (<language>)
1888 Lang_Index.Config.Naming_Data.Body_Suffix :=
1890 Lang_Index.Config.Naming_Data.Separate_Suffix :=
1891 Lang_Index.Config.Naming_Data.Body_Suffix;
1898 Element_Id := Element.Next;
1901 Current_Array_Id := Current_Array.Next;
1905 --------------------
1906 -- Process_Linker --
1907 --------------------
1909 procedure Process_Linker (Attributes : Variable_Id) is
1910 Attribute_Id : Variable_Id;
1911 Attribute : Variable;
1914 -- Process non associated array attribute from package Linker
1916 Attribute_Id := Attributes;
1917 while Attribute_Id /= No_Variable loop
1918 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1920 if not Attribute.Value.Default then
1921 if Attribute.Name = Name_Driver then
1923 -- Attribute Linker'Driver: the default linker to use
1925 Project.Config.Linker :=
1926 Path_Name_Type (Attribute.Value.Value);
1928 -- Linker'Driver is also used to link shared libraries
1929 -- if the obsolescent attribute Library_GCC has not been
1932 if Project.Config.Shared_Lib_Driver = No_File then
1933 Project.Config.Shared_Lib_Driver :=
1934 File_Name_Type (Attribute.Value.Value);
1937 elsif Attribute.Name = Name_Required_Switches then
1939 -- Attribute Required_Switches: the minimum trailing
1940 -- options to use when invoking the linker
1943 Project.Config.Trailing_Linker_Required_Switches,
1944 From_List => Attribute.Value.Values,
1945 In_Tree => Data.Tree);
1947 elsif Attribute.Name = Name_Map_File_Option then
1948 Project.Config.Map_File_Option := Attribute.Value.Value;
1950 elsif Attribute.Name = Name_Max_Command_Line_Length then
1952 Project.Config.Max_Command_Line_Length :=
1953 Natural'Value (Get_Name_String
1954 (Attribute.Value.Value));
1957 when Constraint_Error =>
1960 "value must be positive or equal to 0",
1961 Attribute.Value.Location, Project);
1964 elsif Attribute.Name = Name_Response_File_Format then
1969 Get_Name_String (Attribute.Value.Value);
1970 To_Lower (Name_Buffer (1 .. Name_Len));
1973 if Name = Name_None then
1974 Project.Config.Resp_File_Format := None;
1976 elsif Name = Name_Gnu then
1977 Project.Config.Resp_File_Format := GNU;
1979 elsif Name = Name_Object_List then
1980 Project.Config.Resp_File_Format := Object_List;
1982 elsif Name = Name_Option_List then
1983 Project.Config.Resp_File_Format := Option_List;
1985 elsif Name_Buffer (1 .. Name_Len) = "gcc" then
1986 Project.Config.Resp_File_Format := GCC;
1988 elsif Name_Buffer (1 .. Name_Len) = "gcc_gnu" then
1989 Project.Config.Resp_File_Format := GCC_GNU;
1992 Name_Buffer (1 .. Name_Len) = "gcc_option_list"
1994 Project.Config.Resp_File_Format := GCC_Option_List;
1997 Name_Buffer (1 .. Name_Len) = "gcc_object_list"
1999 Project.Config.Resp_File_Format := GCC_Object_List;
2004 "illegal response file format",
2005 Attribute.Value.Location, Project);
2009 elsif Attribute.Name = Name_Response_File_Switches then
2010 Put (Into_List => Project.Config.Resp_File_Options,
2011 From_List => Attribute.Value.Values,
2012 In_Tree => Data.Tree);
2016 Attribute_Id := Attribute.Next;
2020 -- Start of processing for Process_Packages
2023 Packages := Project.Decl.Packages;
2024 while Packages /= No_Package loop
2025 Element := Shared.Packages.Table (Packages);
2027 case Element.Name is
2030 -- Process attributes of package Binder
2032 Process_Binder (Element.Decl.Arrays);
2034 when Name_Builder =>
2036 -- Process attributes of package Builder
2038 Process_Builder (Element.Decl.Attributes);
2040 when Name_Compiler =>
2042 -- Process attributes of package Compiler
2044 Process_Compiler (Element.Decl.Arrays);
2048 -- Process attributes of package Linker
2050 Process_Linker (Element.Decl.Attributes);
2054 -- Process attributes of package Naming
2056 Process_Naming (Element.Decl.Attributes);
2057 Process_Naming (Element.Decl.Arrays);
2063 Packages := Element.Next;
2065 end Process_Packages;
2067 ---------------------------------------------
2068 -- Process_Project_Level_Simple_Attributes --
2069 ---------------------------------------------
2071 procedure Process_Project_Level_Simple_Attributes is
2072 Attribute_Id : Variable_Id;
2073 Attribute : Variable;
2074 List : String_List_Id;
2077 -- Process non associated array attribute at project level
2079 Attribute_Id := Project.Decl.Attributes;
2080 while Attribute_Id /= No_Variable loop
2081 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
2083 if not Attribute.Value.Default then
2084 if Attribute.Name = Name_Target then
2086 -- Attribute Target: the target specified
2088 Project.Config.Target := Attribute.Value.Value;
2090 elsif Attribute.Name = Name_Library_Builder then
2092 -- Attribute Library_Builder: the application to invoke
2093 -- to build libraries.
2095 Project.Config.Library_Builder :=
2096 Path_Name_Type (Attribute.Value.Value);
2098 elsif Attribute.Name = Name_Archive_Builder then
2100 -- Attribute Archive_Builder: the archive builder
2101 -- (usually "ar") and its minimum options (usually "cr").
2103 List := Attribute.Value.Values;
2105 if List = Nil_String then
2108 "archive builder cannot be null",
2109 Attribute.Value.Location, Project);
2112 Put (Into_List => Project.Config.Archive_Builder,
2114 In_Tree => Data.Tree);
2116 elsif Attribute.Name = Name_Archive_Builder_Append_Option then
2118 -- Attribute Archive_Builder: the archive builder
2119 -- (usually "ar") and its minimum options (usually "cr").
2121 List := Attribute.Value.Values;
2123 if List /= Nil_String then
2126 Project.Config.Archive_Builder_Append_Option,
2128 In_Tree => Data.Tree);
2131 elsif Attribute.Name = Name_Archive_Indexer then
2133 -- Attribute Archive_Indexer: the optional archive
2134 -- indexer (usually "ranlib") with its minimum options
2137 List := Attribute.Value.Values;
2139 if List = Nil_String then
2142 "archive indexer cannot be null",
2143 Attribute.Value.Location, Project);
2146 Put (Into_List => Project.Config.Archive_Indexer,
2148 In_Tree => Data.Tree);
2150 elsif Attribute.Name = Name_Library_Partial_Linker then
2152 -- Attribute Library_Partial_Linker: the optional linker
2153 -- driver with its minimum options, to partially link
2156 List := Attribute.Value.Values;
2158 if List = Nil_String then
2161 "partial linker cannot be null",
2162 Attribute.Value.Location, Project);
2165 Put (Into_List => Project.Config.Lib_Partial_Linker,
2167 In_Tree => Data.Tree);
2169 elsif Attribute.Name = Name_Library_GCC then
2170 Project.Config.Shared_Lib_Driver :=
2171 File_Name_Type (Attribute.Value.Value);
2174 "?Library_'G'C'C is an obsolescent attribute, " &
2175 "use Linker''Driver instead",
2176 Attribute.Value.Location, Project);
2178 elsif Attribute.Name = Name_Archive_Suffix then
2179 Project.Config.Archive_Suffix :=
2180 File_Name_Type (Attribute.Value.Value);
2182 elsif Attribute.Name = Name_Linker_Executable_Option then
2184 -- Attribute Linker_Executable_Option: optional options
2185 -- to specify an executable name. Defaults to "-o".
2187 List := Attribute.Value.Values;
2189 if List = Nil_String then
2192 "linker executable option cannot be null",
2193 Attribute.Value.Location, Project);
2196 Put (Into_List => Project.Config.Linker_Executable_Option,
2198 In_Tree => Data.Tree);
2200 elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
2202 -- Attribute Linker_Lib_Dir_Option: optional options
2203 -- to specify a library search directory. Defaults to
2206 Get_Name_String (Attribute.Value.Value);
2208 if Name_Len = 0 then
2211 "linker library directory option cannot be empty",
2212 Attribute.Value.Location, Project);
2215 Project.Config.Linker_Lib_Dir_Option :=
2216 Attribute.Value.Value;
2218 elsif Attribute.Name = Name_Linker_Lib_Name_Option then
2220 -- Attribute Linker_Lib_Name_Option: optional options
2221 -- to specify the name of a library to be linked in.
2222 -- Defaults to "-l".
2224 Get_Name_String (Attribute.Value.Value);
2226 if Name_Len = 0 then
2229 "linker library name option cannot be empty",
2230 Attribute.Value.Location, Project);
2233 Project.Config.Linker_Lib_Name_Option :=
2234 Attribute.Value.Value;
2236 elsif Attribute.Name = Name_Run_Path_Option then
2238 -- Attribute Run_Path_Option: optional options to
2239 -- specify a path for libraries.
2241 List := Attribute.Value.Values;
2243 if List /= Nil_String then
2244 Put (Into_List => Project.Config.Run_Path_Option,
2246 In_Tree => Data.Tree);
2249 elsif Attribute.Name = Name_Run_Path_Origin then
2250 Get_Name_String (Attribute.Value.Value);
2252 if Name_Len = 0 then
2255 "run path origin cannot be empty",
2256 Attribute.Value.Location, Project);
2259 Project.Config.Run_Path_Origin := Attribute.Value.Value;
2261 elsif Attribute.Name = Name_Library_Install_Name_Option then
2262 Project.Config.Library_Install_Name_Option :=
2263 Attribute.Value.Value;
2265 elsif Attribute.Name = Name_Separate_Run_Path_Options then
2267 pragma Unsuppress (All_Checks);
2269 Project.Config.Separate_Run_Path_Options :=
2270 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2272 when Constraint_Error =>
2275 "invalid value """ &
2276 Get_Name_String (Attribute.Value.Value) &
2277 """ for Separate_Run_Path_Options",
2278 Attribute.Value.Location, Project);
2281 elsif Attribute.Name = Name_Library_Support then
2283 pragma Unsuppress (All_Checks);
2285 Project.Config.Lib_Support :=
2286 Library_Support'Value (Get_Name_String
2287 (Attribute.Value.Value));
2289 when Constraint_Error =>
2292 "invalid value """ &
2293 Get_Name_String (Attribute.Value.Value) &
2294 """ for Library_Support",
2295 Attribute.Value.Location, Project);
2298 elsif Attribute.Name = Name_Shared_Library_Prefix then
2299 Project.Config.Shared_Lib_Prefix :=
2300 File_Name_Type (Attribute.Value.Value);
2302 elsif Attribute.Name = Name_Shared_Library_Suffix then
2303 Project.Config.Shared_Lib_Suffix :=
2304 File_Name_Type (Attribute.Value.Value);
2306 elsif Attribute.Name = Name_Symbolic_Link_Supported then
2308 pragma Unsuppress (All_Checks);
2310 Project.Config.Symbolic_Link_Supported :=
2311 Boolean'Value (Get_Name_String
2312 (Attribute.Value.Value));
2314 when Constraint_Error =>
2318 & Get_Name_String (Attribute.Value.Value)
2319 & """ for Symbolic_Link_Supported",
2320 Attribute.Value.Location, Project);
2324 Attribute.Name = Name_Library_Major_Minor_Id_Supported
2327 pragma Unsuppress (All_Checks);
2329 Project.Config.Lib_Maj_Min_Id_Supported :=
2330 Boolean'Value (Get_Name_String
2331 (Attribute.Value.Value));
2333 when Constraint_Error =>
2336 "invalid value """ &
2337 Get_Name_String (Attribute.Value.Value) &
2338 """ for Library_Major_Minor_Id_Supported",
2339 Attribute.Value.Location, Project);
2342 elsif Attribute.Name = Name_Library_Auto_Init_Supported then
2344 pragma Unsuppress (All_Checks);
2346 Project.Config.Auto_Init_Supported :=
2347 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2349 when Constraint_Error =>
2353 & Get_Name_String (Attribute.Value.Value)
2354 & """ for Library_Auto_Init_Supported",
2355 Attribute.Value.Location, Project);
2358 elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
2359 List := Attribute.Value.Values;
2361 if List /= Nil_String then
2362 Put (Into_List => Project.Config.Shared_Lib_Min_Options,
2364 In_Tree => Data.Tree);
2367 elsif Attribute.Name = Name_Library_Version_Switches then
2368 List := Attribute.Value.Values;
2370 if List /= Nil_String then
2371 Put (Into_List => Project.Config.Lib_Version_Options,
2373 In_Tree => Data.Tree);
2378 Attribute_Id := Attribute.Next;
2380 end Process_Project_Level_Simple_Attributes;
2382 --------------------------------------------
2383 -- Process_Project_Level_Array_Attributes --
2384 --------------------------------------------
2386 procedure Process_Project_Level_Array_Attributes is
2387 Current_Array_Id : Array_Id;
2388 Current_Array : Array_Data;
2389 Element_Id : Array_Element_Id;
2390 Element : Array_Element;
2391 List : String_List_Id;
2394 -- Process the associative array attributes at project level
2396 Current_Array_Id := Project.Decl.Arrays;
2397 while Current_Array_Id /= No_Array loop
2398 Current_Array := Shared.Arrays.Table (Current_Array_Id);
2400 Element_Id := Current_Array.Value;
2401 while Element_Id /= No_Array_Element loop
2402 Element := Shared.Array_Elements.Table (Element_Id);
2404 -- Get the name of the language
2407 Get_Language_From_Name
2408 (Project, Get_Name_String (Element.Index));
2410 if Lang_Index /= No_Language_Index then
2411 case Current_Array.Name is
2412 when Name_Inherit_Source_Path =>
2413 List := Element.Value.Values;
2415 if List /= Nil_String then
2418 Lang_Index.Config.Include_Compatible_Languages,
2420 In_Tree => Data.Tree,
2421 Lower_Case => True);
2424 when Name_Toolchain_Description =>
2426 -- Attribute Toolchain_Description (<language>)
2428 Lang_Index.Config.Toolchain_Description :=
2429 Element.Value.Value;
2431 when Name_Toolchain_Version =>
2433 -- Attribute Toolchain_Version (<language>)
2435 Lang_Index.Config.Toolchain_Version :=
2436 Element.Value.Value;
2438 -- For Ada, set proper checksum computation mode
2440 if Lang_Index.Name = Name_Ada then
2442 Vers : constant String :=
2443 Get_Name_String (Element.Value.Value);
2444 pragma Assert (Vers'First = 1);
2447 -- Version 6.3 or earlier
2450 and then Vers (1 .. 5) = "GNAT "
2451 and then Vers (7) = '.'
2455 (Vers (6) = '6' and then Vers (8) < '4'))
2457 Checksum_GNAT_6_3 := True;
2459 -- Version 5.03 or earlier
2462 or else (Vers (6) = '5'
2463 and then Vers (Vers'Last) < '4')
2465 Checksum_GNAT_5_03 := True;
2467 -- Version 5.02 or earlier
2470 or else Vers (Vers'Last) < '3'
2472 Checksum_Accumulate_Token_Checksum :=
2480 when Name_Runtime_Library_Dir =>
2482 -- Attribute Runtime_Library_Dir (<language>)
2484 Lang_Index.Config.Runtime_Library_Dir :=
2485 Element.Value.Value;
2487 when Name_Runtime_Source_Dir =>
2489 -- Attribute Runtime_Library_Dir (<language>)
2491 Lang_Index.Config.Runtime_Source_Dir :=
2492 Element.Value.Value;
2494 when Name_Object_Generated =>
2496 pragma Unsuppress (All_Checks);
2502 (Get_Name_String (Element.Value.Value));
2504 Lang_Index.Config.Object_Generated := Value;
2506 -- If no object is generated, no object may be
2510 Lang_Index.Config.Objects_Linked := False;
2514 when Constraint_Error =>
2518 & Get_Name_String (Element.Value.Value)
2519 & """ for Object_Generated",
2520 Element.Value.Location, Project);
2523 when Name_Objects_Linked =>
2525 pragma Unsuppress (All_Checks);
2531 (Get_Name_String (Element.Value.Value));
2533 -- No change if Object_Generated is False, as this
2534 -- forces Objects_Linked to be False too.
2536 if Lang_Index.Config.Object_Generated then
2537 Lang_Index.Config.Objects_Linked := Value;
2541 when Constraint_Error =>
2545 & Get_Name_String (Element.Value.Value)
2546 & """ for Objects_Linked",
2547 Element.Value.Location, Project);
2554 Element_Id := Element.Next;
2557 Current_Array_Id := Current_Array.Next;
2559 end Process_Project_Level_Array_Attributes;
2561 -- Start of processing for Check_Configuration
2564 Process_Project_Level_Simple_Attributes;
2565 Process_Project_Level_Array_Attributes;
2568 -- For unit based languages, set Casing, Dot_Replacement and
2569 -- Separate_Suffix in Naming_Data.
2571 Lang_Index := Project.Languages;
2572 while Lang_Index /= No_Language_Index loop
2573 if Lang_Index.Name = Name_Ada then
2574 Lang_Index.Config.Naming_Data.Casing := Casing;
2575 Lang_Index.Config.Naming_Data.Dot_Replacement := Dot_Replacement;
2577 if Separate_Suffix /= No_File then
2578 Lang_Index.Config.Naming_Data.Separate_Suffix :=
2585 Lang_Index := Lang_Index.Next;
2588 -- Give empty names to various prefixes/suffixes, if they have not
2589 -- been specified in the configuration.
2591 if Project.Config.Archive_Suffix = No_File then
2592 Project.Config.Archive_Suffix := Empty_File;
2595 if Project.Config.Shared_Lib_Prefix = No_File then
2596 Project.Config.Shared_Lib_Prefix := Empty_File;
2599 if Project.Config.Shared_Lib_Suffix = No_File then
2600 Project.Config.Shared_Lib_Suffix := Empty_File;
2603 Lang_Index := Project.Languages;
2604 while Lang_Index /= No_Language_Index loop
2606 -- For all languages, Compiler_Driver needs to be specified. This is
2607 -- only needed if we do intend to compile (not in GPS for instance).
2609 if Data.Flags.Compiler_Driver_Mandatory
2610 and then Lang_Index.Config.Compiler_Driver = No_File
2612 Error_Msg_Name_1 := Lang_Index.Display_Name;
2615 "?no compiler specified for language %%" &
2616 ", ignoring all its sources",
2617 No_Location, Project);
2619 if Lang_Index = Project.Languages then
2620 Project.Languages := Lang_Index.Next;
2622 Prev_Index.Next := Lang_Index.Next;
2625 elsif Lang_Index.Name = Name_Ada then
2626 Prev_Index := Lang_Index;
2628 -- For unit based languages, Dot_Replacement, Spec_Suffix and
2629 -- Body_Suffix need to be specified.
2631 if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then
2634 "Dot_Replacement not specified for Ada",
2635 No_Location, Project);
2638 if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
2641 "Spec_Suffix not specified for Ada",
2642 No_Location, Project);
2645 if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
2648 "Body_Suffix not specified for Ada",
2649 No_Location, Project);
2653 Prev_Index := Lang_Index;
2655 -- For file based languages, either Spec_Suffix or Body_Suffix
2656 -- need to be specified.
2658 if Data.Flags.Require_Sources_Other_Lang
2659 and then Lang_Index.Config.Naming_Data.Spec_Suffix = No_File
2660 and then Lang_Index.Config.Naming_Data.Body_Suffix = No_File
2662 Error_Msg_Name_1 := Lang_Index.Display_Name;
2665 "no suffixes specified for %%",
2666 No_Location, Project);
2670 Lang_Index := Lang_Index.Next;
2672 end Check_Configuration;
2674 -------------------------------
2675 -- Check_If_Externally_Built --
2676 -------------------------------
2678 procedure Check_If_Externally_Built
2679 (Project : Project_Id;
2680 Data : in out Tree_Processing_Data)
2682 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
2683 Externally_Built : constant Variable_Value :=
2685 (Name_Externally_Built,
2686 Project.Decl.Attributes, Shared);
2689 if not Externally_Built.Default then
2690 Get_Name_String (Externally_Built.Value);
2691 To_Lower (Name_Buffer (1 .. Name_Len));
2693 if Name_Buffer (1 .. Name_Len) = "true" then
2694 Project.Externally_Built := True;
2696 elsif Name_Buffer (1 .. Name_Len) /= "false" then
2697 Error_Msg (Data.Flags,
2698 "Externally_Built may only be true or false",
2699 Externally_Built.Location, Project);
2703 -- A virtual project extending an externally built project is itself
2704 -- externally built.
2706 if Project.Virtual and then Project.Extends /= No_Project then
2707 Project.Externally_Built := Project.Extends.Externally_Built;
2710 if Project.Externally_Built then
2711 Debug_Output ("Project is externally built");
2713 Debug_Output ("Project is not externally built");
2715 end Check_If_Externally_Built;
2717 ----------------------
2718 -- Check_Interfaces --
2719 ----------------------
2721 procedure Check_Interfaces
2722 (Project : Project_Id;
2723 Data : in out Tree_Processing_Data)
2725 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
2727 Interfaces : constant Prj.Variable_Value :=
2729 (Snames.Name_Interfaces,
2730 Project.Decl.Attributes,
2733 Library_Interface : constant Prj.Variable_Value :=
2735 (Snames.Name_Library_Interface,
2736 Project.Decl.Attributes,
2739 List : String_List_Id;
2740 Element : String_Element;
2741 Name : File_Name_Type;
2742 Iter : Source_Iterator;
2744 Project_2 : Project_Id;
2748 if not Interfaces.Default then
2750 -- Set In_Interfaces to False for all sources. It will be set to True
2751 -- later for the sources in the Interfaces list.
2753 Project_2 := Project;
2754 while Project_2 /= No_Project loop
2755 Iter := For_Each_Source (Data.Tree, Project_2);
2757 Source := Prj.Element (Iter);
2758 exit when Source = No_Source;
2759 Source.In_Interfaces := False;
2763 Project_2 := Project_2.Extends;
2766 List := Interfaces.Values;
2767 while List /= Nil_String loop
2768 Element := Shared.String_Elements.Table (List);
2769 Name := Canonical_Case_File_Name (Element.Value);
2771 Project_2 := Project;
2773 while Project_2 /= No_Project loop
2774 Iter := For_Each_Source (Data.Tree, Project_2);
2777 Source := Prj.Element (Iter);
2778 exit when Source = No_Source;
2780 if Source.File = Name then
2781 if not Source.Locally_Removed then
2782 Source.In_Interfaces := True;
2783 Source.Declared_In_Interfaces := True;
2785 Other := Other_Part (Source);
2787 if Other /= No_Source then
2788 Other.In_Interfaces := True;
2789 Other.Declared_In_Interfaces := True;
2793 ("interface: ", Name_Id (Source.Path.Name));
2802 Project_2 := Project_2.Extends;
2805 if Source = No_Source then
2806 Error_Msg_File_1 := File_Name_Type (Element.Value);
2807 Error_Msg_Name_1 := Project.Name;
2811 "{ cannot be an interface of project %% "
2812 & "as it is not one of its sources",
2813 Element.Location, Project);
2816 List := Element.Next;
2819 Project.Interfaces_Defined := True;
2821 elsif Project.Library and then not Library_Interface.Default then
2823 -- Set In_Interfaces to False for all sources. It will be set to True
2824 -- later for the sources in the Library_Interface list.
2826 Project_2 := Project;
2827 while Project_2 /= No_Project loop
2828 Iter := For_Each_Source (Data.Tree, Project_2);
2830 Source := Prj.Element (Iter);
2831 exit when Source = No_Source;
2832 Source.In_Interfaces := False;
2836 Project_2 := Project_2.Extends;
2839 List := Library_Interface.Values;
2840 while List /= Nil_String loop
2841 Element := Shared.String_Elements.Table (List);
2842 Get_Name_String (Element.Value);
2843 To_Lower (Name_Buffer (1 .. Name_Len));
2846 Project_2 := Project;
2848 while Project_2 /= No_Project loop
2849 Iter := For_Each_Source (Data.Tree, Project_2);
2852 Source := Prj.Element (Iter);
2853 exit when Source = No_Source;
2855 if Source.Unit /= No_Unit_Index and then
2856 Source.Unit.Name = Name_Id (Name)
2858 if not Source.Locally_Removed then
2859 Source.In_Interfaces := True;
2860 Source.Declared_In_Interfaces := True;
2862 Other := Other_Part (Source);
2864 if Other /= No_Source then
2865 Other.In_Interfaces := True;
2866 Other.Declared_In_Interfaces := True;
2870 ("interface: ", Name_Id (Source.Path.Name));
2879 Project_2 := Project_2.Extends;
2880 end loop Big_Loop_2;
2882 List := Element.Next;
2885 Project.Interfaces_Defined := True;
2887 elsif Project.Extends /= No_Project
2888 and then Project.Extends.Interfaces_Defined
2890 Project.Interfaces_Defined := True;
2892 Iter := For_Each_Source (Data.Tree, Project);
2894 Source := Prj.Element (Iter);
2895 exit when Source = No_Source;
2897 if not Source.Declared_In_Interfaces then
2898 Source.In_Interfaces := False;
2904 end Check_Interfaces;
2906 --------------------------
2907 -- Check_Package_Naming --
2908 --------------------------
2910 procedure Check_Package_Naming
2911 (Project : Project_Id;
2912 Data : in out Tree_Processing_Data)
2914 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
2915 Naming_Id : constant Package_Id :=
2917 (Name_Naming, Project.Decl.Packages, Shared);
2918 Naming : Package_Element;
2920 Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
2922 procedure Check_Naming;
2923 -- Check the validity of the Naming package (suffixes valid, ...)
2925 procedure Check_Common
2926 (Dot_Replacement : in out File_Name_Type;
2927 Casing : in out Casing_Type;
2928 Casing_Defined : out Boolean;
2929 Separate_Suffix : in out File_Name_Type;
2930 Sep_Suffix_Loc : out Source_Ptr);
2931 -- Check attributes common
2933 procedure Process_Exceptions_File_Based
2934 (Lang_Id : Language_Ptr;
2935 Kind : Source_Kind);
2936 procedure Process_Exceptions_Unit_Based
2937 (Lang_Id : Language_Ptr;
2938 Kind : Source_Kind);
2939 -- Process the naming exceptions for the two types of languages
2941 procedure Initialize_Naming_Data;
2942 -- Initialize internal naming data for the various languages
2948 procedure Check_Common
2949 (Dot_Replacement : in out File_Name_Type;
2950 Casing : in out Casing_Type;
2951 Casing_Defined : out Boolean;
2952 Separate_Suffix : in out File_Name_Type;
2953 Sep_Suffix_Loc : out Source_Ptr)
2955 Dot_Repl : constant Variable_Value :=
2957 (Name_Dot_Replacement,
2958 Naming.Decl.Attributes,
2960 Casing_String : constant Variable_Value :=
2963 Naming.Decl.Attributes,
2965 Sep_Suffix : constant Variable_Value :=
2967 (Name_Separate_Suffix,
2968 Naming.Decl.Attributes,
2970 Dot_Repl_Loc : Source_Ptr;
2973 Sep_Suffix_Loc := No_Location;
2975 if not Dot_Repl.Default then
2977 (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
2979 if Length_Of_Name (Dot_Repl.Value) = 0 then
2981 (Data.Flags, "Dot_Replacement cannot be empty",
2982 Dot_Repl.Location, Project);
2985 Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
2986 Dot_Repl_Loc := Dot_Repl.Location;
2989 Repl : constant String := Get_Name_String (Dot_Replacement);
2992 -- Dot_Replacement cannot
2994 -- - start or end with an alphanumeric
2995 -- - be a single '_'
2996 -- - start with an '_' followed by an alphanumeric
2997 -- - contain a '.' except if it is "."
3000 or else Is_Alphanumeric (Repl (Repl'First))
3001 or else Is_Alphanumeric (Repl (Repl'Last))
3002 or else (Repl (Repl'First) = '_'
3006 Is_Alphanumeric (Repl (Repl'First + 1))))
3007 or else (Repl'Length > 1
3009 Index (Source => Repl, Pattern => ".") /= 0)
3014 """ is illegal for Dot_Replacement.",
3015 Dot_Repl_Loc, Project);
3020 if Dot_Replacement /= No_File then
3022 ("Dot_Replacement", Get_Name_String (Dot_Replacement));
3025 Casing_Defined := False;
3027 if not Casing_String.Default then
3029 (Casing_String.Kind = Single, "Casing is not a string");
3032 Casing_Image : constant String :=
3033 Get_Name_String (Casing_String.Value);
3036 if Casing_Image'Length = 0 then
3039 "Casing cannot be an empty string",
3040 Casing_String.Location, Project);
3043 Casing := Value (Casing_Image);
3044 Casing_Defined := True;
3047 when Constraint_Error =>
3048 Name_Len := Casing_Image'Length;
3049 Name_Buffer (1 .. Name_Len) := Casing_Image;
3050 Err_Vars.Error_Msg_Name_1 := Name_Find;
3053 "%% is not a correct Casing",
3054 Casing_String.Location, Project);
3058 Write_Attr ("Casing", Image (Casing));
3060 if not Sep_Suffix.Default then
3061 if Length_Of_Name (Sep_Suffix.Value) = 0 then
3064 "Separate_Suffix cannot be empty",
3065 Sep_Suffix.Location, Project);
3068 Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
3069 Sep_Suffix_Loc := Sep_Suffix.Location;
3071 Check_Illegal_Suffix
3072 (Project, Separate_Suffix,
3073 Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location,
3078 if Separate_Suffix /= No_File then
3080 ("Separate_Suffix", Get_Name_String (Separate_Suffix));
3084 -----------------------------------
3085 -- Process_Exceptions_File_Based --
3086 -----------------------------------
3088 procedure Process_Exceptions_File_Based
3089 (Lang_Id : Language_Ptr;
3092 Lang : constant Name_Id := Lang_Id.Name;
3093 Exceptions : Array_Element_Id;
3094 Exception_List : Variable_Value;
3095 Element_Id : String_List_Id;
3096 Element : String_Element;
3097 File_Name : File_Name_Type;
3105 (Name_Implementation_Exceptions,
3106 In_Arrays => Naming.Decl.Arrays,
3112 (Name_Specification_Exceptions,
3113 In_Arrays => Naming.Decl.Arrays,
3120 In_Array => Exceptions,
3123 if Exception_List /= Nil_Variable_Value then
3124 Element_Id := Exception_List.Values;
3125 while Element_Id /= Nil_String loop
3126 Element := Shared.String_Elements.Table (Element_Id);
3127 File_Name := Canonical_Case_File_Name (Element.Value);
3130 Source_Files_Htable.Get
3131 (Data.Tree.Source_Files_HT, File_Name);
3132 while Source /= No_Source
3133 and then Source.Project /= Project
3135 Source := Source.Next_With_File_Name;
3138 if Source = No_Source then
3143 Source_Dir_Rank => 0,
3146 File_Name => File_Name,
3147 Display_File => File_Name_Type (Element.Value),
3148 Naming_Exception => True,
3149 Location => Element.Location);
3152 -- Check if the file name is already recorded for another
3153 -- language or another kind.
3155 if Source.Language /= Lang_Id then
3158 "the same file cannot be a source of two languages",
3159 Element.Location, Project);
3161 elsif Source.Kind /= Kind then
3164 "the same file cannot be a source and a template",
3165 Element.Location, Project);
3168 -- If the file is already recorded for the same
3169 -- language and the same kind, it means that the file
3170 -- name appears several times in the *_Exceptions
3171 -- attribute; so there is nothing to do.
3174 Element_Id := Element.Next;
3177 end Process_Exceptions_File_Based;
3179 -----------------------------------
3180 -- Process_Exceptions_Unit_Based --
3181 -----------------------------------
3183 procedure Process_Exceptions_Unit_Based
3184 (Lang_Id : Language_Ptr;
3187 Lang : constant Name_Id := Lang_Id.Name;
3188 Exceptions : Array_Element_Id;
3189 Element : Array_Element;
3192 File_Name : File_Name_Type;
3201 In_Arrays => Naming.Decl.Arrays,
3204 if Exceptions = No_Array_Element then
3207 (Name_Implementation,
3208 In_Arrays => Naming.Decl.Arrays,
3216 In_Arrays => Naming.Decl.Arrays,
3219 if Exceptions = No_Array_Element then
3223 In_Arrays => Naming.Decl.Arrays,
3228 while Exceptions /= No_Array_Element loop
3229 Element := Shared.Array_Elements.Table (Exceptions);
3230 File_Name := Canonical_Case_File_Name (Element.Value.Value);
3232 Get_Name_String (Element.Index);
3233 To_Lower (Name_Buffer (1 .. Name_Len));
3235 Index := Element.Value.Index;
3237 -- For Ada, check if it is a valid unit name
3239 if Lang = Name_Ada then
3240 Get_Name_String (Element.Index);
3241 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
3243 if Unit = No_Name then
3244 Err_Vars.Error_Msg_Name_1 := Element.Index;
3247 "%% is not a valid unit name.",
3248 Element.Value.Location, Project);
3252 if Unit /= No_Name then
3257 Source_Dir_Rank => 0,
3260 File_Name => File_Name,
3261 Display_File => File_Name_Type (Element.Value.Value),
3264 Location => Element.Value.Location,
3265 Naming_Exception => True);
3268 Exceptions := Element.Next;
3270 end Process_Exceptions_Unit_Based;
3276 procedure Check_Naming is
3277 Dot_Replacement : File_Name_Type :=
3279 (First_Name_Id + Character'Pos ('-'));
3280 Separate_Suffix : File_Name_Type := No_File;
3281 Casing : Casing_Type := All_Lower_Case;
3282 Casing_Defined : Boolean;
3283 Lang_Id : Language_Ptr;
3284 Sep_Suffix_Loc : Source_Ptr;
3285 Suffix : Variable_Value;
3290 (Dot_Replacement => Dot_Replacement,
3292 Casing_Defined => Casing_Defined,
3293 Separate_Suffix => Separate_Suffix,
3294 Sep_Suffix_Loc => Sep_Suffix_Loc);
3296 -- For all unit based languages, if any, set the specified value
3297 -- of Dot_Replacement, Casing and/or Separate_Suffix. Do not
3298 -- systematically overwrite, since the defaults come from the
3299 -- configuration file.
3301 if Dot_Replacement /= No_File
3302 or else Casing_Defined
3303 or else Separate_Suffix /= No_File
3305 Lang_Id := Project.Languages;
3306 while Lang_Id /= No_Language_Index loop
3307 if Lang_Id.Config.Kind = Unit_Based then
3308 if Dot_Replacement /= No_File then
3309 Lang_Id.Config.Naming_Data.Dot_Replacement :=
3313 if Casing_Defined then
3314 Lang_Id.Config.Naming_Data.Casing := Casing;
3318 Lang_Id := Lang_Id.Next;
3322 -- Next, get the spec and body suffixes
3324 Lang_Id := Project.Languages;
3325 while Lang_Id /= No_Language_Index loop
3326 Lang := Lang_Id.Name;
3332 Attribute_Or_Array_Name => Name_Spec_Suffix,
3333 In_Package => Naming_Id,
3336 if Suffix = Nil_Variable_Value then
3339 Attribute_Or_Array_Name => Name_Specification_Suffix,
3340 In_Package => Naming_Id,
3344 if Suffix /= Nil_Variable_Value then
3345 Lang_Id.Config.Naming_Data.Spec_Suffix :=
3346 File_Name_Type (Suffix.Value);
3348 Check_Illegal_Suffix
3350 Lang_Id.Config.Naming_Data.Spec_Suffix,
3351 Lang_Id.Config.Naming_Data.Dot_Replacement,
3352 "Spec_Suffix", Suffix.Location, Data);
3356 Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix));
3364 Attribute_Or_Array_Name => Name_Body_Suffix,
3365 In_Package => Naming_Id,
3368 if Suffix = Nil_Variable_Value then
3372 Attribute_Or_Array_Name => Name_Implementation_Suffix,
3373 In_Package => Naming_Id,
3377 if Suffix /= Nil_Variable_Value then
3378 Lang_Id.Config.Naming_Data.Body_Suffix :=
3379 File_Name_Type (Suffix.Value);
3381 -- The default value of separate suffix should be the same as
3382 -- the body suffix, so we need to compute that first.
3384 if Separate_Suffix = No_File then
3385 Lang_Id.Config.Naming_Data.Separate_Suffix :=
3386 Lang_Id.Config.Naming_Data.Body_Suffix;
3390 (Lang_Id.Config.Naming_Data.Separate_Suffix));
3392 Lang_Id.Config.Naming_Data.Separate_Suffix :=
3396 Check_Illegal_Suffix
3398 Lang_Id.Config.Naming_Data.Body_Suffix,
3399 Lang_Id.Config.Naming_Data.Dot_Replacement,
3400 "Body_Suffix", Suffix.Location, Data);
3404 Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix));
3406 elsif Separate_Suffix /= No_File then
3407 Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix;
3410 -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
3411 -- since that would cause a clear ambiguity. Note that we do allow
3412 -- a Spec_Suffix to have the same termination as one of these,
3413 -- which causes a potential ambiguity, but we resolve that by
3414 -- matching the longest possible suffix.
3416 if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
3417 and then Lang_Id.Config.Naming_Data.Spec_Suffix =
3418 Lang_Id.Config.Naming_Data.Body_Suffix
3423 & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)
3424 & """) cannot be the same as Spec_Suffix.",
3425 Ada_Body_Suffix_Loc, Project);
3428 if Lang_Id.Config.Naming_Data.Body_Suffix /=
3429 Lang_Id.Config.Naming_Data.Separate_Suffix
3430 and then Lang_Id.Config.Naming_Data.Spec_Suffix =
3431 Lang_Id.Config.Naming_Data.Separate_Suffix
3435 "Separate_Suffix ("""
3437 (Lang_Id.Config.Naming_Data.Separate_Suffix)
3438 & """) cannot be the same as Spec_Suffix.",
3439 Sep_Suffix_Loc, Project);
3442 Lang_Id := Lang_Id.Next;
3445 -- Get the naming exceptions for all languages
3447 for Kind in Spec_Or_Body loop
3448 Lang_Id := Project.Languages;
3449 while Lang_Id /= No_Language_Index loop
3450 case Lang_Id.Config.Kind is
3452 Process_Exceptions_File_Based (Lang_Id, Kind);
3455 Process_Exceptions_Unit_Based (Lang_Id, Kind);
3458 Lang_Id := Lang_Id.Next;
3463 ----------------------------
3464 -- Initialize_Naming_Data --
3465 ----------------------------
3467 procedure Initialize_Naming_Data is
3468 Specs : Array_Element_Id :=
3474 Impls : Array_Element_Id :=
3480 Lang : Language_Ptr;
3481 Lang_Name : Name_Id;
3482 Value : Variable_Value;
3483 Extended : Project_Id;
3486 -- At this stage, the project already contains the default extensions
3487 -- for the various languages. We now merge those suffixes read in the
3488 -- user project, and they override the default.
3490 while Specs /= No_Array_Element loop
3491 Lang_Name := Shared.Array_Elements.Table (Specs).Index;
3493 Get_Language_From_Name
3494 (Project, Name => Get_Name_String (Lang_Name));
3496 -- An extending project inherits its parent projects' languages
3497 -- so if needed we should create entries for those languages
3500 Extended := Project.Extends;
3501 while Extended /= null loop
3502 Lang := Get_Language_From_Name
3503 (Extended, Name => Get_Name_String (Lang_Name));
3504 exit when Lang /= null;
3506 Extended := Extended.Extends;
3509 if Lang /= null then
3510 Lang := new Language_Data'(Lang.all);
3511 Lang.First_Source := null;
3512 Lang.Next := Project.Languages;
3513 Project.Languages := Lang;
3517 -- If language was not found in project or the projects it extends
3521 ("Ignoring spec naming data (lang. not in project): ",
3525 Value := Shared.Array_Elements.Table (Specs).Value;
3527 if Value.Kind = Single then
3528 Lang.Config.Naming_Data.Spec_Suffix :=
3529 Canonical_Case_File_Name (Value.Value);
3533 Specs := Shared.Array_Elements.Table (Specs).Next;
3536 while Impls /= No_Array_Element loop
3537 Lang_Name := Shared.Array_Elements.Table (Impls).Index;
3539 Get_Language_From_Name
3540 (Project, Name => Get_Name_String (Lang_Name));
3544 ("Ignoring impl naming data (lang. not in project): ",
3547 Value := Shared.Array_Elements.Table (Impls).Value;
3549 if Lang.Name = Name_Ada then
3550 Ada_Body_Suffix_Loc := Value.Location;
3553 if Value.Kind = Single then
3554 Lang.Config.Naming_Data.Body_Suffix :=
3555 Canonical_Case_File_Name (Value.Value);
3559 Impls := Shared.Array_Elements.Table (Impls).Next;
3561 end Initialize_Naming_Data;
3563 -- Start of processing for Check_Naming_Schemes
3566 -- No Naming package or parsing a configuration file? nothing to do
3568 if Naming_Id /= No_Package
3569 and then Project.Qualifier /= Configuration
3571 Naming := Shared.Packages.Table (Naming_Id);
3572 Debug_Increase_Indent ("Checking package Naming for ", Project.Name);
3573 Initialize_Naming_Data;
3575 Debug_Decrease_Indent ("Done checking package naming");
3577 end Check_Package_Naming;
3579 ------------------------------
3580 -- Check_Library_Attributes --
3581 ------------------------------
3583 procedure Check_Library_Attributes
3584 (Project : Project_Id;
3585 Data : in out Tree_Processing_Data)
3587 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
3589 Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
3591 Lib_Dir : constant Prj.Variable_Value :=
3593 (Snames.Name_Library_Dir, Attributes, Shared);
3595 Lib_Name : constant Prj.Variable_Value :=
3597 (Snames.Name_Library_Name, Attributes, Shared);
3599 Lib_Version : constant Prj.Variable_Value :=
3601 (Snames.Name_Library_Version, Attributes, Shared);
3603 Lib_ALI_Dir : constant Prj.Variable_Value :=
3605 (Snames.Name_Library_Ali_Dir, Attributes, Shared);
3607 Lib_GCC : constant Prj.Variable_Value :=
3609 (Snames.Name_Library_GCC, Attributes, Shared);
3611 The_Lib_Kind : constant Prj.Variable_Value :=
3613 (Snames.Name_Library_Kind, Attributes, Shared);
3615 Imported_Project_List : Project_List;
3617 Continuation : String_Access := No_Continuation_String'Access;
3619 Support_For_Libraries : Library_Support;
3621 Library_Directory_Present : Boolean;
3623 procedure Check_Library (Proj : Project_Id; Extends : Boolean);
3624 -- Check if an imported or extended project if also a library project
3630 procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
3632 Iter : Source_Iterator;
3635 if Proj /= No_Project then
3636 if not Proj.Library then
3638 -- The only not library projects that are OK are those that
3639 -- have no sources. However, header files from non-Ada
3640 -- languages are OK, as there is nothing to compile.
3642 Iter := For_Each_Source (Data.Tree, Proj);
3644 Src_Id := Prj.Element (Iter);
3645 exit when Src_Id = No_Source
3646 or else Src_Id.Language.Config.Kind /= File_Based
3647 or else Src_Id.Kind /= Spec;
3651 if Src_Id /= No_Source then
3652 Error_Msg_Name_1 := Project.Name;
3653 Error_Msg_Name_2 := Proj.Name;
3656 if Project.Library_Kind /= Static then
3660 "shared library project %% cannot extend " &
3661 "project %% that is not a library project",
3662 Project.Location, Project);
3663 Continuation := Continuation_String'Access;
3666 elsif (not Unchecked_Shared_Lib_Imports)
3667 and then Project.Library_Kind /= Static
3672 "shared library project %% cannot import project %% " &
3673 "that is not a shared library project",
3674 Project.Location, Project);
3675 Continuation := Continuation_String'Access;
3679 elsif Project.Library_Kind /= Static and then
3680 Proj.Library_Kind = Static
3682 Error_Msg_Name_1 := Project.Name;
3683 Error_Msg_Name_2 := Proj.Name;
3689 "shared library project %% cannot extend static " &
3690 "library project %%",
3691 Project.Location, Project);
3692 Continuation := Continuation_String'Access;
3694 elsif not Unchecked_Shared_Lib_Imports then
3698 "shared library project %% cannot import static " &
3699 "library project %%",
3700 Project.Location, Project);
3701 Continuation := Continuation_String'Access;
3708 Dir_Exists : Boolean;
3710 -- Start of processing for Check_Library_Attributes
3713 Library_Directory_Present := Lib_Dir.Value /= Empty_String;
3715 -- Special case of extending project
3717 if Project.Extends /= No_Project then
3719 -- If the project extended is a library project, we inherit the
3720 -- library name, if it is not redefined; we check that the library
3721 -- directory is specified.
3723 if Project.Extends.Library then
3724 if Project.Qualifier = Standard then
3727 "a standard project cannot extend a library project",
3728 Project.Location, Project);
3731 if Lib_Name.Default then
3732 Project.Library_Name := Project.Extends.Library_Name;
3735 if Lib_Dir.Default then
3736 if not Project.Virtual then
3739 "a project extending a library project must " &
3740 "specify an attribute Library_Dir",
3741 Project.Location, Project);
3744 -- For a virtual project extending a library project,
3745 -- inherit library directory and library kind.
3747 Project.Library_Dir := Project.Extends.Library_Dir;
3748 Library_Directory_Present := True;
3749 Project.Library_Kind := Project.Extends.Library_Kind;
3756 pragma Assert (Lib_Name.Kind = Single);
3758 if Lib_Name.Value = Empty_String then
3759 if Current_Verbosity = High
3760 and then Project.Library_Name = No_Name
3763 Write_Line ("No library name");
3767 -- There is no restriction on the syntax of library names
3769 Project.Library_Name := Lib_Name.Value;
3772 if Project.Library_Name /= No_Name then
3773 if Current_Verbosity = High then
3774 Write_Attr ("Library name: ",
3775 Get_Name_String (Project.Library_Name));
3778 pragma Assert (Lib_Dir.Kind = Single);
3780 if not Library_Directory_Present then
3781 Debug_Output ("No library directory");
3784 -- Find path name (unless inherited), check that it is a directory
3786 if Project.Library_Dir = No_Path_Information then
3789 File_Name_Type (Lib_Dir.Value),
3790 Path => Project.Library_Dir,
3791 Dir_Exists => Dir_Exists,
3793 Create => "library",
3794 Must_Exist => False,
3795 Location => Lib_Dir.Location,
3796 Externally_Built => Project.Externally_Built);
3802 (Project.Library_Dir.Display_Name));
3805 if not Dir_Exists then
3807 -- Get the absolute name of the library directory that
3808 -- does not exist, to report an error.
3810 Err_Vars.Error_Msg_File_1 :=
3811 File_Name_Type (Project.Library_Dir.Display_Name);
3814 "library directory { does not exist",
3815 Lib_Dir.Location, Project);
3817 elsif not Project.Externally_Built then
3819 -- The library directory cannot be the same as the Object
3822 if Project.Library_Dir.Name = Project.Object_Directory.Name then
3825 "library directory cannot be the same " &
3826 "as object directory",
3827 Lib_Dir.Location, Project);
3828 Project.Library_Dir := No_Path_Information;
3832 OK : Boolean := True;
3833 Dirs_Id : String_List_Id;
3834 Dir_Elem : String_Element;
3838 -- The library directory cannot be the same as a source
3839 -- directory of the current project.
3841 Dirs_Id := Project.Source_Dirs;
3842 while Dirs_Id /= Nil_String loop
3843 Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
3844 Dirs_Id := Dir_Elem.Next;
3846 if Project.Library_Dir.Name =
3847 Path_Name_Type (Dir_Elem.Value)
3849 Err_Vars.Error_Msg_File_1 :=
3850 File_Name_Type (Dir_Elem.Value);
3853 "library directory cannot be the same " &
3854 "as source directory {",
3855 Lib_Dir.Location, Project);
3863 -- The library directory cannot be the same as a
3864 -- source directory of another project either.
3866 Pid := Data.Tree.Projects;
3868 exit Project_Loop when Pid = null;
3870 if Pid.Project /= Project then
3871 Dirs_Id := Pid.Project.Source_Dirs;
3873 Dir_Loop : while Dirs_Id /= Nil_String loop
3875 Shared.String_Elements.Table (Dirs_Id);
3876 Dirs_Id := Dir_Elem.Next;
3878 if Project.Library_Dir.Name =
3879 Path_Name_Type (Dir_Elem.Value)
3881 Err_Vars.Error_Msg_File_1 :=
3882 File_Name_Type (Dir_Elem.Value);
3883 Err_Vars.Error_Msg_Name_1 :=
3888 "library directory cannot be the same" &
3889 " as source directory { of project %%",
3890 Lib_Dir.Location, Project);
3898 end loop Project_Loop;
3902 Project.Library_Dir := No_Path_Information;
3904 elsif Current_Verbosity = High then
3906 -- Display the Library directory in high verbosity
3909 ("Library directory",
3910 Get_Name_String (Project.Library_Dir.Display_Name));
3920 Project.Library_Dir /= No_Path_Information
3921 and then Project.Library_Name /= No_Name;
3923 if Project.Extends = No_Project then
3924 case Project.Qualifier is
3926 if Project.Library then
3929 "a standard project cannot be a library project",
3930 Lib_Name.Location, Project);
3934 if not Project.Library then
3935 if Project.Library_Name = No_Name then
3938 "attribute Library_Name not declared",
3939 Project.Location, Project);
3941 if not Library_Directory_Present then
3944 "\attribute Library_Dir not declared",
3945 Project.Location, Project);
3948 elsif Project.Library_Dir = No_Path_Information then
3951 "attribute Library_Dir not declared",
3952 Project.Location, Project);
3962 if Project.Library then
3963 Support_For_Libraries := Project.Config.Lib_Support;
3965 if Support_For_Libraries = Prj.None then
3968 "?libraries are not supported on this platform",
3969 Lib_Name.Location, Project);
3970 Project.Library := False;
3973 if Lib_ALI_Dir.Value = Empty_String then
3974 Debug_Output ("No library ALI directory specified");
3975 Project.Library_ALI_Dir := Project.Library_Dir;
3978 -- Find path name, check that it is a directory
3982 File_Name_Type (Lib_ALI_Dir.Value),
3983 Path => Project.Library_ALI_Dir,
3984 Create => "library ALI",
3985 Dir_Exists => Dir_Exists,
3987 Must_Exist => False,
3988 Location => Lib_ALI_Dir.Location,
3989 Externally_Built => Project.Externally_Built);
3991 if not Dir_Exists then
3993 -- Get the absolute name of the library ALI directory that
3994 -- does not exist, to report an error.
3996 Err_Vars.Error_Msg_File_1 :=
3997 File_Name_Type (Project.Library_ALI_Dir.Display_Name);
4000 "library 'A'L'I directory { does not exist",
4001 Lib_ALI_Dir.Location, Project);
4004 if (not Project.Externally_Built) and then
4005 Project.Library_ALI_Dir /= Project.Library_Dir
4007 -- The library ALI directory cannot be the same as the
4008 -- Object directory.
4010 if Project.Library_ALI_Dir = Project.Object_Directory then
4013 "library 'A'L'I directory cannot be the same " &
4014 "as object directory",
4015 Lib_ALI_Dir.Location, Project);
4016 Project.Library_ALI_Dir := No_Path_Information;
4020 OK : Boolean := True;
4021 Dirs_Id : String_List_Id;
4022 Dir_Elem : String_Element;
4026 -- The library ALI directory cannot be the same as
4027 -- a source directory of the current project.
4029 Dirs_Id := Project.Source_Dirs;
4030 while Dirs_Id /= Nil_String loop
4031 Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
4032 Dirs_Id := Dir_Elem.Next;
4034 if Project.Library_ALI_Dir.Name =
4035 Path_Name_Type (Dir_Elem.Value)
4037 Err_Vars.Error_Msg_File_1 :=
4038 File_Name_Type (Dir_Elem.Value);
4041 "library 'A'L'I directory cannot be " &
4042 "the same as source directory {",
4043 Lib_ALI_Dir.Location, Project);
4051 -- The library ALI directory cannot be the same as
4052 -- a source directory of another project either.
4054 Pid := Data.Tree.Projects;
4055 ALI_Project_Loop : loop
4056 exit ALI_Project_Loop when Pid = null;
4058 if Pid.Project /= Project then
4059 Dirs_Id := Pid.Project.Source_Dirs;
4062 while Dirs_Id /= Nil_String loop
4064 Shared.String_Elements.Table (Dirs_Id);
4065 Dirs_Id := Dir_Elem.Next;
4067 if Project.Library_ALI_Dir.Name =
4068 Path_Name_Type (Dir_Elem.Value)
4070 Err_Vars.Error_Msg_File_1 :=
4071 File_Name_Type (Dir_Elem.Value);
4072 Err_Vars.Error_Msg_Name_1 :=
4077 "library 'A'L'I directory cannot " &
4078 "be the same as source directory " &
4080 Lib_ALI_Dir.Location, Project);
4082 exit ALI_Project_Loop;
4084 end loop ALI_Dir_Loop;
4087 end loop ALI_Project_Loop;
4091 Project.Library_ALI_Dir := No_Path_Information;
4093 elsif Current_Verbosity = High then
4095 -- Display Library ALI directory in high verbosity
4100 (Project.Library_ALI_Dir.Display_Name));
4107 pragma Assert (Lib_Version.Kind = Single);
4109 if Lib_Version.Value = Empty_String then
4110 Debug_Output ("No library version specified");
4113 Project.Lib_Internal_Name := Lib_Version.Value;
4116 pragma Assert (The_Lib_Kind.Kind = Single);
4118 if The_Lib_Kind.Value = Empty_String then
4119 Debug_Output ("No library kind specified");
4122 Get_Name_String (The_Lib_Kind.Value);
4125 Kind_Name : constant String :=
4126 To_Lower (Name_Buffer (1 .. Name_Len));
4128 OK : Boolean := True;
4131 if Kind_Name = "static" then
4132 Project.Library_Kind := Static;
4134 elsif Kind_Name = "dynamic" then
4135 Project.Library_Kind := Dynamic;
4137 elsif Kind_Name = "relocatable" then
4138 Project.Library_Kind := Relocatable;
4143 "illegal value for Library_Kind",
4144 The_Lib_Kind.Location, Project);
4148 if Current_Verbosity = High and then OK then
4149 Write_Attr ("Library kind", Kind_Name);
4152 if Project.Library_Kind /= Static then
4153 if Support_For_Libraries = Prj.Static_Only then
4156 "only static libraries are supported " &
4158 The_Lib_Kind.Location, Project);
4159 Project.Library := False;
4162 -- Check if (obsolescent) attribute Library_GCC or
4163 -- Linker'Driver is declared.
4165 if Lib_GCC.Value /= Empty_String then
4168 "?Library_'G'C'C is an obsolescent attribute, " &
4169 "use Linker''Driver instead",
4170 Lib_GCC.Location, Project);
4171 Project.Config.Shared_Lib_Driver :=
4172 File_Name_Type (Lib_GCC.Value);
4176 Linker : constant Package_Id :=
4179 Project.Decl.Packages,
4181 Driver : constant Variable_Value :=
4184 Attribute_Or_Array_Name =>
4186 In_Package => Linker,
4190 if Driver /= Nil_Variable_Value
4191 and then Driver.Value /= Empty_String
4193 Project.Config.Shared_Lib_Driver :=
4194 File_Name_Type (Driver.Value);
4203 if Project.Library then
4204 Debug_Output ("This is a library project file");
4206 Check_Library (Project.Extends, Extends => True);
4208 Imported_Project_List := Project.Imported_Projects;
4209 while Imported_Project_List /= null loop
4211 (Imported_Project_List.Project,
4213 Imported_Project_List := Imported_Project_List.Next;
4220 -- Check if Linker'Switches or Linker'Default_Switches are declared.
4221 -- Warn if they are declared, as it is a common error to think that
4222 -- library are "linked" with Linker switches.
4224 if Project.Library then
4226 Linker_Package_Id : constant Package_Id :=
4229 Project.Decl.Packages, Shared);
4230 Linker_Package : Package_Element;
4231 Switches : Array_Element_Id := No_Array_Element;
4234 if Linker_Package_Id /= No_Package then
4235 Linker_Package := Shared.Packages.Table (Linker_Package_Id);
4239 (Name => Name_Switches,
4240 In_Arrays => Linker_Package.Decl.Arrays,
4243 if Switches = No_Array_Element then
4246 (Name => Name_Default_Switches,
4247 In_Arrays => Linker_Package.Decl.Arrays,
4251 if Switches /= No_Array_Element then
4254 "?Linker switches not taken into account in library " &
4256 No_Location, Project);
4262 if Project.Extends /= No_Project and then Project.Extends.Library then
4264 -- Remove the library name from Lib_Data_Table
4266 for J in 1 .. Lib_Data_Table.Last loop
4267 if Lib_Data_Table.Table (J).Proj = Project.Extends then
4268 Lib_Data_Table.Table (J) :=
4269 Lib_Data_Table.Table (Lib_Data_Table.Last);
4270 Lib_Data_Table.Set_Last (Lib_Data_Table.Last - 1);
4275 Project.Extends.Library := False;
4278 if Project.Library and then not Lib_Name.Default then
4280 -- Check if the same library name is used in an other library project
4282 for J in 1 .. Lib_Data_Table.Last loop
4283 if Lib_Data_Table.Table (J).Name = Project.Library_Name then
4284 Error_Msg_Name_1 := Lib_Data_Table.Table (J).Proj.Name;
4287 "Library name cannot be the same as in project %%",
4288 Lib_Name.Location, Project);
4289 Project.Library := False;
4295 if Project.Library then
4297 -- Record the library name
4299 Lib_Data_Table.Append
4300 ((Name => Project.Library_Name, Proj => Project));
4302 end Check_Library_Attributes;
4304 ---------------------------------
4305 -- Check_Programming_Languages --
4306 ---------------------------------
4308 procedure Check_Programming_Languages
4309 (Project : Project_Id;
4310 Data : in out Tree_Processing_Data)
4312 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
4314 Languages : Variable_Value := Nil_Variable_Value;
4315 Def_Lang : Variable_Value := Nil_Variable_Value;
4316 Def_Lang_Id : Name_Id;
4318 procedure Add_Language (Name, Display_Name : Name_Id);
4319 -- Add a new language to the list of languages for the project.
4320 -- Nothing is done if the language has already been defined
4326 procedure Add_Language (Name, Display_Name : Name_Id) is
4327 Lang : Language_Ptr;
4330 Lang := Project.Languages;
4331 while Lang /= No_Language_Index loop
4332 if Name = Lang.Name then
4339 Lang := new Language_Data'(No_Language_Data);
4340 Lang.Next := Project.Languages;
4341 Project.Languages := Lang;
4343 Lang.Display_Name := Display_Name;
4345 if Name = Name_Ada then
4346 Lang.Config.Kind := Unit_Based;
4347 Lang.Config.Dependency_Kind := ALI_File;
4349 Lang.Config.Kind := File_Based;
4353 -- Start of processing for Check_Programming_Languages
4356 Project.Languages := null;
4358 Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
4361 (Name_Default_Language, Project.Decl.Attributes, Shared);
4363 if Project.Source_Dirs /= Nil_String then
4365 -- Check if languages are specified in this project
4367 if Languages.Default then
4369 -- Fail if there is no default language defined
4371 if Def_Lang.Default then
4374 "no languages defined for this project",
4375 Project.Location, Project);
4376 Def_Lang_Id := No_Name;
4379 Get_Name_String (Def_Lang.Value);
4380 To_Lower (Name_Buffer (1 .. Name_Len));
4381 Def_Lang_Id := Name_Find;
4384 if Def_Lang_Id /= No_Name then
4385 Get_Name_String (Def_Lang_Id);
4386 Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
4388 (Name => Def_Lang_Id,
4389 Display_Name => Name_Find);
4394 Current : String_List_Id := Languages.Values;
4395 Element : String_Element;
4398 -- If there are no languages declared, there are no sources
4400 if Current = Nil_String then
4401 Project.Source_Dirs := Nil_String;
4403 if Project.Qualifier = Standard then
4406 "a standard project must have at least one language",
4407 Languages.Location, Project);
4411 -- Look through all the languages specified in attribute
4414 while Current /= Nil_String loop
4415 Element := Shared.String_Elements.Table (Current);
4416 Get_Name_String (Element.Value);
4417 To_Lower (Name_Buffer (1 .. Name_Len));
4421 Display_Name => Element.Value);
4423 Current := Element.Next;
4429 end Check_Programming_Languages;
4431 -------------------------------
4432 -- Check_Stand_Alone_Library --
4433 -------------------------------
4435 procedure Check_Stand_Alone_Library
4436 (Project : Project_Id;
4437 Data : in out Tree_Processing_Data)
4439 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
4441 Lib_Interfaces : constant Prj.Variable_Value :=
4443 (Snames.Name_Library_Interface,
4444 Project.Decl.Attributes,
4447 Lib_Auto_Init : constant Prj.Variable_Value :=
4449 (Snames.Name_Library_Auto_Init,
4450 Project.Decl.Attributes,
4453 Lib_Src_Dir : constant Prj.Variable_Value :=
4455 (Snames.Name_Library_Src_Dir,
4456 Project.Decl.Attributes,
4459 Lib_Symbol_File : constant Prj.Variable_Value :=
4461 (Snames.Name_Library_Symbol_File,
4462 Project.Decl.Attributes,
4465 Lib_Symbol_Policy : constant Prj.Variable_Value :=
4467 (Snames.Name_Library_Symbol_Policy,
4468 Project.Decl.Attributes,
4471 Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
4473 (Snames.Name_Library_Reference_Symbol_File,
4474 Project.Decl.Attributes,
4477 Auto_Init_Supported : Boolean;
4478 OK : Boolean := True;
4480 Next_Proj : Project_Id;
4481 Iter : Source_Iterator;
4484 Auto_Init_Supported := Project.Config.Auto_Init_Supported;
4486 pragma Assert (Lib_Interfaces.Kind = List);
4488 -- It is a stand-alone library project file if attribute
4489 -- Library_Interface is defined.
4491 if not Lib_Interfaces.Default then
4493 Interfaces : String_List_Id := Lib_Interfaces.Values;
4494 Interface_ALIs : String_List_Id := Nil_String;
4498 Project.Standalone_Library := True;
4500 -- Library_Interface cannot be an empty list
4502 if Interfaces = Nil_String then
4505 "Library_Interface cannot be an empty list",
4506 Lib_Interfaces.Location, Project);
4509 -- Process each unit name specified in the attribute
4510 -- Library_Interface.
4512 while Interfaces /= Nil_String loop
4514 (Shared.String_Elements.Table (Interfaces).Value);
4515 To_Lower (Name_Buffer (1 .. Name_Len));
4517 if Name_Len = 0 then
4520 "an interface cannot be an empty string",
4521 Shared.String_Elements.Table (Interfaces).Location,
4526 Error_Msg_Name_1 := Unit;
4528 Next_Proj := Project.Extends;
4529 Iter := For_Each_Source (Data.Tree, Project);
4531 while Prj.Element (Iter) /= No_Source
4533 (Prj.Element (Iter).Unit = null
4534 or else Prj.Element (Iter).Unit.Name /= Unit)
4539 Source := Prj.Element (Iter);
4540 exit when Source /= No_Source
4541 or else Next_Proj = No_Project;
4543 Iter := For_Each_Source (Data.Tree, Next_Proj);
4544 Next_Proj := Next_Proj.Extends;
4547 if Source /= No_Source then
4548 if Source.Kind = Sep then
4549 Source := No_Source;
4551 elsif Source.Kind = Spec
4552 and then Other_Part (Source) /= No_Source
4554 Source := Other_Part (Source);
4558 if Source /= No_Source then
4559 if Source.Project /= Project
4560 and then not Is_Extending (Project, Source.Project)
4562 Source := No_Source;
4566 if Source = No_Source then
4569 "%% is not a unit of this project",
4570 Shared.String_Elements.Table (Interfaces).Location,
4574 if Source.Kind = Spec
4575 and then Other_Part (Source) /= No_Source
4577 Source := Other_Part (Source);
4580 String_Element_Table.Increment_Last
4581 (Shared.String_Elements);
4583 Shared.String_Elements.Table
4584 (String_Element_Table.Last (Shared.String_Elements)) :=
4585 (Value => Name_Id (Source.Dep_Name),
4587 Display_Value => Name_Id (Source.Dep_Name),
4589 Shared.String_Elements.Table (Interfaces).Location,
4591 Next => Interface_ALIs);
4594 String_Element_Table.Last (Shared.String_Elements);
4598 Interfaces := Shared.String_Elements.Table (Interfaces).Next;
4601 -- Put the list of Interface ALIs in the project data
4603 Project.Lib_Interface_ALIs := Interface_ALIs;
4605 -- Check value of attribute Library_Auto_Init and set
4606 -- Lib_Auto_Init accordingly.
4608 if Lib_Auto_Init.Default then
4610 -- If no attribute Library_Auto_Init is declared, then set auto
4611 -- init only if it is supported.
4613 Project.Lib_Auto_Init := Auto_Init_Supported;
4616 Get_Name_String (Lib_Auto_Init.Value);
4617 To_Lower (Name_Buffer (1 .. Name_Len));
4619 if Name_Buffer (1 .. Name_Len) = "false" then
4620 Project.Lib_Auto_Init := False;
4622 elsif Name_Buffer (1 .. Name_Len) = "true" then
4623 if Auto_Init_Supported then
4624 Project.Lib_Auto_Init := True;
4627 -- Library_Auto_Init cannot be "true" if auto init is not
4632 "library auto init not supported " &
4634 Lib_Auto_Init.Location, Project);
4640 "invalid value for attribute Library_Auto_Init",
4641 Lib_Auto_Init.Location, Project);
4646 -- If attribute Library_Src_Dir is defined and not the empty string,
4647 -- check if the directory exist and is not the object directory or
4648 -- one of the source directories. This is the directory where copies
4649 -- of the interface sources will be copied. Note that this directory
4650 -- may be the library directory.
4652 if Lib_Src_Dir.Value /= Empty_String then
4654 Dir_Id : constant File_Name_Type :=
4655 File_Name_Type (Lib_Src_Dir.Value);
4656 Dir_Exists : Boolean;
4662 Path => Project.Library_Src_Dir,
4663 Dir_Exists => Dir_Exists,
4665 Must_Exist => False,
4666 Create => "library source copy",
4667 Location => Lib_Src_Dir.Location,
4668 Externally_Built => Project.Externally_Built);
4670 -- If directory does not exist, report an error
4672 if not Dir_Exists then
4674 -- Get the absolute name of the library directory that does
4675 -- not exist, to report an error.
4677 Err_Vars.Error_Msg_File_1 :=
4678 File_Name_Type (Project.Library_Src_Dir.Display_Name);
4681 "Directory { does not exist",
4682 Lib_Src_Dir.Location, Project);
4684 -- Report error if it is the same as the object directory
4686 elsif Project.Library_Src_Dir = Project.Object_Directory then
4689 "directory to copy interfaces cannot be " &
4690 "the object directory",
4691 Lib_Src_Dir.Location, Project);
4692 Project.Library_Src_Dir := No_Path_Information;
4696 Src_Dirs : String_List_Id;
4697 Src_Dir : String_Element;
4701 -- Interface copy directory cannot be one of the source
4702 -- directory of the current project.
4704 Src_Dirs := Project.Source_Dirs;
4705 while Src_Dirs /= Nil_String loop
4706 Src_Dir := Shared.String_Elements.Table (Src_Dirs);
4708 -- Report error if it is one of the source directories
4710 if Project.Library_Src_Dir.Name =
4711 Path_Name_Type (Src_Dir.Value)
4715 "directory to copy interfaces cannot " &
4716 "be one of the source directories",
4717 Lib_Src_Dir.Location, Project);
4718 Project.Library_Src_Dir := No_Path_Information;
4722 Src_Dirs := Src_Dir.Next;
4725 if Project.Library_Src_Dir /= No_Path_Information then
4727 -- It cannot be a source directory of any other
4730 Pid := Data.Tree.Projects;
4732 exit Project_Loop when Pid = null;
4734 Src_Dirs := Pid.Project.Source_Dirs;
4735 Dir_Loop : while Src_Dirs /= Nil_String loop
4737 Shared.String_Elements.Table (Src_Dirs);
4739 -- Report error if it is one of the source
4742 if Project.Library_Src_Dir.Name =
4743 Path_Name_Type (Src_Dir.Value)
4746 File_Name_Type (Src_Dir.Value);
4747 Error_Msg_Name_1 := Pid.Project.Name;
4750 "directory to copy interfaces cannot " &
4751 "be the same as source directory { of " &
4753 Lib_Src_Dir.Location, Project);
4754 Project.Library_Src_Dir :=
4755 No_Path_Information;
4759 Src_Dirs := Src_Dir.Next;
4763 end loop Project_Loop;
4767 -- In high verbosity, if there is a valid Library_Src_Dir,
4768 -- display its path name.
4770 if Project.Library_Src_Dir /= No_Path_Information
4771 and then Current_Verbosity = High
4774 ("Directory to copy interfaces",
4775 Get_Name_String (Project.Library_Src_Dir.Name));
4781 -- Check the symbol related attributes
4783 -- First, the symbol policy
4785 if not Lib_Symbol_Policy.Default then
4787 Value : constant String :=
4789 (Get_Name_String (Lib_Symbol_Policy.Value));
4792 -- Symbol policy must hove one of a limited number of values
4794 if Value = "autonomous" or else Value = "default" then
4795 Project.Symbol_Data.Symbol_Policy := Autonomous;
4797 elsif Value = "compliant" then
4798 Project.Symbol_Data.Symbol_Policy := Compliant;
4800 elsif Value = "controlled" then
4801 Project.Symbol_Data.Symbol_Policy := Controlled;
4803 elsif Value = "restricted" then
4804 Project.Symbol_Data.Symbol_Policy := Restricted;
4806 elsif Value = "direct" then
4807 Project.Symbol_Data.Symbol_Policy := Direct;
4812 "illegal value for Library_Symbol_Policy",
4813 Lib_Symbol_Policy.Location, Project);
4818 -- If attribute Library_Symbol_File is not specified, symbol policy
4819 -- cannot be Restricted.
4821 if Lib_Symbol_File.Default then
4822 if Project.Symbol_Data.Symbol_Policy = Restricted then
4825 "Library_Symbol_File needs to be defined when " &
4826 "symbol policy is Restricted",
4827 Lib_Symbol_Policy.Location, Project);
4831 -- Library_Symbol_File is defined
4833 Project.Symbol_Data.Symbol_File :=
4834 Path_Name_Type (Lib_Symbol_File.Value);
4836 Get_Name_String (Lib_Symbol_File.Value);
4838 if Name_Len = 0 then
4841 "symbol file name cannot be an empty string",
4842 Lib_Symbol_File.Location, Project);
4845 OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
4848 for J in 1 .. Name_Len loop
4849 if Name_Buffer (J) = '/'
4850 or else Name_Buffer (J) = Directory_Separator
4859 Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
4862 "symbol file name { is illegal. " &
4863 "Name cannot include directory info.",
4864 Lib_Symbol_File.Location, Project);
4869 -- If attribute Library_Reference_Symbol_File is not defined,
4870 -- symbol policy cannot be Compliant or Controlled.
4872 if Lib_Ref_Symbol_File.Default then
4873 if Project.Symbol_Data.Symbol_Policy = Compliant
4874 or else Project.Symbol_Data.Symbol_Policy = Controlled
4878 "a reference symbol file needs to be defined",
4879 Lib_Symbol_Policy.Location, Project);
4883 -- Library_Reference_Symbol_File is defined, check file exists
4885 Project.Symbol_Data.Reference :=
4886 Path_Name_Type (Lib_Ref_Symbol_File.Value);
4888 Get_Name_String (Lib_Ref_Symbol_File.Value);
4890 if Name_Len = 0 then
4893 "reference symbol file name cannot be an empty string",
4894 Lib_Symbol_File.Location, Project);
4897 if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
4899 Add_Str_To_Name_Buffer
4900 (Get_Name_String (Project.Directory.Name));
4901 Add_Str_To_Name_Buffer
4902 (Get_Name_String (Lib_Ref_Symbol_File.Value));
4903 Project.Symbol_Data.Reference := Name_Find;
4906 if not Is_Regular_File
4907 (Get_Name_String (Project.Symbol_Data.Reference))
4910 File_Name_Type (Lib_Ref_Symbol_File.Value);
4912 -- For controlled and direct symbol policies, it is an error
4913 -- if the reference symbol file does not exist. For other
4914 -- symbol policies, this is just a warning
4917 Project.Symbol_Data.Symbol_Policy /= Controlled
4918 and then Project.Symbol_Data.Symbol_Policy /= Direct;
4922 "<library reference symbol file { does not exist",
4923 Lib_Ref_Symbol_File.Location, Project);
4925 -- In addition in the non-controlled case, if symbol policy
4926 -- is Compliant, it is changed to Autonomous, because there
4927 -- is no reference to check against, and we don't want to
4928 -- fail in this case.
4930 if Project.Symbol_Data.Symbol_Policy /= Controlled then
4931 if Project.Symbol_Data.Symbol_Policy = Compliant then
4932 Project.Symbol_Data.Symbol_Policy := Autonomous;
4937 -- If both the reference symbol file and the symbol file are
4938 -- defined, then check that they are not the same file.
4940 if Project.Symbol_Data.Symbol_File /= No_Path then
4941 Get_Name_String (Project.Symbol_Data.Symbol_File);
4943 if Name_Len > 0 then
4945 -- We do not need to pass a Directory to
4946 -- Normalize_Pathname, since the path_information
4947 -- already contains absolute information.
4949 Symb_Path : constant String :=
4952 (Project.Object_Directory.Name) &
4953 Name_Buffer (1 .. Name_Len),
4956 Opt.Follow_Links_For_Files);
4957 Ref_Path : constant String :=
4960 (Project.Symbol_Data.Reference),
4963 Opt.Follow_Links_For_Files);
4965 if Symb_Path = Ref_Path then
4968 "library reference symbol file and library" &
4969 " symbol file cannot be the same file",
4970 Lib_Ref_Symbol_File.Location, Project);
4978 end Check_Stand_Alone_Library;
4980 ----------------------------
4981 -- Compute_Directory_Last --
4982 ----------------------------
4984 function Compute_Directory_Last (Dir : String) return Natural is
4987 and then (Dir (Dir'Last - 1) = Directory_Separator
4989 Dir (Dir'Last - 1) = '/')
4991 return Dir'Last - 1;
4995 end Compute_Directory_Last;
4997 ---------------------
4998 -- Get_Directories --
4999 ---------------------
5001 procedure Get_Directories
5002 (Project : Project_Id;
5003 Data : in out Tree_Processing_Data)
5005 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
5007 Object_Dir : constant Variable_Value :=
5009 (Name_Object_Dir, Project.Decl.Attributes, Shared);
5011 Exec_Dir : constant Variable_Value :=
5013 (Name_Exec_Dir, Project.Decl.Attributes, Shared);
5015 Source_Dirs : constant Variable_Value :=
5017 (Name_Source_Dirs, Project.Decl.Attributes, Shared);
5019 Ignore_Source_Sub_Dirs : constant Variable_Value :=
5021 (Name_Ignore_Source_Sub_Dirs,
5022 Project.Decl.Attributes,
5025 Excluded_Source_Dirs : constant Variable_Value :=
5027 (Name_Excluded_Source_Dirs,
5028 Project.Decl.Attributes,
5031 Source_Files : constant Variable_Value :=
5034 Project.Decl.Attributes, Shared);
5036 Last_Source_Dir : String_List_Id := Nil_String;
5037 Last_Src_Dir_Rank : Number_List_Index := No_Number_List;
5039 Languages : constant Variable_Value :=
5041 (Name_Languages, Project.Decl.Attributes, Shared);
5043 Remove_Source_Dirs : Boolean := False;
5045 procedure Add_To_Or_Remove_From_Source_Dirs
5046 (Path : Path_Information;
5048 -- When Removed = False, the directory Path_Id to the list of
5049 -- source_dirs if not already in the list. When Removed = True,
5050 -- removed directory Path_Id if in the list.
5052 procedure Find_Source_Dirs is new Expand_Subdirectory_Pattern
5053 (Add_To_Or_Remove_From_Source_Dirs);
5055 ---------------------------------------
5056 -- Add_To_Or_Remove_From_Source_Dirs --
5057 ---------------------------------------
5059 procedure Add_To_Or_Remove_From_Source_Dirs
5060 (Path : Path_Information;
5063 List : String_List_Id;
5064 Prev : String_List_Id;
5065 Rank_List : Number_List_Index;
5066 Prev_Rank : Number_List_Index;
5067 Element : String_Element;
5071 Prev_Rank := No_Number_List;
5072 List := Project.Source_Dirs;
5073 Rank_List := Project.Source_Dir_Ranks;
5074 while List /= Nil_String loop
5075 Element := Shared.String_Elements.Table (List);
5076 exit when Element.Value = Name_Id (Path.Name);
5078 List := Element.Next;
5079 Prev_Rank := Rank_List;
5080 Rank_List := Shared.Number_Lists.Table (Prev_Rank).Next;
5083 -- The directory is in the list if List is not Nil_String
5085 if not Remove_Source_Dirs and then List = Nil_String then
5086 Debug_Output ("Adding source dir=", Name_Id (Path.Display_Name));
5088 String_Element_Table.Increment_Last (Shared.String_Elements);
5090 (Value => Name_Id (Path.Name),
5092 Display_Value => Name_Id (Path.Display_Name),
5093 Location => No_Location,
5095 Next => Nil_String);
5097 Number_List_Table.Increment_Last (Shared.Number_Lists);
5099 if Last_Source_Dir = Nil_String then
5101 -- This is the first source directory
5103 Project.Source_Dirs :=
5104 String_Element_Table.Last (Shared.String_Elements);
5105 Project.Source_Dir_Ranks :=
5106 Number_List_Table.Last (Shared.Number_Lists);
5109 -- We already have source directories, link the previous
5110 -- last to the new one.
5112 Shared.String_Elements.Table (Last_Source_Dir).Next :=
5113 String_Element_Table.Last (Shared.String_Elements);
5114 Shared.Number_Lists.Table (Last_Src_Dir_Rank).Next :=
5115 Number_List_Table.Last (Shared.Number_Lists);
5118 -- And register this source directory as the new last
5121 String_Element_Table.Last (Shared.String_Elements);
5122 Shared.String_Elements.Table (Last_Source_Dir) := Element;
5123 Last_Src_Dir_Rank := Number_List_Table.Last (Shared.Number_Lists);
5124 Shared.Number_Lists.Table (Last_Src_Dir_Rank) :=
5125 (Number => Rank, Next => No_Number_List);
5127 elsif Remove_Source_Dirs and then List /= Nil_String then
5129 -- Remove source dir if present
5131 if Prev = Nil_String then
5132 Project.Source_Dirs := Shared.String_Elements.Table (List).Next;
5133 Project.Source_Dir_Ranks :=
5134 Shared.Number_Lists.Table (Rank_List).Next;
5137 Shared.String_Elements.Table (Prev).Next :=
5138 Shared.String_Elements.Table (List).Next;
5139 Shared.Number_Lists.Table (Prev_Rank).Next :=
5140 Shared.Number_Lists.Table (Rank_List).Next;
5143 end Add_To_Or_Remove_From_Source_Dirs;
5145 -- Local declarations
5147 Dir_Exists : Boolean;
5149 No_Sources : constant Boolean :=
5150 ((not Source_Files.Default
5151 and then Source_Files.Values = Nil_String)
5153 (not Source_Dirs.Default
5154 and then Source_Dirs.Values = Nil_String)
5156 (not Languages.Default
5157 and then Languages.Values = Nil_String))
5158 and then Project.Extends = No_Project;
5160 -- Start of processing for Get_Directories
5163 Debug_Output ("Starting to look for directories");
5165 -- Set the object directory to its default which may be nil, if there
5166 -- is no sources in the project.
5169 Project.Object_Directory := No_Path_Information;
5171 Project.Object_Directory := Project.Directory;
5174 -- Check the object directory
5176 if Object_Dir.Value /= Empty_String then
5177 Get_Name_String (Object_Dir.Value);
5179 if Name_Len = 0 then
5182 "Object_Dir cannot be empty",
5183 Object_Dir.Location, Project);
5185 elsif not No_Sources then
5187 -- We check that the specified object directory does exist.
5188 -- However, even when it doesn't exist, we set it to a default
5189 -- value. This is for the benefit of tools that recover from
5190 -- errors; for example, these tools could create the non existent
5191 -- directory. We always return an absolute directory name though.
5195 File_Name_Type (Object_Dir.Value),
5196 Path => Project.Object_Directory,
5198 Dir_Exists => Dir_Exists,
5200 Location => Object_Dir.Location,
5201 Must_Exist => False,
5202 Externally_Built => Project.Externally_Built);
5205 and then not Project.Externally_Built
5207 -- The object directory does not exist, report an error if the
5208 -- project is not externally built.
5210 Err_Vars.Error_Msg_File_1 :=
5211 File_Name_Type (Object_Dir.Value);
5213 (Data.Flags, Data.Flags.Require_Obj_Dirs,
5214 "object directory { not found", Project.Location, Project);
5218 elsif not No_Sources and then Subdirs /= null then
5220 Name_Buffer (1) := '.';
5224 Path => Project.Object_Directory,
5226 Dir_Exists => Dir_Exists,
5228 Location => Object_Dir.Location,
5229 Externally_Built => Project.Externally_Built);
5232 if Current_Verbosity = High then
5233 if Project.Object_Directory = No_Path_Information then
5234 Debug_Output ("No object directory");
5237 ("Object directory",
5238 Get_Name_String (Project.Object_Directory.Display_Name));
5242 -- Check the exec directory
5244 -- We set the object directory to its default
5246 Project.Exec_Directory := Project.Object_Directory;
5248 if Exec_Dir.Value /= Empty_String then
5249 Get_Name_String (Exec_Dir.Value);
5251 if Name_Len = 0 then
5254 "Exec_Dir cannot be empty",
5255 Exec_Dir.Location, Project);
5257 elsif not No_Sources then
5259 -- We check that the specified exec directory does exist
5263 File_Name_Type (Exec_Dir.Value),
5264 Path => Project.Exec_Directory,
5265 Dir_Exists => Dir_Exists,
5268 Location => Exec_Dir.Location,
5269 Externally_Built => Project.Externally_Built);
5271 if not Dir_Exists then
5272 Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
5274 (Data.Flags, Data.Flags.Missing_Source_Files,
5275 "exec directory { not found", Project.Location, Project);
5280 if Current_Verbosity = High then
5281 if Project.Exec_Directory = No_Path_Information then
5282 Debug_Output ("No exec directory");
5285 ("Exec directory: ",
5286 Name_Id (Project.Exec_Directory.Display_Name));
5290 -- Look for the source directories
5292 Debug_Output ("Starting to look for source directories");
5294 pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
5296 if not Source_Files.Default
5297 and then Source_Files.Values = Nil_String
5299 Project.Source_Dirs := Nil_String;
5301 if Project.Qualifier = Standard then
5304 "a standard project cannot have no sources",
5305 Source_Files.Location, Project);
5308 elsif Source_Dirs.Default then
5310 -- No Source_Dirs specified: the single source directory is the one
5311 -- containing the project file.
5313 Remove_Source_Dirs := False;
5314 Add_To_Or_Remove_From_Source_Dirs
5315 (Path => (Name => Project.Directory.Name,
5316 Display_Name => Project.Directory.Display_Name),
5320 Remove_Source_Dirs := False;
5322 (Project => Project,
5324 Patterns => Source_Dirs.Values,
5325 Ignore => Ignore_Source_Sub_Dirs.Values,
5326 Search_For => Search_Directories,
5327 Resolve_Links => Opt.Follow_Links_For_Dirs);
5329 if Project.Source_Dirs = Nil_String
5330 and then Project.Qualifier = Standard
5334 "a standard project cannot have no source directories",
5335 Source_Dirs.Location, Project);
5339 if not Excluded_Source_Dirs.Default
5340 and then Excluded_Source_Dirs.Values /= Nil_String
5342 Remove_Source_Dirs := True;
5344 (Project => Project,
5346 Patterns => Excluded_Source_Dirs.Values,
5347 Ignore => Nil_String,
5348 Search_For => Search_Directories,
5349 Resolve_Links => Opt.Follow_Links_For_Dirs);
5352 Debug_Output ("Putting source directories in canonical cases");
5355 Current : String_List_Id := Project.Source_Dirs;
5356 Element : String_Element;
5359 while Current /= Nil_String loop
5360 Element := Shared.String_Elements.Table (Current);
5361 if Element.Value /= No_Name then
5363 Name_Id (Canonical_Case_File_Name (Element.Value));
5364 Shared.String_Elements.Table (Current) := Element;
5367 Current := Element.Next;
5370 end Get_Directories;
5377 (Project : Project_Id;
5378 Data : in out Tree_Processing_Data)
5380 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
5382 Mains : constant Variable_Value :=
5384 (Name_Main, Project.Decl.Attributes, Shared);
5385 List : String_List_Id;
5386 Elem : String_Element;
5389 Project.Mains := Mains.Values;
5391 -- If no Mains were specified, and if we are an extending project,
5392 -- inherit the Mains from the project we are extending.
5394 if Mains.Default then
5395 if not Project.Library and then Project.Extends /= No_Project then
5396 Project.Mains := Project.Extends.Mains;
5399 -- In a library project file, Main cannot be specified
5401 elsif Project.Library then
5404 "a library project file cannot have Main specified",
5405 Mains.Location, Project);
5408 List := Mains.Values;
5409 while List /= Nil_String loop
5410 Elem := Shared.String_Elements.Table (List);
5412 if Length_Of_Name (Elem.Value) = 0 then
5415 "?a main cannot have an empty name",
5416 Elem.Location, Project);
5425 ---------------------------
5426 -- Get_Sources_From_File --
5427 ---------------------------
5429 procedure Get_Sources_From_File
5431 Location : Source_Ptr;
5432 Project : in out Project_Processing_Data;
5433 Data : in out Tree_Processing_Data)
5435 File : Prj.Util.Text_File;
5436 Line : String (1 .. 250);
5438 Source_Name : File_Name_Type;
5439 Name_Loc : Name_Location;
5442 if Current_Verbosity = High then
5443 Debug_Output ("Opening """ & Path & '"');
5448 Prj.Util.Open (File, Path);
5450 if not Prj.Util.Is_Valid (File) then
5452 (Data.Flags, "file does not exist", Location, Project.Project);
5455 -- Read the lines one by one
5457 while not Prj.Util.End_Of_File (File) loop
5458 Prj.Util.Get_Line (File, Line, Last);
5460 -- A non empty, non comment line should contain a file name
5463 and then (Last = 1 or else Line (1 .. 2) /= "--")
5466 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
5467 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
5468 Source_Name := Name_Find;
5470 -- Check that there is no directory information
5472 for J in 1 .. Last loop
5473 if Line (J) = '/' or else Line (J) = Directory_Separator then
5474 Error_Msg_File_1 := Source_Name;
5477 "file name cannot include directory information ({)",
5478 Location, Project.Project);
5483 Name_Loc := Source_Names_Htable.Get
5484 (Project.Source_Names, Source_Name);
5486 if Name_Loc = No_Name_Location then
5488 (Name => Source_Name,
5489 Location => Location,
5490 Source => No_Source,
5495 Name_Loc.Listed := True;
5498 Source_Names_Htable.Set
5499 (Project.Source_Names, Source_Name, Name_Loc);
5503 Prj.Util.Close (File);
5506 end Get_Sources_From_File;
5512 function No_Space_Img (N : Natural) return String is
5513 Image : constant String := N'Img;
5515 return Image (2 .. Image'Last);
5518 -----------------------
5519 -- Compute_Unit_Name --
5520 -----------------------
5522 procedure Compute_Unit_Name
5523 (File_Name : File_Name_Type;
5524 Naming : Lang_Naming_Data;
5525 Kind : out Source_Kind;
5527 Project : Project_Processing_Data;
5528 In_Tree : Project_Tree_Ref)
5530 Filename : constant String := Get_Name_String (File_Name);
5531 Last : Integer := Filename'Last;
5536 Unit_Except : Unit_Exception;
5537 Masked : Boolean := False;
5543 if Naming.Separate_Suffix = No_File
5544 or else Naming.Body_Suffix = No_File
5545 or else Naming.Spec_Suffix = No_File
5550 if Naming.Dot_Replacement = No_File then
5551 Debug_Output ("No dot_replacement specified");
5555 Sep_Len := Integer (Length_Of_Name (Naming.Separate_Suffix));
5556 Spec_Len := Integer (Length_Of_Name (Naming.Spec_Suffix));
5557 Body_Len := Integer (Length_Of_Name (Naming.Body_Suffix));
5559 -- Choose the longest suffix that matches. If there are several matches,
5560 -- give priority to specs, then bodies, then separates.
5562 if Naming.Separate_Suffix /= Naming.Body_Suffix
5563 and then Suffix_Matches (Filename, Naming.Separate_Suffix)
5565 Last := Filename'Last - Sep_Len;
5569 if Filename'Last - Body_Len <= Last
5570 and then Suffix_Matches (Filename, Naming.Body_Suffix)
5572 Last := Natural'Min (Last, Filename'Last - Body_Len);
5576 if Filename'Last - Spec_Len <= Last
5577 and then Suffix_Matches (Filename, Naming.Spec_Suffix)
5579 Last := Natural'Min (Last, Filename'Last - Spec_Len);
5583 if Last = Filename'Last then
5584 Debug_Output ("no matching suffix");
5588 -- Check that the casing matches
5590 if File_Names_Case_Sensitive then
5591 case Naming.Casing is
5592 when All_Lower_Case =>
5593 for J in Filename'First .. Last loop
5594 if Is_Letter (Filename (J))
5595 and then not Is_Lower (Filename (J))
5597 Debug_Output ("Invalid casing");
5602 when All_Upper_Case =>
5603 for J in Filename'First .. Last loop
5604 if Is_Letter (Filename (J))
5605 and then not Is_Upper (Filename (J))
5607 Debug_Output ("Invalid casing");
5612 when Mixed_Case | Unknown =>
5617 -- If Dot_Replacement is not a single dot, then there should not
5618 -- be any dot in the name.
5621 Dot_Repl : constant String :=
5622 Get_Name_String (Naming.Dot_Replacement);
5625 if Dot_Repl /= "." then
5626 for Index in Filename'First .. Last loop
5627 if Filename (Index) = '.' then
5628 Debug_Output ("Invalid name, contains dot");
5633 Replace_Into_Name_Buffer
5634 (Filename (Filename'First .. Last), Dot_Repl, '.');
5637 Name_Len := Last - Filename'First + 1;
5638 Name_Buffer (1 .. Name_Len) := Filename (Filename'First .. Last);
5640 (Source => Name_Buffer (1 .. Name_Len),
5641 Mapping => Lower_Case_Map);
5645 -- In the standard GNAT naming scheme, check for special cases: children
5646 -- or separates of A, G, I or S, and run time sources.
5648 if Is_Standard_GNAT_Naming (Naming)
5649 and then Name_Len >= 3
5652 S1 : constant Character := Name_Buffer (1);
5653 S2 : constant Character := Name_Buffer (2);
5654 S3 : constant Character := Name_Buffer (3);
5662 -- Children or separates of packages A, G, I or S. These names
5663 -- are x__ ... or x~... (where x is a, g, i, or s). Both
5664 -- versions (x__... and x~...) are allowed in all platforms,
5665 -- because it is not possible to know the platform before
5666 -- processing of the project files.
5668 if S2 = '_' and then S3 = '_' then
5669 Name_Buffer (2) := '.';
5670 Name_Buffer (3 .. Name_Len - 1) :=
5671 Name_Buffer (4 .. Name_Len);
5672 Name_Len := Name_Len - 1;
5675 Name_Buffer (2) := '.';
5679 -- If it is potentially a run time source
5687 -- Name_Buffer contains the name of the unit in lower-cases. Check
5688 -- that this is a valid unit name
5690 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
5692 -- If there is a naming exception for the same unit, the file is not
5693 -- a source for the unit.
5695 if Unit /= No_Name then
5697 Unit_Exceptions_Htable.Get (Project.Unit_Exceptions, Unit);
5700 Masked := Unit_Except.Spec /= No_File
5702 Unit_Except.Spec /= File_Name;
5704 Masked := Unit_Except.Impl /= No_File
5706 Unit_Except.Impl /= File_Name;
5710 if Current_Verbosity = High then
5712 Write_Str (" """ & Filename & """ contains the ");
5715 Write_Str ("spec of a unit found in """);
5716 Write_Str (Get_Name_String (Unit_Except.Spec));
5718 Write_Str ("body of a unit found in """);
5719 Write_Str (Get_Name_String (Unit_Except.Impl));
5722 Write_Line (""" (ignored)");
5730 and then Current_Verbosity = High
5733 when Spec => Debug_Output ("spec of", Unit);
5734 when Impl => Debug_Output ("body of", Unit);
5735 when Sep => Debug_Output ("sep of", Unit);
5738 end Compute_Unit_Name;
5740 --------------------------
5741 -- Check_Illegal_Suffix --
5742 --------------------------
5744 procedure Check_Illegal_Suffix
5745 (Project : Project_Id;
5746 Suffix : File_Name_Type;
5747 Dot_Replacement : File_Name_Type;
5748 Attribute_Name : String;
5749 Location : Source_Ptr;
5750 Data : in out Tree_Processing_Data)
5752 Suffix_Str : constant String := Get_Name_String (Suffix);
5755 if Suffix_Str'Length = 0 then
5761 elsif Index (Suffix_Str, ".") = 0 then
5762 Err_Vars.Error_Msg_File_1 := Suffix;
5765 "{ is illegal for " & Attribute_Name & ": must have a dot",
5770 -- Case of dot replacement is a single dot, and first character of
5771 -- suffix is also a dot.
5773 if Dot_Replacement /= No_File
5774 and then Get_Name_String (Dot_Replacement) = "."
5775 and then Suffix_Str (Suffix_Str'First) = '.'
5777 for Index in Suffix_Str'First + 1 .. Suffix_Str'Last loop
5779 -- If there are multiple dots in the name
5781 if Suffix_Str (Index) = '.' then
5783 -- It is illegal to have a letter following the initial dot
5785 if Is_Letter (Suffix_Str (Suffix_Str'First + 1)) then
5786 Err_Vars.Error_Msg_File_1 := Suffix;
5789 "{ is illegal for " & Attribute_Name
5790 & ": ambiguous prefix when Dot_Replacement is a dot",
5797 end Check_Illegal_Suffix;
5799 ----------------------
5800 -- Locate_Directory --
5801 ----------------------
5803 procedure Locate_Directory
5804 (Project : Project_Id;
5805 Name : File_Name_Type;
5806 Path : out Path_Information;
5807 Dir_Exists : out Boolean;
5808 Data : in out Tree_Processing_Data;
5809 Create : String := "";
5810 Location : Source_Ptr := No_Location;
5811 Must_Exist : Boolean := True;
5812 Externally_Built : Boolean := False)
5814 Parent : constant Path_Name_Type :=
5815 Project.Directory.Display_Name;
5816 The_Parent : constant String :=
5817 Get_Name_String (Parent);
5818 The_Parent_Last : constant Natural :=
5819 Compute_Directory_Last (The_Parent);
5820 Full_Name : File_Name_Type;
5821 The_Name : File_Name_Type;
5824 Get_Name_String (Name);
5826 -- Add Subdirs.all if it is a directory that may be created and
5827 -- Subdirs is not null;
5829 if Create /= "" and then Subdirs /= null then
5830 if Name_Buffer (Name_Len) /= Directory_Separator then
5831 Add_Char_To_Name_Buffer (Directory_Separator);
5834 Add_Str_To_Name_Buffer (Subdirs.all);
5837 -- Convert '/' to directory separator (for Windows)
5839 for J in 1 .. Name_Len loop
5840 if Name_Buffer (J) = '/' then
5841 Name_Buffer (J) := Directory_Separator;
5845 The_Name := Name_Find;
5847 if Current_Verbosity = High then
5849 Write_Str ("Locate_Directory (""");
5850 Write_Str (Get_Name_String (The_Name));
5851 Write_Str (""", in """);
5852 Write_Str (The_Parent);
5856 Path := No_Path_Information;
5857 Dir_Exists := False;
5859 if Is_Absolute_Path (Get_Name_String (The_Name)) then
5860 Full_Name := The_Name;
5864 Add_Str_To_Name_Buffer
5865 (The_Parent (The_Parent'First .. The_Parent_Last));
5866 Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
5867 Full_Name := Name_Find;
5871 Full_Path_Name : String_Access :=
5872 new String'(Get_Name_String (Full_Name));
5875 if (Setup_Projects or else Subdirs /= null)
5876 and then Create'Length > 0
5878 if not Is_Directory (Full_Path_Name.all) then
5880 -- If project is externally built, do not create a subdir,
5881 -- use the specified directory, without the subdir.
5883 if Externally_Built then
5884 if Is_Absolute_Path (Get_Name_String (Name)) then
5885 Get_Name_String (Name);
5889 Add_Str_To_Name_Buffer
5890 (The_Parent (The_Parent'First .. The_Parent_Last));
5891 Add_Str_To_Name_Buffer (Get_Name_String (Name));
5894 Full_Path_Name := new String'(Name_Buffer (1 .. Name_Len));
5898 Create_Path (Full_Path_Name.all);
5900 if not Quiet_Output then
5902 Write_Str (" directory """);
5903 Write_Str (Full_Path_Name.all);
5904 Write_Str (""" created for project ");
5905 Write_Line (Get_Name_String (Project.Name));
5912 "could not create " & Create &
5913 " directory " & Full_Path_Name.all,
5920 Dir_Exists := Is_Directory (Full_Path_Name.all);
5922 if not Must_Exist or else Dir_Exists then
5924 Normed : constant String :=
5926 (Full_Path_Name.all,
5928 The_Parent (The_Parent'First .. The_Parent_Last),
5929 Resolve_Links => False,
5930 Case_Sensitive => True);
5932 Canonical_Path : constant String :=
5937 (The_Parent'First .. The_Parent_Last),
5939 Opt.Follow_Links_For_Dirs,
5940 Case_Sensitive => False);
5943 Name_Len := Normed'Length;
5944 Name_Buffer (1 .. Name_Len) := Normed;
5946 -- Directories should always end with a directory separator
5948 if Name_Buffer (Name_Len) /= Directory_Separator then
5949 Add_Char_To_Name_Buffer (Directory_Separator);
5952 Path.Display_Name := Name_Find;
5954 Name_Len := Canonical_Path'Length;
5955 Name_Buffer (1 .. Name_Len) := Canonical_Path;
5957 if Name_Buffer (Name_Len) /= Directory_Separator then
5958 Add_Char_To_Name_Buffer (Directory_Separator);
5961 Path.Name := Name_Find;
5965 Free (Full_Path_Name);
5967 end Locate_Directory;
5969 ---------------------------
5970 -- Find_Excluded_Sources --
5971 ---------------------------
5973 procedure Find_Excluded_Sources
5974 (Project : in out Project_Processing_Data;
5975 Data : in out Tree_Processing_Data)
5977 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
5979 Excluded_Source_List_File : constant Variable_Value :=
5981 (Name_Excluded_Source_List_File,
5982 Project.Project.Decl.Attributes,
5984 Excluded_Sources : Variable_Value := Util.Value_Of
5985 (Name_Excluded_Source_Files,
5986 Project.Project.Decl.Attributes,
5989 Current : String_List_Id;
5990 Element : String_Element;
5991 Location : Source_Ptr;
5992 Name : File_Name_Type;
5993 File : Prj.Util.Text_File;
5994 Line : String (1 .. 300);
5996 Locally_Removed : Boolean := False;
5999 -- If Excluded_Source_Files is not declared, check Locally_Removed_Files
6001 if Excluded_Sources.Default then
6002 Locally_Removed := True;
6005 (Name_Locally_Removed_Files,
6006 Project.Project.Decl.Attributes, Shared);
6009 -- If there are excluded sources, put them in the table
6011 if not Excluded_Sources.Default then
6012 if not Excluded_Source_List_File.Default then
6013 if Locally_Removed then
6016 "?both attributes Locally_Removed_Files and " &
6017 "Excluded_Source_List_File are present",
6018 Excluded_Source_List_File.Location, Project.Project);
6022 "?both attributes Excluded_Source_Files and " &
6023 "Excluded_Source_List_File are present",
6024 Excluded_Source_List_File.Location, Project.Project);
6028 Current := Excluded_Sources.Values;
6029 while Current /= Nil_String loop
6030 Element := Shared.String_Elements.Table (Current);
6031 Name := Canonical_Case_File_Name (Element.Value);
6033 -- If the element has no location, then use the location of
6034 -- Excluded_Sources to report possible errors.
6036 if Element.Location = No_Location then
6037 Location := Excluded_Sources.Location;
6039 Location := Element.Location;
6042 Excluded_Sources_Htable.Set
6043 (Project.Excluded, Name,
6044 (Name, No_File, 0, False, Location));
6045 Current := Element.Next;
6048 elsif not Excluded_Source_List_File.Default then
6049 Location := Excluded_Source_List_File.Location;
6052 Source_File_Name : constant File_Name_Type :=
6054 (Excluded_Source_List_File.Value);
6055 Source_File_Line : Natural := 0;
6057 Source_File_Path_Name : constant String :=
6060 Project.Project.Directory.Name);
6063 if Source_File_Path_Name'Length = 0 then
6064 Err_Vars.Error_Msg_File_1 :=
6065 File_Name_Type (Excluded_Source_List_File.Value);
6068 "file with excluded sources { does not exist",
6069 Excluded_Source_List_File.Location, Project.Project);
6074 Prj.Util.Open (File, Source_File_Path_Name);
6076 if not Prj.Util.Is_Valid (File) then
6078 (Data.Flags, "file does not exist",
6079 Location, Project.Project);
6081 -- Read the lines one by one
6083 while not Prj.Util.End_Of_File (File) loop
6084 Prj.Util.Get_Line (File, Line, Last);
6085 Source_File_Line := Source_File_Line + 1;
6087 -- Non empty, non comment line should contain a file name
6090 and then (Last = 1 or else Line (1 .. 2) /= "--")
6093 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6094 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6097 -- Check that there is no directory information
6099 for J in 1 .. Last loop
6101 or else Line (J) = Directory_Separator
6103 Error_Msg_File_1 := Name;
6106 "file name cannot include " &
6107 "directory information ({)",
6108 Location, Project.Project);
6113 Excluded_Sources_Htable.Set
6116 (Name, Source_File_Name, Source_File_Line,
6121 Prj.Util.Close (File);
6126 end Find_Excluded_Sources;
6132 procedure Find_Sources
6133 (Project : in out Project_Processing_Data;
6134 Data : in out Tree_Processing_Data)
6136 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
6138 Sources : constant Variable_Value :=
6141 Project.Project.Decl.Attributes,
6144 Source_List_File : constant Variable_Value :=
6146 (Name_Source_List_File,
6147 Project.Project.Decl.Attributes,
6150 Name_Loc : Name_Location;
6151 Has_Explicit_Sources : Boolean;
6154 pragma Assert (Sources.Kind = List, "Source_Files is not a list");
6156 (Source_List_File.Kind = Single,
6157 "Source_List_File is not a single string");
6159 Project.Source_List_File_Location := Source_List_File.Location;
6161 -- If the user has specified a Source_Files attribute
6163 if not Sources.Default then
6164 if not Source_List_File.Default then
6167 "?both attributes source_files and " &
6168 "source_list_file are present",
6169 Source_List_File.Location, Project.Project);
6172 -- Sources is a list of file names
6175 Current : String_List_Id := Sources.Values;
6176 Element : String_Element;
6177 Location : Source_Ptr;
6178 Name : File_Name_Type;
6181 if Current = Nil_String then
6182 Project.Project.Languages := No_Language_Index;
6184 -- This project contains no source. For projects that don't
6185 -- extend other projects, this also means that there is no
6186 -- need for an object directory, if not specified.
6188 if Project.Project.Extends = No_Project
6189 and then Project.Project.Object_Directory =
6190 Project.Project.Directory
6192 Project.Project.Object_Directory := No_Path_Information;
6196 while Current /= Nil_String loop
6197 Element := Shared.String_Elements.Table (Current);
6198 Name := Canonical_Case_File_Name (Element.Value);
6199 Get_Name_String (Element.Value);
6201 -- If the element has no location, then use the location of
6202 -- Sources to report possible errors.
6204 if Element.Location = No_Location then
6205 Location := Sources.Location;
6207 Location := Element.Location;
6210 -- Check that there is no directory information
6212 for J in 1 .. Name_Len loop
6213 if Name_Buffer (J) = '/'
6214 or else Name_Buffer (J) = Directory_Separator
6216 Error_Msg_File_1 := Name;
6219 "file name cannot include directory " &
6221 Location, Project.Project);
6226 -- Check whether the file is already there: the same file name
6227 -- may be in the list. If the source is missing, the error will
6228 -- be on the first mention of the source file name.
6230 Name_Loc := Source_Names_Htable.Get
6231 (Project.Source_Names, Name);
6233 if Name_Loc = No_Name_Location then
6236 Location => Location,
6237 Source => No_Source,
6242 Name_Loc.Listed := True;
6245 Source_Names_Htable.Set
6246 (Project.Source_Names, Name, Name_Loc);
6248 Current := Element.Next;
6251 Has_Explicit_Sources := True;
6254 -- If we have no Source_Files attribute, check the Source_List_File
6257 elsif not Source_List_File.Default then
6259 -- Source_List_File is the name of the file that contains the source
6263 Source_File_Path_Name : constant String :=
6265 (File_Name_Type (Source_List_File.Value),
6266 Project.Project.Directory.Name);
6269 Has_Explicit_Sources := True;
6271 if Source_File_Path_Name'Length = 0 then
6272 Err_Vars.Error_Msg_File_1 :=
6273 File_Name_Type (Source_List_File.Value);
6276 "file with sources { does not exist",
6277 Source_List_File.Location, Project.Project);
6280 Get_Sources_From_File
6281 (Source_File_Path_Name, Source_List_File.Location,
6287 -- Neither Source_Files nor Source_List_File has been specified. Find
6288 -- all the files that satisfy the naming scheme in all the source
6291 Has_Explicit_Sources := False;
6294 -- Remove any exception that is not in the specified list of sources
6296 if Has_Explicit_Sources then
6299 Iter : Source_Iterator;
6306 Iter := For_Each_Source (Data.Tree, Project.Project);
6310 Source := Prj.Element (Iter);
6311 exit Source_Loop when Source = No_Source;
6313 if Source.Naming_Exception then
6314 NL := Source_Names_Htable.Get
6315 (Project.Source_Names, Source.File);
6317 if NL /= No_Name_Location and then not NL.Listed then
6318 -- Remove the exception
6319 Source_Names_Htable.Set
6320 (Project.Source_Names,
6323 Remove_Source (Data.Tree, Source, No_Source);
6325 Error_Msg_Name_1 := Name_Id (Source.File);
6328 "? unknown source file %%",
6338 end loop Source_Loop;
6340 exit Iter_Loop when not Again;
6348 For_All_Sources => Sources.Default and then Source_List_File.Default);
6350 -- Check if all exceptions have been found
6354 Iter : Source_Iterator;
6355 Found : Boolean := False;
6358 Iter := For_Each_Source (Data.Tree, Project.Project);
6360 Source := Prj.Element (Iter);
6361 exit when Source = No_Source;
6363 -- If the full source path is unknown for this source_id, there
6364 -- could be several reasons:
6365 -- * we simply did not find the file itself, this is an error
6366 -- * we have a multi-unit source file. Another Source_Id from
6367 -- the same file has received the full path, so we need to
6370 if Source.Naming_Exception
6371 and then Source.Path = No_Path_Information
6373 if Source.Unit /= No_Unit_Index then
6376 if Source.Index /= 0 then -- Only multi-unit files
6379 Source_Files_Htable.Get
6380 (Data.Tree.Source_Files_HT, Source.File);
6382 while S /= null loop
6383 if S.Path /= No_Path_Information then
6384 Source.Path := S.Path;
6387 if Current_Verbosity = High then
6389 ("Setting full path for "
6390 & Get_Name_String (Source.File)
6391 & " at" & Source.Index'Img
6393 & Get_Name_String (Source.Path.Name));
6399 S := S.Next_With_File_Name;
6405 Error_Msg_Name_1 := Name_Id (Source.Display_File);
6406 Error_Msg_Name_2 := Source.Unit.Name;
6408 (Data.Flags, Data.Flags.Missing_Source_Files,
6409 "source file %% for unit %% not found",
6410 No_Location, Project.Project);
6414 if Source.Path = No_Path_Information then
6415 Remove_Source (Data.Tree, Source, No_Source);
6423 -- It is an error if a source file name in a source list or in a source
6424 -- list file is not found.
6426 if Has_Explicit_Sources then
6429 First_Error : Boolean;
6432 NL := Source_Names_Htable.Get_First (Project.Source_Names);
6433 First_Error := True;
6434 while NL /= No_Name_Location loop
6435 if not NL.Found then
6436 Err_Vars.Error_Msg_File_1 := NL.Name;
6439 (Data.Flags, Data.Flags.Missing_Source_Files,
6440 "source file { not found",
6441 NL.Location, Project.Project);
6442 First_Error := False;
6445 (Data.Flags, Data.Flags.Missing_Source_Files,
6446 "\source file { not found",
6447 NL.Location, Project.Project);
6451 NL := Source_Names_Htable.Get_Next (Project.Source_Names);
6461 procedure Initialize
6462 (Data : out Tree_Processing_Data;
6463 Tree : Project_Tree_Ref;
6464 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
6465 Flags : Prj.Processing_Flags)
6469 Data.Node_Tree := Node_Tree;
6470 Data.Flags := Flags;
6477 procedure Free (Data : in out Tree_Processing_Data) is
6478 pragma Unreferenced (Data);
6487 procedure Initialize
6488 (Data : in out Project_Processing_Data;
6489 Project : Project_Id)
6492 Data.Project := Project;
6499 procedure Free (Data : in out Project_Processing_Data) is
6501 Source_Names_Htable.Reset (Data.Source_Names);
6502 Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions);
6503 Excluded_Sources_Htable.Reset (Data.Excluded);
6506 -------------------------------
6507 -- Check_File_Naming_Schemes --
6508 -------------------------------
6510 procedure Check_File_Naming_Schemes
6511 (In_Tree : Project_Tree_Ref;
6512 Project : Project_Processing_Data;
6513 File_Name : File_Name_Type;
6514 Alternate_Languages : out Language_List;
6515 Language : out Language_Ptr;
6516 Display_Language_Name : out Name_Id;
6518 Lang_Kind : out Language_Kind;
6519 Kind : out Source_Kind)
6521 Filename : constant String := Get_Name_String (File_Name);
6522 Config : Language_Config;
6523 Tmp_Lang : Language_Ptr;
6525 Header_File : Boolean := False;
6526 -- True if we found at least one language for which the file is a header
6527 -- In such a case, we search for all possible languages where this is
6528 -- also a header (C and C++ for instance), since the file might be used
6529 -- for several such languages.
6531 procedure Check_File_Based_Lang;
6532 -- Does the naming scheme test for file-based languages. For those,
6533 -- there is no Unit. Just check if the file name has the implementation
6534 -- or, if it is specified, the template suffix of the language.
6536 -- Returns True if the file belongs to the current language and we
6537 -- should stop searching for matching languages. Not that a given header
6538 -- file could belong to several languages (C and C++ for instance). Thus
6539 -- if we found a header we'll check whether it matches other languages.
6541 ---------------------------
6542 -- Check_File_Based_Lang --
6543 ---------------------------
6545 procedure Check_File_Based_Lang is
6548 and then Suffix_Matches (Filename, Config.Naming_Data.Body_Suffix)
6552 Language := Tmp_Lang;
6555 ("Implementation of language ", Display_Language_Name);
6557 elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
6559 ("Header of language ", Display_Language_Name);
6562 Alternate_Languages := new Language_List_Element'
6563 (Language => Language,
6564 Next => Alternate_Languages);
6567 Header_File := True;
6570 Language := Tmp_Lang;
6573 end Check_File_Based_Lang;
6575 -- Start of processing for Check_File_Naming_Schemes
6578 Language := No_Language_Index;
6579 Alternate_Languages := null;
6580 Display_Language_Name := No_Name;
6582 Lang_Kind := File_Based;
6585 Tmp_Lang := Project.Project.Languages;
6586 while Tmp_Lang /= No_Language_Index loop
6587 if Current_Verbosity = High then
6589 ("Testing language "
6590 & Get_Name_String (Tmp_Lang.Name)
6591 & " Header_File=" & Header_File'Img);
6594 Display_Language_Name := Tmp_Lang.Display_Name;
6595 Config := Tmp_Lang.Config;
6596 Lang_Kind := Config.Kind;
6600 Check_File_Based_Lang;
6601 exit when Kind = Impl;
6605 -- We know it belongs to a least a file_based language, no
6606 -- need to check unit-based ones.
6608 if not Header_File then
6610 (File_Name => File_Name,
6611 Naming => Config.Naming_Data,
6615 In_Tree => In_Tree);
6617 if Unit /= No_Name then
6618 Language := Tmp_Lang;
6624 Tmp_Lang := Tmp_Lang.Next;
6627 if Language = No_Language_Index then
6628 Debug_Output ("not a source of any language");
6630 end Check_File_Naming_Schemes;
6636 procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is
6638 -- If the file was previously already associated with a unit, change it
6640 if Source.Unit /= null
6641 and then Source.Kind in Spec_Or_Body
6642 and then Source.Unit.File_Names (Source.Kind) /= null
6644 -- If we had another file referencing the same unit (for instance it
6645 -- was in an extended project), that source file is in fact invisible
6646 -- from now on, and in particular doesn't belong to the same unit.
6648 if Source.Unit.File_Names (Source.Kind) /= Source then
6649 Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
6652 Source.Unit.File_Names (Source.Kind) := null;
6655 Source.Kind := Kind;
6657 if Current_Verbosity = High
6658 and then Source.File /= No_File
6660 Debug_Output ("Override kind for "
6661 & Get_Name_String (Source.File)
6662 & " idx=" & Source.Index'Img
6663 & " kind=" & Source.Kind'Img);
6666 if Source.Kind in Spec_Or_Body and then Source.Unit /= null then
6667 Source.Unit.File_Names (Source.Kind) := Source;
6675 procedure Check_File
6676 (Project : in out Project_Processing_Data;
6677 Data : in out Tree_Processing_Data;
6678 Source_Dir_Rank : Natural;
6679 Path : Path_Name_Type;
6680 Display_Path : Path_Name_Type;
6681 File_Name : File_Name_Type;
6682 Display_File_Name : File_Name_Type;
6683 Locally_Removed : Boolean;
6684 For_All_Sources : Boolean)
6686 Name_Loc : Name_Location :=
6687 Source_Names_Htable.Get
6688 (Project.Source_Names, File_Name);
6689 Check_Name : Boolean := False;
6690 Alternate_Languages : Language_List;
6691 Language : Language_Ptr;
6693 Src_Ind : Source_File_Index;
6695 Display_Language_Name : Name_Id;
6696 Lang_Kind : Language_Kind;
6697 Kind : Source_Kind := Spec;
6700 if Current_Verbosity = High then
6701 Debug_Increase_Indent
6702 ("Checking file (rank=" & Source_Dir_Rank'Img & ")",
6706 if Name_Loc = No_Name_Location then
6707 Check_Name := For_All_Sources;
6710 if Name_Loc.Found then
6712 -- Check if it is OK to have the same file name in several
6713 -- source directories.
6715 if Source_Dir_Rank = Name_Loc.Source.Source_Dir_Rank then
6716 Error_Msg_File_1 := File_Name;
6719 "{ is found in several source directories",
6720 Name_Loc.Location, Project.Project);
6724 Name_Loc.Found := True;
6726 Source_Names_Htable.Set
6727 (Project.Source_Names, File_Name, Name_Loc);
6729 if Name_Loc.Source = No_Source then
6733 -- Set the full path for the source_id (which might have been
6734 -- created when parsing the naming exceptions, and therefore
6735 -- might not have the full path).
6736 -- We only set this for this source_id, but not for other
6737 -- source_id in the same file (case of multi-unit source files)
6738 -- For the latter, they will be set in Find_Sources when we
6739 -- check that all source_id have known full paths.
6740 -- Doing this later saves one htable lookup per file in the
6741 -- common case where the user is not using multi-unit files.
6743 Name_Loc.Source.Path := (Path, Display_Path);
6745 Source_Paths_Htable.Set
6746 (Data.Tree.Source_Paths_HT, Path, Name_Loc.Source);
6748 -- Check if this is a subunit
6750 if Name_Loc.Source.Unit /= No_Unit_Index
6751 and then Name_Loc.Source.Kind = Impl
6753 Src_Ind := Sinput.P.Load_Project_File
6754 (Get_Name_String (Display_Path));
6756 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
6757 Override_Kind (Name_Loc.Source, Sep);
6765 Check_File_Naming_Schemes
6766 (In_Tree => Data.Tree,
6768 File_Name => File_Name,
6769 Alternate_Languages => Alternate_Languages,
6770 Language => Language,
6771 Display_Language_Name => Display_Language_Name,
6773 Lang_Kind => Lang_Kind,
6776 if Language = No_Language_Index then
6778 -- A file name in a list must be a source of a language
6780 if Data.Flags.Error_On_Unknown_Language
6781 and then Name_Loc.Found
6783 Error_Msg_File_1 := File_Name;
6786 "language unknown for {",
6787 Name_Loc.Location, Project.Project);
6793 Project => Project.Project,
6794 Source_Dir_Rank => Source_Dir_Rank,
6795 Lang_Id => Language,
6798 Alternate_Languages => Alternate_Languages,
6799 File_Name => File_Name,
6800 Display_File => Display_File_Name,
6802 Locally_Removed => Locally_Removed,
6803 Path => (Path, Display_Path));
6805 -- If it is a source specified in a list, update the entry in
6806 -- the Source_Names table.
6808 if Name_Loc.Found and then Name_Loc.Source = No_Source then
6809 Name_Loc.Source := Source;
6810 Source_Names_Htable.Set
6811 (Project.Source_Names, File_Name, Name_Loc);
6816 Debug_Decrease_Indent;
6819 ---------------------------------
6820 -- Expand_Subdirectory_Pattern --
6821 ---------------------------------
6823 procedure Expand_Subdirectory_Pattern
6824 (Project : Project_Id;
6825 Data : in out Tree_Processing_Data;
6826 Patterns : String_List_Id;
6827 Ignore : String_List_Id;
6828 Search_For : Search_Type;
6829 Resolve_Links : Boolean)
6831 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
6833 package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable
6834 (Header_Num => Header_Num,
6836 No_Element => False,
6837 Key => Path_Name_Type,
6840 -- Hash table stores recursive source directories, to avoid looking
6841 -- several times, and to avoid cycles that may be introduced by symbolic
6844 File_Pattern : GNAT.Regexp.Regexp;
6845 -- Pattern to use when matching file names.
6847 Visited : Recursive_Dirs.Instance;
6849 procedure Find_Pattern
6850 (Pattern_Id : Name_Id;
6852 Location : Source_Ptr);
6853 -- Find a specific pattern
6855 function Recursive_Find_Dirs
6856 (Path : Path_Information;
6857 Rank : Natural) return Boolean;
6858 -- Search all the subdirectories (recursively) of Path.
6859 -- Return True if at least one file or directory was processed
6861 function Subdirectory_Matches
6862 (Path : Path_Information;
6863 Rank : Natural) return Boolean;
6864 -- Called when a matching directory was found. If the user is in fact
6865 -- searching for files, we then search for those files matching the
6866 -- pattern within the directory.
6867 -- Return True if at least one file or directory was processed
6869 --------------------------
6870 -- Subdirectory_Matches --
6871 --------------------------
6873 function Subdirectory_Matches
6874 (Path : Path_Information;
6875 Rank : Natural) return Boolean
6878 Name : String (1 .. 250);
6880 Found : Path_Information;
6881 Success : Boolean := False;
6885 when Search_Directories =>
6886 Callback (Path, Rank);
6889 when Search_Files =>
6890 Open (Dir, Get_Name_String (Path.Display_Name));
6892 Read (Dir, Name, Last);
6895 if Name (Name'First .. Last) /= "."
6896 and then Name (Name'First .. Last) /= ".."
6897 and then Match (Name (Name'First .. Last), File_Pattern)
6899 Get_Name_String (Path.Display_Name);
6900 Add_Str_To_Name_Buffer (Name (Name'First .. Last));
6902 Found.Display_Name := Name_Find;
6903 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6904 Found.Name := Name_Find;
6906 Callback (Found, Rank);
6915 end Subdirectory_Matches;
6917 -------------------------
6918 -- Recursive_Find_Dirs --
6919 -------------------------
6921 function Recursive_Find_Dirs
6922 (Path : Path_Information;
6923 Rank : Natural) return Boolean
6925 Path_Str : constant String := Get_Name_String (Path.Display_Name);
6927 Name : String (1 .. 250);
6929 Success : Boolean := False;
6932 Debug_Output ("Looking for subdirs of ", Name_Id (Path.Display_Name));
6934 if Recursive_Dirs.Get (Visited, Path.Name) then
6938 Recursive_Dirs.Set (Visited, Path.Name, True);
6940 Success := Subdirectory_Matches (Path, Rank) or Success;
6942 Open (Dir, Path_Str);
6945 Read (Dir, Name, Last);
6948 if Name (1 .. Last) /= "."
6949 and then Name (1 .. Last) /= ".."
6952 Path_Name : constant String :=
6954 (Name => Name (1 .. Last),
6955 Directory => Path_Str,
6956 Resolve_Links => Resolve_Links)
6957 & Directory_Separator;
6958 Path2 : Path_Information;
6959 OK : Boolean := True;
6962 if Is_Directory (Path_Name) then
6963 if Ignore /= Nil_String then
6965 Dir_Name : String := Name (1 .. Last);
6966 List : String_List_Id := Ignore;
6969 Canonical_Case_File_Name (Dir_Name);
6971 while List /= Nil_String loop
6973 (Shared.String_Elements.Table (List).Value);
6974 Canonical_Case_File_Name
6975 (Name_Buffer (1 .. Name_Len));
6976 OK := Name_Buffer (1 .. Name_Len) /= Dir_Name;
6978 List := Shared.String_Elements.Table (List).Next;
6985 Add_Str_To_Name_Buffer (Path_Name);
6986 Path2.Display_Name := Name_Find;
6988 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6989 Path2.Name := Name_Find;
6992 Recursive_Find_Dirs (Path2, Rank) or Success;
7004 when Directory_Error =>
7006 end Recursive_Find_Dirs;
7012 procedure Find_Pattern
7013 (Pattern_Id : Name_Id;
7015 Location : Source_Ptr)
7017 Pattern : constant String := Get_Name_String (Pattern_Id);
7018 Pattern_End : Natural := Pattern'Last;
7019 Recursive : Boolean;
7020 Dir : File_Name_Type;
7021 Path_Name : Path_Information;
7022 Dir_Exists : Boolean;
7023 Has_Error : Boolean := False;
7027 Debug_Increase_Indent ("Find_Pattern", Pattern_Id);
7029 -- If we are looking for files, find the pattern for the files
7031 if Search_For = Search_Files then
7032 while Pattern_End >= Pattern'First
7033 and then Pattern (Pattern_End) /= '/'
7034 and then Pattern (Pattern_End) /= Directory_Separator
7036 Pattern_End := Pattern_End - 1;
7039 if Pattern_End = Pattern'Last then
7040 Err_Vars.Error_Msg_File_1 := File_Name_Type (Pattern_Id);
7042 (Data.Flags, Data.Flags.Missing_Source_Files,
7043 "Missing file name or pattern in {", Location, Project);
7047 if Current_Verbosity = High then
7049 Write_Str ("file_pattern=");
7050 Write_Str (Pattern (Pattern_End + 1 .. Pattern'Last));
7051 Write_Str (" dir_pattern=");
7052 Write_Line (Pattern (Pattern'First .. Pattern_End));
7055 File_Pattern := Compile
7056 (Pattern (Pattern_End + 1 .. Pattern'Last),
7058 Case_Sensitive => File_Names_Case_Sensitive);
7060 -- If we had just "*.gpr", this is equivalent to "./*.gpr"
7062 if Pattern_End > Pattern'First then
7063 Pattern_End := Pattern_End - 1; -- Skip directory separator
7068 Pattern_End - 1 >= Pattern'First
7069 and then Pattern (Pattern_End - 1 .. Pattern_End) = "**"
7070 and then (Pattern_End - 1 = Pattern'First
7071 or else Pattern (Pattern_End - 2) = '/'
7072 or else Pattern (Pattern_End - 2) = Directory_Separator);
7075 Pattern_End := Pattern_End - 2;
7076 if Pattern_End > Pattern'First then
7077 Pattern_End := Pattern_End - 1; -- Skip '/'
7081 Name_Len := Pattern_End - Pattern'First + 1;
7082 Name_Buffer (1 .. Name_Len) := Pattern (Pattern'First .. Pattern_End);
7086 (Project => Project,
7089 Dir_Exists => Dir_Exists,
7091 Must_Exist => False);
7093 if not Dir_Exists then
7094 Err_Vars.Error_Msg_File_1 := Dir;
7096 (Data.Flags, Data.Flags.Missing_Source_Files,
7097 "{ is not a valid directory", Location, Project);
7098 Has_Error := Data.Flags.Missing_Source_Files = Error;
7101 if not Has_Error then
7102 -- Links have been resolved if necessary, and Path_Name
7103 -- always ends with a directory separator.
7106 Success := Recursive_Find_Dirs (Path_Name, Rank);
7108 Success := Subdirectory_Matches (Path_Name, Rank);
7113 when Search_Directories =>
7114 null; -- Error can't occur
7116 when Search_Files =>
7117 Err_Vars.Error_Msg_File_1 := File_Name_Type (Pattern_Id);
7119 (Data.Flags, Data.Flags.Missing_Source_Files,
7120 "file { not found", Location, Project);
7125 Debug_Decrease_Indent ("Done Find_Pattern");
7130 Pattern_Id : String_List_Id := Patterns;
7131 Element : String_Element;
7132 Rank : Natural := 1;
7134 -- Start of processing for Expand_Subdirectory_Pattern
7137 while Pattern_Id /= Nil_String loop
7138 Element := Shared.String_Elements.Table (Pattern_Id);
7139 Find_Pattern (Element.Value, Rank, Element.Location);
7141 Pattern_Id := Element.Next;
7144 Recursive_Dirs.Reset (Visited);
7145 end Expand_Subdirectory_Pattern;
7147 ------------------------
7148 -- Search_Directories --
7149 ------------------------
7151 procedure Search_Directories
7152 (Project : in out Project_Processing_Data;
7153 Data : in out Tree_Processing_Data;
7154 For_All_Sources : Boolean)
7156 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
7158 Source_Dir : String_List_Id;
7159 Element : String_Element;
7160 Src_Dir_Rank : Number_List_Index;
7161 Num_Nod : Number_Node;
7163 Name : String (1 .. 1_000);
7165 File_Name : File_Name_Type;
7166 Display_File_Name : File_Name_Type;
7169 Debug_Increase_Indent ("Looking for sources");
7171 -- Loop through subdirectories
7173 Source_Dir := Project.Project.Source_Dirs;
7174 Src_Dir_Rank := Project.Project.Source_Dir_Ranks;
7175 while Source_Dir /= Nil_String loop
7177 Num_Nod := Shared.Number_Lists.Table (Src_Dir_Rank);
7178 Element := Shared.String_Elements.Table (Source_Dir);
7180 -- Use Element.Value in this test, not Display_Value, because we
7181 -- want the symbolic links to be resolved when appropriate.
7183 if Element.Value /= No_Name then
7185 Source_Directory : constant String :=
7186 Get_Name_String (Element.Value)
7187 & Directory_Separator;
7189 Dir_Last : constant Natural :=
7190 Compute_Directory_Last (Source_Directory);
7192 Display_Source_Directory : constant String :=
7194 (Element.Display_Value)
7195 & Directory_Separator;
7196 -- Display_Source_Directory is to allow us to open a UTF-8
7197 -- encoded directory on Windows.
7200 if Current_Verbosity = High then
7201 Debug_Increase_Indent
7202 ("Source_Dir (node=" & Num_Nod.Number'Img & ") """
7203 & Source_Directory (Source_Directory'First .. Dir_Last)
7207 -- We look to every entry in the source directory
7209 Open (Dir, Display_Source_Directory);
7212 Read (Dir, Name, Last);
7216 -- In fast project loading mode (without -eL), the user
7217 -- guarantees that no directory has a name which is a
7218 -- valid source name, so we can avoid doing a system call
7219 -- here. This provides a very significant speed up on
7220 -- slow file systems (remote files for instance).
7222 if not Opt.Follow_Links_For_Files
7223 or else Is_Regular_File
7224 (Display_Source_Directory & Name (1 .. Last))
7227 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
7228 Display_File_Name := Name_Find;
7230 if Osint.File_Names_Case_Sensitive then
7231 File_Name := Display_File_Name;
7233 Canonical_Case_File_Name
7234 (Name_Buffer (1 .. Name_Len));
7235 File_Name := Name_Find;
7239 Path_Name : constant String :=
7244 (Source_Directory'First ..
7247 Opt.Follow_Links_For_Files,
7248 Case_Sensitive => True);
7250 Path : Path_Name_Type;
7252 Excluded_Sources_Htable.Get
7253 (Project.Excluded, File_Name);
7254 To_Remove : Boolean := False;
7257 Name_Len := Path_Name'Length;
7258 Name_Buffer (1 .. Name_Len) := Path_Name;
7260 if Osint.File_Names_Case_Sensitive then
7263 Canonical_Case_File_Name
7264 (Name_Buffer (1 .. Name_Len));
7268 if FF /= No_File_Found then
7269 if not FF.Found then
7271 Excluded_Sources_Htable.Set
7272 (Project.Excluded, File_Name, FF);
7275 ("Excluded source ",
7276 Name_Id (Display_File_Name));
7278 -- Will mark the file as removed, but we
7279 -- still need to add it to the list: if we
7280 -- don't, the file will not appear in the
7281 -- mapping file and will cause the compiler
7288 -- Preserve the user's original casing and use of
7289 -- links. The display_value (a directory) already
7290 -- ends with a directory separator by construction,
7291 -- so no need to add one.
7293 Get_Name_String (Element.Display_Value);
7294 Get_Name_String_And_Append (Display_File_Name);
7297 (Project => Project,
7298 Source_Dir_Rank => Num_Nod.Number,
7301 Display_Path => Name_Find,
7302 File_Name => File_Name,
7303 Locally_Removed => To_Remove,
7304 Display_File_Name => Display_File_Name,
7305 For_All_Sources => For_All_Sources);
7309 if Current_Verbosity = High then
7310 Debug_Output ("Ignore " & Name (1 .. Last));
7315 Debug_Decrease_Indent;
7321 when Directory_Error =>
7325 Source_Dir := Element.Next;
7326 Src_Dir_Rank := Num_Nod.Next;
7329 Debug_Decrease_Indent ("end Looking for sources.");
7330 end Search_Directories;
7332 ----------------------------
7333 -- Load_Naming_Exceptions --
7334 ----------------------------
7336 procedure Load_Naming_Exceptions
7337 (Project : in out Project_Processing_Data;
7338 Data : in out Tree_Processing_Data)
7341 Iter : Source_Iterator;
7344 Iter := For_Each_Source (Data.Tree, Project.Project);
7346 Source := Prj.Element (Iter);
7347 exit when Source = No_Source;
7349 -- An excluded file cannot also be an exception file name
7351 if Excluded_Sources_Htable.Get (Project.Excluded, Source.File) /=
7354 Error_Msg_File_1 := Source.File;
7357 "{ cannot be both excluded and an exception file name",
7358 No_Location, Project.Project);
7362 ("Naming exception: adding source file to source_Names: ",
7363 Name_Id (Source.File));
7365 Source_Names_Htable.Set
7366 (Project.Source_Names,
7369 (Name => Source.File,
7370 Location => Source.Location,
7375 -- If this is an Ada exception, record in table Unit_Exceptions
7377 if Source.Unit /= No_Unit_Index then
7379 Unit_Except : Unit_Exception :=
7380 Unit_Exceptions_Htable.Get
7381 (Project.Unit_Exceptions, Source.Unit.Name);
7384 Unit_Except.Name := Source.Unit.Name;
7386 if Source.Kind = Spec then
7387 Unit_Except.Spec := Source.File;
7389 Unit_Except.Impl := Source.File;
7392 Unit_Exceptions_Htable.Set
7393 (Project.Unit_Exceptions, Source.Unit.Name, Unit_Except);
7399 end Load_Naming_Exceptions;
7401 ----------------------
7402 -- Look_For_Sources --
7403 ----------------------
7405 procedure Look_For_Sources
7406 (Project : in out Project_Processing_Data;
7407 Data : in out Tree_Processing_Data)
7409 Object_Files : Object_File_Names_Htable.Instance;
7410 Iter : Source_Iterator;
7413 procedure Check_Object (Src : Source_Id);
7414 -- Check if object file name of Src is already used in the project tree,
7415 -- and report an error if so.
7417 procedure Check_Object_Files;
7418 -- Check that no two sources of this project have the same object file
7420 procedure Mark_Excluded_Sources;
7421 -- Mark as such the sources that are declared as excluded
7423 procedure Check_Missing_Sources;
7424 -- Check whether one of the languages has no sources, and report an
7425 -- error when appropriate
7427 procedure Get_Sources_From_Source_Info;
7428 -- Get the source information from the tables that were created when a
7429 -- source info file was read.
7431 ---------------------------
7432 -- Check_Missing_Sources --
7433 ---------------------------
7435 procedure Check_Missing_Sources is
7436 Extending : constant Boolean :=
7437 Project.Project.Extends /= No_Project;
7438 Language : Language_Ptr;
7440 Alt_Lang : Language_List;
7441 Continuation : Boolean := False;
7442 Iter : Source_Iterator;
7444 if not Project.Project.Externally_Built
7445 and then not Extending
7447 Language := Project.Project.Languages;
7448 while Language /= No_Language_Index loop
7450 -- If there are no sources for this language, check if there
7451 -- are sources for which this is an alternate language.
7453 if Language.First_Source = No_Source
7454 and then (Data.Flags.Require_Sources_Other_Lang
7455 or else Language.Name = Name_Ada)
7457 Iter := For_Each_Source (In_Tree => Data.Tree,
7458 Project => Project.Project);
7460 Source := Element (Iter);
7461 exit Source_Loop when Source = No_Source
7462 or else Source.Language = Language;
7464 Alt_Lang := Source.Alternate_Languages;
7465 while Alt_Lang /= null loop
7466 exit Source_Loop when Alt_Lang.Language = Language;
7467 Alt_Lang := Alt_Lang.Next;
7471 end loop Source_Loop;
7473 if Source = No_Source then
7476 Get_Name_String (Language.Display_Name),
7478 Project.Source_List_File_Location,
7480 Continuation := True;
7484 Language := Language.Next;
7487 end Check_Missing_Sources;
7493 procedure Check_Object (Src : Source_Id) is
7497 Source := Object_File_Names_Htable.Get (Object_Files, Src.Object);
7499 -- We cannot just check on "Source /= Src", since we might have
7500 -- two different entries for the same file (and since that's
7501 -- the same file it is expected that it has the same object)
7503 if Source /= No_Source
7504 and then Source.Path /= Src.Path
7506 Error_Msg_File_1 := Src.File;
7507 Error_Msg_File_2 := Source.File;
7510 "{ and { have the same object file name",
7511 No_Location, Project.Project);
7514 Object_File_Names_Htable.Set (Object_Files, Src.Object, Src);
7518 ---------------------------
7519 -- Mark_Excluded_Sources --
7520 ---------------------------
7522 procedure Mark_Excluded_Sources is
7523 Source : Source_Id := No_Source;
7524 Excluded : File_Found;
7528 -- Minor optimization: if there are no excluded files, no need to
7529 -- traverse the list of sources. We cannot however also check whether
7530 -- the existing exceptions have ".Found" set to True (indicating we
7531 -- found them before) because we need to do some final processing on
7532 -- them in any case.
7534 if Excluded_Sources_Htable.Get_First (Project.Excluded) /=
7537 Proj := Project.Project;
7538 while Proj /= No_Project loop
7539 Iter := For_Each_Source (Data.Tree, Proj);
7540 while Prj.Element (Iter) /= No_Source loop
7541 Source := Prj.Element (Iter);
7542 Excluded := Excluded_Sources_Htable.Get
7543 (Project.Excluded, Source.File);
7545 if Excluded /= No_File_Found then
7546 Source.Locally_Removed := True;
7547 Source.In_Interfaces := False;
7549 if Current_Verbosity = High then
7551 Write_Str ("Removing file ");
7553 (Get_Name_String (Excluded.File)
7554 & " " & Get_Name_String (Source.Project.Name));
7557 Excluded_Sources_Htable.Remove
7558 (Project.Excluded, Source.File);
7564 Proj := Proj.Extends;
7568 -- If we have any excluded element left, that means we did not find
7571 Excluded := Excluded_Sources_Htable.Get_First (Project.Excluded);
7572 while Excluded /= No_File_Found loop
7573 if not Excluded.Found then
7575 -- Check if the file belongs to another imported project to
7576 -- provide a better error message.
7579 (In_Tree => Data.Tree,
7580 Project => Project.Project,
7581 In_Imported_Only => True,
7582 Base_Name => Excluded.File);
7584 Err_Vars.Error_Msg_File_1 := Excluded.File;
7586 if Src = No_Source then
7587 if Excluded.Excl_File = No_File then
7590 "unknown file {", Excluded.Location, Project.Project);
7596 Get_Name_String (Excluded.Excl_File) & ":" &
7597 No_Space_Img (Excluded.Excl_Line) &
7598 ": unknown file {", Excluded.Location, Project.Project);
7602 if Excluded.Excl_File = No_File then
7605 "cannot remove a source from an imported project: {",
7606 Excluded.Location, Project.Project);
7612 Get_Name_String (Excluded.Excl_File) & ":" &
7613 No_Space_Img (Excluded.Excl_Line) &
7614 ": cannot remove a source from an imported project: {",
7615 Excluded.Location, Project.Project);
7620 Excluded := Excluded_Sources_Htable.Get_Next (Project.Excluded);
7622 end Mark_Excluded_Sources;
7624 ------------------------
7625 -- Check_Object_Files --
7626 ------------------------
7628 procedure Check_Object_Files is
7629 Iter : Source_Iterator;
7631 Src_Ind : Source_File_Index;
7634 Iter := For_Each_Source (Data.Tree);
7636 Src_Id := Prj.Element (Iter);
7637 exit when Src_Id = No_Source;
7639 if Is_Compilable (Src_Id)
7640 and then Src_Id.Language.Config.Object_Generated
7641 and then Is_Extending (Project.Project, Src_Id.Project)
7643 if Src_Id.Unit = No_Unit_Index then
7644 if Src_Id.Kind = Impl then
7645 Check_Object (Src_Id);
7651 if Other_Part (Src_Id) = No_Source then
7652 Check_Object (Src_Id);
7659 if Other_Part (Src_Id) /= No_Source then
7660 Check_Object (Src_Id);
7663 -- Check if it is a subunit
7666 Sinput.P.Load_Project_File
7667 (Get_Name_String (Src_Id.Path.Display_Name));
7669 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
7670 Override_Kind (Src_Id, Sep);
7672 Check_Object (Src_Id);
7681 end Check_Object_Files;
7683 ----------------------------------
7684 -- Get_Sources_From_Source_Info --
7685 ----------------------------------
7687 procedure Get_Sources_From_Source_Info is
7688 Iter : Source_Info_Iterator;
7691 Lang_Id : Language_Ptr;
7693 Initialize (Iter, Project.Project.Name);
7696 Src := Source_Info_Of (Iter);
7698 exit when Src = No_Source_Info;
7700 Id := new Source_Data;
7702 Id.Project := Project.Project;
7704 Lang_Id := Project.Project.Languages;
7705 while Lang_Id /= No_Language_Index and then
7706 Lang_Id.Name /= Src.Language
7708 Lang_Id := Lang_Id.Next;
7711 if Lang_Id = No_Language_Index then
7713 ("unknown language " &
7714 Get_Name_String (Src.Language) &
7716 Get_Name_String (Src.Project) &
7717 " in source info file");
7720 Id.Language := Lang_Id;
7721 Id.Kind := Src.Kind;
7722 Id.Index := Src.Index;
7725 (Path_Name_Type (Src.Display_Path_Name),
7726 Path_Name_Type (Src.Path_Name));
7729 Add_Str_To_Name_Buffer
7730 (Ada.Directories.Simple_Name
7731 (Get_Name_String (Src.Path_Name)));
7732 Id.File := Name_Find;
7734 Id.Next_With_File_Name :=
7735 Source_Files_Htable.Get (Data.Tree.Source_Files_HT, Id.File);
7736 Source_Files_Htable.Set (Data.Tree.Source_Files_HT, Id.File, Id);
7739 Add_Str_To_Name_Buffer
7740 (Ada.Directories.Simple_Name
7741 (Get_Name_String (Src.Display_Path_Name)));
7742 Id.Display_File := Name_Find;
7744 Id.Dep_Name := Dependency_Name
7745 (Id.File, Id.Language.Config.Dependency_Kind);
7746 Id.Naming_Exception := Src.Naming_Exception;
7747 Id.Object := Object_Name
7748 (Id.File, Id.Language.Config.Object_File_Suffix);
7749 Id.Switches := Switches_Name (Id.File);
7751 -- Add the source id to the Unit_Sources_HT hash table, if the
7752 -- unit name is not null.
7754 if Src.Kind /= Sep and then Src.Unit_Name /= No_Name then
7757 UData : Unit_Index :=
7758 Units_Htable.Get (Data.Tree.Units_HT, Src.Unit_Name);
7760 if UData = No_Unit_Index then
7761 UData := new Unit_Data;
7762 UData.Name := Src.Unit_Name;
7764 (Data.Tree.Units_HT, Src.Unit_Name, UData);
7770 -- Note that this updates Unit information as well
7772 Override_Kind (Id, Id.Kind);
7775 if Src.Index /= 0 then
7776 Project.Project.Has_Multi_Unit_Sources := True;
7779 -- Add the source to the language list
7781 Id.Next_In_Lang := Id.Language.First_Source;
7782 Id.Language.First_Source := Id;
7786 end Get_Sources_From_Source_Info;
7788 -- Start of processing for Look_For_Sources
7791 if Data.Tree.Source_Info_File_Exists then
7792 Get_Sources_From_Source_Info;
7795 if Project.Project.Source_Dirs /= Nil_String then
7796 Find_Excluded_Sources (Project, Data);
7798 if Project.Project.Languages /= No_Language_Index then
7799 Load_Naming_Exceptions (Project, Data);
7800 Find_Sources (Project, Data);
7801 Mark_Excluded_Sources;
7803 Check_Missing_Sources;
7807 Object_File_Names_Htable.Reset (Object_Files);
7809 end Look_For_Sources;
7815 function Path_Name_Of
7816 (File_Name : File_Name_Type;
7817 Directory : Path_Name_Type) return String
7819 Result : String_Access;
7820 The_Directory : constant String := Get_Name_String (Directory);
7823 Get_Name_String (File_Name);
7826 (File_Name => Name_Buffer (1 .. Name_Len),
7827 Path => The_Directory);
7829 if Result = null then
7833 R : String := Result.all;
7836 Canonical_Case_File_Name (R);
7846 procedure Remove_Source
7847 (Tree : Project_Tree_Ref;
7849 Replaced_By : Source_Id)
7854 if Current_Verbosity = High then
7856 Write_Str ("Removing source ");
7857 Write_Str (Get_Name_String (Id.File));
7859 if Id.Index /= 0 then
7860 Write_Str (" at" & Id.Index'Img);
7866 if Replaced_By /= No_Source then
7867 Id.Replaced_By := Replaced_By;
7868 Replaced_By.Declared_In_Interfaces := Id.Declared_In_Interfaces;
7870 if Id.File /= Replaced_By.File then
7872 Replacement : constant File_Name_Type :=
7873 Replaced_Source_HTable.Get
7874 (Tree.Replaced_Sources, Id.File);
7877 Replaced_Source_HTable.Set
7878 (Tree.Replaced_Sources, Id.File, Replaced_By.File);
7880 if Replacement = No_File then
7881 Tree.Replaced_Source_Number :=
7882 Tree.Replaced_Source_Number + 1;
7888 Id.In_Interfaces := False;
7889 Id.Locally_Removed := True;
7891 -- ??? Should we remove the source from the unit ? The file is not used,
7892 -- so probably should not be referenced from the unit. On the other hand
7893 -- it might give useful additional info
7894 -- if Id.Unit /= null then
7895 -- Id.Unit.File_Names (Id.Kind) := null;
7898 Source := Id.Language.First_Source;
7901 Id.Language.First_Source := Id.Next_In_Lang;
7904 while Source.Next_In_Lang /= Id loop
7905 Source := Source.Next_In_Lang;
7908 Source.Next_In_Lang := Id.Next_In_Lang;
7912 -----------------------
7913 -- Report_No_Sources --
7914 -----------------------
7916 procedure Report_No_Sources
7917 (Project : Project_Id;
7919 Data : Tree_Processing_Data;
7920 Location : Source_Ptr;
7921 Continuation : Boolean := False)
7924 case Data.Flags.When_No_Sources is
7928 when Warning | Error =>
7930 Msg : constant String :=
7933 " sources in this project";
7936 Error_Msg_Warn := Data.Flags.When_No_Sources = Warning;
7938 if Continuation then
7939 Error_Msg (Data.Flags, "\" & Msg, Location, Project);
7941 Error_Msg (Data.Flags, Msg, Location, Project);
7945 end Report_No_Sources;
7947 ----------------------
7948 -- Show_Source_Dirs --
7949 ----------------------
7951 procedure Show_Source_Dirs
7952 (Project : Project_Id;
7953 Shared : Shared_Project_Tree_Data_Access)
7955 Current : String_List_Id;
7956 Element : String_Element;
7959 if Project.Source_Dirs = Nil_String then
7960 Debug_Output ("No source dirs");
7962 Debug_Increase_Indent ("Source_Dirs:");
7964 Current := Project.Source_Dirs;
7965 while Current /= Nil_String loop
7966 Element := Shared.String_Elements.Table (Current);
7967 Debug_Output (Get_Name_String (Element.Display_Value));
7968 Current := Element.Next;
7971 Debug_Decrease_Indent ("end Source_Dirs.");
7973 end Show_Source_Dirs;
7975 ---------------------------
7976 -- Process_Naming_Scheme --
7977 ---------------------------
7979 procedure Process_Naming_Scheme
7980 (Tree : Project_Tree_Ref;
7981 Root_Project : Project_Id;
7982 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
7983 Flags : Processing_Flags)
7985 procedure Recursive_Check
7986 (Project : Project_Id;
7987 Prj_Tree : Project_Tree_Ref;
7988 Data : in out Tree_Processing_Data);
7989 -- Check_Naming_Scheme for the project
7991 ---------------------
7992 -- Recursive_Check --
7993 ---------------------
7995 procedure Recursive_Check
7996 (Project : Project_Id;
7997 Prj_Tree : Project_Tree_Ref;
7998 Data : in out Tree_Processing_Data) is
8000 if Current_Verbosity = High then
8001 Debug_Increase_Indent
8002 ("Processing_Naming_Scheme for project", Project.Name);
8005 Data.Tree := Prj_Tree;
8006 Prj.Nmsc.Check (Project, Data);
8008 if Current_Verbosity = High then
8009 Debug_Decrease_Indent ("Done Processing_Naming_Scheme");
8011 end Recursive_Check;
8013 procedure Check_All_Projects is new
8014 For_Every_Project_Imported (Tree_Processing_Data, Recursive_Check);
8016 Data : Tree_Processing_Data;
8018 -- Start of processing for Process_Naming_Scheme
8020 Lib_Data_Table.Init;
8021 Initialize (Data, Tree => Tree, Node_Tree => Node_Tree, Flags => Flags);
8022 Check_All_Projects (Root_Project, Tree, Data, Imported_First => True);
8025 -- Adjust language configs for projects that are extended
8028 List : Project_List;
8031 Lang : Language_Ptr;
8032 Elng : Language_Ptr;
8035 List := Tree.Projects;
8036 while List /= null loop
8037 Proj := List.Project;
8039 while Exte.Extended_By /= No_Project loop
8040 Exte := Exte.Extended_By;
8043 if Exte /= Proj then
8044 Lang := Proj.Languages;
8046 if Lang /= No_Language_Index then
8048 Elng := Get_Language_From_Name
8049 (Exte, Get_Name_String (Lang.Name));
8050 exit when Elng /= No_Language_Index;
8051 Exte := Exte.Extends;
8054 if Elng /= Lang then
8055 Lang.Config := Elng.Config;
8063 end Process_Naming_Scheme;