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
168 Tree : Project_Tree_Ref;
171 package Lib_Data_Table is new GNAT.Table
172 (Table_Component_Type => Lib_Data,
173 Table_Index_Type => Natural,
174 Table_Low_Bound => 1,
176 Table_Increment => 100);
177 -- A table to record library names in order to check that two library
178 -- projects do not have the same library names.
181 (Data : out Tree_Processing_Data;
182 Tree : Project_Tree_Ref;
183 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
184 Flags : Prj.Processing_Flags);
187 procedure Free (Data : in out Tree_Processing_Data);
188 -- Free the memory occupied by Data
191 (Data : in out Project_Processing_Data;
192 Project : Project_Id);
193 procedure Free (Data : in out Project_Processing_Data);
194 -- Initialize or free memory for a project-specific data
196 procedure Find_Excluded_Sources
197 (Project : in out Project_Processing_Data;
198 Data : in out Tree_Processing_Data);
199 -- Find the list of files that should not be considered as source files
200 -- for this project. Sets the list in the Project.Excluded_Sources_Htable.
202 procedure Override_Kind (Source : Source_Id; Kind : Source_Kind);
203 -- Override the reference kind for a source file. This properly updates
204 -- the unit data if necessary.
206 procedure Load_Naming_Exceptions
207 (Project : in out Project_Processing_Data;
208 Data : in out Tree_Processing_Data);
209 -- All source files in Data.First_Source are considered as naming
210 -- exceptions, and copied into the Source_Names and Unit_Exceptions tables
213 type Search_Type is (Search_Files, Search_Directories);
216 with procedure Callback
217 (Path : Path_Information;
218 Pattern_Index : Natural);
219 procedure Expand_Subdirectory_Pattern
220 (Project : Project_Id;
221 Data : in out Tree_Processing_Data;
222 Patterns : String_List_Id;
223 Ignore : String_List_Id;
224 Search_For : Search_Type;
225 Resolve_Links : Boolean);
226 -- Search the subdirectories of Project's directory for files or
227 -- directories that match the globbing patterns found in Patterns (for
228 -- instance "**/*.adb"). Typically, Patterns will be the value of the
229 -- Source_Dirs or Excluded_Source_Dirs attributes.
231 -- Every time such a file or directory is found, the callback is called.
232 -- Resolve_Links indicates whether we should resolve links while
233 -- normalizing names.
235 -- In the callback, Pattern_Index is the index within Patterns where the
236 -- expanded pattern was found (1 for the first element of Patterns and
237 -- all its matching directories, then 2,...).
239 -- We use a generic and not an access-to-subprogram because in some cases
240 -- this code is compiled with the restriction No_Implicit_Dynamic_Code.
241 -- An error message is raised if a pattern does not match any file.
245 Data : in out Tree_Processing_Data;
246 Project : Project_Id;
247 Source_Dir_Rank : Natural;
248 Lang_Id : Language_Ptr;
250 File_Name : File_Name_Type;
251 Display_File : File_Name_Type;
252 Naming_Exception : Naming_Exception_Type := No;
253 Path : Path_Information := No_Path_Information;
254 Alternate_Languages : Language_List := null;
255 Unit : Name_Id := No_Name;
257 Locally_Removed : Boolean := False;
258 Location : Source_Ptr := No_Location);
259 -- Add a new source to the different lists: list of all sources in the
260 -- project tree, list of source of a project and list of sources of a
261 -- language. If Path is specified, the file is also added to
262 -- Source_Paths_HT. Location is used for error messages
264 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type;
265 -- Same as Osint.Canonical_Case_File_Name but applies to Name_Id.
266 -- This alters Name_Buffer.
268 function Suffix_Matches
270 Suffix : File_Name_Type) return Boolean;
271 -- True if the file name ends with the given suffix. Always returns False
272 -- if Suffix is No_Name.
274 procedure Replace_Into_Name_Buffer
277 Replacement : Character);
278 -- Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is
279 -- converted to lower-case at the same time.
281 procedure Check_Abstract_Project
282 (Project : Project_Id;
283 Data : in out Tree_Processing_Data);
284 -- Check abstract projects attributes
286 procedure Check_Configuration
287 (Project : Project_Id;
288 Data : in out Tree_Processing_Data);
289 -- Check the configuration attributes for the project
291 procedure Check_If_Externally_Built
292 (Project : Project_Id;
293 Data : in out Tree_Processing_Data);
294 -- Check attribute Externally_Built of project Project in project tree
295 -- Data.Tree and modify its data Data if it has the value "true".
297 procedure Check_Interfaces
298 (Project : Project_Id;
299 Data : in out Tree_Processing_Data);
300 -- If a list of sources is specified in attribute Interfaces, set
301 -- In_Interfaces only for the sources specified in the list.
303 procedure Check_Library_Attributes
304 (Project : Project_Id;
305 Data : in out Tree_Processing_Data);
306 -- Check the library attributes of project Project in project tree
307 -- and modify its data Data accordingly.
309 procedure Check_Package_Naming
310 (Project : Project_Id;
311 Data : in out Tree_Processing_Data);
312 -- Check the naming scheme part of Data, and initialize the naming scheme
313 -- data in the config of the various languages.
315 procedure Check_Programming_Languages
316 (Project : Project_Id;
317 Data : in out Tree_Processing_Data);
318 -- Check attribute Languages for the project with data Data in project
319 -- tree Data.Tree and set the components of Data for all the programming
320 -- languages indicated in attribute Languages, if any.
322 procedure Check_Stand_Alone_Library
323 (Project : Project_Id;
324 Data : in out Tree_Processing_Data);
325 -- Check if project Project in project tree Data.Tree is a Stand-Alone
326 -- Library project, and modify its data Data accordingly if it is one.
328 procedure Check_Unit_Name (Name : String; Unit : out Name_Id);
329 -- Check that a name is a valid unit name
331 function Compute_Directory_Last (Dir : String) return Natural;
332 -- Return the index of the last significant character in Dir. This is used
333 -- to avoid duplicate '/' (slash) characters at the end of directory names.
335 procedure Search_Directories
336 (Project : in out Project_Processing_Data;
337 Data : in out Tree_Processing_Data;
338 For_All_Sources : Boolean);
339 -- Search the source directories to find the sources. If For_All_Sources is
340 -- True, check each regular file name against the naming schemes of the
341 -- various languages. Otherwise consider only the file names in hash table
342 -- Source_Names. If Allow_Duplicate_Basenames then files with identical
343 -- base names are permitted within a project for source-based languages
344 -- (never for unit based languages).
347 (Project : in out Project_Processing_Data;
348 Data : in out Tree_Processing_Data;
349 Source_Dir_Rank : Natural;
350 Path : Path_Name_Type;
351 Display_Path : Path_Name_Type;
352 File_Name : File_Name_Type;
353 Display_File_Name : File_Name_Type;
354 Locally_Removed : Boolean;
355 For_All_Sources : Boolean);
356 -- Check if file File_Name is a valid source of the project. This is used
357 -- in multi-language mode only. When the file matches one of the naming
358 -- schemes, it is added to various htables through Add_Source and to
359 -- Source_Paths_Htable.
361 -- File_Name is the same as Display_File_Name, but has been normalized.
362 -- They do not include the directory information.
364 -- Path and Display_Path on the other hand are the full path to the file.
365 -- Path must have been normalized (canonical casing and possibly links
368 -- Source_Directory is the directory in which the file was found. It is
369 -- neither normalized nor has had links resolved, and must not end with a
370 -- a directory separator, to avoid duplicates later on.
372 -- If For_All_Sources is True, then all possible file names are analyzed
373 -- otherwise only those currently set in the Source_Names hash table.
375 procedure Check_File_Naming_Schemes
376 (Project : Project_Processing_Data;
377 File_Name : File_Name_Type;
378 Alternate_Languages : out Language_List;
379 Language : out Language_Ptr;
380 Display_Language_Name : out Name_Id;
382 Lang_Kind : out Language_Kind;
383 Kind : out Source_Kind);
384 -- Check if the file name File_Name conforms to one of the naming schemes
385 -- of the project. If the file does not match one of the naming schemes,
386 -- set Language to No_Language_Index. Filename is the name of the file
387 -- being investigated. It has been normalized (case-folded). File_Name is
390 procedure Get_Directories
391 (Project : Project_Id;
392 Data : in out Tree_Processing_Data);
393 -- Get the object directory, the exec directory and the source directories
397 (Project : Project_Id;
398 Data : in out Tree_Processing_Data);
399 -- Get the mains of a project from attribute Main, if it exists, and put
400 -- them in the project data.
402 procedure Get_Sources_From_File
404 Location : Source_Ptr;
405 Project : in out Project_Processing_Data;
406 Data : in out Tree_Processing_Data);
407 -- Get the list of sources from a text file and put them in hash table
410 procedure Find_Sources
411 (Project : in out Project_Processing_Data;
412 Data : in out Tree_Processing_Data);
413 -- Process the Source_Files and Source_List_File attributes, and store the
414 -- list of source files into the Source_Names htable. When these attributes
415 -- are not defined, find all files matching the naming schemes in the
416 -- source directories. If Allow_Duplicate_Basenames, then files with the
417 -- same base names are authorized within a project for source-based
418 -- languages (never for unit based languages)
420 procedure Compute_Unit_Name
421 (File_Name : File_Name_Type;
422 Naming : Lang_Naming_Data;
423 Kind : out Source_Kind;
425 Project : Project_Processing_Data);
426 -- Check whether the file matches the naming scheme. If it does,
427 -- compute its unit name. If Unit is set to No_Name on exit, none of the
428 -- other out parameters are relevant.
430 procedure Check_Illegal_Suffix
431 (Project : Project_Id;
432 Suffix : File_Name_Type;
433 Dot_Replacement : File_Name_Type;
434 Attribute_Name : String;
435 Location : Source_Ptr;
436 Data : in out Tree_Processing_Data);
437 -- Display an error message if the given suffix is illegal for some reason.
438 -- The name of the attribute we are testing is specified in Attribute_Name,
439 -- which is used in the error message. Location is the location where the
440 -- suffix is defined.
442 procedure Locate_Directory
443 (Project : Project_Id;
444 Name : File_Name_Type;
445 Path : out Path_Information;
446 Dir_Exists : out Boolean;
447 Data : in out Tree_Processing_Data;
448 Create : String := "";
449 Location : Source_Ptr := No_Location;
450 Must_Exist : Boolean := True;
451 Externally_Built : Boolean := False);
452 -- Locate a directory. Name is the directory name. Relative paths are
453 -- resolved relative to the project's directory. If the directory does not
454 -- exist and Setup_Projects is True and Create is a non null string, an
455 -- attempt is made to create the directory. If the directory does not
456 -- exist, it is either created if Setup_Projects is False (and then
457 -- returned), or simply returned without checking for its existence (if
458 -- Must_Exist is False) or No_Path_Information is returned. In all cases,
459 -- Dir_Exists indicates whether the directory now exists. Create is also
460 -- used for debugging traces to show which path we are computing.
462 procedure Look_For_Sources
463 (Project : in out Project_Processing_Data;
464 Data : in out Tree_Processing_Data);
465 -- Find all the sources of project Project in project tree Data.Tree and
466 -- update its Data accordingly. This assumes that the special naming
467 -- exceptions have already been processed.
469 function Path_Name_Of
470 (File_Name : File_Name_Type;
471 Directory : Path_Name_Type) return String;
472 -- Returns the path name of a (non project) file. Returns an empty string
473 -- if file cannot be found.
475 procedure Remove_Source
476 (Tree : Project_Tree_Ref;
478 Replaced_By : Source_Id);
479 -- Remove a file from the list of sources of a project. This might be
480 -- because the file is replaced by another one in an extending project,
481 -- or because a file was added as a naming exception but was not found
484 procedure Report_No_Sources
485 (Project : Project_Id;
487 Data : Tree_Processing_Data;
488 Location : Source_Ptr;
489 Continuation : Boolean := False);
490 -- Report an error or a warning depending on the value of When_No_Sources
491 -- when there are no sources for language Lang_Name.
493 procedure Show_Source_Dirs
494 (Project : Project_Id;
495 Shared : Shared_Project_Tree_Data_Access);
496 -- List all the source directories of a project
498 procedure Write_Attr (Name, Value : String);
499 -- Debug print a value for a specific property. Does nothing when not in
502 procedure Error_Or_Warning
503 (Flags : Processing_Flags;
504 Kind : Error_Warning;
506 Location : Source_Ptr;
507 Project : Project_Id);
508 -- Emits either an error or warning message (or nothing), depending on Kind
510 function No_Space_Img (N : Natural) return String;
511 -- Image of a Natural without the initial space
513 ----------------------
514 -- Error_Or_Warning --
515 ----------------------
517 procedure Error_Or_Warning
518 (Flags : Processing_Flags;
519 Kind : Error_Warning;
521 Location : Source_Ptr;
522 Project : Project_Id) is
525 when Error => Error_Msg (Flags, Msg, Location, Project);
526 when Warning => Error_Msg (Flags, "?" & Msg, Location, Project);
529 end Error_Or_Warning;
531 ------------------------------
532 -- Replace_Into_Name_Buffer --
533 ------------------------------
535 procedure Replace_Into_Name_Buffer
538 Replacement : Character)
540 Max : constant Integer := Str'Last - Pattern'Length + 1;
547 while J <= Str'Last loop
548 Name_Len := Name_Len + 1;
551 and then Str (J .. J + Pattern'Length - 1) = Pattern
553 Name_Buffer (Name_Len) := Replacement;
554 J := J + Pattern'Length;
557 Name_Buffer (Name_Len) := GNAT.Case_Util.To_Lower (Str (J));
561 end Replace_Into_Name_Buffer;
567 function Suffix_Matches
569 Suffix : File_Name_Type) return Boolean
571 Min_Prefix_Length : Natural := 0;
574 if Suffix = No_File or else Suffix = Empty_File then
579 Suf : String := Get_Name_String (Suffix);
582 -- On non case-sensitive systems, use proper suffix casing
584 Canonical_Case_File_Name (Suf);
586 -- The file name must end with the suffix (which is not an extension)
587 -- For instance a suffix "configure.in" must match a file with the
588 -- same name. To avoid dummy cases, though, a suffix starting with
589 -- '.' requires a file that is at least one character longer ('.cpp'
590 -- should not match a file with the same name).
592 if Suf (Suf'First) = '.' then
593 Min_Prefix_Length := 1;
596 return Filename'Length >= Suf'Length + Min_Prefix_Length
598 Filename (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;
606 procedure Write_Attr (Name, Value : String) is
608 if Current_Verbosity = High then
609 Debug_Output (Name & " = """ & Value & '"');
619 Data : in out Tree_Processing_Data;
620 Project : Project_Id;
621 Source_Dir_Rank : Natural;
622 Lang_Id : Language_Ptr;
624 File_Name : File_Name_Type;
625 Display_File : File_Name_Type;
626 Naming_Exception : Naming_Exception_Type := No;
627 Path : Path_Information := No_Path_Information;
628 Alternate_Languages : Language_List := null;
629 Unit : Name_Id := No_Name;
631 Locally_Removed : Boolean := False;
632 Location : Source_Ptr := No_Location)
634 Config : constant Language_Config := Lang_Id.Config;
638 Prev_Unit : Unit_Index := No_Unit_Index;
639 Source_To_Replace : Source_Id := No_Source;
642 -- Check if the same file name or unit is used in the prj tree
646 if Unit /= No_Name then
647 Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit);
650 if Prev_Unit /= No_Unit_Index
651 and then (Kind = Impl or else Kind = Spec)
652 and then Prev_Unit.File_Names (Kind) /= null
654 -- Suspicious, we need to check later whether this is authorized
657 Source := Prev_Unit.File_Names (Kind);
660 Source := Source_Files_Htable.Get
661 (Data.Tree.Source_Files_HT, File_Name);
663 if Source /= No_Source and then Source.Index = Index then
668 -- Always add the source if it is locally removed, to avoid incorrect
671 if Locally_Removed then
674 -- A locally removed source may first replace a source in a project
677 if Source /= No_Source
678 and then Is_Extending (Project, Source.Project)
679 and then Naming_Exception /= Inherited
681 Source_To_Replace := Source;
685 -- Duplication of file/unit in same project is allowed if order of
686 -- source directories is known, or if there is no compiler for the
689 if Add_Src = False then
692 if Project = Source.Project then
693 if Prev_Unit = No_Unit_Index then
694 if Data.Flags.Allow_Duplicate_Basenames then
697 elsif Lang_Id.Config.Compiler_Driver = Empty_File then
700 elsif Source_Dir_Rank /= Source.Source_Dir_Rank then
704 Error_Msg_File_1 := File_Name;
706 (Data.Flags, "duplicate source file name {",
712 if Source_Dir_Rank /= Source.Source_Dir_Rank then
715 -- We might be seeing the same file through a different
716 -- path (for instance because of symbolic links).
718 elsif Source.Path.Name /= Path.Name then
719 if not Source.Duplicate_Unit then
720 Error_Msg_Name_1 := Unit;
723 "\duplicate unit %%",
726 Source.Duplicate_Unit := True;
733 -- Do not allow the same unit name in different projects,
734 -- except if one is extending the other.
736 -- For a file based language, the same file name replaces a
737 -- file in a project being extended, but it is allowed to have
738 -- the same file name in unrelated projects.
740 elsif Is_Extending (Project, Source.Project) then
741 if not Locally_Removed
742 and then Naming_Exception /= Inherited
744 Source_To_Replace := Source;
747 elsif Prev_Unit /= No_Unit_Index
748 and then Prev_Unit.File_Names (Kind) /= null
749 and then not Source.Locally_Removed
750 and then Source.Replaced_By = No_Source
751 and then not Data.In_Aggregate_Lib
753 -- Path is set if this is a source we found on the disk, in
754 -- which case we can provide more explicit error message. Path
755 -- is unset when the source is added from one of the naming
756 -- exceptions in the project.
758 if Path /= No_Path_Information then
759 Error_Msg_Name_1 := Unit;
762 "unit %% cannot belong to several projects",
765 Error_Msg_Name_1 := Project.Name;
766 Error_Msg_Name_2 := Name_Id (Path.Display_Name);
768 (Data.Flags, "\ project %%, %%", Location, Project);
770 Error_Msg_Name_1 := Source.Project.Name;
771 Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);
773 (Data.Flags, "\ project %%, %%", Location, Project);
776 Error_Msg_Name_1 := Unit;
777 Error_Msg_Name_2 := Source.Project.Name;
779 (Data.Flags, "unit %% already belongs to project %%",
785 elsif not Source.Locally_Removed
786 and then Source.Replaced_By /= No_Source
787 and then not Data.Flags.Allow_Duplicate_Basenames
788 and then Lang_Id.Config.Kind = Unit_Based
789 and then Source.Language.Config.Kind = Unit_Based
790 and then not Data.In_Aggregate_Lib
792 Error_Msg_File_1 := File_Name;
793 Error_Msg_File_2 := File_Name_Type (Source.Project.Name);
796 "{ is already a source of project {", Location, Project);
798 -- Add the file anyway, to avoid further warnings like
799 -- "language unknown".
812 Id := new Source_Data;
814 if Current_Verbosity = High then
816 Write_Str ("adding source File: ");
817 Write_Str (Get_Name_String (Display_File));
820 Write_Str (" at" & Index'Img);
823 if Lang_Id.Config.Kind = Unit_Based then
824 Write_Str (" Unit: ");
826 -- ??? in gprclean, it seems we sometimes pass an empty Unit name
827 -- (see test extended_projects).
829 if Unit /= No_Name then
830 Write_Str (Get_Name_String (Unit));
833 Write_Str (" Kind: ");
834 Write_Str (Source_Kind'Image (Kind));
840 Id.Project := Project;
841 Id.Location := Location;
842 Id.Source_Dir_Rank := Source_Dir_Rank;
843 Id.Language := Lang_Id;
845 Id.Alternate_Languages := Alternate_Languages;
846 Id.Locally_Removed := Locally_Removed;
848 Id.File := File_Name;
849 Id.Display_File := Display_File;
850 Id.Dep_Name := Dependency_Name
851 (File_Name, Lang_Id.Config.Dependency_Kind);
852 Id.Naming_Exception := Naming_Exception;
853 Id.Object := Object_Name
854 (File_Name, Config.Object_File_Suffix);
855 Id.Switches := Switches_Name (File_Name);
857 -- Add the source id to the Unit_Sources_HT hash table, if the unit name
860 if Unit /= No_Name then
862 -- Note: we might be creating a dummy unit here, when we in fact have
863 -- a separate. For instance, file file-bar.adb will initially be
864 -- assumed to be the IMPL of unit "file.bar". Only later on (in
865 -- Check_Object_Files) will we parse those units that only have an
866 -- impl and no spec to make sure whether we have a Separate in fact
867 -- (that significantly reduces the number of times we need to parse
868 -- the files, since we are then only interested in those with no
869 -- spec). We still need those dummy units in the table, since that's
870 -- the name we find in the ALI file
872 UData := Units_Htable.Get (Data.Tree.Units_HT, Unit);
874 if UData = No_Unit_Index then
875 UData := new Unit_Data;
878 if Naming_Exception /= Inherited then
879 Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
885 -- Note that this updates Unit information as well
887 if Naming_Exception /= Inherited and then not Locally_Removed then
888 Override_Kind (Id, Kind);
892 if Path /= No_Path_Information then
894 Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id);
897 Id.Next_With_File_Name :=
898 Source_Files_Htable.Get (Data.Tree.Source_Files_HT, File_Name);
899 Source_Files_Htable.Set (Data.Tree.Source_Files_HT, File_Name, Id);
902 Project.Has_Multi_Unit_Sources := True;
905 -- Add the source to the language list
907 Id.Next_In_Lang := Lang_Id.First_Source;
908 Lang_Id.First_Source := Id;
910 if Source_To_Replace /= No_Source then
911 Remove_Source (Data.Tree, Source_To_Replace, Id);
914 if Data.Tree.Replaced_Source_Number > 0
916 Replaced_Source_HTable.Get
917 (Data.Tree.Replaced_Sources, Id.File) /= No_File
919 Replaced_Source_HTable.Remove (Data.Tree.Replaced_Sources, Id.File);
920 Data.Tree.Replaced_Source_Number :=
921 Data.Tree.Replaced_Source_Number - 1;
925 ------------------------------
926 -- Canonical_Case_File_Name --
927 ------------------------------
929 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type is
931 if Osint.File_Names_Case_Sensitive then
932 return File_Name_Type (Name);
934 Get_Name_String (Name);
935 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
938 end Canonical_Case_File_Name;
940 ---------------------------------
941 -- Process_Aggregated_Projects --
942 ---------------------------------
944 procedure Process_Aggregated_Projects
945 (Tree : Project_Tree_Ref;
946 Project : Project_Id;
947 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
948 Flags : Processing_Flags)
950 Data : Tree_Processing_Data :=
952 Node_Tree => Node_Tree,
954 In_Aggregate_Lib => False);
956 Project_Files : constant Prj.Variable_Value :=
958 (Snames.Name_Project_Files,
959 Project.Decl.Attributes,
962 Project_Path_For_Aggregate : Prj.Env.Project_Search_Path;
964 procedure Found_Project_File (Path : Path_Information; Rank : Natural);
965 -- Called for each project file aggregated by Project
967 procedure Expand_Project_Files is
968 new Expand_Subdirectory_Pattern (Callback => Found_Project_File);
969 -- Search for all project files referenced by the patterns given in
970 -- parameter. Calls Found_Project_File for each of them.
972 ------------------------
973 -- Found_Project_File --
974 ------------------------
976 procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
977 pragma Unreferenced (Rank);
980 if Path.Name /= Project.Path.Name then
981 Debug_Output ("aggregates: ", Name_Id (Path.Display_Name));
983 -- For usual "with" statement, this phase will have been done when
984 -- parsing the project itself. However, for aggregate projects, we
985 -- can only do this when processing the aggregate project, since
986 -- the exact list of project files or project directories can
987 -- depend on scenario variables.
989 -- We only load the projects explicitly here, but do not process
990 -- them. For the processing, Prj.Proc will take care of processing
991 -- them, within the same call to Recursive_Process (thus avoiding
992 -- the processing of a given project multiple times).
994 -- ??? We might already have loaded the project
996 Add_Aggregated_Project (Project, Path => Path.Name);
999 Debug_Output ("pattern returned the aggregate itself, ignored");
1001 end Found_Project_File;
1003 -- Start of processing for Check_Aggregate_Project
1006 pragma Assert (Project.Qualifier in Aggregate_Project);
1008 if Project_Files.Default then
1009 Error_Msg_Name_1 := Snames.Name_Project_Files;
1012 "Attribute %% must be specified in aggregate project",
1013 Project.Location, Project);
1017 -- The aggregated projects are only searched relative to the directory
1018 -- of the aggregate project, not in the default project path.
1020 Initialize_Empty (Project_Path_For_Aggregate);
1022 Free (Project.Aggregated_Projects);
1024 -- Look for aggregated projects. For similarity with source files and
1025 -- dirs, the aggregated project files are not searched for on the
1026 -- project path, and are only found through the path specified in
1027 -- the Project_Files attribute.
1029 Expand_Project_Files
1030 (Project => Project,
1032 Patterns => Project_Files.Values,
1033 Ignore => Nil_String,
1034 Search_For => Search_Files,
1035 Resolve_Links => Opt.Follow_Links_For_Files);
1037 Free (Project_Path_For_Aggregate);
1038 end Process_Aggregated_Projects;
1040 ----------------------------
1041 -- Check_Abstract_Project --
1042 ----------------------------
1044 procedure Check_Abstract_Project
1045 (Project : Project_Id;
1046 Data : in out Tree_Processing_Data)
1048 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
1050 Source_Dirs : constant Variable_Value :=
1053 Project.Decl.Attributes, Shared);
1054 Source_Files : constant Variable_Value :=
1057 Project.Decl.Attributes, Shared);
1058 Source_List_File : constant Variable_Value :=
1060 (Name_Source_List_File,
1061 Project.Decl.Attributes, Shared);
1062 Languages : constant Variable_Value :=
1065 Project.Decl.Attributes, Shared);
1068 if Project.Source_Dirs /= Nil_String then
1069 if Source_Dirs.Values = Nil_String
1070 and then Source_Files.Values = Nil_String
1071 and then Languages.Values = Nil_String
1072 and then Source_List_File.Default
1074 Project.Source_Dirs := Nil_String;
1079 "at least one of Source_Files, Source_Dirs or Languages "
1080 & "must be declared empty for an abstract project",
1081 Project.Location, Project);
1084 end Check_Abstract_Project;
1086 -------------------------
1087 -- Check_Configuration --
1088 -------------------------
1090 procedure Check_Configuration
1091 (Project : Project_Id;
1092 Data : in out Tree_Processing_Data)
1094 Shared : constant Shared_Project_Tree_Data_Access :=
1097 Dot_Replacement : File_Name_Type := No_File;
1098 Casing : Casing_Type := All_Lower_Case;
1099 Separate_Suffix : File_Name_Type := No_File;
1101 Lang_Index : Language_Ptr := No_Language_Index;
1102 -- The index of the language data being checked
1104 Prev_Index : Language_Ptr := No_Language_Index;
1105 -- The index of the previous language
1107 procedure Process_Project_Level_Simple_Attributes;
1108 -- Process the simple attributes at the project level
1110 procedure Process_Project_Level_Array_Attributes;
1111 -- Process the associate array attributes at the project level
1113 procedure Process_Packages;
1114 -- Read the packages of the project
1116 ----------------------
1117 -- Process_Packages --
1118 ----------------------
1120 procedure Process_Packages is
1121 Packages : Package_Id;
1122 Element : Package_Element;
1124 procedure Process_Binder (Arrays : Array_Id);
1125 -- Process the associated array attributes of package Binder
1127 procedure Process_Builder (Attributes : Variable_Id);
1128 -- Process the simple attributes of package Builder
1130 procedure Process_Clean (Arrays : Array_Id);
1131 -- Process the associated array attributes of package Clean
1133 procedure Process_Compiler (Arrays : Array_Id);
1134 -- Process the associated array attributes of package Compiler
1136 procedure Process_Naming (Attributes : Variable_Id);
1137 -- Process the simple attributes of package Naming
1139 procedure Process_Naming (Arrays : Array_Id);
1140 -- Process the associated array attributes of package Naming
1142 procedure Process_Linker (Attributes : Variable_Id);
1143 -- Process the simple attributes of package Linker of a
1144 -- configuration project.
1146 --------------------
1147 -- Process_Binder --
1148 --------------------
1150 procedure Process_Binder (Arrays : Array_Id) is
1151 Current_Array_Id : Array_Id;
1152 Current_Array : Array_Data;
1153 Element_Id : Array_Element_Id;
1154 Element : Array_Element;
1157 -- Process the associative array attribute of package Binder
1159 Current_Array_Id := Arrays;
1160 while Current_Array_Id /= No_Array loop
1161 Current_Array := Shared.Arrays.Table (Current_Array_Id);
1163 Element_Id := Current_Array.Value;
1164 while Element_Id /= No_Array_Element loop
1165 Element := Shared.Array_Elements.Table (Element_Id);
1167 if Element.Index /= All_Other_Names then
1169 -- Get the name of the language
1172 Get_Language_From_Name
1173 (Project, Get_Name_String (Element.Index));
1175 if Lang_Index /= No_Language_Index then
1176 case Current_Array.Name is
1179 -- Attribute Driver (<language>)
1181 Lang_Index.Config.Binder_Driver :=
1182 File_Name_Type (Element.Value.Value);
1184 when Name_Required_Switches =>
1187 Lang_Index.Config.Binder_Required_Switches,
1188 From_List => Element.Value.Values,
1189 In_Tree => Data.Tree);
1193 -- Attribute Prefix (<language>)
1195 Lang_Index.Config.Binder_Prefix :=
1196 Element.Value.Value;
1198 when Name_Objects_Path =>
1200 -- Attribute Objects_Path (<language>)
1202 Lang_Index.Config.Objects_Path :=
1203 Element.Value.Value;
1205 when Name_Objects_Path_File =>
1207 -- Attribute Objects_Path (<language>)
1209 Lang_Index.Config.Objects_Path_File :=
1210 Element.Value.Value;
1218 Element_Id := Element.Next;
1221 Current_Array_Id := Current_Array.Next;
1225 ---------------------
1226 -- Process_Builder --
1227 ---------------------
1229 procedure Process_Builder (Attributes : Variable_Id) is
1230 Attribute_Id : Variable_Id;
1231 Attribute : Variable;
1234 -- Process non associated array attribute from package Builder
1236 Attribute_Id := Attributes;
1237 while Attribute_Id /= No_Variable loop
1238 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1240 if not Attribute.Value.Default then
1241 if Attribute.Name = Name_Executable_Suffix then
1243 -- Attribute Executable_Suffix: the suffix of the
1246 Project.Config.Executable_Suffix :=
1247 Attribute.Value.Value;
1251 Attribute_Id := Attribute.Next;
1253 end Process_Builder;
1259 procedure Process_Clean (Arrays : Array_Id) is
1260 Current_Array_Id : Array_Id;
1261 Current_Array : Array_Data;
1262 Element_Id : Array_Element_Id;
1263 Element : Array_Element;
1264 List : String_List_Id;
1267 -- Process the associated array attributes of package Clean
1269 Current_Array_Id := Arrays;
1270 while Current_Array_Id /= No_Array loop
1271 Current_Array := Shared.Arrays.Table (Current_Array_Id);
1273 Element_Id := Current_Array.Value;
1274 while Element_Id /= No_Array_Element loop
1275 Element := Shared.Array_Elements.Table (Element_Id);
1277 -- Get the name of the language
1280 Get_Language_From_Name
1281 (Project, Get_Name_String (Element.Index));
1283 if Lang_Index /= No_Language_Index then
1284 case Current_Array.Name is
1286 -- Attribute Object_Artifact_Extensions (<language>)
1288 when Name_Object_Artifact_Extensions =>
1289 List := Element.Value.Values;
1291 if List /= Nil_String then
1293 Lang_Index.Config.Clean_Object_Artifacts,
1295 In_Tree => Data.Tree);
1298 -- Attribute Source_Artifact_Extensions (<language>)
1300 when Name_Source_Artifact_Extensions =>
1301 List := Element.Value.Values;
1303 if List /= Nil_String then
1305 Lang_Index.Config.Clean_Source_Artifacts,
1307 In_Tree => Data.Tree);
1315 Element_Id := Element.Next;
1318 Current_Array_Id := Current_Array.Next;
1322 ----------------------
1323 -- Process_Compiler --
1324 ----------------------
1326 procedure Process_Compiler (Arrays : Array_Id) is
1327 Current_Array_Id : Array_Id;
1328 Current_Array : Array_Data;
1329 Element_Id : Array_Element_Id;
1330 Element : Array_Element;
1331 List : String_List_Id;
1334 -- Process the associative array attribute of package Compiler
1336 Current_Array_Id := Arrays;
1337 while Current_Array_Id /= No_Array loop
1338 Current_Array := Shared.Arrays.Table (Current_Array_Id);
1340 Element_Id := Current_Array.Value;
1341 while Element_Id /= No_Array_Element loop
1342 Element := Shared.Array_Elements.Table (Element_Id);
1344 if Element.Index /= All_Other_Names then
1346 -- Get the name of the language
1348 Lang_Index := Get_Language_From_Name
1349 (Project, Get_Name_String (Element.Index));
1351 if Lang_Index /= No_Language_Index then
1352 case Current_Array.Name is
1354 -- Attribute Dependency_Kind (<language>)
1356 when Name_Dependency_Kind =>
1357 Get_Name_String (Element.Value.Value);
1360 Lang_Index.Config.Dependency_Kind :=
1361 Dependency_File_Kind'Value
1362 (Name_Buffer (1 .. Name_Len));
1365 when Constraint_Error =>
1368 "illegal value for Dependency_Kind",
1369 Element.Value.Location,
1373 -- Attribute Dependency_Switches (<language>)
1375 when Name_Dependency_Switches =>
1376 if Lang_Index.Config.Dependency_Kind = None then
1377 Lang_Index.Config.Dependency_Kind := Makefile;
1380 List := Element.Value.Values;
1382 if List /= Nil_String then
1384 Lang_Index.Config.Dependency_Option,
1386 In_Tree => Data.Tree);
1389 -- Attribute Dependency_Driver (<language>)
1391 when Name_Dependency_Driver =>
1392 if Lang_Index.Config.Dependency_Kind = None then
1393 Lang_Index.Config.Dependency_Kind := Makefile;
1396 List := Element.Value.Values;
1398 if List /= Nil_String then
1400 Lang_Index.Config.Compute_Dependency,
1402 In_Tree => Data.Tree);
1405 -- Attribute Language_Kind (<language>)
1407 when Name_Language_Kind =>
1408 Get_Name_String (Element.Value.Value);
1411 Lang_Index.Config.Kind :=
1413 (Name_Buffer (1 .. Name_Len));
1416 when Constraint_Error =>
1419 "illegal value for Language_Kind",
1420 Element.Value.Location,
1424 -- Attribute Include_Switches (<language>)
1426 when Name_Include_Switches =>
1427 List := Element.Value.Values;
1429 if List = Nil_String then
1431 (Data.Flags, "include option cannot be null",
1432 Element.Value.Location, Project);
1435 Put (Into_List => Lang_Index.Config.Include_Option,
1437 In_Tree => Data.Tree);
1439 -- Attribute Include_Path (<language>)
1441 when Name_Include_Path =>
1442 Lang_Index.Config.Include_Path :=
1443 Element.Value.Value;
1445 -- Attribute Include_Path_File (<language>)
1447 when Name_Include_Path_File =>
1448 Lang_Index.Config.Include_Path_File :=
1449 Element.Value.Value;
1451 -- Attribute Driver (<language>)
1454 Lang_Index.Config.Compiler_Driver :=
1455 File_Name_Type (Element.Value.Value);
1457 when Name_Required_Switches
1458 | Name_Leading_Required_Switches
1462 Compiler_Leading_Required_Switches,
1463 From_List => Element.Value.Values,
1464 In_Tree => Data.Tree);
1466 when Name_Trailing_Required_Switches =>
1469 Compiler_Trailing_Required_Switches,
1470 From_List => Element.Value.Values,
1471 In_Tree => Data.Tree);
1473 when Name_Multi_Unit_Switches =>
1475 Lang_Index.Config.Multi_Unit_Switches,
1476 From_List => Element.Value.Values,
1477 In_Tree => Data.Tree);
1479 when Name_Multi_Unit_Object_Separator =>
1480 Get_Name_String (Element.Value.Value);
1482 if Name_Len /= 1 then
1485 "multi-unit object separator must have " &
1486 "a single character",
1487 Element.Value.Location, Project);
1489 elsif Name_Buffer (1) = ' ' then
1492 "multi-unit object separator cannot be " &
1494 Element.Value.Location, Project);
1497 Lang_Index.Config.Multi_Unit_Object_Separator :=
1501 when Name_Path_Syntax =>
1503 Lang_Index.Config.Path_Syntax :=
1504 Path_Syntax_Kind'Value
1505 (Get_Name_String (Element.Value.Value));
1508 when Constraint_Error =>
1511 "invalid value for Path_Syntax",
1512 Element.Value.Location, Project);
1515 when Name_Source_File_Switches =>
1517 Lang_Index.Config.Source_File_Switches,
1518 From_List => Element.Value.Values,
1519 In_Tree => Data.Tree);
1521 when Name_Object_File_Suffix =>
1522 if Get_Name_String (Element.Value.Value) = "" then
1525 "object file suffix cannot be empty",
1526 Element.Value.Location, Project);
1529 Lang_Index.Config.Object_File_Suffix :=
1530 Element.Value.Value;
1533 when Name_Object_File_Switches =>
1535 Lang_Index.Config.Object_File_Switches,
1536 From_List => Element.Value.Values,
1537 In_Tree => Data.Tree);
1539 when Name_Object_Path_Switches =>
1541 Lang_Index.Config.Object_Path_Switches,
1542 From_List => Element.Value.Values,
1543 In_Tree => Data.Tree);
1545 -- Attribute Compiler_Pic_Option (<language>)
1547 when Name_Pic_Option =>
1548 List := Element.Value.Values;
1550 if List = Nil_String then
1553 "compiler PIC option cannot be null",
1554 Element.Value.Location, Project);
1558 Lang_Index.Config.Compilation_PIC_Option,
1560 In_Tree => Data.Tree);
1562 -- Attribute Mapping_File_Switches (<language>)
1564 when Name_Mapping_File_Switches =>
1565 List := Element.Value.Values;
1567 if List = Nil_String then
1570 "mapping file switches cannot be null",
1571 Element.Value.Location, Project);
1575 Lang_Index.Config.Mapping_File_Switches,
1577 In_Tree => Data.Tree);
1579 -- Attribute Mapping_Spec_Suffix (<language>)
1581 when Name_Mapping_Spec_Suffix =>
1582 Lang_Index.Config.Mapping_Spec_Suffix :=
1583 File_Name_Type (Element.Value.Value);
1585 -- Attribute Mapping_Body_Suffix (<language>)
1587 when Name_Mapping_Body_Suffix =>
1588 Lang_Index.Config.Mapping_Body_Suffix :=
1589 File_Name_Type (Element.Value.Value);
1591 -- Attribute Config_File_Switches (<language>)
1593 when Name_Config_File_Switches =>
1594 List := Element.Value.Values;
1596 if List = Nil_String then
1599 "config file switches cannot be null",
1600 Element.Value.Location, Project);
1604 Lang_Index.Config.Config_File_Switches,
1606 In_Tree => Data.Tree);
1608 -- Attribute Objects_Path (<language>)
1610 when Name_Objects_Path =>
1611 Lang_Index.Config.Objects_Path :=
1612 Element.Value.Value;
1614 -- Attribute Objects_Path_File (<language>)
1616 when Name_Objects_Path_File =>
1617 Lang_Index.Config.Objects_Path_File :=
1618 Element.Value.Value;
1620 -- Attribute Config_Body_File_Name (<language>)
1622 when Name_Config_Body_File_Name =>
1623 Lang_Index.Config.Config_Body :=
1624 Element.Value.Value;
1626 -- Attribute Config_Body_File_Name_Index (< Language>)
1628 when Name_Config_Body_File_Name_Index =>
1629 Lang_Index.Config.Config_Body_Index :=
1630 Element.Value.Value;
1632 -- Attribute Config_Body_File_Name_Pattern(<language>)
1634 when Name_Config_Body_File_Name_Pattern =>
1635 Lang_Index.Config.Config_Body_Pattern :=
1636 Element.Value.Value;
1638 -- Attribute Config_Spec_File_Name (<language>)
1640 when Name_Config_Spec_File_Name =>
1641 Lang_Index.Config.Config_Spec :=
1642 Element.Value.Value;
1644 -- Attribute Config_Spec_File_Name_Index (<language>)
1646 when Name_Config_Spec_File_Name_Index =>
1647 Lang_Index.Config.Config_Spec_Index :=
1648 Element.Value.Value;
1650 -- Attribute Config_Spec_File_Name_Pattern(<language>)
1652 when Name_Config_Spec_File_Name_Pattern =>
1653 Lang_Index.Config.Config_Spec_Pattern :=
1654 Element.Value.Value;
1656 -- Attribute Config_File_Unique (<language>)
1658 when Name_Config_File_Unique =>
1660 Lang_Index.Config.Config_File_Unique :=
1662 (Get_Name_String (Element.Value.Value));
1664 when Constraint_Error =>
1667 "illegal value for Config_File_Unique",
1668 Element.Value.Location, Project);
1677 Element_Id := Element.Next;
1680 Current_Array_Id := Current_Array.Next;
1682 end Process_Compiler;
1684 --------------------
1685 -- Process_Naming --
1686 --------------------
1688 procedure Process_Naming (Attributes : Variable_Id) is
1689 Attribute_Id : Variable_Id;
1690 Attribute : Variable;
1693 -- Process non associated array attribute from package Naming
1695 Attribute_Id := Attributes;
1696 while Attribute_Id /= No_Variable loop
1697 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1699 if not Attribute.Value.Default then
1700 if Attribute.Name = Name_Separate_Suffix then
1702 -- Attribute Separate_Suffix
1704 Get_Name_String (Attribute.Value.Value);
1705 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1706 Separate_Suffix := Name_Find;
1708 elsif Attribute.Name = Name_Casing then
1714 Value (Get_Name_String (Attribute.Value.Value));
1717 when Constraint_Error =>
1720 "invalid value for Casing",
1721 Attribute.Value.Location, Project);
1724 elsif Attribute.Name = Name_Dot_Replacement then
1726 -- Attribute Dot_Replacement
1728 Dot_Replacement := File_Name_Type (Attribute.Value.Value);
1733 Attribute_Id := Attribute.Next;
1737 procedure Process_Naming (Arrays : Array_Id) is
1738 Current_Array_Id : Array_Id;
1739 Current_Array : Array_Data;
1740 Element_Id : Array_Element_Id;
1741 Element : Array_Element;
1744 -- Process the associative array attribute of package Naming
1746 Current_Array_Id := Arrays;
1747 while Current_Array_Id /= No_Array loop
1748 Current_Array := Shared.Arrays.Table (Current_Array_Id);
1750 Element_Id := Current_Array.Value;
1751 while Element_Id /= No_Array_Element loop
1752 Element := Shared.Array_Elements.Table (Element_Id);
1754 -- Get the name of the language
1756 Lang_Index := Get_Language_From_Name
1757 (Project, Get_Name_String (Element.Index));
1759 if Lang_Index /= No_Language_Index then
1760 case Current_Array.Name is
1761 when Name_Spec_Suffix | Name_Specification_Suffix =>
1763 -- Attribute Spec_Suffix (<language>)
1765 Get_Name_String (Element.Value.Value);
1766 Canonical_Case_File_Name
1767 (Name_Buffer (1 .. Name_Len));
1768 Lang_Index.Config.Naming_Data.Spec_Suffix :=
1771 when Name_Implementation_Suffix | Name_Body_Suffix =>
1773 Get_Name_String (Element.Value.Value);
1774 Canonical_Case_File_Name
1775 (Name_Buffer (1 .. Name_Len));
1777 -- Attribute Body_Suffix (<language>)
1779 Lang_Index.Config.Naming_Data.Body_Suffix :=
1781 Lang_Index.Config.Naming_Data.Separate_Suffix :=
1782 Lang_Index.Config.Naming_Data.Body_Suffix;
1789 Element_Id := Element.Next;
1792 Current_Array_Id := Current_Array.Next;
1796 --------------------
1797 -- Process_Linker --
1798 --------------------
1800 procedure Process_Linker (Attributes : Variable_Id) is
1801 Attribute_Id : Variable_Id;
1802 Attribute : Variable;
1805 -- Process non associated array attribute from package Linker
1807 Attribute_Id := Attributes;
1808 while Attribute_Id /= No_Variable loop
1809 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1811 if not Attribute.Value.Default then
1812 if Attribute.Name = Name_Driver then
1814 -- Attribute Linker'Driver: the default linker to use
1816 Project.Config.Linker :=
1817 Path_Name_Type (Attribute.Value.Value);
1819 -- Linker'Driver is also used to link shared libraries
1820 -- if the obsolescent attribute Library_GCC has not been
1823 if Project.Config.Shared_Lib_Driver = No_File then
1824 Project.Config.Shared_Lib_Driver :=
1825 File_Name_Type (Attribute.Value.Value);
1828 elsif Attribute.Name = Name_Required_Switches then
1830 -- Attribute Required_Switches: the minimum trailing
1831 -- options to use when invoking the linker
1834 Project.Config.Trailing_Linker_Required_Switches,
1835 From_List => Attribute.Value.Values,
1836 In_Tree => Data.Tree);
1838 elsif Attribute.Name = Name_Map_File_Option then
1839 Project.Config.Map_File_Option := Attribute.Value.Value;
1841 elsif Attribute.Name = Name_Max_Command_Line_Length then
1843 Project.Config.Max_Command_Line_Length :=
1844 Natural'Value (Get_Name_String
1845 (Attribute.Value.Value));
1848 when Constraint_Error =>
1851 "value must be positive or equal to 0",
1852 Attribute.Value.Location, Project);
1855 elsif Attribute.Name = Name_Response_File_Format then
1860 Get_Name_String (Attribute.Value.Value);
1861 To_Lower (Name_Buffer (1 .. Name_Len));
1864 if Name = Name_None then
1865 Project.Config.Resp_File_Format := None;
1867 elsif Name = Name_Gnu then
1868 Project.Config.Resp_File_Format := GNU;
1870 elsif Name = Name_Object_List then
1871 Project.Config.Resp_File_Format := Object_List;
1873 elsif Name = Name_Option_List then
1874 Project.Config.Resp_File_Format := Option_List;
1876 elsif Name_Buffer (1 .. Name_Len) = "gcc" then
1877 Project.Config.Resp_File_Format := GCC;
1879 elsif Name_Buffer (1 .. Name_Len) = "gcc_gnu" then
1880 Project.Config.Resp_File_Format := GCC_GNU;
1883 Name_Buffer (1 .. Name_Len) = "gcc_option_list"
1885 Project.Config.Resp_File_Format := GCC_Option_List;
1888 Name_Buffer (1 .. Name_Len) = "gcc_object_list"
1890 Project.Config.Resp_File_Format := GCC_Object_List;
1895 "illegal response file format",
1896 Attribute.Value.Location, Project);
1900 elsif Attribute.Name = Name_Response_File_Switches then
1901 Put (Into_List => Project.Config.Resp_File_Options,
1902 From_List => Attribute.Value.Values,
1903 In_Tree => Data.Tree);
1907 Attribute_Id := Attribute.Next;
1911 -- Start of processing for Process_Packages
1914 Packages := Project.Decl.Packages;
1915 while Packages /= No_Package loop
1916 Element := Shared.Packages.Table (Packages);
1918 case Element.Name is
1921 -- Process attributes of package Binder
1923 Process_Binder (Element.Decl.Arrays);
1925 when Name_Builder =>
1927 -- Process attributes of package Builder
1929 Process_Builder (Element.Decl.Attributes);
1933 -- Process attributes of package Clean
1935 Process_Clean (Element.Decl.Arrays);
1937 when Name_Compiler =>
1939 -- Process attributes of package Compiler
1941 Process_Compiler (Element.Decl.Arrays);
1945 -- Process attributes of package Linker
1947 Process_Linker (Element.Decl.Attributes);
1951 -- Process attributes of package Naming
1953 Process_Naming (Element.Decl.Attributes);
1954 Process_Naming (Element.Decl.Arrays);
1960 Packages := Element.Next;
1962 end Process_Packages;
1964 ---------------------------------------------
1965 -- Process_Project_Level_Simple_Attributes --
1966 ---------------------------------------------
1968 procedure Process_Project_Level_Simple_Attributes is
1969 Attribute_Id : Variable_Id;
1970 Attribute : Variable;
1971 List : String_List_Id;
1974 -- Process non associated array attribute at project level
1976 Attribute_Id := Project.Decl.Attributes;
1977 while Attribute_Id /= No_Variable loop
1978 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1980 if not Attribute.Value.Default then
1981 if Attribute.Name = Name_Target then
1983 -- Attribute Target: the target specified
1985 Project.Config.Target := Attribute.Value.Value;
1987 elsif Attribute.Name = Name_Library_Builder then
1989 -- Attribute Library_Builder: the application to invoke
1990 -- to build libraries.
1992 Project.Config.Library_Builder :=
1993 Path_Name_Type (Attribute.Value.Value);
1995 elsif Attribute.Name = Name_Archive_Builder then
1997 -- Attribute Archive_Builder: the archive builder
1998 -- (usually "ar") and its minimum options (usually "cr").
2000 List := Attribute.Value.Values;
2002 if List = Nil_String then
2005 "archive builder cannot be null",
2006 Attribute.Value.Location, Project);
2009 Put (Into_List => Project.Config.Archive_Builder,
2011 In_Tree => Data.Tree);
2013 elsif Attribute.Name = Name_Archive_Builder_Append_Option then
2015 -- Attribute Archive_Builder: the archive builder
2016 -- (usually "ar") and its minimum options (usually "cr").
2018 List := Attribute.Value.Values;
2020 if List /= Nil_String then
2023 Project.Config.Archive_Builder_Append_Option,
2025 In_Tree => Data.Tree);
2028 elsif Attribute.Name = Name_Archive_Indexer then
2030 -- Attribute Archive_Indexer: the optional archive
2031 -- indexer (usually "ranlib") with its minimum options
2034 List := Attribute.Value.Values;
2036 if List = Nil_String then
2039 "archive indexer cannot be null",
2040 Attribute.Value.Location, Project);
2043 Put (Into_List => Project.Config.Archive_Indexer,
2045 In_Tree => Data.Tree);
2047 elsif Attribute.Name = Name_Library_Partial_Linker then
2049 -- Attribute Library_Partial_Linker: the optional linker
2050 -- driver with its minimum options, to partially link
2053 List := Attribute.Value.Values;
2055 if List = Nil_String then
2058 "partial linker cannot be null",
2059 Attribute.Value.Location, Project);
2062 Put (Into_List => Project.Config.Lib_Partial_Linker,
2064 In_Tree => Data.Tree);
2066 elsif Attribute.Name = Name_Library_GCC then
2067 Project.Config.Shared_Lib_Driver :=
2068 File_Name_Type (Attribute.Value.Value);
2071 "?Library_'G'C'C is an obsolescent attribute, " &
2072 "use Linker''Driver instead",
2073 Attribute.Value.Location, Project);
2075 elsif Attribute.Name = Name_Archive_Suffix then
2076 Project.Config.Archive_Suffix :=
2077 File_Name_Type (Attribute.Value.Value);
2079 elsif Attribute.Name = Name_Linker_Executable_Option then
2081 -- Attribute Linker_Executable_Option: optional options
2082 -- to specify an executable name. Defaults to "-o".
2084 List := Attribute.Value.Values;
2086 if List = Nil_String then
2089 "linker executable option cannot be null",
2090 Attribute.Value.Location, Project);
2093 Put (Into_List => Project.Config.Linker_Executable_Option,
2095 In_Tree => Data.Tree);
2097 elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
2099 -- Attribute Linker_Lib_Dir_Option: optional options
2100 -- to specify a library search directory. Defaults to
2103 Get_Name_String (Attribute.Value.Value);
2105 if Name_Len = 0 then
2108 "linker library directory option cannot be empty",
2109 Attribute.Value.Location, Project);
2112 Project.Config.Linker_Lib_Dir_Option :=
2113 Attribute.Value.Value;
2115 elsif Attribute.Name = Name_Linker_Lib_Name_Option then
2117 -- Attribute Linker_Lib_Name_Option: optional options
2118 -- to specify the name of a library to be linked in.
2119 -- Defaults to "-l".
2121 Get_Name_String (Attribute.Value.Value);
2123 if Name_Len = 0 then
2126 "linker library name option cannot be empty",
2127 Attribute.Value.Location, Project);
2130 Project.Config.Linker_Lib_Name_Option :=
2131 Attribute.Value.Value;
2133 elsif Attribute.Name = Name_Run_Path_Option then
2135 -- Attribute Run_Path_Option: optional options to
2136 -- specify a path for libraries.
2138 List := Attribute.Value.Values;
2140 if List /= Nil_String then
2141 Put (Into_List => Project.Config.Run_Path_Option,
2143 In_Tree => Data.Tree);
2146 elsif Attribute.Name = Name_Run_Path_Origin then
2147 Get_Name_String (Attribute.Value.Value);
2149 if Name_Len = 0 then
2152 "run path origin cannot be empty",
2153 Attribute.Value.Location, Project);
2156 Project.Config.Run_Path_Origin := Attribute.Value.Value;
2158 elsif Attribute.Name = Name_Library_Install_Name_Option then
2159 Project.Config.Library_Install_Name_Option :=
2160 Attribute.Value.Value;
2162 elsif Attribute.Name = Name_Separate_Run_Path_Options then
2164 pragma Unsuppress (All_Checks);
2166 Project.Config.Separate_Run_Path_Options :=
2167 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2169 when Constraint_Error =>
2172 "invalid value """ &
2173 Get_Name_String (Attribute.Value.Value) &
2174 """ for Separate_Run_Path_Options",
2175 Attribute.Value.Location, Project);
2178 elsif Attribute.Name = Name_Library_Support then
2180 pragma Unsuppress (All_Checks);
2182 Project.Config.Lib_Support :=
2183 Library_Support'Value (Get_Name_String
2184 (Attribute.Value.Value));
2186 when Constraint_Error =>
2189 "invalid value """ &
2190 Get_Name_String (Attribute.Value.Value) &
2191 """ for Library_Support",
2192 Attribute.Value.Location, Project);
2196 Attribute.Name = Name_Library_Encapsulated_Supported
2199 pragma Unsuppress (All_Checks);
2201 Project.Config.Lib_Encapsulated_Supported :=
2202 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2204 when Constraint_Error =>
2208 & Get_Name_String (Attribute.Value.Value)
2209 & """ for Library_Encapsulated_Supported",
2210 Attribute.Value.Location, Project);
2213 elsif Attribute.Name = Name_Shared_Library_Prefix then
2214 Project.Config.Shared_Lib_Prefix :=
2215 File_Name_Type (Attribute.Value.Value);
2217 elsif Attribute.Name = Name_Shared_Library_Suffix then
2218 Project.Config.Shared_Lib_Suffix :=
2219 File_Name_Type (Attribute.Value.Value);
2221 elsif Attribute.Name = Name_Symbolic_Link_Supported then
2223 pragma Unsuppress (All_Checks);
2225 Project.Config.Symbolic_Link_Supported :=
2226 Boolean'Value (Get_Name_String
2227 (Attribute.Value.Value));
2229 when Constraint_Error =>
2233 & Get_Name_String (Attribute.Value.Value)
2234 & """ for Symbolic_Link_Supported",
2235 Attribute.Value.Location, Project);
2239 Attribute.Name = Name_Library_Major_Minor_Id_Supported
2242 pragma Unsuppress (All_Checks);
2244 Project.Config.Lib_Maj_Min_Id_Supported :=
2245 Boolean'Value (Get_Name_String
2246 (Attribute.Value.Value));
2248 when Constraint_Error =>
2251 "invalid value """ &
2252 Get_Name_String (Attribute.Value.Value) &
2253 """ for Library_Major_Minor_Id_Supported",
2254 Attribute.Value.Location, Project);
2257 elsif Attribute.Name = Name_Library_Auto_Init_Supported then
2259 pragma Unsuppress (All_Checks);
2261 Project.Config.Auto_Init_Supported :=
2262 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2264 when Constraint_Error =>
2268 & Get_Name_String (Attribute.Value.Value)
2269 & """ for Library_Auto_Init_Supported",
2270 Attribute.Value.Location, Project);
2273 elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
2274 List := Attribute.Value.Values;
2276 if List /= Nil_String then
2277 Put (Into_List => Project.Config.Shared_Lib_Min_Options,
2279 In_Tree => Data.Tree);
2282 elsif Attribute.Name = Name_Library_Version_Switches then
2283 List := Attribute.Value.Values;
2285 if List /= Nil_String then
2286 Put (Into_List => Project.Config.Lib_Version_Options,
2288 In_Tree => Data.Tree);
2293 Attribute_Id := Attribute.Next;
2295 end Process_Project_Level_Simple_Attributes;
2297 --------------------------------------------
2298 -- Process_Project_Level_Array_Attributes --
2299 --------------------------------------------
2301 procedure Process_Project_Level_Array_Attributes is
2302 Current_Array_Id : Array_Id;
2303 Current_Array : Array_Data;
2304 Element_Id : Array_Element_Id;
2305 Element : Array_Element;
2306 List : String_List_Id;
2309 -- Process the associative array attributes at project level
2311 Current_Array_Id := Project.Decl.Arrays;
2312 while Current_Array_Id /= No_Array loop
2313 Current_Array := Shared.Arrays.Table (Current_Array_Id);
2315 Element_Id := Current_Array.Value;
2316 while Element_Id /= No_Array_Element loop
2317 Element := Shared.Array_Elements.Table (Element_Id);
2319 -- Get the name of the language
2322 Get_Language_From_Name
2323 (Project, Get_Name_String (Element.Index));
2325 if Lang_Index /= No_Language_Index then
2326 case Current_Array.Name is
2327 when Name_Inherit_Source_Path =>
2328 List := Element.Value.Values;
2330 if List /= Nil_String then
2333 Lang_Index.Config.Include_Compatible_Languages,
2335 In_Tree => Data.Tree,
2336 Lower_Case => True);
2339 when Name_Toolchain_Description =>
2341 -- Attribute Toolchain_Description (<language>)
2343 Lang_Index.Config.Toolchain_Description :=
2344 Element.Value.Value;
2346 when Name_Toolchain_Version =>
2348 -- Attribute Toolchain_Version (<language>)
2350 Lang_Index.Config.Toolchain_Version :=
2351 Element.Value.Value;
2353 -- For Ada, set proper checksum computation mode
2355 if Lang_Index.Name = Name_Ada then
2357 Vers : constant String :=
2358 Get_Name_String (Element.Value.Value);
2359 pragma Assert (Vers'First = 1);
2362 -- Version 6.3 or earlier
2365 and then Vers (1 .. 5) = "GNAT "
2366 and then Vers (7) = '.'
2370 (Vers (6) = '6' and then Vers (8) < '4'))
2372 Checksum_GNAT_6_3 := True;
2374 -- Version 5.03 or earlier
2377 or else (Vers (6) = '5'
2378 and then Vers (Vers'Last) < '4')
2380 Checksum_GNAT_5_03 := True;
2382 -- Version 5.02 or earlier
2385 or else Vers (Vers'Last) < '3'
2387 Checksum_Accumulate_Token_Checksum :=
2395 when Name_Runtime_Library_Dir =>
2397 -- Attribute Runtime_Library_Dir (<language>)
2399 Lang_Index.Config.Runtime_Library_Dir :=
2400 Element.Value.Value;
2402 when Name_Runtime_Source_Dir =>
2404 -- Attribute Runtime_Source_Dir (<language>)
2406 Lang_Index.Config.Runtime_Source_Dir :=
2407 Element.Value.Value;
2409 when Name_Object_Generated =>
2411 pragma Unsuppress (All_Checks);
2417 (Get_Name_String (Element.Value.Value));
2419 Lang_Index.Config.Object_Generated := Value;
2421 -- If no object is generated, no object may be
2425 Lang_Index.Config.Objects_Linked := False;
2429 when Constraint_Error =>
2433 & Get_Name_String (Element.Value.Value)
2434 & """ for Object_Generated",
2435 Element.Value.Location, Project);
2438 when Name_Objects_Linked =>
2440 pragma Unsuppress (All_Checks);
2446 (Get_Name_String (Element.Value.Value));
2448 -- No change if Object_Generated is False, as this
2449 -- forces Objects_Linked to be False too.
2451 if Lang_Index.Config.Object_Generated then
2452 Lang_Index.Config.Objects_Linked := Value;
2456 when Constraint_Error =>
2460 & Get_Name_String (Element.Value.Value)
2461 & """ for Objects_Linked",
2462 Element.Value.Location, Project);
2469 Element_Id := Element.Next;
2472 Current_Array_Id := Current_Array.Next;
2474 end Process_Project_Level_Array_Attributes;
2476 -- Start of processing for Check_Configuration
2479 Process_Project_Level_Simple_Attributes;
2480 Process_Project_Level_Array_Attributes;
2483 -- For unit based languages, set Casing, Dot_Replacement and
2484 -- Separate_Suffix in Naming_Data.
2486 Lang_Index := Project.Languages;
2487 while Lang_Index /= No_Language_Index loop
2488 if Lang_Index.Config.Kind = Unit_Based then
2489 Lang_Index.Config.Naming_Data.Casing := Casing;
2490 Lang_Index.Config.Naming_Data.Dot_Replacement := Dot_Replacement;
2492 if Separate_Suffix /= No_File then
2493 Lang_Index.Config.Naming_Data.Separate_Suffix :=
2500 Lang_Index := Lang_Index.Next;
2503 -- Give empty names to various prefixes/suffixes, if they have not
2504 -- been specified in the configuration.
2506 if Project.Config.Archive_Suffix = No_File then
2507 Project.Config.Archive_Suffix := Empty_File;
2510 if Project.Config.Shared_Lib_Prefix = No_File then
2511 Project.Config.Shared_Lib_Prefix := Empty_File;
2514 if Project.Config.Shared_Lib_Suffix = No_File then
2515 Project.Config.Shared_Lib_Suffix := Empty_File;
2518 Lang_Index := Project.Languages;
2519 while Lang_Index /= No_Language_Index loop
2521 -- For all languages, Compiler_Driver needs to be specified. This is
2522 -- only needed if we do intend to compile (not in GPS for instance).
2524 if Data.Flags.Compiler_Driver_Mandatory
2525 and then Lang_Index.Config.Compiler_Driver = No_File
2527 Error_Msg_Name_1 := Lang_Index.Display_Name;
2530 "?no compiler specified for language %%" &
2531 ", ignoring all its sources",
2532 No_Location, Project);
2534 if Lang_Index = Project.Languages then
2535 Project.Languages := Lang_Index.Next;
2537 Prev_Index.Next := Lang_Index.Next;
2540 elsif Lang_Index.Config.Kind = Unit_Based then
2541 Prev_Index := Lang_Index;
2543 -- For unit based languages, Dot_Replacement, Spec_Suffix and
2544 -- Body_Suffix need to be specified.
2546 if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then
2549 "Dot_Replacement not specified for " &
2550 Get_Name_String (Lang_Index.Name),
2551 No_Location, Project);
2554 if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
2557 "Spec_Suffix not specified for " &
2558 Get_Name_String (Lang_Index.Name),
2559 No_Location, Project);
2562 if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
2565 "Body_Suffix not specified for " &
2566 Get_Name_String (Lang_Index.Name),
2567 No_Location, Project);
2571 Prev_Index := Lang_Index;
2573 -- For file based languages, either Spec_Suffix or Body_Suffix
2574 -- need to be specified.
2576 if Data.Flags.Require_Sources_Other_Lang
2577 and then Lang_Index.Config.Naming_Data.Spec_Suffix = No_File
2578 and then Lang_Index.Config.Naming_Data.Body_Suffix = No_File
2580 Error_Msg_Name_1 := Lang_Index.Display_Name;
2583 "no suffixes specified for %%",
2584 No_Location, Project);
2588 Lang_Index := Lang_Index.Next;
2590 end Check_Configuration;
2592 -------------------------------
2593 -- Check_If_Externally_Built --
2594 -------------------------------
2596 procedure Check_If_Externally_Built
2597 (Project : Project_Id;
2598 Data : in out Tree_Processing_Data)
2600 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
2601 Externally_Built : constant Variable_Value :=
2603 (Name_Externally_Built,
2604 Project.Decl.Attributes, Shared);
2607 if not Externally_Built.Default then
2608 Get_Name_String (Externally_Built.Value);
2609 To_Lower (Name_Buffer (1 .. Name_Len));
2611 if Name_Buffer (1 .. Name_Len) = "true" then
2612 Project.Externally_Built := True;
2614 elsif Name_Buffer (1 .. Name_Len) /= "false" then
2615 Error_Msg (Data.Flags,
2616 "Externally_Built may only be true or false",
2617 Externally_Built.Location, Project);
2621 -- A virtual project extending an externally built project is itself
2622 -- externally built.
2624 if Project.Virtual and then Project.Extends /= No_Project then
2625 Project.Externally_Built := Project.Extends.Externally_Built;
2628 if Project.Externally_Built then
2629 Debug_Output ("project is externally built");
2631 Debug_Output ("project is not externally built");
2633 end Check_If_Externally_Built;
2635 ----------------------
2636 -- Check_Interfaces --
2637 ----------------------
2639 procedure Check_Interfaces
2640 (Project : Project_Id;
2641 Data : in out Tree_Processing_Data)
2643 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
2645 Interfaces : constant Prj.Variable_Value :=
2647 (Snames.Name_Interfaces,
2648 Project.Decl.Attributes,
2651 Library_Interface : constant Prj.Variable_Value :=
2653 (Snames.Name_Library_Interface,
2654 Project.Decl.Attributes,
2657 List : String_List_Id;
2658 Element : String_Element;
2659 Name : File_Name_Type;
2660 Iter : Source_Iterator;
2662 Project_2 : Project_Id;
2664 Unit_Found : Boolean;
2666 Interface_ALIs : String_List_Id := Nil_String;
2669 if not Interfaces.Default then
2671 -- Set In_Interfaces to False for all sources. It will be set to True
2672 -- later for the sources in the Interfaces list.
2674 Project_2 := Project;
2675 while Project_2 /= No_Project loop
2676 Iter := For_Each_Source (Data.Tree, Project_2);
2678 Source := Prj.Element (Iter);
2679 exit when Source = No_Source;
2680 Source.In_Interfaces := False;
2684 Project_2 := Project_2.Extends;
2687 List := Interfaces.Values;
2688 while List /= Nil_String loop
2689 Element := Shared.String_Elements.Table (List);
2690 Name := Canonical_Case_File_Name (Element.Value);
2692 Project_2 := Project;
2693 Big_Loop : while Project_2 /= No_Project loop
2694 if Project.Qualifier = Aggregate_Library then
2696 -- For an aggregate library we want to consider sources of
2697 -- all aggregated projects.
2699 Iter := For_Each_Source (Data.Tree);
2702 Iter := For_Each_Source (Data.Tree, Project_2);
2706 Source := Prj.Element (Iter);
2707 exit when Source = No_Source;
2709 if Source.File = Name then
2710 if not Source.Locally_Removed then
2711 Source.In_Interfaces := True;
2712 Source.Declared_In_Interfaces := True;
2714 Other := Other_Part (Source);
2716 if Other /= No_Source then
2717 Other.In_Interfaces := True;
2718 Other.Declared_In_Interfaces := True;
2721 if Source.Language.Config.Kind = Unit_Based then
2722 if Source.Kind = Spec
2723 and then Other_Part (Source) /= No_Source
2725 Source := Other_Part (Source);
2728 String_Element_Table.Increment_Last
2729 (Shared.String_Elements);
2731 Shared.String_Elements.Table
2732 (String_Element_Table.Last
2733 (Shared.String_Elements)) :=
2734 (Value => Name_Id (Source.Dep_Name),
2736 Display_Value => Name_Id (Source.Dep_Name),
2737 Location => No_Location,
2739 Next => Interface_ALIs);
2742 String_Element_Table.Last
2743 (Shared.String_Elements);
2747 ("interface: ", Name_Id (Source.Path.Name));
2756 Project_2 := Project_2.Extends;
2759 if Source = No_Source then
2760 Error_Msg_File_1 := File_Name_Type (Element.Value);
2761 Error_Msg_Name_1 := Project.Name;
2765 "{ cannot be an interface of project %% "
2766 & "as it is not one of its sources",
2767 Element.Location, Project);
2770 List := Element.Next;
2773 Project.Interfaces_Defined := True;
2774 Project.Lib_Interface_ALIs := Interface_ALIs;
2776 elsif Project.Library and then not Library_Interface.Default then
2778 -- Set In_Interfaces to False for all sources. It will be set to True
2779 -- later for the sources in the Library_Interface list.
2781 Project_2 := Project;
2782 while Project_2 /= No_Project loop
2783 Iter := For_Each_Source (Data.Tree, Project_2);
2785 Source := Prj.Element (Iter);
2786 exit when Source = No_Source;
2787 Source.In_Interfaces := False;
2791 Project_2 := Project_2.Extends;
2794 List := Library_Interface.Values;
2795 while List /= Nil_String loop
2796 Element := Shared.String_Elements.Table (List);
2797 Get_Name_String (Element.Value);
2798 To_Lower (Name_Buffer (1 .. Name_Len));
2800 Unit_Found := False;
2802 Project_2 := Project;
2803 Big_Loop_2 : while Project_2 /= No_Project loop
2804 if Project.Qualifier = Aggregate_Library then
2806 -- For an aggregate library we want to consider sources of
2807 -- all aggregated projects.
2809 Iter := For_Each_Source (Data.Tree);
2812 Iter := For_Each_Source (Data.Tree, Project_2);
2816 Source := Prj.Element (Iter);
2817 exit when Source = No_Source;
2819 if Source.Unit /= No_Unit_Index
2820 and then Source.Unit.Name = Name_Id (Name)
2822 if not Source.Locally_Removed then
2823 Source.In_Interfaces := True;
2824 Source.Declared_In_Interfaces := True;
2825 Project.Interfaces_Defined := True;
2827 Other := Other_Part (Source);
2829 if Other /= No_Source then
2830 Other.In_Interfaces := True;
2831 Other.Declared_In_Interfaces := True;
2835 ("interface: ", Name_Id (Source.Path.Name));
2837 if Source.Kind = Spec
2838 and then Other_Part (Source) /= No_Source
2840 Source := Other_Part (Source);
2843 String_Element_Table.Increment_Last
2844 (Shared.String_Elements);
2846 Shared.String_Elements.Table
2847 (String_Element_Table.Last
2848 (Shared.String_Elements)) :=
2849 (Value => Name_Id (Source.Dep_Name),
2851 Display_Value => Name_Id (Source.Dep_Name),
2852 Location => No_Location,
2854 Next => Interface_ALIs);
2857 String_Element_Table.Last (Shared.String_Elements);
2867 Project_2 := Project_2.Extends;
2868 end loop Big_Loop_2;
2870 if not Unit_Found then
2871 Error_Msg_Name_1 := Name_Id (Name);
2875 "%% is not a unit of this project",
2876 Element.Location, Project);
2879 List := Element.Next;
2882 Project.Lib_Interface_ALIs := Interface_ALIs;
2884 elsif Project.Extends /= No_Project
2885 and then Project.Extends.Interfaces_Defined
2887 Project.Interfaces_Defined := True;
2889 Iter := For_Each_Source (Data.Tree, Project);
2891 Source := Prj.Element (Iter);
2892 exit when Source = No_Source;
2894 if not Source.Declared_In_Interfaces then
2895 Source.In_Interfaces := False;
2901 Project.Lib_Interface_ALIs := Project.Extends.Lib_Interface_ALIs;
2903 end Check_Interfaces;
2905 ------------------------------
2906 -- Check_Library_Attributes --
2907 ------------------------------
2909 -- This procedure is awfully long (over 700 lines) should be broken up???
2911 procedure Check_Library_Attributes
2912 (Project : Project_Id;
2913 Data : in out Tree_Processing_Data)
2915 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
2917 Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
2919 Lib_Dir : constant Prj.Variable_Value :=
2921 (Snames.Name_Library_Dir, Attributes, Shared);
2923 Lib_Name : constant Prj.Variable_Value :=
2925 (Snames.Name_Library_Name, Attributes, Shared);
2927 Lib_Standalone : constant Prj.Variable_Value :=
2929 (Snames.Name_Library_Standalone,
2930 Attributes, Shared);
2932 Lib_Version : constant Prj.Variable_Value :=
2934 (Snames.Name_Library_Version, Attributes, Shared);
2936 Lib_ALI_Dir : constant Prj.Variable_Value :=
2938 (Snames.Name_Library_Ali_Dir, Attributes, Shared);
2940 Lib_GCC : constant Prj.Variable_Value :=
2942 (Snames.Name_Library_GCC, Attributes, Shared);
2944 The_Lib_Kind : constant Prj.Variable_Value :=
2946 (Snames.Name_Library_Kind, Attributes, Shared);
2948 Imported_Project_List : Project_List;
2949 Continuation : String_Access := No_Continuation_String'Access;
2950 Support_For_Libraries : Library_Support;
2952 Library_Directory_Present : Boolean;
2954 procedure Check_Library (Proj : Project_Id; Extends : Boolean);
2955 -- Check if an imported or extended project if also a library project
2961 procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
2963 Iter : Source_Iterator;
2966 if Proj /= No_Project then
2967 if not Proj.Library then
2969 -- The only not library projects that are OK are those that
2970 -- have no sources. However, header files from non-Ada
2971 -- languages are OK, as there is nothing to compile.
2973 Iter := For_Each_Source (Data.Tree, Proj);
2975 Src_Id := Prj.Element (Iter);
2976 exit when Src_Id = No_Source
2977 or else Src_Id.Language.Config.Kind /= File_Based
2978 or else Src_Id.Kind /= Spec;
2982 if Src_Id /= No_Source then
2983 Error_Msg_Name_1 := Project.Name;
2984 Error_Msg_Name_2 := Proj.Name;
2987 if Project.Library_Kind /= Static then
2991 "shared library project %% cannot extend " &
2992 "project %% that is not a library project",
2993 Project.Location, Project);
2994 Continuation := Continuation_String'Access;
2997 elsif not Unchecked_Shared_Lib_Imports
2998 and then Project.Library_Kind /= Static
3003 "shared library project %% cannot import project %% " &
3004 "that is not a shared library project",
3005 Project.Location, Project);
3006 Continuation := Continuation_String'Access;
3010 elsif Project.Library_Kind /= Static
3011 and then not Lib_Standalone.Default
3012 and then Get_Name_String (Lib_Standalone.Value) = "encapsulated"
3013 and then Proj.Library_Kind /= Static
3015 -- An encapsulated library must depend only on static libraries
3017 Error_Msg_Name_1 := Project.Name;
3018 Error_Msg_Name_2 := Proj.Name;
3023 "encapsulated library project %% cannot import shared " &
3024 "library project %%",
3025 Project.Location, Project);
3026 Continuation := Continuation_String'Access;
3028 elsif Project.Library_Kind /= Static
3029 and then Proj.Library_Kind = Static
3031 (Lib_Standalone.Default
3033 Get_Name_String (Lib_Standalone.Value) /= "encapsulated")
3035 Error_Msg_Name_1 := Project.Name;
3036 Error_Msg_Name_2 := Proj.Name;
3042 "shared library project %% cannot extend static " &
3043 "library project %%",
3044 Project.Location, Project);
3045 Continuation := Continuation_String'Access;
3047 elsif not Unchecked_Shared_Lib_Imports then
3051 "shared library project %% cannot import static " &
3052 "library project %%",
3053 Project.Location, Project);
3054 Continuation := Continuation_String'Access;
3061 Dir_Exists : Boolean;
3063 -- Start of processing for Check_Library_Attributes
3066 Library_Directory_Present := Lib_Dir.Value /= Empty_String;
3068 -- Special case of extending project
3070 if Project.Extends /= No_Project then
3072 -- If the project extended is a library project, we inherit the
3073 -- library name, if it is not redefined; we check that the library
3074 -- directory is specified.
3076 if Project.Extends.Library then
3077 if Project.Qualifier = Standard then
3080 "a standard project cannot extend a library project",
3081 Project.Location, Project);
3084 if Lib_Name.Default then
3085 Project.Library_Name := Project.Extends.Library_Name;
3088 if Lib_Dir.Default then
3089 if not Project.Virtual then
3092 "a project extending a library project must " &
3093 "specify an attribute Library_Dir",
3094 Project.Location, Project);
3097 -- For a virtual project extending a library project,
3098 -- inherit library directory and library kind.
3100 Project.Library_Dir := Project.Extends.Library_Dir;
3101 Library_Directory_Present := True;
3102 Project.Library_Kind := Project.Extends.Library_Kind;
3109 pragma Assert (Lib_Name.Kind = Single);
3111 if Lib_Name.Value = Empty_String then
3112 if Current_Verbosity = High
3113 and then Project.Library_Name = No_Name
3116 Write_Line ("no library name");
3120 -- There is no restriction on the syntax of library names
3122 Project.Library_Name := Lib_Name.Value;
3125 if Project.Library_Name /= No_Name then
3126 if Current_Verbosity = High then
3128 ("Library name: ", Get_Name_String (Project.Library_Name));
3131 pragma Assert (Lib_Dir.Kind = Single);
3133 if not Library_Directory_Present then
3134 Debug_Output ("no library directory");
3137 -- Find path name (unless inherited), check that it is a directory
3139 if Project.Library_Dir = No_Path_Information then
3142 File_Name_Type (Lib_Dir.Value),
3143 Path => Project.Library_Dir,
3144 Dir_Exists => Dir_Exists,
3146 Create => "library",
3147 Must_Exist => False,
3148 Location => Lib_Dir.Location,
3149 Externally_Built => Project.Externally_Built);
3154 (Get_Name_String (Project.Library_Dir.Display_Name));
3157 if not Dir_Exists then
3159 -- Get the absolute name of the library directory that
3160 -- does not exist, to report an error.
3162 Err_Vars.Error_Msg_File_1 :=
3163 File_Name_Type (Project.Library_Dir.Display_Name);
3166 "library directory { does not exist",
3167 Lib_Dir.Location, Project);
3169 -- Checks for object/source directories
3171 elsif not Project.Externally_Built
3173 -- An aggregate library does not have sources or objects, so
3174 -- these tests are not required in this case.
3176 and then Project.Qualifier /= Aggregate_Library
3178 -- Library directory cannot be the same as Object directory
3180 if Project.Library_Dir.Name = Project.Object_Directory.Name then
3183 "library directory cannot be the same " &
3184 "as object directory",
3185 Lib_Dir.Location, Project);
3186 Project.Library_Dir := No_Path_Information;
3190 OK : Boolean := True;
3191 Dirs_Id : String_List_Id;
3192 Dir_Elem : String_Element;
3196 -- The library directory cannot be the same as a source
3197 -- directory of the current project.
3199 Dirs_Id := Project.Source_Dirs;
3200 while Dirs_Id /= Nil_String loop
3201 Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
3202 Dirs_Id := Dir_Elem.Next;
3204 if Project.Library_Dir.Name =
3205 Path_Name_Type (Dir_Elem.Value)
3207 Err_Vars.Error_Msg_File_1 :=
3208 File_Name_Type (Dir_Elem.Value);
3211 "library directory cannot be the same " &
3212 "as source directory {",
3213 Lib_Dir.Location, Project);
3221 -- The library directory cannot be the same as a
3222 -- source directory of another project either.
3224 Pid := Data.Tree.Projects;
3226 exit Project_Loop when Pid = null;
3228 if Pid.Project /= Project then
3229 Dirs_Id := Pid.Project.Source_Dirs;
3231 Dir_Loop : while Dirs_Id /= Nil_String loop
3233 Shared.String_Elements.Table (Dirs_Id);
3234 Dirs_Id := Dir_Elem.Next;
3236 if Project.Library_Dir.Name =
3237 Path_Name_Type (Dir_Elem.Value)
3239 Err_Vars.Error_Msg_File_1 :=
3240 File_Name_Type (Dir_Elem.Value);
3241 Err_Vars.Error_Msg_Name_1 :=
3246 "library directory cannot be the same" &
3247 " as source directory { of project %%",
3248 Lib_Dir.Location, Project);
3256 end loop Project_Loop;
3260 Project.Library_Dir := No_Path_Information;
3262 elsif Current_Verbosity = High then
3264 -- Display the Library directory in high verbosity
3267 ("Library directory",
3268 Get_Name_String (Project.Library_Dir.Display_Name));
3278 Project.Library_Dir /= No_Path_Information
3279 and then Project.Library_Name /= No_Name;
3281 if Project.Extends = No_Project then
3282 case Project.Qualifier is
3284 if Project.Library then
3287 "a standard project cannot be a library project",
3288 Lib_Name.Location, Project);
3291 when Library | Aggregate_Library =>
3292 if not Project.Library then
3293 if Project.Library_Name = No_Name then
3296 "attribute Library_Name not declared",
3297 Project.Location, Project);
3299 if not Library_Directory_Present then
3302 "\attribute Library_Dir not declared",
3303 Project.Location, Project);
3306 elsif Project.Library_Dir = No_Path_Information then
3309 "attribute Library_Dir not declared",
3310 Project.Location, Project);
3319 if Project.Library then
3320 Support_For_Libraries := Project.Config.Lib_Support;
3322 if not Project.Externally_Built
3323 and then Support_For_Libraries = Prj.None
3327 "?libraries are not supported on this platform",
3328 Lib_Name.Location, Project);
3329 Project.Library := False;
3332 if Lib_ALI_Dir.Value = Empty_String then
3333 Debug_Output ("no library ALI directory specified");
3334 Project.Library_ALI_Dir := Project.Library_Dir;
3337 -- Find path name, check that it is a directory
3341 File_Name_Type (Lib_ALI_Dir.Value),
3342 Path => Project.Library_ALI_Dir,
3343 Create => "library ALI",
3344 Dir_Exists => Dir_Exists,
3346 Must_Exist => False,
3347 Location => Lib_ALI_Dir.Location,
3348 Externally_Built => Project.Externally_Built);
3350 if not Dir_Exists then
3352 -- Get the absolute name of the library ALI directory that
3353 -- does not exist, to report an error.
3355 Err_Vars.Error_Msg_File_1 :=
3356 File_Name_Type (Project.Library_ALI_Dir.Display_Name);
3359 "library 'A'L'I directory { does not exist",
3360 Lib_ALI_Dir.Location, Project);
3363 if not Project.Externally_Built
3364 and then Project.Library_ALI_Dir /= Project.Library_Dir
3366 -- The library ALI directory cannot be the same as the
3367 -- Object directory.
3369 if Project.Library_ALI_Dir = Project.Object_Directory then
3372 "library 'A'L'I directory cannot be the same " &
3373 "as object directory",
3374 Lib_ALI_Dir.Location, Project);
3375 Project.Library_ALI_Dir := No_Path_Information;
3379 OK : Boolean := True;
3380 Dirs_Id : String_List_Id;
3381 Dir_Elem : String_Element;
3385 -- The library ALI directory cannot be the same as
3386 -- a source directory of the current project.
3388 Dirs_Id := Project.Source_Dirs;
3389 while Dirs_Id /= Nil_String loop
3390 Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
3391 Dirs_Id := Dir_Elem.Next;
3393 if Project.Library_ALI_Dir.Name =
3394 Path_Name_Type (Dir_Elem.Value)
3396 Err_Vars.Error_Msg_File_1 :=
3397 File_Name_Type (Dir_Elem.Value);
3400 "library 'A'L'I directory cannot be " &
3401 "the same as source directory {",
3402 Lib_ALI_Dir.Location, Project);
3410 -- The library ALI directory cannot be the same as
3411 -- a source directory of another project either.
3413 Pid := Data.Tree.Projects;
3414 ALI_Project_Loop : loop
3415 exit ALI_Project_Loop when Pid = null;
3417 if Pid.Project /= Project then
3418 Dirs_Id := Pid.Project.Source_Dirs;
3421 while Dirs_Id /= Nil_String loop
3423 Shared.String_Elements.Table (Dirs_Id);
3424 Dirs_Id := Dir_Elem.Next;
3426 if Project.Library_ALI_Dir.Name =
3427 Path_Name_Type (Dir_Elem.Value)
3429 Err_Vars.Error_Msg_File_1 :=
3430 File_Name_Type (Dir_Elem.Value);
3431 Err_Vars.Error_Msg_Name_1 :=
3436 "library 'A'L'I directory cannot " &
3437 "be the same as source directory " &
3439 Lib_ALI_Dir.Location, Project);
3441 exit ALI_Project_Loop;
3443 end loop ALI_Dir_Loop;
3446 end loop ALI_Project_Loop;
3450 Project.Library_ALI_Dir := No_Path_Information;
3452 elsif Current_Verbosity = High then
3454 -- Display Library ALI directory in high verbosity
3459 (Project.Library_ALI_Dir.Display_Name));
3466 pragma Assert (Lib_Version.Kind = Single);
3468 if Lib_Version.Value = Empty_String then
3469 Debug_Output ("no library version specified");
3472 Project.Lib_Internal_Name := Lib_Version.Value;
3475 pragma Assert (The_Lib_Kind.Kind = Single);
3477 if The_Lib_Kind.Value = Empty_String then
3478 Debug_Output ("no library kind specified");
3481 Get_Name_String (The_Lib_Kind.Value);
3484 Kind_Name : constant String :=
3485 To_Lower (Name_Buffer (1 .. Name_Len));
3487 OK : Boolean := True;
3490 if Kind_Name = "static" then
3491 Project.Library_Kind := Static;
3493 elsif Kind_Name = "dynamic" then
3494 Project.Library_Kind := Dynamic;
3496 elsif Kind_Name = "relocatable" then
3497 Project.Library_Kind := Relocatable;
3502 "illegal value for Library_Kind",
3503 The_Lib_Kind.Location, Project);
3507 if Current_Verbosity = High and then OK then
3508 Write_Attr ("Library kind", Kind_Name);
3511 if Project.Library_Kind /= Static then
3512 if not Project.Externally_Built
3513 and then Support_For_Libraries = Prj.Static_Only
3517 "only static libraries are supported " &
3519 The_Lib_Kind.Location, Project);
3520 Project.Library := False;
3523 -- Check if (obsolescent) attribute Library_GCC or
3524 -- Linker'Driver is declared.
3526 if Lib_GCC.Value /= Empty_String then
3529 "?Library_'G'C'C is an obsolescent attribute, " &
3530 "use Linker''Driver instead",
3531 Lib_GCC.Location, Project);
3532 Project.Config.Shared_Lib_Driver :=
3533 File_Name_Type (Lib_GCC.Value);
3537 Linker : constant Package_Id :=
3540 Project.Decl.Packages,
3542 Driver : constant Variable_Value :=
3545 Attribute_Or_Array_Name =>
3547 In_Package => Linker,
3551 if Driver /= Nil_Variable_Value
3552 and then Driver.Value /= Empty_String
3554 Project.Config.Shared_Lib_Driver :=
3555 File_Name_Type (Driver.Value);
3565 and then Project.Qualifier /= Aggregate_Library
3567 Debug_Output ("this is a library project file");
3569 Check_Library (Project.Extends, Extends => True);
3571 Imported_Project_List := Project.Imported_Projects;
3572 while Imported_Project_List /= null loop
3574 (Imported_Project_List.Project,
3576 Imported_Project_List := Imported_Project_List.Next;
3582 -- Check if Linker'Switches or Linker'Default_Switches are declared.
3583 -- Warn if they are declared, as it is a common error to think that
3584 -- library are "linked" with Linker switches.
3586 if Project.Library then
3588 Linker_Package_Id : constant Package_Id :=
3591 Project.Decl.Packages, Shared);
3592 Linker_Package : Package_Element;
3593 Switches : Array_Element_Id := No_Array_Element;
3596 if Linker_Package_Id /= No_Package then
3597 Linker_Package := Shared.Packages.Table (Linker_Package_Id);
3601 (Name => Name_Switches,
3602 In_Arrays => Linker_Package.Decl.Arrays,
3605 if Switches = No_Array_Element then
3608 (Name => Name_Default_Switches,
3609 In_Arrays => Linker_Package.Decl.Arrays,
3613 if Switches /= No_Array_Element then
3616 "?Linker switches not taken into account in library " &
3618 No_Location, Project);
3624 if Project.Extends /= No_Project and then Project.Extends.Library then
3626 -- Remove the library name from Lib_Data_Table
3628 for J in 1 .. Lib_Data_Table.Last loop
3629 if Lib_Data_Table.Table (J).Proj = Project.Extends then
3630 Lib_Data_Table.Table (J) :=
3631 Lib_Data_Table.Table (Lib_Data_Table.Last);
3632 Lib_Data_Table.Set_Last (Lib_Data_Table.Last - 1);
3638 if Project.Library and then not Lib_Name.Default then
3640 -- Check if the same library name is used in an other library project
3642 for J in 1 .. Lib_Data_Table.Last loop
3643 if Lib_Data_Table.Table (J).Name = Project.Library_Name
3644 and then Lib_Data_Table.Table (J).Tree = Data.Tree
3646 Error_Msg_Name_1 := Lib_Data_Table.Table (J).Proj.Name;
3649 "Library name cannot be the same as in project %%",
3650 Lib_Name.Location, Project);
3651 Project.Library := False;
3657 if Project.Library and not Data.In_Aggregate_Lib then
3659 -- Record the library name
3661 Lib_Data_Table.Append
3662 ((Name => Project.Library_Name,
3664 Tree => Data.Tree));
3666 end Check_Library_Attributes;
3668 --------------------------
3669 -- Check_Package_Naming --
3670 --------------------------
3672 procedure Check_Package_Naming
3673 (Project : Project_Id;
3674 Data : in out Tree_Processing_Data)
3676 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
3677 Naming_Id : constant Package_Id :=
3679 (Name_Naming, Project.Decl.Packages, Shared);
3680 Naming : Package_Element;
3682 Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
3684 procedure Check_Naming;
3685 -- Check the validity of the Naming package (suffixes valid, ...)
3687 procedure Check_Common
3688 (Dot_Replacement : in out File_Name_Type;
3689 Casing : in out Casing_Type;
3690 Casing_Defined : out Boolean;
3691 Separate_Suffix : in out File_Name_Type;
3692 Sep_Suffix_Loc : out Source_Ptr);
3693 -- Check attributes common
3695 procedure Process_Exceptions_File_Based
3696 (Lang_Id : Language_Ptr;
3697 Kind : Source_Kind);
3698 procedure Process_Exceptions_Unit_Based
3699 (Lang_Id : Language_Ptr;
3700 Kind : Source_Kind);
3701 -- Process the naming exceptions for the two types of languages
3703 procedure Initialize_Naming_Data;
3704 -- Initialize internal naming data for the various languages
3710 procedure Check_Common
3711 (Dot_Replacement : in out File_Name_Type;
3712 Casing : in out Casing_Type;
3713 Casing_Defined : out Boolean;
3714 Separate_Suffix : in out File_Name_Type;
3715 Sep_Suffix_Loc : out Source_Ptr)
3717 Dot_Repl : constant Variable_Value :=
3719 (Name_Dot_Replacement,
3720 Naming.Decl.Attributes,
3722 Casing_String : constant Variable_Value :=
3725 Naming.Decl.Attributes,
3727 Sep_Suffix : constant Variable_Value :=
3729 (Name_Separate_Suffix,
3730 Naming.Decl.Attributes,
3732 Dot_Repl_Loc : Source_Ptr;
3735 Sep_Suffix_Loc := No_Location;
3737 if not Dot_Repl.Default then
3739 (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
3741 if Length_Of_Name (Dot_Repl.Value) = 0 then
3743 (Data.Flags, "Dot_Replacement cannot be empty",
3744 Dot_Repl.Location, Project);
3747 Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
3748 Dot_Repl_Loc := Dot_Repl.Location;
3751 Repl : constant String := Get_Name_String (Dot_Replacement);
3754 -- Dot_Replacement cannot
3756 -- - start or end with an alphanumeric
3757 -- - be a single '_'
3758 -- - start with an '_' followed by an alphanumeric
3759 -- - contain a '.' except if it is "."
3762 or else Is_Alphanumeric (Repl (Repl'First))
3763 or else Is_Alphanumeric (Repl (Repl'Last))
3764 or else (Repl (Repl'First) = '_'
3768 Is_Alphanumeric (Repl (Repl'First + 1))))
3769 or else (Repl'Length > 1
3771 Index (Source => Repl, Pattern => ".") /= 0)
3776 """ is illegal for Dot_Replacement.",
3777 Dot_Repl_Loc, Project);
3782 if Dot_Replacement /= No_File then
3784 ("Dot_Replacement", Get_Name_String (Dot_Replacement));
3787 Casing_Defined := False;
3789 if not Casing_String.Default then
3791 (Casing_String.Kind = Single, "Casing is not a string");
3794 Casing_Image : constant String :=
3795 Get_Name_String (Casing_String.Value);
3798 if Casing_Image'Length = 0 then
3801 "Casing cannot be an empty string",
3802 Casing_String.Location, Project);
3805 Casing := Value (Casing_Image);
3806 Casing_Defined := True;
3809 when Constraint_Error =>
3810 Name_Len := Casing_Image'Length;
3811 Name_Buffer (1 .. Name_Len) := Casing_Image;
3812 Err_Vars.Error_Msg_Name_1 := Name_Find;
3815 "%% is not a correct Casing",
3816 Casing_String.Location, Project);
3820 Write_Attr ("Casing", Image (Casing));
3822 if not Sep_Suffix.Default then
3823 if Length_Of_Name (Sep_Suffix.Value) = 0 then
3826 "Separate_Suffix cannot be empty",
3827 Sep_Suffix.Location, Project);
3830 Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
3831 Sep_Suffix_Loc := Sep_Suffix.Location;
3833 Check_Illegal_Suffix
3834 (Project, Separate_Suffix,
3835 Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location,
3840 if Separate_Suffix /= No_File then
3842 ("Separate_Suffix", Get_Name_String (Separate_Suffix));
3846 -----------------------------------
3847 -- Process_Exceptions_File_Based --
3848 -----------------------------------
3850 procedure Process_Exceptions_File_Based
3851 (Lang_Id : Language_Ptr;
3854 Lang : constant Name_Id := Lang_Id.Name;
3855 Exceptions : Array_Element_Id;
3856 Exception_List : Variable_Value;
3857 Element_Id : String_List_Id;
3858 Element : String_Element;
3859 File_Name : File_Name_Type;
3867 (Name_Implementation_Exceptions,
3868 In_Arrays => Naming.Decl.Arrays,
3874 (Name_Specification_Exceptions,
3875 In_Arrays => Naming.Decl.Arrays,
3882 In_Array => Exceptions,
3885 if Exception_List /= Nil_Variable_Value then
3886 Element_Id := Exception_List.Values;
3887 while Element_Id /= Nil_String loop
3888 Element := Shared.String_Elements.Table (Element_Id);
3889 File_Name := Canonical_Case_File_Name (Element.Value);
3892 Source_Files_Htable.Get
3893 (Data.Tree.Source_Files_HT, File_Name);
3894 while Source /= No_Source
3895 and then Source.Project /= Project
3897 Source := Source.Next_With_File_Name;
3900 if Source = No_Source then
3905 Source_Dir_Rank => 0,
3908 File_Name => File_Name,
3909 Display_File => File_Name_Type (Element.Value),
3910 Naming_Exception => Yes,
3911 Location => Element.Location);
3914 -- Check if the file name is already recorded for another
3915 -- language or another kind.
3917 if Source.Language /= Lang_Id then
3920 "the same file cannot be a source of two languages",
3921 Element.Location, Project);
3923 elsif Source.Kind /= Kind then
3926 "the same file cannot be a source and a template",
3927 Element.Location, Project);
3930 -- If the file is already recorded for the same
3931 -- language and the same kind, it means that the file
3932 -- name appears several times in the *_Exceptions
3933 -- attribute; so there is nothing to do.
3936 Element_Id := Element.Next;
3939 end Process_Exceptions_File_Based;
3941 -----------------------------------
3942 -- Process_Exceptions_Unit_Based --
3943 -----------------------------------
3945 procedure Process_Exceptions_Unit_Based
3946 (Lang_Id : Language_Ptr;
3949 Exceptions : Array_Element_Id;
3950 Element : Array_Element;
3953 File_Name : File_Name_Type;
3956 Naming_Exception : Naming_Exception_Type;
3964 In_Arrays => Naming.Decl.Arrays,
3967 if Exceptions = No_Array_Element then
3970 (Name_Implementation,
3971 In_Arrays => Naming.Decl.Arrays,
3979 In_Arrays => Naming.Decl.Arrays,
3982 if Exceptions = No_Array_Element then
3985 (Name_Specification,
3986 In_Arrays => Naming.Decl.Arrays,
3991 while Exceptions /= No_Array_Element loop
3992 Element := Shared.Array_Elements.Table (Exceptions);
3994 if Element.Restricted then
3995 Naming_Exception := Inherited;
3997 Naming_Exception := Yes;
4000 File_Name := Canonical_Case_File_Name (Element.Value.Value);
4002 Get_Name_String (Element.Index);
4003 To_Lower (Name_Buffer (1 .. Name_Len));
4004 Index := Element.Value.Index;
4006 -- Check if it is a valid unit name
4008 Get_Name_String (Element.Index);
4009 Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit);
4011 if Unit = No_Name then
4012 Err_Vars.Error_Msg_Name_1 := Element.Index;
4015 "%% is not a valid unit name.",
4016 Element.Value.Location, Project);
4019 if Unit /= No_Name then
4024 Source_Dir_Rank => 0,
4027 File_Name => File_Name,
4028 Display_File => File_Name_Type (Element.Value.Value),
4031 Location => Element.Value.Location,
4032 Naming_Exception => Naming_Exception);
4035 Exceptions := Element.Next;
4037 end Process_Exceptions_Unit_Based;
4043 procedure Check_Naming is
4044 Dot_Replacement : File_Name_Type :=
4046 (First_Name_Id + Character'Pos ('-'));
4047 Separate_Suffix : File_Name_Type := No_File;
4048 Casing : Casing_Type := All_Lower_Case;
4049 Casing_Defined : Boolean;
4050 Lang_Id : Language_Ptr;
4051 Sep_Suffix_Loc : Source_Ptr;
4052 Suffix : Variable_Value;
4057 (Dot_Replacement => Dot_Replacement,
4059 Casing_Defined => Casing_Defined,
4060 Separate_Suffix => Separate_Suffix,
4061 Sep_Suffix_Loc => Sep_Suffix_Loc);
4063 -- For all unit based languages, if any, set the specified value
4064 -- of Dot_Replacement, Casing and/or Separate_Suffix. Do not
4065 -- systematically overwrite, since the defaults come from the
4066 -- configuration file.
4068 if Dot_Replacement /= No_File
4069 or else Casing_Defined
4070 or else Separate_Suffix /= No_File
4072 Lang_Id := Project.Languages;
4073 while Lang_Id /= No_Language_Index loop
4074 if Lang_Id.Config.Kind = Unit_Based then
4075 if Dot_Replacement /= No_File then
4076 Lang_Id.Config.Naming_Data.Dot_Replacement :=
4080 if Casing_Defined then
4081 Lang_Id.Config.Naming_Data.Casing := Casing;
4085 Lang_Id := Lang_Id.Next;
4089 -- Next, get the spec and body suffixes
4091 Lang_Id := Project.Languages;
4092 while Lang_Id /= No_Language_Index loop
4093 Lang := Lang_Id.Name;
4099 Attribute_Or_Array_Name => Name_Spec_Suffix,
4100 In_Package => Naming_Id,
4103 if Suffix = Nil_Variable_Value then
4106 Attribute_Or_Array_Name => Name_Specification_Suffix,
4107 In_Package => Naming_Id,
4111 if Suffix /= Nil_Variable_Value then
4112 Lang_Id.Config.Naming_Data.Spec_Suffix :=
4113 File_Name_Type (Suffix.Value);
4115 Check_Illegal_Suffix
4117 Lang_Id.Config.Naming_Data.Spec_Suffix,
4118 Lang_Id.Config.Naming_Data.Dot_Replacement,
4119 "Spec_Suffix", Suffix.Location, Data);
4123 Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix));
4131 Attribute_Or_Array_Name => Name_Body_Suffix,
4132 In_Package => Naming_Id,
4135 if Suffix = Nil_Variable_Value then
4139 Attribute_Or_Array_Name => Name_Implementation_Suffix,
4140 In_Package => Naming_Id,
4144 if Suffix /= Nil_Variable_Value then
4145 Lang_Id.Config.Naming_Data.Body_Suffix :=
4146 File_Name_Type (Suffix.Value);
4148 -- The default value of separate suffix should be the same as
4149 -- the body suffix, so we need to compute that first.
4151 if Separate_Suffix = No_File then
4152 Lang_Id.Config.Naming_Data.Separate_Suffix :=
4153 Lang_Id.Config.Naming_Data.Body_Suffix;
4157 (Lang_Id.Config.Naming_Data.Separate_Suffix));
4159 Lang_Id.Config.Naming_Data.Separate_Suffix :=
4163 Check_Illegal_Suffix
4165 Lang_Id.Config.Naming_Data.Body_Suffix,
4166 Lang_Id.Config.Naming_Data.Dot_Replacement,
4167 "Body_Suffix", Suffix.Location, Data);
4171 Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix));
4173 elsif Separate_Suffix /= No_File then
4174 Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix;
4177 -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
4178 -- since that would cause a clear ambiguity. Note that we do allow
4179 -- a Spec_Suffix to have the same termination as one of these,
4180 -- which causes a potential ambiguity, but we resolve that by
4181 -- matching the longest possible suffix.
4183 if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
4184 and then Lang_Id.Config.Naming_Data.Spec_Suffix =
4185 Lang_Id.Config.Naming_Data.Body_Suffix
4190 & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)
4191 & """) cannot be the same as Spec_Suffix.",
4192 Ada_Body_Suffix_Loc, Project);
4195 if Lang_Id.Config.Naming_Data.Body_Suffix /=
4196 Lang_Id.Config.Naming_Data.Separate_Suffix
4197 and then Lang_Id.Config.Naming_Data.Spec_Suffix =
4198 Lang_Id.Config.Naming_Data.Separate_Suffix
4202 "Separate_Suffix ("""
4204 (Lang_Id.Config.Naming_Data.Separate_Suffix)
4205 & """) cannot be the same as Spec_Suffix.",
4206 Sep_Suffix_Loc, Project);
4209 Lang_Id := Lang_Id.Next;
4212 -- Get the naming exceptions for all languages, but not for virtual
4215 if not Project.Virtual then
4216 for Kind in Spec_Or_Body loop
4217 Lang_Id := Project.Languages;
4218 while Lang_Id /= No_Language_Index loop
4219 case Lang_Id.Config.Kind is
4221 Process_Exceptions_File_Based (Lang_Id, Kind);
4224 Process_Exceptions_Unit_Based (Lang_Id, Kind);
4227 Lang_Id := Lang_Id.Next;
4233 ----------------------------
4234 -- Initialize_Naming_Data --
4235 ----------------------------
4237 procedure Initialize_Naming_Data is
4238 Specs : Array_Element_Id :=
4244 Impls : Array_Element_Id :=
4250 Lang : Language_Ptr;
4251 Lang_Name : Name_Id;
4252 Value : Variable_Value;
4253 Extended : Project_Id;
4256 -- At this stage, the project already contains the default extensions
4257 -- for the various languages. We now merge those suffixes read in the
4258 -- user project, and they override the default.
4260 while Specs /= No_Array_Element loop
4261 Lang_Name := Shared.Array_Elements.Table (Specs).Index;
4263 Get_Language_From_Name
4264 (Project, Name => Get_Name_String (Lang_Name));
4266 -- An extending project inherits its parent projects' languages
4267 -- so if needed we should create entries for those languages
4270 Extended := Project.Extends;
4271 while Extended /= null loop
4272 Lang := Get_Language_From_Name
4273 (Extended, Name => Get_Name_String (Lang_Name));
4274 exit when Lang /= null;
4276 Extended := Extended.Extends;
4279 if Lang /= null then
4280 Lang := new Language_Data'(Lang.all);
4281 Lang.First_Source := null;
4282 Lang.Next := Project.Languages;
4283 Project.Languages := Lang;
4287 -- If language was not found in project or the projects it extends
4291 ("ignoring spec naming data (lang. not in project): ",
4295 Value := Shared.Array_Elements.Table (Specs).Value;
4297 if Value.Kind = Single then
4298 Lang.Config.Naming_Data.Spec_Suffix :=
4299 Canonical_Case_File_Name (Value.Value);
4303 Specs := Shared.Array_Elements.Table (Specs).Next;
4306 while Impls /= No_Array_Element loop
4307 Lang_Name := Shared.Array_Elements.Table (Impls).Index;
4309 Get_Language_From_Name
4310 (Project, Name => Get_Name_String (Lang_Name));
4314 ("ignoring impl naming data (lang. not in project): ",
4317 Value := Shared.Array_Elements.Table (Impls).Value;
4319 if Lang.Name = Name_Ada then
4320 Ada_Body_Suffix_Loc := Value.Location;
4323 if Value.Kind = Single then
4324 Lang.Config.Naming_Data.Body_Suffix :=
4325 Canonical_Case_File_Name (Value.Value);
4329 Impls := Shared.Array_Elements.Table (Impls).Next;
4331 end Initialize_Naming_Data;
4333 -- Start of processing for Check_Naming_Schemes
4336 -- No Naming package or parsing a configuration file? nothing to do
4338 if Naming_Id /= No_Package
4339 and then Project.Qualifier /= Configuration
4341 Naming := Shared.Packages.Table (Naming_Id);
4342 Debug_Increase_Indent ("checking package Naming for ", Project.Name);
4343 Initialize_Naming_Data;
4345 Debug_Decrease_Indent ("done checking package naming");
4347 end Check_Package_Naming;
4349 ---------------------------------
4350 -- Check_Programming_Languages --
4351 ---------------------------------
4353 procedure Check_Programming_Languages
4354 (Project : Project_Id;
4355 Data : in out Tree_Processing_Data)
4357 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
4359 Languages : Variable_Value := Nil_Variable_Value;
4360 Def_Lang : Variable_Value := Nil_Variable_Value;
4361 Def_Lang_Id : Name_Id;
4363 procedure Add_Language (Name, Display_Name : Name_Id);
4364 -- Add a new language to the list of languages for the project.
4365 -- Nothing is done if the language has already been defined
4371 procedure Add_Language (Name, Display_Name : Name_Id) is
4372 Lang : Language_Ptr;
4375 Lang := Project.Languages;
4376 while Lang /= No_Language_Index loop
4377 if Name = Lang.Name then
4384 Lang := new Language_Data'(No_Language_Data);
4385 Lang.Next := Project.Languages;
4386 Project.Languages := Lang;
4388 Lang.Display_Name := Display_Name;
4391 -- Start of processing for Check_Programming_Languages
4394 Project.Languages := null;
4396 Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
4399 (Name_Default_Language, Project.Decl.Attributes, Shared);
4401 if Project.Source_Dirs /= Nil_String then
4403 -- Check if languages are specified in this project
4405 if Languages.Default then
4407 -- Fail if there is no default language defined
4409 if Def_Lang.Default then
4412 "no languages defined for this project",
4413 Project.Location, Project);
4414 Def_Lang_Id := No_Name;
4417 Get_Name_String (Def_Lang.Value);
4418 To_Lower (Name_Buffer (1 .. Name_Len));
4419 Def_Lang_Id := Name_Find;
4422 if Def_Lang_Id /= No_Name then
4423 Get_Name_String (Def_Lang_Id);
4424 Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
4426 (Name => Def_Lang_Id,
4427 Display_Name => Name_Find);
4432 Current : String_List_Id := Languages.Values;
4433 Element : String_Element;
4436 -- If there are no languages declared, there are no sources
4438 if Current = Nil_String then
4439 Project.Source_Dirs := Nil_String;
4441 if Project.Qualifier = Standard then
4444 "a standard project must have at least one language",
4445 Languages.Location, Project);
4449 -- Look through all the languages specified in attribute
4452 while Current /= Nil_String loop
4453 Element := Shared.String_Elements.Table (Current);
4454 Get_Name_String (Element.Value);
4455 To_Lower (Name_Buffer (1 .. Name_Len));
4459 Display_Name => Element.Value);
4461 Current := Element.Next;
4467 end Check_Programming_Languages;
4469 -------------------------------
4470 -- Check_Stand_Alone_Library --
4471 -------------------------------
4473 procedure Check_Stand_Alone_Library
4474 (Project : Project_Id;
4475 Data : in out Tree_Processing_Data)
4477 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
4479 Lib_Name : constant Prj.Variable_Value :=
4481 (Snames.Name_Library_Name,
4482 Project.Decl.Attributes,
4485 Lib_Standalone : constant Prj.Variable_Value :=
4487 (Snames.Name_Library_Standalone,
4488 Project.Decl.Attributes,
4491 Lib_Auto_Init : constant Prj.Variable_Value :=
4493 (Snames.Name_Library_Auto_Init,
4494 Project.Decl.Attributes,
4497 Lib_Src_Dir : constant Prj.Variable_Value :=
4499 (Snames.Name_Library_Src_Dir,
4500 Project.Decl.Attributes,
4503 Lib_Symbol_File : constant Prj.Variable_Value :=
4505 (Snames.Name_Library_Symbol_File,
4506 Project.Decl.Attributes,
4509 Lib_Symbol_Policy : constant Prj.Variable_Value :=
4511 (Snames.Name_Library_Symbol_Policy,
4512 Project.Decl.Attributes,
4515 Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
4517 (Snames.Name_Library_Reference_Symbol_File,
4518 Project.Decl.Attributes,
4521 Auto_Init_Supported : Boolean;
4522 OK : Boolean := True;
4525 Auto_Init_Supported := Project.Config.Auto_Init_Supported;
4527 -- It is a stand-alone library project file if there is at least one
4528 -- unit in the declared or inherited interface.
4530 if Project.Lib_Interface_ALIs = Nil_String then
4531 if not Lib_Standalone.Default
4532 and then Get_Name_String (Lib_Standalone.Value) /= "no"
4536 "Library_Standalone valid only if Library_Interface is set",
4537 Lib_Standalone.Location, Project);
4541 if Project.Standalone_Library = No then
4542 Project.Standalone_Library := Standard;
4545 -- The name of a stand-alone library needs to have the syntax of an
4549 Name : constant String := Get_Name_String (Project.Library_Name);
4550 OK : Boolean := Is_Letter (Name (Name'First));
4552 Underline : Boolean := False;
4555 for J in Name'First + 1 .. Name'Last loop
4558 if Is_Alphanumeric (Name (J)) then
4561 elsif Name (J) = '_' then
4573 OK := OK and not Underline;
4578 "Incorrect library name for a Stand-Alone Library",
4579 Lib_Name.Location, Project);
4584 if Lib_Standalone.Default then
4585 Project.Standalone_Library := Standard;
4588 Get_Name_String (Lib_Standalone.Value);
4589 To_Lower (Name_Buffer (1 .. Name_Len));
4591 if Name_Buffer (1 .. Name_Len) = "standard" then
4592 Project.Standalone_Library := Standard;
4594 elsif Name_Buffer (1 .. Name_Len) = "encapsulated" then
4595 Project.Standalone_Library := Encapsulated;
4597 elsif Name_Buffer (1 .. Name_Len) = "no" then
4598 Project.Standalone_Library := No;
4601 "wrong value for Library_Standalone "
4602 & "when Library_Interface defined",
4603 Lib_Standalone.Location, Project);
4608 "invalid value for attribute Library_Standalone",
4609 Lib_Standalone.Location, Project);
4613 -- Check value of attribute Library_Auto_Init and set Lib_Auto_Init
4616 if Lib_Auto_Init.Default then
4618 -- If no attribute Library_Auto_Init is declared, then set auto
4619 -- init only if it is supported.
4621 Project.Lib_Auto_Init := Auto_Init_Supported;
4624 Get_Name_String (Lib_Auto_Init.Value);
4625 To_Lower (Name_Buffer (1 .. Name_Len));
4627 if Name_Buffer (1 .. Name_Len) = "false" then
4628 Project.Lib_Auto_Init := False;
4630 elsif Name_Buffer (1 .. Name_Len) = "true" then
4631 if Auto_Init_Supported then
4632 Project.Lib_Auto_Init := True;
4635 -- Library_Auto_Init cannot be "true" if auto init is not
4640 "library auto init not supported " &
4642 Lib_Auto_Init.Location, Project);
4648 "invalid value for attribute Library_Auto_Init",
4649 Lib_Auto_Init.Location, Project);
4653 -- If attribute Library_Src_Dir is defined and not the empty string,
4654 -- check if the directory exist and is not the object directory or
4655 -- one of the source directories. This is the directory where copies
4656 -- of the interface sources will be copied. Note that this directory
4657 -- may be the library directory.
4659 if Lib_Src_Dir.Value /= Empty_String then
4661 Dir_Id : constant File_Name_Type :=
4662 File_Name_Type (Lib_Src_Dir.Value);
4663 Dir_Exists : Boolean;
4669 Path => Project.Library_Src_Dir,
4670 Dir_Exists => Dir_Exists,
4672 Must_Exist => False,
4673 Create => "library source copy",
4674 Location => Lib_Src_Dir.Location,
4675 Externally_Built => Project.Externally_Built);
4677 -- If directory does not exist, report an error
4679 if not Dir_Exists then
4681 -- Get the absolute name of the library directory that does
4682 -- not exist, to report an error.
4684 Err_Vars.Error_Msg_File_1 :=
4685 File_Name_Type (Project.Library_Src_Dir.Display_Name);
4688 "Directory { does not exist",
4689 Lib_Src_Dir.Location, Project);
4691 -- Report error if it is the same as the object directory
4693 elsif Project.Library_Src_Dir = Project.Object_Directory then
4696 "directory to copy interfaces cannot be " &
4697 "the object directory",
4698 Lib_Src_Dir.Location, Project);
4699 Project.Library_Src_Dir := No_Path_Information;
4703 Src_Dirs : String_List_Id;
4704 Src_Dir : String_Element;
4708 -- Interface copy directory cannot be one of the source
4709 -- directory of the current project.
4711 Src_Dirs := Project.Source_Dirs;
4712 while Src_Dirs /= Nil_String loop
4713 Src_Dir := Shared.String_Elements.Table (Src_Dirs);
4715 -- Report error if it is one of the source directories
4717 if Project.Library_Src_Dir.Name =
4718 Path_Name_Type (Src_Dir.Value)
4722 "directory to copy interfaces cannot " &
4723 "be one of the source directories",
4724 Lib_Src_Dir.Location, Project);
4725 Project.Library_Src_Dir := No_Path_Information;
4729 Src_Dirs := Src_Dir.Next;
4732 if Project.Library_Src_Dir /= No_Path_Information then
4734 -- It cannot be a source directory of any other
4737 Pid := Data.Tree.Projects;
4739 exit Project_Loop when Pid = null;
4741 Src_Dirs := Pid.Project.Source_Dirs;
4742 Dir_Loop : while Src_Dirs /= Nil_String loop
4744 Shared.String_Elements.Table (Src_Dirs);
4746 -- Report error if it is one of the source
4749 if Project.Library_Src_Dir.Name =
4750 Path_Name_Type (Src_Dir.Value)
4753 File_Name_Type (Src_Dir.Value);
4754 Error_Msg_Name_1 := Pid.Project.Name;
4757 "directory to copy interfaces cannot " &
4758 "be the same as source directory { of " &
4760 Lib_Src_Dir.Location, Project);
4761 Project.Library_Src_Dir :=
4762 No_Path_Information;
4766 Src_Dirs := Src_Dir.Next;
4770 end loop Project_Loop;
4774 -- In high verbosity, if there is a valid Library_Src_Dir,
4775 -- display its path name.
4777 if Project.Library_Src_Dir /= No_Path_Information
4778 and then Current_Verbosity = High
4781 ("Directory to copy interfaces",
4782 Get_Name_String (Project.Library_Src_Dir.Name));
4788 -- Check the symbol related attributes
4790 -- First, the symbol policy
4792 if not Lib_Symbol_Policy.Default then
4794 Value : constant String :=
4796 (Get_Name_String (Lib_Symbol_Policy.Value));
4799 -- Symbol policy must have one of a limited number of values
4801 if Value = "autonomous" or else Value = "default" then
4802 Project.Symbol_Data.Symbol_Policy := Autonomous;
4804 elsif Value = "compliant" then
4805 Project.Symbol_Data.Symbol_Policy := Compliant;
4807 elsif Value = "controlled" then
4808 Project.Symbol_Data.Symbol_Policy := Controlled;
4810 elsif Value = "restricted" then
4811 Project.Symbol_Data.Symbol_Policy := Restricted;
4813 elsif Value = "direct" then
4814 Project.Symbol_Data.Symbol_Policy := Direct;
4819 "illegal value for Library_Symbol_Policy",
4820 Lib_Symbol_Policy.Location, Project);
4825 -- If attribute Library_Symbol_File is not specified, symbol policy
4826 -- cannot be Restricted.
4828 if Lib_Symbol_File.Default then
4829 if Project.Symbol_Data.Symbol_Policy = Restricted then
4832 "Library_Symbol_File needs to be defined when " &
4833 "symbol policy is Restricted",
4834 Lib_Symbol_Policy.Location, Project);
4838 -- Library_Symbol_File is defined
4840 Project.Symbol_Data.Symbol_File :=
4841 Path_Name_Type (Lib_Symbol_File.Value);
4843 Get_Name_String (Lib_Symbol_File.Value);
4845 if Name_Len = 0 then
4848 "symbol file name cannot be an empty string",
4849 Lib_Symbol_File.Location, Project);
4852 OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
4855 for J in 1 .. Name_Len loop
4856 if Name_Buffer (J) = '/'
4857 or else Name_Buffer (J) = Directory_Separator
4866 Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
4869 "symbol file name { is illegal. " &
4870 "Name cannot include directory info.",
4871 Lib_Symbol_File.Location, Project);
4876 -- If attribute Library_Reference_Symbol_File is not defined,
4877 -- symbol policy cannot be Compliant or Controlled.
4879 if Lib_Ref_Symbol_File.Default then
4880 if Project.Symbol_Data.Symbol_Policy = Compliant
4881 or else Project.Symbol_Data.Symbol_Policy = Controlled
4885 "a reference symbol file needs to be defined",
4886 Lib_Symbol_Policy.Location, Project);
4890 -- Library_Reference_Symbol_File is defined, check file exists
4892 Project.Symbol_Data.Reference :=
4893 Path_Name_Type (Lib_Ref_Symbol_File.Value);
4895 Get_Name_String (Lib_Ref_Symbol_File.Value);
4897 if Name_Len = 0 then
4900 "reference symbol file name cannot be an empty string",
4901 Lib_Symbol_File.Location, Project);
4904 if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
4906 Add_Str_To_Name_Buffer
4907 (Get_Name_String (Project.Directory.Name));
4908 Add_Str_To_Name_Buffer
4909 (Get_Name_String (Lib_Ref_Symbol_File.Value));
4910 Project.Symbol_Data.Reference := Name_Find;
4913 if not Is_Regular_File
4914 (Get_Name_String (Project.Symbol_Data.Reference))
4917 File_Name_Type (Lib_Ref_Symbol_File.Value);
4919 -- For controlled and direct symbol policies, it is an error
4920 -- if the reference symbol file does not exist. For other
4921 -- symbol policies, this is just a warning
4924 Project.Symbol_Data.Symbol_Policy /= Controlled
4925 and then Project.Symbol_Data.Symbol_Policy /= Direct;
4929 "<library reference symbol file { does not exist",
4930 Lib_Ref_Symbol_File.Location, Project);
4932 -- In addition in the non-controlled case, if symbol policy
4933 -- is Compliant, it is changed to Autonomous, because there
4934 -- is no reference to check against, and we don't want to
4935 -- fail in this case.
4937 if Project.Symbol_Data.Symbol_Policy /= Controlled then
4938 if Project.Symbol_Data.Symbol_Policy = Compliant then
4939 Project.Symbol_Data.Symbol_Policy := Autonomous;
4944 -- If both the reference symbol file and the symbol file are
4945 -- defined, then check that they are not the same file.
4947 if Project.Symbol_Data.Symbol_File /= No_Path then
4948 Get_Name_String (Project.Symbol_Data.Symbol_File);
4950 if Name_Len > 0 then
4952 -- We do not need to pass a Directory to
4953 -- Normalize_Pathname, since the path_information
4954 -- already contains absolute information.
4956 Symb_Path : constant String :=
4959 (Project.Object_Directory.Name) &
4960 Name_Buffer (1 .. Name_Len),
4963 Opt.Follow_Links_For_Files);
4964 Ref_Path : constant String :=
4967 (Project.Symbol_Data.Reference),
4970 Opt.Follow_Links_For_Files);
4972 if Symb_Path = Ref_Path then
4975 "library reference symbol file and library" &
4976 " symbol file cannot be the same file",
4977 Lib_Ref_Symbol_File.Location, Project);
4985 end Check_Stand_Alone_Library;
4987 ---------------------
4988 -- Check_Unit_Name --
4989 ---------------------
4991 procedure Check_Unit_Name (Name : String; Unit : out Name_Id) is
4992 The_Name : String := Name;
4993 Real_Name : Name_Id;
4994 Need_Letter : Boolean := True;
4995 Last_Underscore : Boolean := False;
4996 OK : Boolean := The_Name'Length > 0;
4999 function Is_Reserved (Name : Name_Id) return Boolean;
5000 function Is_Reserved (S : String) return Boolean;
5001 -- Check that the given name is not an Ada 95 reserved word. The reason
5002 -- for the Ada 95 here is that we do not want to exclude the case of an
5003 -- Ada 95 unit called Interface (for example). In Ada 2005, such a unit
5004 -- name would be rejected anyway by the compiler. That means there is no
5005 -- requirement that the project file parser reject this.
5011 function Is_Reserved (S : String) return Boolean is
5014 Add_Str_To_Name_Buffer (S);
5015 return Is_Reserved (Name_Find);
5022 function Is_Reserved (Name : Name_Id) return Boolean is
5024 if Get_Name_Table_Byte (Name) /= 0
5025 and then Name /= Name_Project
5026 and then Name /= Name_Extends
5027 and then Name /= Name_External
5028 and then Name not in Ada_2005_Reserved_Words
5031 Debug_Output ("Ada reserved word: ", Name);
5039 -- Start of processing for Check_Unit_Name
5042 To_Lower (The_Name);
5044 Name_Len := The_Name'Length;
5045 Name_Buffer (1 .. Name_Len) := The_Name;
5047 -- Special cases of children of packages A, G, I and S on VMS
5049 if OpenVMS_On_Target
5050 and then Name_Len > 3
5051 and then Name_Buffer (2 .. 3) = "__"
5053 (Name_Buffer (1) = 'a' or else
5054 Name_Buffer (1) = 'g' or else
5055 Name_Buffer (1) = 'i' or else
5056 Name_Buffer (1) = 's')
5058 Name_Buffer (2) := '.';
5059 Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
5060 Name_Len := Name_Len - 1;
5063 Real_Name := Name_Find;
5065 if Is_Reserved (Real_Name) then
5069 First := The_Name'First;
5071 for Index in The_Name'Range loop
5074 -- We need a letter (at the beginning, and following a dot),
5075 -- but we don't have one.
5077 if Is_Letter (The_Name (Index)) then
5078 Need_Letter := False;
5083 if Current_Verbosity = High then
5085 Write_Int (Types.Int (Index));
5087 Write_Char (The_Name (Index));
5088 Write_Line ("' is not a letter.");
5094 elsif Last_Underscore
5095 and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
5097 -- Two underscores are illegal, and a dot cannot follow
5102 if Current_Verbosity = High then
5104 Write_Int (Types.Int (Index));
5106 Write_Char (The_Name (Index));
5107 Write_Line ("' is illegal here.");
5112 elsif The_Name (Index) = '.' then
5114 -- First, check if the name before the dot is not a reserved word
5116 if Is_Reserved (The_Name (First .. Index - 1)) then
5122 -- We need a letter after a dot
5124 Need_Letter := True;
5126 elsif The_Name (Index) = '_' then
5127 Last_Underscore := True;
5130 -- We need an letter or a digit
5132 Last_Underscore := False;
5134 if not Is_Alphanumeric (The_Name (Index)) then
5137 if Current_Verbosity = High then
5139 Write_Int (Types.Int (Index));
5141 Write_Char (The_Name (Index));
5142 Write_Line ("' is not alphanumeric.");
5150 -- Cannot end with an underscore or a dot
5152 OK := OK and then not Need_Letter and then not Last_Underscore;
5155 if First /= Name'First
5156 and then Is_Reserved (The_Name (First .. The_Name'Last))
5164 -- Signal a problem with No_Name
5168 end Check_Unit_Name;
5170 ----------------------------
5171 -- Compute_Directory_Last --
5172 ----------------------------
5174 function Compute_Directory_Last (Dir : String) return Natural is
5177 and then (Dir (Dir'Last - 1) = Directory_Separator
5179 Dir (Dir'Last - 1) = '/')
5181 return Dir'Last - 1;
5185 end Compute_Directory_Last;
5187 ---------------------
5188 -- Get_Directories --
5189 ---------------------
5191 procedure Get_Directories
5192 (Project : Project_Id;
5193 Data : in out Tree_Processing_Data)
5195 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
5197 Object_Dir : constant Variable_Value :=
5199 (Name_Object_Dir, Project.Decl.Attributes, Shared);
5201 Exec_Dir : constant Variable_Value :=
5203 (Name_Exec_Dir, Project.Decl.Attributes, Shared);
5205 Source_Dirs : constant Variable_Value :=
5207 (Name_Source_Dirs, Project.Decl.Attributes, Shared);
5209 Ignore_Source_Sub_Dirs : constant Variable_Value :=
5211 (Name_Ignore_Source_Sub_Dirs,
5212 Project.Decl.Attributes,
5215 Excluded_Source_Dirs : constant Variable_Value :=
5217 (Name_Excluded_Source_Dirs,
5218 Project.Decl.Attributes,
5221 Source_Files : constant Variable_Value :=
5224 Project.Decl.Attributes, Shared);
5226 Last_Source_Dir : String_List_Id := Nil_String;
5227 Last_Src_Dir_Rank : Number_List_Index := No_Number_List;
5229 Languages : constant Variable_Value :=
5231 (Name_Languages, Project.Decl.Attributes, Shared);
5233 Remove_Source_Dirs : Boolean := False;
5235 procedure Add_To_Or_Remove_From_Source_Dirs
5236 (Path : Path_Information;
5238 -- When Removed = False, the directory Path_Id to the list of
5239 -- source_dirs if not already in the list. When Removed = True,
5240 -- removed directory Path_Id if in the list.
5242 procedure Find_Source_Dirs is new Expand_Subdirectory_Pattern
5243 (Add_To_Or_Remove_From_Source_Dirs);
5245 ---------------------------------------
5246 -- Add_To_Or_Remove_From_Source_Dirs --
5247 ---------------------------------------
5249 procedure Add_To_Or_Remove_From_Source_Dirs
5250 (Path : Path_Information;
5253 List : String_List_Id;
5254 Prev : String_List_Id;
5255 Rank_List : Number_List_Index;
5256 Prev_Rank : Number_List_Index;
5257 Element : String_Element;
5261 Prev_Rank := No_Number_List;
5262 List := Project.Source_Dirs;
5263 Rank_List := Project.Source_Dir_Ranks;
5264 while List /= Nil_String loop
5265 Element := Shared.String_Elements.Table (List);
5266 exit when Element.Value = Name_Id (Path.Name);
5268 List := Element.Next;
5269 Prev_Rank := Rank_List;
5270 Rank_List := Shared.Number_Lists.Table (Prev_Rank).Next;
5273 -- The directory is in the list if List is not Nil_String
5275 if not Remove_Source_Dirs and then List = Nil_String then
5276 Debug_Output ("adding source dir=", Name_Id (Path.Display_Name));
5278 String_Element_Table.Increment_Last (Shared.String_Elements);
5280 (Value => Name_Id (Path.Name),
5282 Display_Value => Name_Id (Path.Display_Name),
5283 Location => No_Location,
5285 Next => Nil_String);
5287 Number_List_Table.Increment_Last (Shared.Number_Lists);
5289 if Last_Source_Dir = Nil_String then
5291 -- This is the first source directory
5293 Project.Source_Dirs :=
5294 String_Element_Table.Last (Shared.String_Elements);
5295 Project.Source_Dir_Ranks :=
5296 Number_List_Table.Last (Shared.Number_Lists);
5299 -- We already have source directories, link the previous
5300 -- last to the new one.
5302 Shared.String_Elements.Table (Last_Source_Dir).Next :=
5303 String_Element_Table.Last (Shared.String_Elements);
5304 Shared.Number_Lists.Table (Last_Src_Dir_Rank).Next :=
5305 Number_List_Table.Last (Shared.Number_Lists);
5308 -- And register this source directory as the new last
5311 String_Element_Table.Last (Shared.String_Elements);
5312 Shared.String_Elements.Table (Last_Source_Dir) := Element;
5313 Last_Src_Dir_Rank := Number_List_Table.Last (Shared.Number_Lists);
5314 Shared.Number_Lists.Table (Last_Src_Dir_Rank) :=
5315 (Number => Rank, Next => No_Number_List);
5317 elsif Remove_Source_Dirs and then List /= Nil_String then
5319 -- Remove source dir if present
5321 if Prev = Nil_String then
5322 Project.Source_Dirs := Shared.String_Elements.Table (List).Next;
5323 Project.Source_Dir_Ranks :=
5324 Shared.Number_Lists.Table (Rank_List).Next;
5327 Shared.String_Elements.Table (Prev).Next :=
5328 Shared.String_Elements.Table (List).Next;
5329 Shared.Number_Lists.Table (Prev_Rank).Next :=
5330 Shared.Number_Lists.Table (Rank_List).Next;
5333 end Add_To_Or_Remove_From_Source_Dirs;
5335 -- Local declarations
5337 Dir_Exists : Boolean;
5339 No_Sources : constant Boolean :=
5340 ((not Source_Files.Default
5341 and then Source_Files.Values = Nil_String)
5343 (not Source_Dirs.Default
5344 and then Source_Dirs.Values = Nil_String)
5346 (not Languages.Default
5347 and then Languages.Values = Nil_String))
5348 and then Project.Extends = No_Project;
5350 -- Start of processing for Get_Directories
5353 Debug_Output ("starting to look for directories");
5355 -- Set the object directory to its default which may be nil, if there
5356 -- is no sources in the project.
5359 Project.Object_Directory := No_Path_Information;
5361 Project.Object_Directory := Project.Directory;
5364 -- Check the object directory
5366 if Object_Dir.Value /= Empty_String then
5367 Get_Name_String (Object_Dir.Value);
5369 if Name_Len = 0 then
5372 "Object_Dir cannot be empty",
5373 Object_Dir.Location, Project);
5375 elsif Setup_Projects
5377 and then Project.Extends = No_Project
5379 -- Do not create an object directory for a non extending project
5384 File_Name_Type (Object_Dir.Value),
5385 Path => Project.Object_Directory,
5386 Dir_Exists => Dir_Exists,
5388 Location => Object_Dir.Location,
5389 Must_Exist => False,
5390 Externally_Built => Project.Externally_Built);
5393 -- We check that the specified object directory does exist.
5394 -- However, even when it doesn't exist, we set it to a default
5395 -- value. This is for the benefit of tools that recover from
5396 -- errors; for example, these tools could create the non existent
5397 -- directory. We always return an absolute directory name though.
5401 File_Name_Type (Object_Dir.Value),
5402 Path => Project.Object_Directory,
5404 Dir_Exists => Dir_Exists,
5406 Location => Object_Dir.Location,
5407 Must_Exist => False,
5408 Externally_Built => Project.Externally_Built);
5410 if not Dir_Exists and then not Project.Externally_Built then
5412 -- The object directory does not exist, report an error if the
5413 -- project is not externally built.
5415 Err_Vars.Error_Msg_File_1 :=
5416 File_Name_Type (Object_Dir.Value);
5418 (Data.Flags, Data.Flags.Require_Obj_Dirs,
5419 "object directory { not found", Project.Location, Project);
5423 elsif not No_Sources and then Subdirs /= null then
5425 Name_Buffer (1) := '.';
5429 Path => Project.Object_Directory,
5431 Dir_Exists => Dir_Exists,
5433 Location => Object_Dir.Location,
5434 Externally_Built => Project.Externally_Built);
5437 if Current_Verbosity = High then
5438 if Project.Object_Directory = No_Path_Information then
5439 Debug_Output ("no object directory");
5442 ("Object directory",
5443 Get_Name_String (Project.Object_Directory.Display_Name));
5447 -- Check the exec directory
5449 -- We set the object directory to its default
5451 Project.Exec_Directory := Project.Object_Directory;
5453 if Exec_Dir.Value /= Empty_String then
5454 Get_Name_String (Exec_Dir.Value);
5456 if Name_Len = 0 then
5459 "Exec_Dir cannot be empty",
5460 Exec_Dir.Location, Project);
5462 elsif Setup_Projects
5464 and then Project.Extends = No_Project
5466 -- Do not create an exec directory for a non extending project
5471 File_Name_Type (Exec_Dir.Value),
5472 Path => Project.Exec_Directory,
5473 Dir_Exists => Dir_Exists,
5475 Location => Exec_Dir.Location,
5476 Externally_Built => Project.Externally_Built);
5479 -- We check that the specified exec directory does exist
5483 File_Name_Type (Exec_Dir.Value),
5484 Path => Project.Exec_Directory,
5485 Dir_Exists => Dir_Exists,
5488 Location => Exec_Dir.Location,
5489 Externally_Built => Project.Externally_Built);
5491 if not Dir_Exists then
5492 Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
5494 (Data.Flags, Data.Flags.Missing_Source_Files,
5495 "exec directory { not found", Project.Location, Project);
5500 if Current_Verbosity = High then
5501 if Project.Exec_Directory = No_Path_Information then
5502 Debug_Output ("no exec directory");
5505 ("exec directory: ",
5506 Name_Id (Project.Exec_Directory.Display_Name));
5510 -- Look for the source directories
5512 Debug_Output ("starting to look for source directories");
5514 pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
5516 if not Source_Files.Default
5517 and then Source_Files.Values = Nil_String
5519 Project.Source_Dirs := Nil_String;
5521 if Project.Qualifier = Standard then
5524 "a standard project cannot have no sources",
5525 Source_Files.Location, Project);
5528 elsif Source_Dirs.Default then
5530 -- No Source_Dirs specified: the single source directory is the one
5531 -- containing the project file.
5533 Remove_Source_Dirs := False;
5534 Add_To_Or_Remove_From_Source_Dirs
5535 (Path => (Name => Project.Directory.Name,
5536 Display_Name => Project.Directory.Display_Name),
5540 Remove_Source_Dirs := False;
5542 (Project => Project,
5544 Patterns => Source_Dirs.Values,
5545 Ignore => Ignore_Source_Sub_Dirs.Values,
5546 Search_For => Search_Directories,
5547 Resolve_Links => Opt.Follow_Links_For_Dirs);
5549 if Project.Source_Dirs = Nil_String
5550 and then Project.Qualifier = Standard
5554 "a standard project cannot have no source directories",
5555 Source_Dirs.Location, Project);
5559 if not Excluded_Source_Dirs.Default
5560 and then Excluded_Source_Dirs.Values /= Nil_String
5562 Remove_Source_Dirs := True;
5564 (Project => Project,
5566 Patterns => Excluded_Source_Dirs.Values,
5567 Ignore => Nil_String,
5568 Search_For => Search_Directories,
5569 Resolve_Links => Opt.Follow_Links_For_Dirs);
5572 Debug_Output ("putting source directories in canonical cases");
5575 Current : String_List_Id := Project.Source_Dirs;
5576 Element : String_Element;
5579 while Current /= Nil_String loop
5580 Element := Shared.String_Elements.Table (Current);
5581 if Element.Value /= No_Name then
5583 Name_Id (Canonical_Case_File_Name (Element.Value));
5584 Shared.String_Elements.Table (Current) := Element;
5587 Current := Element.Next;
5590 end Get_Directories;
5597 (Project : Project_Id;
5598 Data : in out Tree_Processing_Data)
5600 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
5602 Mains : constant Variable_Value :=
5604 (Name_Main, Project.Decl.Attributes, Shared);
5605 List : String_List_Id;
5606 Elem : String_Element;
5609 Project.Mains := Mains.Values;
5611 -- If no Mains were specified, and if we are an extending project,
5612 -- inherit the Mains from the project we are extending.
5614 if Mains.Default then
5615 if not Project.Library and then Project.Extends /= No_Project then
5616 Project.Mains := Project.Extends.Mains;
5619 -- In a library project file, Main cannot be specified
5621 elsif Project.Library then
5624 "a library project file cannot have Main specified",
5625 Mains.Location, Project);
5628 List := Mains.Values;
5629 while List /= Nil_String loop
5630 Elem := Shared.String_Elements.Table (List);
5632 if Length_Of_Name (Elem.Value) = 0 then
5635 "?a main cannot have an empty name",
5636 Elem.Location, Project);
5645 ---------------------------
5646 -- Get_Sources_From_File --
5647 ---------------------------
5649 procedure Get_Sources_From_File
5651 Location : Source_Ptr;
5652 Project : in out Project_Processing_Data;
5653 Data : in out Tree_Processing_Data)
5655 File : Prj.Util.Text_File;
5656 Line : String (1 .. 250);
5658 Source_Name : File_Name_Type;
5659 Name_Loc : Name_Location;
5662 if Current_Verbosity = High then
5663 Debug_Output ("opening """ & Path & '"');
5668 Prj.Util.Open (File, Path);
5670 if not Prj.Util.Is_Valid (File) then
5672 (Data.Flags, "file does not exist", Location, Project.Project);
5675 -- Read the lines one by one
5677 while not Prj.Util.End_Of_File (File) loop
5678 Prj.Util.Get_Line (File, Line, Last);
5680 -- A non empty, non comment line should contain a file name
5683 and then (Last = 1 or else Line (1 .. 2) /= "--")
5686 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
5687 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
5688 Source_Name := Name_Find;
5690 -- Check that there is no directory information
5692 for J in 1 .. Last loop
5693 if Line (J) = '/' or else Line (J) = Directory_Separator then
5694 Error_Msg_File_1 := Source_Name;
5697 "file name cannot include directory information ({)",
5698 Location, Project.Project);
5703 Name_Loc := Source_Names_Htable.Get
5704 (Project.Source_Names, Source_Name);
5706 if Name_Loc = No_Name_Location then
5708 (Name => Source_Name,
5709 Location => Location,
5710 Source => No_Source,
5715 Name_Loc.Listed := True;
5718 Source_Names_Htable.Set
5719 (Project.Source_Names, Source_Name, Name_Loc);
5723 Prj.Util.Close (File);
5726 end Get_Sources_From_File;
5732 function No_Space_Img (N : Natural) return String is
5733 Image : constant String := N'Img;
5735 return Image (2 .. Image'Last);
5738 -----------------------
5739 -- Compute_Unit_Name --
5740 -----------------------
5742 procedure Compute_Unit_Name
5743 (File_Name : File_Name_Type;
5744 Naming : Lang_Naming_Data;
5745 Kind : out Source_Kind;
5747 Project : Project_Processing_Data)
5749 Filename : constant String := Get_Name_String (File_Name);
5750 Last : Integer := Filename'Last;
5755 Unit_Except : Unit_Exception;
5756 Masked : Boolean := False;
5762 if Naming.Separate_Suffix = No_File
5763 or else Naming.Body_Suffix = No_File
5764 or else Naming.Spec_Suffix = No_File
5769 if Naming.Dot_Replacement = No_File then
5770 Debug_Output ("no dot_replacement specified");
5774 Sep_Len := Integer (Length_Of_Name (Naming.Separate_Suffix));
5775 Spec_Len := Integer (Length_Of_Name (Naming.Spec_Suffix));
5776 Body_Len := Integer (Length_Of_Name (Naming.Body_Suffix));
5778 -- Choose the longest suffix that matches. If there are several matches,
5779 -- give priority to specs, then bodies, then separates.
5781 if Naming.Separate_Suffix /= Naming.Body_Suffix
5782 and then Suffix_Matches (Filename, Naming.Separate_Suffix)
5784 Last := Filename'Last - Sep_Len;
5788 if Filename'Last - Body_Len <= Last
5789 and then Suffix_Matches (Filename, Naming.Body_Suffix)
5791 Last := Natural'Min (Last, Filename'Last - Body_Len);
5795 if Filename'Last - Spec_Len <= Last
5796 and then Suffix_Matches (Filename, Naming.Spec_Suffix)
5798 Last := Natural'Min (Last, Filename'Last - Spec_Len);
5802 if Last = Filename'Last then
5803 Debug_Output ("no matching suffix");
5807 -- Check that the casing matches
5809 if File_Names_Case_Sensitive then
5810 case Naming.Casing is
5811 when All_Lower_Case =>
5812 for J in Filename'First .. Last loop
5813 if Is_Letter (Filename (J))
5814 and then not Is_Lower (Filename (J))
5816 Debug_Output ("invalid casing");
5821 when All_Upper_Case =>
5822 for J in Filename'First .. Last loop
5823 if Is_Letter (Filename (J))
5824 and then not Is_Upper (Filename (J))
5826 Debug_Output ("invalid casing");
5831 when Mixed_Case | Unknown =>
5836 -- If Dot_Replacement is not a single dot, then there should not
5837 -- be any dot in the name.
5840 Dot_Repl : constant String :=
5841 Get_Name_String (Naming.Dot_Replacement);
5844 if Dot_Repl /= "." then
5845 for Index in Filename'First .. Last loop
5846 if Filename (Index) = '.' then
5847 Debug_Output ("invalid name, contains dot");
5852 Replace_Into_Name_Buffer
5853 (Filename (Filename'First .. Last), Dot_Repl, '.');
5856 Name_Len := Last - Filename'First + 1;
5857 Name_Buffer (1 .. Name_Len) := Filename (Filename'First .. Last);
5859 (Source => Name_Buffer (1 .. Name_Len),
5860 Mapping => Lower_Case_Map);
5864 -- In the standard GNAT naming scheme, check for special cases: children
5865 -- or separates of A, G, I or S, and run time sources.
5867 if Is_Standard_GNAT_Naming (Naming)
5868 and then Name_Len >= 3
5871 S1 : constant Character := Name_Buffer (1);
5872 S2 : constant Character := Name_Buffer (2);
5873 S3 : constant Character := Name_Buffer (3);
5881 -- Children or separates of packages A, G, I or S. These names
5882 -- are x__ ... or x~... (where x is a, g, i, or s). Both
5883 -- versions (x__... and x~...) are allowed in all platforms,
5884 -- because it is not possible to know the platform before
5885 -- processing of the project files.
5887 if S2 = '_' and then S3 = '_' then
5888 Name_Buffer (2) := '.';
5889 Name_Buffer (3 .. Name_Len - 1) :=
5890 Name_Buffer (4 .. Name_Len);
5891 Name_Len := Name_Len - 1;
5894 Name_Buffer (2) := '.';
5898 -- If it is potentially a run time source
5906 -- Name_Buffer contains the name of the unit in lower-cases. Check
5907 -- that this is a valid unit name
5909 Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit);
5911 -- If there is a naming exception for the same unit, the file is not
5912 -- a source for the unit.
5914 if Unit /= No_Name then
5916 Unit_Exceptions_Htable.Get (Project.Unit_Exceptions, Unit);
5919 Masked := Unit_Except.Spec /= No_File
5921 Unit_Except.Spec /= File_Name;
5923 Masked := Unit_Except.Impl /= No_File
5925 Unit_Except.Impl /= File_Name;
5929 if Current_Verbosity = High then
5931 Write_Str (" """ & Filename & """ contains the ");
5934 Write_Str ("spec of a unit found in """);
5935 Write_Str (Get_Name_String (Unit_Except.Spec));
5937 Write_Str ("body of a unit found in """);
5938 Write_Str (Get_Name_String (Unit_Except.Impl));
5941 Write_Line (""" (ignored)");
5949 and then Current_Verbosity = High
5952 when Spec => Debug_Output ("spec of", Unit);
5953 when Impl => Debug_Output ("body of", Unit);
5954 when Sep => Debug_Output ("sep of", Unit);
5957 end Compute_Unit_Name;
5959 --------------------------
5960 -- Check_Illegal_Suffix --
5961 --------------------------
5963 procedure Check_Illegal_Suffix
5964 (Project : Project_Id;
5965 Suffix : File_Name_Type;
5966 Dot_Replacement : File_Name_Type;
5967 Attribute_Name : String;
5968 Location : Source_Ptr;
5969 Data : in out Tree_Processing_Data)
5971 Suffix_Str : constant String := Get_Name_String (Suffix);
5974 if Suffix_Str'Length = 0 then
5980 elsif Index (Suffix_Str, ".") = 0 then
5981 Err_Vars.Error_Msg_File_1 := Suffix;
5984 "{ is illegal for " & Attribute_Name & ": must have a dot",
5989 -- Case of dot replacement is a single dot, and first character of
5990 -- suffix is also a dot.
5992 if Dot_Replacement /= No_File
5993 and then Get_Name_String (Dot_Replacement) = "."
5994 and then Suffix_Str (Suffix_Str'First) = '.'
5996 for Index in Suffix_Str'First + 1 .. Suffix_Str'Last loop
5998 -- If there are multiple dots in the name
6000 if Suffix_Str (Index) = '.' then
6002 -- It is illegal to have a letter following the initial dot
6004 if Is_Letter (Suffix_Str (Suffix_Str'First + 1)) then
6005 Err_Vars.Error_Msg_File_1 := Suffix;
6008 "{ is illegal for " & Attribute_Name
6009 & ": ambiguous prefix when Dot_Replacement is a dot",
6016 end Check_Illegal_Suffix;
6018 ----------------------
6019 -- Locate_Directory --
6020 ----------------------
6022 procedure Locate_Directory
6023 (Project : Project_Id;
6024 Name : File_Name_Type;
6025 Path : out Path_Information;
6026 Dir_Exists : out Boolean;
6027 Data : in out Tree_Processing_Data;
6028 Create : String := "";
6029 Location : Source_Ptr := No_Location;
6030 Must_Exist : Boolean := True;
6031 Externally_Built : Boolean := False)
6033 Parent : constant Path_Name_Type :=
6034 Project.Directory.Display_Name;
6035 The_Parent : constant String :=
6036 Get_Name_String (Parent);
6037 The_Parent_Last : constant Natural :=
6038 Compute_Directory_Last (The_Parent);
6039 Full_Name : File_Name_Type;
6040 The_Name : File_Name_Type;
6043 Get_Name_String (Name);
6045 -- Add Subdirs.all if it is a directory that may be created and
6046 -- Subdirs is not null;
6048 if Create /= "" and then Subdirs /= null then
6049 if Name_Buffer (Name_Len) /= Directory_Separator then
6050 Add_Char_To_Name_Buffer (Directory_Separator);
6053 Add_Str_To_Name_Buffer (Subdirs.all);
6056 -- Convert '/' to directory separator (for Windows)
6058 for J in 1 .. Name_Len loop
6059 if Name_Buffer (J) = '/' then
6060 Name_Buffer (J) := Directory_Separator;
6064 The_Name := Name_Find;
6066 if Current_Verbosity = High then
6068 Write_Str ("Locate_Directory (""");
6069 Write_Str (Get_Name_String (The_Name));
6070 Write_Str (""", in """);
6071 Write_Str (The_Parent);
6075 Path := No_Path_Information;
6076 Dir_Exists := False;
6078 if Is_Absolute_Path (Get_Name_String (The_Name)) then
6079 Full_Name := The_Name;
6083 Add_Str_To_Name_Buffer
6084 (The_Parent (The_Parent'First .. The_Parent_Last));
6085 Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
6086 Full_Name := Name_Find;
6090 Full_Path_Name : String_Access :=
6091 new String'(Get_Name_String (Full_Name));
6094 if (Setup_Projects or else Subdirs /= null)
6095 and then Create'Length > 0
6097 if not Is_Directory (Full_Path_Name.all) then
6099 -- If project is externally built, do not create a subdir,
6100 -- use the specified directory, without the subdir.
6102 if Externally_Built then
6103 if Is_Absolute_Path (Get_Name_String (Name)) then
6104 Get_Name_String (Name);
6108 Add_Str_To_Name_Buffer
6109 (The_Parent (The_Parent'First .. The_Parent_Last));
6110 Add_Str_To_Name_Buffer (Get_Name_String (Name));
6113 Full_Path_Name := new String'(Name_Buffer (1 .. Name_Len));
6117 Create_Path (Full_Path_Name.all);
6119 if not Quiet_Output then
6121 Write_Str (" directory """);
6122 Write_Str (Full_Path_Name.all);
6123 Write_Str (""" created for project ");
6124 Write_Line (Get_Name_String (Project.Name));
6131 "could not create " & Create &
6132 " directory " & Full_Path_Name.all,
6139 Dir_Exists := Is_Directory (Full_Path_Name.all);
6141 if not Must_Exist or else Dir_Exists then
6143 Normed : constant String :=
6145 (Full_Path_Name.all,
6147 The_Parent (The_Parent'First .. The_Parent_Last),
6148 Resolve_Links => False,
6149 Case_Sensitive => True);
6151 Canonical_Path : constant String :=
6156 (The_Parent'First .. The_Parent_Last),
6158 Opt.Follow_Links_For_Dirs,
6159 Case_Sensitive => False);
6162 Name_Len := Normed'Length;
6163 Name_Buffer (1 .. Name_Len) := Normed;
6165 -- Directories should always end with a directory separator
6167 if Name_Buffer (Name_Len) /= Directory_Separator then
6168 Add_Char_To_Name_Buffer (Directory_Separator);
6171 Path.Display_Name := Name_Find;
6173 Name_Len := Canonical_Path'Length;
6174 Name_Buffer (1 .. Name_Len) := Canonical_Path;
6176 if Name_Buffer (Name_Len) /= Directory_Separator then
6177 Add_Char_To_Name_Buffer (Directory_Separator);
6180 Path.Name := Name_Find;
6184 Free (Full_Path_Name);
6186 end Locate_Directory;
6188 ---------------------------
6189 -- Find_Excluded_Sources --
6190 ---------------------------
6192 procedure Find_Excluded_Sources
6193 (Project : in out Project_Processing_Data;
6194 Data : in out Tree_Processing_Data)
6196 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
6198 Excluded_Source_List_File : constant Variable_Value :=
6200 (Name_Excluded_Source_List_File,
6201 Project.Project.Decl.Attributes,
6203 Excluded_Sources : Variable_Value := Util.Value_Of
6204 (Name_Excluded_Source_Files,
6205 Project.Project.Decl.Attributes,
6208 Current : String_List_Id;
6209 Element : String_Element;
6210 Location : Source_Ptr;
6211 Name : File_Name_Type;
6212 File : Prj.Util.Text_File;
6213 Line : String (1 .. 300);
6215 Locally_Removed : Boolean := False;
6218 -- If Excluded_Source_Files is not declared, check Locally_Removed_Files
6220 if Excluded_Sources.Default then
6221 Locally_Removed := True;
6224 (Name_Locally_Removed_Files,
6225 Project.Project.Decl.Attributes, Shared);
6228 -- If there are excluded sources, put them in the table
6230 if not Excluded_Sources.Default then
6231 if not Excluded_Source_List_File.Default then
6232 if Locally_Removed then
6235 "?both attributes Locally_Removed_Files and " &
6236 "Excluded_Source_List_File are present",
6237 Excluded_Source_List_File.Location, Project.Project);
6241 "?both attributes Excluded_Source_Files and " &
6242 "Excluded_Source_List_File are present",
6243 Excluded_Source_List_File.Location, Project.Project);
6247 Current := Excluded_Sources.Values;
6248 while Current /= Nil_String loop
6249 Element := Shared.String_Elements.Table (Current);
6250 Name := Canonical_Case_File_Name (Element.Value);
6252 -- If the element has no location, then use the location of
6253 -- Excluded_Sources to report possible errors.
6255 if Element.Location = No_Location then
6256 Location := Excluded_Sources.Location;
6258 Location := Element.Location;
6261 Excluded_Sources_Htable.Set
6262 (Project.Excluded, Name,
6263 (Name, No_File, 0, False, Location));
6264 Current := Element.Next;
6267 elsif not Excluded_Source_List_File.Default then
6268 Location := Excluded_Source_List_File.Location;
6271 Source_File_Name : constant File_Name_Type :=
6273 (Excluded_Source_List_File.Value);
6274 Source_File_Line : Natural := 0;
6276 Source_File_Path_Name : constant String :=
6279 Project.Project.Directory.Name);
6282 if Source_File_Path_Name'Length = 0 then
6283 Err_Vars.Error_Msg_File_1 :=
6284 File_Name_Type (Excluded_Source_List_File.Value);
6287 "file with excluded sources { does not exist",
6288 Excluded_Source_List_File.Location, Project.Project);
6293 Prj.Util.Open (File, Source_File_Path_Name);
6295 if not Prj.Util.Is_Valid (File) then
6297 (Data.Flags, "file does not exist",
6298 Location, Project.Project);
6300 -- Read the lines one by one
6302 while not Prj.Util.End_Of_File (File) loop
6303 Prj.Util.Get_Line (File, Line, Last);
6304 Source_File_Line := Source_File_Line + 1;
6306 -- Non empty, non comment line should contain a file name
6309 and then (Last = 1 or else Line (1 .. 2) /= "--")
6312 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6313 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6316 -- Check that there is no directory information
6318 for J in 1 .. Last loop
6320 or else Line (J) = Directory_Separator
6322 Error_Msg_File_1 := Name;
6325 "file name cannot include " &
6326 "directory information ({)",
6327 Location, Project.Project);
6332 Excluded_Sources_Htable.Set
6335 (Name, Source_File_Name, Source_File_Line,
6340 Prj.Util.Close (File);
6345 end Find_Excluded_Sources;
6351 procedure Find_Sources
6352 (Project : in out Project_Processing_Data;
6353 Data : in out Tree_Processing_Data)
6355 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
6357 Sources : constant Variable_Value :=
6360 Project.Project.Decl.Attributes,
6363 Source_List_File : constant Variable_Value :=
6365 (Name_Source_List_File,
6366 Project.Project.Decl.Attributes,
6369 Name_Loc : Name_Location;
6370 Has_Explicit_Sources : Boolean;
6373 pragma Assert (Sources.Kind = List, "Source_Files is not a list");
6375 (Source_List_File.Kind = Single,
6376 "Source_List_File is not a single string");
6378 Project.Source_List_File_Location := Source_List_File.Location;
6380 -- If the user has specified a Source_Files attribute
6382 if not Sources.Default then
6383 if not Source_List_File.Default then
6386 "?both attributes source_files and " &
6387 "source_list_file are present",
6388 Source_List_File.Location, Project.Project);
6391 -- Sources is a list of file names
6394 Current : String_List_Id := Sources.Values;
6395 Element : String_Element;
6396 Location : Source_Ptr;
6397 Name : File_Name_Type;
6400 if Current = Nil_String then
6401 Project.Project.Languages := No_Language_Index;
6403 -- This project contains no source. For projects that don't
6404 -- extend other projects, this also means that there is no
6405 -- need for an object directory, if not specified.
6407 if Project.Project.Extends = No_Project
6409 Project.Project.Object_Directory = Project.Project.Directory
6411 not (Project.Project.Qualifier = Aggregate_Library)
6413 Project.Project.Object_Directory := No_Path_Information;
6417 while Current /= Nil_String loop
6418 Element := Shared.String_Elements.Table (Current);
6419 Name := Canonical_Case_File_Name (Element.Value);
6420 Get_Name_String (Element.Value);
6422 -- If the element has no location, then use the location of
6423 -- Sources to report possible errors.
6425 if Element.Location = No_Location then
6426 Location := Sources.Location;
6428 Location := Element.Location;
6431 -- Check that there is no directory information
6433 for J in 1 .. Name_Len loop
6434 if Name_Buffer (J) = '/'
6435 or else Name_Buffer (J) = Directory_Separator
6437 Error_Msg_File_1 := Name;
6440 "file name cannot include directory " &
6442 Location, Project.Project);
6447 -- Check whether the file is already there: the same file name
6448 -- may be in the list. If the source is missing, the error will
6449 -- be on the first mention of the source file name.
6451 Name_Loc := Source_Names_Htable.Get
6452 (Project.Source_Names, Name);
6454 if Name_Loc = No_Name_Location then
6457 Location => Location,
6458 Source => No_Source,
6463 Name_Loc.Listed := True;
6466 Source_Names_Htable.Set
6467 (Project.Source_Names, Name, Name_Loc);
6469 Current := Element.Next;
6472 Has_Explicit_Sources := True;
6475 -- If we have no Source_Files attribute, check the Source_List_File
6478 elsif not Source_List_File.Default then
6480 -- Source_List_File is the name of the file that contains the source
6484 Source_File_Path_Name : constant String :=
6487 (Source_List_File.Value),
6489 Directory.Display_Name);
6492 Has_Explicit_Sources := True;
6494 if Source_File_Path_Name'Length = 0 then
6495 Err_Vars.Error_Msg_File_1 :=
6496 File_Name_Type (Source_List_File.Value);
6499 "file with sources { does not exist",
6500 Source_List_File.Location, Project.Project);
6503 Get_Sources_From_File
6504 (Source_File_Path_Name, Source_List_File.Location,
6510 -- Neither Source_Files nor Source_List_File has been specified. Find
6511 -- all the files that satisfy the naming scheme in all the source
6514 Has_Explicit_Sources := False;
6517 -- Remove any exception that is not in the specified list of sources
6519 if Has_Explicit_Sources then
6522 Iter : Source_Iterator;
6529 Iter := For_Each_Source (Data.Tree, Project.Project);
6533 Source := Prj.Element (Iter);
6534 exit Source_Loop when Source = No_Source;
6536 if Source.Naming_Exception /= No then
6537 NL := Source_Names_Htable.Get
6538 (Project.Source_Names, Source.File);
6540 if NL /= No_Name_Location and then not NL.Listed then
6541 -- Remove the exception
6542 Source_Names_Htable.Set
6543 (Project.Source_Names,
6546 Remove_Source (Data.Tree, Source, No_Source);
6548 if Source.Naming_Exception = Yes then
6549 Error_Msg_Name_1 := Name_Id (Source.File);
6552 "? unknown source file %%",
6563 end loop Source_Loop;
6565 exit Iter_Loop when not Again;
6573 For_All_Sources => Sources.Default and then Source_List_File.Default);
6575 -- Check if all exceptions have been found
6579 Iter : Source_Iterator;
6580 Found : Boolean := False;
6583 Iter := For_Each_Source (Data.Tree, Project.Project);
6585 Source := Prj.Element (Iter);
6586 exit when Source = No_Source;
6588 -- If the full source path is unknown for this source_id, there
6589 -- could be several reasons:
6590 -- * we simply did not find the file itself, this is an error
6591 -- * we have a multi-unit source file. Another Source_Id from
6592 -- the same file has received the full path, so we need to
6595 if Source.Path = No_Path_Information then
6596 if Source.Naming_Exception = Yes then
6597 if Source.Unit /= No_Unit_Index then
6600 if Source.Index /= 0 then -- Only multi-unit files
6603 Source_Files_Htable.Get
6604 (Data.Tree.Source_Files_HT, Source.File);
6607 while S /= null loop
6608 if S.Path /= No_Path_Information then
6609 Source.Path := S.Path;
6612 if Current_Verbosity = High then
6614 ("setting full path for "
6615 & Get_Name_String (Source.File)
6616 & " at" & Source.Index'Img
6618 & Get_Name_String (Source.Path.Name));
6624 S := S.Next_With_File_Name;
6630 Error_Msg_Name_1 := Name_Id (Source.Display_File);
6631 Error_Msg_Name_2 := Source.Unit.Name;
6633 (Data.Flags, Data.Flags.Missing_Source_Files,
6634 "source file %% for unit %% not found",
6635 No_Location, Project.Project);
6639 if Source.Path = No_Path_Information then
6640 Remove_Source (Data.Tree, Source, No_Source);
6643 elsif Source.Naming_Exception = Inherited then
6644 Remove_Source (Data.Tree, Source, No_Source);
6652 -- It is an error if a source file name in a source list or in a source
6653 -- list file is not found.
6655 if Has_Explicit_Sources then
6658 First_Error : Boolean;
6661 NL := Source_Names_Htable.Get_First (Project.Source_Names);
6662 First_Error := True;
6663 while NL /= No_Name_Location loop
6664 if not NL.Found then
6665 Err_Vars.Error_Msg_File_1 := NL.Name;
6668 (Data.Flags, Data.Flags.Missing_Source_Files,
6669 "source file { not found",
6670 NL.Location, Project.Project);
6671 First_Error := False;
6674 (Data.Flags, Data.Flags.Missing_Source_Files,
6675 "\source file { not found",
6676 NL.Location, Project.Project);
6680 NL := Source_Names_Htable.Get_Next (Project.Source_Names);
6690 procedure Initialize
6691 (Data : out Tree_Processing_Data;
6692 Tree : Project_Tree_Ref;
6693 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
6694 Flags : Prj.Processing_Flags)
6698 Data.Node_Tree := Node_Tree;
6699 Data.Flags := Flags;
6706 procedure Free (Data : in out Tree_Processing_Data) is
6707 pragma Unreferenced (Data);
6716 procedure Initialize
6717 (Data : in out Project_Processing_Data;
6718 Project : Project_Id)
6721 Data.Project := Project;
6728 procedure Free (Data : in out Project_Processing_Data) is
6730 Source_Names_Htable.Reset (Data.Source_Names);
6731 Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions);
6732 Excluded_Sources_Htable.Reset (Data.Excluded);
6735 -------------------------------
6736 -- Check_File_Naming_Schemes --
6737 -------------------------------
6739 procedure Check_File_Naming_Schemes
6740 (Project : Project_Processing_Data;
6741 File_Name : File_Name_Type;
6742 Alternate_Languages : out Language_List;
6743 Language : out Language_Ptr;
6744 Display_Language_Name : out Name_Id;
6746 Lang_Kind : out Language_Kind;
6747 Kind : out Source_Kind)
6749 Filename : constant String := Get_Name_String (File_Name);
6750 Config : Language_Config;
6751 Tmp_Lang : Language_Ptr;
6753 Header_File : Boolean := False;
6754 -- True if we found at least one language for which the file is a header
6755 -- In such a case, we search for all possible languages where this is
6756 -- also a header (C and C++ for instance), since the file might be used
6757 -- for several such languages.
6759 procedure Check_File_Based_Lang;
6760 -- Does the naming scheme test for file-based languages. For those,
6761 -- there is no Unit. Just check if the file name has the implementation
6762 -- or, if it is specified, the template suffix of the language.
6764 -- Returns True if the file belongs to the current language and we
6765 -- should stop searching for matching languages. Not that a given header
6766 -- file could belong to several languages (C and C++ for instance). Thus
6767 -- if we found a header we'll check whether it matches other languages.
6769 ---------------------------
6770 -- Check_File_Based_Lang --
6771 ---------------------------
6773 procedure Check_File_Based_Lang is
6776 and then Suffix_Matches (Filename, Config.Naming_Data.Body_Suffix)
6780 Language := Tmp_Lang;
6783 ("implementation of language ", Display_Language_Name);
6785 elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
6787 ("header of language ", Display_Language_Name);
6790 Alternate_Languages := new Language_List_Element'
6791 (Language => Language,
6792 Next => Alternate_Languages);
6795 Header_File := True;
6798 Language := Tmp_Lang;
6801 end Check_File_Based_Lang;
6803 -- Start of processing for Check_File_Naming_Schemes
6806 Language := No_Language_Index;
6807 Alternate_Languages := null;
6808 Display_Language_Name := No_Name;
6810 Lang_Kind := File_Based;
6813 Tmp_Lang := Project.Project.Languages;
6814 while Tmp_Lang /= No_Language_Index loop
6815 if Current_Verbosity = High then
6817 ("testing language "
6818 & Get_Name_String (Tmp_Lang.Name)
6819 & " Header_File=" & Header_File'Img);
6822 Display_Language_Name := Tmp_Lang.Display_Name;
6823 Config := Tmp_Lang.Config;
6824 Lang_Kind := Config.Kind;
6828 Check_File_Based_Lang;
6829 exit when Kind = Impl;
6833 -- We know it belongs to a least a file_based language, no
6834 -- need to check unit-based ones.
6836 if not Header_File then
6838 (File_Name => File_Name,
6839 Naming => Config.Naming_Data,
6842 Project => Project);
6844 if Unit /= No_Name then
6845 Language := Tmp_Lang;
6851 Tmp_Lang := Tmp_Lang.Next;
6854 if Language = No_Language_Index then
6855 Debug_Output ("not a source of any language");
6857 end Check_File_Naming_Schemes;
6863 procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is
6865 -- If the file was previously already associated with a unit, change it
6867 if Source.Unit /= null
6868 and then Source.Kind in Spec_Or_Body
6869 and then Source.Unit.File_Names (Source.Kind) /= null
6871 -- If we had another file referencing the same unit (for instance it
6872 -- was in an extended project), that source file is in fact invisible
6873 -- from now on, and in particular doesn't belong to the same unit.
6874 -- If the source is an inherited naming exception, then it may not
6875 -- really exist: the source potentially replaced is left untouched.
6877 if Source.Unit.File_Names (Source.Kind) /= Source then
6878 Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
6881 Source.Unit.File_Names (Source.Kind) := null;
6884 Source.Kind := Kind;
6886 if Current_Verbosity = High
6887 and then Source.File /= No_File
6889 Debug_Output ("override kind for "
6890 & Get_Name_String (Source.File)
6891 & " idx=" & Source.Index'Img
6892 & " kind=" & Source.Kind'Img);
6895 if Source.Unit /= null then
6896 if Source.Kind = Spec then
6897 Source.Unit.File_Names (Spec) := Source;
6899 Source.Unit.File_Names (Impl) := Source;
6908 procedure Check_File
6909 (Project : in out Project_Processing_Data;
6910 Data : in out Tree_Processing_Data;
6911 Source_Dir_Rank : Natural;
6912 Path : Path_Name_Type;
6913 Display_Path : Path_Name_Type;
6914 File_Name : File_Name_Type;
6915 Display_File_Name : File_Name_Type;
6916 Locally_Removed : Boolean;
6917 For_All_Sources : Boolean)
6919 Name_Loc : Name_Location :=
6920 Source_Names_Htable.Get
6921 (Project.Source_Names, File_Name);
6922 Check_Name : Boolean := False;
6923 Alternate_Languages : Language_List;
6924 Language : Language_Ptr;
6926 Src_Ind : Source_File_Index;
6928 Display_Language_Name : Name_Id;
6929 Lang_Kind : Language_Kind;
6930 Kind : Source_Kind := Spec;
6933 if Current_Verbosity = High then
6934 Debug_Increase_Indent
6935 ("checking file (rank=" & Source_Dir_Rank'Img & ")",
6936 Name_Id (Display_Path));
6939 if Name_Loc = No_Name_Location then
6940 Check_Name := For_All_Sources;
6943 if Name_Loc.Found then
6945 -- Check if it is OK to have the same file name in several
6946 -- source directories.
6948 if Source_Dir_Rank = Name_Loc.Source.Source_Dir_Rank then
6949 Error_Msg_File_1 := File_Name;
6952 "{ is found in several source directories",
6953 Name_Loc.Location, Project.Project);
6957 Name_Loc.Found := True;
6959 Source_Names_Htable.Set
6960 (Project.Source_Names, File_Name, Name_Loc);
6962 if Name_Loc.Source = No_Source then
6966 -- Set the full path for the source_id (which might have been
6967 -- created when parsing the naming exceptions, and therefore
6968 -- might not have the full path).
6969 -- We only set this for this source_id, but not for other
6970 -- source_id in the same file (case of multi-unit source files)
6971 -- For the latter, they will be set in Find_Sources when we
6972 -- check that all source_id have known full paths.
6973 -- Doing this later saves one htable lookup per file in the
6974 -- common case where the user is not using multi-unit files.
6976 Name_Loc.Source.Path := (Path, Display_Path);
6978 Source_Paths_Htable.Set
6979 (Data.Tree.Source_Paths_HT, Path, Name_Loc.Source);
6981 -- Check if this is a subunit
6983 if Name_Loc.Source.Unit /= No_Unit_Index
6984 and then Name_Loc.Source.Kind = Impl
6986 Src_Ind := Sinput.P.Load_Project_File
6987 (Get_Name_String (Display_Path));
6989 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
6990 Override_Kind (Name_Loc.Source, Sep);
6994 -- If this is an inherited naming exception, make sure that
6995 -- the naming exception it replaces is no longer a source.
6997 if Name_Loc.Source.Naming_Exception = Inherited then
6999 Proj : Project_Id := Name_Loc.Source.Project.Extends;
7000 Iter : Source_Iterator;
7003 while Proj /= No_Project loop
7004 Iter := For_Each_Source (Data.Tree, Proj);
7005 Src := Prj.Element (Iter);
7006 while Src /= No_Source loop
7007 if Src.File = Name_Loc.Source.File then
7008 Src.Replaced_By := Name_Loc.Source;
7013 Src := Prj.Element (Iter);
7016 Proj := Proj.Extends;
7020 if Name_Loc.Source.Unit /= No_Unit_Index then
7021 if Name_Loc.Source.Kind = Spec then
7022 Name_Loc.Source.Unit.File_Names (Spec) :=
7025 elsif Name_Loc.Source.Kind = Impl then
7026 Name_Loc.Source.Unit.File_Names (Impl) :=
7031 (Data.Tree.Units_HT,
7032 Name_Loc.Source.Unit.Name,
7033 Name_Loc.Source.Unit);
7041 Check_File_Naming_Schemes
7042 (Project => Project,
7043 File_Name => File_Name,
7044 Alternate_Languages => Alternate_Languages,
7045 Language => Language,
7046 Display_Language_Name => Display_Language_Name,
7048 Lang_Kind => Lang_Kind,
7051 if Language = No_Language_Index then
7053 -- A file name in a list must be a source of a language
7055 if Data.Flags.Error_On_Unknown_Language
7056 and then Name_Loc.Found
7058 Error_Msg_File_1 := File_Name;
7061 "language unknown for {",
7062 Name_Loc.Location, Project.Project);
7068 Project => Project.Project,
7069 Source_Dir_Rank => Source_Dir_Rank,
7070 Lang_Id => Language,
7073 Alternate_Languages => Alternate_Languages,
7074 File_Name => File_Name,
7075 Display_File => Display_File_Name,
7077 Locally_Removed => Locally_Removed,
7078 Path => (Path, Display_Path));
7080 -- If it is a source specified in a list, update the entry in
7081 -- the Source_Names table.
7083 if Name_Loc.Found and then Name_Loc.Source = No_Source then
7084 Name_Loc.Source := Source;
7085 Source_Names_Htable.Set
7086 (Project.Source_Names, File_Name, Name_Loc);
7091 Debug_Decrease_Indent;
7094 ---------------------------------
7095 -- Expand_Subdirectory_Pattern --
7096 ---------------------------------
7098 procedure Expand_Subdirectory_Pattern
7099 (Project : Project_Id;
7100 Data : in out Tree_Processing_Data;
7101 Patterns : String_List_Id;
7102 Ignore : String_List_Id;
7103 Search_For : Search_Type;
7104 Resolve_Links : Boolean)
7106 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
7108 package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable
7109 (Header_Num => Header_Num,
7111 No_Element => False,
7112 Key => Path_Name_Type,
7115 -- Hash table stores recursive source directories, to avoid looking
7116 -- several times, and to avoid cycles that may be introduced by symbolic
7119 File_Pattern : GNAT.Regexp.Regexp;
7120 -- Pattern to use when matching file names
7122 Visited : Recursive_Dirs.Instance;
7124 procedure Find_Pattern
7125 (Pattern_Id : Name_Id;
7127 Location : Source_Ptr);
7128 -- Find a specific pattern
7130 function Recursive_Find_Dirs
7131 (Path : Path_Information;
7132 Rank : Natural) return Boolean;
7133 -- Search all the subdirectories (recursively) of Path.
7134 -- Return True if at least one file or directory was processed
7136 function Subdirectory_Matches
7137 (Path : Path_Information;
7138 Rank : Natural) return Boolean;
7139 -- Called when a matching directory was found. If the user is in fact
7140 -- searching for files, we then search for those files matching the
7141 -- pattern within the directory.
7142 -- Return True if at least one file or directory was processed
7144 --------------------------
7145 -- Subdirectory_Matches --
7146 --------------------------
7148 function Subdirectory_Matches
7149 (Path : Path_Information;
7150 Rank : Natural) return Boolean
7153 Name : String (1 .. 250);
7155 Found : Path_Information;
7156 Success : Boolean := False;
7160 when Search_Directories =>
7161 Callback (Path, Rank);
7164 when Search_Files =>
7165 Open (Dir, Get_Name_String (Path.Display_Name));
7167 Read (Dir, Name, Last);
7170 if Name (Name'First .. Last) /= "."
7171 and then Name (Name'First .. Last) /= ".."
7172 and then Match (Name (Name'First .. Last), File_Pattern)
7174 Get_Name_String (Path.Display_Name);
7175 Add_Str_To_Name_Buffer (Name (Name'First .. Last));
7177 Found.Display_Name := Name_Find;
7178 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7179 Found.Name := Name_Find;
7181 Callback (Found, Rank);
7190 end Subdirectory_Matches;
7192 -------------------------
7193 -- Recursive_Find_Dirs --
7194 -------------------------
7196 function Recursive_Find_Dirs
7197 (Path : Path_Information;
7198 Rank : Natural) return Boolean
7200 Path_Str : constant String := Get_Name_String (Path.Display_Name);
7202 Name : String (1 .. 250);
7204 Success : Boolean := False;
7207 Debug_Output ("looking for subdirs of ", Name_Id (Path.Display_Name));
7209 if Recursive_Dirs.Get (Visited, Path.Name) then
7213 Recursive_Dirs.Set (Visited, Path.Name, True);
7215 Success := Subdirectory_Matches (Path, Rank) or Success;
7217 Open (Dir, Path_Str);
7220 Read (Dir, Name, Last);
7223 if Name (1 .. Last) /= "."
7225 Name (1 .. Last) /= ".."
7228 Path_Name : constant String :=
7230 (Name => Name (1 .. Last),
7231 Directory => Path_Str,
7232 Resolve_Links => Resolve_Links)
7233 & Directory_Separator;
7234 Path2 : Path_Information;
7235 OK : Boolean := True;
7238 if Is_Directory (Path_Name) then
7239 if Ignore /= Nil_String then
7241 Dir_Name : String := Name (1 .. Last);
7242 List : String_List_Id := Ignore;
7245 Canonical_Case_File_Name (Dir_Name);
7247 while List /= Nil_String loop
7249 (Shared.String_Elements.Table (List).Value);
7250 Canonical_Case_File_Name
7251 (Name_Buffer (1 .. Name_Len));
7252 OK := Name_Buffer (1 .. Name_Len) /= Dir_Name;
7254 List := Shared.String_Elements.Table (List).Next;
7261 Add_Str_To_Name_Buffer (Path_Name);
7262 Path2.Display_Name := Name_Find;
7264 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7265 Path2.Name := Name_Find;
7268 Recursive_Find_Dirs (Path2, Rank) or Success;
7280 when Directory_Error =>
7282 end Recursive_Find_Dirs;
7288 procedure Find_Pattern
7289 (Pattern_Id : Name_Id;
7291 Location : Source_Ptr)
7293 Pattern : constant String := Get_Name_String (Pattern_Id);
7294 Pattern_End : Natural := Pattern'Last;
7295 Recursive : Boolean;
7296 Dir : File_Name_Type;
7297 Path_Name : Path_Information;
7298 Dir_Exists : Boolean;
7299 Has_Error : Boolean := False;
7303 Debug_Increase_Indent ("Find_Pattern", Pattern_Id);
7305 -- If we are looking for files, find the pattern for the files
7307 if Search_For = Search_Files then
7308 while Pattern_End >= Pattern'First
7309 and then Pattern (Pattern_End) /= '/'
7310 and then Pattern (Pattern_End) /= Directory_Separator
7312 Pattern_End := Pattern_End - 1;
7315 if Pattern_End = Pattern'Last then
7316 Err_Vars.Error_Msg_File_1 := File_Name_Type (Pattern_Id);
7318 (Data.Flags, Data.Flags.Missing_Source_Files,
7319 "Missing file name or pattern in {", Location, Project);
7323 if Current_Verbosity = High then
7325 Write_Str ("file_pattern=");
7326 Write_Str (Pattern (Pattern_End + 1 .. Pattern'Last));
7327 Write_Str (" dir_pattern=");
7328 Write_Line (Pattern (Pattern'First .. Pattern_End));
7331 File_Pattern := Compile
7332 (Pattern (Pattern_End + 1 .. Pattern'Last),
7334 Case_Sensitive => File_Names_Case_Sensitive);
7336 -- If we had just "*.gpr", this is equivalent to "./*.gpr"
7338 if Pattern_End > Pattern'First then
7339 Pattern_End := Pattern_End - 1; -- Skip directory separator
7344 Pattern_End - 1 >= Pattern'First
7345 and then Pattern (Pattern_End - 1 .. Pattern_End) = "**"
7346 and then (Pattern_End - 1 = Pattern'First
7347 or else Pattern (Pattern_End - 2) = '/'
7348 or else Pattern (Pattern_End - 2) = Directory_Separator);
7351 Pattern_End := Pattern_End - 2;
7352 if Pattern_End > Pattern'First then
7353 Pattern_End := Pattern_End - 1; -- Skip '/'
7357 Name_Len := Pattern_End - Pattern'First + 1;
7358 Name_Buffer (1 .. Name_Len) := Pattern (Pattern'First .. Pattern_End);
7362 (Project => Project,
7365 Dir_Exists => Dir_Exists,
7367 Must_Exist => False);
7369 if not Dir_Exists then
7370 Err_Vars.Error_Msg_File_1 := Dir;
7372 (Data.Flags, Data.Flags.Missing_Source_Files,
7373 "{ is not a valid directory", Location, Project);
7374 Has_Error := Data.Flags.Missing_Source_Files = Error;
7377 if not Has_Error then
7379 -- Links have been resolved if necessary, and Path_Name
7380 -- always ends with a directory separator.
7383 Success := Recursive_Find_Dirs (Path_Name, Rank);
7385 Success := Subdirectory_Matches (Path_Name, Rank);
7390 when Search_Directories =>
7391 null; -- Error can't occur
7393 when Search_Files =>
7394 Err_Vars.Error_Msg_File_1 := File_Name_Type (Pattern_Id);
7396 (Data.Flags, Data.Flags.Missing_Source_Files,
7397 "file { not found", Location, Project);
7402 Debug_Decrease_Indent ("done Find_Pattern");
7407 Pattern_Id : String_List_Id := Patterns;
7408 Element : String_Element;
7409 Rank : Natural := 1;
7411 -- Start of processing for Expand_Subdirectory_Pattern
7414 while Pattern_Id /= Nil_String loop
7415 Element := Shared.String_Elements.Table (Pattern_Id);
7416 Find_Pattern (Element.Value, Rank, Element.Location);
7418 Pattern_Id := Element.Next;
7421 Recursive_Dirs.Reset (Visited);
7422 end Expand_Subdirectory_Pattern;
7424 ------------------------
7425 -- Search_Directories --
7426 ------------------------
7428 procedure Search_Directories
7429 (Project : in out Project_Processing_Data;
7430 Data : in out Tree_Processing_Data;
7431 For_All_Sources : Boolean)
7433 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
7435 Source_Dir : String_List_Id;
7436 Element : String_Element;
7437 Src_Dir_Rank : Number_List_Index;
7438 Num_Nod : Number_Node;
7440 Name : String (1 .. 1_000);
7442 File_Name : File_Name_Type;
7443 Display_File_Name : File_Name_Type;
7446 Debug_Increase_Indent ("looking for sources of", Project.Project.Name);
7448 -- Loop through subdirectories
7450 Src_Dir_Rank := Project.Project.Source_Dir_Ranks;
7452 Source_Dir := Project.Project.Source_Dirs;
7453 while Source_Dir /= Nil_String loop
7455 Num_Nod := Shared.Number_Lists.Table (Src_Dir_Rank);
7456 Element := Shared.String_Elements.Table (Source_Dir);
7458 -- Use Element.Value in this test, not Display_Value, because we
7459 -- want the symbolic links to be resolved when appropriate.
7461 if Element.Value /= No_Name then
7463 Source_Directory : constant String :=
7464 Get_Name_String (Element.Value)
7465 & Directory_Separator;
7467 Dir_Last : constant Natural :=
7468 Compute_Directory_Last (Source_Directory);
7470 Display_Source_Directory : constant String :=
7472 (Element.Display_Value)
7473 & Directory_Separator;
7474 -- Display_Source_Directory is to allow us to open a UTF-8
7475 -- encoded directory on Windows.
7478 if Current_Verbosity = High then
7479 Debug_Increase_Indent
7480 ("Source_Dir (node=" & Num_Nod.Number'Img & ") """
7481 & Source_Directory (Source_Directory'First .. Dir_Last)
7485 -- We look to every entry in the source directory
7487 Open (Dir, Display_Source_Directory);
7490 Read (Dir, Name, Last);
7493 -- In fast project loading mode (without -eL), the user
7494 -- guarantees that no directory has a name which is a
7495 -- valid source name, so we can avoid doing a system call
7496 -- here. This provides a very significant speed up on
7497 -- slow file systems (remote files for instance).
7499 if not Opt.Follow_Links_For_Files
7500 or else Is_Regular_File
7501 (Display_Source_Directory & Name (1 .. Last))
7504 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
7505 Display_File_Name := Name_Find;
7507 if Osint.File_Names_Case_Sensitive then
7508 File_Name := Display_File_Name;
7510 Canonical_Case_File_Name
7511 (Name_Buffer (1 .. Name_Len));
7512 File_Name := Name_Find;
7516 Path_Name : constant String :=
7521 (Source_Directory'First ..
7524 Opt.Follow_Links_For_Files,
7525 Case_Sensitive => True);
7527 Path : Path_Name_Type;
7529 Excluded_Sources_Htable.Get
7530 (Project.Excluded, File_Name);
7531 To_Remove : Boolean := False;
7534 Name_Len := Path_Name'Length;
7535 Name_Buffer (1 .. Name_Len) := Path_Name;
7537 if Osint.File_Names_Case_Sensitive then
7540 Canonical_Case_File_Name
7541 (Name_Buffer (1 .. Name_Len));
7545 if FF /= No_File_Found then
7546 if not FF.Found then
7548 Excluded_Sources_Htable.Set
7549 (Project.Excluded, File_Name, FF);
7552 ("excluded source ",
7553 Name_Id (Display_File_Name));
7555 -- Will mark the file as removed, but we
7556 -- still need to add it to the list: if we
7557 -- don't, the file will not appear in the
7558 -- mapping file and will cause the compiler
7565 -- Preserve the user's original casing and use of
7566 -- links. The display_value (a directory) already
7567 -- ends with a directory separator by construction,
7568 -- so no need to add one.
7570 Get_Name_String (Element.Display_Value);
7571 Get_Name_String_And_Append (Display_File_Name);
7574 (Project => Project,
7575 Source_Dir_Rank => Num_Nod.Number,
7578 Display_Path => Name_Find,
7579 File_Name => File_Name,
7580 Locally_Removed => To_Remove,
7581 Display_File_Name => Display_File_Name,
7582 For_All_Sources => For_All_Sources);
7586 if Current_Verbosity = High then
7587 Debug_Output ("ignore " & Name (1 .. Last));
7592 Debug_Decrease_Indent;
7598 when Directory_Error =>
7602 Source_Dir := Element.Next;
7603 Src_Dir_Rank := Num_Nod.Next;
7606 Debug_Decrease_Indent ("end looking for sources.");
7607 end Search_Directories;
7609 ----------------------------
7610 -- Load_Naming_Exceptions --
7611 ----------------------------
7613 procedure Load_Naming_Exceptions
7614 (Project : in out Project_Processing_Data;
7615 Data : in out Tree_Processing_Data)
7618 Iter : Source_Iterator;
7621 Iter := For_Each_Source (Data.Tree, Project.Project);
7623 Source := Prj.Element (Iter);
7624 exit when Source = No_Source;
7626 -- An excluded file cannot also be an exception file name
7628 if Excluded_Sources_Htable.Get (Project.Excluded, Source.File) /=
7631 Error_Msg_File_1 := Source.File;
7634 "{ cannot be both excluded and an exception file name",
7635 No_Location, Project.Project);
7639 ("naming exception: adding source file to source_Names: ",
7640 Name_Id (Source.File));
7642 Source_Names_Htable.Set
7643 (Project.Source_Names,
7646 (Name => Source.File,
7647 Location => Source.Location,
7652 -- If this is an Ada exception, record in table Unit_Exceptions
7654 if Source.Unit /= No_Unit_Index then
7656 Unit_Except : Unit_Exception :=
7657 Unit_Exceptions_Htable.Get
7658 (Project.Unit_Exceptions, Source.Unit.Name);
7661 Unit_Except.Name := Source.Unit.Name;
7663 if Source.Kind = Spec then
7664 Unit_Except.Spec := Source.File;
7666 Unit_Except.Impl := Source.File;
7669 Unit_Exceptions_Htable.Set
7670 (Project.Unit_Exceptions, Source.Unit.Name, Unit_Except);
7676 end Load_Naming_Exceptions;
7678 ----------------------
7679 -- Look_For_Sources --
7680 ----------------------
7682 procedure Look_For_Sources
7683 (Project : in out Project_Processing_Data;
7684 Data : in out Tree_Processing_Data)
7686 Object_Files : Object_File_Names_Htable.Instance;
7687 Iter : Source_Iterator;
7690 procedure Check_Object (Src : Source_Id);
7691 -- Check if object file name of Src is already used in the project tree,
7692 -- and report an error if so.
7694 procedure Check_Object_Files;
7695 -- Check that no two sources of this project have the same object file
7697 procedure Mark_Excluded_Sources;
7698 -- Mark as such the sources that are declared as excluded
7700 procedure Check_Missing_Sources;
7701 -- Check whether one of the languages has no sources, and report an
7702 -- error when appropriate
7704 procedure Get_Sources_From_Source_Info;
7705 -- Get the source information from the tables that were created when a
7706 -- source info file was read.
7708 ---------------------------
7709 -- Check_Missing_Sources --
7710 ---------------------------
7712 procedure Check_Missing_Sources is
7713 Extending : constant Boolean :=
7714 Project.Project.Extends /= No_Project;
7715 Language : Language_Ptr;
7717 Alt_Lang : Language_List;
7718 Continuation : Boolean := False;
7719 Iter : Source_Iterator;
7721 if not Project.Project.Externally_Built
7722 and then not Extending
7724 Language := Project.Project.Languages;
7725 while Language /= No_Language_Index loop
7727 -- If there are no sources for this language, check if there
7728 -- are sources for which this is an alternate language.
7730 if Language.First_Source = No_Source
7731 and then (Data.Flags.Require_Sources_Other_Lang
7732 or else Language.Name = Name_Ada)
7734 Iter := For_Each_Source (In_Tree => Data.Tree,
7735 Project => Project.Project);
7737 Source := Element (Iter);
7738 exit Source_Loop when Source = No_Source
7739 or else Source.Language = Language;
7741 Alt_Lang := Source.Alternate_Languages;
7742 while Alt_Lang /= null loop
7743 exit Source_Loop when Alt_Lang.Language = Language;
7744 Alt_Lang := Alt_Lang.Next;
7748 end loop Source_Loop;
7750 if Source = No_Source then
7753 Get_Name_String (Language.Display_Name),
7755 Project.Source_List_File_Location,
7757 Continuation := True;
7761 Language := Language.Next;
7764 end Check_Missing_Sources;
7770 procedure Check_Object (Src : Source_Id) is
7774 Source := Object_File_Names_Htable.Get (Object_Files, Src.Object);
7776 -- We cannot just check on "Source /= Src", since we might have
7777 -- two different entries for the same file (and since that's
7778 -- the same file it is expected that it has the same object)
7780 if Source /= No_Source
7781 and then Source.Replaced_By = No_Source
7782 and then Source.Path /= Src.Path
7783 and then Is_Extending (Src.Project, Source.Project)
7785 Error_Msg_File_1 := Src.File;
7786 Error_Msg_File_2 := Source.File;
7789 "{ and { have the same object file name",
7790 No_Location, Project.Project);
7793 Object_File_Names_Htable.Set (Object_Files, Src.Object, Src);
7797 ---------------------------
7798 -- Mark_Excluded_Sources --
7799 ---------------------------
7801 procedure Mark_Excluded_Sources is
7802 Source : Source_Id := No_Source;
7803 Excluded : File_Found;
7807 -- Minor optimization: if there are no excluded files, no need to
7808 -- traverse the list of sources. We cannot however also check whether
7809 -- the existing exceptions have ".Found" set to True (indicating we
7810 -- found them before) because we need to do some final processing on
7811 -- them in any case.
7813 if Excluded_Sources_Htable.Get_First (Project.Excluded) /=
7816 Proj := Project.Project;
7817 while Proj /= No_Project loop
7818 Iter := For_Each_Source (Data.Tree, Proj);
7819 while Prj.Element (Iter) /= No_Source loop
7820 Source := Prj.Element (Iter);
7821 Excluded := Excluded_Sources_Htable.Get
7822 (Project.Excluded, Source.File);
7824 if Excluded /= No_File_Found then
7825 Source.In_Interfaces := False;
7826 Source.Locally_Removed := True;
7828 if Proj = Project.Project then
7829 Source.Suppressed := True;
7832 if Current_Verbosity = High then
7834 Write_Str ("removing file ");
7836 (Get_Name_String (Excluded.File)
7837 & " " & Get_Name_String (Source.Project.Name));
7840 Excluded_Sources_Htable.Remove
7841 (Project.Excluded, Source.File);
7847 Proj := Proj.Extends;
7851 -- If we have any excluded element left, that means we did not find
7854 Excluded := Excluded_Sources_Htable.Get_First (Project.Excluded);
7855 while Excluded /= No_File_Found loop
7856 if not Excluded.Found then
7858 -- Check if the file belongs to another imported project to
7859 -- provide a better error message.
7862 (In_Tree => Data.Tree,
7863 Project => Project.Project,
7864 In_Imported_Only => True,
7865 Base_Name => Excluded.File);
7867 Err_Vars.Error_Msg_File_1 := Excluded.File;
7869 if Src = No_Source then
7870 if Excluded.Excl_File = No_File then
7873 "unknown file {", Excluded.Location, Project.Project);
7879 Get_Name_String (Excluded.Excl_File) & ":" &
7880 No_Space_Img (Excluded.Excl_Line) &
7881 ": unknown file {", Excluded.Location, Project.Project);
7885 if Excluded.Excl_File = No_File then
7888 "cannot remove a source from an imported project: {",
7889 Excluded.Location, Project.Project);
7895 Get_Name_String (Excluded.Excl_File) & ":" &
7896 No_Space_Img (Excluded.Excl_Line) &
7897 ": cannot remove a source from an imported project: {",
7898 Excluded.Location, Project.Project);
7903 Excluded := Excluded_Sources_Htable.Get_Next (Project.Excluded);
7905 end Mark_Excluded_Sources;
7907 ------------------------
7908 -- Check_Object_Files --
7909 ------------------------
7911 procedure Check_Object_Files is
7912 Iter : Source_Iterator;
7914 Src_Ind : Source_File_Index;
7917 Iter := For_Each_Source (Data.Tree);
7919 Src_Id := Prj.Element (Iter);
7920 exit when Src_Id = No_Source;
7922 if Is_Compilable (Src_Id)
7923 and then Src_Id.Language.Config.Object_Generated
7924 and then Is_Extending (Project.Project, Src_Id.Project)
7926 if Src_Id.Unit = No_Unit_Index then
7927 if Src_Id.Kind = Impl then
7928 Check_Object (Src_Id);
7934 if Other_Part (Src_Id) = No_Source then
7935 Check_Object (Src_Id);
7942 if Other_Part (Src_Id) /= No_Source then
7943 Check_Object (Src_Id);
7946 -- Check if it is a subunit
7949 Sinput.P.Load_Project_File
7950 (Get_Name_String (Src_Id.Path.Display_Name));
7952 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
7953 Override_Kind (Src_Id, Sep);
7955 Check_Object (Src_Id);
7964 end Check_Object_Files;
7966 ----------------------------------
7967 -- Get_Sources_From_Source_Info --
7968 ----------------------------------
7970 procedure Get_Sources_From_Source_Info is
7971 Iter : Source_Info_Iterator;
7974 Lang_Id : Language_Ptr;
7977 Initialize (Iter, Project.Project.Name);
7980 Src := Source_Info_Of (Iter);
7982 exit when Src = No_Source_Info;
7984 Id := new Source_Data;
7986 Id.Project := Project.Project;
7988 Lang_Id := Project.Project.Languages;
7989 while Lang_Id /= No_Language_Index
7990 and then Lang_Id.Name /= Src.Language
7992 Lang_Id := Lang_Id.Next;
7995 if Lang_Id = No_Language_Index then
7997 ("unknown language " &
7998 Get_Name_String (Src.Language) &
8000 Get_Name_String (Src.Project) &
8001 " in source info file");
8004 Id.Language := Lang_Id;
8005 Id.Kind := Src.Kind;
8006 Id.Index := Src.Index;
8009 (Path_Name_Type (Src.Display_Path_Name),
8010 Path_Name_Type (Src.Path_Name));
8013 Add_Str_To_Name_Buffer
8014 (Directories.Simple_Name (Get_Name_String (Src.Path_Name)));
8015 Id.File := Name_Find;
8017 Id.Next_With_File_Name :=
8018 Source_Files_Htable.Get (Data.Tree.Source_Files_HT, Id.File);
8019 Source_Files_Htable.Set (Data.Tree.Source_Files_HT, Id.File, Id);
8022 Add_Str_To_Name_Buffer
8023 (Directories.Simple_Name
8024 (Get_Name_String (Src.Display_Path_Name)));
8025 Id.Display_File := Name_Find;
8028 Dependency_Name (Id.File, Id.Language.Config.Dependency_Kind);
8029 Id.Naming_Exception := Src.Naming_Exception;
8031 Object_Name (Id.File, Id.Language.Config.Object_File_Suffix);
8032 Id.Switches := Switches_Name (Id.File);
8034 -- Add the source id to the Unit_Sources_HT hash table, if the
8035 -- unit name is not null.
8037 if Src.Kind /= Sep and then Src.Unit_Name /= No_Name then
8040 UData : Unit_Index :=
8042 (Data.Tree.Units_HT, Src.Unit_Name);
8044 if UData = No_Unit_Index then
8045 UData := new Unit_Data;
8046 UData.Name := Src.Unit_Name;
8048 (Data.Tree.Units_HT, Src.Unit_Name, UData);
8054 -- Note that this updates Unit information as well
8056 Override_Kind (Id, Id.Kind);
8059 if Src.Index /= 0 then
8060 Project.Project.Has_Multi_Unit_Sources := True;
8063 -- Add the source to the language list
8065 Id.Next_In_Lang := Id.Language.First_Source;
8066 Id.Language.First_Source := Id;
8070 end Get_Sources_From_Source_Info;
8072 -- Start of processing for Look_For_Sources
8075 if Data.Tree.Source_Info_File_Exists then
8076 Get_Sources_From_Source_Info;
8079 if Project.Project.Source_Dirs /= Nil_String then
8080 Find_Excluded_Sources (Project, Data);
8082 if Project.Project.Languages /= No_Language_Index then
8083 Load_Naming_Exceptions (Project, Data);
8084 Find_Sources (Project, Data);
8085 Mark_Excluded_Sources;
8087 Check_Missing_Sources;
8091 Object_File_Names_Htable.Reset (Object_Files);
8093 end Look_For_Sources;
8099 function Path_Name_Of
8100 (File_Name : File_Name_Type;
8101 Directory : Path_Name_Type) return String
8103 Result : String_Access;
8104 The_Directory : constant String := Get_Name_String (Directory);
8107 Debug_Output ("Path_Name_Of file name=", Name_Id (File_Name));
8108 Debug_Output ("Path_Name_Of directory=", Name_Id (Directory));
8109 Get_Name_String (File_Name);
8112 (File_Name => Name_Buffer (1 .. Name_Len),
8113 Path => The_Directory);
8115 if Result = null then
8119 R : constant String := Result.all;
8131 procedure Remove_Source
8132 (Tree : Project_Tree_Ref;
8134 Replaced_By : Source_Id)
8139 if Current_Verbosity = High then
8141 Write_Str ("removing source ");
8142 Write_Str (Get_Name_String (Id.File));
8144 if Id.Index /= 0 then
8145 Write_Str (" at" & Id.Index'Img);
8151 if Replaced_By /= No_Source then
8152 Id.Replaced_By := Replaced_By;
8153 Replaced_By.Declared_In_Interfaces := Id.Declared_In_Interfaces;
8155 if Id.File /= Replaced_By.File then
8157 Replacement : constant File_Name_Type :=
8158 Replaced_Source_HTable.Get
8159 (Tree.Replaced_Sources, Id.File);
8162 Replaced_Source_HTable.Set
8163 (Tree.Replaced_Sources, Id.File, Replaced_By.File);
8165 if Replacement = No_File then
8166 Tree.Replaced_Source_Number :=
8167 Tree.Replaced_Source_Number + 1;
8173 Id.In_Interfaces := False;
8174 Id.Locally_Removed := True;
8176 -- ??? Should we remove the source from the unit ? The file is not used,
8177 -- so probably should not be referenced from the unit. On the other hand
8178 -- it might give useful additional info
8179 -- if Id.Unit /= null then
8180 -- Id.Unit.File_Names (Id.Kind) := null;
8183 Source := Id.Language.First_Source;
8186 Id.Language.First_Source := Id.Next_In_Lang;
8189 while Source.Next_In_Lang /= Id loop
8190 Source := Source.Next_In_Lang;
8193 Source.Next_In_Lang := Id.Next_In_Lang;
8197 -----------------------
8198 -- Report_No_Sources --
8199 -----------------------
8201 procedure Report_No_Sources
8202 (Project : Project_Id;
8204 Data : Tree_Processing_Data;
8205 Location : Source_Ptr;
8206 Continuation : Boolean := False)
8209 case Data.Flags.When_No_Sources is
8213 when Warning | Error =>
8215 Msg : constant String :=
8217 & Lang_Name & " sources in this project";
8220 Error_Msg_Warn := Data.Flags.When_No_Sources = Warning;
8222 if Continuation then
8223 Error_Msg (Data.Flags, "\" & Msg, Location, Project);
8225 Error_Msg (Data.Flags, Msg, Location, Project);
8229 end Report_No_Sources;
8231 ----------------------
8232 -- Show_Source_Dirs --
8233 ----------------------
8235 procedure Show_Source_Dirs
8236 (Project : Project_Id;
8237 Shared : Shared_Project_Tree_Data_Access)
8239 Current : String_List_Id;
8240 Element : String_Element;
8243 if Project.Source_Dirs = Nil_String then
8244 Debug_Output ("no Source_Dirs");
8246 Debug_Increase_Indent ("Source_Dirs:");
8248 Current := Project.Source_Dirs;
8249 while Current /= Nil_String loop
8250 Element := Shared.String_Elements.Table (Current);
8251 Debug_Output (Get_Name_String (Element.Display_Value));
8252 Current := Element.Next;
8255 Debug_Decrease_Indent ("end Source_Dirs.");
8257 end Show_Source_Dirs;
8259 ---------------------------
8260 -- Process_Naming_Scheme --
8261 ---------------------------
8263 procedure Process_Naming_Scheme
8264 (Tree : Project_Tree_Ref;
8265 Root_Project : Project_Id;
8266 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
8267 Flags : Processing_Flags)
8271 (Project : Project_Id;
8272 In_Aggregate_Lib : Boolean;
8273 Data : in out Tree_Processing_Data);
8274 -- Process the naming scheme for a single project
8276 procedure Recursive_Check
8277 (Project : Project_Id;
8278 Prj_Tree : Project_Tree_Ref;
8279 Context : Project_Context;
8280 Data : in out Tree_Processing_Data);
8281 -- Check_Naming_Scheme for the project
8288 (Project : Project_Id;
8289 In_Aggregate_Lib : Boolean;
8290 Data : in out Tree_Processing_Data)
8292 procedure Check_Aggregate
8293 (Project : Project_Id;
8294 Data : in out Tree_Processing_Data);
8295 -- Check the aggregate project attributes, reject any not supported
8298 procedure Check_Aggregated
8299 (Project : Project_Id;
8300 Data : in out Tree_Processing_Data);
8301 -- Check aggregated projects which should not be externally built.
8302 -- What is Data??? if same as outer Data, why passed???
8303 -- What exact check is performed here??? Seems a bad idea to have
8304 -- two procedures with such close names ???
8306 ---------------------
8307 -- Check_Aggregate --
8308 ---------------------
8310 procedure Check_Aggregate
8311 (Project : Project_Id;
8312 Data : in out Tree_Processing_Data)
8314 procedure Check_Not_Defined (Name : Name_Id);
8315 -- Report an error if Var is defined
8317 -----------------------
8318 -- Check_Not_Defined --
8319 -----------------------
8321 procedure Check_Not_Defined (Name : Name_Id) is
8322 Var : constant Prj.Variable_Value :=
8325 Project.Decl.Attributes,
8328 if not Var.Default then
8329 Error_Msg_Name_1 := Name;
8331 (Data.Flags, "wrong attribute %% in aggregate library",
8332 Var.Location, Project);
8334 end Check_Not_Defined;
8336 -- Start of processing for Check_Aggregate
8339 Check_Not_Defined (Snames.Name_Library_Dir);
8340 Check_Not_Defined (Snames.Name_Library_Interface);
8341 Check_Not_Defined (Snames.Name_Library_Name);
8342 Check_Not_Defined (Snames.Name_Library_Ali_Dir);
8343 Check_Not_Defined (Snames.Name_Library_Src_Dir);
8344 Check_Not_Defined (Snames.Name_Library_Options);
8345 Check_Not_Defined (Snames.Name_Library_Standalone);
8346 Check_Not_Defined (Snames.Name_Library_Kind);
8347 Check_Not_Defined (Snames.Name_Leading_Library_Options);
8348 Check_Not_Defined (Snames.Name_Library_Version);
8349 end Check_Aggregate;
8351 ----------------------
8352 -- Check_Aggregated --
8353 ----------------------
8355 procedure Check_Aggregated
8356 (Project : Project_Id;
8357 Data : in out Tree_Processing_Data)
8359 L : Aggregated_Project_List;
8362 -- Check that aggregated projects are not externally built
8364 L := Project.Aggregated_Projects;
8365 while L /= null loop
8367 Var : constant Prj.Variable_Value :=
8369 (Snames.Name_Externally_Built,
8370 L.Project.Decl.Attributes,
8373 if not Var.Default then
8374 Error_Msg_Name_1 := L.Project.Display_Name;
8377 "cannot aggregate externally build library %%",
8378 Var.Location, Project);
8384 end Check_Aggregated;
8388 Shared : constant Shared_Project_Tree_Data_Access :=
8390 Prj_Data : Project_Processing_Data;
8392 -- Start of processing for Check
8395 Debug_Increase_Indent ("check", Project.Name);
8397 Initialize (Prj_Data, Project);
8399 Check_If_Externally_Built (Project, Data);
8401 case Project.Qualifier is
8403 Check_Aggregated (Project, Data);
8405 when Aggregate_Library =>
8406 Check_Aggregated (Project, Data);
8408 if Project.Object_Directory = No_Path_Information then
8409 Project.Object_Directory := Project.Directory;
8413 Get_Directories (Project, Data);
8414 Check_Programming_Languages (Project, Data);
8416 if Current_Verbosity = High then
8417 Show_Source_Dirs (Project, Shared);
8420 if Project.Qualifier = Dry then
8421 Check_Abstract_Project (Project, Data);
8425 -- Check configuration. Must be done for gnatmake (even though no
8426 -- user configuration file was provided) since the default config we
8427 -- generate indicates whether libraries are supported for instance.
8429 Check_Configuration (Project, Data);
8431 -- For aggregate project check no library attributes are defined
8433 if Project.Qualifier = Aggregate then
8434 Check_Aggregate (Project, Data);
8437 Check_Library_Attributes (Project, Data);
8438 Check_Package_Naming (Project, Data);
8440 -- An aggregate library has no source, no need to look for them
8442 if Project.Qualifier /= Aggregate_Library then
8443 Look_For_Sources (Prj_Data, Data);
8446 Check_Interfaces (Project, Data);
8448 -- If this library is part of an aggregated library don't check it
8449 -- as it has no sources by itself and so interface won't be found.
8451 if Project.Library and not In_Aggregate_Lib then
8452 Check_Stand_Alone_Library (Project, Data);
8455 Get_Mains (Project, Data);
8460 Debug_Decrease_Indent ("done check");
8463 ---------------------
8464 -- Recursive_Check --
8465 ---------------------
8467 procedure Recursive_Check
8468 (Project : Project_Id;
8469 Prj_Tree : Project_Tree_Ref;
8470 Context : Project_Context;
8471 Data : in out Tree_Processing_Data)
8474 if Current_Verbosity = High then
8475 Debug_Increase_Indent
8476 ("Processing_Naming_Scheme for project", Project.Name);
8479 Data.Tree := Prj_Tree;
8480 Data.In_Aggregate_Lib := Context.In_Aggregate_Lib;
8482 Check (Project, Context.In_Aggregate_Lib, Data);
8484 if Current_Verbosity = High then
8485 Debug_Decrease_Indent ("done Processing_Naming_Scheme");
8487 end Recursive_Check;
8489 procedure Check_All_Projects is new For_Every_Project_Imported_Context
8490 (Tree_Processing_Data, Recursive_Check);
8491 -- Comment required???
8495 Data : Tree_Processing_Data;
8497 -- Start of processing for Process_Naming_Scheme
8500 Lib_Data_Table.Init;
8501 Initialize (Data, Tree => Tree, Node_Tree => Node_Tree, Flags => Flags);
8502 Check_All_Projects (Root_Project, Tree, Data, Imported_First => True);
8505 -- Adjust language configs for projects that are extended
8508 List : Project_List;
8511 Lang : Language_Ptr;
8512 Elng : Language_Ptr;
8515 List := Tree.Projects;
8516 while List /= null loop
8517 Proj := List.Project;
8520 while Exte.Extended_By /= No_Project loop
8521 Exte := Exte.Extended_By;
8524 if Exte /= Proj then
8525 Lang := Proj.Languages;
8527 if Lang /= No_Language_Index then
8529 Elng := Get_Language_From_Name
8530 (Exte, Get_Name_String (Lang.Name));
8531 exit when Elng /= No_Language_Index;
8532 Exte := Exte.Extends;
8535 if Elng /= Lang then
8536 Lang.Config := Elng.Config;
8544 end Process_Naming_Scheme;