1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2000-2012, 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;
40 with Ada.Characters.Handling; use Ada.Characters.Handling;
41 with Ada.Directories; use Ada.Directories;
42 with Ada.Strings; use Ada.Strings;
43 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
44 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
46 with GNAT.Case_Util; use GNAT.Case_Util;
47 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
48 with GNAT.Dynamic_HTables;
49 with GNAT.Regexp; use GNAT.Regexp;
52 package body Prj.Nmsc is
54 No_Continuation_String : aliased String := "";
55 Continuation_String : aliased String := "\";
56 -- Used in Check_Library for continuation error messages at the same
59 type Name_Location is record
60 Name : File_Name_Type;
61 -- Key is duplicated, so that it is known when using functions Get_First
62 -- and Get_Next, as these functions only return an Element.
64 Location : Source_Ptr;
65 Source : Source_Id := No_Source;
66 Listed : Boolean := False;
67 Found : Boolean := False;
70 No_Name_Location : constant Name_Location :=
72 Location => No_Location,
77 package Source_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable
78 (Header_Num => Header_Num,
79 Element => Name_Location,
80 No_Element => No_Name_Location,
81 Key => File_Name_Type,
84 -- File name information found in string list attribute (Source_Files or
85 -- Source_List_File). Used to check that all referenced files were indeed
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;
157 In_Aggregate_Lib : Boolean;
159 -- Temporary data which is needed while parsing a project. It does not need
160 -- to be kept in memory once a project has been fully loaded, but is
161 -- necessary while performing consistency checks (duplicate sources,...)
162 -- This data must be initialized before processing any project, and the
163 -- same data is used for processing all projects in the tree.
165 type Lib_Data is record
170 package Lib_Data_Table is new GNAT.Table
171 (Table_Component_Type => Lib_Data,
172 Table_Index_Type => Natural,
173 Table_Low_Bound => 1,
175 Table_Increment => 100);
176 -- A table to record library names in order to check that two library
177 -- projects do not have the same library names.
180 (Data : out Tree_Processing_Data;
181 Tree : Project_Tree_Ref;
182 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
183 Flags : Prj.Processing_Flags);
186 procedure Free (Data : in out Tree_Processing_Data);
187 -- Free the memory occupied by Data
190 (Data : in out Project_Processing_Data;
191 Project : Project_Id);
192 procedure Free (Data : in out Project_Processing_Data);
193 -- Initialize or free memory for a project-specific data
195 procedure Find_Excluded_Sources
196 (Project : in out Project_Processing_Data;
197 Data : in out Tree_Processing_Data);
198 -- Find the list of files that should not be considered as source files
199 -- for this project. Sets the list in the Project.Excluded_Sources_Htable.
201 procedure Override_Kind (Source : Source_Id; Kind : Source_Kind);
202 -- Override the reference kind for a source file. This properly updates
203 -- the unit data if necessary.
205 procedure Load_Naming_Exceptions
206 (Project : in out Project_Processing_Data;
207 Data : in out Tree_Processing_Data);
208 -- All source files in Data.First_Source are considered as naming
209 -- exceptions, and copied into the Source_Names and Unit_Exceptions tables
212 type Search_Type is (Search_Files, Search_Directories);
215 with procedure Callback
216 (Path : Path_Information;
217 Pattern_Index : Natural);
218 procedure Expand_Subdirectory_Pattern
219 (Project : Project_Id;
220 Data : in out Tree_Processing_Data;
221 Patterns : String_List_Id;
222 Ignore : String_List_Id;
223 Search_For : Search_Type;
224 Resolve_Links : Boolean);
225 -- Search the subdirectories of Project's directory for files or
226 -- directories that match the globbing patterns found in Patterns (for
227 -- instance "**/*.adb"). Typically, Patterns will be the value of the
228 -- Source_Dirs or Excluded_Source_Dirs attributes.
230 -- Every time such a file or directory is found, the callback is called.
231 -- Resolve_Links indicates whether we should resolve links while
232 -- normalizing names.
234 -- In the callback, Pattern_Index is the index within Patterns where the
235 -- expanded pattern was found (1 for the first element of Patterns and
236 -- all its matching directories, then 2,...).
238 -- We use a generic and not an access-to-subprogram because in some cases
239 -- this code is compiled with the restriction No_Implicit_Dynamic_Code.
240 -- An error message is raised if a pattern does not match any file.
244 Data : in out Tree_Processing_Data;
245 Project : Project_Id;
246 Source_Dir_Rank : Natural;
247 Lang_Id : Language_Ptr;
249 File_Name : File_Name_Type;
250 Display_File : File_Name_Type;
251 Naming_Exception : Naming_Exception_Type := No;
252 Path : Path_Information := No_Path_Information;
253 Alternate_Languages : Language_List := null;
254 Unit : Name_Id := No_Name;
256 Locally_Removed : Boolean := False;
257 Location : Source_Ptr := No_Location);
258 -- Add a new source to the different lists: list of all sources in the
259 -- project tree, list of source of a project and list of sources of a
260 -- language. If Path is specified, the file is also added to
261 -- Source_Paths_HT. Location is used for error messages
263 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type;
264 -- Same as Osint.Canonical_Case_File_Name but applies to Name_Id.
265 -- This alters Name_Buffer.
267 function Suffix_Matches
269 Suffix : File_Name_Type) return Boolean;
270 -- True if the file name ends with the given suffix. Always returns False
271 -- if Suffix is No_Name.
273 procedure Replace_Into_Name_Buffer
276 Replacement : Character);
277 -- Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is
278 -- converted to lower-case at the same time.
280 procedure Check_Abstract_Project
281 (Project : Project_Id;
282 Data : in out Tree_Processing_Data);
283 -- Check abstract projects attributes
285 procedure Check_Configuration
286 (Project : Project_Id;
287 Data : in out Tree_Processing_Data);
288 -- Check the configuration attributes for the project
290 procedure Check_If_Externally_Built
291 (Project : Project_Id;
292 Data : in out Tree_Processing_Data);
293 -- Check attribute Externally_Built of project Project in project tree
294 -- Data.Tree and modify its data Data if it has the value "true".
296 procedure Check_Interfaces
297 (Project : Project_Id;
298 Data : in out Tree_Processing_Data);
299 -- If a list of sources is specified in attribute Interfaces, set
300 -- In_Interfaces only for the sources specified in the list.
302 procedure Check_Library_Attributes
303 (Project : Project_Id;
304 Data : in out Tree_Processing_Data);
305 -- Check the library attributes of project Project in project tree
306 -- and modify its data Data accordingly.
308 procedure Check_Package_Naming
309 (Project : Project_Id;
310 Data : in out Tree_Processing_Data);
311 -- Check the naming scheme part of Data, and initialize the naming scheme
312 -- data in the config of the various languages.
314 procedure Check_Programming_Languages
315 (Project : Project_Id;
316 Data : in out Tree_Processing_Data);
317 -- Check attribute Languages for the project with data Data in project
318 -- tree Data.Tree and set the components of Data for all the programming
319 -- languages indicated in attribute Languages, if any.
321 procedure Check_Stand_Alone_Library
322 (Project : Project_Id;
323 Data : in out Tree_Processing_Data);
324 -- Check if project Project in project tree Data.Tree is a Stand-Alone
325 -- Library project, and modify its data Data accordingly if it is one.
327 procedure Check_Unit_Name (Name : String; Unit : out Name_Id);
328 -- Check that a name is a valid unit name
330 function Compute_Directory_Last (Dir : String) return Natural;
331 -- Return the index of the last significant character in Dir. This is used
332 -- to avoid duplicate '/' (slash) characters at the end of directory names.
334 procedure Search_Directories
335 (Project : in out Project_Processing_Data;
336 Data : in out Tree_Processing_Data;
337 For_All_Sources : Boolean);
338 -- Search the source directories to find the sources. If For_All_Sources is
339 -- True, check each regular file name against the naming schemes of the
340 -- various languages. Otherwise consider only the file names in hash table
341 -- Source_Names. If Allow_Duplicate_Basenames then files with identical
342 -- base names are permitted within a project for source-based languages
343 -- (never for unit based languages).
346 (Project : in out Project_Processing_Data;
347 Data : in out Tree_Processing_Data;
348 Source_Dir_Rank : Natural;
349 Path : Path_Name_Type;
350 Display_Path : Path_Name_Type;
351 File_Name : File_Name_Type;
352 Display_File_Name : File_Name_Type;
353 Locally_Removed : Boolean;
354 For_All_Sources : Boolean);
355 -- Check if file File_Name is a valid source of the project. This is used
356 -- in multi-language mode only. When the file matches one of the naming
357 -- schemes, it is added to various htables through Add_Source and to
358 -- Source_Paths_Htable.
360 -- File_Name is the same as Display_File_Name, but has been normalized.
361 -- They do not include the directory information.
363 -- Path and Display_Path on the other hand are the full path to the file.
364 -- Path must have been normalized (canonical casing and possibly links
367 -- Source_Directory is the directory in which the file was found. It is
368 -- neither normalized nor has had links resolved, and must not end with a
369 -- a directory separator, to avoid duplicates later on.
371 -- If For_All_Sources is True, then all possible file names are analyzed
372 -- otherwise only those currently set in the Source_Names hash table.
374 procedure Check_File_Naming_Schemes
375 (Project : Project_Processing_Data;
376 File_Name : File_Name_Type;
377 Alternate_Languages : out Language_List;
378 Language : out Language_Ptr;
379 Display_Language_Name : out Name_Id;
381 Lang_Kind : out Language_Kind;
382 Kind : out Source_Kind);
383 -- Check if the file name File_Name conforms to one of the naming schemes
384 -- of the project. If the file does not match one of the naming schemes,
385 -- set Language to No_Language_Index. Filename is the name of the file
386 -- being investigated. It has been normalized (case-folded). File_Name is
389 procedure Get_Directories
390 (Project : Project_Id;
391 Data : in out Tree_Processing_Data);
392 -- Get the object directory, the exec directory and the source directories
396 (Project : Project_Id;
397 Data : in out Tree_Processing_Data);
398 -- Get the mains of a project from attribute Main, if it exists, and put
399 -- them in the project data.
401 procedure Get_Sources_From_File
403 Location : Source_Ptr;
404 Project : in out Project_Processing_Data;
405 Data : in out Tree_Processing_Data);
406 -- Get the list of sources from a text file and put them in hash table
409 procedure Find_Sources
410 (Project : in out Project_Processing_Data;
411 Data : in out Tree_Processing_Data);
412 -- Process the Source_Files and Source_List_File attributes, and store the
413 -- list of source files into the Source_Names htable. When these attributes
414 -- are not defined, find all files matching the naming schemes in the
415 -- source directories. If Allow_Duplicate_Basenames, then files with the
416 -- same base names are authorized within a project for source-based
417 -- languages (never for unit based languages)
419 procedure Compute_Unit_Name
420 (File_Name : File_Name_Type;
421 Naming : Lang_Naming_Data;
422 Kind : out Source_Kind;
424 Project : Project_Processing_Data);
425 -- Check whether the file matches the naming scheme. If it does,
426 -- compute its unit name. If Unit is set to No_Name on exit, none of the
427 -- other out parameters are relevant.
429 procedure Check_Illegal_Suffix
430 (Project : Project_Id;
431 Suffix : File_Name_Type;
432 Dot_Replacement : File_Name_Type;
433 Attribute_Name : String;
434 Location : Source_Ptr;
435 Data : in out Tree_Processing_Data);
436 -- Display an error message if the given suffix is illegal for some reason.
437 -- The name of the attribute we are testing is specified in Attribute_Name,
438 -- which is used in the error message. Location is the location where the
439 -- suffix is defined.
441 procedure Locate_Directory
442 (Project : Project_Id;
443 Name : File_Name_Type;
444 Path : out Path_Information;
445 Dir_Exists : out Boolean;
446 Data : in out Tree_Processing_Data;
447 Create : String := "";
448 Location : Source_Ptr := No_Location;
449 Must_Exist : Boolean := True;
450 Externally_Built : Boolean := False);
451 -- Locate a directory. Name is the directory name. Relative paths are
452 -- resolved relative to the project's directory. If the directory does not
453 -- exist and Setup_Projects is True and Create is a non null string, an
454 -- attempt is made to create the directory. If the directory does not
455 -- exist, it is either created if Setup_Projects is False (and then
456 -- returned), or simply returned without checking for its existence (if
457 -- Must_Exist is False) or No_Path_Information is returned. In all cases,
458 -- Dir_Exists indicates whether the directory now exists. Create is also
459 -- used for debugging traces to show which path we are computing.
461 procedure Look_For_Sources
462 (Project : in out Project_Processing_Data;
463 Data : in out Tree_Processing_Data);
464 -- Find all the sources of project Project in project tree Data.Tree and
465 -- update its Data accordingly. This assumes that the special naming
466 -- exceptions have already been processed.
468 function Path_Name_Of
469 (File_Name : File_Name_Type;
470 Directory : Path_Name_Type) return String;
471 -- Returns the path name of a (non project) file. Returns an empty string
472 -- if file cannot be found.
474 procedure Remove_Source
475 (Tree : Project_Tree_Ref;
477 Replaced_By : Source_Id);
478 -- Remove a file from the list of sources of a project. This might be
479 -- because the file is replaced by another one in an extending project,
480 -- or because a file was added as a naming exception but was not found
483 procedure Report_No_Sources
484 (Project : Project_Id;
486 Data : Tree_Processing_Data;
487 Location : Source_Ptr;
488 Continuation : Boolean := False);
489 -- Report an error or a warning depending on the value of When_No_Sources
490 -- when there are no sources for language Lang_Name.
492 procedure Show_Source_Dirs
493 (Project : Project_Id;
494 Shared : Shared_Project_Tree_Data_Access);
495 -- List all the source directories of a project
497 procedure Write_Attr (Name, Value : String);
498 -- Debug print a value for a specific property. Does nothing when not in
501 procedure Error_Or_Warning
502 (Flags : Processing_Flags;
503 Kind : Error_Warning;
505 Location : Source_Ptr;
506 Project : Project_Id);
507 -- Emits either an error or warning message (or nothing), depending on Kind
509 function No_Space_Img (N : Natural) return String;
510 -- Image of a Natural without the initial space
512 ----------------------
513 -- Error_Or_Warning --
514 ----------------------
516 procedure Error_Or_Warning
517 (Flags : Processing_Flags;
518 Kind : Error_Warning;
520 Location : Source_Ptr;
521 Project : Project_Id) is
524 when Error => Error_Msg (Flags, Msg, Location, Project);
525 when Warning => Error_Msg (Flags, "?" & Msg, Location, Project);
528 end Error_Or_Warning;
530 ------------------------------
531 -- Replace_Into_Name_Buffer --
532 ------------------------------
534 procedure Replace_Into_Name_Buffer
537 Replacement : Character)
539 Max : constant Integer := Str'Last - Pattern'Length + 1;
546 while J <= Str'Last loop
547 Name_Len := Name_Len + 1;
550 and then Str (J .. J + Pattern'Length - 1) = Pattern
552 Name_Buffer (Name_Len) := Replacement;
553 J := J + Pattern'Length;
556 Name_Buffer (Name_Len) := GNAT.Case_Util.To_Lower (Str (J));
560 end Replace_Into_Name_Buffer;
566 function Suffix_Matches
568 Suffix : File_Name_Type) return Boolean
570 Min_Prefix_Length : Natural := 0;
573 if Suffix = No_File or else Suffix = Empty_File then
578 Suf : String := Get_Name_String (Suffix);
581 -- On non case-sensitive systems, use proper suffix casing
583 Canonical_Case_File_Name (Suf);
585 -- The file name must end with the suffix (which is not an extension)
586 -- For instance a suffix "configure.in" must match a file with the
587 -- same name. To avoid dummy cases, though, a suffix starting with
588 -- '.' requires a file that is at least one character longer ('.cpp'
589 -- should not match a file with the same name).
591 if Suf (Suf'First) = '.' then
592 Min_Prefix_Length := 1;
595 return Filename'Length >= Suf'Length + Min_Prefix_Length
597 Filename (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;
605 procedure Write_Attr (Name, Value : String) is
607 if Current_Verbosity = High then
608 Debug_Output (Name & " = """ & Value & '"');
618 Data : in out Tree_Processing_Data;
619 Project : Project_Id;
620 Source_Dir_Rank : Natural;
621 Lang_Id : Language_Ptr;
623 File_Name : File_Name_Type;
624 Display_File : File_Name_Type;
625 Naming_Exception : Naming_Exception_Type := No;
626 Path : Path_Information := No_Path_Information;
627 Alternate_Languages : Language_List := null;
628 Unit : Name_Id := No_Name;
630 Locally_Removed : Boolean := False;
631 Location : Source_Ptr := No_Location)
633 Config : constant Language_Config := Lang_Id.Config;
637 Prev_Unit : Unit_Index := No_Unit_Index;
638 Source_To_Replace : Source_Id := No_Source;
641 -- Check if the same file name or unit is used in the prj tree
645 if Unit /= No_Name then
646 Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit);
649 if Prev_Unit /= No_Unit_Index
650 and then (Kind = Impl or else Kind = Spec)
651 and then Prev_Unit.File_Names (Kind) /= null
653 -- Suspicious, we need to check later whether this is authorized
656 Source := Prev_Unit.File_Names (Kind);
659 Source := Source_Files_Htable.Get
660 (Data.Tree.Source_Files_HT, File_Name);
662 if Source /= No_Source and then Source.Index = Index then
667 -- Duplication of file/unit in same project is allowed if order of
668 -- source directories is known, or if there is no compiler for the
671 if Add_Src = False then
674 if Project = Source.Project then
675 if Prev_Unit = No_Unit_Index then
676 if Data.Flags.Allow_Duplicate_Basenames then
679 elsif Lang_Id.Config.Compiler_Driver = Empty_File then
682 elsif Source_Dir_Rank /= Source.Source_Dir_Rank then
686 Error_Msg_File_1 := File_Name;
688 (Data.Flags, "duplicate source file name {",
694 if Source_Dir_Rank /= Source.Source_Dir_Rank then
697 -- We might be seeing the same file through a different path
698 -- (for instance because of symbolic links).
700 elsif Source.Path.Name /= Path.Name then
701 if not Source.Duplicate_Unit then
702 Error_Msg_Name_1 := Unit;
704 (Data.Flags, "\duplicate unit %%", Location, Project);
705 Source.Duplicate_Unit := True;
712 -- Do not allow the same unit name in different projects, except
713 -- if one is extending the other.
715 -- For a file based language, the same file name replaces a file
716 -- in a project being extended, but it is allowed to have the same
717 -- file name in unrelated projects.
719 elsif Is_Extending (Project, Source.Project) then
720 if not Locally_Removed and then Naming_Exception /= Inherited then
721 Source_To_Replace := Source;
724 elsif Prev_Unit /= No_Unit_Index
725 and then Prev_Unit.File_Names (Kind) /= null
726 and then not Source.Locally_Removed
727 and then not Data.In_Aggregate_Lib
729 -- Path is set if this is a source we found on the disk, in which
730 -- case we can provide more explicit error message. Path is unset
731 -- when the source is added from one of the naming exceptions in
734 if Path /= No_Path_Information then
735 Error_Msg_Name_1 := Unit;
738 "unit %% cannot belong to several projects",
741 Error_Msg_Name_1 := Project.Name;
742 Error_Msg_Name_2 := Name_Id (Path.Display_Name);
744 (Data.Flags, "\ project %%, %%", Location, Project);
746 Error_Msg_Name_1 := Source.Project.Name;
747 Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);
749 (Data.Flags, "\ project %%, %%", Location, Project);
752 Error_Msg_Name_1 := Unit;
753 Error_Msg_Name_2 := Source.Project.Name;
755 (Data.Flags, "unit %% already belongs to project %%",
761 elsif not Source.Locally_Removed
762 and then not Data.Flags.Allow_Duplicate_Basenames
763 and then Lang_Id.Config.Kind = Unit_Based
764 and then Source.Language.Config.Kind = Unit_Based
765 and then not Data.In_Aggregate_Lib
767 Error_Msg_File_1 := File_Name;
768 Error_Msg_File_2 := File_Name_Type (Source.Project.Name);
771 "{ is already a source of project {", Location, Project);
773 -- Add the file anyway, to avoid further warnings like "language
786 Id := new Source_Data;
788 if Current_Verbosity = High then
790 Write_Str ("adding source File: ");
791 Write_Str (Get_Name_String (Display_File));
794 Write_Str (" at" & Index'Img);
797 if Lang_Id.Config.Kind = Unit_Based then
798 Write_Str (" Unit: ");
800 -- ??? in gprclean, it seems we sometimes pass an empty Unit name
801 -- (see test extended_projects).
803 if Unit /= No_Name then
804 Write_Str (Get_Name_String (Unit));
807 Write_Str (" Kind: ");
808 Write_Str (Source_Kind'Image (Kind));
814 Id.Project := Project;
815 Id.Location := Location;
816 Id.Source_Dir_Rank := Source_Dir_Rank;
817 Id.Language := Lang_Id;
819 Id.Alternate_Languages := Alternate_Languages;
820 Id.Locally_Removed := Locally_Removed;
822 Id.File := File_Name;
823 Id.Display_File := Display_File;
824 Id.Dep_Name := Dependency_Name
825 (File_Name, Lang_Id.Config.Dependency_Kind);
826 Id.Naming_Exception := Naming_Exception;
827 Id.Object := Object_Name
828 (File_Name, Config.Object_File_Suffix);
829 Id.Switches := Switches_Name (File_Name);
831 -- Add the source id to the Unit_Sources_HT hash table, if the unit name
834 if Unit /= No_Name then
836 -- Note: we might be creating a dummy unit here, when we in fact have
837 -- a separate. For instance, file file-bar.adb will initially be
838 -- assumed to be the IMPL of unit "file.bar". Only later on (in
839 -- Check_Object_Files) will we parse those units that only have an
840 -- impl and no spec to make sure whether we have a Separate in fact
841 -- (that significantly reduces the number of times we need to parse
842 -- the files, since we are then only interested in those with no
843 -- spec). We still need those dummy units in the table, since that's
844 -- the name we find in the ALI file
846 UData := Units_Htable.Get (Data.Tree.Units_HT, Unit);
848 if UData = No_Unit_Index then
849 UData := new Unit_Data;
852 if Naming_Exception /= Inherited then
853 Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
859 -- Note that this updates Unit information as well
861 if Naming_Exception /= Inherited then
862 Override_Kind (Id, Kind);
866 if Path /= No_Path_Information then
868 Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id);
871 Id.Next_With_File_Name :=
872 Source_Files_Htable.Get (Data.Tree.Source_Files_HT, File_Name);
873 Source_Files_Htable.Set (Data.Tree.Source_Files_HT, File_Name, Id);
876 Project.Has_Multi_Unit_Sources := True;
879 -- Add the source to the language list
881 Id.Next_In_Lang := Lang_Id.First_Source;
882 Lang_Id.First_Source := Id;
884 if Source_To_Replace /= No_Source then
885 Remove_Source (Data.Tree, Source_To_Replace, Id);
888 if Data.Tree.Replaced_Source_Number > 0
890 Replaced_Source_HTable.Get
891 (Data.Tree.Replaced_Sources, Id.File) /= No_File
893 Replaced_Source_HTable.Remove (Data.Tree.Replaced_Sources, Id.File);
894 Data.Tree.Replaced_Source_Number :=
895 Data.Tree.Replaced_Source_Number - 1;
899 ------------------------------
900 -- Canonical_Case_File_Name --
901 ------------------------------
903 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type is
905 if Osint.File_Names_Case_Sensitive then
906 return File_Name_Type (Name);
908 Get_Name_String (Name);
909 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
912 end Canonical_Case_File_Name;
914 ---------------------------------
915 -- Process_Aggregated_Projects --
916 ---------------------------------
918 procedure Process_Aggregated_Projects
919 (Tree : Project_Tree_Ref;
920 Project : Project_Id;
921 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
922 Flags : Processing_Flags)
924 Data : Tree_Processing_Data :=
926 Node_Tree => Node_Tree,
928 In_Aggregate_Lib => False);
930 Project_Files : constant Prj.Variable_Value :=
932 (Snames.Name_Project_Files,
933 Project.Decl.Attributes,
936 Project_Path_For_Aggregate : Prj.Env.Project_Search_Path;
938 procedure Found_Project_File (Path : Path_Information; Rank : Natural);
939 -- Called for each project file aggregated by Project
941 procedure Expand_Project_Files is
942 new Expand_Subdirectory_Pattern (Callback => Found_Project_File);
943 -- Search for all project files referenced by the patterns given in
944 -- parameter. Calls Found_Project_File for each of them.
946 ------------------------
947 -- Found_Project_File --
948 ------------------------
950 procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
951 pragma Unreferenced (Rank);
954 if Path.Name /= Project.Path.Name then
955 Debug_Output ("aggregates: ", Name_Id (Path.Display_Name));
957 -- For usual "with" statement, this phase will have been done when
958 -- parsing the project itself. However, for aggregate projects, we
959 -- can only do this when processing the aggregate project, since
960 -- the exact list of project files or project directories can
961 -- depend on scenario variables.
963 -- We only load the projects explicitly here, but do not process
964 -- them. For the processing, Prj.Proc will take care of processing
965 -- them, within the same call to Recursive_Process (thus avoiding
966 -- the processing of a given project multiple times).
968 -- ??? We might already have loaded the project
970 Add_Aggregated_Project (Project, Path => Path.Name);
973 Debug_Output ("pattern returned the aggregate itself, ignored");
975 end Found_Project_File;
977 -- Start of processing for Check_Aggregate_Project
980 pragma Assert (Project.Qualifier in Aggregate_Project);
982 if Project_Files.Default then
983 Error_Msg_Name_1 := Snames.Name_Project_Files;
986 "Attribute %% must be specified in aggregate project",
987 Project.Location, Project);
991 -- The aggregated projects are only searched relative to the directory
992 -- of the aggregate project, not in the default project path.
994 Initialize_Empty (Project_Path_For_Aggregate);
996 Free (Project.Aggregated_Projects);
998 -- Look for aggregated projects. For similarity with source files and
999 -- dirs, the aggregated project files are not searched for on the
1000 -- project path, and are only found through the path specified in
1001 -- the Project_Files attribute.
1003 Expand_Project_Files
1004 (Project => Project,
1006 Patterns => Project_Files.Values,
1007 Ignore => Nil_String,
1008 Search_For => Search_Files,
1009 Resolve_Links => Opt.Follow_Links_For_Files);
1011 Free (Project_Path_For_Aggregate);
1012 end Process_Aggregated_Projects;
1014 ----------------------------
1015 -- Check_Abstract_Project --
1016 ----------------------------
1018 procedure Check_Abstract_Project
1019 (Project : Project_Id;
1020 Data : in out Tree_Processing_Data)
1022 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
1024 Source_Dirs : constant Variable_Value :=
1027 Project.Decl.Attributes, Shared);
1028 Source_Files : constant Variable_Value :=
1031 Project.Decl.Attributes, Shared);
1032 Source_List_File : constant Variable_Value :=
1034 (Name_Source_List_File,
1035 Project.Decl.Attributes, Shared);
1036 Languages : constant Variable_Value :=
1039 Project.Decl.Attributes, Shared);
1042 if Project.Source_Dirs /= Nil_String then
1043 if Source_Dirs.Values = Nil_String
1044 and then Source_Files.Values = Nil_String
1045 and then Languages.Values = Nil_String
1046 and then Source_List_File.Default
1048 Project.Source_Dirs := Nil_String;
1053 "at least one of Source_Files, Source_Dirs or Languages "
1054 & "must be declared empty for an abstract project",
1055 Project.Location, Project);
1058 end Check_Abstract_Project;
1060 -------------------------
1061 -- Check_Configuration --
1062 -------------------------
1064 procedure Check_Configuration
1065 (Project : Project_Id;
1066 Data : in out Tree_Processing_Data)
1068 Shared : constant Shared_Project_Tree_Data_Access :=
1071 Dot_Replacement : File_Name_Type := No_File;
1072 Casing : Casing_Type := All_Lower_Case;
1073 Separate_Suffix : File_Name_Type := No_File;
1075 Lang_Index : Language_Ptr := No_Language_Index;
1076 -- The index of the language data being checked
1078 Prev_Index : Language_Ptr := No_Language_Index;
1079 -- The index of the previous language
1081 procedure Process_Project_Level_Simple_Attributes;
1082 -- Process the simple attributes at the project level
1084 procedure Process_Project_Level_Array_Attributes;
1085 -- Process the associate array attributes at the project level
1087 procedure Process_Packages;
1088 -- Read the packages of the project
1090 ----------------------
1091 -- Process_Packages --
1092 ----------------------
1094 procedure Process_Packages is
1095 Packages : Package_Id;
1096 Element : Package_Element;
1098 procedure Process_Binder (Arrays : Array_Id);
1099 -- Process the associate array attributes of package Binder
1101 procedure Process_Builder (Attributes : Variable_Id);
1102 -- Process the simple attributes of package Builder
1104 procedure Process_Compiler (Arrays : Array_Id);
1105 -- Process the associate array attributes of package Compiler
1107 procedure Process_Naming (Attributes : Variable_Id);
1108 -- Process the simple attributes of package Naming
1110 procedure Process_Naming (Arrays : Array_Id);
1111 -- Process the associate array attributes of package Naming
1113 procedure Process_Linker (Attributes : Variable_Id);
1114 -- Process the simple attributes of package Linker of a
1115 -- configuration project.
1117 --------------------
1118 -- Process_Binder --
1119 --------------------
1121 procedure Process_Binder (Arrays : Array_Id) is
1122 Current_Array_Id : Array_Id;
1123 Current_Array : Array_Data;
1124 Element_Id : Array_Element_Id;
1125 Element : Array_Element;
1128 -- Process the associative array attribute of package Binder
1130 Current_Array_Id := Arrays;
1131 while Current_Array_Id /= No_Array loop
1132 Current_Array := Shared.Arrays.Table (Current_Array_Id);
1134 Element_Id := Current_Array.Value;
1135 while Element_Id /= No_Array_Element loop
1136 Element := Shared.Array_Elements.Table (Element_Id);
1138 if Element.Index /= All_Other_Names then
1140 -- Get the name of the language
1143 Get_Language_From_Name
1144 (Project, Get_Name_String (Element.Index));
1146 if Lang_Index /= No_Language_Index then
1147 case Current_Array.Name is
1150 -- Attribute Driver (<language>)
1152 Lang_Index.Config.Binder_Driver :=
1153 File_Name_Type (Element.Value.Value);
1155 when Name_Required_Switches =>
1158 Lang_Index.Config.Binder_Required_Switches,
1159 From_List => Element.Value.Values,
1160 In_Tree => Data.Tree);
1164 -- Attribute Prefix (<language>)
1166 Lang_Index.Config.Binder_Prefix :=
1167 Element.Value.Value;
1169 when Name_Objects_Path =>
1171 -- Attribute Objects_Path (<language>)
1173 Lang_Index.Config.Objects_Path :=
1174 Element.Value.Value;
1176 when Name_Objects_Path_File =>
1178 -- Attribute Objects_Path (<language>)
1180 Lang_Index.Config.Objects_Path_File :=
1181 Element.Value.Value;
1189 Element_Id := Element.Next;
1192 Current_Array_Id := Current_Array.Next;
1196 ---------------------
1197 -- Process_Builder --
1198 ---------------------
1200 procedure Process_Builder (Attributes : Variable_Id) is
1201 Attribute_Id : Variable_Id;
1202 Attribute : Variable;
1205 -- Process non associated array attribute from package Builder
1207 Attribute_Id := Attributes;
1208 while Attribute_Id /= No_Variable loop
1209 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1211 if not Attribute.Value.Default then
1212 if Attribute.Name = Name_Executable_Suffix then
1214 -- Attribute Executable_Suffix: the suffix of the
1217 Project.Config.Executable_Suffix :=
1218 Attribute.Value.Value;
1222 Attribute_Id := Attribute.Next;
1224 end Process_Builder;
1226 ----------------------
1227 -- Process_Compiler --
1228 ----------------------
1230 procedure Process_Compiler (Arrays : Array_Id) is
1231 Current_Array_Id : Array_Id;
1232 Current_Array : Array_Data;
1233 Element_Id : Array_Element_Id;
1234 Element : Array_Element;
1235 List : String_List_Id;
1238 -- Process the associative array attribute of package Compiler
1240 Current_Array_Id := Arrays;
1241 while Current_Array_Id /= No_Array loop
1242 Current_Array := Shared.Arrays.Table (Current_Array_Id);
1244 Element_Id := Current_Array.Value;
1245 while Element_Id /= No_Array_Element loop
1246 Element := Shared.Array_Elements.Table (Element_Id);
1248 if Element.Index /= All_Other_Names then
1250 -- Get the name of the language
1252 Lang_Index := Get_Language_From_Name
1253 (Project, Get_Name_String (Element.Index));
1255 if Lang_Index /= No_Language_Index then
1256 case Current_Array.Name is
1258 -- Attribute Dependency_Kind (<language>)
1260 when Name_Dependency_Kind =>
1261 Get_Name_String (Element.Value.Value);
1264 Lang_Index.Config.Dependency_Kind :=
1265 Dependency_File_Kind'Value
1266 (Name_Buffer (1 .. Name_Len));
1269 when Constraint_Error =>
1272 "illegal value for Dependency_Kind",
1273 Element.Value.Location,
1277 -- Attribute Dependency_Switches (<language>)
1279 when Name_Dependency_Switches =>
1280 if Lang_Index.Config.Dependency_Kind = None then
1281 Lang_Index.Config.Dependency_Kind := Makefile;
1284 List := Element.Value.Values;
1286 if List /= Nil_String then
1288 Lang_Index.Config.Dependency_Option,
1290 In_Tree => Data.Tree);
1293 -- Attribute Dependency_Driver (<language>)
1295 when Name_Dependency_Driver =>
1296 if Lang_Index.Config.Dependency_Kind = None then
1297 Lang_Index.Config.Dependency_Kind := Makefile;
1300 List := Element.Value.Values;
1302 if List /= Nil_String then
1304 Lang_Index.Config.Compute_Dependency,
1306 In_Tree => Data.Tree);
1309 -- Attribute Language_Kind (<language>)
1311 when Name_Language_Kind =>
1312 Get_Name_String (Element.Value.Value);
1315 Lang_Index.Config.Kind :=
1317 (Name_Buffer (1 .. Name_Len));
1320 when Constraint_Error =>
1323 "illegal value for Language_Kind",
1324 Element.Value.Location,
1328 -- Attribute Include_Switches (<language>)
1330 when Name_Include_Switches =>
1331 List := Element.Value.Values;
1333 if List = Nil_String then
1335 (Data.Flags, "include option cannot be null",
1336 Element.Value.Location, Project);
1339 Put (Into_List => Lang_Index.Config.Include_Option,
1341 In_Tree => Data.Tree);
1343 -- Attribute Include_Path (<language>)
1345 when Name_Include_Path =>
1346 Lang_Index.Config.Include_Path :=
1347 Element.Value.Value;
1349 -- Attribute Include_Path_File (<language>)
1351 when Name_Include_Path_File =>
1352 Lang_Index.Config.Include_Path_File :=
1353 Element.Value.Value;
1355 -- Attribute Driver (<language>)
1358 Lang_Index.Config.Compiler_Driver :=
1359 File_Name_Type (Element.Value.Value);
1361 when Name_Required_Switches
1362 | Name_Leading_Required_Switches
1366 Compiler_Leading_Required_Switches,
1367 From_List => Element.Value.Values,
1368 In_Tree => Data.Tree);
1370 when Name_Trailing_Required_Switches =>
1373 Compiler_Trailing_Required_Switches,
1374 From_List => Element.Value.Values,
1375 In_Tree => Data.Tree);
1377 when Name_Multi_Unit_Switches =>
1379 Lang_Index.Config.Multi_Unit_Switches,
1380 From_List => Element.Value.Values,
1381 In_Tree => Data.Tree);
1383 when Name_Multi_Unit_Object_Separator =>
1384 Get_Name_String (Element.Value.Value);
1386 if Name_Len /= 1 then
1389 "multi-unit object separator must have " &
1390 "a single character",
1391 Element.Value.Location, Project);
1393 elsif Name_Buffer (1) = ' ' then
1396 "multi-unit object separator cannot be " &
1398 Element.Value.Location, Project);
1401 Lang_Index.Config.Multi_Unit_Object_Separator :=
1405 when Name_Path_Syntax =>
1407 Lang_Index.Config.Path_Syntax :=
1408 Path_Syntax_Kind'Value
1409 (Get_Name_String (Element.Value.Value));
1412 when Constraint_Error =>
1415 "invalid value for Path_Syntax",
1416 Element.Value.Location, Project);
1419 when Name_Source_File_Switches =>
1421 Lang_Index.Config.Source_File_Switches,
1422 From_List => Element.Value.Values,
1423 In_Tree => Data.Tree);
1425 when Name_Object_File_Suffix =>
1426 if Get_Name_String (Element.Value.Value) = "" then
1429 "object file suffix cannot be empty",
1430 Element.Value.Location, Project);
1433 Lang_Index.Config.Object_File_Suffix :=
1434 Element.Value.Value;
1437 when Name_Object_File_Switches =>
1439 Lang_Index.Config.Object_File_Switches,
1440 From_List => Element.Value.Values,
1441 In_Tree => Data.Tree);
1443 -- Attribute Compiler_Pic_Option (<language>)
1445 when Name_Pic_Option =>
1446 List := Element.Value.Values;
1448 if List = Nil_String then
1451 "compiler PIC option cannot be null",
1452 Element.Value.Location, Project);
1456 Lang_Index.Config.Compilation_PIC_Option,
1458 In_Tree => Data.Tree);
1460 -- Attribute Mapping_File_Switches (<language>)
1462 when Name_Mapping_File_Switches =>
1463 List := Element.Value.Values;
1465 if List = Nil_String then
1468 "mapping file switches cannot be null",
1469 Element.Value.Location, Project);
1473 Lang_Index.Config.Mapping_File_Switches,
1475 In_Tree => Data.Tree);
1477 -- Attribute Mapping_Spec_Suffix (<language>)
1479 when Name_Mapping_Spec_Suffix =>
1480 Lang_Index.Config.Mapping_Spec_Suffix :=
1481 File_Name_Type (Element.Value.Value);
1483 -- Attribute Mapping_Body_Suffix (<language>)
1485 when Name_Mapping_Body_Suffix =>
1486 Lang_Index.Config.Mapping_Body_Suffix :=
1487 File_Name_Type (Element.Value.Value);
1489 -- Attribute Config_File_Switches (<language>)
1491 when Name_Config_File_Switches =>
1492 List := Element.Value.Values;
1494 if List = Nil_String then
1497 "config file switches cannot be null",
1498 Element.Value.Location, Project);
1502 Lang_Index.Config.Config_File_Switches,
1504 In_Tree => Data.Tree);
1506 -- Attribute Objects_Path (<language>)
1508 when Name_Objects_Path =>
1509 Lang_Index.Config.Objects_Path :=
1510 Element.Value.Value;
1512 -- Attribute Objects_Path_File (<language>)
1514 when Name_Objects_Path_File =>
1515 Lang_Index.Config.Objects_Path_File :=
1516 Element.Value.Value;
1518 -- Attribute Config_Body_File_Name (<language>)
1520 when Name_Config_Body_File_Name =>
1521 Lang_Index.Config.Config_Body :=
1522 Element.Value.Value;
1524 -- Attribute Config_Body_File_Name_Index (< Language>)
1526 when Name_Config_Body_File_Name_Index =>
1527 Lang_Index.Config.Config_Body_Index :=
1528 Element.Value.Value;
1530 -- Attribute Config_Body_File_Name_Pattern(<language>)
1532 when Name_Config_Body_File_Name_Pattern =>
1533 Lang_Index.Config.Config_Body_Pattern :=
1534 Element.Value.Value;
1536 -- Attribute Config_Spec_File_Name (<language>)
1538 when Name_Config_Spec_File_Name =>
1539 Lang_Index.Config.Config_Spec :=
1540 Element.Value.Value;
1542 -- Attribute Config_Spec_File_Name_Index (<language>)
1544 when Name_Config_Spec_File_Name_Index =>
1545 Lang_Index.Config.Config_Spec_Index :=
1546 Element.Value.Value;
1548 -- Attribute Config_Spec_File_Name_Pattern(<language>)
1550 when Name_Config_Spec_File_Name_Pattern =>
1551 Lang_Index.Config.Config_Spec_Pattern :=
1552 Element.Value.Value;
1554 -- Attribute Config_File_Unique (<language>)
1556 when Name_Config_File_Unique =>
1558 Lang_Index.Config.Config_File_Unique :=
1560 (Get_Name_String (Element.Value.Value));
1562 when Constraint_Error =>
1565 "illegal value for Config_File_Unique",
1566 Element.Value.Location, Project);
1575 Element_Id := Element.Next;
1578 Current_Array_Id := Current_Array.Next;
1580 end Process_Compiler;
1582 --------------------
1583 -- Process_Naming --
1584 --------------------
1586 procedure Process_Naming (Attributes : Variable_Id) is
1587 Attribute_Id : Variable_Id;
1588 Attribute : Variable;
1591 -- Process non associated array attribute from package Naming
1593 Attribute_Id := Attributes;
1594 while Attribute_Id /= No_Variable loop
1595 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1597 if not Attribute.Value.Default then
1598 if Attribute.Name = Name_Separate_Suffix then
1600 -- Attribute Separate_Suffix
1602 Get_Name_String (Attribute.Value.Value);
1603 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1604 Separate_Suffix := Name_Find;
1606 elsif Attribute.Name = Name_Casing then
1612 Value (Get_Name_String (Attribute.Value.Value));
1615 when Constraint_Error =>
1618 "invalid value for Casing",
1619 Attribute.Value.Location, Project);
1622 elsif Attribute.Name = Name_Dot_Replacement then
1624 -- Attribute Dot_Replacement
1626 Dot_Replacement := File_Name_Type (Attribute.Value.Value);
1631 Attribute_Id := Attribute.Next;
1635 procedure Process_Naming (Arrays : Array_Id) is
1636 Current_Array_Id : Array_Id;
1637 Current_Array : Array_Data;
1638 Element_Id : Array_Element_Id;
1639 Element : Array_Element;
1642 -- Process the associative array attribute of package Naming
1644 Current_Array_Id := Arrays;
1645 while Current_Array_Id /= No_Array loop
1646 Current_Array := Shared.Arrays.Table (Current_Array_Id);
1648 Element_Id := Current_Array.Value;
1649 while Element_Id /= No_Array_Element loop
1650 Element := Shared.Array_Elements.Table (Element_Id);
1652 -- Get the name of the language
1654 Lang_Index := Get_Language_From_Name
1655 (Project, Get_Name_String (Element.Index));
1657 if Lang_Index /= No_Language_Index then
1658 case Current_Array.Name is
1659 when Name_Spec_Suffix | Name_Specification_Suffix =>
1661 -- Attribute Spec_Suffix (<language>)
1663 Get_Name_String (Element.Value.Value);
1664 Canonical_Case_File_Name
1665 (Name_Buffer (1 .. Name_Len));
1666 Lang_Index.Config.Naming_Data.Spec_Suffix :=
1669 when Name_Implementation_Suffix | Name_Body_Suffix =>
1671 Get_Name_String (Element.Value.Value);
1672 Canonical_Case_File_Name
1673 (Name_Buffer (1 .. Name_Len));
1675 -- Attribute Body_Suffix (<language>)
1677 Lang_Index.Config.Naming_Data.Body_Suffix :=
1679 Lang_Index.Config.Naming_Data.Separate_Suffix :=
1680 Lang_Index.Config.Naming_Data.Body_Suffix;
1687 Element_Id := Element.Next;
1690 Current_Array_Id := Current_Array.Next;
1694 --------------------
1695 -- Process_Linker --
1696 --------------------
1698 procedure Process_Linker (Attributes : Variable_Id) is
1699 Attribute_Id : Variable_Id;
1700 Attribute : Variable;
1703 -- Process non associated array attribute from package Linker
1705 Attribute_Id := Attributes;
1706 while Attribute_Id /= No_Variable loop
1707 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1709 if not Attribute.Value.Default then
1710 if Attribute.Name = Name_Driver then
1712 -- Attribute Linker'Driver: the default linker to use
1714 Project.Config.Linker :=
1715 Path_Name_Type (Attribute.Value.Value);
1717 -- Linker'Driver is also used to link shared libraries
1718 -- if the obsolescent attribute Library_GCC has not been
1721 if Project.Config.Shared_Lib_Driver = No_File then
1722 Project.Config.Shared_Lib_Driver :=
1723 File_Name_Type (Attribute.Value.Value);
1726 elsif Attribute.Name = Name_Required_Switches then
1728 -- Attribute Required_Switches: the minimum trailing
1729 -- options to use when invoking the linker
1732 Project.Config.Trailing_Linker_Required_Switches,
1733 From_List => Attribute.Value.Values,
1734 In_Tree => Data.Tree);
1736 elsif Attribute.Name = Name_Map_File_Option then
1737 Project.Config.Map_File_Option := Attribute.Value.Value;
1739 elsif Attribute.Name = Name_Max_Command_Line_Length then
1741 Project.Config.Max_Command_Line_Length :=
1742 Natural'Value (Get_Name_String
1743 (Attribute.Value.Value));
1746 when Constraint_Error =>
1749 "value must be positive or equal to 0",
1750 Attribute.Value.Location, Project);
1753 elsif Attribute.Name = Name_Response_File_Format then
1758 Get_Name_String (Attribute.Value.Value);
1759 To_Lower (Name_Buffer (1 .. Name_Len));
1762 if Name = Name_None then
1763 Project.Config.Resp_File_Format := None;
1765 elsif Name = Name_Gnu then
1766 Project.Config.Resp_File_Format := GNU;
1768 elsif Name = Name_Object_List then
1769 Project.Config.Resp_File_Format := Object_List;
1771 elsif Name = Name_Option_List then
1772 Project.Config.Resp_File_Format := Option_List;
1774 elsif Name_Buffer (1 .. Name_Len) = "gcc" then
1775 Project.Config.Resp_File_Format := GCC;
1777 elsif Name_Buffer (1 .. Name_Len) = "gcc_gnu" then
1778 Project.Config.Resp_File_Format := GCC_GNU;
1781 Name_Buffer (1 .. Name_Len) = "gcc_option_list"
1783 Project.Config.Resp_File_Format := GCC_Option_List;
1786 Name_Buffer (1 .. Name_Len) = "gcc_object_list"
1788 Project.Config.Resp_File_Format := GCC_Object_List;
1793 "illegal response file format",
1794 Attribute.Value.Location, Project);
1798 elsif Attribute.Name = Name_Response_File_Switches then
1799 Put (Into_List => Project.Config.Resp_File_Options,
1800 From_List => Attribute.Value.Values,
1801 In_Tree => Data.Tree);
1805 Attribute_Id := Attribute.Next;
1809 -- Start of processing for Process_Packages
1812 Packages := Project.Decl.Packages;
1813 while Packages /= No_Package loop
1814 Element := Shared.Packages.Table (Packages);
1816 case Element.Name is
1819 -- Process attributes of package Binder
1821 Process_Binder (Element.Decl.Arrays);
1823 when Name_Builder =>
1825 -- Process attributes of package Builder
1827 Process_Builder (Element.Decl.Attributes);
1829 when Name_Compiler =>
1831 -- Process attributes of package Compiler
1833 Process_Compiler (Element.Decl.Arrays);
1837 -- Process attributes of package Linker
1839 Process_Linker (Element.Decl.Attributes);
1843 -- Process attributes of package Naming
1845 Process_Naming (Element.Decl.Attributes);
1846 Process_Naming (Element.Decl.Arrays);
1852 Packages := Element.Next;
1854 end Process_Packages;
1856 ---------------------------------------------
1857 -- Process_Project_Level_Simple_Attributes --
1858 ---------------------------------------------
1860 procedure Process_Project_Level_Simple_Attributes is
1861 Attribute_Id : Variable_Id;
1862 Attribute : Variable;
1863 List : String_List_Id;
1866 -- Process non associated array attribute at project level
1868 Attribute_Id := Project.Decl.Attributes;
1869 while Attribute_Id /= No_Variable loop
1870 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1872 if not Attribute.Value.Default then
1873 if Attribute.Name = Name_Target then
1875 -- Attribute Target: the target specified
1877 Project.Config.Target := Attribute.Value.Value;
1879 elsif Attribute.Name = Name_Library_Builder then
1881 -- Attribute Library_Builder: the application to invoke
1882 -- to build libraries.
1884 Project.Config.Library_Builder :=
1885 Path_Name_Type (Attribute.Value.Value);
1887 elsif Attribute.Name = Name_Archive_Builder then
1889 -- Attribute Archive_Builder: the archive builder
1890 -- (usually "ar") and its minimum options (usually "cr").
1892 List := Attribute.Value.Values;
1894 if List = Nil_String then
1897 "archive builder cannot be null",
1898 Attribute.Value.Location, Project);
1901 Put (Into_List => Project.Config.Archive_Builder,
1903 In_Tree => Data.Tree);
1905 elsif Attribute.Name = Name_Archive_Builder_Append_Option then
1907 -- Attribute Archive_Builder: the archive builder
1908 -- (usually "ar") and its minimum options (usually "cr").
1910 List := Attribute.Value.Values;
1912 if List /= Nil_String then
1915 Project.Config.Archive_Builder_Append_Option,
1917 In_Tree => Data.Tree);
1920 elsif Attribute.Name = Name_Archive_Indexer then
1922 -- Attribute Archive_Indexer: the optional archive
1923 -- indexer (usually "ranlib") with its minimum options
1926 List := Attribute.Value.Values;
1928 if List = Nil_String then
1931 "archive indexer cannot be null",
1932 Attribute.Value.Location, Project);
1935 Put (Into_List => Project.Config.Archive_Indexer,
1937 In_Tree => Data.Tree);
1939 elsif Attribute.Name = Name_Library_Partial_Linker then
1941 -- Attribute Library_Partial_Linker: the optional linker
1942 -- driver with its minimum options, to partially link
1945 List := Attribute.Value.Values;
1947 if List = Nil_String then
1950 "partial linker cannot be null",
1951 Attribute.Value.Location, Project);
1954 Put (Into_List => Project.Config.Lib_Partial_Linker,
1956 In_Tree => Data.Tree);
1958 elsif Attribute.Name = Name_Library_GCC then
1959 Project.Config.Shared_Lib_Driver :=
1960 File_Name_Type (Attribute.Value.Value);
1963 "?Library_'G'C'C is an obsolescent attribute, " &
1964 "use Linker''Driver instead",
1965 Attribute.Value.Location, Project);
1967 elsif Attribute.Name = Name_Archive_Suffix then
1968 Project.Config.Archive_Suffix :=
1969 File_Name_Type (Attribute.Value.Value);
1971 elsif Attribute.Name = Name_Linker_Executable_Option then
1973 -- Attribute Linker_Executable_Option: optional options
1974 -- to specify an executable name. Defaults to "-o".
1976 List := Attribute.Value.Values;
1978 if List = Nil_String then
1981 "linker executable option cannot be null",
1982 Attribute.Value.Location, Project);
1985 Put (Into_List => Project.Config.Linker_Executable_Option,
1987 In_Tree => Data.Tree);
1989 elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
1991 -- Attribute Linker_Lib_Dir_Option: optional options
1992 -- to specify a library search directory. Defaults to
1995 Get_Name_String (Attribute.Value.Value);
1997 if Name_Len = 0 then
2000 "linker library directory option cannot be empty",
2001 Attribute.Value.Location, Project);
2004 Project.Config.Linker_Lib_Dir_Option :=
2005 Attribute.Value.Value;
2007 elsif Attribute.Name = Name_Linker_Lib_Name_Option then
2009 -- Attribute Linker_Lib_Name_Option: optional options
2010 -- to specify the name of a library to be linked in.
2011 -- Defaults to "-l".
2013 Get_Name_String (Attribute.Value.Value);
2015 if Name_Len = 0 then
2018 "linker library name option cannot be empty",
2019 Attribute.Value.Location, Project);
2022 Project.Config.Linker_Lib_Name_Option :=
2023 Attribute.Value.Value;
2025 elsif Attribute.Name = Name_Run_Path_Option then
2027 -- Attribute Run_Path_Option: optional options to
2028 -- specify a path for libraries.
2030 List := Attribute.Value.Values;
2032 if List /= Nil_String then
2033 Put (Into_List => Project.Config.Run_Path_Option,
2035 In_Tree => Data.Tree);
2038 elsif Attribute.Name = Name_Run_Path_Origin then
2039 Get_Name_String (Attribute.Value.Value);
2041 if Name_Len = 0 then
2044 "run path origin cannot be empty",
2045 Attribute.Value.Location, Project);
2048 Project.Config.Run_Path_Origin := Attribute.Value.Value;
2050 elsif Attribute.Name = Name_Library_Install_Name_Option then
2051 Project.Config.Library_Install_Name_Option :=
2052 Attribute.Value.Value;
2054 elsif Attribute.Name = Name_Separate_Run_Path_Options then
2056 pragma Unsuppress (All_Checks);
2058 Project.Config.Separate_Run_Path_Options :=
2059 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2061 when Constraint_Error =>
2064 "invalid value """ &
2065 Get_Name_String (Attribute.Value.Value) &
2066 """ for Separate_Run_Path_Options",
2067 Attribute.Value.Location, Project);
2070 elsif Attribute.Name = Name_Library_Support then
2072 pragma Unsuppress (All_Checks);
2074 Project.Config.Lib_Support :=
2075 Library_Support'Value (Get_Name_String
2076 (Attribute.Value.Value));
2078 when Constraint_Error =>
2081 "invalid value """ &
2082 Get_Name_String (Attribute.Value.Value) &
2083 """ for Library_Support",
2084 Attribute.Value.Location, Project);
2088 Attribute.Name = Name_Library_Encapsulated_Supported
2091 pragma Unsuppress (All_Checks);
2093 Project.Config.Lib_Encapsulated_Supported :=
2094 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2096 when Constraint_Error =>
2100 & Get_Name_String (Attribute.Value.Value)
2101 & """ for Library_Encapsulated_Supported",
2102 Attribute.Value.Location, Project);
2105 elsif Attribute.Name = Name_Shared_Library_Prefix then
2106 Project.Config.Shared_Lib_Prefix :=
2107 File_Name_Type (Attribute.Value.Value);
2109 elsif Attribute.Name = Name_Shared_Library_Suffix then
2110 Project.Config.Shared_Lib_Suffix :=
2111 File_Name_Type (Attribute.Value.Value);
2113 elsif Attribute.Name = Name_Symbolic_Link_Supported then
2115 pragma Unsuppress (All_Checks);
2117 Project.Config.Symbolic_Link_Supported :=
2118 Boolean'Value (Get_Name_String
2119 (Attribute.Value.Value));
2121 when Constraint_Error =>
2125 & Get_Name_String (Attribute.Value.Value)
2126 & """ for Symbolic_Link_Supported",
2127 Attribute.Value.Location, Project);
2131 Attribute.Name = Name_Library_Major_Minor_Id_Supported
2134 pragma Unsuppress (All_Checks);
2136 Project.Config.Lib_Maj_Min_Id_Supported :=
2137 Boolean'Value (Get_Name_String
2138 (Attribute.Value.Value));
2140 when Constraint_Error =>
2143 "invalid value """ &
2144 Get_Name_String (Attribute.Value.Value) &
2145 """ for Library_Major_Minor_Id_Supported",
2146 Attribute.Value.Location, Project);
2149 elsif Attribute.Name = Name_Library_Auto_Init_Supported then
2151 pragma Unsuppress (All_Checks);
2153 Project.Config.Auto_Init_Supported :=
2154 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2156 when Constraint_Error =>
2160 & Get_Name_String (Attribute.Value.Value)
2161 & """ for Library_Auto_Init_Supported",
2162 Attribute.Value.Location, Project);
2165 elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
2166 List := Attribute.Value.Values;
2168 if List /= Nil_String then
2169 Put (Into_List => Project.Config.Shared_Lib_Min_Options,
2171 In_Tree => Data.Tree);
2174 elsif Attribute.Name = Name_Library_Version_Switches then
2175 List := Attribute.Value.Values;
2177 if List /= Nil_String then
2178 Put (Into_List => Project.Config.Lib_Version_Options,
2180 In_Tree => Data.Tree);
2185 Attribute_Id := Attribute.Next;
2187 end Process_Project_Level_Simple_Attributes;
2189 --------------------------------------------
2190 -- Process_Project_Level_Array_Attributes --
2191 --------------------------------------------
2193 procedure Process_Project_Level_Array_Attributes is
2194 Current_Array_Id : Array_Id;
2195 Current_Array : Array_Data;
2196 Element_Id : Array_Element_Id;
2197 Element : Array_Element;
2198 List : String_List_Id;
2201 -- Process the associative array attributes at project level
2203 Current_Array_Id := Project.Decl.Arrays;
2204 while Current_Array_Id /= No_Array loop
2205 Current_Array := Shared.Arrays.Table (Current_Array_Id);
2207 Element_Id := Current_Array.Value;
2208 while Element_Id /= No_Array_Element loop
2209 Element := Shared.Array_Elements.Table (Element_Id);
2211 -- Get the name of the language
2214 Get_Language_From_Name
2215 (Project, Get_Name_String (Element.Index));
2217 if Lang_Index /= No_Language_Index then
2218 case Current_Array.Name is
2219 when Name_Inherit_Source_Path =>
2220 List := Element.Value.Values;
2222 if List /= Nil_String then
2225 Lang_Index.Config.Include_Compatible_Languages,
2227 In_Tree => Data.Tree,
2228 Lower_Case => True);
2231 when Name_Toolchain_Description =>
2233 -- Attribute Toolchain_Description (<language>)
2235 Lang_Index.Config.Toolchain_Description :=
2236 Element.Value.Value;
2238 when Name_Toolchain_Version =>
2240 -- Attribute Toolchain_Version (<language>)
2242 Lang_Index.Config.Toolchain_Version :=
2243 Element.Value.Value;
2245 -- For Ada, set proper checksum computation mode
2247 if Lang_Index.Name = Name_Ada then
2249 Vers : constant String :=
2250 Get_Name_String (Element.Value.Value);
2251 pragma Assert (Vers'First = 1);
2254 -- Version 6.3 or earlier
2257 and then Vers (1 .. 5) = "GNAT "
2258 and then Vers (7) = '.'
2262 (Vers (6) = '6' and then Vers (8) < '4'))
2264 Checksum_GNAT_6_3 := True;
2266 -- Version 5.03 or earlier
2269 or else (Vers (6) = '5'
2270 and then Vers (Vers'Last) < '4')
2272 Checksum_GNAT_5_03 := True;
2274 -- Version 5.02 or earlier
2277 or else Vers (Vers'Last) < '3'
2279 Checksum_Accumulate_Token_Checksum :=
2287 when Name_Runtime_Library_Dir =>
2289 -- Attribute Runtime_Library_Dir (<language>)
2291 Lang_Index.Config.Runtime_Library_Dir :=
2292 Element.Value.Value;
2294 when Name_Runtime_Source_Dir =>
2296 -- Attribute Runtime_Source_Dir (<language>)
2298 Lang_Index.Config.Runtime_Source_Dir :=
2299 Element.Value.Value;
2301 when Name_Object_Generated =>
2303 pragma Unsuppress (All_Checks);
2309 (Get_Name_String (Element.Value.Value));
2311 Lang_Index.Config.Object_Generated := Value;
2313 -- If no object is generated, no object may be
2317 Lang_Index.Config.Objects_Linked := False;
2321 when Constraint_Error =>
2325 & Get_Name_String (Element.Value.Value)
2326 & """ for Object_Generated",
2327 Element.Value.Location, Project);
2330 when Name_Objects_Linked =>
2332 pragma Unsuppress (All_Checks);
2338 (Get_Name_String (Element.Value.Value));
2340 -- No change if Object_Generated is False, as this
2341 -- forces Objects_Linked to be False too.
2343 if Lang_Index.Config.Object_Generated then
2344 Lang_Index.Config.Objects_Linked := Value;
2348 when Constraint_Error =>
2352 & Get_Name_String (Element.Value.Value)
2353 & """ for Objects_Linked",
2354 Element.Value.Location, Project);
2361 Element_Id := Element.Next;
2364 Current_Array_Id := Current_Array.Next;
2366 end Process_Project_Level_Array_Attributes;
2368 -- Start of processing for Check_Configuration
2371 Process_Project_Level_Simple_Attributes;
2372 Process_Project_Level_Array_Attributes;
2375 -- For unit based languages, set Casing, Dot_Replacement and
2376 -- Separate_Suffix in Naming_Data.
2378 Lang_Index := Project.Languages;
2379 while Lang_Index /= No_Language_Index loop
2380 if Lang_Index.Config.Kind = Unit_Based then
2381 Lang_Index.Config.Naming_Data.Casing := Casing;
2382 Lang_Index.Config.Naming_Data.Dot_Replacement := Dot_Replacement;
2384 if Separate_Suffix /= No_File then
2385 Lang_Index.Config.Naming_Data.Separate_Suffix :=
2392 Lang_Index := Lang_Index.Next;
2395 -- Give empty names to various prefixes/suffixes, if they have not
2396 -- been specified in the configuration.
2398 if Project.Config.Archive_Suffix = No_File then
2399 Project.Config.Archive_Suffix := Empty_File;
2402 if Project.Config.Shared_Lib_Prefix = No_File then
2403 Project.Config.Shared_Lib_Prefix := Empty_File;
2406 if Project.Config.Shared_Lib_Suffix = No_File then
2407 Project.Config.Shared_Lib_Suffix := Empty_File;
2410 Lang_Index := Project.Languages;
2411 while Lang_Index /= No_Language_Index loop
2413 -- For all languages, Compiler_Driver needs to be specified. This is
2414 -- only needed if we do intend to compile (not in GPS for instance).
2416 if Data.Flags.Compiler_Driver_Mandatory
2417 and then Lang_Index.Config.Compiler_Driver = No_File
2419 Error_Msg_Name_1 := Lang_Index.Display_Name;
2422 "?no compiler specified for language %%" &
2423 ", ignoring all its sources",
2424 No_Location, Project);
2426 if Lang_Index = Project.Languages then
2427 Project.Languages := Lang_Index.Next;
2429 Prev_Index.Next := Lang_Index.Next;
2432 elsif Lang_Index.Config.Kind = Unit_Based then
2433 Prev_Index := Lang_Index;
2435 -- For unit based languages, Dot_Replacement, Spec_Suffix and
2436 -- Body_Suffix need to be specified.
2438 if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then
2441 "Dot_Replacement not specified for " &
2442 Get_Name_String (Lang_Index.Name),
2443 No_Location, Project);
2446 if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
2449 "Spec_Suffix not specified for " &
2450 Get_Name_String (Lang_Index.Name),
2451 No_Location, Project);
2454 if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
2457 "Body_Suffix not specified for " &
2458 Get_Name_String (Lang_Index.Name),
2459 No_Location, Project);
2463 Prev_Index := Lang_Index;
2465 -- For file based languages, either Spec_Suffix or Body_Suffix
2466 -- need to be specified.
2468 if Data.Flags.Require_Sources_Other_Lang
2469 and then Lang_Index.Config.Naming_Data.Spec_Suffix = No_File
2470 and then Lang_Index.Config.Naming_Data.Body_Suffix = No_File
2472 Error_Msg_Name_1 := Lang_Index.Display_Name;
2475 "no suffixes specified for %%",
2476 No_Location, Project);
2480 Lang_Index := Lang_Index.Next;
2482 end Check_Configuration;
2484 -------------------------------
2485 -- Check_If_Externally_Built --
2486 -------------------------------
2488 procedure Check_If_Externally_Built
2489 (Project : Project_Id;
2490 Data : in out Tree_Processing_Data)
2492 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
2493 Externally_Built : constant Variable_Value :=
2495 (Name_Externally_Built,
2496 Project.Decl.Attributes, Shared);
2499 if not Externally_Built.Default then
2500 Get_Name_String (Externally_Built.Value);
2501 To_Lower (Name_Buffer (1 .. Name_Len));
2503 if Name_Buffer (1 .. Name_Len) = "true" then
2504 Project.Externally_Built := True;
2506 elsif Name_Buffer (1 .. Name_Len) /= "false" then
2507 Error_Msg (Data.Flags,
2508 "Externally_Built may only be true or false",
2509 Externally_Built.Location, Project);
2513 -- A virtual project extending an externally built project is itself
2514 -- externally built.
2516 if Project.Virtual and then Project.Extends /= No_Project then
2517 Project.Externally_Built := Project.Extends.Externally_Built;
2520 if Project.Externally_Built then
2521 Debug_Output ("project is externally built");
2523 Debug_Output ("project is not externally built");
2525 end Check_If_Externally_Built;
2527 ----------------------
2528 -- Check_Interfaces --
2529 ----------------------
2531 procedure Check_Interfaces
2532 (Project : Project_Id;
2533 Data : in out Tree_Processing_Data)
2535 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
2537 Interfaces : constant Prj.Variable_Value :=
2539 (Snames.Name_Interfaces,
2540 Project.Decl.Attributes,
2543 Library_Interface : constant Prj.Variable_Value :=
2545 (Snames.Name_Library_Interface,
2546 Project.Decl.Attributes,
2549 List : String_List_Id;
2550 Element : String_Element;
2551 Name : File_Name_Type;
2552 Iter : Source_Iterator;
2554 Project_2 : Project_Id;
2556 Unit_Found : Boolean;
2558 Interface_ALIs : String_List_Id := Nil_String;
2561 if not Interfaces.Default then
2563 -- Set In_Interfaces to False for all sources. It will be set to True
2564 -- later for the sources in the Interfaces list.
2566 Project_2 := Project;
2567 while Project_2 /= No_Project loop
2568 Iter := For_Each_Source (Data.Tree, Project_2);
2570 Source := Prj.Element (Iter);
2571 exit when Source = No_Source;
2572 Source.In_Interfaces := False;
2576 Project_2 := Project_2.Extends;
2579 List := Interfaces.Values;
2580 while List /= Nil_String loop
2581 Element := Shared.String_Elements.Table (List);
2582 Name := Canonical_Case_File_Name (Element.Value);
2584 Project_2 := Project;
2585 Big_Loop : while Project_2 /= No_Project loop
2586 if Project.Qualifier = Aggregate_Library then
2588 -- For an aggregate library we want to consider sources of
2589 -- all aggregated projects.
2591 Iter := For_Each_Source (Data.Tree);
2594 Iter := For_Each_Source (Data.Tree, Project_2);
2598 Source := Prj.Element (Iter);
2599 exit when Source = No_Source;
2601 if Source.File = Name then
2602 if not Source.Locally_Removed then
2603 Source.In_Interfaces := True;
2604 Source.Declared_In_Interfaces := True;
2606 Other := Other_Part (Source);
2608 if Other /= No_Source then
2609 Other.In_Interfaces := True;
2610 Other.Declared_In_Interfaces := True;
2613 if Source.Language.Config.Kind = Unit_Based then
2614 if Source.Kind = Spec
2615 and then Other_Part (Source) /= No_Source
2617 Source := Other_Part (Source);
2620 String_Element_Table.Increment_Last
2621 (Shared.String_Elements);
2623 Shared.String_Elements.Table
2624 (String_Element_Table.Last
2625 (Shared.String_Elements)) :=
2626 (Value => Name_Id (Source.Dep_Name),
2628 Display_Value => Name_Id (Source.Dep_Name),
2629 Location => No_Location,
2631 Next => Interface_ALIs);
2634 String_Element_Table.Last
2635 (Shared.String_Elements);
2639 ("interface: ", Name_Id (Source.Path.Name));
2648 Project_2 := Project_2.Extends;
2651 if Source = No_Source then
2652 Error_Msg_File_1 := File_Name_Type (Element.Value);
2653 Error_Msg_Name_1 := Project.Name;
2657 "{ cannot be an interface of project %% "
2658 & "as it is not one of its sources",
2659 Element.Location, Project);
2662 List := Element.Next;
2665 Project.Interfaces_Defined := True;
2666 Project.Lib_Interface_ALIs := Interface_ALIs;
2668 elsif Project.Library and then not Library_Interface.Default then
2670 -- Set In_Interfaces to False for all sources. It will be set to True
2671 -- later for the sources in the Library_Interface list.
2673 Project_2 := Project;
2674 while Project_2 /= No_Project loop
2675 Iter := For_Each_Source (Data.Tree, Project_2);
2677 Source := Prj.Element (Iter);
2678 exit when Source = No_Source;
2679 Source.In_Interfaces := False;
2683 Project_2 := Project_2.Extends;
2686 List := Library_Interface.Values;
2687 while List /= Nil_String loop
2688 Element := Shared.String_Elements.Table (List);
2689 Get_Name_String (Element.Value);
2690 To_Lower (Name_Buffer (1 .. Name_Len));
2692 Unit_Found := False;
2694 Project_2 := Project;
2695 Big_Loop_2 : while Project_2 /= No_Project loop
2696 if Project.Qualifier = Aggregate_Library then
2698 -- For an aggregate library we want to consider sources of
2699 -- all aggregated projects.
2701 Iter := For_Each_Source (Data.Tree);
2704 Iter := For_Each_Source (Data.Tree, Project_2);
2708 Source := Prj.Element (Iter);
2709 exit when Source = No_Source;
2711 if Source.Unit /= No_Unit_Index
2712 and then Source.Unit.Name = Name_Id (Name)
2714 if not Source.Locally_Removed then
2715 Source.In_Interfaces := True;
2716 Source.Declared_In_Interfaces := True;
2717 Project.Interfaces_Defined := True;
2719 Other := Other_Part (Source);
2721 if Other /= No_Source then
2722 Other.In_Interfaces := True;
2723 Other.Declared_In_Interfaces := True;
2727 ("interface: ", Name_Id (Source.Path.Name));
2729 if Source.Kind = Spec
2730 and then Other_Part (Source) /= No_Source
2732 Source := Other_Part (Source);
2735 String_Element_Table.Increment_Last
2736 (Shared.String_Elements);
2738 Shared.String_Elements.Table
2739 (String_Element_Table.Last
2740 (Shared.String_Elements)) :=
2741 (Value => Name_Id (Source.Dep_Name),
2743 Display_Value => Name_Id (Source.Dep_Name),
2744 Location => No_Location,
2746 Next => Interface_ALIs);
2749 String_Element_Table.Last (Shared.String_Elements);
2759 Project_2 := Project_2.Extends;
2760 end loop Big_Loop_2;
2762 if not Unit_Found then
2763 Error_Msg_Name_1 := Name_Id (Name);
2767 "%% is not a unit of this project",
2768 Element.Location, Project);
2771 List := Element.Next;
2774 Project.Lib_Interface_ALIs := Interface_ALIs;
2776 elsif Project.Extends /= No_Project
2777 and then Project.Extends.Interfaces_Defined
2779 Project.Interfaces_Defined := True;
2781 Iter := For_Each_Source (Data.Tree, Project);
2783 Source := Prj.Element (Iter);
2784 exit when Source = No_Source;
2786 if not Source.Declared_In_Interfaces then
2787 Source.In_Interfaces := False;
2793 Project.Lib_Interface_ALIs := Project.Extends.Lib_Interface_ALIs;
2795 end Check_Interfaces;
2797 ------------------------------
2798 -- Check_Library_Attributes --
2799 ------------------------------
2801 -- This procedure is awfully long (over 700 lines) should be broken up???
2803 procedure Check_Library_Attributes
2804 (Project : Project_Id;
2805 Data : in out Tree_Processing_Data)
2807 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
2809 Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
2811 Lib_Dir : constant Prj.Variable_Value :=
2813 (Snames.Name_Library_Dir, Attributes, Shared);
2815 Lib_Name : constant Prj.Variable_Value :=
2817 (Snames.Name_Library_Name, Attributes, Shared);
2819 Lib_Standalone : constant Prj.Variable_Value :=
2821 (Snames.Name_Library_Standalone,
2822 Attributes, Shared);
2824 Lib_Version : constant Prj.Variable_Value :=
2826 (Snames.Name_Library_Version, Attributes, Shared);
2828 Lib_ALI_Dir : constant Prj.Variable_Value :=
2830 (Snames.Name_Library_Ali_Dir, Attributes, Shared);
2832 Lib_GCC : constant Prj.Variable_Value :=
2834 (Snames.Name_Library_GCC, Attributes, Shared);
2836 The_Lib_Kind : constant Prj.Variable_Value :=
2838 (Snames.Name_Library_Kind, Attributes, Shared);
2840 Imported_Project_List : Project_List;
2841 Continuation : String_Access := No_Continuation_String'Access;
2842 Support_For_Libraries : Library_Support;
2844 Library_Directory_Present : Boolean;
2846 procedure Check_Library (Proj : Project_Id; Extends : Boolean);
2847 -- Check if an imported or extended project if also a library project
2853 procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
2855 Iter : Source_Iterator;
2858 if Proj /= No_Project then
2859 if not Proj.Library then
2861 -- The only not library projects that are OK are those that
2862 -- have no sources. However, header files from non-Ada
2863 -- languages are OK, as there is nothing to compile.
2865 Iter := For_Each_Source (Data.Tree, Proj);
2867 Src_Id := Prj.Element (Iter);
2868 exit when Src_Id = No_Source
2869 or else Src_Id.Language.Config.Kind /= File_Based
2870 or else Src_Id.Kind /= Spec;
2874 if Src_Id /= No_Source then
2875 Error_Msg_Name_1 := Project.Name;
2876 Error_Msg_Name_2 := Proj.Name;
2879 if Project.Library_Kind /= Static then
2883 "shared library project %% cannot extend " &
2884 "project %% that is not a library project",
2885 Project.Location, Project);
2886 Continuation := Continuation_String'Access;
2889 elsif not Unchecked_Shared_Lib_Imports
2890 and then Project.Library_Kind /= Static
2895 "shared library project %% cannot import project %% " &
2896 "that is not a shared library project",
2897 Project.Location, Project);
2898 Continuation := Continuation_String'Access;
2902 elsif Project.Library_Kind /= Static
2903 and then not Lib_Standalone.Default
2904 and then Get_Name_String (Lib_Standalone.Value) = "encapsulated"
2905 and then Proj.Library_Kind /= Static
2907 -- An encapsulated library must depend only on static libraries
2909 Error_Msg_Name_1 := Project.Name;
2910 Error_Msg_Name_2 := Proj.Name;
2915 "encapsulated library project %% cannot import shared " &
2916 "library project %%",
2917 Project.Location, Project);
2918 Continuation := Continuation_String'Access;
2920 elsif Project.Library_Kind /= Static
2921 and then Proj.Library_Kind = Static
2923 (Lib_Standalone.Default
2925 Get_Name_String (Lib_Standalone.Value) /= "encapsulated")
2927 Error_Msg_Name_1 := Project.Name;
2928 Error_Msg_Name_2 := Proj.Name;
2934 "shared library project %% cannot extend static " &
2935 "library project %%",
2936 Project.Location, Project);
2937 Continuation := Continuation_String'Access;
2939 elsif not Unchecked_Shared_Lib_Imports then
2943 "shared library project %% cannot import static " &
2944 "library project %%",
2945 Project.Location, Project);
2946 Continuation := Continuation_String'Access;
2953 Dir_Exists : Boolean;
2955 -- Start of processing for Check_Library_Attributes
2958 Library_Directory_Present := Lib_Dir.Value /= Empty_String;
2960 -- Special case of extending project
2962 if Project.Extends /= No_Project then
2964 -- If the project extended is a library project, we inherit the
2965 -- library name, if it is not redefined; we check that the library
2966 -- directory is specified.
2968 if Project.Extends.Library then
2969 if Project.Qualifier = Standard then
2972 "a standard project cannot extend a library project",
2973 Project.Location, Project);
2976 if Lib_Name.Default then
2977 Project.Library_Name := Project.Extends.Library_Name;
2980 if Lib_Dir.Default then
2981 if not Project.Virtual then
2984 "a project extending a library project must " &
2985 "specify an attribute Library_Dir",
2986 Project.Location, Project);
2989 -- For a virtual project extending a library project,
2990 -- inherit library directory and library kind.
2992 Project.Library_Dir := Project.Extends.Library_Dir;
2993 Library_Directory_Present := True;
2994 Project.Library_Kind := Project.Extends.Library_Kind;
3001 pragma Assert (Lib_Name.Kind = Single);
3003 if Lib_Name.Value = Empty_String then
3004 if Current_Verbosity = High
3005 and then Project.Library_Name = No_Name
3008 Write_Line ("no library name");
3012 -- There is no restriction on the syntax of library names
3014 Project.Library_Name := Lib_Name.Value;
3017 if Project.Library_Name /= No_Name then
3018 if Current_Verbosity = High then
3020 ("Library name: ", Get_Name_String (Project.Library_Name));
3023 pragma Assert (Lib_Dir.Kind = Single);
3025 if not Library_Directory_Present then
3026 Debug_Output ("no library directory");
3029 -- Find path name (unless inherited), check that it is a directory
3031 if Project.Library_Dir = No_Path_Information then
3034 File_Name_Type (Lib_Dir.Value),
3035 Path => Project.Library_Dir,
3036 Dir_Exists => Dir_Exists,
3038 Create => "library",
3039 Must_Exist => False,
3040 Location => Lib_Dir.Location,
3041 Externally_Built => Project.Externally_Built);
3046 (Get_Name_String (Project.Library_Dir.Display_Name));
3049 if not Dir_Exists then
3051 -- Get the absolute name of the library directory that
3052 -- does not exist, to report an error.
3054 Err_Vars.Error_Msg_File_1 :=
3055 File_Name_Type (Project.Library_Dir.Display_Name);
3058 "library directory { does not exist",
3059 Lib_Dir.Location, Project);
3061 -- Checks for object/source directories
3063 elsif not Project.Externally_Built
3065 -- An aggregate library does not have sources or objects, so
3066 -- these tests are not required in this case.
3068 and then Project.Qualifier /= Aggregate_Library
3070 -- Library directory cannot be the same as Object directory
3072 if Project.Library_Dir.Name = Project.Object_Directory.Name then
3075 "library directory cannot be the same " &
3076 "as object directory",
3077 Lib_Dir.Location, Project);
3078 Project.Library_Dir := No_Path_Information;
3082 OK : Boolean := True;
3083 Dirs_Id : String_List_Id;
3084 Dir_Elem : String_Element;
3088 -- The library directory cannot be the same as a source
3089 -- directory of the current project.
3091 Dirs_Id := Project.Source_Dirs;
3092 while Dirs_Id /= Nil_String loop
3093 Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
3094 Dirs_Id := Dir_Elem.Next;
3096 if Project.Library_Dir.Name =
3097 Path_Name_Type (Dir_Elem.Value)
3099 Err_Vars.Error_Msg_File_1 :=
3100 File_Name_Type (Dir_Elem.Value);
3103 "library directory cannot be the same " &
3104 "as source directory {",
3105 Lib_Dir.Location, Project);
3113 -- The library directory cannot be the same as a
3114 -- source directory of another project either.
3116 Pid := Data.Tree.Projects;
3118 exit Project_Loop when Pid = null;
3120 if Pid.Project /= Project then
3121 Dirs_Id := Pid.Project.Source_Dirs;
3123 Dir_Loop : while Dirs_Id /= Nil_String loop
3125 Shared.String_Elements.Table (Dirs_Id);
3126 Dirs_Id := Dir_Elem.Next;
3128 if Project.Library_Dir.Name =
3129 Path_Name_Type (Dir_Elem.Value)
3131 Err_Vars.Error_Msg_File_1 :=
3132 File_Name_Type (Dir_Elem.Value);
3133 Err_Vars.Error_Msg_Name_1 :=
3138 "library directory cannot be the same" &
3139 " as source directory { of project %%",
3140 Lib_Dir.Location, Project);
3148 end loop Project_Loop;
3152 Project.Library_Dir := No_Path_Information;
3154 elsif Current_Verbosity = High then
3156 -- Display the Library directory in high verbosity
3159 ("Library directory",
3160 Get_Name_String (Project.Library_Dir.Display_Name));
3170 Project.Library_Dir /= No_Path_Information
3171 and then Project.Library_Name /= No_Name;
3173 if Project.Extends = No_Project then
3174 case Project.Qualifier is
3176 if Project.Library then
3179 "a standard project cannot be a library project",
3180 Lib_Name.Location, Project);
3183 when Library | Aggregate_Library =>
3184 if not Project.Library then
3185 if Project.Library_Name = No_Name then
3188 "attribute Library_Name not declared",
3189 Project.Location, Project);
3191 if not Library_Directory_Present then
3194 "\attribute Library_Dir not declared",
3195 Project.Location, Project);
3198 elsif Project.Library_Dir = No_Path_Information then
3201 "attribute Library_Dir not declared",
3202 Project.Location, Project);
3211 if Project.Library then
3212 Support_For_Libraries := Project.Config.Lib_Support;
3214 if Support_For_Libraries = Prj.None then
3217 "?libraries are not supported on this platform",
3218 Lib_Name.Location, Project);
3219 Project.Library := False;
3222 if Lib_ALI_Dir.Value = Empty_String then
3223 Debug_Output ("no library ALI directory specified");
3224 Project.Library_ALI_Dir := Project.Library_Dir;
3227 -- Find path name, check that it is a directory
3231 File_Name_Type (Lib_ALI_Dir.Value),
3232 Path => Project.Library_ALI_Dir,
3233 Create => "library ALI",
3234 Dir_Exists => Dir_Exists,
3236 Must_Exist => False,
3237 Location => Lib_ALI_Dir.Location,
3238 Externally_Built => Project.Externally_Built);
3240 if not Dir_Exists then
3242 -- Get the absolute name of the library ALI directory that
3243 -- does not exist, to report an error.
3245 Err_Vars.Error_Msg_File_1 :=
3246 File_Name_Type (Project.Library_ALI_Dir.Display_Name);
3249 "library 'A'L'I directory { does not exist",
3250 Lib_ALI_Dir.Location, Project);
3253 if not Project.Externally_Built
3254 and then Project.Library_ALI_Dir /= Project.Library_Dir
3256 -- The library ALI directory cannot be the same as the
3257 -- Object directory.
3259 if Project.Library_ALI_Dir = Project.Object_Directory then
3262 "library 'A'L'I directory cannot be the same " &
3263 "as object directory",
3264 Lib_ALI_Dir.Location, Project);
3265 Project.Library_ALI_Dir := No_Path_Information;
3269 OK : Boolean := True;
3270 Dirs_Id : String_List_Id;
3271 Dir_Elem : String_Element;
3275 -- The library ALI directory cannot be the same as
3276 -- a source directory of the current project.
3278 Dirs_Id := Project.Source_Dirs;
3279 while Dirs_Id /= Nil_String loop
3280 Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
3281 Dirs_Id := Dir_Elem.Next;
3283 if Project.Library_ALI_Dir.Name =
3284 Path_Name_Type (Dir_Elem.Value)
3286 Err_Vars.Error_Msg_File_1 :=
3287 File_Name_Type (Dir_Elem.Value);
3290 "library 'A'L'I directory cannot be " &
3291 "the same as source directory {",
3292 Lib_ALI_Dir.Location, Project);
3300 -- The library ALI directory cannot be the same as
3301 -- a source directory of another project either.
3303 Pid := Data.Tree.Projects;
3304 ALI_Project_Loop : loop
3305 exit ALI_Project_Loop when Pid = null;
3307 if Pid.Project /= Project then
3308 Dirs_Id := Pid.Project.Source_Dirs;
3311 while Dirs_Id /= Nil_String loop
3313 Shared.String_Elements.Table (Dirs_Id);
3314 Dirs_Id := Dir_Elem.Next;
3316 if Project.Library_ALI_Dir.Name =
3317 Path_Name_Type (Dir_Elem.Value)
3319 Err_Vars.Error_Msg_File_1 :=
3320 File_Name_Type (Dir_Elem.Value);
3321 Err_Vars.Error_Msg_Name_1 :=
3326 "library 'A'L'I directory cannot " &
3327 "be the same as source directory " &
3329 Lib_ALI_Dir.Location, Project);
3331 exit ALI_Project_Loop;
3333 end loop ALI_Dir_Loop;
3336 end loop ALI_Project_Loop;
3340 Project.Library_ALI_Dir := No_Path_Information;
3342 elsif Current_Verbosity = High then
3344 -- Display Library ALI directory in high verbosity
3349 (Project.Library_ALI_Dir.Display_Name));
3356 pragma Assert (Lib_Version.Kind = Single);
3358 if Lib_Version.Value = Empty_String then
3359 Debug_Output ("no library version specified");
3362 Project.Lib_Internal_Name := Lib_Version.Value;
3365 pragma Assert (The_Lib_Kind.Kind = Single);
3367 if The_Lib_Kind.Value = Empty_String then
3368 Debug_Output ("no library kind specified");
3371 Get_Name_String (The_Lib_Kind.Value);
3374 Kind_Name : constant String :=
3375 To_Lower (Name_Buffer (1 .. Name_Len));
3377 OK : Boolean := True;
3380 if Kind_Name = "static" then
3381 Project.Library_Kind := Static;
3383 elsif Kind_Name = "dynamic" then
3384 Project.Library_Kind := Dynamic;
3386 elsif Kind_Name = "relocatable" then
3387 Project.Library_Kind := Relocatable;
3392 "illegal value for Library_Kind",
3393 The_Lib_Kind.Location, Project);
3397 if Current_Verbosity = High and then OK then
3398 Write_Attr ("Library kind", Kind_Name);
3401 if Project.Library_Kind /= Static then
3402 if Support_For_Libraries = Prj.Static_Only then
3405 "only static libraries are supported " &
3407 The_Lib_Kind.Location, Project);
3408 Project.Library := False;
3411 -- Check if (obsolescent) attribute Library_GCC or
3412 -- Linker'Driver is declared.
3414 if Lib_GCC.Value /= Empty_String then
3417 "?Library_'G'C'C is an obsolescent attribute, " &
3418 "use Linker''Driver instead",
3419 Lib_GCC.Location, Project);
3420 Project.Config.Shared_Lib_Driver :=
3421 File_Name_Type (Lib_GCC.Value);
3425 Linker : constant Package_Id :=
3428 Project.Decl.Packages,
3430 Driver : constant Variable_Value :=
3433 Attribute_Or_Array_Name =>
3435 In_Package => Linker,
3439 if Driver /= Nil_Variable_Value
3440 and then Driver.Value /= Empty_String
3442 Project.Config.Shared_Lib_Driver :=
3443 File_Name_Type (Driver.Value);
3453 and then Project.Qualifier /= Aggregate_Library
3455 Debug_Output ("this is a library project file");
3457 Check_Library (Project.Extends, Extends => True);
3459 Imported_Project_List := Project.Imported_Projects;
3460 while Imported_Project_List /= null loop
3462 (Imported_Project_List.Project,
3464 Imported_Project_List := Imported_Project_List.Next;
3470 -- Check if Linker'Switches or Linker'Default_Switches are declared.
3471 -- Warn if they are declared, as it is a common error to think that
3472 -- library are "linked" with Linker switches.
3474 if Project.Library then
3476 Linker_Package_Id : constant Package_Id :=
3479 Project.Decl.Packages, Shared);
3480 Linker_Package : Package_Element;
3481 Switches : Array_Element_Id := No_Array_Element;
3484 if Linker_Package_Id /= No_Package then
3485 Linker_Package := Shared.Packages.Table (Linker_Package_Id);
3489 (Name => Name_Switches,
3490 In_Arrays => Linker_Package.Decl.Arrays,
3493 if Switches = No_Array_Element then
3496 (Name => Name_Default_Switches,
3497 In_Arrays => Linker_Package.Decl.Arrays,
3501 if Switches /= No_Array_Element then
3504 "?Linker switches not taken into account in library " &
3506 No_Location, Project);
3512 if Project.Extends /= No_Project and then Project.Extends.Library then
3514 -- Remove the library name from Lib_Data_Table
3516 for J in 1 .. Lib_Data_Table.Last loop
3517 if Lib_Data_Table.Table (J).Proj = Project.Extends then
3518 Lib_Data_Table.Table (J) :=
3519 Lib_Data_Table.Table (Lib_Data_Table.Last);
3520 Lib_Data_Table.Set_Last (Lib_Data_Table.Last - 1);
3526 if Project.Library and then not Lib_Name.Default then
3528 -- Check if the same library name is used in an other library project
3530 for J in 1 .. Lib_Data_Table.Last loop
3531 if Lib_Data_Table.Table (J).Name = Project.Library_Name then
3532 Error_Msg_Name_1 := Lib_Data_Table.Table (J).Proj.Name;
3535 "Library name cannot be the same as in project %%",
3536 Lib_Name.Location, Project);
3537 Project.Library := False;
3543 if Project.Library and not Data.In_Aggregate_Lib then
3545 -- Record the library name
3547 Lib_Data_Table.Append
3548 ((Name => Project.Library_Name, Proj => Project));
3550 end Check_Library_Attributes;
3552 --------------------------
3553 -- Check_Package_Naming --
3554 --------------------------
3556 procedure Check_Package_Naming
3557 (Project : Project_Id;
3558 Data : in out Tree_Processing_Data)
3560 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
3561 Naming_Id : constant Package_Id :=
3563 (Name_Naming, Project.Decl.Packages, Shared);
3564 Naming : Package_Element;
3566 Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
3568 procedure Check_Naming;
3569 -- Check the validity of the Naming package (suffixes valid, ...)
3571 procedure Check_Common
3572 (Dot_Replacement : in out File_Name_Type;
3573 Casing : in out Casing_Type;
3574 Casing_Defined : out Boolean;
3575 Separate_Suffix : in out File_Name_Type;
3576 Sep_Suffix_Loc : out Source_Ptr);
3577 -- Check attributes common
3579 procedure Process_Exceptions_File_Based
3580 (Lang_Id : Language_Ptr;
3581 Kind : Source_Kind);
3582 procedure Process_Exceptions_Unit_Based
3583 (Lang_Id : Language_Ptr;
3584 Kind : Source_Kind);
3585 -- Process the naming exceptions for the two types of languages
3587 procedure Initialize_Naming_Data;
3588 -- Initialize internal naming data for the various languages
3594 procedure Check_Common
3595 (Dot_Replacement : in out File_Name_Type;
3596 Casing : in out Casing_Type;
3597 Casing_Defined : out Boolean;
3598 Separate_Suffix : in out File_Name_Type;
3599 Sep_Suffix_Loc : out Source_Ptr)
3601 Dot_Repl : constant Variable_Value :=
3603 (Name_Dot_Replacement,
3604 Naming.Decl.Attributes,
3606 Casing_String : constant Variable_Value :=
3609 Naming.Decl.Attributes,
3611 Sep_Suffix : constant Variable_Value :=
3613 (Name_Separate_Suffix,
3614 Naming.Decl.Attributes,
3616 Dot_Repl_Loc : Source_Ptr;
3619 Sep_Suffix_Loc := No_Location;
3621 if not Dot_Repl.Default then
3623 (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
3625 if Length_Of_Name (Dot_Repl.Value) = 0 then
3627 (Data.Flags, "Dot_Replacement cannot be empty",
3628 Dot_Repl.Location, Project);
3631 Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
3632 Dot_Repl_Loc := Dot_Repl.Location;
3635 Repl : constant String := Get_Name_String (Dot_Replacement);
3638 -- Dot_Replacement cannot
3640 -- - start or end with an alphanumeric
3641 -- - be a single '_'
3642 -- - start with an '_' followed by an alphanumeric
3643 -- - contain a '.' except if it is "."
3646 or else Is_Alphanumeric (Repl (Repl'First))
3647 or else Is_Alphanumeric (Repl (Repl'Last))
3648 or else (Repl (Repl'First) = '_'
3652 Is_Alphanumeric (Repl (Repl'First + 1))))
3653 or else (Repl'Length > 1
3655 Index (Source => Repl, Pattern => ".") /= 0)
3660 """ is illegal for Dot_Replacement.",
3661 Dot_Repl_Loc, Project);
3666 if Dot_Replacement /= No_File then
3668 ("Dot_Replacement", Get_Name_String (Dot_Replacement));
3671 Casing_Defined := False;
3673 if not Casing_String.Default then
3675 (Casing_String.Kind = Single, "Casing is not a string");
3678 Casing_Image : constant String :=
3679 Get_Name_String (Casing_String.Value);
3682 if Casing_Image'Length = 0 then
3685 "Casing cannot be an empty string",
3686 Casing_String.Location, Project);
3689 Casing := Value (Casing_Image);
3690 Casing_Defined := True;
3693 when Constraint_Error =>
3694 Name_Len := Casing_Image'Length;
3695 Name_Buffer (1 .. Name_Len) := Casing_Image;
3696 Err_Vars.Error_Msg_Name_1 := Name_Find;
3699 "%% is not a correct Casing",
3700 Casing_String.Location, Project);
3704 Write_Attr ("Casing", Image (Casing));
3706 if not Sep_Suffix.Default then
3707 if Length_Of_Name (Sep_Suffix.Value) = 0 then
3710 "Separate_Suffix cannot be empty",
3711 Sep_Suffix.Location, Project);
3714 Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
3715 Sep_Suffix_Loc := Sep_Suffix.Location;
3717 Check_Illegal_Suffix
3718 (Project, Separate_Suffix,
3719 Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location,
3724 if Separate_Suffix /= No_File then
3726 ("Separate_Suffix", Get_Name_String (Separate_Suffix));
3730 -----------------------------------
3731 -- Process_Exceptions_File_Based --
3732 -----------------------------------
3734 procedure Process_Exceptions_File_Based
3735 (Lang_Id : Language_Ptr;
3738 Lang : constant Name_Id := Lang_Id.Name;
3739 Exceptions : Array_Element_Id;
3740 Exception_List : Variable_Value;
3741 Element_Id : String_List_Id;
3742 Element : String_Element;
3743 File_Name : File_Name_Type;
3751 (Name_Implementation_Exceptions,
3752 In_Arrays => Naming.Decl.Arrays,
3758 (Name_Specification_Exceptions,
3759 In_Arrays => Naming.Decl.Arrays,
3766 In_Array => Exceptions,
3769 if Exception_List /= Nil_Variable_Value then
3770 Element_Id := Exception_List.Values;
3771 while Element_Id /= Nil_String loop
3772 Element := Shared.String_Elements.Table (Element_Id);
3773 File_Name := Canonical_Case_File_Name (Element.Value);
3776 Source_Files_Htable.Get
3777 (Data.Tree.Source_Files_HT, File_Name);
3778 while Source /= No_Source
3779 and then Source.Project /= Project
3781 Source := Source.Next_With_File_Name;
3784 if Source = No_Source then
3789 Source_Dir_Rank => 0,
3792 File_Name => File_Name,
3793 Display_File => File_Name_Type (Element.Value),
3794 Naming_Exception => Yes,
3795 Location => Element.Location);
3798 -- Check if the file name is already recorded for another
3799 -- language or another kind.
3801 if Source.Language /= Lang_Id then
3804 "the same file cannot be a source of two languages",
3805 Element.Location, Project);
3807 elsif Source.Kind /= Kind then
3810 "the same file cannot be a source and a template",
3811 Element.Location, Project);
3814 -- If the file is already recorded for the same
3815 -- language and the same kind, it means that the file
3816 -- name appears several times in the *_Exceptions
3817 -- attribute; so there is nothing to do.
3820 Element_Id := Element.Next;
3823 end Process_Exceptions_File_Based;
3825 -----------------------------------
3826 -- Process_Exceptions_Unit_Based --
3827 -----------------------------------
3829 procedure Process_Exceptions_Unit_Based
3830 (Lang_Id : Language_Ptr;
3833 Exceptions : Array_Element_Id;
3834 Element : Array_Element;
3837 File_Name : File_Name_Type;
3840 Naming_Exception : Naming_Exception_Type;
3848 In_Arrays => Naming.Decl.Arrays,
3851 if Exceptions = No_Array_Element then
3854 (Name_Implementation,
3855 In_Arrays => Naming.Decl.Arrays,
3863 In_Arrays => Naming.Decl.Arrays,
3866 if Exceptions = No_Array_Element then
3869 (Name_Specification,
3870 In_Arrays => Naming.Decl.Arrays,
3875 while Exceptions /= No_Array_Element loop
3876 Element := Shared.Array_Elements.Table (Exceptions);
3878 if Element.Restricted then
3879 Naming_Exception := Inherited;
3881 Naming_Exception := Yes;
3884 File_Name := Canonical_Case_File_Name (Element.Value.Value);
3886 Get_Name_String (Element.Index);
3887 To_Lower (Name_Buffer (1 .. Name_Len));
3888 Index := Element.Value.Index;
3890 -- Check if it is a valid unit name
3892 Get_Name_String (Element.Index);
3893 Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit);
3895 if Unit = No_Name then
3896 Err_Vars.Error_Msg_Name_1 := Element.Index;
3899 "%% is not a valid unit name.",
3900 Element.Value.Location, Project);
3903 if Unit /= No_Name then
3908 Source_Dir_Rank => 0,
3911 File_Name => File_Name,
3912 Display_File => File_Name_Type (Element.Value.Value),
3915 Location => Element.Value.Location,
3916 Naming_Exception => Naming_Exception);
3919 Exceptions := Element.Next;
3921 end Process_Exceptions_Unit_Based;
3927 procedure Check_Naming is
3928 Dot_Replacement : File_Name_Type :=
3930 (First_Name_Id + Character'Pos ('-'));
3931 Separate_Suffix : File_Name_Type := No_File;
3932 Casing : Casing_Type := All_Lower_Case;
3933 Casing_Defined : Boolean;
3934 Lang_Id : Language_Ptr;
3935 Sep_Suffix_Loc : Source_Ptr;
3936 Suffix : Variable_Value;
3941 (Dot_Replacement => Dot_Replacement,
3943 Casing_Defined => Casing_Defined,
3944 Separate_Suffix => Separate_Suffix,
3945 Sep_Suffix_Loc => Sep_Suffix_Loc);
3947 -- For all unit based languages, if any, set the specified value
3948 -- of Dot_Replacement, Casing and/or Separate_Suffix. Do not
3949 -- systematically overwrite, since the defaults come from the
3950 -- configuration file.
3952 if Dot_Replacement /= No_File
3953 or else Casing_Defined
3954 or else Separate_Suffix /= No_File
3956 Lang_Id := Project.Languages;
3957 while Lang_Id /= No_Language_Index loop
3958 if Lang_Id.Config.Kind = Unit_Based then
3959 if Dot_Replacement /= No_File then
3960 Lang_Id.Config.Naming_Data.Dot_Replacement :=
3964 if Casing_Defined then
3965 Lang_Id.Config.Naming_Data.Casing := Casing;
3969 Lang_Id := Lang_Id.Next;
3973 -- Next, get the spec and body suffixes
3975 Lang_Id := Project.Languages;
3976 while Lang_Id /= No_Language_Index loop
3977 Lang := Lang_Id.Name;
3983 Attribute_Or_Array_Name => Name_Spec_Suffix,
3984 In_Package => Naming_Id,
3987 if Suffix = Nil_Variable_Value then
3990 Attribute_Or_Array_Name => Name_Specification_Suffix,
3991 In_Package => Naming_Id,
3995 if Suffix /= Nil_Variable_Value then
3996 Lang_Id.Config.Naming_Data.Spec_Suffix :=
3997 File_Name_Type (Suffix.Value);
3999 Check_Illegal_Suffix
4001 Lang_Id.Config.Naming_Data.Spec_Suffix,
4002 Lang_Id.Config.Naming_Data.Dot_Replacement,
4003 "Spec_Suffix", Suffix.Location, Data);
4007 Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix));
4015 Attribute_Or_Array_Name => Name_Body_Suffix,
4016 In_Package => Naming_Id,
4019 if Suffix = Nil_Variable_Value then
4023 Attribute_Or_Array_Name => Name_Implementation_Suffix,
4024 In_Package => Naming_Id,
4028 if Suffix /= Nil_Variable_Value then
4029 Lang_Id.Config.Naming_Data.Body_Suffix :=
4030 File_Name_Type (Suffix.Value);
4032 -- The default value of separate suffix should be the same as
4033 -- the body suffix, so we need to compute that first.
4035 if Separate_Suffix = No_File then
4036 Lang_Id.Config.Naming_Data.Separate_Suffix :=
4037 Lang_Id.Config.Naming_Data.Body_Suffix;
4041 (Lang_Id.Config.Naming_Data.Separate_Suffix));
4043 Lang_Id.Config.Naming_Data.Separate_Suffix :=
4047 Check_Illegal_Suffix
4049 Lang_Id.Config.Naming_Data.Body_Suffix,
4050 Lang_Id.Config.Naming_Data.Dot_Replacement,
4051 "Body_Suffix", Suffix.Location, Data);
4055 Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix));
4057 elsif Separate_Suffix /= No_File then
4058 Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix;
4061 -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
4062 -- since that would cause a clear ambiguity. Note that we do allow
4063 -- a Spec_Suffix to have the same termination as one of these,
4064 -- which causes a potential ambiguity, but we resolve that by
4065 -- matching the longest possible suffix.
4067 if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
4068 and then Lang_Id.Config.Naming_Data.Spec_Suffix =
4069 Lang_Id.Config.Naming_Data.Body_Suffix
4074 & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)
4075 & """) cannot be the same as Spec_Suffix.",
4076 Ada_Body_Suffix_Loc, Project);
4079 if Lang_Id.Config.Naming_Data.Body_Suffix /=
4080 Lang_Id.Config.Naming_Data.Separate_Suffix
4081 and then Lang_Id.Config.Naming_Data.Spec_Suffix =
4082 Lang_Id.Config.Naming_Data.Separate_Suffix
4086 "Separate_Suffix ("""
4088 (Lang_Id.Config.Naming_Data.Separate_Suffix)
4089 & """) cannot be the same as Spec_Suffix.",
4090 Sep_Suffix_Loc, Project);
4093 Lang_Id := Lang_Id.Next;
4096 -- Get the naming exceptions for all languages
4098 for Kind in Spec_Or_Body loop
4099 Lang_Id := Project.Languages;
4100 while Lang_Id /= No_Language_Index loop
4101 case Lang_Id.Config.Kind is
4103 Process_Exceptions_File_Based (Lang_Id, Kind);
4106 Process_Exceptions_Unit_Based (Lang_Id, Kind);
4109 Lang_Id := Lang_Id.Next;
4114 ----------------------------
4115 -- Initialize_Naming_Data --
4116 ----------------------------
4118 procedure Initialize_Naming_Data is
4119 Specs : Array_Element_Id :=
4125 Impls : Array_Element_Id :=
4131 Lang : Language_Ptr;
4132 Lang_Name : Name_Id;
4133 Value : Variable_Value;
4134 Extended : Project_Id;
4137 -- At this stage, the project already contains the default extensions
4138 -- for the various languages. We now merge those suffixes read in the
4139 -- user project, and they override the default.
4141 while Specs /= No_Array_Element loop
4142 Lang_Name := Shared.Array_Elements.Table (Specs).Index;
4144 Get_Language_From_Name
4145 (Project, Name => Get_Name_String (Lang_Name));
4147 -- An extending project inherits its parent projects' languages
4148 -- so if needed we should create entries for those languages
4151 Extended := Project.Extends;
4152 while Extended /= null loop
4153 Lang := Get_Language_From_Name
4154 (Extended, Name => Get_Name_String (Lang_Name));
4155 exit when Lang /= null;
4157 Extended := Extended.Extends;
4160 if Lang /= null then
4161 Lang := new Language_Data'(Lang.all);
4162 Lang.First_Source := null;
4163 Lang.Next := Project.Languages;
4164 Project.Languages := Lang;
4168 -- If language was not found in project or the projects it extends
4172 ("ignoring spec naming data (lang. not in project): ",
4176 Value := Shared.Array_Elements.Table (Specs).Value;
4178 if Value.Kind = Single then
4179 Lang.Config.Naming_Data.Spec_Suffix :=
4180 Canonical_Case_File_Name (Value.Value);
4184 Specs := Shared.Array_Elements.Table (Specs).Next;
4187 while Impls /= No_Array_Element loop
4188 Lang_Name := Shared.Array_Elements.Table (Impls).Index;
4190 Get_Language_From_Name
4191 (Project, Name => Get_Name_String (Lang_Name));
4195 ("ignoring impl naming data (lang. not in project): ",
4198 Value := Shared.Array_Elements.Table (Impls).Value;
4200 if Lang.Name = Name_Ada then
4201 Ada_Body_Suffix_Loc := Value.Location;
4204 if Value.Kind = Single then
4205 Lang.Config.Naming_Data.Body_Suffix :=
4206 Canonical_Case_File_Name (Value.Value);
4210 Impls := Shared.Array_Elements.Table (Impls).Next;
4212 end Initialize_Naming_Data;
4214 -- Start of processing for Check_Naming_Schemes
4217 -- No Naming package or parsing a configuration file? nothing to do
4219 if Naming_Id /= No_Package
4220 and then Project.Qualifier /= Configuration
4222 Naming := Shared.Packages.Table (Naming_Id);
4223 Debug_Increase_Indent ("checking package Naming for ", Project.Name);
4224 Initialize_Naming_Data;
4226 Debug_Decrease_Indent ("done checking package naming");
4228 end Check_Package_Naming;
4230 ---------------------------------
4231 -- Check_Programming_Languages --
4232 ---------------------------------
4234 procedure Check_Programming_Languages
4235 (Project : Project_Id;
4236 Data : in out Tree_Processing_Data)
4238 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
4240 Languages : Variable_Value := Nil_Variable_Value;
4241 Def_Lang : Variable_Value := Nil_Variable_Value;
4242 Def_Lang_Id : Name_Id;
4244 procedure Add_Language (Name, Display_Name : Name_Id);
4245 -- Add a new language to the list of languages for the project.
4246 -- Nothing is done if the language has already been defined
4252 procedure Add_Language (Name, Display_Name : Name_Id) is
4253 Lang : Language_Ptr;
4256 Lang := Project.Languages;
4257 while Lang /= No_Language_Index loop
4258 if Name = Lang.Name then
4265 Lang := new Language_Data'(No_Language_Data);
4266 Lang.Next := Project.Languages;
4267 Project.Languages := Lang;
4269 Lang.Display_Name := Display_Name;
4272 -- Start of processing for Check_Programming_Languages
4275 Project.Languages := null;
4277 Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
4280 (Name_Default_Language, Project.Decl.Attributes, Shared);
4282 if Project.Source_Dirs /= Nil_String then
4284 -- Check if languages are specified in this project
4286 if Languages.Default then
4288 -- Fail if there is no default language defined
4290 if Def_Lang.Default then
4293 "no languages defined for this project",
4294 Project.Location, Project);
4295 Def_Lang_Id := No_Name;
4298 Get_Name_String (Def_Lang.Value);
4299 To_Lower (Name_Buffer (1 .. Name_Len));
4300 Def_Lang_Id := Name_Find;
4303 if Def_Lang_Id /= No_Name then
4304 Get_Name_String (Def_Lang_Id);
4305 Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
4307 (Name => Def_Lang_Id,
4308 Display_Name => Name_Find);
4313 Current : String_List_Id := Languages.Values;
4314 Element : String_Element;
4317 -- If there are no languages declared, there are no sources
4319 if Current = Nil_String then
4320 Project.Source_Dirs := Nil_String;
4322 if Project.Qualifier = Standard then
4325 "a standard project must have at least one language",
4326 Languages.Location, Project);
4330 -- Look through all the languages specified in attribute
4333 while Current /= Nil_String loop
4334 Element := Shared.String_Elements.Table (Current);
4335 Get_Name_String (Element.Value);
4336 To_Lower (Name_Buffer (1 .. Name_Len));
4340 Display_Name => Element.Value);
4342 Current := Element.Next;
4348 end Check_Programming_Languages;
4350 -------------------------------
4351 -- Check_Stand_Alone_Library --
4352 -------------------------------
4354 procedure Check_Stand_Alone_Library
4355 (Project : Project_Id;
4356 Data : in out Tree_Processing_Data)
4358 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
4360 Lib_Name : constant Prj.Variable_Value :=
4362 (Snames.Name_Library_Name,
4363 Project.Decl.Attributes,
4366 Lib_Standalone : constant Prj.Variable_Value :=
4368 (Snames.Name_Library_Standalone,
4369 Project.Decl.Attributes,
4372 Lib_Auto_Init : constant Prj.Variable_Value :=
4374 (Snames.Name_Library_Auto_Init,
4375 Project.Decl.Attributes,
4378 Lib_Src_Dir : constant Prj.Variable_Value :=
4380 (Snames.Name_Library_Src_Dir,
4381 Project.Decl.Attributes,
4384 Lib_Symbol_File : constant Prj.Variable_Value :=
4386 (Snames.Name_Library_Symbol_File,
4387 Project.Decl.Attributes,
4390 Lib_Symbol_Policy : constant Prj.Variable_Value :=
4392 (Snames.Name_Library_Symbol_Policy,
4393 Project.Decl.Attributes,
4396 Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
4398 (Snames.Name_Library_Reference_Symbol_File,
4399 Project.Decl.Attributes,
4402 Auto_Init_Supported : Boolean;
4403 OK : Boolean := True;
4406 Auto_Init_Supported := Project.Config.Auto_Init_Supported;
4408 -- It is a stand-alone library project file if there is at least one
4409 -- unit in the declared or inherited interface.
4411 if Project.Lib_Interface_ALIs = Nil_String then
4412 if not Lib_Standalone.Default
4413 and then Get_Name_String (Lib_Standalone.Value) /= "no"
4417 "Library_Standalone valid only if Library_Interface is set",
4418 Lib_Standalone.Location, Project);
4422 if Project.Standalone_Library = No then
4423 Project.Standalone_Library := Standard;
4426 -- The name of a stand-alone library needs to have the syntax of an
4430 Name : constant String := Get_Name_String (Project.Library_Name);
4431 OK : Boolean := Is_Letter (Name (Name'First));
4433 Underline : Boolean := False;
4436 for J in Name'First + 1 .. Name'Last loop
4439 if Is_Alphanumeric (Name (J)) then
4442 elsif Name (J) = '_' then
4454 OK := OK and not Underline;
4459 "Incorrect library name for a Stand-Alone Library",
4460 Lib_Name.Location, Project);
4465 if Lib_Standalone.Default then
4466 Project.Standalone_Library := Standard;
4469 Get_Name_String (Lib_Standalone.Value);
4470 To_Lower (Name_Buffer (1 .. Name_Len));
4472 if Name_Buffer (1 .. Name_Len) = "standard" then
4473 Project.Standalone_Library := Standard;
4475 elsif Name_Buffer (1 .. Name_Len) = "encapsulated" then
4476 Project.Standalone_Library := Encapsulated;
4478 elsif Name_Buffer (1 .. Name_Len) = "no" then
4479 Project.Standalone_Library := No;
4482 "wrong value for Library_Standalone "
4483 & "when Library_Interface defined",
4484 Lib_Standalone.Location, Project);
4489 "invalid value for attribute Library_Standalone",
4490 Lib_Standalone.Location, Project);
4494 -- Check value of attribute Library_Auto_Init and set Lib_Auto_Init
4497 if Lib_Auto_Init.Default then
4499 -- If no attribute Library_Auto_Init is declared, then set auto
4500 -- init only if it is supported.
4502 Project.Lib_Auto_Init := Auto_Init_Supported;
4505 Get_Name_String (Lib_Auto_Init.Value);
4506 To_Lower (Name_Buffer (1 .. Name_Len));
4508 if Name_Buffer (1 .. Name_Len) = "false" then
4509 Project.Lib_Auto_Init := False;
4511 elsif Name_Buffer (1 .. Name_Len) = "true" then
4512 if Auto_Init_Supported then
4513 Project.Lib_Auto_Init := True;
4516 -- Library_Auto_Init cannot be "true" if auto init is not
4521 "library auto init not supported " &
4523 Lib_Auto_Init.Location, Project);
4529 "invalid value for attribute Library_Auto_Init",
4530 Lib_Auto_Init.Location, Project);
4534 -- If attribute Library_Src_Dir is defined and not the empty string,
4535 -- check if the directory exist and is not the object directory or
4536 -- one of the source directories. This is the directory where copies
4537 -- of the interface sources will be copied. Note that this directory
4538 -- may be the library directory.
4540 if Lib_Src_Dir.Value /= Empty_String then
4542 Dir_Id : constant File_Name_Type :=
4543 File_Name_Type (Lib_Src_Dir.Value);
4544 Dir_Exists : Boolean;
4550 Path => Project.Library_Src_Dir,
4551 Dir_Exists => Dir_Exists,
4553 Must_Exist => False,
4554 Create => "library source copy",
4555 Location => Lib_Src_Dir.Location,
4556 Externally_Built => Project.Externally_Built);
4558 -- If directory does not exist, report an error
4560 if not Dir_Exists then
4562 -- Get the absolute name of the library directory that does
4563 -- not exist, to report an error.
4565 Err_Vars.Error_Msg_File_1 :=
4566 File_Name_Type (Project.Library_Src_Dir.Display_Name);
4569 "Directory { does not exist",
4570 Lib_Src_Dir.Location, Project);
4572 -- Report error if it is the same as the object directory
4574 elsif Project.Library_Src_Dir = Project.Object_Directory then
4577 "directory to copy interfaces cannot be " &
4578 "the object directory",
4579 Lib_Src_Dir.Location, Project);
4580 Project.Library_Src_Dir := No_Path_Information;
4584 Src_Dirs : String_List_Id;
4585 Src_Dir : String_Element;
4589 -- Interface copy directory cannot be one of the source
4590 -- directory of the current project.
4592 Src_Dirs := Project.Source_Dirs;
4593 while Src_Dirs /= Nil_String loop
4594 Src_Dir := Shared.String_Elements.Table (Src_Dirs);
4596 -- Report error if it is one of the source directories
4598 if Project.Library_Src_Dir.Name =
4599 Path_Name_Type (Src_Dir.Value)
4603 "directory to copy interfaces cannot " &
4604 "be one of the source directories",
4605 Lib_Src_Dir.Location, Project);
4606 Project.Library_Src_Dir := No_Path_Information;
4610 Src_Dirs := Src_Dir.Next;
4613 if Project.Library_Src_Dir /= No_Path_Information then
4615 -- It cannot be a source directory of any other
4618 Pid := Data.Tree.Projects;
4620 exit Project_Loop when Pid = null;
4622 Src_Dirs := Pid.Project.Source_Dirs;
4623 Dir_Loop : while Src_Dirs /= Nil_String loop
4625 Shared.String_Elements.Table (Src_Dirs);
4627 -- Report error if it is one of the source
4630 if Project.Library_Src_Dir.Name =
4631 Path_Name_Type (Src_Dir.Value)
4634 File_Name_Type (Src_Dir.Value);
4635 Error_Msg_Name_1 := Pid.Project.Name;
4638 "directory to copy interfaces cannot " &
4639 "be the same as source directory { of " &
4641 Lib_Src_Dir.Location, Project);
4642 Project.Library_Src_Dir :=
4643 No_Path_Information;
4647 Src_Dirs := Src_Dir.Next;
4651 end loop Project_Loop;
4655 -- In high verbosity, if there is a valid Library_Src_Dir,
4656 -- display its path name.
4658 if Project.Library_Src_Dir /= No_Path_Information
4659 and then Current_Verbosity = High
4662 ("Directory to copy interfaces",
4663 Get_Name_String (Project.Library_Src_Dir.Name));
4669 -- Check the symbol related attributes
4671 -- First, the symbol policy
4673 if not Lib_Symbol_Policy.Default then
4675 Value : constant String :=
4677 (Get_Name_String (Lib_Symbol_Policy.Value));
4680 -- Symbol policy must have one of a limited number of values
4682 if Value = "autonomous" or else Value = "default" then
4683 Project.Symbol_Data.Symbol_Policy := Autonomous;
4685 elsif Value = "compliant" then
4686 Project.Symbol_Data.Symbol_Policy := Compliant;
4688 elsif Value = "controlled" then
4689 Project.Symbol_Data.Symbol_Policy := Controlled;
4691 elsif Value = "restricted" then
4692 Project.Symbol_Data.Symbol_Policy := Restricted;
4694 elsif Value = "direct" then
4695 Project.Symbol_Data.Symbol_Policy := Direct;
4700 "illegal value for Library_Symbol_Policy",
4701 Lib_Symbol_Policy.Location, Project);
4706 -- If attribute Library_Symbol_File is not specified, symbol policy
4707 -- cannot be Restricted.
4709 if Lib_Symbol_File.Default then
4710 if Project.Symbol_Data.Symbol_Policy = Restricted then
4713 "Library_Symbol_File needs to be defined when " &
4714 "symbol policy is Restricted",
4715 Lib_Symbol_Policy.Location, Project);
4719 -- Library_Symbol_File is defined
4721 Project.Symbol_Data.Symbol_File :=
4722 Path_Name_Type (Lib_Symbol_File.Value);
4724 Get_Name_String (Lib_Symbol_File.Value);
4726 if Name_Len = 0 then
4729 "symbol file name cannot be an empty string",
4730 Lib_Symbol_File.Location, Project);
4733 OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
4736 for J in 1 .. Name_Len loop
4737 if Name_Buffer (J) = '/'
4738 or else Name_Buffer (J) = Directory_Separator
4747 Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
4750 "symbol file name { is illegal. " &
4751 "Name cannot include directory info.",
4752 Lib_Symbol_File.Location, Project);
4757 -- If attribute Library_Reference_Symbol_File is not defined,
4758 -- symbol policy cannot be Compliant or Controlled.
4760 if Lib_Ref_Symbol_File.Default then
4761 if Project.Symbol_Data.Symbol_Policy = Compliant
4762 or else Project.Symbol_Data.Symbol_Policy = Controlled
4766 "a reference symbol file needs to be defined",
4767 Lib_Symbol_Policy.Location, Project);
4771 -- Library_Reference_Symbol_File is defined, check file exists
4773 Project.Symbol_Data.Reference :=
4774 Path_Name_Type (Lib_Ref_Symbol_File.Value);
4776 Get_Name_String (Lib_Ref_Symbol_File.Value);
4778 if Name_Len = 0 then
4781 "reference symbol file name cannot be an empty string",
4782 Lib_Symbol_File.Location, Project);
4785 if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
4787 Add_Str_To_Name_Buffer
4788 (Get_Name_String (Project.Directory.Name));
4789 Add_Str_To_Name_Buffer
4790 (Get_Name_String (Lib_Ref_Symbol_File.Value));
4791 Project.Symbol_Data.Reference := Name_Find;
4794 if not Is_Regular_File
4795 (Get_Name_String (Project.Symbol_Data.Reference))
4798 File_Name_Type (Lib_Ref_Symbol_File.Value);
4800 -- For controlled and direct symbol policies, it is an error
4801 -- if the reference symbol file does not exist. For other
4802 -- symbol policies, this is just a warning
4805 Project.Symbol_Data.Symbol_Policy /= Controlled
4806 and then Project.Symbol_Data.Symbol_Policy /= Direct;
4810 "<library reference symbol file { does not exist",
4811 Lib_Ref_Symbol_File.Location, Project);
4813 -- In addition in the non-controlled case, if symbol policy
4814 -- is Compliant, it is changed to Autonomous, because there
4815 -- is no reference to check against, and we don't want to
4816 -- fail in this case.
4818 if Project.Symbol_Data.Symbol_Policy /= Controlled then
4819 if Project.Symbol_Data.Symbol_Policy = Compliant then
4820 Project.Symbol_Data.Symbol_Policy := Autonomous;
4825 -- If both the reference symbol file and the symbol file are
4826 -- defined, then check that they are not the same file.
4828 if Project.Symbol_Data.Symbol_File /= No_Path then
4829 Get_Name_String (Project.Symbol_Data.Symbol_File);
4831 if Name_Len > 0 then
4833 -- We do not need to pass a Directory to
4834 -- Normalize_Pathname, since the path_information
4835 -- already contains absolute information.
4837 Symb_Path : constant String :=
4840 (Project.Object_Directory.Name) &
4841 Name_Buffer (1 .. Name_Len),
4844 Opt.Follow_Links_For_Files);
4845 Ref_Path : constant String :=
4848 (Project.Symbol_Data.Reference),
4851 Opt.Follow_Links_For_Files);
4853 if Symb_Path = Ref_Path then
4856 "library reference symbol file and library" &
4857 " symbol file cannot be the same file",
4858 Lib_Ref_Symbol_File.Location, Project);
4866 end Check_Stand_Alone_Library;
4868 ---------------------
4869 -- Check_Unit_Name --
4870 ---------------------
4872 procedure Check_Unit_Name (Name : String; Unit : out Name_Id) is
4873 The_Name : String := Name;
4874 Real_Name : Name_Id;
4875 Need_Letter : Boolean := True;
4876 Last_Underscore : Boolean := False;
4877 OK : Boolean := The_Name'Length > 0;
4880 function Is_Reserved (Name : Name_Id) return Boolean;
4881 function Is_Reserved (S : String) return Boolean;
4882 -- Check that the given name is not an Ada 95 reserved word. The reason
4883 -- for the Ada 95 here is that we do not want to exclude the case of an
4884 -- Ada 95 unit called Interface (for example). In Ada 2005, such a unit
4885 -- name would be rejected anyway by the compiler. That means there is no
4886 -- requirement that the project file parser reject this.
4892 function Is_Reserved (S : String) return Boolean is
4895 Add_Str_To_Name_Buffer (S);
4896 return Is_Reserved (Name_Find);
4903 function Is_Reserved (Name : Name_Id) return Boolean is
4905 if Get_Name_Table_Byte (Name) /= 0
4906 and then Name /= Name_Project
4907 and then Name /= Name_Extends
4908 and then Name /= Name_External
4909 and then Name not in Ada_2005_Reserved_Words
4912 Debug_Output ("Ada reserved word: ", Name);
4920 -- Start of processing for Check_Unit_Name
4923 To_Lower (The_Name);
4925 Name_Len := The_Name'Length;
4926 Name_Buffer (1 .. Name_Len) := The_Name;
4928 -- Special cases of children of packages A, G, I and S on VMS
4930 if OpenVMS_On_Target
4931 and then Name_Len > 3
4932 and then Name_Buffer (2 .. 3) = "__"
4934 (Name_Buffer (1) = 'a' or else
4935 Name_Buffer (1) = 'g' or else
4936 Name_Buffer (1) = 'i' or else
4937 Name_Buffer (1) = 's')
4939 Name_Buffer (2) := '.';
4940 Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
4941 Name_Len := Name_Len - 1;
4944 Real_Name := Name_Find;
4946 if Is_Reserved (Real_Name) then
4950 First := The_Name'First;
4952 for Index in The_Name'Range loop
4955 -- We need a letter (at the beginning, and following a dot),
4956 -- but we don't have one.
4958 if Is_Letter (The_Name (Index)) then
4959 Need_Letter := False;
4964 if Current_Verbosity = High then
4966 Write_Int (Types.Int (Index));
4968 Write_Char (The_Name (Index));
4969 Write_Line ("' is not a letter.");
4975 elsif Last_Underscore
4976 and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
4978 -- Two underscores are illegal, and a dot cannot follow
4983 if Current_Verbosity = High then
4985 Write_Int (Types.Int (Index));
4987 Write_Char (The_Name (Index));
4988 Write_Line ("' is illegal here.");
4993 elsif The_Name (Index) = '.' then
4995 -- First, check if the name before the dot is not a reserved word
4997 if Is_Reserved (The_Name (First .. Index - 1)) then
5003 -- We need a letter after a dot
5005 Need_Letter := True;
5007 elsif The_Name (Index) = '_' then
5008 Last_Underscore := True;
5011 -- We need an letter or a digit
5013 Last_Underscore := False;
5015 if not Is_Alphanumeric (The_Name (Index)) then
5018 if Current_Verbosity = High then
5020 Write_Int (Types.Int (Index));
5022 Write_Char (The_Name (Index));
5023 Write_Line ("' is not alphanumeric.");
5031 -- Cannot end with an underscore or a dot
5033 OK := OK and then not Need_Letter and then not Last_Underscore;
5036 if First /= Name'First
5037 and then Is_Reserved (The_Name (First .. The_Name'Last))
5045 -- Signal a problem with No_Name
5049 end Check_Unit_Name;
5051 ----------------------------
5052 -- Compute_Directory_Last --
5053 ----------------------------
5055 function Compute_Directory_Last (Dir : String) return Natural is
5058 and then (Dir (Dir'Last - 1) = Directory_Separator
5060 Dir (Dir'Last - 1) = '/')
5062 return Dir'Last - 1;
5066 end Compute_Directory_Last;
5068 ---------------------
5069 -- Get_Directories --
5070 ---------------------
5072 procedure Get_Directories
5073 (Project : Project_Id;
5074 Data : in out Tree_Processing_Data)
5076 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
5078 Object_Dir : constant Variable_Value :=
5080 (Name_Object_Dir, Project.Decl.Attributes, Shared);
5082 Exec_Dir : constant Variable_Value :=
5084 (Name_Exec_Dir, Project.Decl.Attributes, Shared);
5086 Source_Dirs : constant Variable_Value :=
5088 (Name_Source_Dirs, Project.Decl.Attributes, Shared);
5090 Ignore_Source_Sub_Dirs : constant Variable_Value :=
5092 (Name_Ignore_Source_Sub_Dirs,
5093 Project.Decl.Attributes,
5096 Excluded_Source_Dirs : constant Variable_Value :=
5098 (Name_Excluded_Source_Dirs,
5099 Project.Decl.Attributes,
5102 Source_Files : constant Variable_Value :=
5105 Project.Decl.Attributes, Shared);
5107 Last_Source_Dir : String_List_Id := Nil_String;
5108 Last_Src_Dir_Rank : Number_List_Index := No_Number_List;
5110 Languages : constant Variable_Value :=
5112 (Name_Languages, Project.Decl.Attributes, Shared);
5114 Remove_Source_Dirs : Boolean := False;
5116 procedure Add_To_Or_Remove_From_Source_Dirs
5117 (Path : Path_Information;
5119 -- When Removed = False, the directory Path_Id to the list of
5120 -- source_dirs if not already in the list. When Removed = True,
5121 -- removed directory Path_Id if in the list.
5123 procedure Find_Source_Dirs is new Expand_Subdirectory_Pattern
5124 (Add_To_Or_Remove_From_Source_Dirs);
5126 ---------------------------------------
5127 -- Add_To_Or_Remove_From_Source_Dirs --
5128 ---------------------------------------
5130 procedure Add_To_Or_Remove_From_Source_Dirs
5131 (Path : Path_Information;
5134 List : String_List_Id;
5135 Prev : String_List_Id;
5136 Rank_List : Number_List_Index;
5137 Prev_Rank : Number_List_Index;
5138 Element : String_Element;
5142 Prev_Rank := No_Number_List;
5143 List := Project.Source_Dirs;
5144 Rank_List := Project.Source_Dir_Ranks;
5145 while List /= Nil_String loop
5146 Element := Shared.String_Elements.Table (List);
5147 exit when Element.Value = Name_Id (Path.Name);
5149 List := Element.Next;
5150 Prev_Rank := Rank_List;
5151 Rank_List := Shared.Number_Lists.Table (Prev_Rank).Next;
5154 -- The directory is in the list if List is not Nil_String
5156 if not Remove_Source_Dirs and then List = Nil_String then
5157 Debug_Output ("adding source dir=", Name_Id (Path.Display_Name));
5159 String_Element_Table.Increment_Last (Shared.String_Elements);
5161 (Value => Name_Id (Path.Name),
5163 Display_Value => Name_Id (Path.Display_Name),
5164 Location => No_Location,
5166 Next => Nil_String);
5168 Number_List_Table.Increment_Last (Shared.Number_Lists);
5170 if Last_Source_Dir = Nil_String then
5172 -- This is the first source directory
5174 Project.Source_Dirs :=
5175 String_Element_Table.Last (Shared.String_Elements);
5176 Project.Source_Dir_Ranks :=
5177 Number_List_Table.Last (Shared.Number_Lists);
5180 -- We already have source directories, link the previous
5181 -- last to the new one.
5183 Shared.String_Elements.Table (Last_Source_Dir).Next :=
5184 String_Element_Table.Last (Shared.String_Elements);
5185 Shared.Number_Lists.Table (Last_Src_Dir_Rank).Next :=
5186 Number_List_Table.Last (Shared.Number_Lists);
5189 -- And register this source directory as the new last
5192 String_Element_Table.Last (Shared.String_Elements);
5193 Shared.String_Elements.Table (Last_Source_Dir) := Element;
5194 Last_Src_Dir_Rank := Number_List_Table.Last (Shared.Number_Lists);
5195 Shared.Number_Lists.Table (Last_Src_Dir_Rank) :=
5196 (Number => Rank, Next => No_Number_List);
5198 elsif Remove_Source_Dirs and then List /= Nil_String then
5200 -- Remove source dir if present
5202 if Prev = Nil_String then
5203 Project.Source_Dirs := Shared.String_Elements.Table (List).Next;
5204 Project.Source_Dir_Ranks :=
5205 Shared.Number_Lists.Table (Rank_List).Next;
5208 Shared.String_Elements.Table (Prev).Next :=
5209 Shared.String_Elements.Table (List).Next;
5210 Shared.Number_Lists.Table (Prev_Rank).Next :=
5211 Shared.Number_Lists.Table (Rank_List).Next;
5214 end Add_To_Or_Remove_From_Source_Dirs;
5216 -- Local declarations
5218 Dir_Exists : Boolean;
5220 No_Sources : constant Boolean :=
5221 ((not Source_Files.Default
5222 and then Source_Files.Values = Nil_String)
5224 (not Source_Dirs.Default
5225 and then Source_Dirs.Values = Nil_String)
5227 (not Languages.Default
5228 and then Languages.Values = Nil_String))
5229 and then Project.Extends = No_Project;
5231 -- Start of processing for Get_Directories
5234 Debug_Output ("starting to look for directories");
5236 -- Set the object directory to its default which may be nil, if there
5237 -- is no sources in the project.
5240 Project.Object_Directory := No_Path_Information;
5242 Project.Object_Directory := Project.Directory;
5245 -- Check the object directory
5247 if Object_Dir.Value /= Empty_String then
5248 Get_Name_String (Object_Dir.Value);
5250 if Name_Len = 0 then
5253 "Object_Dir cannot be empty",
5254 Object_Dir.Location, Project);
5256 elsif Setup_Projects
5258 and then Project.Extends = No_Project
5260 -- Do not create an object directory for a non extending project
5265 File_Name_Type (Object_Dir.Value),
5266 Path => Project.Object_Directory,
5267 Dir_Exists => Dir_Exists,
5269 Location => Object_Dir.Location,
5270 Must_Exist => False,
5271 Externally_Built => Project.Externally_Built);
5274 -- We check that the specified object directory does exist.
5275 -- However, even when it doesn't exist, we set it to a default
5276 -- value. This is for the benefit of tools that recover from
5277 -- errors; for example, these tools could create the non existent
5278 -- directory. We always return an absolute directory name though.
5282 File_Name_Type (Object_Dir.Value),
5283 Path => Project.Object_Directory,
5285 Dir_Exists => Dir_Exists,
5287 Location => Object_Dir.Location,
5288 Must_Exist => False,
5289 Externally_Built => Project.Externally_Built);
5291 if not Dir_Exists and then not Project.Externally_Built then
5293 -- The object directory does not exist, report an error if the
5294 -- project is not externally built.
5296 Err_Vars.Error_Msg_File_1 :=
5297 File_Name_Type (Object_Dir.Value);
5299 (Data.Flags, Data.Flags.Require_Obj_Dirs,
5300 "object directory { not found", Project.Location, Project);
5304 elsif not No_Sources and then Subdirs /= null then
5306 Name_Buffer (1) := '.';
5310 Path => Project.Object_Directory,
5312 Dir_Exists => Dir_Exists,
5314 Location => Object_Dir.Location,
5315 Externally_Built => Project.Externally_Built);
5318 if Current_Verbosity = High then
5319 if Project.Object_Directory = No_Path_Information then
5320 Debug_Output ("no object directory");
5323 ("Object directory",
5324 Get_Name_String (Project.Object_Directory.Display_Name));
5328 -- Check the exec directory
5330 -- We set the object directory to its default
5332 Project.Exec_Directory := Project.Object_Directory;
5334 if Exec_Dir.Value /= Empty_String then
5335 Get_Name_String (Exec_Dir.Value);
5337 if Name_Len = 0 then
5340 "Exec_Dir cannot be empty",
5341 Exec_Dir.Location, Project);
5343 elsif Setup_Projects
5345 and then Project.Extends = No_Project
5347 -- Do not create an exec directory for a non extending project
5352 File_Name_Type (Exec_Dir.Value),
5353 Path => Project.Exec_Directory,
5354 Dir_Exists => Dir_Exists,
5356 Location => Exec_Dir.Location,
5357 Externally_Built => Project.Externally_Built);
5360 -- We check that the specified exec directory does exist
5364 File_Name_Type (Exec_Dir.Value),
5365 Path => Project.Exec_Directory,
5366 Dir_Exists => Dir_Exists,
5369 Location => Exec_Dir.Location,
5370 Externally_Built => Project.Externally_Built);
5372 if not Dir_Exists then
5373 Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
5375 (Data.Flags, Data.Flags.Missing_Source_Files,
5376 "exec directory { not found", Project.Location, Project);
5381 if Current_Verbosity = High then
5382 if Project.Exec_Directory = No_Path_Information then
5383 Debug_Output ("no exec directory");
5386 ("exec directory: ",
5387 Name_Id (Project.Exec_Directory.Display_Name));
5391 -- Look for the source directories
5393 Debug_Output ("starting to look for source directories");
5395 pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
5397 if not Source_Files.Default
5398 and then Source_Files.Values = Nil_String
5400 Project.Source_Dirs := Nil_String;
5402 if Project.Qualifier = Standard then
5405 "a standard project cannot have no sources",
5406 Source_Files.Location, Project);
5409 elsif Source_Dirs.Default then
5411 -- No Source_Dirs specified: the single source directory is the one
5412 -- containing the project file.
5414 Remove_Source_Dirs := False;
5415 Add_To_Or_Remove_From_Source_Dirs
5416 (Path => (Name => Project.Directory.Name,
5417 Display_Name => Project.Directory.Display_Name),
5421 Remove_Source_Dirs := False;
5423 (Project => Project,
5425 Patterns => Source_Dirs.Values,
5426 Ignore => Ignore_Source_Sub_Dirs.Values,
5427 Search_For => Search_Directories,
5428 Resolve_Links => Opt.Follow_Links_For_Dirs);
5430 if Project.Source_Dirs = Nil_String
5431 and then Project.Qualifier = Standard
5435 "a standard project cannot have no source directories",
5436 Source_Dirs.Location, Project);
5440 if not Excluded_Source_Dirs.Default
5441 and then Excluded_Source_Dirs.Values /= Nil_String
5443 Remove_Source_Dirs := True;
5445 (Project => Project,
5447 Patterns => Excluded_Source_Dirs.Values,
5448 Ignore => Nil_String,
5449 Search_For => Search_Directories,
5450 Resolve_Links => Opt.Follow_Links_For_Dirs);
5453 Debug_Output ("putting source directories in canonical cases");
5456 Current : String_List_Id := Project.Source_Dirs;
5457 Element : String_Element;
5460 while Current /= Nil_String loop
5461 Element := Shared.String_Elements.Table (Current);
5462 if Element.Value /= No_Name then
5464 Name_Id (Canonical_Case_File_Name (Element.Value));
5465 Shared.String_Elements.Table (Current) := Element;
5468 Current := Element.Next;
5471 end Get_Directories;
5478 (Project : Project_Id;
5479 Data : in out Tree_Processing_Data)
5481 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
5483 Mains : constant Variable_Value :=
5485 (Name_Main, Project.Decl.Attributes, Shared);
5486 List : String_List_Id;
5487 Elem : String_Element;
5490 Project.Mains := Mains.Values;
5492 -- If no Mains were specified, and if we are an extending project,
5493 -- inherit the Mains from the project we are extending.
5495 if Mains.Default then
5496 if not Project.Library and then Project.Extends /= No_Project then
5497 Project.Mains := Project.Extends.Mains;
5500 -- In a library project file, Main cannot be specified
5502 elsif Project.Library then
5505 "a library project file cannot have Main specified",
5506 Mains.Location, Project);
5509 List := Mains.Values;
5510 while List /= Nil_String loop
5511 Elem := Shared.String_Elements.Table (List);
5513 if Length_Of_Name (Elem.Value) = 0 then
5516 "?a main cannot have an empty name",
5517 Elem.Location, Project);
5526 ---------------------------
5527 -- Get_Sources_From_File --
5528 ---------------------------
5530 procedure Get_Sources_From_File
5532 Location : Source_Ptr;
5533 Project : in out Project_Processing_Data;
5534 Data : in out Tree_Processing_Data)
5536 File : Prj.Util.Text_File;
5537 Line : String (1 .. 250);
5539 Source_Name : File_Name_Type;
5540 Name_Loc : Name_Location;
5543 if Current_Verbosity = High then
5544 Debug_Output ("opening """ & Path & '"');
5549 Prj.Util.Open (File, Path);
5551 if not Prj.Util.Is_Valid (File) then
5553 (Data.Flags, "file does not exist", Location, Project.Project);
5556 -- Read the lines one by one
5558 while not Prj.Util.End_Of_File (File) loop
5559 Prj.Util.Get_Line (File, Line, Last);
5561 -- A non empty, non comment line should contain a file name
5564 and then (Last = 1 or else Line (1 .. 2) /= "--")
5567 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
5568 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
5569 Source_Name := Name_Find;
5571 -- Check that there is no directory information
5573 for J in 1 .. Last loop
5574 if Line (J) = '/' or else Line (J) = Directory_Separator then
5575 Error_Msg_File_1 := Source_Name;
5578 "file name cannot include directory information ({)",
5579 Location, Project.Project);
5584 Name_Loc := Source_Names_Htable.Get
5585 (Project.Source_Names, Source_Name);
5587 if Name_Loc = No_Name_Location then
5589 (Name => Source_Name,
5590 Location => Location,
5591 Source => No_Source,
5596 Name_Loc.Listed := True;
5599 Source_Names_Htable.Set
5600 (Project.Source_Names, Source_Name, Name_Loc);
5604 Prj.Util.Close (File);
5607 end Get_Sources_From_File;
5613 function No_Space_Img (N : Natural) return String is
5614 Image : constant String := N'Img;
5616 return Image (2 .. Image'Last);
5619 -----------------------
5620 -- Compute_Unit_Name --
5621 -----------------------
5623 procedure Compute_Unit_Name
5624 (File_Name : File_Name_Type;
5625 Naming : Lang_Naming_Data;
5626 Kind : out Source_Kind;
5628 Project : Project_Processing_Data)
5630 Filename : constant String := Get_Name_String (File_Name);
5631 Last : Integer := Filename'Last;
5636 Unit_Except : Unit_Exception;
5637 Masked : Boolean := False;
5643 if Naming.Separate_Suffix = No_File
5644 or else Naming.Body_Suffix = No_File
5645 or else Naming.Spec_Suffix = No_File
5650 if Naming.Dot_Replacement = No_File then
5651 Debug_Output ("no dot_replacement specified");
5655 Sep_Len := Integer (Length_Of_Name (Naming.Separate_Suffix));
5656 Spec_Len := Integer (Length_Of_Name (Naming.Spec_Suffix));
5657 Body_Len := Integer (Length_Of_Name (Naming.Body_Suffix));
5659 -- Choose the longest suffix that matches. If there are several matches,
5660 -- give priority to specs, then bodies, then separates.
5662 if Naming.Separate_Suffix /= Naming.Body_Suffix
5663 and then Suffix_Matches (Filename, Naming.Separate_Suffix)
5665 Last := Filename'Last - Sep_Len;
5669 if Filename'Last - Body_Len <= Last
5670 and then Suffix_Matches (Filename, Naming.Body_Suffix)
5672 Last := Natural'Min (Last, Filename'Last - Body_Len);
5676 if Filename'Last - Spec_Len <= Last
5677 and then Suffix_Matches (Filename, Naming.Spec_Suffix)
5679 Last := Natural'Min (Last, Filename'Last - Spec_Len);
5683 if Last = Filename'Last then
5684 Debug_Output ("no matching suffix");
5688 -- Check that the casing matches
5690 if File_Names_Case_Sensitive then
5691 case Naming.Casing is
5692 when All_Lower_Case =>
5693 for J in Filename'First .. Last loop
5694 if Is_Letter (Filename (J))
5695 and then not Is_Lower (Filename (J))
5697 Debug_Output ("invalid casing");
5702 when All_Upper_Case =>
5703 for J in Filename'First .. Last loop
5704 if Is_Letter (Filename (J))
5705 and then not Is_Upper (Filename (J))
5707 Debug_Output ("invalid casing");
5712 when Mixed_Case | Unknown =>
5717 -- If Dot_Replacement is not a single dot, then there should not
5718 -- be any dot in the name.
5721 Dot_Repl : constant String :=
5722 Get_Name_String (Naming.Dot_Replacement);
5725 if Dot_Repl /= "." then
5726 for Index in Filename'First .. Last loop
5727 if Filename (Index) = '.' then
5728 Debug_Output ("invalid name, contains dot");
5733 Replace_Into_Name_Buffer
5734 (Filename (Filename'First .. Last), Dot_Repl, '.');
5737 Name_Len := Last - Filename'First + 1;
5738 Name_Buffer (1 .. Name_Len) := Filename (Filename'First .. Last);
5740 (Source => Name_Buffer (1 .. Name_Len),
5741 Mapping => Lower_Case_Map);
5745 -- In the standard GNAT naming scheme, check for special cases: children
5746 -- or separates of A, G, I or S, and run time sources.
5748 if Is_Standard_GNAT_Naming (Naming)
5749 and then Name_Len >= 3
5752 S1 : constant Character := Name_Buffer (1);
5753 S2 : constant Character := Name_Buffer (2);
5754 S3 : constant Character := Name_Buffer (3);
5762 -- Children or separates of packages A, G, I or S. These names
5763 -- are x__ ... or x~... (where x is a, g, i, or s). Both
5764 -- versions (x__... and x~...) are allowed in all platforms,
5765 -- because it is not possible to know the platform before
5766 -- processing of the project files.
5768 if S2 = '_' and then S3 = '_' then
5769 Name_Buffer (2) := '.';
5770 Name_Buffer (3 .. Name_Len - 1) :=
5771 Name_Buffer (4 .. Name_Len);
5772 Name_Len := Name_Len - 1;
5775 Name_Buffer (2) := '.';
5779 -- If it is potentially a run time source
5787 -- Name_Buffer contains the name of the unit in lower-cases. Check
5788 -- that this is a valid unit name
5790 Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit);
5792 -- If there is a naming exception for the same unit, the file is not
5793 -- a source for the unit.
5795 if Unit /= No_Name then
5797 Unit_Exceptions_Htable.Get (Project.Unit_Exceptions, Unit);
5800 Masked := Unit_Except.Spec /= No_File
5802 Unit_Except.Spec /= File_Name;
5804 Masked := Unit_Except.Impl /= No_File
5806 Unit_Except.Impl /= File_Name;
5810 if Current_Verbosity = High then
5812 Write_Str (" """ & Filename & """ contains the ");
5815 Write_Str ("spec of a unit found in """);
5816 Write_Str (Get_Name_String (Unit_Except.Spec));
5818 Write_Str ("body of a unit found in """);
5819 Write_Str (Get_Name_String (Unit_Except.Impl));
5822 Write_Line (""" (ignored)");
5830 and then Current_Verbosity = High
5833 when Spec => Debug_Output ("spec of", Unit);
5834 when Impl => Debug_Output ("body of", Unit);
5835 when Sep => Debug_Output ("sep of", Unit);
5838 end Compute_Unit_Name;
5840 --------------------------
5841 -- Check_Illegal_Suffix --
5842 --------------------------
5844 procedure Check_Illegal_Suffix
5845 (Project : Project_Id;
5846 Suffix : File_Name_Type;
5847 Dot_Replacement : File_Name_Type;
5848 Attribute_Name : String;
5849 Location : Source_Ptr;
5850 Data : in out Tree_Processing_Data)
5852 Suffix_Str : constant String := Get_Name_String (Suffix);
5855 if Suffix_Str'Length = 0 then
5861 elsif Index (Suffix_Str, ".") = 0 then
5862 Err_Vars.Error_Msg_File_1 := Suffix;
5865 "{ is illegal for " & Attribute_Name & ": must have a dot",
5870 -- Case of dot replacement is a single dot, and first character of
5871 -- suffix is also a dot.
5873 if Dot_Replacement /= No_File
5874 and then Get_Name_String (Dot_Replacement) = "."
5875 and then Suffix_Str (Suffix_Str'First) = '.'
5877 for Index in Suffix_Str'First + 1 .. Suffix_Str'Last loop
5879 -- If there are multiple dots in the name
5881 if Suffix_Str (Index) = '.' then
5883 -- It is illegal to have a letter following the initial dot
5885 if Is_Letter (Suffix_Str (Suffix_Str'First + 1)) then
5886 Err_Vars.Error_Msg_File_1 := Suffix;
5889 "{ is illegal for " & Attribute_Name
5890 & ": ambiguous prefix when Dot_Replacement is a dot",
5897 end Check_Illegal_Suffix;
5899 ----------------------
5900 -- Locate_Directory --
5901 ----------------------
5903 procedure Locate_Directory
5904 (Project : Project_Id;
5905 Name : File_Name_Type;
5906 Path : out Path_Information;
5907 Dir_Exists : out Boolean;
5908 Data : in out Tree_Processing_Data;
5909 Create : String := "";
5910 Location : Source_Ptr := No_Location;
5911 Must_Exist : Boolean := True;
5912 Externally_Built : Boolean := False)
5914 Parent : constant Path_Name_Type :=
5915 Project.Directory.Display_Name;
5916 The_Parent : constant String :=
5917 Get_Name_String (Parent);
5918 The_Parent_Last : constant Natural :=
5919 Compute_Directory_Last (The_Parent);
5920 Full_Name : File_Name_Type;
5921 The_Name : File_Name_Type;
5924 Get_Name_String (Name);
5926 -- Add Subdirs.all if it is a directory that may be created and
5927 -- Subdirs is not null;
5929 if Create /= "" and then Subdirs /= null then
5930 if Name_Buffer (Name_Len) /= Directory_Separator then
5931 Add_Char_To_Name_Buffer (Directory_Separator);
5934 Add_Str_To_Name_Buffer (Subdirs.all);
5937 -- Convert '/' to directory separator (for Windows)
5939 for J in 1 .. Name_Len loop
5940 if Name_Buffer (J) = '/' then
5941 Name_Buffer (J) := Directory_Separator;
5945 The_Name := Name_Find;
5947 if Current_Verbosity = High then
5949 Write_Str ("Locate_Directory (""");
5950 Write_Str (Get_Name_String (The_Name));
5951 Write_Str (""", in """);
5952 Write_Str (The_Parent);
5956 Path := No_Path_Information;
5957 Dir_Exists := False;
5959 if Is_Absolute_Path (Get_Name_String (The_Name)) then
5960 Full_Name := The_Name;
5964 Add_Str_To_Name_Buffer
5965 (The_Parent (The_Parent'First .. The_Parent_Last));
5966 Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
5967 Full_Name := Name_Find;
5971 Full_Path_Name : String_Access :=
5972 new String'(Get_Name_String (Full_Name));
5975 if (Setup_Projects or else Subdirs /= null)
5976 and then Create'Length > 0
5978 if not Is_Directory (Full_Path_Name.all) then
5980 -- If project is externally built, do not create a subdir,
5981 -- use the specified directory, without the subdir.
5983 if Externally_Built then
5984 if Is_Absolute_Path (Get_Name_String (Name)) then
5985 Get_Name_String (Name);
5989 Add_Str_To_Name_Buffer
5990 (The_Parent (The_Parent'First .. The_Parent_Last));
5991 Add_Str_To_Name_Buffer (Get_Name_String (Name));
5994 Full_Path_Name := new String'(Name_Buffer (1 .. Name_Len));
5998 Create_Path (Full_Path_Name.all);
6000 if not Quiet_Output then
6002 Write_Str (" directory """);
6003 Write_Str (Full_Path_Name.all);
6004 Write_Str (""" created for project ");
6005 Write_Line (Get_Name_String (Project.Name));
6012 "could not create " & Create &
6013 " directory " & Full_Path_Name.all,
6020 Dir_Exists := Is_Directory (Full_Path_Name.all);
6022 if not Must_Exist or else Dir_Exists then
6024 Normed : constant String :=
6026 (Full_Path_Name.all,
6028 The_Parent (The_Parent'First .. The_Parent_Last),
6029 Resolve_Links => False,
6030 Case_Sensitive => True);
6032 Canonical_Path : constant String :=
6037 (The_Parent'First .. The_Parent_Last),
6039 Opt.Follow_Links_For_Dirs,
6040 Case_Sensitive => False);
6043 Name_Len := Normed'Length;
6044 Name_Buffer (1 .. Name_Len) := Normed;
6046 -- Directories should always end with a directory separator
6048 if Name_Buffer (Name_Len) /= Directory_Separator then
6049 Add_Char_To_Name_Buffer (Directory_Separator);
6052 Path.Display_Name := Name_Find;
6054 Name_Len := Canonical_Path'Length;
6055 Name_Buffer (1 .. Name_Len) := Canonical_Path;
6057 if Name_Buffer (Name_Len) /= Directory_Separator then
6058 Add_Char_To_Name_Buffer (Directory_Separator);
6061 Path.Name := Name_Find;
6065 Free (Full_Path_Name);
6067 end Locate_Directory;
6069 ---------------------------
6070 -- Find_Excluded_Sources --
6071 ---------------------------
6073 procedure Find_Excluded_Sources
6074 (Project : in out Project_Processing_Data;
6075 Data : in out Tree_Processing_Data)
6077 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
6079 Excluded_Source_List_File : constant Variable_Value :=
6081 (Name_Excluded_Source_List_File,
6082 Project.Project.Decl.Attributes,
6084 Excluded_Sources : Variable_Value := Util.Value_Of
6085 (Name_Excluded_Source_Files,
6086 Project.Project.Decl.Attributes,
6089 Current : String_List_Id;
6090 Element : String_Element;
6091 Location : Source_Ptr;
6092 Name : File_Name_Type;
6093 File : Prj.Util.Text_File;
6094 Line : String (1 .. 300);
6096 Locally_Removed : Boolean := False;
6099 -- If Excluded_Source_Files is not declared, check Locally_Removed_Files
6101 if Excluded_Sources.Default then
6102 Locally_Removed := True;
6105 (Name_Locally_Removed_Files,
6106 Project.Project.Decl.Attributes, Shared);
6109 -- If there are excluded sources, put them in the table
6111 if not Excluded_Sources.Default then
6112 if not Excluded_Source_List_File.Default then
6113 if Locally_Removed then
6116 "?both attributes Locally_Removed_Files and " &
6117 "Excluded_Source_List_File are present",
6118 Excluded_Source_List_File.Location, Project.Project);
6122 "?both attributes Excluded_Source_Files and " &
6123 "Excluded_Source_List_File are present",
6124 Excluded_Source_List_File.Location, Project.Project);
6128 Current := Excluded_Sources.Values;
6129 while Current /= Nil_String loop
6130 Element := Shared.String_Elements.Table (Current);
6131 Name := Canonical_Case_File_Name (Element.Value);
6133 -- If the element has no location, then use the location of
6134 -- Excluded_Sources to report possible errors.
6136 if Element.Location = No_Location then
6137 Location := Excluded_Sources.Location;
6139 Location := Element.Location;
6142 Excluded_Sources_Htable.Set
6143 (Project.Excluded, Name,
6144 (Name, No_File, 0, False, Location));
6145 Current := Element.Next;
6148 elsif not Excluded_Source_List_File.Default then
6149 Location := Excluded_Source_List_File.Location;
6152 Source_File_Name : constant File_Name_Type :=
6154 (Excluded_Source_List_File.Value);
6155 Source_File_Line : Natural := 0;
6157 Source_File_Path_Name : constant String :=
6160 Project.Project.Directory.Name);
6163 if Source_File_Path_Name'Length = 0 then
6164 Err_Vars.Error_Msg_File_1 :=
6165 File_Name_Type (Excluded_Source_List_File.Value);
6168 "file with excluded sources { does not exist",
6169 Excluded_Source_List_File.Location, Project.Project);
6174 Prj.Util.Open (File, Source_File_Path_Name);
6176 if not Prj.Util.Is_Valid (File) then
6178 (Data.Flags, "file does not exist",
6179 Location, Project.Project);
6181 -- Read the lines one by one
6183 while not Prj.Util.End_Of_File (File) loop
6184 Prj.Util.Get_Line (File, Line, Last);
6185 Source_File_Line := Source_File_Line + 1;
6187 -- Non empty, non comment line should contain a file name
6190 and then (Last = 1 or else Line (1 .. 2) /= "--")
6193 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6194 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6197 -- Check that there is no directory information
6199 for J in 1 .. Last loop
6201 or else Line (J) = Directory_Separator
6203 Error_Msg_File_1 := Name;
6206 "file name cannot include " &
6207 "directory information ({)",
6208 Location, Project.Project);
6213 Excluded_Sources_Htable.Set
6216 (Name, Source_File_Name, Source_File_Line,
6221 Prj.Util.Close (File);
6226 end Find_Excluded_Sources;
6232 procedure Find_Sources
6233 (Project : in out Project_Processing_Data;
6234 Data : in out Tree_Processing_Data)
6236 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
6238 Sources : constant Variable_Value :=
6241 Project.Project.Decl.Attributes,
6244 Source_List_File : constant Variable_Value :=
6246 (Name_Source_List_File,
6247 Project.Project.Decl.Attributes,
6250 Name_Loc : Name_Location;
6251 Has_Explicit_Sources : Boolean;
6254 pragma Assert (Sources.Kind = List, "Source_Files is not a list");
6256 (Source_List_File.Kind = Single,
6257 "Source_List_File is not a single string");
6259 Project.Source_List_File_Location := Source_List_File.Location;
6261 -- If the user has specified a Source_Files attribute
6263 if not Sources.Default then
6264 if not Source_List_File.Default then
6267 "?both attributes source_files and " &
6268 "source_list_file are present",
6269 Source_List_File.Location, Project.Project);
6272 -- Sources is a list of file names
6275 Current : String_List_Id := Sources.Values;
6276 Element : String_Element;
6277 Location : Source_Ptr;
6278 Name : File_Name_Type;
6281 if Current = Nil_String then
6282 Project.Project.Languages := No_Language_Index;
6284 -- This project contains no source. For projects that don't
6285 -- extend other projects, this also means that there is no
6286 -- need for an object directory, if not specified.
6288 if Project.Project.Extends = No_Project
6290 Project.Project.Object_Directory = Project.Project.Directory
6292 not (Project.Project.Qualifier = Aggregate_Library)
6294 Project.Project.Object_Directory := No_Path_Information;
6298 while Current /= Nil_String loop
6299 Element := Shared.String_Elements.Table (Current);
6300 Name := Canonical_Case_File_Name (Element.Value);
6301 Get_Name_String (Element.Value);
6303 -- If the element has no location, then use the location of
6304 -- Sources to report possible errors.
6306 if Element.Location = No_Location then
6307 Location := Sources.Location;
6309 Location := Element.Location;
6312 -- Check that there is no directory information
6314 for J in 1 .. Name_Len loop
6315 if Name_Buffer (J) = '/'
6316 or else Name_Buffer (J) = Directory_Separator
6318 Error_Msg_File_1 := Name;
6321 "file name cannot include directory " &
6323 Location, Project.Project);
6328 -- Check whether the file is already there: the same file name
6329 -- may be in the list. If the source is missing, the error will
6330 -- be on the first mention of the source file name.
6332 Name_Loc := Source_Names_Htable.Get
6333 (Project.Source_Names, Name);
6335 if Name_Loc = No_Name_Location then
6338 Location => Location,
6339 Source => No_Source,
6344 Name_Loc.Listed := True;
6347 Source_Names_Htable.Set
6348 (Project.Source_Names, Name, Name_Loc);
6350 Current := Element.Next;
6353 Has_Explicit_Sources := True;
6356 -- If we have no Source_Files attribute, check the Source_List_File
6359 elsif not Source_List_File.Default then
6361 -- Source_List_File is the name of the file that contains the source
6365 Source_File_Path_Name : constant String :=
6368 (Source_List_File.Value),
6370 Directory.Display_Name);
6373 Has_Explicit_Sources := True;
6375 if Source_File_Path_Name'Length = 0 then
6376 Err_Vars.Error_Msg_File_1 :=
6377 File_Name_Type (Source_List_File.Value);
6380 "file with sources { does not exist",
6381 Source_List_File.Location, Project.Project);
6384 Get_Sources_From_File
6385 (Source_File_Path_Name, Source_List_File.Location,
6391 -- Neither Source_Files nor Source_List_File has been specified. Find
6392 -- all the files that satisfy the naming scheme in all the source
6395 Has_Explicit_Sources := False;
6398 -- Remove any exception that is not in the specified list of sources
6400 if Has_Explicit_Sources then
6403 Iter : Source_Iterator;
6410 Iter := For_Each_Source (Data.Tree, Project.Project);
6414 Source := Prj.Element (Iter);
6415 exit Source_Loop when Source = No_Source;
6417 if Source.Naming_Exception /= No then
6418 NL := Source_Names_Htable.Get
6419 (Project.Source_Names, Source.File);
6421 if NL /= No_Name_Location and then not NL.Listed then
6422 -- Remove the exception
6423 Source_Names_Htable.Set
6424 (Project.Source_Names,
6427 Remove_Source (Data.Tree, Source, No_Source);
6429 if Source.Naming_Exception = Yes then
6430 Error_Msg_Name_1 := Name_Id (Source.File);
6433 "? unknown source file %%",
6444 end loop Source_Loop;
6446 exit Iter_Loop when not Again;
6454 For_All_Sources => Sources.Default and then Source_List_File.Default);
6456 -- Check if all exceptions have been found
6460 Iter : Source_Iterator;
6461 Found : Boolean := False;
6464 Iter := For_Each_Source (Data.Tree, Project.Project);
6466 Source := Prj.Element (Iter);
6467 exit when Source = No_Source;
6469 -- If the full source path is unknown for this source_id, there
6470 -- could be several reasons:
6471 -- * we simply did not find the file itself, this is an error
6472 -- * we have a multi-unit source file. Another Source_Id from
6473 -- the same file has received the full path, so we need to
6476 if Source.Path = No_Path_Information then
6477 if Source.Naming_Exception = Yes then
6478 if Source.Unit /= No_Unit_Index then
6481 if Source.Index /= 0 then -- Only multi-unit files
6484 Source_Files_Htable.Get
6485 (Data.Tree.Source_Files_HT, Source.File);
6488 while S /= null loop
6489 if S.Path /= No_Path_Information then
6490 Source.Path := S.Path;
6493 if Current_Verbosity = High then
6495 ("setting full path for "
6496 & Get_Name_String (Source.File)
6497 & " at" & Source.Index'Img
6499 & Get_Name_String (Source.Path.Name));
6505 S := S.Next_With_File_Name;
6511 Error_Msg_Name_1 := Name_Id (Source.Display_File);
6512 Error_Msg_Name_2 := Source.Unit.Name;
6514 (Data.Flags, Data.Flags.Missing_Source_Files,
6515 "source file %% for unit %% not found",
6516 No_Location, Project.Project);
6520 if Source.Path = No_Path_Information then
6521 Remove_Source (Data.Tree, Source, No_Source);
6524 elsif Source.Naming_Exception = Inherited then
6525 Remove_Source (Data.Tree, Source, No_Source);
6533 -- It is an error if a source file name in a source list or in a source
6534 -- list file is not found.
6536 if Has_Explicit_Sources then
6539 First_Error : Boolean;
6542 NL := Source_Names_Htable.Get_First (Project.Source_Names);
6543 First_Error := True;
6544 while NL /= No_Name_Location loop
6545 if not NL.Found then
6546 Err_Vars.Error_Msg_File_1 := NL.Name;
6549 (Data.Flags, Data.Flags.Missing_Source_Files,
6550 "source file { not found",
6551 NL.Location, Project.Project);
6552 First_Error := False;
6555 (Data.Flags, Data.Flags.Missing_Source_Files,
6556 "\source file { not found",
6557 NL.Location, Project.Project);
6561 NL := Source_Names_Htable.Get_Next (Project.Source_Names);
6571 procedure Initialize
6572 (Data : out Tree_Processing_Data;
6573 Tree : Project_Tree_Ref;
6574 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
6575 Flags : Prj.Processing_Flags)
6579 Data.Node_Tree := Node_Tree;
6580 Data.Flags := Flags;
6587 procedure Free (Data : in out Tree_Processing_Data) is
6588 pragma Unreferenced (Data);
6597 procedure Initialize
6598 (Data : in out Project_Processing_Data;
6599 Project : Project_Id)
6602 Data.Project := Project;
6609 procedure Free (Data : in out Project_Processing_Data) is
6611 Source_Names_Htable.Reset (Data.Source_Names);
6612 Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions);
6613 Excluded_Sources_Htable.Reset (Data.Excluded);
6616 -------------------------------
6617 -- Check_File_Naming_Schemes --
6618 -------------------------------
6620 procedure Check_File_Naming_Schemes
6621 (Project : Project_Processing_Data;
6622 File_Name : File_Name_Type;
6623 Alternate_Languages : out Language_List;
6624 Language : out Language_Ptr;
6625 Display_Language_Name : out Name_Id;
6627 Lang_Kind : out Language_Kind;
6628 Kind : out Source_Kind)
6630 Filename : constant String := Get_Name_String (File_Name);
6631 Config : Language_Config;
6632 Tmp_Lang : Language_Ptr;
6634 Header_File : Boolean := False;
6635 -- True if we found at least one language for which the file is a header
6636 -- In such a case, we search for all possible languages where this is
6637 -- also a header (C and C++ for instance), since the file might be used
6638 -- for several such languages.
6640 procedure Check_File_Based_Lang;
6641 -- Does the naming scheme test for file-based languages. For those,
6642 -- there is no Unit. Just check if the file name has the implementation
6643 -- or, if it is specified, the template suffix of the language.
6645 -- Returns True if the file belongs to the current language and we
6646 -- should stop searching for matching languages. Not that a given header
6647 -- file could belong to several languages (C and C++ for instance). Thus
6648 -- if we found a header we'll check whether it matches other languages.
6650 ---------------------------
6651 -- Check_File_Based_Lang --
6652 ---------------------------
6654 procedure Check_File_Based_Lang is
6657 and then Suffix_Matches (Filename, Config.Naming_Data.Body_Suffix)
6661 Language := Tmp_Lang;
6664 ("implementation of language ", Display_Language_Name);
6666 elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
6668 ("header of language ", Display_Language_Name);
6671 Alternate_Languages := new Language_List_Element'
6672 (Language => Language,
6673 Next => Alternate_Languages);
6676 Header_File := True;
6679 Language := Tmp_Lang;
6682 end Check_File_Based_Lang;
6684 -- Start of processing for Check_File_Naming_Schemes
6687 Language := No_Language_Index;
6688 Alternate_Languages := null;
6689 Display_Language_Name := No_Name;
6691 Lang_Kind := File_Based;
6694 Tmp_Lang := Project.Project.Languages;
6695 while Tmp_Lang /= No_Language_Index loop
6696 if Current_Verbosity = High then
6698 ("testing language "
6699 & Get_Name_String (Tmp_Lang.Name)
6700 & " Header_File=" & Header_File'Img);
6703 Display_Language_Name := Tmp_Lang.Display_Name;
6704 Config := Tmp_Lang.Config;
6705 Lang_Kind := Config.Kind;
6709 Check_File_Based_Lang;
6710 exit when Kind = Impl;
6714 -- We know it belongs to a least a file_based language, no
6715 -- need to check unit-based ones.
6717 if not Header_File then
6719 (File_Name => File_Name,
6720 Naming => Config.Naming_Data,
6723 Project => Project);
6725 if Unit /= No_Name then
6726 Language := Tmp_Lang;
6732 Tmp_Lang := Tmp_Lang.Next;
6735 if Language = No_Language_Index then
6736 Debug_Output ("not a source of any language");
6738 end Check_File_Naming_Schemes;
6744 procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is
6746 -- If the file was previously already associated with a unit, change it
6748 if Source.Unit /= null
6749 and then Source.Kind in Spec_Or_Body
6750 and then Source.Unit.File_Names (Source.Kind) /= null
6752 -- If we had another file referencing the same unit (for instance it
6753 -- was in an extended project), that source file is in fact invisible
6754 -- from now on, and in particular doesn't belong to the same unit.
6755 -- If the source is an inherited naming exception, then it may not
6756 -- really exist: the source potentially replaced is left untouched.
6758 if Source.Unit.File_Names (Source.Kind) /= Source then
6759 Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
6762 Source.Unit.File_Names (Source.Kind) := null;
6765 Source.Kind := Kind;
6767 if Current_Verbosity = High
6768 and then Source.File /= No_File
6770 Debug_Output ("override kind for "
6771 & Get_Name_String (Source.File)
6772 & " idx=" & Source.Index'Img
6773 & " kind=" & Source.Kind'Img);
6776 if Source.Unit /= null then
6777 if Source.Kind = Spec then
6778 Source.Unit.File_Names (Spec) := Source;
6780 Source.Unit.File_Names (Impl) := Source;
6789 procedure Check_File
6790 (Project : in out Project_Processing_Data;
6791 Data : in out Tree_Processing_Data;
6792 Source_Dir_Rank : Natural;
6793 Path : Path_Name_Type;
6794 Display_Path : Path_Name_Type;
6795 File_Name : File_Name_Type;
6796 Display_File_Name : File_Name_Type;
6797 Locally_Removed : Boolean;
6798 For_All_Sources : Boolean)
6800 Name_Loc : Name_Location :=
6801 Source_Names_Htable.Get
6802 (Project.Source_Names, File_Name);
6803 Check_Name : Boolean := False;
6804 Alternate_Languages : Language_List;
6805 Language : Language_Ptr;
6807 Src_Ind : Source_File_Index;
6809 Display_Language_Name : Name_Id;
6810 Lang_Kind : Language_Kind;
6811 Kind : Source_Kind := Spec;
6814 if Current_Verbosity = High then
6815 Debug_Increase_Indent
6816 ("checking file (rank=" & Source_Dir_Rank'Img & ")",
6817 Name_Id (Display_Path));
6820 if Name_Loc = No_Name_Location then
6821 Check_Name := For_All_Sources;
6824 if Name_Loc.Found then
6826 -- Check if it is OK to have the same file name in several
6827 -- source directories.
6829 if Source_Dir_Rank = Name_Loc.Source.Source_Dir_Rank then
6830 Error_Msg_File_1 := File_Name;
6833 "{ is found in several source directories",
6834 Name_Loc.Location, Project.Project);
6838 Name_Loc.Found := True;
6840 Source_Names_Htable.Set
6841 (Project.Source_Names, File_Name, Name_Loc);
6843 if Name_Loc.Source = No_Source then
6847 -- Set the full path for the source_id (which might have been
6848 -- created when parsing the naming exceptions, and therefore
6849 -- might not have the full path).
6850 -- We only set this for this source_id, but not for other
6851 -- source_id in the same file (case of multi-unit source files)
6852 -- For the latter, they will be set in Find_Sources when we
6853 -- check that all source_id have known full paths.
6854 -- Doing this later saves one htable lookup per file in the
6855 -- common case where the user is not using multi-unit files.
6857 Name_Loc.Source.Path := (Path, Display_Path);
6859 Source_Paths_Htable.Set
6860 (Data.Tree.Source_Paths_HT, Path, Name_Loc.Source);
6862 -- Check if this is a subunit
6864 if Name_Loc.Source.Unit /= No_Unit_Index
6865 and then Name_Loc.Source.Kind = Impl
6867 Src_Ind := Sinput.P.Load_Project_File
6868 (Get_Name_String (Display_Path));
6870 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
6871 Override_Kind (Name_Loc.Source, Sep);
6875 -- If this is an inherited naming exception, make sure that
6876 -- the naming exception it replaces is no longer a source.
6878 if Name_Loc.Source.Naming_Exception = Inherited then
6880 Proj : Project_Id := Name_Loc.Source.Project.Extends;
6881 Iter : Source_Iterator;
6884 while Proj /= No_Project loop
6885 Iter := For_Each_Source (Data.Tree, Proj);
6886 Src := Prj.Element (Iter);
6887 while Src /= No_Source loop
6888 if Src.File = Name_Loc.Source.File then
6889 Src.Replaced_By := Name_Loc.Source;
6894 Src := Prj.Element (Iter);
6897 Proj := Proj.Extends;
6901 if Name_Loc.Source.Unit /= No_Unit_Index then
6902 if Name_Loc.Source.Kind = Spec then
6903 Name_Loc.Source.Unit.File_Names (Spec) :=
6906 elsif Name_Loc.Source.Kind = Impl then
6907 Name_Loc.Source.Unit.File_Names (Impl) :=
6912 (Data.Tree.Units_HT,
6913 Name_Loc.Source.Unit.Name,
6914 Name_Loc.Source.Unit);
6922 Check_File_Naming_Schemes
6923 (Project => Project,
6924 File_Name => File_Name,
6925 Alternate_Languages => Alternate_Languages,
6926 Language => Language,
6927 Display_Language_Name => Display_Language_Name,
6929 Lang_Kind => Lang_Kind,
6932 if Language = No_Language_Index then
6934 -- A file name in a list must be a source of a language
6936 if Data.Flags.Error_On_Unknown_Language
6937 and then Name_Loc.Found
6939 Error_Msg_File_1 := File_Name;
6942 "language unknown for {",
6943 Name_Loc.Location, Project.Project);
6949 Project => Project.Project,
6950 Source_Dir_Rank => Source_Dir_Rank,
6951 Lang_Id => Language,
6954 Alternate_Languages => Alternate_Languages,
6955 File_Name => File_Name,
6956 Display_File => Display_File_Name,
6958 Locally_Removed => Locally_Removed,
6959 Path => (Path, Display_Path));
6961 -- If it is a source specified in a list, update the entry in
6962 -- the Source_Names table.
6964 if Name_Loc.Found and then Name_Loc.Source = No_Source then
6965 Name_Loc.Source := Source;
6966 Source_Names_Htable.Set
6967 (Project.Source_Names, File_Name, Name_Loc);
6972 Debug_Decrease_Indent;
6975 ---------------------------------
6976 -- Expand_Subdirectory_Pattern --
6977 ---------------------------------
6979 procedure Expand_Subdirectory_Pattern
6980 (Project : Project_Id;
6981 Data : in out Tree_Processing_Data;
6982 Patterns : String_List_Id;
6983 Ignore : String_List_Id;
6984 Search_For : Search_Type;
6985 Resolve_Links : Boolean)
6987 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
6989 package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable
6990 (Header_Num => Header_Num,
6992 No_Element => False,
6993 Key => Path_Name_Type,
6996 -- Hash table stores recursive source directories, to avoid looking
6997 -- several times, and to avoid cycles that may be introduced by symbolic
7000 File_Pattern : GNAT.Regexp.Regexp;
7001 -- Pattern to use when matching file names
7003 Visited : Recursive_Dirs.Instance;
7005 procedure Find_Pattern
7006 (Pattern_Id : Name_Id;
7008 Location : Source_Ptr);
7009 -- Find a specific pattern
7011 function Recursive_Find_Dirs
7012 (Path : Path_Information;
7013 Rank : Natural) return Boolean;
7014 -- Search all the subdirectories (recursively) of Path.
7015 -- Return True if at least one file or directory was processed
7017 function Subdirectory_Matches
7018 (Path : Path_Information;
7019 Rank : Natural) return Boolean;
7020 -- Called when a matching directory was found. If the user is in fact
7021 -- searching for files, we then search for those files matching the
7022 -- pattern within the directory.
7023 -- Return True if at least one file or directory was processed
7025 --------------------------
7026 -- Subdirectory_Matches --
7027 --------------------------
7029 function Subdirectory_Matches
7030 (Path : Path_Information;
7031 Rank : Natural) return Boolean
7034 Name : String (1 .. 250);
7036 Found : Path_Information;
7037 Success : Boolean := False;
7041 when Search_Directories =>
7042 Callback (Path, Rank);
7045 when Search_Files =>
7046 Open (Dir, Get_Name_String (Path.Display_Name));
7048 Read (Dir, Name, Last);
7051 if Name (Name'First .. Last) /= "."
7052 and then Name (Name'First .. Last) /= ".."
7053 and then Match (Name (Name'First .. Last), File_Pattern)
7055 Get_Name_String (Path.Display_Name);
7056 Add_Str_To_Name_Buffer (Name (Name'First .. Last));
7058 Found.Display_Name := Name_Find;
7059 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7060 Found.Name := Name_Find;
7062 Callback (Found, Rank);
7071 end Subdirectory_Matches;
7073 -------------------------
7074 -- Recursive_Find_Dirs --
7075 -------------------------
7077 function Recursive_Find_Dirs
7078 (Path : Path_Information;
7079 Rank : Natural) return Boolean
7081 Path_Str : constant String := Get_Name_String (Path.Display_Name);
7083 Name : String (1 .. 250);
7085 Success : Boolean := False;
7088 Debug_Output ("looking for subdirs of ", Name_Id (Path.Display_Name));
7090 if Recursive_Dirs.Get (Visited, Path.Name) then
7094 Recursive_Dirs.Set (Visited, Path.Name, True);
7096 Success := Subdirectory_Matches (Path, Rank) or Success;
7098 Open (Dir, Path_Str);
7101 Read (Dir, Name, Last);
7104 if Name (1 .. Last) /= "."
7106 Name (1 .. Last) /= ".."
7109 Path_Name : constant String :=
7111 (Name => Name (1 .. Last),
7112 Directory => Path_Str,
7113 Resolve_Links => Resolve_Links)
7114 & Directory_Separator;
7115 Path2 : Path_Information;
7116 OK : Boolean := True;
7119 if Is_Directory (Path_Name) then
7120 if Ignore /= Nil_String then
7122 Dir_Name : String := Name (1 .. Last);
7123 List : String_List_Id := Ignore;
7126 Canonical_Case_File_Name (Dir_Name);
7128 while List /= Nil_String loop
7130 (Shared.String_Elements.Table (List).Value);
7131 Canonical_Case_File_Name
7132 (Name_Buffer (1 .. Name_Len));
7133 OK := Name_Buffer (1 .. Name_Len) /= Dir_Name;
7135 List := Shared.String_Elements.Table (List).Next;
7142 Add_Str_To_Name_Buffer (Path_Name);
7143 Path2.Display_Name := Name_Find;
7145 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7146 Path2.Name := Name_Find;
7149 Recursive_Find_Dirs (Path2, Rank) or Success;
7161 when Directory_Error =>
7163 end Recursive_Find_Dirs;
7169 procedure Find_Pattern
7170 (Pattern_Id : Name_Id;
7172 Location : Source_Ptr)
7174 Pattern : constant String := Get_Name_String (Pattern_Id);
7175 Pattern_End : Natural := Pattern'Last;
7176 Recursive : Boolean;
7177 Dir : File_Name_Type;
7178 Path_Name : Path_Information;
7179 Dir_Exists : Boolean;
7180 Has_Error : Boolean := False;
7184 Debug_Increase_Indent ("Find_Pattern", Pattern_Id);
7186 -- If we are looking for files, find the pattern for the files
7188 if Search_For = Search_Files then
7189 while Pattern_End >= Pattern'First
7190 and then Pattern (Pattern_End) /= '/'
7191 and then Pattern (Pattern_End) /= Directory_Separator
7193 Pattern_End := Pattern_End - 1;
7196 if Pattern_End = Pattern'Last then
7197 Err_Vars.Error_Msg_File_1 := File_Name_Type (Pattern_Id);
7199 (Data.Flags, Data.Flags.Missing_Source_Files,
7200 "Missing file name or pattern in {", Location, Project);
7204 if Current_Verbosity = High then
7206 Write_Str ("file_pattern=");
7207 Write_Str (Pattern (Pattern_End + 1 .. Pattern'Last));
7208 Write_Str (" dir_pattern=");
7209 Write_Line (Pattern (Pattern'First .. Pattern_End));
7212 File_Pattern := Compile
7213 (Pattern (Pattern_End + 1 .. Pattern'Last),
7215 Case_Sensitive => File_Names_Case_Sensitive);
7217 -- If we had just "*.gpr", this is equivalent to "./*.gpr"
7219 if Pattern_End > Pattern'First then
7220 Pattern_End := Pattern_End - 1; -- Skip directory separator
7225 Pattern_End - 1 >= Pattern'First
7226 and then Pattern (Pattern_End - 1 .. Pattern_End) = "**"
7227 and then (Pattern_End - 1 = Pattern'First
7228 or else Pattern (Pattern_End - 2) = '/'
7229 or else Pattern (Pattern_End - 2) = Directory_Separator);
7232 Pattern_End := Pattern_End - 2;
7233 if Pattern_End > Pattern'First then
7234 Pattern_End := Pattern_End - 1; -- Skip '/'
7238 Name_Len := Pattern_End - Pattern'First + 1;
7239 Name_Buffer (1 .. Name_Len) := Pattern (Pattern'First .. Pattern_End);
7243 (Project => Project,
7246 Dir_Exists => Dir_Exists,
7248 Must_Exist => False);
7250 if not Dir_Exists then
7251 Err_Vars.Error_Msg_File_1 := Dir;
7253 (Data.Flags, Data.Flags.Missing_Source_Files,
7254 "{ is not a valid directory", Location, Project);
7255 Has_Error := Data.Flags.Missing_Source_Files = Error;
7258 if not Has_Error then
7260 -- Links have been resolved if necessary, and Path_Name
7261 -- always ends with a directory separator.
7264 Success := Recursive_Find_Dirs (Path_Name, Rank);
7266 Success := Subdirectory_Matches (Path_Name, Rank);
7271 when Search_Directories =>
7272 null; -- Error can't occur
7274 when Search_Files =>
7275 Err_Vars.Error_Msg_File_1 := File_Name_Type (Pattern_Id);
7277 (Data.Flags, Data.Flags.Missing_Source_Files,
7278 "file { not found", Location, Project);
7283 Debug_Decrease_Indent ("done Find_Pattern");
7288 Pattern_Id : String_List_Id := Patterns;
7289 Element : String_Element;
7290 Rank : Natural := 1;
7292 -- Start of processing for Expand_Subdirectory_Pattern
7295 while Pattern_Id /= Nil_String loop
7296 Element := Shared.String_Elements.Table (Pattern_Id);
7297 Find_Pattern (Element.Value, Rank, Element.Location);
7299 Pattern_Id := Element.Next;
7302 Recursive_Dirs.Reset (Visited);
7303 end Expand_Subdirectory_Pattern;
7305 ------------------------
7306 -- Search_Directories --
7307 ------------------------
7309 procedure Search_Directories
7310 (Project : in out Project_Processing_Data;
7311 Data : in out Tree_Processing_Data;
7312 For_All_Sources : Boolean)
7314 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
7316 Source_Dir : String_List_Id;
7317 Element : String_Element;
7318 Src_Dir_Rank : Number_List_Index;
7319 Num_Nod : Number_Node;
7321 Name : String (1 .. 1_000);
7323 File_Name : File_Name_Type;
7324 Display_File_Name : File_Name_Type;
7327 Debug_Increase_Indent ("looking for sources of", Project.Project.Name);
7329 -- Loop through subdirectories
7331 Src_Dir_Rank := Project.Project.Source_Dir_Ranks;
7333 Source_Dir := Project.Project.Source_Dirs;
7334 while Source_Dir /= Nil_String loop
7336 Num_Nod := Shared.Number_Lists.Table (Src_Dir_Rank);
7337 Element := Shared.String_Elements.Table (Source_Dir);
7339 -- Use Element.Value in this test, not Display_Value, because we
7340 -- want the symbolic links to be resolved when appropriate.
7342 if Element.Value /= No_Name then
7344 Source_Directory : constant String :=
7345 Get_Name_String (Element.Value)
7346 & Directory_Separator;
7348 Dir_Last : constant Natural :=
7349 Compute_Directory_Last (Source_Directory);
7351 Display_Source_Directory : constant String :=
7353 (Element.Display_Value)
7354 & Directory_Separator;
7355 -- Display_Source_Directory is to allow us to open a UTF-8
7356 -- encoded directory on Windows.
7359 if Current_Verbosity = High then
7360 Debug_Increase_Indent
7361 ("Source_Dir (node=" & Num_Nod.Number'Img & ") """
7362 & Source_Directory (Source_Directory'First .. Dir_Last)
7366 -- We look to every entry in the source directory
7368 Open (Dir, Display_Source_Directory);
7371 Read (Dir, Name, Last);
7374 -- In fast project loading mode (without -eL), the user
7375 -- guarantees that no directory has a name which is a
7376 -- valid source name, so we can avoid doing a system call
7377 -- here. This provides a very significant speed up on
7378 -- slow file systems (remote files for instance).
7380 if not Opt.Follow_Links_For_Files
7381 or else Is_Regular_File
7382 (Display_Source_Directory & Name (1 .. Last))
7385 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
7386 Display_File_Name := Name_Find;
7388 if Osint.File_Names_Case_Sensitive then
7389 File_Name := Display_File_Name;
7391 Canonical_Case_File_Name
7392 (Name_Buffer (1 .. Name_Len));
7393 File_Name := Name_Find;
7397 Path_Name : constant String :=
7402 (Source_Directory'First ..
7405 Opt.Follow_Links_For_Files,
7406 Case_Sensitive => True);
7408 Path : Path_Name_Type;
7410 Excluded_Sources_Htable.Get
7411 (Project.Excluded, File_Name);
7412 To_Remove : Boolean := False;
7415 Name_Len := Path_Name'Length;
7416 Name_Buffer (1 .. Name_Len) := Path_Name;
7418 if Osint.File_Names_Case_Sensitive then
7421 Canonical_Case_File_Name
7422 (Name_Buffer (1 .. Name_Len));
7426 if FF /= No_File_Found then
7427 if not FF.Found then
7429 Excluded_Sources_Htable.Set
7430 (Project.Excluded, File_Name, FF);
7433 ("excluded source ",
7434 Name_Id (Display_File_Name));
7436 -- Will mark the file as removed, but we
7437 -- still need to add it to the list: if we
7438 -- don't, the file will not appear in the
7439 -- mapping file and will cause the compiler
7446 -- Preserve the user's original casing and use of
7447 -- links. The display_value (a directory) already
7448 -- ends with a directory separator by construction,
7449 -- so no need to add one.
7451 Get_Name_String (Element.Display_Value);
7452 Get_Name_String_And_Append (Display_File_Name);
7455 (Project => Project,
7456 Source_Dir_Rank => Num_Nod.Number,
7459 Display_Path => Name_Find,
7460 File_Name => File_Name,
7461 Locally_Removed => To_Remove,
7462 Display_File_Name => Display_File_Name,
7463 For_All_Sources => For_All_Sources);
7467 if Current_Verbosity = High then
7468 Debug_Output ("ignore " & Name (1 .. Last));
7473 Debug_Decrease_Indent;
7479 when Directory_Error =>
7483 Source_Dir := Element.Next;
7484 Src_Dir_Rank := Num_Nod.Next;
7487 Debug_Decrease_Indent ("end looking for sources.");
7488 end Search_Directories;
7490 ----------------------------
7491 -- Load_Naming_Exceptions --
7492 ----------------------------
7494 procedure Load_Naming_Exceptions
7495 (Project : in out Project_Processing_Data;
7496 Data : in out Tree_Processing_Data)
7499 Iter : Source_Iterator;
7502 Iter := For_Each_Source (Data.Tree, Project.Project);
7504 Source := Prj.Element (Iter);
7505 exit when Source = No_Source;
7507 -- An excluded file cannot also be an exception file name
7509 if Excluded_Sources_Htable.Get (Project.Excluded, Source.File) /=
7512 Error_Msg_File_1 := Source.File;
7515 "{ cannot be both excluded and an exception file name",
7516 No_Location, Project.Project);
7520 ("naming exception: adding source file to source_Names: ",
7521 Name_Id (Source.File));
7523 Source_Names_Htable.Set
7524 (Project.Source_Names,
7527 (Name => Source.File,
7528 Location => Source.Location,
7533 -- If this is an Ada exception, record in table Unit_Exceptions
7535 if Source.Unit /= No_Unit_Index then
7537 Unit_Except : Unit_Exception :=
7538 Unit_Exceptions_Htable.Get
7539 (Project.Unit_Exceptions, Source.Unit.Name);
7542 Unit_Except.Name := Source.Unit.Name;
7544 if Source.Kind = Spec then
7545 Unit_Except.Spec := Source.File;
7547 Unit_Except.Impl := Source.File;
7550 Unit_Exceptions_Htable.Set
7551 (Project.Unit_Exceptions, Source.Unit.Name, Unit_Except);
7557 end Load_Naming_Exceptions;
7559 ----------------------
7560 -- Look_For_Sources --
7561 ----------------------
7563 procedure Look_For_Sources
7564 (Project : in out Project_Processing_Data;
7565 Data : in out Tree_Processing_Data)
7567 Object_Files : Object_File_Names_Htable.Instance;
7568 Iter : Source_Iterator;
7571 procedure Check_Object (Src : Source_Id);
7572 -- Check if object file name of Src is already used in the project tree,
7573 -- and report an error if so.
7575 procedure Check_Object_Files;
7576 -- Check that no two sources of this project have the same object file
7578 procedure Mark_Excluded_Sources;
7579 -- Mark as such the sources that are declared as excluded
7581 procedure Check_Missing_Sources;
7582 -- Check whether one of the languages has no sources, and report an
7583 -- error when appropriate
7585 procedure Get_Sources_From_Source_Info;
7586 -- Get the source information from the tables that were created when a
7587 -- source info file was read.
7589 ---------------------------
7590 -- Check_Missing_Sources --
7591 ---------------------------
7593 procedure Check_Missing_Sources is
7594 Extending : constant Boolean :=
7595 Project.Project.Extends /= No_Project;
7596 Language : Language_Ptr;
7598 Alt_Lang : Language_List;
7599 Continuation : Boolean := False;
7600 Iter : Source_Iterator;
7602 if not Project.Project.Externally_Built
7603 and then not Extending
7605 Language := Project.Project.Languages;
7606 while Language /= No_Language_Index loop
7608 -- If there are no sources for this language, check if there
7609 -- are sources for which this is an alternate language.
7611 if Language.First_Source = No_Source
7612 and then (Data.Flags.Require_Sources_Other_Lang
7613 or else Language.Name = Name_Ada)
7615 Iter := For_Each_Source (In_Tree => Data.Tree,
7616 Project => Project.Project);
7618 Source := Element (Iter);
7619 exit Source_Loop when Source = No_Source
7620 or else Source.Language = Language;
7622 Alt_Lang := Source.Alternate_Languages;
7623 while Alt_Lang /= null loop
7624 exit Source_Loop when Alt_Lang.Language = Language;
7625 Alt_Lang := Alt_Lang.Next;
7629 end loop Source_Loop;
7631 if Source = No_Source then
7634 Get_Name_String (Language.Display_Name),
7636 Project.Source_List_File_Location,
7638 Continuation := True;
7642 Language := Language.Next;
7645 end Check_Missing_Sources;
7651 procedure Check_Object (Src : Source_Id) is
7655 Source := Object_File_Names_Htable.Get (Object_Files, Src.Object);
7657 -- We cannot just check on "Source /= Src", since we might have
7658 -- two different entries for the same file (and since that's
7659 -- the same file it is expected that it has the same object)
7661 if Source /= No_Source
7662 and then Source.Replaced_By = No_Source
7663 and then Source.Path /= Src.Path
7664 and then Is_Extending (Src.Project, Source.Project)
7666 Error_Msg_File_1 := Src.File;
7667 Error_Msg_File_2 := Source.File;
7670 "{ and { have the same object file name",
7671 No_Location, Project.Project);
7674 Object_File_Names_Htable.Set (Object_Files, Src.Object, Src);
7678 ---------------------------
7679 -- Mark_Excluded_Sources --
7680 ---------------------------
7682 procedure Mark_Excluded_Sources is
7683 Source : Source_Id := No_Source;
7684 Excluded : File_Found;
7688 -- Minor optimization: if there are no excluded files, no need to
7689 -- traverse the list of sources. We cannot however also check whether
7690 -- the existing exceptions have ".Found" set to True (indicating we
7691 -- found them before) because we need to do some final processing on
7692 -- them in any case.
7694 if Excluded_Sources_Htable.Get_First (Project.Excluded) /=
7697 Proj := Project.Project;
7698 while Proj /= No_Project loop
7699 Iter := For_Each_Source (Data.Tree, Proj);
7700 while Prj.Element (Iter) /= No_Source loop
7701 Source := Prj.Element (Iter);
7702 Excluded := Excluded_Sources_Htable.Get
7703 (Project.Excluded, Source.File);
7705 if Excluded /= No_File_Found then
7706 Source.Locally_Removed := True;
7707 Source.In_Interfaces := False;
7709 if Current_Verbosity = High then
7711 Write_Str ("removing file ");
7713 (Get_Name_String (Excluded.File)
7714 & " " & Get_Name_String (Source.Project.Name));
7717 Excluded_Sources_Htable.Remove
7718 (Project.Excluded, Source.File);
7724 Proj := Proj.Extends;
7728 -- If we have any excluded element left, that means we did not find
7731 Excluded := Excluded_Sources_Htable.Get_First (Project.Excluded);
7732 while Excluded /= No_File_Found loop
7733 if not Excluded.Found then
7735 -- Check if the file belongs to another imported project to
7736 -- provide a better error message.
7739 (In_Tree => Data.Tree,
7740 Project => Project.Project,
7741 In_Imported_Only => True,
7742 Base_Name => Excluded.File);
7744 Err_Vars.Error_Msg_File_1 := Excluded.File;
7746 if Src = No_Source then
7747 if Excluded.Excl_File = No_File then
7750 "unknown file {", Excluded.Location, Project.Project);
7756 Get_Name_String (Excluded.Excl_File) & ":" &
7757 No_Space_Img (Excluded.Excl_Line) &
7758 ": unknown file {", Excluded.Location, Project.Project);
7762 if Excluded.Excl_File = No_File then
7765 "cannot remove a source from an imported project: {",
7766 Excluded.Location, Project.Project);
7772 Get_Name_String (Excluded.Excl_File) & ":" &
7773 No_Space_Img (Excluded.Excl_Line) &
7774 ": cannot remove a source from an imported project: {",
7775 Excluded.Location, Project.Project);
7780 Excluded := Excluded_Sources_Htable.Get_Next (Project.Excluded);
7782 end Mark_Excluded_Sources;
7784 ------------------------
7785 -- Check_Object_Files --
7786 ------------------------
7788 procedure Check_Object_Files is
7789 Iter : Source_Iterator;
7791 Src_Ind : Source_File_Index;
7794 Iter := For_Each_Source (Data.Tree);
7796 Src_Id := Prj.Element (Iter);
7797 exit when Src_Id = No_Source;
7799 if Is_Compilable (Src_Id)
7800 and then Src_Id.Language.Config.Object_Generated
7801 and then Is_Extending (Project.Project, Src_Id.Project)
7803 if Src_Id.Unit = No_Unit_Index then
7804 if Src_Id.Kind = Impl then
7805 Check_Object (Src_Id);
7811 if Other_Part (Src_Id) = No_Source then
7812 Check_Object (Src_Id);
7819 if Other_Part (Src_Id) /= No_Source then
7820 Check_Object (Src_Id);
7823 -- Check if it is a subunit
7826 Sinput.P.Load_Project_File
7827 (Get_Name_String (Src_Id.Path.Display_Name));
7829 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
7830 Override_Kind (Src_Id, Sep);
7832 Check_Object (Src_Id);
7841 end Check_Object_Files;
7843 ----------------------------------
7844 -- Get_Sources_From_Source_Info --
7845 ----------------------------------
7847 procedure Get_Sources_From_Source_Info is
7848 Iter : Source_Info_Iterator;
7851 Lang_Id : Language_Ptr;
7854 Initialize (Iter, Project.Project.Name);
7857 Src := Source_Info_Of (Iter);
7859 exit when Src = No_Source_Info;
7861 Id := new Source_Data;
7863 Id.Project := Project.Project;
7865 Lang_Id := Project.Project.Languages;
7866 while Lang_Id /= No_Language_Index
7867 and then Lang_Id.Name /= Src.Language
7869 Lang_Id := Lang_Id.Next;
7872 if Lang_Id = No_Language_Index then
7874 ("unknown language " &
7875 Get_Name_String (Src.Language) &
7877 Get_Name_String (Src.Project) &
7878 " in source info file");
7881 Id.Language := Lang_Id;
7882 Id.Kind := Src.Kind;
7883 Id.Index := Src.Index;
7886 (Path_Name_Type (Src.Display_Path_Name),
7887 Path_Name_Type (Src.Path_Name));
7890 Add_Str_To_Name_Buffer
7891 (Directories.Simple_Name (Get_Name_String (Src.Path_Name)));
7892 Id.File := Name_Find;
7894 Id.Next_With_File_Name :=
7895 Source_Files_Htable.Get (Data.Tree.Source_Files_HT, Id.File);
7896 Source_Files_Htable.Set (Data.Tree.Source_Files_HT, Id.File, Id);
7899 Add_Str_To_Name_Buffer
7900 (Directories.Simple_Name
7901 (Get_Name_String (Src.Display_Path_Name)));
7902 Id.Display_File := Name_Find;
7905 Dependency_Name (Id.File, Id.Language.Config.Dependency_Kind);
7906 Id.Naming_Exception := Src.Naming_Exception;
7908 Object_Name (Id.File, Id.Language.Config.Object_File_Suffix);
7909 Id.Switches := Switches_Name (Id.File);
7911 -- Add the source id to the Unit_Sources_HT hash table, if the
7912 -- unit name is not null.
7914 if Src.Kind /= Sep and then Src.Unit_Name /= No_Name then
7917 UData : Unit_Index :=
7919 (Data.Tree.Units_HT, Src.Unit_Name);
7921 if UData = No_Unit_Index then
7922 UData := new Unit_Data;
7923 UData.Name := Src.Unit_Name;
7925 (Data.Tree.Units_HT, Src.Unit_Name, UData);
7931 -- Note that this updates Unit information as well
7933 Override_Kind (Id, Id.Kind);
7936 if Src.Index /= 0 then
7937 Project.Project.Has_Multi_Unit_Sources := True;
7940 -- Add the source to the language list
7942 Id.Next_In_Lang := Id.Language.First_Source;
7943 Id.Language.First_Source := Id;
7947 end Get_Sources_From_Source_Info;
7949 -- Start of processing for Look_For_Sources
7952 if Data.Tree.Source_Info_File_Exists then
7953 Get_Sources_From_Source_Info;
7956 if Project.Project.Source_Dirs /= Nil_String then
7957 Find_Excluded_Sources (Project, Data);
7959 if Project.Project.Languages /= No_Language_Index then
7960 Load_Naming_Exceptions (Project, Data);
7961 Find_Sources (Project, Data);
7962 Mark_Excluded_Sources;
7964 Check_Missing_Sources;
7968 Object_File_Names_Htable.Reset (Object_Files);
7970 end Look_For_Sources;
7976 function Path_Name_Of
7977 (File_Name : File_Name_Type;
7978 Directory : Path_Name_Type) return String
7980 Result : String_Access;
7981 The_Directory : constant String := Get_Name_String (Directory);
7984 Debug_Output ("Path_Name_Of file name=", Name_Id (File_Name));
7985 Debug_Output ("Path_Name_Of directory=", Name_Id (Directory));
7986 Get_Name_String (File_Name);
7989 (File_Name => Name_Buffer (1 .. Name_Len),
7990 Path => The_Directory);
7992 if Result = null then
7996 R : constant String := Result.all;
8008 procedure Remove_Source
8009 (Tree : Project_Tree_Ref;
8011 Replaced_By : Source_Id)
8016 if Current_Verbosity = High then
8018 Write_Str ("removing source ");
8019 Write_Str (Get_Name_String (Id.File));
8021 if Id.Index /= 0 then
8022 Write_Str (" at" & Id.Index'Img);
8028 if Replaced_By /= No_Source then
8029 Id.Replaced_By := Replaced_By;
8030 Replaced_By.Declared_In_Interfaces := Id.Declared_In_Interfaces;
8032 if Id.File /= Replaced_By.File then
8034 Replacement : constant File_Name_Type :=
8035 Replaced_Source_HTable.Get
8036 (Tree.Replaced_Sources, Id.File);
8039 Replaced_Source_HTable.Set
8040 (Tree.Replaced_Sources, Id.File, Replaced_By.File);
8042 if Replacement = No_File then
8043 Tree.Replaced_Source_Number :=
8044 Tree.Replaced_Source_Number + 1;
8050 Id.In_Interfaces := False;
8051 Id.Locally_Removed := True;
8053 -- ??? Should we remove the source from the unit ? The file is not used,
8054 -- so probably should not be referenced from the unit. On the other hand
8055 -- it might give useful additional info
8056 -- if Id.Unit /= null then
8057 -- Id.Unit.File_Names (Id.Kind) := null;
8060 Source := Id.Language.First_Source;
8063 Id.Language.First_Source := Id.Next_In_Lang;
8066 while Source.Next_In_Lang /= Id loop
8067 Source := Source.Next_In_Lang;
8070 Source.Next_In_Lang := Id.Next_In_Lang;
8074 -----------------------
8075 -- Report_No_Sources --
8076 -----------------------
8078 procedure Report_No_Sources
8079 (Project : Project_Id;
8081 Data : Tree_Processing_Data;
8082 Location : Source_Ptr;
8083 Continuation : Boolean := False)
8086 case Data.Flags.When_No_Sources is
8090 when Warning | Error =>
8092 Msg : constant String :=
8094 & Lang_Name & " sources in this project";
8097 Error_Msg_Warn := Data.Flags.When_No_Sources = Warning;
8099 if Continuation then
8100 Error_Msg (Data.Flags, "\" & Msg, Location, Project);
8102 Error_Msg (Data.Flags, Msg, Location, Project);
8106 end Report_No_Sources;
8108 ----------------------
8109 -- Show_Source_Dirs --
8110 ----------------------
8112 procedure Show_Source_Dirs
8113 (Project : Project_Id;
8114 Shared : Shared_Project_Tree_Data_Access)
8116 Current : String_List_Id;
8117 Element : String_Element;
8120 if Project.Source_Dirs = Nil_String then
8121 Debug_Output ("no Source_Dirs");
8123 Debug_Increase_Indent ("Source_Dirs:");
8125 Current := Project.Source_Dirs;
8126 while Current /= Nil_String loop
8127 Element := Shared.String_Elements.Table (Current);
8128 Debug_Output (Get_Name_String (Element.Display_Value));
8129 Current := Element.Next;
8132 Debug_Decrease_Indent ("end Source_Dirs.");
8134 end Show_Source_Dirs;
8136 ---------------------------
8137 -- Process_Naming_Scheme --
8138 ---------------------------
8140 procedure Process_Naming_Scheme
8141 (Tree : Project_Tree_Ref;
8142 Root_Project : Project_Id;
8143 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
8144 Flags : Processing_Flags)
8148 (Project : Project_Id;
8149 In_Aggregate_Lib : Boolean;
8150 Data : in out Tree_Processing_Data);
8151 -- Process the naming scheme for a single project
8153 procedure Recursive_Check
8154 (Project : Project_Id;
8155 Prj_Tree : Project_Tree_Ref;
8156 Context : Project_Context;
8157 Data : in out Tree_Processing_Data);
8158 -- Check_Naming_Scheme for the project
8165 (Project : Project_Id;
8166 In_Aggregate_Lib : Boolean;
8167 Data : in out Tree_Processing_Data)
8169 procedure Check_Aggregate
8170 (Project : Project_Id;
8171 Data : in out Tree_Processing_Data);
8172 -- Check the aggregate project attributes, reject any not supported
8175 procedure Check_Aggregated
8176 (Project : Project_Id;
8177 Data : in out Tree_Processing_Data);
8178 -- Check aggregated projects which should not be externally built.
8179 -- What is Data??? if same as outer Data, why passed???
8180 -- What exact check is performed here??? Seems a bad idea to have
8181 -- two procedures with such close names ???
8183 ---------------------
8184 -- Check_Aggregate --
8185 ---------------------
8187 procedure Check_Aggregate
8188 (Project : Project_Id;
8189 Data : in out Tree_Processing_Data)
8191 procedure Check_Not_Defined (Name : Name_Id);
8192 -- Report an error if Var is defined
8194 -----------------------
8195 -- Check_Not_Defined --
8196 -----------------------
8198 procedure Check_Not_Defined (Name : Name_Id) is
8199 Var : constant Prj.Variable_Value :=
8202 Project.Decl.Attributes,
8205 if not Var.Default then
8206 Error_Msg_Name_1 := Name;
8208 (Data.Flags, "wrong attribute %% in aggregate library",
8209 Var.Location, Project);
8211 end Check_Not_Defined;
8213 -- Start of processing for Check_Aggregate
8216 Check_Not_Defined (Snames.Name_Library_Dir);
8217 Check_Not_Defined (Snames.Name_Library_Interface);
8218 Check_Not_Defined (Snames.Name_Library_Name);
8219 Check_Not_Defined (Snames.Name_Library_Ali_Dir);
8220 Check_Not_Defined (Snames.Name_Library_Src_Dir);
8221 Check_Not_Defined (Snames.Name_Library_Options);
8222 Check_Not_Defined (Snames.Name_Library_Standalone);
8223 Check_Not_Defined (Snames.Name_Library_Kind);
8224 Check_Not_Defined (Snames.Name_Leading_Library_Options);
8225 Check_Not_Defined (Snames.Name_Library_Version);
8226 end Check_Aggregate;
8228 ----------------------
8229 -- Check_Aggregated --
8230 ----------------------
8232 procedure Check_Aggregated
8233 (Project : Project_Id;
8234 Data : in out Tree_Processing_Data)
8236 L : Aggregated_Project_List;
8239 -- Check that aggregated projects are not externally built
8241 L := Project.Aggregated_Projects;
8242 while L /= null loop
8244 Var : constant Prj.Variable_Value :=
8246 (Snames.Name_Externally_Built,
8247 L.Project.Decl.Attributes,
8250 if not Var.Default then
8251 Error_Msg_Name_1 := L.Project.Display_Name;
8254 "cannot aggregate externally build library %%",
8255 Var.Location, Project);
8261 end Check_Aggregated;
8265 Shared : constant Shared_Project_Tree_Data_Access :=
8267 Prj_Data : Project_Processing_Data;
8269 -- Start of processing for Check
8272 Debug_Increase_Indent ("check", Project.Name);
8274 Initialize (Prj_Data, Project);
8276 Check_If_Externally_Built (Project, Data);
8278 case Project.Qualifier is
8280 Check_Aggregated (Project, Data);
8282 when Aggregate_Library =>
8283 Check_Aggregated (Project, Data);
8285 if Project.Object_Directory = No_Path_Information then
8286 Project.Object_Directory := Project.Directory;
8290 Get_Directories (Project, Data);
8291 Check_Programming_Languages (Project, Data);
8293 if Current_Verbosity = High then
8294 Show_Source_Dirs (Project, Shared);
8297 if Project.Qualifier = Dry then
8298 Check_Abstract_Project (Project, Data);
8302 -- Check configuration. Must be done for gnatmake (even though no
8303 -- user configuration file was provided) since the default config we
8304 -- generate indicates whether libraries are supported for instance.
8306 Check_Configuration (Project, Data);
8308 -- For aggregate project check no library attributes are defined
8310 if Project.Qualifier = Aggregate then
8311 Check_Aggregate (Project, Data);
8314 Check_Library_Attributes (Project, Data);
8315 Check_Package_Naming (Project, Data);
8317 -- An aggregate library has no source, no need to look for them
8319 if Project.Qualifier /= Aggregate_Library then
8320 Look_For_Sources (Prj_Data, Data);
8323 Check_Interfaces (Project, Data);
8325 -- If this library is part of an aggregated library don't check it
8326 -- as it has no sources by itself and so interface won't be found.
8328 if Project.Library and not In_Aggregate_Lib then
8329 Check_Stand_Alone_Library (Project, Data);
8332 Get_Mains (Project, Data);
8337 Debug_Decrease_Indent ("done check");
8340 ---------------------
8341 -- Recursive_Check --
8342 ---------------------
8344 procedure Recursive_Check
8345 (Project : Project_Id;
8346 Prj_Tree : Project_Tree_Ref;
8347 Context : Project_Context;
8348 Data : in out Tree_Processing_Data)
8351 if Current_Verbosity = High then
8352 Debug_Increase_Indent
8353 ("Processing_Naming_Scheme for project", Project.Name);
8356 Data.Tree := Prj_Tree;
8357 Data.In_Aggregate_Lib := Context.In_Aggregate_Lib;
8359 Check (Project, Context.In_Aggregate_Lib, Data);
8361 if Current_Verbosity = High then
8362 Debug_Decrease_Indent ("done Processing_Naming_Scheme");
8364 end Recursive_Check;
8366 procedure Check_All_Projects is new For_Every_Project_Imported_Context
8367 (Tree_Processing_Data, Recursive_Check);
8368 -- Comment required???
8372 Data : Tree_Processing_Data;
8374 -- Start of processing for Process_Naming_Scheme
8377 Lib_Data_Table.Init;
8378 Initialize (Data, Tree => Tree, Node_Tree => Node_Tree, Flags => Flags);
8379 Check_All_Projects (Root_Project, Tree, Data, Imported_First => True);
8382 -- Adjust language configs for projects that are extended
8385 List : Project_List;
8388 Lang : Language_Ptr;
8389 Elng : Language_Ptr;
8392 List := Tree.Projects;
8393 while List /= null loop
8394 Proj := List.Project;
8397 while Exte.Extended_By /= No_Project loop
8398 Exte := Exte.Extended_By;
8401 if Exte /= Proj then
8402 Lang := Proj.Languages;
8404 if Lang /= No_Language_Index then
8406 Elng := Get_Language_From_Name
8407 (Exte, Get_Name_String (Lang.Name));
8408 exit when Elng /= No_Language_Index;
8409 Exte := Exte.Extends;
8412 if Elng /= Lang then
8413 Lang.Config := Elng.Config;
8421 end Process_Naming_Scheme;