1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2000-2014, 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
;
39 with Ada
.Characters
.Handling
; use Ada
.Characters
.Handling
;
40 with Ada
.Directories
; use Ada
.Directories
;
41 with Ada
.Strings
; use Ada
.Strings
;
42 with Ada
.Strings
.Fixed
; use Ada
.Strings
.Fixed
;
43 with Ada
.Strings
.Maps
.Constants
; use Ada
.Strings
.Maps
.Constants
;
45 with GNAT
.Case_Util
; use GNAT
.Case_Util
;
46 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
47 with GNAT
.Dynamic_HTables
;
48 with GNAT
.Regexp
; use GNAT
.Regexp
;
51 package body Prj
.Nmsc
is
53 No_Continuation_String
: aliased String := "";
54 Continuation_String
: aliased String := "\";
55 -- Used in Check_Library for continuation error messages at the same
58 type Name_Location is record
59 Name : File_Name_Type;
60 -- Key is duplicated, so that it is known when using functions Get_First
61 -- and Get_Next, as these functions only return an Element.
63 Location : Source_Ptr;
64 Source : Source_Id := No_Source;
65 Listed : Boolean := False;
66 Found : Boolean := False;
69 No_Name_Location : constant Name_Location :=
71 Location => No_Location,
76 package Source_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable
77 (Header_Num => Header_Num,
78 Element => Name_Location,
79 No_Element => No_Name_Location,
80 Key => File_Name_Type,
83 -- File name information found in string list attribute (Source_Files or
84 -- Source_List_File). Used to check that all referenced files were indeed
87 type Unit_Exception is record
89 -- Key is duplicated, so that it is known when using functions Get_First
90 -- and Get_Next, as these functions only return an Element.
92 Spec : File_Name_Type;
93 Impl : File_Name_Type;
96 No_Unit_Exception : constant Unit_Exception := (No_Name, No_File, No_File);
98 package Unit_Exceptions_Htable is new GNAT.Dynamic_HTables.Simple_HTable
99 (Header_Num => Header_Num,
100 Element => Unit_Exception,
101 No_Element => No_Unit_Exception,
105 -- Record special naming schemes for Ada units (name of spec file and name
106 -- of implementation file). The elements in this list come from the naming
107 -- exceptions specified in the project files.
109 type File_Found is record
110 File : File_Name_Type := No_File;
111 Excl_File : File_Name_Type := No_File;
112 Excl_Line : Natural := 0;
113 Found : Boolean := False;
114 Location : Source_Ptr := No_Location;
117 No_File_Found : constant File_Found :=
118 (No_File, No_File, 0, False, No_Location);
120 package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable
121 (Header_Num => Header_Num,
122 Element => File_Found,
123 No_Element => No_File_Found,
124 Key => File_Name_Type,
127 -- A hash table to store the base names of excluded files, if any
129 package Object_File_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable
130 (Header_Num => Header_Num,
131 Element => Source_Id,
132 No_Element => No_Source,
133 Key => File_Name_Type,
136 -- A hash table to store the object file names for a project, to check that
137 -- two different sources have different object file names.
139 type Project_Processing_Data is record
140 Project : Project_Id;
141 Source_Names : Source_Names_Htable.Instance;
142 Unit_Exceptions : Unit_Exceptions_Htable.Instance;
143 Excluded : Excluded_Sources_Htable.Instance;
145 Source_List_File_Location : Source_Ptr;
146 -- Location of the Source_List_File attribute, for error messages
148 -- This is similar to Tree_Processing_Data, but contains project-specific
149 -- information which is only useful while processing the project, and can
150 -- be discarded as soon as we have finished processing the project
152 type Tree_Processing_Data is record
153 Tree : Project_Tree_Ref;
154 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
155 Flags : Prj.Processing_Flags;
156 In_Aggregate_Lib : Boolean;
158 -- Temporary data which is needed while parsing a project. It does not need
159 -- to be kept in memory once a project has been fully loaded, but is
160 -- necessary while performing consistency checks (duplicate sources,...)
161 -- This data must be initialized before processing any project, and the
162 -- same data is used for processing all projects in the tree.
164 type Lib_Data is record
167 Tree : Project_Tree_Ref;
170 package Lib_Data_Table is new GNAT.Table
171 (Table_Component_Type => Lib_Data,
172 Table_Index_Type => Natural,
173 Table_Low_Bound => 1,
175 Table_Increment => 100);
176 -- A table to record library names in order to check that two library
177 -- projects do not have the same library names.
180 (Data : out Tree_Processing_Data;
181 Tree : Project_Tree_Ref;
182 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
183 Flags : Prj.Processing_Flags);
186 procedure Free (Data : in out Tree_Processing_Data);
187 -- Free the memory occupied by Data
190 (Data : in out Project_Processing_Data;
191 Project : Project_Id);
192 procedure Free (Data : in out Project_Processing_Data);
193 -- Initialize or free memory for a project-specific data
195 procedure Find_Excluded_Sources
196 (Project : in out Project_Processing_Data;
197 Data : in out Tree_Processing_Data);
198 -- Find the list of files that should not be considered as source files
199 -- for this project. Sets the list in the Project.Excluded_Sources_Htable.
201 procedure Override_Kind (Source : Source_Id; Kind : Source_Kind);
202 -- Override the reference kind for a source file. This properly updates
203 -- the unit data if necessary.
205 procedure Load_Naming_Exceptions
206 (Project : in out Project_Processing_Data;
207 Data : in out Tree_Processing_Data);
208 -- All source files in Data.First_Source are considered as naming
209 -- exceptions, and copied into the Source_Names and Unit_Exceptions tables
212 type Search_Type is (Search_Files, Search_Directories);
215 with procedure Callback
216 (Path : Path_Information;
217 Pattern_Index : Natural);
218 procedure Expand_Subdirectory_Pattern
219 (Project : Project_Id;
220 Data : in out Tree_Processing_Data;
221 Patterns : String_List_Id;
222 Ignore : String_List_Id;
223 Search_For : Search_Type;
224 Resolve_Links : Boolean);
225 -- Search the subdirectories of Project's directory for files or
226 -- directories that match the globbing patterns found in Patterns (for
227 -- instance "**/*.adb
"). Typically, Patterns will be the value of the
228 -- Source_Dirs or Excluded_Source_Dirs attributes.
230 -- Every time such a file or directory is found, the callback is called.
231 -- Resolve_Links indicates whether we should resolve links while
232 -- normalizing names.
234 -- In the callback, Pattern_Index is the index within Patterns where the
235 -- expanded pattern was found (1 for the first element of Patterns and
236 -- all its matching directories, then 2,...).
238 -- We use a generic and not an access-to-subprogram because in some cases
239 -- this code is compiled with the restriction No_Implicit_Dynamic_Code.
240 -- An error message is raised if a pattern does not match any file.
244 Data : in out Tree_Processing_Data;
245 Project : Project_Id;
246 Source_Dir_Rank : Natural;
247 Lang_Id : Language_Ptr;
249 File_Name : File_Name_Type;
250 Display_File : File_Name_Type;
251 Naming_Exception : Naming_Exception_Type := No;
252 Path : Path_Information := No_Path_Information;
253 Alternate_Languages : Language_List := null;
254 Unit : Name_Id := No_Name;
256 Locally_Removed : Boolean := False;
257 Location : Source_Ptr := No_Location);
258 -- Add a new source to the different lists: list of all sources in the
259 -- project tree, list of source of a project and list of sources of a
260 -- language. If Path is specified, the file is also added to
261 -- Source_Paths_HT. Location is used for error messages
263 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type;
264 -- Same as Osint.Canonical_Case_File_Name but applies to Name_Id.
265 -- This alters Name_Buffer.
267 function Suffix_Matches
269 Suffix : File_Name_Type) return Boolean;
270 -- True if the file name ends with the given suffix. Always returns False
271 -- if Suffix is No_Name.
273 procedure Replace_Into_Name_Buffer
276 Replacement : Character);
277 -- Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is
278 -- converted to lower-case at the same time.
280 procedure Check_Abstract_Project
281 (Project : Project_Id;
282 Data : in out Tree_Processing_Data);
283 -- Check abstract projects attributes
285 procedure Check_Configuration
286 (Project : Project_Id;
287 Data : in out Tree_Processing_Data);
288 -- Check the configuration attributes for the project
290 procedure Check_If_Externally_Built
291 (Project : Project_Id;
292 Data : in out Tree_Processing_Data);
293 -- Check attribute Externally_Built of project Project in project tree
294 -- Data.Tree and modify its data Data if it has the value "true".
296 procedure Check_Interfaces
297 (Project : Project_Id;
298 Data : in out Tree_Processing_Data);
299 -- If a list of sources is specified in attribute Interfaces, set
300 -- In_Interfaces only for the sources specified in the list.
302 procedure Check_Library_Attributes
303 (Project : Project_Id;
304 Data : in out Tree_Processing_Data);
305 -- Check the library attributes of project Project in project tree
306 -- and modify its data Data accordingly.
308 procedure Check_Package_Naming
309 (Project : Project_Id;
310 Data : in out Tree_Processing_Data);
311 -- Check the naming scheme part of Data, and initialize the naming scheme
312 -- data in the config of the various languages.
314 procedure Check_Programming_Languages
315 (Project : Project_Id;
316 Data : in out Tree_Processing_Data);
317 -- Check attribute Languages for the project with data Data in project
318 -- tree Data.Tree and set the components of Data for all the programming
319 -- languages indicated in attribute Languages, if any.
321 procedure Check_Stand_Alone_Library
322 (Project : Project_Id;
323 Data : in out Tree_Processing_Data);
324 -- Check if project Project in project tree Data.Tree is a Stand-Alone
325 -- Library project, and modify its data Data accordingly if it is one.
327 procedure Check_Unit_Name (Name : String; Unit : out Name_Id);
328 -- Check that a name is a valid unit name
330 function Compute_Directory_Last (Dir : String) return Natural;
331 -- Return the index of the last significant character in Dir. This is used
332 -- to avoid duplicate '/' (slash) characters at the end of directory names.
334 procedure Search_Directories
335 (Project : in out Project_Processing_Data;
336 Data : in out Tree_Processing_Data;
337 For_All_Sources : Boolean);
338 -- Search the source directories to find the sources. If For_All_Sources is
339 -- True, check each regular file name against the naming schemes of the
340 -- various languages. Otherwise consider only the file names in hash table
341 -- Source_Names. If Allow_Duplicate_Basenames then files with identical
342 -- base names are permitted within a project for source-based languages
343 -- (never for unit based languages).
346 (Project : in out Project_Processing_Data;
347 Data : in out Tree_Processing_Data;
348 Source_Dir_Rank : Natural;
349 Path : Path_Name_Type;
350 Display_Path : Path_Name_Type;
351 File_Name : File_Name_Type;
352 Display_File_Name : File_Name_Type;
353 Locally_Removed : Boolean;
354 For_All_Sources : Boolean);
355 -- Check if file File_Name is a valid source of the project. This is used
356 -- in multi-language mode only. When the file matches one of the naming
357 -- schemes, it is added to various htables through Add_Source and to
358 -- Source_Paths_Htable.
360 -- File_Name is the same as Display_File_Name, but has been normalized.
361 -- They do not include the directory information.
363 -- Path and Display_Path on the other hand are the full path to the file.
364 -- Path must have been normalized (canonical casing and possibly links
367 -- Source_Directory is the directory in which the file was found. It is
368 -- neither normalized nor has had links resolved, and must not end with a
369 -- a directory separator, to avoid duplicates later on.
371 -- If For_All_Sources is True, then all possible file names are analyzed
372 -- otherwise only those currently set in the Source_Names hash table.
374 procedure Check_File_Naming_Schemes
375 (Project : Project_Processing_Data;
376 File_Name : File_Name_Type;
377 Alternate_Languages : out Language_List;
378 Language : out Language_Ptr;
379 Display_Language_Name : out Name_Id;
381 Lang_Kind : out Language_Kind;
382 Kind : out Source_Kind);
383 -- Check if the file name File_Name conforms to one of the naming schemes
384 -- of the project. If the file does not match one of the naming schemes,
385 -- set Language to No_Language_Index. Filename is the name of the file
386 -- being investigated. It has been normalized (case-folded). File_Name is
389 procedure Get_Directories
390 (Project : Project_Id;
391 Data : in out Tree_Processing_Data);
392 -- Get the object directory, the exec directory and the source directories
396 (Project : Project_Id;
397 Data : in out Tree_Processing_Data);
398 -- Get the mains of a project from attribute Main, if it exists, and put
399 -- them in the project data.
401 procedure Get_Sources_From_File
403 Location : Source_Ptr;
404 Project : in out Project_Processing_Data;
405 Data : in out Tree_Processing_Data);
406 -- Get the list of sources from a text file and put them in hash table
409 procedure Find_Sources
410 (Project : in out Project_Processing_Data;
411 Data : in out Tree_Processing_Data);
412 -- Process the Source_Files and Source_List_File attributes, and store the
413 -- list of source files into the Source_Names htable. When these attributes
414 -- are not defined, find all files matching the naming schemes in the
415 -- source directories. If Allow_Duplicate_Basenames, then files with the
416 -- same base names are authorized within a project for source-based
417 -- languages (never for unit based languages)
419 procedure Compute_Unit_Name
420 (File_Name : File_Name_Type;
421 Naming : Lang_Naming_Data;
422 Kind : out Source_Kind;
424 Project : Project_Processing_Data);
425 -- Check whether the file matches the naming scheme. If it does,
426 -- compute its unit name. If Unit is set to No_Name on exit, none of the
427 -- other out parameters are relevant.
429 procedure Check_Illegal_Suffix
430 (Project : Project_Id;
431 Suffix : File_Name_Type;
432 Dot_Replacement : File_Name_Type;
433 Attribute_Name : String;
434 Location : Source_Ptr;
435 Data : in out Tree_Processing_Data);
436 -- Display an error message if the given suffix is illegal for some reason.
437 -- The name of the attribute we are testing is specified in Attribute_Name,
438 -- which is used in the error message. Location is the location where the
439 -- suffix is defined.
441 procedure Locate_Directory
442 (Project : Project_Id;
443 Name : File_Name_Type;
444 Path : out Path_Information;
445 Dir_Exists : out Boolean;
446 Data : in out Tree_Processing_Data;
447 Create : String := "";
448 Location : Source_Ptr := No_Location;
449 Must_Exist : Boolean := True;
450 Externally_Built : Boolean := False);
451 -- Locate a directory. Name is the directory name. Relative paths are
452 -- resolved relative to the project's directory. If the directory does not
453 -- exist and Setup_Projects is True and Create is a non null string, an
454 -- attempt is made to create the directory. If the directory does not
455 -- exist, it is either created if Setup_Projects is False (and then
456 -- returned), or simply returned without checking for its existence (if
457 -- Must_Exist is False) or No_Path_Information is returned. In all cases,
458 -- Dir_Exists indicates whether the directory now exists. Create is also
459 -- used for debugging traces to show which path we are computing.
461 procedure Look_For_Sources
462 (Project : in out Project_Processing_Data;
463 Data : in out Tree_Processing_Data);
464 -- Find all the sources of project Project in project tree Data.Tree and
465 -- update its Data accordingly. This assumes that the special naming
466 -- exceptions have already been processed.
468 function Path_Name_Of
469 (File_Name : File_Name_Type;
470 Directory : Path_Name_Type) return String;
471 -- Returns the path name of a (non project) file. Returns an empty string
472 -- if file cannot be found.
474 procedure Remove_Source
475 (Tree : Project_Tree_Ref;
477 Replaced_By : Source_Id);
478 -- Remove a file from the list of sources of a project. This might be
479 -- because the file is replaced by another one in an extending project,
480 -- or because a file was added as a naming exception but was not found
483 procedure Report_No_Sources
484 (Project : Project_Id;
486 Data : Tree_Processing_Data;
487 Location : Source_Ptr;
488 Continuation : Boolean := False);
489 -- Report an error or a warning depending on the value of When_No_Sources
490 -- when there are no sources for language Lang_Name.
492 procedure Show_Source_Dirs
493 (Project : Project_Id;
494 Shared : Shared_Project_Tree_Data_Access);
495 -- List all the source directories of a project
497 procedure Write_Attr (Name, Value : String);
498 -- Debug print a value for a specific property. Does nothing when not in
501 procedure Error_Or_Warning
502 (Flags : Processing_Flags;
503 Kind : Error_Warning;
505 Location : Source_Ptr;
506 Project : Project_Id);
507 -- Emits either an error or warning message (or nothing), depending on Kind
509 function No_Space_Img (N : Natural) return String;
510 -- Image of a Natural without the initial space
512 ----------------------
513 -- Error_Or_Warning --
514 ----------------------
516 procedure Error_Or_Warning
517 (Flags : Processing_Flags;
518 Kind : Error_Warning;
520 Location : Source_Ptr;
521 Project : Project_Id) is
524 when Error => Error_Msg (Flags, Msg, Location, Project);
525 when Warning => Error_Msg (Flags, "?
" & Msg, Location, Project);
528 end Error_Or_Warning;
530 ------------------------------
531 -- Replace_Into_Name_Buffer --
532 ------------------------------
534 procedure Replace_Into_Name_Buffer
537 Replacement : Character)
539 Max : constant Integer := Str'Last - Pattern'Length + 1;
546 while J <= Str'Last loop
547 Name_Len := Name_Len + 1;
549 if J <= Max and then Str (J .. J + Pattern'Length - 1) = Pattern then
550 Name_Buffer (Name_Len) := Replacement;
551 J := J + Pattern'Length;
553 Name_Buffer (Name_Len) := GNAT.Case_Util.To_Lower (Str (J));
557 end Replace_Into_Name_Buffer;
563 function Suffix_Matches
565 Suffix : File_Name_Type) return Boolean
567 Min_Prefix_Length : Natural := 0;
570 if Suffix = No_File or else Suffix = Empty_File then
575 Suf : String := Get_Name_String (Suffix);
578 -- On non case-sensitive systems, use proper suffix casing
580 Canonical_Case_File_Name (Suf);
582 -- The file name must end with the suffix (which is not an extension)
583 -- For instance a suffix "configure
.in" must match a file with the
584 -- same name. To avoid dummy cases, though, a suffix starting with
585 -- '.' requires a file that is at least one character longer ('.cpp'
586 -- should not match a file with the same name).
588 if Suf (Suf'First) = '.' then
589 Min_Prefix_Length := 1;
592 return Filename'Length >= Suf'Length + Min_Prefix_Length
594 Filename (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;
602 procedure Write_Attr (Name, Value : String) is
604 if Current_Verbosity = High then
605 Debug_Output (Name & " = """ & Value & '"');
615 Data : in out Tree_Processing_Data;
616 Project : Project_Id;
617 Source_Dir_Rank : Natural;
618 Lang_Id : Language_Ptr;
620 File_Name : File_Name_Type;
621 Display_File : File_Name_Type;
622 Naming_Exception : Naming_Exception_Type := No;
623 Path : Path_Information := No_Path_Information;
624 Alternate_Languages : Language_List := null;
625 Unit : Name_Id := No_Name;
627 Locally_Removed : Boolean := False;
628 Location : Source_Ptr := No_Location)
630 Config : constant Language_Config := Lang_Id.Config;
634 Prev_Unit : Unit_Index := No_Unit_Index;
635 Source_To_Replace : Source_Id := No_Source;
638 -- Check if the same file name or unit is used in the prj tree
642 if Unit /= No_Name then
643 Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit);
646 if Prev_Unit /= No_Unit_Index
647 and then (Kind = Impl or else Kind = Spec)
648 and then Prev_Unit.File_Names (Kind) /= null
650 -- Suspicious, we need to check later whether this is authorized
653 Source := Prev_Unit.File_Names (Kind);
656 Source := Source_Files_Htable.Get
657 (Data.Tree.Source_Files_HT, File_Name);
659 if Source /= No_Source and then Source.Index = Index then
664 -- Always add the source if it is locally removed, to avoid incorrect
667 if Locally_Removed then
670 -- A locally removed source may first replace a source in a project
673 if Source /= No_Source
674 and then Is_Extending (Project, Source.Project)
675 and then Naming_Exception /= Inherited
677 Source_To_Replace := Source;
681 -- Duplication of file/unit in same project is allowed if order of
682 -- source directories is known, or if there is no compiler for the
685 if Add_Src = False then
688 if Project = Source.Project then
689 if Prev_Unit = No_Unit_Index then
690 if Data.Flags.Allow_Duplicate_Basenames then
693 elsif Lang_Id.Config.Compiler_Driver = Empty_File then
696 elsif Source_Dir_Rank /= Source.Source_Dir_Rank then
700 Error_Msg_File_1 := File_Name;
702 (Data.Flags, "duplicate source file name {",
708 if Source_Dir_Rank /= Source.Source_Dir_Rank then
711 -- We might be seeing the same file through a different
712 -- path (for instance because of symbolic links).
714 elsif Source.Path.Name /= Path.Name then
715 if not Source.Duplicate_Unit then
716 Error_Msg_Name_1 := Unit;
719 "\duplicate unit %%",
722 Source.Duplicate_Unit := True;
729 -- Do not allow the same unit name in different projects,
730 -- except if one is extending the other.
732 -- For a file based language, the same file name replaces a
733 -- file in a project being extended, but it is allowed to have
734 -- the same file name in unrelated projects.
736 elsif Is_Extending (Project, Source.Project) then
737 if not Locally_Removed and then Naming_Exception /= Inherited
739 Source_To_Replace := Source;
742 elsif Prev_Unit /= No_Unit_Index
743 and then Prev_Unit.File_Names (Kind) /= null
744 and then not Source.Locally_Removed
745 and then Source.Replaced_By = No_Source
746 and then not Data.In_Aggregate_Lib
748 -- Path is set if this is a source we found on the disk, in
749 -- which case we can provide more explicit error message. Path
750 -- is unset when the source is added from one of the naming
751 -- exceptions in the project.
753 if Path /= No_Path_Information then
754 Error_Msg_Name_1 := Unit;
757 "unit %% cannot belong to several projects",
760 Error_Msg_Name_1 := Project.Name;
761 Error_Msg_Name_2 := Name_Id (Path.Display_Name);
763 (Data.Flags, "\ project %%, %%", Location, Project);
765 Error_Msg_Name_1 := Source.Project.Name;
766 Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);
768 (Data.Flags, "\ project %%, %%", Location, Project);
771 Error_Msg_Name_1 := Unit;
772 Error_Msg_Name_2 := Source.Project.Name;
774 (Data.Flags, "unit %% already belongs to project %%",
780 elsif not Source.Locally_Removed
781 and then Source.Replaced_By /= No_Source
782 and then not Data.Flags.Allow_Duplicate_Basenames
783 and then Lang_Id.Config.Kind = Unit_Based
784 and then Source.Language.Config.Kind = Unit_Based
785 and then not Data.In_Aggregate_Lib
787 Error_Msg_File_1 := File_Name;
788 Error_Msg_File_2 := File_Name_Type (Source.Project.Name);
791 "{ is already a source of project {", Location, Project);
793 -- Add the file anyway, to avoid further warnings like
794 -- "language unknown".
807 Id := new Source_Data;
809 if Current_Verbosity = High then
811 Write_Str ("adding source File: ");
812 Write_Str (Get_Name_String (Display_File));
815 Write_Str (" at" & Index'Img);
818 if Lang_Id.Config.Kind = Unit_Based then
819 Write_Str (" Unit: ");
821 -- ??? in gprclean, it seems we sometimes pass an empty Unit name
822 -- (see test extended_projects).
824 if Unit /= No_Name then
825 Write_Str (Get_Name_String (Unit));
828 Write_Str (" Kind: ");
829 Write_Str (Source_Kind'Image (Kind));
835 Id.Project := Project;
836 Id.Location := Location;
837 Id.Source_Dir_Rank := Source_Dir_Rank;
838 Id.Language := Lang_Id;
840 Id.Alternate_Languages := Alternate_Languages;
841 Id.Locally_Removed := Locally_Removed;
843 Id.File := File_Name;
844 Id.Display_File := Display_File;
845 Id.Dep_Name := Dependency_Name
846 (File_Name, Lang_Id.Config.Dependency_Kind);
847 Id.Naming_Exception := Naming_Exception;
848 Id.Object := Object_Name
849 (File_Name, Config.Object_File_Suffix);
850 Id.Switches := Switches_Name (File_Name);
852 -- Add the source id to the Unit_Sources_HT hash table, if the unit name
855 if Unit /= No_Name then
857 -- Note: we might be creating a dummy unit here, when we in fact have
858 -- a separate. For instance, file file-bar.adb will initially be
859 -- assumed to be the IMPL of unit "file.bar". Only later on (in
860 -- Check_Object_Files) will we parse those units that only have an
861 -- impl and no spec to make sure whether we have a Separate in fact
862 -- (that significantly reduces the number of times we need to parse
863 -- the files, since we are then only interested in those with no
864 -- spec). We still need those dummy units in the table, since that's
865 -- the name we find in the ALI file
867 UData := Units_Htable.Get (Data.Tree.Units_HT, Unit);
869 if UData = No_Unit_Index then
870 UData := new Unit_Data;
873 if Naming_Exception /= Inherited then
874 Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
880 -- Note that this updates Unit information as well
882 if Naming_Exception /= Inherited and then not Locally_Removed then
883 Override_Kind (Id, Kind);
887 if Path /= No_Path_Information then
889 Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id);
892 Id.Next_With_File_Name :=
893 Source_Files_Htable.Get (Data.Tree.Source_Files_HT, File_Name);
894 Source_Files_Htable.Set (Data.Tree.Source_Files_HT, File_Name, Id);
897 Project.Has_Multi_Unit_Sources := True;
900 -- Add the source to the language list
902 Id.Next_In_Lang := Lang_Id.First_Source;
903 Lang_Id.First_Source := Id;
905 if Source_To_Replace /= No_Source then
906 Remove_Source (Data.Tree, Source_To_Replace, Id);
909 if Data.Tree.Replaced_Source_Number > 0
911 Replaced_Source_HTable.Get
912 (Data.Tree.Replaced_Sources, Id.File) /= No_File
914 Replaced_Source_HTable.Remove (Data.Tree.Replaced_Sources, Id.File);
915 Data.Tree.Replaced_Source_Number :=
916 Data.Tree.Replaced_Source_Number - 1;
920 ------------------------------
921 -- Canonical_Case_File_Name --
922 ------------------------------
924 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type is
926 if Osint.File_Names_Case_Sensitive then
927 return File_Name_Type (Name);
929 Get_Name_String (Name);
930 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
933 end Canonical_Case_File_Name;
935 ---------------------------------
936 -- Process_Aggregated_Projects --
937 ---------------------------------
939 procedure Process_Aggregated_Projects
940 (Tree : Project_Tree_Ref;
941 Project : Project_Id;
942 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
943 Flags : Processing_Flags)
945 Data : Tree_Processing_Data :=
947 Node_Tree => Node_Tree,
949 In_Aggregate_Lib => False);
951 Project_Files : constant Prj.Variable_Value :=
953 (Snames.Name_Project_Files,
954 Project.Decl.Attributes,
957 Project_Path_For_Aggregate : Prj.Env.Project_Search_Path;
959 procedure Found_Project_File (Path : Path_Information; Rank : Natural);
960 -- Called for each project file aggregated by Project
962 procedure Expand_Project_Files is
963 new Expand_Subdirectory_Pattern (Callback => Found_Project_File);
964 -- Search for all project files referenced by the patterns given in
965 -- parameter. Calls Found_Project_File for each of them.
967 ------------------------
968 -- Found_Project_File --
969 ------------------------
971 procedure Found_Project_File (Path : Path_Information; Rank : Natural) is
972 pragma Unreferenced (Rank);
975 if Path.Name /= Project.Path.Name then
976 Debug_Output ("aggregates: ", Name_Id (Path.Display_Name));
978 -- For usual "with" statement, this phase will have been done when
979 -- parsing the project itself. However, for aggregate projects, we
980 -- can only do this when processing the aggregate project, since
981 -- the exact list of project files or project directories can
982 -- depend on scenario variables.
984 -- We only load the projects explicitly here, but do not process
985 -- them. For the processing, Prj.Proc will take care of processing
986 -- them, within the same call to Recursive_Process (thus avoiding
987 -- the processing of a given project multiple times).
989 -- ??? We might already have loaded the project
991 Add_Aggregated_Project (Project, Path => Path.Name);
994 Debug_Output ("pattern returned the aggregate itself, ignored");
996 end Found_Project_File;
998 -- Start of processing for Check_Aggregate_Project
1001 pragma Assert (Project.Qualifier in Aggregate_Project);
1003 if Project_Files.Default then
1004 Error_Msg_Name_1 := Snames.Name_Project_Files;
1007 "Attribute %% must be specified in aggregate project",
1008 Project.Location, Project);
1012 -- The aggregated projects are only searched relative to the directory
1013 -- of the aggregate project, not in the default project path.
1015 Initialize_Empty (Project_Path_For_Aggregate);
1017 Free (Project.Aggregated_Projects);
1019 -- Look for aggregated projects. For similarity with source files and
1020 -- dirs, the aggregated project files are not searched for on the
1021 -- project path, and are only found through the path specified in
1022 -- the Project_Files attribute.
1024 Expand_Project_Files
1025 (Project => Project,
1027 Patterns => Project_Files.Values,
1028 Ignore => Nil_String,
1029 Search_For => Search_Files,
1030 Resolve_Links => Opt.Follow_Links_For_Files);
1032 Free (Project_Path_For_Aggregate);
1033 end Process_Aggregated_Projects;
1035 ----------------------------
1036 -- Check_Abstract_Project --
1037 ----------------------------
1039 procedure Check_Abstract_Project
1040 (Project : Project_Id;
1041 Data : in out Tree_Processing_Data)
1043 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
1045 Source_Dirs : constant Variable_Value :=
1048 Project.Decl.Attributes, Shared);
1049 Source_Files : constant Variable_Value :=
1052 Project.Decl.Attributes, Shared);
1053 Source_List_File : constant Variable_Value :=
1055 (Name_Source_List_File,
1056 Project.Decl.Attributes, Shared);
1057 Languages : constant Variable_Value :=
1060 Project.Decl.Attributes, Shared);
1063 if Project.Source_Dirs /= Nil_String then
1064 if Source_Dirs.Values = Nil_String
1065 and then Source_Files.Values = Nil_String
1066 and then Languages.Values = Nil_String
1067 and then Source_List_File.Default
1069 Project.Source_Dirs := Nil_String;
1074 "at least one of Source_Files, Source_Dirs or Languages "
1075 & "must be declared empty for an abstract project",
1076 Project.Location, Project);
1079 end Check_Abstract_Project;
1081 -------------------------
1082 -- Check_Configuration --
1083 -------------------------
1085 procedure Check_Configuration
1086 (Project : Project_Id;
1087 Data : in out Tree_Processing_Data)
1089 Shared : constant Shared_Project_Tree_Data_Access :=
1092 Dot_Replacement : File_Name_Type := No_File;
1093 Casing : Casing_Type := All_Lower_Case;
1094 Separate_Suffix : File_Name_Type := No_File;
1096 Lang_Index : Language_Ptr := No_Language_Index;
1097 -- The index of the language data being checked
1099 Prev_Index : Language_Ptr := No_Language_Index;
1100 -- The index of the previous language
1102 procedure Process_Project_Level_Simple_Attributes;
1103 -- Process the simple attributes at the project level
1105 procedure Process_Project_Level_Array_Attributes;
1106 -- Process the associate array attributes at the project level
1108 procedure Process_Packages;
1109 -- Read the packages of the project
1111 ----------------------
1112 -- Process_Packages --
1113 ----------------------
1115 procedure Process_Packages is
1116 Packages : Package_Id;
1117 Element : Package_Element;
1119 procedure Process_Binder (Arrays : Array_Id);
1120 -- Process the associated array attributes of package Binder
1122 procedure Process_Builder (Attributes : Variable_Id);
1123 -- Process the simple attributes of package Builder
1125 procedure Process_Clean (Attributes : Variable_Id);
1126 -- Process the simple attributes of package Clean
1128 procedure Process_Clean (Arrays : Array_Id);
1129 -- Process the associated array attributes of package Clean
1131 procedure Process_Compiler (Arrays : Array_Id);
1132 -- Process the associated array attributes of package Compiler
1134 procedure Process_Naming (Attributes : Variable_Id);
1135 -- Process the simple attributes of package Naming
1137 procedure Process_Naming (Arrays : Array_Id);
1138 -- Process the associated array attributes of package Naming
1140 procedure Process_Linker (Attributes : Variable_Id);
1141 -- Process the simple attributes of package Linker of a
1142 -- configuration project.
1144 --------------------
1145 -- Process_Binder --
1146 --------------------
1148 procedure Process_Binder (Arrays : Array_Id) is
1149 Current_Array_Id : Array_Id;
1150 Current_Array : Array_Data;
1151 Element_Id : Array_Element_Id;
1152 Element : Array_Element;
1155 -- Process the associative array attribute of package Binder
1157 Current_Array_Id := Arrays;
1158 while Current_Array_Id /= No_Array loop
1159 Current_Array := Shared.Arrays.Table (Current_Array_Id);
1161 Element_Id := Current_Array.Value;
1162 while Element_Id /= No_Array_Element loop
1163 Element := Shared.Array_Elements.Table (Element_Id);
1165 if Element.Index /= All_Other_Names then
1167 -- Get the name of the language
1170 Get_Language_From_Name
1171 (Project, Get_Name_String (Element.Index));
1173 if Lang_Index /= No_Language_Index then
1174 case Current_Array.Name is
1177 -- Attribute Driver (<language>)
1179 Lang_Index.Config.Binder_Driver :=
1180 File_Name_Type (Element.Value.Value);
1182 when Name_Required_Switches =>
1185 Lang_Index.Config.Binder_Required_Switches,
1186 From_List => Element.Value.Values,
1187 In_Tree => Data.Tree);
1191 -- Attribute Prefix (<language>)
1193 Lang_Index.Config.Binder_Prefix :=
1194 Element.Value.Value;
1196 when Name_Objects_Path =>
1198 -- Attribute Objects_Path (<language>)
1200 Lang_Index.Config.Objects_Path :=
1201 Element.Value.Value;
1203 when Name_Objects_Path_File =>
1205 -- Attribute Objects_Path (<language>)
1207 Lang_Index.Config.Objects_Path_File :=
1208 Element.Value.Value;
1216 Element_Id := Element.Next;
1219 Current_Array_Id := Current_Array.Next;
1223 ---------------------
1224 -- Process_Builder --
1225 ---------------------
1227 procedure Process_Builder (Attributes : Variable_Id) is
1228 Attribute_Id : Variable_Id;
1229 Attribute : Variable;
1232 -- Process non associated array attribute from package Builder
1234 Attribute_Id := Attributes;
1235 while Attribute_Id /= No_Variable loop
1236 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1238 if not Attribute.Value.Default then
1239 if Attribute.Name = Name_Executable_Suffix then
1241 -- Attribute Executable_Suffix: the suffix of the
1244 Project.Config.Executable_Suffix :=
1245 Attribute.Value.Value;
1249 Attribute_Id := Attribute.Next;
1251 end Process_Builder;
1257 procedure Process_Clean (Attributes : Variable_Id) is
1258 Attribute_Id : Variable_Id;
1259 Attribute : Variable;
1260 List : String_List_Id;
1263 -- Process non associated array attributes from package Clean
1265 Attribute_Id := Attributes;
1266 while Attribute_Id /= No_Variable loop
1267 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1269 if not Attribute.Value.Default then
1270 if Attribute.Name = Name_Artifacts_In_Exec_Dir then
1272 -- Attribute Artifacts_In_Exec_Dir: the list of file
1273 -- names to be cleaned in the exec dir of the main
1276 List := Attribute.Value.Values;
1278 if List /= Nil_String then
1280 Project.Config.Artifacts_In_Exec_Dir,
1282 In_Tree => Data.Tree);
1285 elsif Attribute.Name = Name_Artifacts_In_Object_Dir then
1287 -- Attribute Artifacts_In_Exec_Dir: the list of file
1288 -- names to be cleaned in the object dir of every
1291 List := Attribute.Value.Values;
1293 if List /= Nil_String then
1295 Project.Config.Artifacts_In_Object_Dir,
1297 In_Tree => Data.Tree);
1302 Attribute_Id := Attribute.Next;
1306 procedure Process_Clean (Arrays : Array_Id) is
1307 Current_Array_Id : Array_Id;
1308 Current_Array : Array_Data;
1309 Element_Id : Array_Element_Id;
1310 Element : Array_Element;
1311 List : String_List_Id;
1314 -- Process the associated array attributes of package Clean
1316 Current_Array_Id := Arrays;
1317 while Current_Array_Id /= No_Array loop
1318 Current_Array := Shared.Arrays.Table (Current_Array_Id);
1320 Element_Id := Current_Array.Value;
1321 while Element_Id /= No_Array_Element loop
1322 Element := Shared.Array_Elements.Table (Element_Id);
1324 -- Get the name of the language
1327 Get_Language_From_Name
1328 (Project, Get_Name_String (Element.Index));
1330 if Lang_Index /= No_Language_Index then
1331 case Current_Array.Name is
1333 -- Attribute Object_Artifact_Extensions (<language>)
1335 when Name_Object_Artifact_Extensions =>
1336 List := Element.Value.Values;
1338 if List /= Nil_String then
1340 Lang_Index.Config.Clean_Object_Artifacts,
1342 In_Tree => Data.Tree);
1345 -- Attribute Source_Artifact_Extensions (<language>)
1347 when Name_Source_Artifact_Extensions =>
1348 List := Element.Value.Values;
1350 if List /= Nil_String then
1352 Lang_Index.Config.Clean_Source_Artifacts,
1354 In_Tree => Data.Tree);
1362 Element_Id := Element.Next;
1365 Current_Array_Id := Current_Array.Next;
1369 ----------------------
1370 -- Process_Compiler --
1371 ----------------------
1373 procedure Process_Compiler (Arrays : Array_Id) is
1374 Current_Array_Id : Array_Id;
1375 Current_Array : Array_Data;
1376 Element_Id : Array_Element_Id;
1377 Element : Array_Element;
1378 List : String_List_Id;
1381 -- Process the associative array attribute of package Compiler
1383 Current_Array_Id := Arrays;
1384 while Current_Array_Id /= No_Array loop
1385 Current_Array := Shared.Arrays.Table (Current_Array_Id);
1387 Element_Id := Current_Array.Value;
1388 while Element_Id /= No_Array_Element loop
1389 Element := Shared.Array_Elements.Table (Element_Id);
1391 if Element.Index /= All_Other_Names then
1393 -- Get the name of the language
1395 Lang_Index := Get_Language_From_Name
1396 (Project, Get_Name_String (Element.Index));
1398 if Lang_Index /= No_Language_Index then
1399 case Current_Array.Name is
1401 -- Attribute Dependency_Kind (<language>)
1403 when Name_Dependency_Kind =>
1404 Get_Name_String (Element.Value.Value);
1407 Lang_Index.Config.Dependency_Kind :=
1408 Dependency_File_Kind'Value
1409 (Name_Buffer (1 .. Name_Len));
1412 when Constraint_Error =>
1415 "illegal value for Dependency_Kind",
1416 Element.Value.Location,
1420 -- Attribute Dependency_Switches (<language>)
1422 when Name_Dependency_Switches =>
1423 if Lang_Index.Config.Dependency_Kind = None then
1424 Lang_Index.Config.Dependency_Kind := Makefile;
1427 List := Element.Value.Values;
1429 if List /= Nil_String then
1431 Lang_Index.Config.Dependency_Option,
1433 In_Tree => Data.Tree);
1436 -- Attribute Dependency_Driver (<language>)
1438 when Name_Dependency_Driver =>
1439 if Lang_Index.Config.Dependency_Kind = None then
1440 Lang_Index.Config.Dependency_Kind := Makefile;
1443 List := Element.Value.Values;
1445 if List /= Nil_String then
1447 Lang_Index.Config.Compute_Dependency,
1449 In_Tree => Data.Tree);
1452 -- Attribute Language_Kind (<language>)
1454 when Name_Language_Kind =>
1455 Get_Name_String (Element.Value.Value);
1458 Lang_Index.Config.Kind :=
1460 (Name_Buffer (1 .. Name_Len));
1463 when Constraint_Error =>
1466 "illegal value for Language_Kind",
1467 Element.Value.Location,
1471 -- Attribute Include_Switches (<language>)
1473 when Name_Include_Switches =>
1474 List := Element.Value.Values;
1476 if List = Nil_String then
1478 (Data.Flags, "include option cannot be null",
1479 Element.Value.Location, Project);
1482 Put (Into_List => Lang_Index.Config.Include_Option,
1484 In_Tree => Data.Tree);
1486 -- Attribute Include_Path (<language>)
1488 when Name_Include_Path =>
1489 Lang_Index.Config.Include_Path :=
1490 Element.Value.Value;
1492 -- Attribute Include_Path_File (<language>)
1494 when Name_Include_Path_File =>
1495 Lang_Index.Config.Include_Path_File :=
1496 Element.Value.Value;
1498 -- Attribute Driver (<language>)
1501 Lang_Index.Config.Compiler_Driver :=
1502 File_Name_Type (Element.Value.Value);
1504 when Name_Required_Switches
1505 | Name_Leading_Required_Switches
1509 Compiler_Leading_Required_Switches,
1510 From_List => Element.Value.Values,
1511 In_Tree => Data.Tree);
1513 when Name_Trailing_Required_Switches =>
1516 Compiler_Trailing_Required_Switches,
1517 From_List => Element.Value.Values,
1518 In_Tree => Data.Tree);
1520 when Name_Multi_Unit_Switches =>
1522 Lang_Index.Config.Multi_Unit_Switches,
1523 From_List => Element.Value.Values,
1524 In_Tree => Data.Tree);
1526 when Name_Multi_Unit_Object_Separator =>
1527 Get_Name_String (Element.Value.Value);
1529 if Name_Len /= 1 then
1532 "multi-unit object separator must have " &
1533 "a single character",
1534 Element.Value.Location, Project);
1536 elsif Name_Buffer (1) = ' ' then
1539 "multi-unit object separator cannot be " &
1541 Element.Value.Location, Project);
1544 Lang_Index.Config.Multi_Unit_Object_Separator :=
1548 when Name_Path_Syntax =>
1550 Lang_Index.Config.Path_Syntax :=
1551 Path_Syntax_Kind'Value
1552 (Get_Name_String (Element.Value.Value));
1555 when Constraint_Error =>
1558 "invalid value for Path_Syntax",
1559 Element.Value.Location, Project);
1562 when Name_Source_File_Switches =>
1564 Lang_Index.Config.Source_File_Switches,
1565 From_List => Element.Value.Values,
1566 In_Tree => Data.Tree);
1568 when Name_Object_File_Suffix =>
1569 if Get_Name_String (Element.Value.Value) = "" then
1572 "object file suffix cannot be empty",
1573 Element.Value.Location, Project);
1576 Lang_Index.Config.Object_File_Suffix :=
1577 Element.Value.Value;
1580 when Name_Object_File_Switches =>
1582 Lang_Index.Config.Object_File_Switches,
1583 From_List => Element.Value.Values,
1584 In_Tree => Data.Tree);
1586 when Name_Object_Path_Switches =>
1588 Lang_Index.Config.Object_Path_Switches,
1589 From_List => Element.Value.Values,
1590 In_Tree => Data.Tree);
1592 -- Attribute Compiler_Pic_Option (<language>)
1594 when Name_Pic_Option =>
1595 List := Element.Value.Values;
1597 if List = Nil_String then
1600 "compiler PIC option cannot be null",
1601 Element.Value.Location, Project);
1605 Lang_Index.Config.Compilation_PIC_Option,
1607 In_Tree => Data.Tree);
1609 -- Attribute Mapping_File_Switches (<language>)
1611 when Name_Mapping_File_Switches =>
1612 List := Element.Value.Values;
1614 if List = Nil_String then
1617 "mapping file switches cannot be null",
1618 Element.Value.Location, Project);
1622 Lang_Index.Config.Mapping_File_Switches,
1624 In_Tree => Data.Tree);
1626 -- Attribute Mapping_Spec_Suffix (<language>)
1628 when Name_Mapping_Spec_Suffix =>
1629 Lang_Index.Config.Mapping_Spec_Suffix :=
1630 File_Name_Type (Element.Value.Value);
1632 -- Attribute Mapping_Body_Suffix (<language>)
1634 when Name_Mapping_Body_Suffix =>
1635 Lang_Index.Config.Mapping_Body_Suffix :=
1636 File_Name_Type (Element.Value.Value);
1638 -- Attribute Config_File_Switches (<language>)
1640 when Name_Config_File_Switches =>
1641 List := Element.Value.Values;
1643 if List = Nil_String then
1646 "config file switches cannot be null",
1647 Element.Value.Location, Project);
1651 Lang_Index.Config.Config_File_Switches,
1653 In_Tree => Data.Tree);
1655 -- Attribute Objects_Path (<language>)
1657 when Name_Objects_Path =>
1658 Lang_Index.Config.Objects_Path :=
1659 Element.Value.Value;
1661 -- Attribute Objects_Path_File (<language>)
1663 when Name_Objects_Path_File =>
1664 Lang_Index.Config.Objects_Path_File :=
1665 Element.Value.Value;
1667 -- Attribute Config_Body_File_Name (<language>)
1669 when Name_Config_Body_File_Name =>
1670 Lang_Index.Config.Config_Body :=
1671 Element.Value.Value;
1673 -- Attribute Config_Body_File_Name_Index (< Language>)
1675 when Name_Config_Body_File_Name_Index =>
1676 Lang_Index.Config.Config_Body_Index :=
1677 Element.Value.Value;
1679 -- Attribute Config_Body_File_Name_Pattern(<language>)
1681 when Name_Config_Body_File_Name_Pattern =>
1682 Lang_Index.Config.Config_Body_Pattern :=
1683 Element.Value.Value;
1685 -- Attribute Config_Spec_File_Name (<language>)
1687 when Name_Config_Spec_File_Name =>
1688 Lang_Index.Config.Config_Spec :=
1689 Element.Value.Value;
1691 -- Attribute Config_Spec_File_Name_Index (<language>)
1693 when Name_Config_Spec_File_Name_Index =>
1694 Lang_Index.Config.Config_Spec_Index :=
1695 Element.Value.Value;
1697 -- Attribute Config_Spec_File_Name_Pattern(<language>)
1699 when Name_Config_Spec_File_Name_Pattern =>
1700 Lang_Index.Config.Config_Spec_Pattern :=
1701 Element.Value.Value;
1703 -- Attribute Config_File_Unique (<language>)
1705 when Name_Config_File_Unique =>
1707 Lang_Index.Config.Config_File_Unique :=
1709 (Get_Name_String (Element.Value.Value));
1711 when Constraint_Error =>
1714 "illegal value for Config_File_Unique",
1715 Element.Value.Location, Project);
1724 Element_Id := Element.Next;
1727 Current_Array_Id := Current_Array.Next;
1729 end Process_Compiler;
1731 --------------------
1732 -- Process_Naming --
1733 --------------------
1735 procedure Process_Naming (Attributes : Variable_Id) is
1736 Attribute_Id : Variable_Id;
1737 Attribute : Variable;
1740 -- Process non associated array attribute from package Naming
1742 Attribute_Id := Attributes;
1743 while Attribute_Id /= No_Variable loop
1744 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1746 if not Attribute.Value.Default then
1747 if Attribute.Name = Name_Separate_Suffix then
1749 -- Attribute Separate_Suffix
1751 Get_Name_String (Attribute.Value.Value);
1752 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1753 Separate_Suffix := Name_Find;
1755 elsif Attribute.Name = Name_Casing then
1761 Value (Get_Name_String (Attribute.Value.Value));
1764 when Constraint_Error =>
1767 "invalid value for Casing",
1768 Attribute.Value.Location, Project);
1771 elsif Attribute.Name = Name_Dot_Replacement then
1773 -- Attribute Dot_Replacement
1775 Dot_Replacement := File_Name_Type (Attribute.Value.Value);
1780 Attribute_Id := Attribute.Next;
1784 procedure Process_Naming (Arrays : Array_Id) is
1785 Current_Array_Id : Array_Id;
1786 Current_Array : Array_Data;
1787 Element_Id : Array_Element_Id;
1788 Element : Array_Element;
1791 -- Process the associative array attribute of package Naming
1793 Current_Array_Id := Arrays;
1794 while Current_Array_Id /= No_Array loop
1795 Current_Array := Shared.Arrays.Table (Current_Array_Id);
1797 Element_Id := Current_Array.Value;
1798 while Element_Id /= No_Array_Element loop
1799 Element := Shared.Array_Elements.Table (Element_Id);
1801 -- Get the name of the language
1803 Lang_Index := Get_Language_From_Name
1804 (Project, Get_Name_String (Element.Index));
1806 if Lang_Index /= No_Language_Index then
1807 case Current_Array.Name is
1808 when Name_Spec_Suffix | Name_Specification_Suffix =>
1810 -- Attribute Spec_Suffix (<language>)
1812 Get_Name_String (Element.Value.Value);
1813 Canonical_Case_File_Name
1814 (Name_Buffer (1 .. Name_Len));
1815 Lang_Index.Config.Naming_Data.Spec_Suffix :=
1818 when Name_Implementation_Suffix | Name_Body_Suffix =>
1820 Get_Name_String (Element.Value.Value);
1821 Canonical_Case_File_Name
1822 (Name_Buffer (1 .. Name_Len));
1824 -- Attribute Body_Suffix (<language>)
1826 Lang_Index.Config.Naming_Data.Body_Suffix :=
1828 Lang_Index.Config.Naming_Data.Separate_Suffix :=
1829 Lang_Index.Config.Naming_Data.Body_Suffix;
1836 Element_Id := Element.Next;
1839 Current_Array_Id := Current_Array.Next;
1843 --------------------
1844 -- Process_Linker --
1845 --------------------
1847 procedure Process_Linker (Attributes : Variable_Id) is
1848 Attribute_Id : Variable_Id;
1849 Attribute : Variable;
1852 -- Process non associated array attribute from package Linker
1854 Attribute_Id := Attributes;
1855 while Attribute_Id /= No_Variable loop
1856 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
1858 if not Attribute.Value.Default then
1859 if Attribute.Name = Name_Driver then
1861 -- Attribute Linker'Driver: the default linker to use
1863 Project.Config.Linker :=
1864 Path_Name_Type (Attribute.Value.Value);
1866 -- Linker'Driver is also used to link shared libraries
1867 -- if the obsolescent attribute Library_GCC has not been
1870 if Project.Config.Shared_Lib_Driver = No_File then
1871 Project.Config.Shared_Lib_Driver :=
1872 File_Name_Type (Attribute.Value.Value);
1875 elsif Attribute.Name = Name_Required_Switches then
1877 -- Attribute Required_Switches: the minimum trailing
1878 -- options to use when invoking the linker
1881 Project.Config.Trailing_Linker_Required_Switches,
1882 From_List => Attribute.Value.Values,
1883 In_Tree => Data.Tree);
1885 elsif Attribute.Name = Name_Map_File_Option then
1886 Project.Config.Map_File_Option := Attribute.Value.Value;
1888 elsif Attribute.Name = Name_Max_Command_Line_Length then
1890 Project.Config.Max_Command_Line_Length :=
1891 Natural'Value (Get_Name_String
1892 (Attribute.Value.Value));
1895 when Constraint_Error =>
1898 "value must be positive or equal to 0",
1899 Attribute.Value.Location, Project);
1902 elsif Attribute.Name = Name_Response_File_Format then
1907 Get_Name_String (Attribute.Value.Value);
1908 To_Lower (Name_Buffer (1 .. Name_Len));
1911 if Name = Name_None then
1912 Project.Config.Resp_File_Format := None;
1914 elsif Name = Name_Gnu then
1915 Project.Config.Resp_File_Format := GNU;
1917 elsif Name = Name_Object_List then
1918 Project.Config.Resp_File_Format := Object_List;
1920 elsif Name = Name_Option_List then
1921 Project.Config.Resp_File_Format := Option_List;
1923 elsif Name_Buffer (1 .. Name_Len) = "gcc" then
1924 Project.Config.Resp_File_Format := GCC;
1926 elsif Name_Buffer (1 .. Name_Len) = "gcc_gnu" then
1927 Project.Config.Resp_File_Format := GCC_GNU;
1930 Name_Buffer (1 .. Name_Len) = "gcc_option_list"
1932 Project.Config.Resp_File_Format := GCC_Option_List;
1935 Name_Buffer (1 .. Name_Len) = "gcc_object_list"
1937 Project.Config.Resp_File_Format := GCC_Object_List;
1942 "illegal response file format",
1943 Attribute.Value.Location, Project);
1947 elsif Attribute.Name = Name_Response_File_Switches then
1948 Put (Into_List => Project.Config.Resp_File_Options,
1949 From_List => Attribute.Value.Values,
1950 In_Tree => Data.Tree);
1954 Attribute_Id := Attribute.Next;
1958 -- Start of processing for Process_Packages
1961 Packages := Project.Decl.Packages;
1962 while Packages /= No_Package loop
1963 Element := Shared.Packages.Table (Packages);
1965 case Element.Name is
1968 -- Process attributes of package Binder
1970 Process_Binder (Element.Decl.Arrays);
1972 when Name_Builder =>
1974 -- Process attributes of package Builder
1976 Process_Builder (Element.Decl.Attributes);
1980 -- Process attributes of package Clean
1982 Process_Clean (Element.Decl.Attributes);
1983 Process_Clean (Element.Decl.Arrays);
1985 when Name_Compiler =>
1987 -- Process attributes of package Compiler
1989 Process_Compiler (Element.Decl.Arrays);
1993 -- Process attributes of package Linker
1995 Process_Linker (Element.Decl.Attributes);
1999 -- Process attributes of package Naming
2001 Process_Naming (Element.Decl.Attributes);
2002 Process_Naming (Element.Decl.Arrays);
2008 Packages := Element.Next;
2010 end Process_Packages;
2012 ---------------------------------------------
2013 -- Process_Project_Level_Simple_Attributes --
2014 ---------------------------------------------
2016 procedure Process_Project_Level_Simple_Attributes is
2017 Attribute_Id : Variable_Id;
2018 Attribute : Variable;
2019 List : String_List_Id;
2022 -- Process non associated array attribute at project level
2024 Attribute_Id := Project.Decl.Attributes;
2025 while Attribute_Id /= No_Variable loop
2026 Attribute := Shared.Variable_Elements.Table (Attribute_Id);
2028 if not Attribute.Value.Default then
2029 if Attribute.Name = Name_Target then
2031 -- Attribute Target: the target specified
2033 Project.Config.Target := Attribute.Value.Value;
2035 elsif Attribute.Name = Name_Library_Builder then
2037 -- Attribute Library_Builder: the application to invoke
2038 -- to build libraries.
2040 Project.Config.Library_Builder :=
2041 Path_Name_Type (Attribute.Value.Value);
2043 elsif Attribute.Name = Name_Archive_Builder then
2045 -- Attribute Archive_Builder: the archive builder
2046 -- (usually "ar") and its minimum options (usually "cr").
2048 List := Attribute.Value.Values;
2050 if List = Nil_String then
2053 "archive builder cannot be null",
2054 Attribute.Value.Location, Project);
2057 Put (Into_List => Project.Config.Archive_Builder,
2059 In_Tree => Data.Tree);
2061 elsif Attribute.Name = Name_Archive_Builder_Append_Option then
2063 -- Attribute Archive_Builder: the archive builder
2064 -- (usually "ar") and its minimum options (usually "cr").
2066 List := Attribute.Value.Values;
2068 if List /= Nil_String then
2071 Project.Config.Archive_Builder_Append_Option,
2073 In_Tree => Data.Tree);
2076 elsif Attribute.Name = Name_Archive_Indexer then
2078 -- Attribute Archive_Indexer: the optional archive
2079 -- indexer (usually "ranlib") with its minimum options
2082 List := Attribute.Value.Values;
2084 if List = Nil_String then
2087 "archive indexer cannot be null",
2088 Attribute.Value.Location, Project);
2091 Put (Into_List => Project.Config.Archive_Indexer,
2093 In_Tree => Data.Tree);
2095 elsif Attribute.Name = Name_Library_Partial_Linker then
2097 -- Attribute Library_Partial_Linker: the optional linker
2098 -- driver with its minimum options, to partially link
2101 List := Attribute.Value.Values;
2103 if List = Nil_String then
2106 "partial linker cannot be null",
2107 Attribute.Value.Location, Project);
2110 Put (Into_List => Project.Config.Lib_Partial_Linker,
2112 In_Tree => Data.Tree);
2114 elsif Attribute.Name = Name_Library_GCC then
2115 Project.Config.Shared_Lib_Driver :=
2116 File_Name_Type (Attribute.Value.Value);
2119 "?Library_'G'C
'C is an obsolescent attribute
, " &
2120 "use Linker
''Driver instead
",
2121 Attribute.Value.Location, Project);
2123 elsif Attribute.Name = Name_Archive_Suffix then
2124 Project.Config.Archive_Suffix :=
2125 File_Name_Type (Attribute.Value.Value);
2127 elsif Attribute.Name = Name_Linker_Executable_Option then
2129 -- Attribute Linker_Executable_Option: optional options
2130 -- to specify an executable name. Defaults to "-o
".
2132 List := Attribute.Value.Values;
2134 if List = Nil_String then
2137 "linker executable option cannot be
null",
2138 Attribute.Value.Location, Project);
2141 Put (Into_List => Project.Config.Linker_Executable_Option,
2143 In_Tree => Data.Tree);
2145 elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
2147 -- Attribute Linker_Lib_Dir_Option: optional options
2148 -- to specify a library search directory. Defaults to
2151 Get_Name_String (Attribute.Value.Value);
2153 if Name_Len = 0 then
2156 "linker library directory option cannot be empty
",
2157 Attribute.Value.Location, Project);
2160 Project.Config.Linker_Lib_Dir_Option :=
2161 Attribute.Value.Value;
2163 elsif Attribute.Name = Name_Linker_Lib_Name_Option then
2165 -- Attribute Linker_Lib_Name_Option: optional options
2166 -- to specify the name of a library to be linked in.
2167 -- Defaults to "-l
".
2169 Get_Name_String (Attribute.Value.Value);
2171 if Name_Len = 0 then
2174 "linker library name option cannot be empty
",
2175 Attribute.Value.Location, Project);
2178 Project.Config.Linker_Lib_Name_Option :=
2179 Attribute.Value.Value;
2181 elsif Attribute.Name = Name_Run_Path_Option then
2183 -- Attribute Run_Path_Option: optional options to
2184 -- specify a path for libraries.
2186 List := Attribute.Value.Values;
2188 if List /= Nil_String then
2189 Put (Into_List => Project.Config.Run_Path_Option,
2191 In_Tree => Data.Tree);
2194 elsif Attribute.Name = Name_Run_Path_Origin then
2195 Get_Name_String (Attribute.Value.Value);
2197 if Name_Len = 0 then
2200 "run path origin cannot be empty
",
2201 Attribute.Value.Location, Project);
2204 Project.Config.Run_Path_Origin := Attribute.Value.Value;
2206 elsif Attribute.Name = Name_Library_Install_Name_Option then
2207 Project.Config.Library_Install_Name_Option :=
2208 Attribute.Value.Value;
2210 elsif Attribute.Name = Name_Separate_Run_Path_Options then
2212 pragma Unsuppress (All_Checks);
2214 Project.Config.Separate_Run_Path_Options :=
2215 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2217 when Constraint_Error =>
2220 "invalid value
""" &
2221 Get_Name_String (Attribute.Value.Value) &
2222 """ for Separate_Run_Path_Options
",
2223 Attribute.Value.Location, Project);
2226 elsif Attribute.Name = Name_Library_Support then
2228 pragma Unsuppress (All_Checks);
2230 Project.Config.Lib_Support :=
2231 Library_Support'Value (Get_Name_String
2232 (Attribute.Value.Value));
2234 when Constraint_Error =>
2237 "invalid value
""" &
2238 Get_Name_String (Attribute.Value.Value) &
2239 """ for Library_Support
",
2240 Attribute.Value.Location, Project);
2244 Attribute.Name = Name_Library_Encapsulated_Supported
2247 pragma Unsuppress (All_Checks);
2249 Project.Config.Lib_Encapsulated_Supported :=
2250 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2252 when Constraint_Error =>
2256 & Get_Name_String (Attribute.Value.Value)
2257 & """ for Library_Encapsulated_Supported
",
2258 Attribute.Value.Location, Project);
2261 elsif Attribute.Name = Name_Shared_Library_Prefix then
2262 Project.Config.Shared_Lib_Prefix :=
2263 File_Name_Type (Attribute.Value.Value);
2265 elsif Attribute.Name = Name_Shared_Library_Suffix then
2266 Project.Config.Shared_Lib_Suffix :=
2267 File_Name_Type (Attribute.Value.Value);
2269 elsif Attribute.Name = Name_Symbolic_Link_Supported then
2271 pragma Unsuppress (All_Checks);
2273 Project.Config.Symbolic_Link_Supported :=
2274 Boolean'Value (Get_Name_String
2275 (Attribute.Value.Value));
2277 when Constraint_Error =>
2281 & Get_Name_String (Attribute.Value.Value)
2282 & """ for Symbolic_Link_Supported
",
2283 Attribute.Value.Location, Project);
2287 Attribute.Name = Name_Library_Major_Minor_Id_Supported
2290 pragma Unsuppress (All_Checks);
2292 Project.Config.Lib_Maj_Min_Id_Supported :=
2293 Boolean'Value (Get_Name_String
2294 (Attribute.Value.Value));
2296 when Constraint_Error =>
2299 "invalid value
""" &
2300 Get_Name_String (Attribute.Value.Value) &
2301 """ for Library_Major_Minor_Id_Supported
",
2302 Attribute.Value.Location, Project);
2305 elsif Attribute.Name = Name_Library_Auto_Init_Supported then
2307 pragma Unsuppress (All_Checks);
2309 Project.Config.Auto_Init_Supported :=
2310 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2312 when Constraint_Error =>
2316 & Get_Name_String (Attribute.Value.Value)
2317 & """ for Library_Auto_Init_Supported
",
2318 Attribute.Value.Location, Project);
2321 elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
2322 List := Attribute.Value.Values;
2324 if List /= Nil_String then
2325 Put (Into_List => Project.Config.Shared_Lib_Min_Options,
2327 In_Tree => Data.Tree);
2330 elsif Attribute.Name = Name_Library_Version_Switches then
2331 List := Attribute.Value.Values;
2333 if List /= Nil_String then
2334 Put (Into_List => Project.Config.Lib_Version_Options,
2336 In_Tree => Data.Tree);
2341 Attribute_Id := Attribute.Next;
2343 end Process_Project_Level_Simple_Attributes;
2345 --------------------------------------------
2346 -- Process_Project_Level_Array_Attributes --
2347 --------------------------------------------
2349 procedure Process_Project_Level_Array_Attributes is
2350 Current_Array_Id : Array_Id;
2351 Current_Array : Array_Data;
2352 Element_Id : Array_Element_Id;
2353 Element : Array_Element;
2354 List : String_List_Id;
2357 -- Process the associative array attributes at project level
2359 Current_Array_Id := Project.Decl.Arrays;
2360 while Current_Array_Id /= No_Array loop
2361 Current_Array := Shared.Arrays.Table (Current_Array_Id);
2363 Element_Id := Current_Array.Value;
2364 while Element_Id /= No_Array_Element loop
2365 Element := Shared.Array_Elements.Table (Element_Id);
2367 -- Get the name of the language
2370 Get_Language_From_Name
2371 (Project, Get_Name_String (Element.Index));
2373 if Lang_Index /= No_Language_Index then
2374 case Current_Array.Name is
2375 when Name_Inherit_Source_Path =>
2376 List := Element.Value.Values;
2378 if List /= Nil_String then
2381 Lang_Index.Config.Include_Compatible_Languages,
2383 In_Tree => Data.Tree,
2384 Lower_Case => True);
2387 when Name_Toolchain_Description =>
2389 -- Attribute Toolchain_Description (<language>)
2391 Lang_Index.Config.Toolchain_Description :=
2392 Element.Value.Value;
2394 when Name_Toolchain_Version =>
2396 -- Attribute Toolchain_Version (<language>)
2398 Lang_Index.Config.Toolchain_Version :=
2399 Element.Value.Value;
2401 -- For Ada, set proper checksum computation mode,
2402 -- which has changed from version to version.
2404 if Lang_Index.Name = Name_Ada then
2406 Vers : constant String :=
2407 Get_Name_String (Element.Value.Value);
2408 pragma Assert (Vers'First = 1);
2411 -- Version 6.3 or earlier
2414 and then Vers (1 .. 5) = "GNAT
"
2415 and then Vers (7) = '.'
2419 (Vers (6) = '6' and then Vers (8) < '4'))
2421 Checksum_GNAT_6_3 := True;
2423 -- Version 5.03 or earlier
2426 or else (Vers (6) = '5'
2427 and then Vers (Vers'Last) < '4')
2429 Checksum_GNAT_5_03 := True;
2431 -- Version 5.02 or earlier (no checksums)
2434 or else Vers (Vers'Last) < '3'
2436 Checksum_Accumulate_Token_Checksum :=
2444 when Name_Runtime_Library_Dir =>
2446 -- Attribute Runtime_Library_Dir (<language>)
2448 Lang_Index.Config.Runtime_Library_Dir :=
2449 Element.Value.Value;
2451 when Name_Runtime_Source_Dir =>
2453 -- Attribute Runtime_Source_Dir (<language>)
2455 Lang_Index.Config.Runtime_Source_Dir :=
2456 Element.Value.Value;
2458 when Name_Object_Generated =>
2460 pragma Unsuppress (All_Checks);
2466 (Get_Name_String (Element.Value.Value));
2468 Lang_Index.Config.Object_Generated := Value;
2470 -- If no object is generated, no object may be
2474 Lang_Index.Config.Objects_Linked := False;
2478 when Constraint_Error =>
2482 & Get_Name_String (Element.Value.Value)
2483 & """ for Object_Generated
",
2484 Element.Value.Location, Project);
2487 when Name_Objects_Linked =>
2489 pragma Unsuppress (All_Checks);
2495 (Get_Name_String (Element.Value.Value));
2497 -- No change if Object_Generated is False, as this
2498 -- forces Objects_Linked to be False too.
2500 if Lang_Index.Config.Object_Generated then
2501 Lang_Index.Config.Objects_Linked := Value;
2505 when Constraint_Error =>
2509 & Get_Name_String (Element.Value.Value)
2510 & """ for Objects_Linked
",
2511 Element.Value.Location, Project);
2518 Element_Id := Element.Next;
2521 Current_Array_Id := Current_Array.Next;
2523 end Process_Project_Level_Array_Attributes;
2525 -- Start of processing for Check_Configuration
2528 Process_Project_Level_Simple_Attributes;
2529 Process_Project_Level_Array_Attributes;
2532 -- For unit based languages, set Casing, Dot_Replacement and
2533 -- Separate_Suffix in Naming_Data.
2535 Lang_Index := Project.Languages;
2536 while Lang_Index /= No_Language_Index loop
2537 if Lang_Index.Config.Kind = Unit_Based then
2538 Lang_Index.Config.Naming_Data.Casing := Casing;
2539 Lang_Index.Config.Naming_Data.Dot_Replacement := Dot_Replacement;
2541 if Separate_Suffix /= No_File then
2542 Lang_Index.Config.Naming_Data.Separate_Suffix :=
2549 Lang_Index := Lang_Index.Next;
2552 -- Give empty names to various prefixes/suffixes, if they have not
2553 -- been specified in the configuration.
2555 if Project.Config.Archive_Suffix = No_File then
2556 Project.Config.Archive_Suffix := Empty_File;
2559 if Project.Config.Shared_Lib_Prefix = No_File then
2560 Project.Config.Shared_Lib_Prefix := Empty_File;
2563 if Project.Config.Shared_Lib_Suffix = No_File then
2564 Project.Config.Shared_Lib_Suffix := Empty_File;
2567 Lang_Index := Project.Languages;
2568 while Lang_Index /= No_Language_Index loop
2570 -- For all languages, Compiler_Driver needs to be specified. This is
2571 -- only needed if we do intend to compile (not in GPS for instance).
2573 if Data.Flags.Compiler_Driver_Mandatory
2574 and then Lang_Index.Config.Compiler_Driver = No_File
2576 Error_Msg_Name_1 := Lang_Index.Display_Name;
2579 "?no compiler specified
for language
%%" &
2580 ", ignoring
all its sources
",
2581 No_Location, Project);
2583 if Lang_Index = Project.Languages then
2584 Project.Languages := Lang_Index.Next;
2586 Prev_Index.Next := Lang_Index.Next;
2589 elsif Lang_Index.Config.Kind = Unit_Based then
2590 Prev_Index := Lang_Index;
2592 -- For unit based languages, Dot_Replacement, Spec_Suffix and
2593 -- Body_Suffix need to be specified.
2595 if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then
2598 "Dot_Replacement
not specified
for " &
2599 Get_Name_String (Lang_Index.Name),
2600 No_Location, Project);
2603 if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
2606 "Spec_Suffix
not specified
for " &
2607 Get_Name_String (Lang_Index.Name),
2608 No_Location, Project);
2611 if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
2614 "Body_Suffix
not specified
for " &
2615 Get_Name_String (Lang_Index.Name),
2616 No_Location, Project);
2620 Prev_Index := Lang_Index;
2622 -- For file based languages, either Spec_Suffix or Body_Suffix
2623 -- need to be specified.
2625 if Data.Flags.Require_Sources_Other_Lang
2626 and then Lang_Index.Config.Naming_Data.Spec_Suffix = No_File
2627 and then Lang_Index.Config.Naming_Data.Body_Suffix = No_File
2629 Error_Msg_Name_1 := Lang_Index.Display_Name;
2632 "no suffixes specified
for %%",
2633 No_Location, Project);
2637 Lang_Index := Lang_Index.Next;
2639 end Check_Configuration;
2641 -------------------------------
2642 -- Check_If_Externally_Built --
2643 -------------------------------
2645 procedure Check_If_Externally_Built
2646 (Project : Project_Id;
2647 Data : in out Tree_Processing_Data)
2649 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
2650 Externally_Built : constant Variable_Value :=
2652 (Name_Externally_Built,
2653 Project.Decl.Attributes, Shared);
2656 if not Externally_Built.Default then
2657 Get_Name_String (Externally_Built.Value);
2658 To_Lower (Name_Buffer (1 .. Name_Len));
2660 if Name_Buffer (1 .. Name_Len) = "true" then
2661 Project.Externally_Built := True;
2663 elsif Name_Buffer (1 .. Name_Len) /= "false" then
2664 Error_Msg (Data.Flags,
2665 "Externally_Built may only be
true or false",
2666 Externally_Built.Location, Project);
2670 -- A virtual project extending an externally built project is itself
2671 -- externally built.
2673 if Project.Virtual and then Project.Extends /= No_Project then
2674 Project.Externally_Built := Project.Extends.Externally_Built;
2677 if Project.Externally_Built then
2678 Debug_Output ("project
is externally built
");
2680 Debug_Output ("project
is not externally built
");
2682 end Check_If_Externally_Built;
2684 ----------------------
2685 -- Check_Interfaces --
2686 ----------------------
2688 procedure Check_Interfaces
2689 (Project : Project_Id;
2690 Data : in out Tree_Processing_Data)
2692 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
2694 Interfaces : constant Prj.Variable_Value :=
2696 (Snames.Name_Interfaces,
2697 Project.Decl.Attributes,
2700 Library_Interface : constant Prj.Variable_Value :=
2702 (Snames.Name_Library_Interface,
2703 Project.Decl.Attributes,
2706 List : String_List_Id;
2707 Element : String_Element;
2708 Name : File_Name_Type;
2709 Iter : Source_Iterator;
2711 Project_2 : Project_Id;
2713 Unit_Found : Boolean;
2715 Interface_ALIs : String_List_Id := Nil_String;
2716 Other_Interfaces : String_List_Id := Nil_String;
2719 if not Interfaces.Default then
2721 -- Set In_Interfaces to False for all sources. It will be set to True
2722 -- later for the sources in the Interfaces list.
2724 Project_2 := Project;
2725 while Project_2 /= No_Project loop
2726 Iter := For_Each_Source (Data.Tree, Project_2);
2728 Source := Prj.Element (Iter);
2729 exit when Source = No_Source;
2730 Source.In_Interfaces := False;
2734 Project_2 := Project_2.Extends;
2737 List := Interfaces.Values;
2738 while List /= Nil_String loop
2739 Element := Shared.String_Elements.Table (List);
2740 Name := Canonical_Case_File_Name (Element.Value);
2742 Project_2 := Project;
2743 Big_Loop : while Project_2 /= No_Project loop
2744 if Project.Qualifier = Aggregate_Library then
2746 -- For an aggregate library we want to consider sources of
2747 -- all aggregated projects.
2749 Iter := For_Each_Source (Data.Tree);
2752 Iter := For_Each_Source (Data.Tree, Project_2);
2756 Source := Prj.Element (Iter);
2757 exit when Source = No_Source;
2759 if Source.File = Name then
2760 if not Source.Locally_Removed then
2761 Source.In_Interfaces := True;
2762 Source.Declared_In_Interfaces := True;
2764 Other := Other_Part (Source);
2766 if Other /= No_Source then
2767 Other.In_Interfaces := True;
2768 Other.Declared_In_Interfaces := True;
2773 if Source.Language.Config.Kind = Unit_Based then
2774 if Source.Kind = Spec
2775 and then Other_Part (Source) /= No_Source
2777 Source := Other_Part (Source);
2780 String_Element_Table.Increment_Last
2781 (Shared.String_Elements);
2783 Shared.String_Elements.Table
2784 (String_Element_Table.Last
2785 (Shared.String_Elements)) :=
2786 (Value => Name_Id (Source.Dep_Name),
2788 Display_Value => Name_Id (Source.Dep_Name),
2789 Location => No_Location,
2791 Next => Interface_ALIs);
2794 String_Element_Table.Last
2795 (Shared.String_Elements);
2800 String_Element_Table.Increment_Last
2801 (Shared.String_Elements);
2803 Shared.String_Elements.Table
2804 (String_Element_Table.Last
2805 (Shared.String_Elements)) :=
2806 (Value => Name_Id (Source.File),
2808 Display_Value => Name_Id (Source.Display_File),
2809 Location => No_Location,
2811 Next => Other_Interfaces);
2814 String_Element_Table.Last
2815 (Shared.String_Elements);
2819 ("interface
: ", Name_Id (Source.Path.Name));
2828 Project_2 := Project_2.Extends;
2831 if Source = No_Source then
2832 Error_Msg_File_1 := File_Name_Type (Element.Value);
2833 Error_Msg_Name_1 := Project.Name;
2837 "{ cannot be an interface
of project
%% "
2838 & "as it
is not one
of its sources
",
2839 Element.Location, Project);
2842 List := Element.Next;
2845 Project.Interfaces_Defined := True;
2846 Project.Lib_Interface_ALIs := Interface_ALIs;
2847 Project.Other_Interfaces := Other_Interfaces;
2849 elsif Project.Library and then not Library_Interface.Default then
2851 -- Set In_Interfaces to False for all sources. It will be set to True
2852 -- later for the sources in the Library_Interface list.
2854 Project_2 := Project;
2855 while Project_2 /= No_Project loop
2856 Iter := For_Each_Source (Data.Tree, Project_2);
2858 Source := Prj.Element (Iter);
2859 exit when Source = No_Source;
2860 Source.In_Interfaces := False;
2864 Project_2 := Project_2.Extends;
2867 List := Library_Interface.Values;
2868 while List /= Nil_String loop
2869 Element := Shared.String_Elements.Table (List);
2870 Get_Name_String (Element.Value);
2871 To_Lower (Name_Buffer (1 .. Name_Len));
2873 Unit_Found := False;
2875 Project_2 := Project;
2876 Big_Loop_2 : while Project_2 /= No_Project loop
2877 if Project.Qualifier = Aggregate_Library then
2879 -- For an aggregate library we want to consider sources of
2880 -- all aggregated projects.
2882 Iter := For_Each_Source (Data.Tree);
2885 Iter := For_Each_Source (Data.Tree, Project_2);
2889 Source := Prj.Element (Iter);
2890 exit when Source = No_Source;
2892 if Source.Unit /= No_Unit_Index
2893 and then Source.Unit.Name = Name_Id (Name)
2895 if not Source.Locally_Removed then
2896 Source.In_Interfaces := True;
2897 Source.Declared_In_Interfaces := True;
2898 Project.Interfaces_Defined := True;
2900 Other := Other_Part (Source);
2902 if Other /= No_Source then
2903 Other.In_Interfaces := True;
2904 Other.Declared_In_Interfaces := True;
2908 ("interface
: ", Name_Id (Source.Path.Name));
2910 if Source.Kind = Spec
2911 and then Other_Part (Source) /= No_Source
2913 Source := Other_Part (Source);
2916 String_Element_Table.Increment_Last
2917 (Shared.String_Elements);
2919 Shared.String_Elements.Table
2920 (String_Element_Table.Last
2921 (Shared.String_Elements)) :=
2922 (Value => Name_Id (Source.Dep_Name),
2924 Display_Value => Name_Id (Source.Dep_Name),
2925 Location => No_Location,
2927 Next => Interface_ALIs);
2930 String_Element_Table.Last (Shared.String_Elements);
2940 Project_2 := Project_2.Extends;
2941 end loop Big_Loop_2;
2943 if not Unit_Found then
2944 Error_Msg_Name_1 := Name_Id (Name);
2948 "%% is not a unit
of this project
",
2949 Element.Location, Project);
2952 List := Element.Next;
2955 Project.Lib_Interface_ALIs := Interface_ALIs;
2957 elsif Project.Extends /= No_Project
2958 and then Project.Extends.Interfaces_Defined
2960 Project.Interfaces_Defined := True;
2962 Iter := For_Each_Source (Data.Tree, Project);
2964 Source := Prj.Element (Iter);
2965 exit when Source = No_Source;
2967 if not Source.Declared_In_Interfaces then
2968 Source.In_Interfaces := False;
2974 Project.Lib_Interface_ALIs := Project.Extends.Lib_Interface_ALIs;
2976 end Check_Interfaces;
2978 ------------------------------
2979 -- Check_Library_Attributes --
2980 ------------------------------
2982 -- This procedure is awfully long (over 700 lines) should be broken up???
2984 procedure Check_Library_Attributes
2985 (Project : Project_Id;
2986 Data : in out Tree_Processing_Data)
2988 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
2990 Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
2992 Lib_Dir : constant Prj.Variable_Value :=
2994 (Snames.Name_Library_Dir, Attributes, Shared);
2996 Lib_Name : constant Prj.Variable_Value :=
2998 (Snames.Name_Library_Name, Attributes, Shared);
3000 Lib_Standalone : constant Prj.Variable_Value :=
3002 (Snames.Name_Library_Standalone,
3003 Attributes, Shared);
3005 Lib_Version : constant Prj.Variable_Value :=
3007 (Snames.Name_Library_Version, Attributes, Shared);
3009 Lib_ALI_Dir : constant Prj.Variable_Value :=
3011 (Snames.Name_Library_Ali_Dir, Attributes, Shared);
3013 Lib_GCC : constant Prj.Variable_Value :=
3015 (Snames.Name_Library_GCC, Attributes, Shared);
3017 The_Lib_Kind : constant Prj.Variable_Value :=
3019 (Snames.Name_Library_Kind, Attributes, Shared);
3021 Imported_Project_List : Project_List;
3022 Continuation : String_Access := No_Continuation_String'Access;
3023 Support_For_Libraries : Library_Support;
3025 Library_Directory_Present : Boolean;
3027 procedure Check_Library (Proj : Project_Id; Extends : Boolean);
3028 -- Check if an imported or extended project if also a library project
3030 procedure Check_Aggregate_Library_Dirs;
3031 -- Check that the library directory and the library ALI directory of an
3032 -- aggregate library project are not the same as the object directory or
3033 -- the library directory of any of its aggregated projects.
3035 ----------------------------------
3036 -- Check_Aggregate_Library_Dirs --
3037 ----------------------------------
3039 procedure Check_Aggregate_Library_Dirs is
3040 procedure Process_Aggregate (Proj : Project_Id);
3041 -- Recursive procedure to check the aggregated projects, as they may
3042 -- also be aggregated library projects.
3044 -----------------------
3045 -- Process_Aggregate --
3046 -----------------------
3048 procedure Process_Aggregate (Proj : Project_Id) is
3049 Agg : Aggregated_Project_List;
3052 Agg := Proj.Aggregated_Projects;
3053 while Agg /= null loop
3054 Error_Msg_Name_1 := Agg.Project.Name;
3056 if Agg.Project.Qualifier /= Aggregate_Library
3057 and then Project.Library_ALI_Dir.Name =
3058 Agg.Project.Object_Directory.Name
3062 "aggregate library
'A'L'I directory cannot be shared
with"
3063 & " object directory
of aggregated project
%%",
3064 The_Lib_Kind.Location, Project);
3066 elsif Project.Library_ALI_Dir.Name =
3067 Agg.Project.Library_Dir.Name
3071 "aggregate library
'A'L'I directory cannot be shared
with"
3072 & " library directory
of aggregated project
%%",
3073 The_Lib_Kind.Location, Project);
3075 elsif Agg.Project.Qualifier /= Aggregate_Library
3076 and then Project.Library_Dir.Name =
3077 Agg.Project.Object_Directory.Name
3081 "aggregate library directory cannot be shared
with"
3082 & " object directory
of aggregated project
%%",
3083 The_Lib_Kind.Location, Project);
3085 elsif Project.Library_Dir.Name =
3086 Agg.Project.Library_Dir.Name
3090 "aggregate library directory cannot be shared
with"
3091 & " library directory
of aggregated project
%%",
3092 The_Lib_Kind.Location, Project);
3095 if Agg.Project.Qualifier = Aggregate_Library then
3096 Process_Aggregate (Agg.Project);
3101 end Process_Aggregate;
3103 -- Start of processing for Check_Aggregate_Library_Dirs
3106 if Project.Qualifier = Aggregate_Library then
3107 Process_Aggregate (Project);
3109 end Check_Aggregate_Library_Dirs;
3115 procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
3117 Iter : Source_Iterator;
3120 if Proj /= No_Project then
3121 if not Proj.Library then
3123 -- The only not library projects that are OK are those that
3124 -- have no sources. However, header files from non-Ada
3125 -- languages are OK, as there is nothing to compile.
3127 Iter := For_Each_Source (Data.Tree, Proj);
3129 Src_Id := Prj.Element (Iter);
3130 exit when Src_Id = No_Source
3131 or else Src_Id.Language.Config.Kind /= File_Based
3132 or else Src_Id.Kind /= Spec;
3136 if Src_Id /= No_Source then
3137 Error_Msg_Name_1 := Project.Name;
3138 Error_Msg_Name_2 := Proj.Name;
3141 if Project.Library_Kind /= Static then
3145 "shared library project
%% cannot extend
" &
3146 "project
%% that
is not a library project
",
3147 Project.Location, Project);
3148 Continuation := Continuation_String'Access;
3151 elsif not Unchecked_Shared_Lib_Imports
3152 and then Project.Library_Kind /= Static
3157 "shared library project
%% cannot import project
%% " &
3158 "that
is not a shared library project
",
3159 Project.Location, Project);
3160 Continuation := Continuation_String'Access;
3164 elsif Project.Library_Kind /= Static
3165 and then not Lib_Standalone.Default
3166 and then Get_Name_String (Lib_Standalone.Value) = "encapsulated
"
3167 and then Proj.Library_Kind /= Static
3169 -- An encapsulated library must depend only on static libraries
3171 Error_Msg_Name_1 := Project.Name;
3172 Error_Msg_Name_2 := Proj.Name;
3177 "encapsulated library project
%% cannot import shared
" &
3178 "library project
%%",
3179 Project.Location, Project);
3180 Continuation := Continuation_String'Access;
3182 elsif Project.Library_Kind /= Static
3183 and then Proj.Library_Kind = Static
3185 (Lib_Standalone.Default
3187 Get_Name_String (Lib_Standalone.Value) /= "encapsulated
")
3189 Error_Msg_Name_1 := Project.Name;
3190 Error_Msg_Name_2 := Proj.Name;
3196 "shared library project
%% cannot extend static
" &
3197 "library project
%%",
3198 Project.Location, Project);
3199 Continuation := Continuation_String'Access;
3201 elsif not Unchecked_Shared_Lib_Imports then
3205 "shared library project
%% cannot import static
" &
3206 "library project
%%",
3207 Project.Location, Project);
3208 Continuation := Continuation_String'Access;
3215 Dir_Exists : Boolean;
3217 -- Start of processing for Check_Library_Attributes
3220 Library_Directory_Present := Lib_Dir.Value /= Empty_String;
3222 -- Special case of extending project
3224 if Project.Extends /= No_Project then
3226 -- If the project extended is a library project, we inherit the
3227 -- library name, if it is not redefined; we check that the library
3228 -- directory is specified.
3230 if Project.Extends.Library then
3231 if Project.Qualifier = Standard then
3234 "a standard project cannot extend a library project
",
3235 Project.Location, Project);
3238 if Lib_Name.Default then
3239 Project.Library_Name := Project.Extends.Library_Name;
3242 if Lib_Dir.Default then
3243 if not Project.Virtual then
3246 "a project extending a library project must
" &
3247 "specify an attribute Library_Dir
",
3248 Project.Location, Project);
3251 -- For a virtual project extending a library project,
3252 -- inherit library directory and library kind.
3254 Project.Library_Dir := Project.Extends.Library_Dir;
3255 Library_Directory_Present := True;
3256 Project.Library_Kind := Project.Extends.Library_Kind;
3263 pragma Assert (Lib_Name.Kind = Single);
3265 if Lib_Name.Value = Empty_String then
3266 if Current_Verbosity = High
3267 and then Project.Library_Name = No_Name
3270 Write_Line ("no library name
");
3274 -- There is no restriction on the syntax of library names
3276 Project.Library_Name := Lib_Name.Value;
3279 if Project.Library_Name /= No_Name then
3280 if Current_Verbosity = High then
3282 ("Library name
: ", Get_Name_String (Project.Library_Name));
3285 pragma Assert (Lib_Dir.Kind = Single);
3287 if not Library_Directory_Present then
3288 Debug_Output ("no library directory
");
3291 -- Find path name (unless inherited), check that it is a directory
3293 if Project.Library_Dir = No_Path_Information then
3296 File_Name_Type (Lib_Dir.Value),
3297 Path => Project.Library_Dir,
3298 Dir_Exists => Dir_Exists,
3300 Create => "library
",
3301 Must_Exist => False,
3302 Location => Lib_Dir.Location,
3303 Externally_Built => Project.Externally_Built);
3308 (Get_Name_String (Project.Library_Dir.Display_Name));
3311 if not Dir_Exists then
3312 if Directories_Must_Exist_In_Projects then
3314 -- Get the absolute name of the library directory that does
3315 -- not exist, to report an error.
3317 Err_Vars.Error_Msg_File_1 :=
3318 File_Name_Type (Project.Library_Dir.Display_Name);
3321 "library directory
{ does
not exist
",
3322 Lib_Dir.Location, Project);
3325 -- Checks for object/source directories
3327 elsif not Project.Externally_Built
3329 -- An aggregate library does not have sources or objects, so
3330 -- these tests are not required in this case.
3332 and then Project.Qualifier /= Aggregate_Library
3334 -- Library directory cannot be the same as Object directory
3336 if Project.Library_Dir.Name = Project.Object_Directory.Name then
3339 "library directory cannot be the same
" &
3340 "as object directory
",
3341 Lib_Dir.Location, Project);
3342 Project.Library_Dir := No_Path_Information;
3346 OK : Boolean := True;
3347 Dirs_Id : String_List_Id;
3348 Dir_Elem : String_Element;
3352 -- The library directory cannot be the same as a source
3353 -- directory of the current project.
3355 Dirs_Id := Project.Source_Dirs;
3356 while Dirs_Id /= Nil_String loop
3357 Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
3358 Dirs_Id := Dir_Elem.Next;
3360 if Project.Library_Dir.Name =
3361 Path_Name_Type (Dir_Elem.Value)
3363 Err_Vars.Error_Msg_File_1 :=
3364 File_Name_Type (Dir_Elem.Value);
3367 "library directory cannot be the same
"
3368 & "as source directory
{",
3369 Lib_Dir.Location, Project);
3377 -- The library directory cannot be the same as a
3378 -- source directory of another project either.
3380 Pid := Data.Tree.Projects;
3382 exit Project_Loop when Pid = null;
3384 if Pid.Project /= Project then
3385 Dirs_Id := Pid.Project.Source_Dirs;
3387 Dir_Loop : while Dirs_Id /= Nil_String loop
3389 Shared.String_Elements.Table (Dirs_Id);
3390 Dirs_Id := Dir_Elem.Next;
3392 if Project.Library_Dir.Name =
3393 Path_Name_Type (Dir_Elem.Value)
3395 Err_Vars.Error_Msg_File_1 :=
3396 File_Name_Type (Dir_Elem.Value);
3397 Err_Vars.Error_Msg_Name_1 :=
3402 "library directory cannot be the same
"
3403 & "as source directory
{ of project
%%",
3404 Lib_Dir.Location, Project);
3412 end loop Project_Loop;
3416 Project.Library_Dir := No_Path_Information;
3418 elsif Current_Verbosity = High then
3420 -- Display the Library directory in high verbosity
3423 ("Library directory
",
3424 Get_Name_String (Project.Library_Dir.Display_Name));
3434 Project.Library_Dir /= No_Path_Information
3435 and then Project.Library_Name /= No_Name;
3437 if Project.Extends = No_Project then
3438 case Project.Qualifier is
3440 if Project.Library then
3443 "a standard project cannot be a library project
",
3444 Lib_Name.Location, Project);
3447 when Library | Aggregate_Library =>
3448 if not Project.Library then
3449 if Project.Library_Name = No_Name then
3452 "attribute Library_Name
not declared
",
3453 Project.Location, Project);
3455 if not Library_Directory_Present then
3458 "\attribute Library_Dir
not declared
",
3459 Project.Location, Project);
3462 elsif Project.Library_Dir = No_Path_Information then
3465 "attribute Library_Dir
not declared
",
3466 Project.Location, Project);
3475 if Project.Library then
3476 Support_For_Libraries := Project.Config.Lib_Support;
3478 if not Project.Externally_Built
3479 and then Support_For_Libraries = Prj.None
3483 "?libraries are
not supported on this platform
",
3484 Lib_Name.Location, Project);
3485 Project.Library := False;
3488 if Lib_ALI_Dir.Value = Empty_String then
3489 Debug_Output ("no library ALI directory specified
");
3490 Project.Library_ALI_Dir := Project.Library_Dir;
3493 -- Find path name, check that it is a directory
3497 File_Name_Type (Lib_ALI_Dir.Value),
3498 Path => Project.Library_ALI_Dir,
3499 Create => "library ALI
",
3500 Dir_Exists => Dir_Exists,
3502 Must_Exist => False,
3503 Location => Lib_ALI_Dir.Location,
3504 Externally_Built => Project.Externally_Built);
3506 if not Dir_Exists then
3508 -- Get the absolute name of the library ALI directory that
3509 -- does not exist, to report an error.
3511 Err_Vars.Error_Msg_File_1 :=
3512 File_Name_Type (Project.Library_ALI_Dir.Display_Name);
3515 "library
'A'L'I directory
{ does
not exist
",
3516 Lib_ALI_Dir.Location, Project);
3519 if not Project.Externally_Built
3520 and then Project.Library_ALI_Dir /= Project.Library_Dir
3522 -- The library ALI directory cannot be the same as the
3523 -- Object directory.
3525 if Project.Library_ALI_Dir = Project.Object_Directory then
3528 "library
'A'L'I directory cannot be the same
" &
3529 "as object directory
",
3530 Lib_ALI_Dir.Location, Project);
3531 Project.Library_ALI_Dir := No_Path_Information;
3535 OK : Boolean := True;
3536 Dirs_Id : String_List_Id;
3537 Dir_Elem : String_Element;
3541 -- The library ALI directory cannot be the same as
3542 -- a source directory of the current project.
3544 Dirs_Id := Project.Source_Dirs;
3545 while Dirs_Id /= Nil_String loop
3546 Dir_Elem := Shared.String_Elements.Table (Dirs_Id);
3547 Dirs_Id := Dir_Elem.Next;
3549 if Project.Library_ALI_Dir.Name =
3550 Path_Name_Type (Dir_Elem.Value)
3552 Err_Vars.Error_Msg_File_1 :=
3553 File_Name_Type (Dir_Elem.Value);
3556 "library
'A'L'I directory cannot be
" &
3557 "the same as source directory
{",
3558 Lib_ALI_Dir.Location, Project);
3566 -- The library ALI directory cannot be the same as
3567 -- a source directory of another project either.
3569 Pid := Data.Tree.Projects;
3570 ALI_Project_Loop : loop
3571 exit ALI_Project_Loop when Pid = null;
3573 if Pid.Project /= Project then
3574 Dirs_Id := Pid.Project.Source_Dirs;
3577 while Dirs_Id /= Nil_String loop
3579 Shared.String_Elements.Table (Dirs_Id);
3580 Dirs_Id := Dir_Elem.Next;
3582 if Project.Library_ALI_Dir.Name =
3583 Path_Name_Type (Dir_Elem.Value)
3585 Err_Vars.Error_Msg_File_1 :=
3586 File_Name_Type (Dir_Elem.Value);
3587 Err_Vars.Error_Msg_Name_1 :=
3592 "library
'A'L'I directory cannot
" &
3593 "be the same as source directory
" &
3595 Lib_ALI_Dir.Location, Project);
3597 exit ALI_Project_Loop;
3599 end loop ALI_Dir_Loop;
3602 end loop ALI_Project_Loop;
3606 Project.Library_ALI_Dir := No_Path_Information;
3608 elsif Current_Verbosity = High then
3610 -- Display Library ALI directory in high verbosity
3615 (Project.Library_ALI_Dir.Display_Name));
3622 pragma Assert (Lib_Version.Kind = Single);
3624 if Lib_Version.Value = Empty_String then
3625 Debug_Output ("no library version specified
");
3628 Project.Lib_Internal_Name := Lib_Version.Value;
3631 pragma Assert (The_Lib_Kind.Kind = Single);
3633 if The_Lib_Kind.Value = Empty_String then
3634 Debug_Output ("no library kind specified
");
3637 Get_Name_String (The_Lib_Kind.Value);
3640 Kind_Name : constant String :=
3641 To_Lower (Name_Buffer (1 .. Name_Len));
3643 OK : Boolean := True;
3646 if Kind_Name = "static
" then
3647 Project.Library_Kind := Static;
3649 elsif Kind_Name = "dynamic
" then
3650 Project.Library_Kind := Dynamic;
3652 elsif Kind_Name = "relocatable
" then
3653 Project.Library_Kind := Relocatable;
3658 "illegal value
for Library_Kind
",
3659 The_Lib_Kind.Location, Project);
3663 if Current_Verbosity = High and then OK then
3664 Write_Attr ("Library kind
", Kind_Name);
3667 if Project.Library_Kind /= Static then
3668 if not Project.Externally_Built
3669 and then Support_For_Libraries = Prj.Static_Only
3673 "only static libraries are supported
" &
3675 The_Lib_Kind.Location, Project);
3676 Project.Library := False;
3679 -- Check if (obsolescent) attribute Library_GCC or
3680 -- Linker'Driver is declared.
3682 if Lib_GCC.Value /= Empty_String then
3685 "?Library_
'G'C'C is an obsolescent attribute, " &
3686 "use Linker''Driver instead",
3687 Lib_GCC.Location, Project);
3688 Project.Config.Shared_Lib_Driver :=
3689 File_Name_Type (Lib_GCC.Value);
3693 Linker : constant Package_Id :=
3696 Project.Decl.Packages,
3698 Driver : constant Variable_Value :=
3701 Attribute_Or_Array_Name =>
3703 In_Package => Linker,
3707 if Driver /= Nil_Variable_Value
3708 and then Driver.Value /= Empty_String
3710 Project.Config.Shared_Lib_Driver :=
3711 File_Name_Type (Driver.Value);
3721 and then Project.Qualifier /= Aggregate_Library
3723 Debug_Output ("this is a library project file");
3725 Check_Library (Project.Extends, Extends => True);
3727 Imported_Project_List := Project.Imported_Projects;
3728 while Imported_Project_List /= null loop
3730 (Imported_Project_List.Project,
3732 Imported_Project_List := Imported_Project_List.Next;
3738 -- Check if Linker'Switches or Linker'Default_Switches are declared.
3739 -- Warn if they are declared, as it is a common error to think that
3740 -- library are "linked" with Linker switches.
3742 if Project.Library then
3744 Linker_Package_Id : constant Package_Id :=
3747 Project.Decl.Packages, Shared);
3748 Linker_Package : Package_Element;
3749 Switches : Array_Element_Id := No_Array_Element;
3752 if Linker_Package_Id /= No_Package then
3753 Linker_Package := Shared.Packages.Table (Linker_Package_Id);
3757 (Name => Name_Switches,
3758 In_Arrays => Linker_Package.Decl.Arrays,
3761 if Switches = No_Array_Element then
3764 (Name => Name_Default_Switches,
3765 In_Arrays => Linker_Package.Decl.Arrays,
3769 if Switches /= No_Array_Element then
3772 "?Linker switches not taken into account in library " &
3774 No_Location, Project);
3780 if Project.Extends /= No_Project and then Project.Extends.Library then
3782 -- Remove the library name from Lib_Data_Table
3784 for J in 1 .. Lib_Data_Table.Last loop
3785 if Lib_Data_Table.Table (J).Proj = Project.Extends then
3786 Lib_Data_Table.Table (J) :=
3787 Lib_Data_Table.Table (Lib_Data_Table.Last);
3788 Lib_Data_Table.Set_Last (Lib_Data_Table.Last - 1);
3794 if Project.Library and then not Lib_Name.Default then
3796 -- Check if the same library name is used in an other library project
3798 for J in 1 .. Lib_Data_Table.Last loop
3799 if Lib_Data_Table.Table (J).Name = Project.Library_Name
3800 and then Lib_Data_Table.Table (J).Tree = Data.Tree
3802 Error_Msg_Name_1 := Lib_Data_Table.Table (J).Proj.Name;
3805 "Library name cannot be the same as in project %%",
3806 Lib_Name.Location, Project);
3807 Project.Library := False;
3813 if not Lib_Standalone.Default
3814 and then Project.Library_Kind = Static
3816 -- An standalone library must be a shared library
3818 Error_Msg_Name_1 := Project.Name;
3823 "standalone library project %% must be a shared library",
3824 Project.Location, Project);
3825 Continuation := Continuation_String'Access;
3828 -- Check that aggregated libraries do not share the aggregate
3831 if Project.Qualifier = Aggregate_Library then
3832 Check_Aggregate_Library_Dirs;
3835 if Project.Library and not Data.In_Aggregate_Lib then
3837 -- Record the library name
3839 Lib_Data_Table.Append
3840 ((Name => Project.Library_Name,
3842 Tree => Data.Tree));
3844 end Check_Library_Attributes;
3846 --------------------------
3847 -- Check_Package_Naming --
3848 --------------------------
3850 procedure Check_Package_Naming
3851 (Project : Project_Id;
3852 Data : in out Tree_Processing_Data)
3854 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
3855 Naming_Id : constant Package_Id :=
3857 (Name_Naming, Project.Decl.Packages, Shared);
3858 Naming : Package_Element;
3860 Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
3862 procedure Check_Naming;
3863 -- Check the validity of the Naming package (suffixes valid, ...)
3865 procedure Check_Common
3866 (Dot_Replacement : in out File_Name_Type;
3867 Casing : in out Casing_Type;
3868 Casing_Defined : out Boolean;
3869 Separate_Suffix : in out File_Name_Type;
3870 Sep_Suffix_Loc : out Source_Ptr);
3871 -- Check attributes common
3873 procedure Process_Exceptions_File_Based
3874 (Lang_Id : Language_Ptr;
3875 Kind : Source_Kind);
3876 procedure Process_Exceptions_Unit_Based
3877 (Lang_Id : Language_Ptr;
3878 Kind : Source_Kind);
3879 -- Process the naming exceptions for the two types of languages
3881 procedure Initialize_Naming_Data;
3882 -- Initialize internal naming data for the various languages
3888 procedure Check_Common
3889 (Dot_Replacement : in out File_Name_Type;
3890 Casing : in out Casing_Type;
3891 Casing_Defined : out Boolean;
3892 Separate_Suffix : in out File_Name_Type;
3893 Sep_Suffix_Loc : out Source_Ptr)
3895 Dot_Repl : constant Variable_Value :=
3897 (Name_Dot_Replacement,
3898 Naming.Decl.Attributes,
3900 Casing_String : constant Variable_Value :=
3903 Naming.Decl.Attributes,
3905 Sep_Suffix : constant Variable_Value :=
3907 (Name_Separate_Suffix,
3908 Naming.Decl.Attributes,
3910 Dot_Repl_Loc : Source_Ptr;
3913 Sep_Suffix_Loc := No_Location;
3915 if not Dot_Repl.Default then
3917 (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
3919 if Length_Of_Name (Dot_Repl.Value) = 0 then
3921 (Data.Flags, "Dot_Replacement cannot be empty",
3922 Dot_Repl.Location, Project);
3925 Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
3926 Dot_Repl_Loc := Dot_Repl.Location;
3929 Repl : constant String := Get_Name_String (Dot_Replacement);
3932 -- Dot_Replacement cannot
3934 -- - start or end with an alphanumeric
3935 -- - be a single '_
'
3936 -- - start with an '_
' followed by an alphanumeric
3937 -- - contain a '.' except if it is "."
3940 or else Is_Alphanumeric (Repl (Repl'First))
3941 or else Is_Alphanumeric (Repl (Repl'Last))
3942 or else (Repl (Repl'First) = '_
'
3946 Is_Alphanumeric (Repl (Repl'First + 1))))
3947 or else (Repl'Length > 1
3949 Index (Source => Repl, Pattern => ".") /= 0)
3954 """ is illegal
for Dot_Replacement
.",
3955 Dot_Repl_Loc, Project);
3960 if Dot_Replacement /= No_File then
3962 ("Dot_Replacement
", Get_Name_String (Dot_Replacement));
3965 Casing_Defined := False;
3967 if not Casing_String.Default then
3969 (Casing_String.Kind = Single, "Casing
is not a
string");
3972 Casing_Image : constant String :=
3973 Get_Name_String (Casing_String.Value);
3976 if Casing_Image'Length = 0 then
3979 "Casing cannot be an empty
string",
3980 Casing_String.Location, Project);
3983 Casing := Value (Casing_Image);
3984 Casing_Defined := True;
3987 when Constraint_Error =>
3988 Name_Len := Casing_Image'Length;
3989 Name_Buffer (1 .. Name_Len) := Casing_Image;
3990 Err_Vars.Error_Msg_Name_1 := Name_Find;
3993 "%% is not a correct Casing
",
3994 Casing_String.Location, Project);
3998 Write_Attr ("Casing
", Image (Casing));
4000 if not Sep_Suffix.Default then
4001 if Length_Of_Name (Sep_Suffix.Value) = 0 then
4004 "Separate_Suffix cannot be empty
",
4005 Sep_Suffix.Location, Project);
4008 Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
4009 Sep_Suffix_Loc := Sep_Suffix.Location;
4011 Check_Illegal_Suffix
4012 (Project, Separate_Suffix,
4013 Dot_Replacement, "Separate_Suffix
", Sep_Suffix.Location,
4018 if Separate_Suffix /= No_File then
4020 ("Separate_Suffix
", Get_Name_String (Separate_Suffix));
4024 -----------------------------------
4025 -- Process_Exceptions_File_Based --
4026 -----------------------------------
4028 procedure Process_Exceptions_File_Based
4029 (Lang_Id : Language_Ptr;
4032 Lang : constant Name_Id := Lang_Id.Name;
4033 Exceptions : Array_Element_Id;
4034 Exception_List : Variable_Value;
4035 Element_Id : String_List_Id;
4036 Element : String_Element;
4037 File_Name : File_Name_Type;
4045 (Name_Implementation_Exceptions,
4046 In_Arrays => Naming.Decl.Arrays,
4052 (Name_Specification_Exceptions,
4053 In_Arrays => Naming.Decl.Arrays,
4060 In_Array => Exceptions,
4063 if Exception_List /= Nil_Variable_Value then
4064 Element_Id := Exception_List.Values;
4065 while Element_Id /= Nil_String loop
4066 Element := Shared.String_Elements.Table (Element_Id);
4067 File_Name := Canonical_Case_File_Name (Element.Value);
4070 Source_Files_Htable.Get
4071 (Data.Tree.Source_Files_HT, File_Name);
4072 while Source /= No_Source
4073 and then Source.Project /= Project
4075 Source := Source.Next_With_File_Name;
4078 if Source = No_Source then
4083 Source_Dir_Rank => 0,
4086 File_Name => File_Name,
4087 Display_File => File_Name_Type (Element.Value),
4088 Naming_Exception => Yes,
4089 Location => Element.Location);
4092 -- Check if the file name is already recorded for another
4093 -- language or another kind.
4095 if Source.Language /= Lang_Id then
4098 "the same file cannot be a source
of two languages
",
4099 Element.Location, Project);
4101 elsif Source.Kind /= Kind then
4104 "the same file cannot be a source
and a template
",
4105 Element.Location, Project);
4108 -- If the file is already recorded for the same
4109 -- language and the same kind, it means that the file
4110 -- name appears several times in the *_Exceptions
4111 -- attribute; so there is nothing to do.
4114 Element_Id := Element.Next;
4117 end Process_Exceptions_File_Based;
4119 -----------------------------------
4120 -- Process_Exceptions_Unit_Based --
4121 -----------------------------------
4123 procedure Process_Exceptions_Unit_Based
4124 (Lang_Id : Language_Ptr;
4127 Exceptions : Array_Element_Id;
4128 Element : Array_Element;
4131 File_Name : File_Name_Type;
4134 Naming_Exception : Naming_Exception_Type;
4142 In_Arrays => Naming.Decl.Arrays,
4145 if Exceptions = No_Array_Element then
4148 (Name_Implementation,
4149 In_Arrays => Naming.Decl.Arrays,
4157 In_Arrays => Naming.Decl.Arrays,
4160 if Exceptions = No_Array_Element then
4163 (Name_Specification,
4164 In_Arrays => Naming.Decl.Arrays,
4169 while Exceptions /= No_Array_Element loop
4170 Element := Shared.Array_Elements.Table (Exceptions);
4172 if Element.Restricted then
4173 Naming_Exception := Inherited;
4175 Naming_Exception := Yes;
4178 File_Name := Canonical_Case_File_Name (Element.Value.Value);
4180 Get_Name_String (Element.Index);
4181 To_Lower (Name_Buffer (1 .. Name_Len));
4182 Index := Element.Value.Index;
4184 -- Check if it is a valid unit name
4186 Get_Name_String (Element.Index);
4187 Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit);
4189 if Unit = No_Name then
4190 Err_Vars.Error_Msg_Name_1 := Element.Index;
4193 "%% is not a valid unit name
.",
4194 Element.Value.Location, Project);
4197 if Unit /= No_Name then
4202 Source_Dir_Rank => 0,
4205 File_Name => File_Name,
4206 Display_File => File_Name_Type (Element.Value.Value),
4209 Location => Element.Value.Location,
4210 Naming_Exception => Naming_Exception);
4213 Exceptions := Element.Next;
4215 end Process_Exceptions_Unit_Based;
4221 procedure Check_Naming is
4222 Dot_Replacement : File_Name_Type :=
4224 (First_Name_Id + Character'Pos ('-'));
4225 Separate_Suffix : File_Name_Type := No_File;
4226 Casing : Casing_Type := All_Lower_Case;
4227 Casing_Defined : Boolean;
4228 Lang_Id : Language_Ptr;
4229 Sep_Suffix_Loc : Source_Ptr;
4230 Suffix : Variable_Value;
4235 (Dot_Replacement => Dot_Replacement,
4237 Casing_Defined => Casing_Defined,
4238 Separate_Suffix => Separate_Suffix,
4239 Sep_Suffix_Loc => Sep_Suffix_Loc);
4241 -- For all unit based languages, if any, set the specified value
4242 -- of Dot_Replacement, Casing and/or Separate_Suffix. Do not
4243 -- systematically overwrite, since the defaults come from the
4244 -- configuration file.
4246 if Dot_Replacement /= No_File
4247 or else Casing_Defined
4248 or else Separate_Suffix /= No_File
4250 Lang_Id := Project.Languages;
4251 while Lang_Id /= No_Language_Index loop
4252 if Lang_Id.Config.Kind = Unit_Based then
4253 if Dot_Replacement /= No_File then
4254 Lang_Id.Config.Naming_Data.Dot_Replacement :=
4258 if Casing_Defined then
4259 Lang_Id.Config.Naming_Data.Casing := Casing;
4263 Lang_Id := Lang_Id.Next;
4267 -- Next, get the spec and body suffixes
4269 Lang_Id := Project.Languages;
4270 while Lang_Id /= No_Language_Index loop
4271 Lang := Lang_Id.Name;
4277 Attribute_Or_Array_Name => Name_Spec_Suffix,
4278 In_Package => Naming_Id,
4281 if Suffix = Nil_Variable_Value then
4284 Attribute_Or_Array_Name => Name_Specification_Suffix,
4285 In_Package => Naming_Id,
4289 if Suffix /= Nil_Variable_Value then
4290 Lang_Id.Config.Naming_Data.Spec_Suffix :=
4291 File_Name_Type (Suffix.Value);
4293 Check_Illegal_Suffix
4295 Lang_Id.Config.Naming_Data.Spec_Suffix,
4296 Lang_Id.Config.Naming_Data.Dot_Replacement,
4297 "Spec_Suffix
", Suffix.Location, Data);
4301 Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix));
4309 Attribute_Or_Array_Name => Name_Body_Suffix,
4310 In_Package => Naming_Id,
4313 if Suffix = Nil_Variable_Value then
4317 Attribute_Or_Array_Name => Name_Implementation_Suffix,
4318 In_Package => Naming_Id,
4322 if Suffix /= Nil_Variable_Value then
4323 Lang_Id.Config.Naming_Data.Body_Suffix :=
4324 File_Name_Type (Suffix.Value);
4326 -- The default value of separate suffix should be the same as
4327 -- the body suffix, so we need to compute that first.
4329 if Separate_Suffix = No_File then
4330 Lang_Id.Config.Naming_Data.Separate_Suffix :=
4331 Lang_Id.Config.Naming_Data.Body_Suffix;
4335 (Lang_Id.Config.Naming_Data.Separate_Suffix));
4337 Lang_Id.Config.Naming_Data.Separate_Suffix :=
4341 Check_Illegal_Suffix
4343 Lang_Id.Config.Naming_Data.Body_Suffix,
4344 Lang_Id.Config.Naming_Data.Dot_Replacement,
4345 "Body_Suffix
", Suffix.Location, Data);
4349 Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix));
4351 elsif Separate_Suffix /= No_File then
4352 Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix;
4355 -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
4356 -- since that would cause a clear ambiguity. Note that we do allow
4357 -- a Spec_Suffix to have the same termination as one of these,
4358 -- which causes a potential ambiguity, but we resolve that by
4359 -- matching the longest possible suffix.
4361 if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
4362 and then Lang_Id.Config.Naming_Data.Spec_Suffix =
4363 Lang_Id.Config.Naming_Data.Body_Suffix
4368 & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)
4369 & """) cannot be the same as Spec_Suffix
.",
4370 Ada_Body_Suffix_Loc, Project);
4373 if Lang_Id.Config.Naming_Data.Body_Suffix /=
4374 Lang_Id.Config.Naming_Data.Separate_Suffix
4375 and then Lang_Id.Config.Naming_Data.Spec_Suffix =
4376 Lang_Id.Config.Naming_Data.Separate_Suffix
4380 "Separate_Suffix
("""
4382 (Lang_Id.Config.Naming_Data.Separate_Suffix)
4383 & """) cannot be the same as Spec_Suffix
.",
4384 Sep_Suffix_Loc, Project);
4387 Lang_Id := Lang_Id.Next;
4390 -- Get the naming exceptions for all languages, but not for virtual
4393 if not Project.Virtual then
4394 for Kind in Spec_Or_Body loop
4395 Lang_Id := Project.Languages;
4396 while Lang_Id /= No_Language_Index loop
4397 case Lang_Id.Config.Kind is
4399 Process_Exceptions_File_Based (Lang_Id, Kind);
4402 Process_Exceptions_Unit_Based (Lang_Id, Kind);
4405 Lang_Id := Lang_Id.Next;
4411 ----------------------------
4412 -- Initialize_Naming_Data --
4413 ----------------------------
4415 procedure Initialize_Naming_Data is
4416 Specs : Array_Element_Id :=
4422 Impls : Array_Element_Id :=
4428 Lang : Language_Ptr;
4429 Lang_Name : Name_Id;
4430 Value : Variable_Value;
4431 Extended : Project_Id;
4434 -- At this stage, the project already contains the default extensions
4435 -- for the various languages. We now merge those suffixes read in the
4436 -- user project, and they override the default.
4438 while Specs /= No_Array_Element loop
4439 Lang_Name := Shared.Array_Elements.Table (Specs).Index;
4441 Get_Language_From_Name
4442 (Project, Name => Get_Name_String (Lang_Name));
4444 -- An extending project inherits its parent projects' languages
4445 -- so if needed we should create entries for those languages
4448 Extended := Project.Extends;
4449 while Extended /= null loop
4450 Lang := Get_Language_From_Name
4451 (Extended, Name => Get_Name_String (Lang_Name));
4452 exit when Lang /= null;
4454 Extended := Extended.Extends;
4457 if Lang /= null then
4458 Lang := new Language_Data'(Lang.all);
4459 Lang.First_Source := null;
4460 Lang.Next := Project.Languages;
4461 Project.Languages := Lang;
4465 -- If language was not found in project or the projects it extends
4469 ("ignoring spec naming data
(lang
. not in project
): ",
4473 Value := Shared.Array_Elements.Table (Specs).Value;
4475 if Value.Kind = Single then
4476 Lang.Config.Naming_Data.Spec_Suffix :=
4477 Canonical_Case_File_Name (Value.Value);
4481 Specs := Shared.Array_Elements.Table (Specs).Next;
4484 while Impls /= No_Array_Element loop
4485 Lang_Name := Shared.Array_Elements.Table (Impls).Index;
4487 Get_Language_From_Name
4488 (Project, Name => Get_Name_String (Lang_Name));
4492 ("ignoring impl naming data
(lang
. not in project
): ",
4495 Value := Shared.Array_Elements.Table (Impls).Value;
4497 if Lang.Name = Name_Ada then
4498 Ada_Body_Suffix_Loc := Value.Location;
4501 if Value.Kind = Single then
4502 Lang.Config.Naming_Data.Body_Suffix :=
4503 Canonical_Case_File_Name (Value.Value);
4507 Impls := Shared.Array_Elements.Table (Impls).Next;
4509 end Initialize_Naming_Data;
4511 -- Start of processing for Check_Naming_Schemes
4514 -- No Naming package or parsing a configuration file? nothing to do
4516 if Naming_Id /= No_Package
4517 and then Project.Qualifier /= Configuration
4519 Naming := Shared.Packages.Table (Naming_Id);
4520 Debug_Increase_Indent ("checking
package Naming
for ", Project.Name);
4521 Initialize_Naming_Data;
4523 Debug_Decrease_Indent ("done checking
package naming
");
4525 end Check_Package_Naming;
4527 ---------------------------------
4528 -- Check_Programming_Languages --
4529 ---------------------------------
4531 procedure Check_Programming_Languages
4532 (Project : Project_Id;
4533 Data : in out Tree_Processing_Data)
4535 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
4537 Languages : Variable_Value := Nil_Variable_Value;
4538 Def_Lang : Variable_Value := Nil_Variable_Value;
4539 Def_Lang_Id : Name_Id;
4541 procedure Add_Language (Name, Display_Name : Name_Id);
4542 -- Add a new language to the list of languages for the project.
4543 -- Nothing is done if the language has already been defined
4549 procedure Add_Language (Name, Display_Name : Name_Id) is
4550 Lang : Language_Ptr;
4553 Lang := Project.Languages;
4554 while Lang /= No_Language_Index loop
4555 if Name = Lang.Name then
4562 Lang := new Language_Data'(No_Language_Data);
4563 Lang.Next := Project.Languages;
4564 Project.Languages := Lang;
4566 Lang.Display_Name := Display_Name;
4569 -- Start of processing for Check_Programming_Languages
4572 Project.Languages := null;
4574 Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
4577 (Name_Default_Language, Project.Decl.Attributes, Shared);
4579 if Project.Source_Dirs /= Nil_String then
4581 -- Check if languages are specified in this project
4583 if Languages.Default then
4585 -- Fail if there is no default language defined
4587 if Def_Lang.Default then
4590 "no languages defined
for this project
",
4591 Project.Location, Project);
4592 Def_Lang_Id := No_Name;
4595 Get_Name_String (Def_Lang.Value);
4596 To_Lower (Name_Buffer (1 .. Name_Len));
4597 Def_Lang_Id := Name_Find;
4600 if Def_Lang_Id /= No_Name then
4601 Get_Name_String (Def_Lang_Id);
4602 Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
4604 (Name => Def_Lang_Id,
4605 Display_Name => Name_Find);
4610 Current : String_List_Id := Languages.Values;
4611 Element : String_Element;
4614 -- If there are no languages declared, there are no sources
4616 if Current = Nil_String then
4617 Project.Source_Dirs := Nil_String;
4619 if Project.Qualifier = Standard then
4622 "a standard project must have
at least one language
",
4623 Languages.Location, Project);
4627 -- Look through all the languages specified in attribute
4630 while Current /= Nil_String loop
4631 Element := Shared.String_Elements.Table (Current);
4632 Get_Name_String (Element.Value);
4633 To_Lower (Name_Buffer (1 .. Name_Len));
4637 Display_Name => Element.Value);
4639 Current := Element.Next;
4645 end Check_Programming_Languages;
4647 -------------------------------
4648 -- Check_Stand_Alone_Library --
4649 -------------------------------
4651 procedure Check_Stand_Alone_Library
4652 (Project : Project_Id;
4653 Data : in out Tree_Processing_Data)
4655 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
4657 Lib_Name : constant Prj.Variable_Value :=
4659 (Snames.Name_Library_Name,
4660 Project.Decl.Attributes,
4663 Lib_Standalone : constant Prj.Variable_Value :=
4665 (Snames.Name_Library_Standalone,
4666 Project.Decl.Attributes,
4669 Lib_Auto_Init : constant Prj.Variable_Value :=
4671 (Snames.Name_Library_Auto_Init,
4672 Project.Decl.Attributes,
4675 Lib_Src_Dir : constant Prj.Variable_Value :=
4677 (Snames.Name_Library_Src_Dir,
4678 Project.Decl.Attributes,
4681 Lib_Symbol_File : constant Prj.Variable_Value :=
4683 (Snames.Name_Library_Symbol_File,
4684 Project.Decl.Attributes,
4687 Lib_Symbol_Policy : constant Prj.Variable_Value :=
4689 (Snames.Name_Library_Symbol_Policy,
4690 Project.Decl.Attributes,
4693 Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
4695 (Snames.Name_Library_Reference_Symbol_File,
4696 Project.Decl.Attributes,
4699 Auto_Init_Supported : Boolean;
4700 OK : Boolean := True;
4703 Auto_Init_Supported := Project.Config.Auto_Init_Supported;
4705 -- It is a stand-alone library project file if there is at least one
4706 -- unit in the declared or inherited interface.
4708 if Project.Lib_Interface_ALIs = Nil_String then
4709 if not Lib_Standalone.Default
4710 and then Get_Name_String (Lib_Standalone.Value) /= "no
"
4714 "Library_Standalone valid only
if Library_Interface
is set
",
4715 Lib_Standalone.Location, Project);
4719 if Project.Standalone_Library = No then
4720 Project.Standalone_Library := Standard;
4723 -- The name of a stand-alone library needs to have the syntax of an
4727 Name : constant String := Get_Name_String (Project.Library_Name);
4728 OK : Boolean := Is_Letter (Name (Name'First));
4730 Underline : Boolean := False;
4733 for J in Name'First + 1 .. Name'Last loop
4736 if Is_Alphanumeric (Name (J)) then
4739 elsif Name (J) = '_' then
4751 OK := OK and not Underline;
4756 "Incorrect library name
for a Stand
-Alone Library
",
4757 Lib_Name.Location, Project);
4762 if Lib_Standalone.Default then
4763 Project.Standalone_Library := Standard;
4766 Get_Name_String (Lib_Standalone.Value);
4767 To_Lower (Name_Buffer (1 .. Name_Len));
4769 if Name_Buffer (1 .. Name_Len) = "standard
" then
4770 Project.Standalone_Library := Standard;
4772 elsif Name_Buffer (1 .. Name_Len) = "encapsulated
" then
4773 Project.Standalone_Library := Encapsulated;
4775 elsif Name_Buffer (1 .. Name_Len) = "no
" then
4776 Project.Standalone_Library := No;
4779 "wrong value
for Library_Standalone
"
4780 & "when Library_Interface defined
",
4781 Lib_Standalone.Location, Project);
4786 "invalid value
for attribute Library_Standalone
",
4787 Lib_Standalone.Location, Project);
4791 -- Check value of attribute Library_Auto_Init and set Lib_Auto_Init
4794 if Lib_Auto_Init.Default then
4796 -- If no attribute Library_Auto_Init is declared, then set auto
4797 -- init only if it is supported.
4799 Project.Lib_Auto_Init := Auto_Init_Supported;
4802 Get_Name_String (Lib_Auto_Init.Value);
4803 To_Lower (Name_Buffer (1 .. Name_Len));
4805 if Name_Buffer (1 .. Name_Len) = "false" then
4806 Project.Lib_Auto_Init := False;
4808 elsif Name_Buffer (1 .. Name_Len) = "true" then
4809 if Auto_Init_Supported then
4810 Project.Lib_Auto_Init := True;
4813 -- Library_Auto_Init cannot be "true" if auto init is not
4818 "library auto init
not supported
" &
4820 Lib_Auto_Init.Location, Project);
4826 "invalid value
for attribute Library_Auto_Init
",
4827 Lib_Auto_Init.Location, Project);
4831 -- If attribute Library_Src_Dir is defined and not the empty string,
4832 -- check if the directory exist and is not the object directory or
4833 -- one of the source directories. This is the directory where copies
4834 -- of the interface sources will be copied. Note that this directory
4835 -- may be the library directory.
4837 if Lib_Src_Dir.Value /= Empty_String then
4839 Dir_Id : constant File_Name_Type :=
4840 File_Name_Type (Lib_Src_Dir.Value);
4841 Dir_Exists : Boolean;
4847 Path => Project.Library_Src_Dir,
4848 Dir_Exists => Dir_Exists,
4850 Must_Exist => False,
4851 Create => "library source copy
",
4852 Location => Lib_Src_Dir.Location,
4853 Externally_Built => Project.Externally_Built);
4855 -- If directory does not exist, report an error
4857 if not Dir_Exists then
4859 -- Get the absolute name of the library directory that does
4860 -- not exist, to report an error.
4862 Err_Vars.Error_Msg_File_1 :=
4863 File_Name_Type (Project.Library_Src_Dir.Display_Name);
4866 "Directory
{ does
not exist
",
4867 Lib_Src_Dir.Location, Project);
4869 -- Report error if it is the same as the object directory
4871 elsif Project.Library_Src_Dir = Project.Object_Directory then
4874 "directory to copy interfaces cannot be
" &
4875 "the object directory
",
4876 Lib_Src_Dir.Location, Project);
4877 Project.Library_Src_Dir := No_Path_Information;
4881 Src_Dirs : String_List_Id;
4882 Src_Dir : String_Element;
4886 -- Interface copy directory cannot be one of the source
4887 -- directory of the current project.
4889 Src_Dirs := Project.Source_Dirs;
4890 while Src_Dirs /= Nil_String loop
4891 Src_Dir := Shared.String_Elements.Table (Src_Dirs);
4893 -- Report error if it is one of the source directories
4895 if Project.Library_Src_Dir.Name =
4896 Path_Name_Type (Src_Dir.Value)
4900 "directory to copy interfaces cannot
" &
4901 "be one
of the source directories
",
4902 Lib_Src_Dir.Location, Project);
4903 Project.Library_Src_Dir := No_Path_Information;
4907 Src_Dirs := Src_Dir.Next;
4910 if Project.Library_Src_Dir /= No_Path_Information then
4912 -- It cannot be a source directory of any other
4915 Pid := Data.Tree.Projects;
4917 exit Project_Loop when Pid = null;
4919 Src_Dirs := Pid.Project.Source_Dirs;
4920 Dir_Loop : while Src_Dirs /= Nil_String loop
4922 Shared.String_Elements.Table (Src_Dirs);
4924 -- Report error if it is one of the source
4927 if Project.Library_Src_Dir.Name =
4928 Path_Name_Type (Src_Dir.Value)
4931 File_Name_Type (Src_Dir.Value);
4932 Error_Msg_Name_1 := Pid.Project.Name;
4935 "directory to copy interfaces cannot
" &
4936 "be the same as source directory
{ of " &
4938 Lib_Src_Dir.Location, Project);
4939 Project.Library_Src_Dir :=
4940 No_Path_Information;
4944 Src_Dirs := Src_Dir.Next;
4948 end loop Project_Loop;
4952 -- In high verbosity, if there is a valid Library_Src_Dir,
4953 -- display its path name.
4955 if Project.Library_Src_Dir /= No_Path_Information
4956 and then Current_Verbosity = High
4959 ("Directory to copy interfaces
",
4960 Get_Name_String (Project.Library_Src_Dir.Name));
4966 -- Check the symbol related attributes
4968 -- First, the symbol policy
4970 if not Lib_Symbol_Policy.Default then
4972 Value : constant String :=
4974 (Get_Name_String (Lib_Symbol_Policy.Value));
4977 -- Symbol policy must have one of a limited number of values
4979 if Value = "autonomous
" or else Value = "default
" then
4980 Project.Symbol_Data.Symbol_Policy := Autonomous;
4982 elsif Value = "compliant
" then
4983 Project.Symbol_Data.Symbol_Policy := Compliant;
4985 elsif Value = "controlled
" then
4986 Project.Symbol_Data.Symbol_Policy := Controlled;
4988 elsif Value = "restricted
" then
4989 Project.Symbol_Data.Symbol_Policy := Restricted;
4991 elsif Value = "direct
" then
4992 Project.Symbol_Data.Symbol_Policy := Direct;
4997 "illegal value
for Library_Symbol_Policy
",
4998 Lib_Symbol_Policy.Location, Project);
5003 -- If attribute Library_Symbol_File is not specified, symbol policy
5004 -- cannot be Restricted.
5006 if Lib_Symbol_File.Default then
5007 if Project.Symbol_Data.Symbol_Policy = Restricted then
5010 "Library_Symbol_File needs to be defined
when " &
5011 "symbol policy
is Restricted
",
5012 Lib_Symbol_Policy.Location, Project);
5016 -- Library_Symbol_File is defined
5018 Project.Symbol_Data.Symbol_File :=
5019 Path_Name_Type (Lib_Symbol_File.Value);
5021 Get_Name_String (Lib_Symbol_File.Value);
5023 if Name_Len = 0 then
5026 "symbol file name cannot be an empty
string",
5027 Lib_Symbol_File.Location, Project);
5030 OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
5033 for J in 1 .. Name_Len loop
5034 if Name_Buffer (J) = '/'
5036 Name_Buffer (J) = Directory_Separator
5045 Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
5048 "symbol file name
{ is illegal
. " &
5049 "Name cannot include directory info
.",
5050 Lib_Symbol_File.Location, Project);
5055 -- If attribute Library_Reference_Symbol_File is not defined,
5056 -- symbol policy cannot be Compliant or Controlled.
5058 if Lib_Ref_Symbol_File.Default then
5059 if Project.Symbol_Data.Symbol_Policy = Compliant
5060 or else Project.Symbol_Data.Symbol_Policy = Controlled
5064 "a reference symbol file needs to be defined
",
5065 Lib_Symbol_Policy.Location, Project);
5069 -- Library_Reference_Symbol_File is defined, check file exists
5071 Project.Symbol_Data.Reference :=
5072 Path_Name_Type (Lib_Ref_Symbol_File.Value);
5074 Get_Name_String (Lib_Ref_Symbol_File.Value);
5076 if Name_Len = 0 then
5079 "reference symbol file name cannot be an empty
string",
5080 Lib_Symbol_File.Location, Project);
5083 if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
5085 Add_Str_To_Name_Buffer
5086 (Get_Name_String (Project.Directory.Name));
5087 Add_Str_To_Name_Buffer
5088 (Get_Name_String (Lib_Ref_Symbol_File.Value));
5089 Project.Symbol_Data.Reference := Name_Find;
5092 if not Is_Regular_File
5093 (Get_Name_String (Project.Symbol_Data.Reference))
5096 File_Name_Type (Lib_Ref_Symbol_File.Value);
5098 -- For controlled and direct symbol policies, it is an error
5099 -- if the reference symbol file does not exist. For other
5100 -- symbol policies, this is just a warning
5103 Project.Symbol_Data.Symbol_Policy /= Controlled
5104 and then Project.Symbol_Data.Symbol_Policy /= Direct;
5108 "<library reference symbol file
{ does
not exist
",
5109 Lib_Ref_Symbol_File.Location, Project);
5111 -- In addition in the non-controlled case, if symbol policy
5112 -- is Compliant, it is changed to Autonomous, because there
5113 -- is no reference to check against, and we don't want to
5114 -- fail in this case.
5116 if Project.Symbol_Data.Symbol_Policy /= Controlled then
5117 if Project.Symbol_Data.Symbol_Policy = Compliant then
5118 Project.Symbol_Data.Symbol_Policy := Autonomous;
5123 -- If both the reference symbol file and the symbol file are
5124 -- defined, then check that they are not the same file.
5126 if Project.Symbol_Data.Symbol_File /= No_Path then
5127 Get_Name_String (Project.Symbol_Data.Symbol_File);
5129 if Name_Len > 0 then
5131 -- We do not need to pass a Directory to
5132 -- Normalize_Pathname, since the path_information
5133 -- already contains absolute information.
5135 Symb_Path : constant String :=
5138 (Project.Object_Directory.Name) &
5139 Name_Buffer (1 .. Name_Len),
5142 Opt.Follow_Links_For_Files);
5143 Ref_Path : constant String :=
5146 (Project.Symbol_Data.Reference),
5149 Opt.Follow_Links_For_Files);
5151 if Symb_Path = Ref_Path then
5154 "library reference symbol file
and library
" &
5155 " symbol file cannot be the same file
",
5156 Lib_Ref_Symbol_File.Location, Project);
5164 end Check_Stand_Alone_Library;
5166 ---------------------
5167 -- Check_Unit_Name --
5168 ---------------------
5170 procedure Check_Unit_Name (Name : String; Unit : out Name_Id) is
5171 The_Name : String := Name;
5172 Real_Name : Name_Id;
5173 Need_Letter : Boolean := True;
5174 Last_Underscore : Boolean := False;
5175 OK : Boolean := The_Name'Length > 0;
5178 function Is_Reserved (Name : Name_Id) return Boolean;
5179 function Is_Reserved (S : String) return Boolean;
5180 -- Check that the given name is not an Ada 95 reserved word. The reason
5181 -- for the Ada 95 here is that we do not want to exclude the case of an
5182 -- Ada 95 unit called Interface (for example). In Ada 2005, such a unit
5183 -- name would be rejected anyway by the compiler. That means there is no
5184 -- requirement that the project file parser reject this.
5190 function Is_Reserved (S : String) return Boolean is
5193 Add_Str_To_Name_Buffer (S);
5194 return Is_Reserved (Name_Find);
5201 function Is_Reserved (Name : Name_Id) return Boolean is
5203 if Get_Name_Table_Byte (Name) /= 0
5205 not Nam_In (Name, Name_Project, Name_Extends, Name_External)
5206 and then Name not in Ada_2005_Reserved_Words
5209 Debug_Output ("Ada reserved word
: ", Name);
5217 -- Start of processing for Check_Unit_Name
5220 To_Lower (The_Name);
5222 Name_Len := The_Name'Length;
5223 Name_Buffer (1 .. Name_Len) := The_Name;
5225 Real_Name := Name_Find;
5227 if Is_Reserved (Real_Name) then
5231 First := The_Name'First;
5233 for Index in The_Name'Range loop
5236 -- We need a letter (at the beginning, and following a dot),
5237 -- but we don't have one.
5239 if Is_Letter (The_Name (Index)) then
5240 Need_Letter := False;
5245 if Current_Verbosity = High then
5247 Write_Int (Types.Int (Index));
5249 Write_Char (The_Name (Index));
5250 Write_Line ("' is not a letter
.");
5256 elsif Last_Underscore
5257 and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
5259 -- Two underscores are illegal, and a dot cannot follow
5264 if Current_Verbosity = High then
5266 Write_Int (Types.Int (Index));
5268 Write_Char (The_Name (Index));
5269 Write_Line ("' is illegal here
.");
5274 elsif The_Name (Index) = '.' then
5276 -- First, check if the name before the dot is not a reserved word
5278 if Is_Reserved (The_Name (First .. Index - 1)) then
5284 -- We need a letter after a dot
5286 Need_Letter := True;
5288 elsif The_Name (Index) = '_' then
5289 Last_Underscore := True;
5292 -- We need an letter or a digit
5294 Last_Underscore := False;
5296 if not Is_Alphanumeric (The_Name (Index)) then
5299 if Current_Verbosity = High then
5301 Write_Int (Types.Int (Index));
5303 Write_Char (The_Name (Index));
5304 Write_Line ("' is not alphanumeric
.");
5312 -- Cannot end with an underscore or a dot
5314 OK := OK and then not Need_Letter and then not Last_Underscore;
5317 if First /= Name'First
5318 and then Is_Reserved (The_Name (First .. The_Name'Last))
5326 -- Signal a problem with No_Name
5330 end Check_Unit_Name;
5332 ----------------------------
5333 -- Compute_Directory_Last --
5334 ----------------------------
5336 function Compute_Directory_Last (Dir : String) return Natural is
5339 and then (Dir (Dir'Last - 1) = Directory_Separator
5341 Dir (Dir'Last - 1) = '/')
5343 return Dir'Last - 1;
5347 end Compute_Directory_Last;
5349 ---------------------
5350 -- Get_Directories --
5351 ---------------------
5353 procedure Get_Directories
5354 (Project : Project_Id;
5355 Data : in out Tree_Processing_Data)
5357 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
5359 Object_Dir : constant Variable_Value :=
5361 (Name_Object_Dir, Project.Decl.Attributes, Shared);
5363 Exec_Dir : constant Variable_Value :=
5365 (Name_Exec_Dir, Project.Decl.Attributes, Shared);
5367 Source_Dirs : constant Variable_Value :=
5369 (Name_Source_Dirs, Project.Decl.Attributes, Shared);
5371 Ignore_Source_Sub_Dirs : constant Variable_Value :=
5373 (Name_Ignore_Source_Sub_Dirs,
5374 Project.Decl.Attributes,
5377 Excluded_Source_Dirs : constant Variable_Value :=
5379 (Name_Excluded_Source_Dirs,
5380 Project.Decl.Attributes,
5383 Source_Files : constant Variable_Value :=
5386 Project.Decl.Attributes, Shared);
5388 Last_Source_Dir : String_List_Id := Nil_String;
5389 Last_Src_Dir_Rank : Number_List_Index := No_Number_List;
5391 Languages : constant Variable_Value :=
5393 (Name_Languages, Project.Decl.Attributes, Shared);
5395 Remove_Source_Dirs : Boolean := False;
5397 procedure Add_To_Or_Remove_From_Source_Dirs
5398 (Path : Path_Information;
5400 -- When Removed = False, the directory Path_Id to the list of
5401 -- source_dirs if not already in the list. When Removed = True,
5402 -- removed directory Path_Id if in the list.
5404 procedure Find_Source_Dirs is new Expand_Subdirectory_Pattern
5405 (Add_To_Or_Remove_From_Source_Dirs);
5407 ---------------------------------------
5408 -- Add_To_Or_Remove_From_Source_Dirs --
5409 ---------------------------------------
5411 procedure Add_To_Or_Remove_From_Source_Dirs
5412 (Path : Path_Information;
5415 List : String_List_Id;
5416 Prev : String_List_Id;
5417 Rank_List : Number_List_Index;
5418 Prev_Rank : Number_List_Index;
5419 Element : String_Element;
5423 Prev_Rank := No_Number_List;
5424 List := Project.Source_Dirs;
5425 Rank_List := Project.Source_Dir_Ranks;
5426 while List /= Nil_String loop
5427 Element := Shared.String_Elements.Table (List);
5428 exit when Element.Value = Name_Id (Path.Name);
5430 List := Element.Next;
5431 Prev_Rank := Rank_List;
5432 Rank_List := Shared.Number_Lists.Table (Prev_Rank).Next;
5435 -- The directory is in the list if List is not Nil_String
5437 if not Remove_Source_Dirs and then List = Nil_String then
5438 Debug_Output ("adding source dir
=", Name_Id (Path.Display_Name));
5440 String_Element_Table.Increment_Last (Shared.String_Elements);
5442 (Value => Name_Id (Path.Name),
5444 Display_Value => Name_Id (Path.Display_Name),
5445 Location => No_Location,
5447 Next => Nil_String);
5449 Number_List_Table.Increment_Last (Shared.Number_Lists);
5451 if Last_Source_Dir = Nil_String then
5453 -- This is the first source directory
5455 Project.Source_Dirs :=
5456 String_Element_Table.Last (Shared.String_Elements);
5457 Project.Source_Dir_Ranks :=
5458 Number_List_Table.Last (Shared.Number_Lists);
5461 -- We already have source directories, link the previous
5462 -- last to the new one.
5464 Shared.String_Elements.Table (Last_Source_Dir).Next :=
5465 String_Element_Table.Last (Shared.String_Elements);
5466 Shared.Number_Lists.Table (Last_Src_Dir_Rank).Next :=
5467 Number_List_Table.Last (Shared.Number_Lists);
5470 -- And register this source directory as the new last
5473 String_Element_Table.Last (Shared.String_Elements);
5474 Shared.String_Elements.Table (Last_Source_Dir) := Element;
5475 Last_Src_Dir_Rank := Number_List_Table.Last (Shared.Number_Lists);
5476 Shared.Number_Lists.Table (Last_Src_Dir_Rank) :=
5477 (Number => Rank, Next => No_Number_List);
5479 elsif Remove_Source_Dirs and then List /= Nil_String then
5481 -- Remove source dir if present
5483 if Prev = Nil_String then
5484 Project.Source_Dirs := Shared.String_Elements.Table (List).Next;
5485 Project.Source_Dir_Ranks :=
5486 Shared.Number_Lists.Table (Rank_List).Next;
5489 Shared.String_Elements.Table (Prev).Next :=
5490 Shared.String_Elements.Table (List).Next;
5491 Shared.Number_Lists.Table (Prev_Rank).Next :=
5492 Shared.Number_Lists.Table (Rank_List).Next;
5495 end Add_To_Or_Remove_From_Source_Dirs;
5497 -- Local declarations
5499 Dir_Exists : Boolean;
5501 No_Sources : constant Boolean :=
5502 Project.Qualifier = Abstract_Project
5503 or else (((not Source_Files.Default
5504 and then Source_Files.Values = Nil_String)
5506 (not Source_Dirs.Default
5507 and then Source_Dirs.Values = Nil_String)
5509 (not Languages.Default
5510 and then Languages.Values = Nil_String))
5511 and then Project.Extends = No_Project);
5513 -- Start of processing for Get_Directories
5516 Debug_Output ("starting to look
for directories
");
5518 -- Set the object directory to its default which may be nil, if there
5519 -- is no sources in the project.
5522 Project.Object_Directory := No_Path_Information;
5524 Project.Object_Directory := Project.Directory;
5527 -- Check the object directory
5529 if Object_Dir.Value /= Empty_String then
5530 Get_Name_String (Object_Dir.Value);
5532 if Name_Len = 0 then
5535 "Object_Dir cannot be empty
",
5536 Object_Dir.Location, Project);
5538 elsif Setup_Projects
5540 and then Project.Extends = No_Project
5542 -- Do not create an object directory for a non extending project
5547 File_Name_Type (Object_Dir.Value),
5548 Path => Project.Object_Directory,
5549 Dir_Exists => Dir_Exists,
5551 Location => Object_Dir.Location,
5552 Must_Exist => False,
5553 Externally_Built => Project.Externally_Built);
5556 -- We check that the specified object directory does exist.
5557 -- However, even when it doesn't exist, we set it to a default
5558 -- value. This is for the benefit of tools that recover from
5559 -- errors; for example, these tools could create the non existent
5560 -- directory. We always return an absolute directory name though.
5564 File_Name_Type (Object_Dir.Value),
5565 Path => Project.Object_Directory,
5567 Dir_Exists => Dir_Exists,
5569 Location => Object_Dir.Location,
5570 Must_Exist => False,
5571 Externally_Built => Project.Externally_Built);
5573 if not Dir_Exists and then not Project.Externally_Built then
5574 if Opt.Directories_Must_Exist_In_Projects then
5576 -- The object directory does not exist, report an error if
5577 -- the project is not externally built.
5579 Err_Vars.Error_Msg_File_1 :=
5580 File_Name_Type (Object_Dir.Value);
5582 (Data.Flags, Data.Flags.Require_Obj_Dirs,
5583 "object directory
{ not found
",
5584 Project.Location, Project);
5589 elsif not No_Sources and then Subdirs /= null then
5591 Name_Buffer (1) := '.';
5595 Path => Project.Object_Directory,
5597 Dir_Exists => Dir_Exists,
5599 Location => Object_Dir.Location,
5600 Externally_Built => Project.Externally_Built);
5603 if Current_Verbosity = High then
5604 if Project.Object_Directory = No_Path_Information then
5605 Debug_Output ("no object directory
");
5608 ("Object directory
",
5609 Get_Name_String (Project.Object_Directory.Display_Name));
5613 -- Check the exec directory
5615 -- We set the object directory to its default
5617 Project.Exec_Directory := Project.Object_Directory;
5619 if Exec_Dir.Value /= Empty_String then
5620 Get_Name_String (Exec_Dir.Value);
5622 if Name_Len = 0 then
5625 "Exec_Dir cannot be empty
",
5626 Exec_Dir.Location, Project);
5628 elsif Setup_Projects
5630 and then Project.Extends = No_Project
5632 -- Do not create an exec directory for a non extending project
5637 File_Name_Type (Exec_Dir.Value),
5638 Path => Project.Exec_Directory,
5639 Dir_Exists => Dir_Exists,
5641 Location => Exec_Dir.Location,
5642 Externally_Built => Project.Externally_Built);
5645 -- We check that the specified exec directory does exist
5649 File_Name_Type (Exec_Dir.Value),
5650 Path => Project.Exec_Directory,
5651 Dir_Exists => Dir_Exists,
5654 Location => Exec_Dir.Location,
5655 Externally_Built => Project.Externally_Built);
5657 if not Dir_Exists then
5658 if Opt.Directories_Must_Exist_In_Projects then
5659 Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
5661 (Data.Flags, Data.Flags.Missing_Source_Files,
5662 "exec directory
{ not found
", Project.Location, Project);
5665 Project.Exec_Directory := No_Path_Information;
5671 if Current_Verbosity = High then
5672 if Project.Exec_Directory = No_Path_Information then
5673 Debug_Output ("no exec directory
");
5676 ("exec directory
: ",
5677 Name_Id (Project.Exec_Directory.Display_Name));
5681 -- Look for the source directories
5683 Debug_Output ("starting to look
for source directories
");
5685 pragma Assert (Source_Dirs.Kind = List, "Source_Dirs
is not a list
");
5687 if not Source_Files.Default and then Source_Files.Values = Nil_String
5689 Project.Source_Dirs := Nil_String;
5691 if Project.Qualifier = Standard then
5694 "a standard project cannot have no sources
",
5695 Source_Files.Location, Project);
5698 elsif Source_Dirs.Default then
5700 -- No Source_Dirs specified: the single source directory is the one
5701 -- containing the project file.
5703 Remove_Source_Dirs := False;
5704 Add_To_Or_Remove_From_Source_Dirs
5705 (Path => (Name => Project.Directory.Name,
5706 Display_Name => Project.Directory.Display_Name),
5710 Remove_Source_Dirs := False;
5712 (Project => Project,
5714 Patterns => Source_Dirs.Values,
5715 Ignore => Ignore_Source_Sub_Dirs.Values,
5716 Search_For => Search_Directories,
5717 Resolve_Links => Opt.Follow_Links_For_Dirs);
5719 if Project.Source_Dirs = Nil_String
5720 and then Project.Qualifier = Standard
5724 "a standard project cannot have no source directories
",
5725 Source_Dirs.Location, Project);
5729 if not Excluded_Source_Dirs.Default
5730 and then Excluded_Source_Dirs.Values /= Nil_String
5732 Remove_Source_Dirs := True;
5734 (Project => Project,
5736 Patterns => Excluded_Source_Dirs.Values,
5737 Ignore => Nil_String,
5738 Search_For => Search_Directories,
5739 Resolve_Links => Opt.Follow_Links_For_Dirs);
5742 Debug_Output ("putting source directories
in canonical cases
");
5745 Current : String_List_Id := Project.Source_Dirs;
5746 Element : String_Element;
5749 while Current /= Nil_String loop
5750 Element := Shared.String_Elements.Table (Current);
5751 if Element.Value /= No_Name then
5753 Name_Id (Canonical_Case_File_Name (Element.Value));
5754 Shared.String_Elements.Table (Current) := Element;
5757 Current := Element.Next;
5760 end Get_Directories;
5767 (Project : Project_Id;
5768 Data : in out Tree_Processing_Data)
5770 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
5772 Mains : constant Variable_Value :=
5774 (Name_Main, Project.Decl.Attributes, Shared);
5775 List : String_List_Id;
5776 Elem : String_Element;
5779 Project.Mains := Mains.Values;
5781 -- If no Mains were specified, and if we are an extending project,
5782 -- inherit the Mains from the project we are extending.
5784 if Mains.Default then
5785 if not Project.Library and then Project.Extends /= No_Project then
5786 Project.Mains := Project.Extends.Mains;
5789 -- In a library project file, Main cannot be specified
5791 elsif Project.Library then
5794 "a library project file cannot have Main specified
",
5795 Mains.Location, Project);
5798 List := Mains.Values;
5799 while List /= Nil_String loop
5800 Elem := Shared.String_Elements.Table (List);
5802 if Length_Of_Name (Elem.Value) = 0 then
5805 "?a main cannot have an empty name
",
5806 Elem.Location, Project);
5815 ---------------------------
5816 -- Get_Sources_From_File --
5817 ---------------------------
5819 procedure Get_Sources_From_File
5821 Location : Source_Ptr;
5822 Project : in out Project_Processing_Data;
5823 Data : in out Tree_Processing_Data)
5825 File : Prj.Util.Text_File;
5826 Line : String (1 .. 250);
5828 Source_Name : File_Name_Type;
5829 Name_Loc : Name_Location;
5832 if Current_Verbosity = High then
5833 Debug_Output ("opening
""" & Path & '"');
5838 Prj.Util.Open (File, Path);
5840 if not Prj.Util.Is_Valid (File) then
5842 (Data.Flags, "file does not exist", Location, Project.Project);
5845 -- Read the lines one by one
5847 while not Prj.Util.End_Of_File (File) loop
5848 Prj.Util.Get_Line (File, Line, Last);
5850 -- A non empty, non comment line should contain a file name
5852 if Last /= 0 and then (Last = 1 or else Line (1 .. 2) /= "--") then
5854 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
5855 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
5856 Source_Name := Name_Find;
5858 -- Check that there is no directory information
5860 for J in 1 .. Last loop
5861 if Line (J) = '/' or else Line (J) = Directory_Separator then
5862 Error_Msg_File_1 := Source_Name;
5865 "file name cannot include directory information ({)",
5866 Location, Project.Project);
5871 Name_Loc := Source_Names_Htable.Get
5872 (Project.Source_Names, Source_Name);
5874 if Name_Loc = No_Name_Location then
5876 (Name => Source_Name,
5877 Location => Location,
5878 Source => No_Source,
5883 Name_Loc.Listed := True;
5886 Source_Names_Htable.Set
5887 (Project.Source_Names, Source_Name, Name_Loc);
5891 Prj.Util.Close (File);
5894 end Get_Sources_From_File;
5900 function No_Space_Img (N : Natural) return String is
5901 Image : constant String := N'Img;
5903 return Image (2 .. Image'Last);
5906 -----------------------
5907 -- Compute_Unit_Name --
5908 -----------------------
5910 procedure Compute_Unit_Name
5911 (File_Name : File_Name_Type;
5912 Naming : Lang_Naming_Data;
5913 Kind : out Source_Kind;
5915 Project : Project_Processing_Data)
5917 Filename : constant String := Get_Name_String (File_Name);
5918 Last : Integer := Filename'Last;
5923 Unit_Except : Unit_Exception;
5924 Masked : Boolean := False;
5930 if Naming.Separate_Suffix = No_File
5931 or else Naming.Body_Suffix = No_File
5932 or else Naming.Spec_Suffix = No_File
5937 if Naming.Dot_Replacement = No_File then
5938 Debug_Output ("no dot_replacement specified");
5942 Sep_Len := Integer (Length_Of_Name (Naming.Separate_Suffix));
5943 Spec_Len := Integer (Length_Of_Name (Naming.Spec_Suffix));
5944 Body_Len := Integer (Length_Of_Name (Naming.Body_Suffix));
5946 -- Choose the longest suffix that matches. If there are several matches,
5947 -- give priority to specs, then bodies, then separates.
5949 if Naming.Separate_Suffix /= Naming.Body_Suffix
5950 and then Suffix_Matches (Filename, Naming.Separate_Suffix)
5952 Last := Filename'Last - Sep_Len;
5956 if Filename'Last - Body_Len <= Last
5957 and then Suffix_Matches (Filename, Naming.Body_Suffix)
5959 Last := Natural'Min (Last, Filename'Last - Body_Len);
5963 if Filename'Last - Spec_Len <= Last
5964 and then Suffix_Matches (Filename, Naming.Spec_Suffix)
5966 Last := Natural'Min (Last, Filename'Last - Spec_Len);
5970 if Last = Filename'Last then
5971 Debug_Output ("no matching suffix");
5975 -- Check that the casing matches
5977 if File_Names_Case_Sensitive then
5978 case Naming.Casing is
5979 when All_Lower_Case =>
5980 for J in Filename'First .. Last loop
5981 if Is_Letter (Filename (J))
5982 and then not Is_Lower (Filename (J))
5984 Debug_Output ("invalid casing");
5989 when All_Upper_Case =>
5990 for J in Filename'First .. Last loop
5991 if Is_Letter (Filename (J))
5992 and then not Is_Upper (Filename (J))
5994 Debug_Output ("invalid casing");
5999 when Mixed_Case | Unknown =>
6004 -- If Dot_Replacement is not a single dot, then there should not
6005 -- be any dot in the name.
6008 Dot_Repl : constant String :=
6009 Get_Name_String (Naming.Dot_Replacement);
6012 if Dot_Repl /= "." then
6013 for Index in Filename'First .. Last loop
6014 if Filename (Index) = '.' then
6015 Debug_Output ("invalid name, contains dot");
6020 Replace_Into_Name_Buffer
6021 (Filename (Filename'First .. Last), Dot_Repl, '.');
6024 Name_Len := Last - Filename'First + 1;
6025 Name_Buffer (1 .. Name_Len) := Filename (Filename'First .. Last);
6027 (Source => Name_Buffer (1 .. Name_Len),
6028 Mapping => Lower_Case_Map);
6032 -- In the standard GNAT naming scheme, check for special cases: children
6033 -- or separates of A, G, I or S, and run time sources.
6035 if Is_Standard_GNAT_Naming (Naming) and then Name_Len >= 3 then
6037 S1 : constant Character := Name_Buffer (1);
6038 S2 : constant Character := Name_Buffer (2);
6039 S3 : constant Character := Name_Buffer (3);
6042 if S1 = 'a
' or else S1 = 'g
' or else S1 = 'i
' or else S1 = 's
' then
6044 -- Children or separates of packages A, G, I or S. These names
6045 -- are x__ ... or x~... (where x is a, g, i, or s). Both
6046 -- versions (x__... and x~...) are allowed in all platforms,
6047 -- because it is not possible to know the platform before
6048 -- processing of the project files.
6050 if S2 = '_
' and then S3 = '_
' then
6051 Name_Buffer (2) := '.';
6052 Name_Buffer (3 .. Name_Len - 1) :=
6053 Name_Buffer (4 .. Name_Len);
6054 Name_Len := Name_Len - 1;
6057 Name_Buffer (2) := '.';
6061 -- If it is potentially a run time source
6069 -- Name_Buffer contains the name of the unit in lower-cases. Check
6070 -- that this is a valid unit name
6072 Check_Unit_Name (Name_Buffer (1 .. Name_Len), Unit);
6074 -- If there is a naming exception for the same unit, the file is not
6075 -- a source for the unit.
6077 if Unit /= No_Name then
6079 Unit_Exceptions_Htable.Get (Project.Unit_Exceptions, Unit);
6082 Masked := Unit_Except.Spec /= No_File
6084 Unit_Except.Spec /= File_Name;
6086 Masked := Unit_Except.Impl /= No_File
6088 Unit_Except.Impl /= File_Name;
6092 if Current_Verbosity = High then
6094 Write_Str (" """ & Filename & """ contains the ");
6097 Write_Str ("spec of a unit found in """);
6098 Write_Str (Get_Name_String (Unit_Except.Spec));
6100 Write_Str ("body of a unit found in """);
6101 Write_Str (Get_Name_String (Unit_Except.Impl));
6104 Write_Line (""" (ignored)");
6111 if Unit /= No_Name and then Current_Verbosity = High then
6113 when Spec => Debug_Output ("spec of", Unit);
6114 when Impl => Debug_Output ("body of", Unit);
6115 when Sep => Debug_Output ("sep of", Unit);
6118 end Compute_Unit_Name;
6120 --------------------------
6121 -- Check_Illegal_Suffix --
6122 --------------------------
6124 procedure Check_Illegal_Suffix
6125 (Project : Project_Id;
6126 Suffix : File_Name_Type;
6127 Dot_Replacement : File_Name_Type;
6128 Attribute_Name : String;
6129 Location : Source_Ptr;
6130 Data : in out Tree_Processing_Data)
6132 Suffix_Str : constant String := Get_Name_String (Suffix);
6135 if Suffix_Str'Length = 0 then
6141 elsif Index (Suffix_Str, ".") = 0 then
6142 Err_Vars.Error_Msg_File_1 := Suffix;
6145 "{ is illegal for " & Attribute_Name & ": must have a dot",
6150 -- Case of dot replacement is a single dot, and first character of
6151 -- suffix is also a dot.
6153 if Dot_Replacement /= No_File
6154 and then Get_Name_String (Dot_Replacement) = "."
6155 and then Suffix_Str (Suffix_Str'First) = '.'
6157 for Index in Suffix_Str'First + 1 .. Suffix_Str'Last loop
6159 -- If there are multiple dots in the name
6161 if Suffix_Str (Index) = '.' then
6163 -- It is illegal to have a letter following the initial dot
6165 if Is_Letter (Suffix_Str (Suffix_Str'First + 1)) then
6166 Err_Vars.Error_Msg_File_1 := Suffix;
6169 "{ is illegal for " & Attribute_Name
6170 & ": ambiguous prefix when Dot_Replacement is a dot",
6177 end Check_Illegal_Suffix;
6179 ----------------------
6180 -- Locate_Directory --
6181 ----------------------
6183 procedure Locate_Directory
6184 (Project : Project_Id;
6185 Name : File_Name_Type;
6186 Path : out Path_Information;
6187 Dir_Exists : out Boolean;
6188 Data : in out Tree_Processing_Data;
6189 Create : String := "";
6190 Location : Source_Ptr := No_Location;
6191 Must_Exist : Boolean := True;
6192 Externally_Built : Boolean := False)
6194 Parent : constant Path_Name_Type :=
6195 Project.Directory.Display_Name;
6196 The_Parent : constant String :=
6197 Get_Name_String (Parent);
6198 The_Parent_Last : constant Natural :=
6199 Compute_Directory_Last (The_Parent);
6200 Full_Name : File_Name_Type;
6201 The_Name : File_Name_Type;
6204 Get_Name_String (Name);
6206 -- Add Subdirs.all if it is a directory that may be created and
6207 -- Subdirs is not null;
6209 if Create /= "" and then Subdirs /= null then
6210 if Name_Buffer (Name_Len) /= Directory_Separator then
6211 Add_Char_To_Name_Buffer (Directory_Separator);
6214 Add_Str_To_Name_Buffer (Subdirs.all);
6217 -- Convert '/' to directory separator (for Windows)
6219 for J in 1 .. Name_Len loop
6220 if Name_Buffer (J) = '/' then
6221 Name_Buffer (J) := Directory_Separator;
6225 The_Name := Name_Find;
6227 if Current_Verbosity = High then
6229 Write_Str ("Locate_Directory (""");
6230 Write_Str (Get_Name_String (The_Name));
6231 Write_Str (""", in """);
6232 Write_Str (The_Parent);
6236 Path := No_Path_Information;
6237 Dir_Exists := False;
6239 if Is_Absolute_Path (Get_Name_String (The_Name)) then
6240 Full_Name := The_Name;
6244 Add_Str_To_Name_Buffer
6245 (The_Parent (The_Parent'First .. The_Parent_Last));
6246 Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
6247 Full_Name := Name_Find;
6251 Full_Path_Name : String_Access :=
6252 new String'(Get_Name_String
(Full_Name
));
6255 if (Setup_Projects
or else Subdirs
/= null)
6256 and then Create
'Length > 0
6258 if not Is_Directory
(Full_Path_Name
.all) then
6260 -- If project is externally built, do not create a subdir,
6261 -- use the specified directory, without the subdir.
6263 if Externally_Built
then
6264 if Is_Absolute_Path
(Get_Name_String
(Name
)) then
6265 Get_Name_String
(Name
);
6269 Add_Str_To_Name_Buffer
6270 (The_Parent
(The_Parent
'First .. The_Parent_Last
));
6271 Add_Str_To_Name_Buffer
(Get_Name_String
(Name
));
6274 Full_Path_Name
:= new String'(Name_Buffer (1 .. Name_Len));
6278 Create_Path (Full_Path_Name.all);
6280 if not Quiet_Output then
6282 Write_Str (" directory """);
6283 Write_Str (Full_Path_Name.all);
6284 Write_Str (""" created for project ");
6285 Write_Line (Get_Name_String (Project.Name));
6291 -- Output message with name of directory. Note that we
6292 -- use the ~ insertion method here in case the name
6293 -- has special characters in it.
6295 Error_Msg_Strlen := Full_Path_Name'Length;
6296 Error_Msg_String (1 .. Error_Msg_Strlen) :=
6300 "could not create " & Create & " directory ~",
6308 Dir_Exists := Is_Directory (Full_Path_Name.all);
6310 if not Must_Exist or Dir_Exists then
6312 Normed : constant String :=
6314 (Full_Path_Name.all,
6316 The_Parent (The_Parent'First .. The_Parent_Last),
6317 Resolve_Links => False,
6318 Case_Sensitive => True);
6320 Canonical_Path : constant String :=
6325 (The_Parent'First .. The_Parent_Last),
6327 Opt.Follow_Links_For_Dirs,
6328 Case_Sensitive => False);
6331 Name_Len := Normed'Length;
6332 Name_Buffer (1 .. Name_Len) := Normed;
6334 -- Directories should always end with a directory separator
6336 if Name_Buffer (Name_Len) /= Directory_Separator then
6337 Add_Char_To_Name_Buffer (Directory_Separator);
6340 Path.Display_Name := Name_Find;
6342 Name_Len := Canonical_Path'Length;
6343 Name_Buffer (1 .. Name_Len) := Canonical_Path;
6345 if Name_Buffer (Name_Len) /= Directory_Separator then
6346 Add_Char_To_Name_Buffer (Directory_Separator);
6349 Path.Name := Name_Find;
6353 Free (Full_Path_Name);
6355 end Locate_Directory;
6357 ---------------------------
6358 -- Find_Excluded_Sources --
6359 ---------------------------
6361 procedure Find_Excluded_Sources
6362 (Project : in out Project_Processing_Data;
6363 Data : in out Tree_Processing_Data)
6365 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
6367 Excluded_Source_List_File : constant Variable_Value :=
6369 (Name_Excluded_Source_List_File,
6370 Project.Project.Decl.Attributes,
6372 Excluded_Sources : Variable_Value := Util.Value_Of
6373 (Name_Excluded_Source_Files,
6374 Project.Project.Decl.Attributes,
6377 Current : String_List_Id;
6378 Element : String_Element;
6379 Location : Source_Ptr;
6380 Name : File_Name_Type;
6381 File : Prj.Util.Text_File;
6382 Line : String (1 .. 300);
6384 Locally_Removed : Boolean := False;
6387 -- If Excluded_Source_Files is not declared, check Locally_Removed_Files
6389 if Excluded_Sources.Default then
6390 Locally_Removed := True;
6393 (Name_Locally_Removed_Files,
6394 Project.Project.Decl.Attributes, Shared);
6397 -- If there are excluded sources, put them in the table
6399 if not Excluded_Sources.Default then
6400 if not Excluded_Source_List_File.Default then
6401 if Locally_Removed then
6404 "?both attributes Locally_Removed_Files and " &
6405 "Excluded_Source_List_File are present",
6406 Excluded_Source_List_File.Location, Project.Project);
6410 "?both attributes Excluded_Source_Files and " &
6411 "Excluded_Source_List_File are present",
6412 Excluded_Source_List_File.Location, Project.Project);
6416 Current := Excluded_Sources.Values;
6417 while Current /= Nil_String loop
6418 Element := Shared.String_Elements.Table (Current);
6419 Name := Canonical_Case_File_Name (Element.Value);
6421 -- If the element has no location, then use the location of
6422 -- Excluded_Sources to report possible errors.
6424 if Element.Location = No_Location then
6425 Location := Excluded_Sources.Location;
6427 Location := Element.Location;
6430 Excluded_Sources_Htable.Set
6431 (Project.Excluded, Name,
6432 (Name, No_File, 0, False, Location));
6433 Current := Element.Next;
6436 elsif not Excluded_Source_List_File.Default then
6437 Location := Excluded_Source_List_File.Location;
6440 Source_File_Name : constant File_Name_Type :=
6442 (Excluded_Source_List_File.Value);
6443 Source_File_Line : Natural := 0;
6445 Source_File_Path_Name : constant String :=
6448 Project.Project.Directory.Name);
6451 if Source_File_Path_Name'Length = 0 then
6452 Err_Vars.Error_Msg_File_1 :=
6453 File_Name_Type (Excluded_Source_List_File.Value);
6456 "file with excluded sources { does not exist",
6457 Excluded_Source_List_File.Location, Project.Project);
6462 Prj.Util.Open (File, Source_File_Path_Name);
6464 if not Prj.Util.Is_Valid (File) then
6466 (Data.Flags, "file does not exist",
6467 Location, Project.Project);
6469 -- Read the lines one by one
6471 while not Prj.Util.End_Of_File (File) loop
6472 Prj.Util.Get_Line (File, Line, Last);
6473 Source_File_Line := Source_File_Line + 1;
6475 -- Non empty, non comment line should contain a file name
6478 and then (Last = 1 or else Line (1 .. 2) /= "--")
6481 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6482 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6485 -- Check that there is no directory information
6487 for J in 1 .. Last loop
6490 Line (J) = Directory_Separator
6492 Error_Msg_File_1 := Name;
6495 "file name cannot include " &
6496 "directory information ({)",
6497 Location, Project.Project);
6502 Excluded_Sources_Htable.Set
6505 (Name, Source_File_Name, Source_File_Line,
6510 Prj.Util.Close (File);
6515 end Find_Excluded_Sources;
6521 procedure Find_Sources
6522 (Project : in out Project_Processing_Data;
6523 Data : in out Tree_Processing_Data)
6525 Shared : constant Shared_Project_Tree_Data_Access := Data.Tree.Shared;
6527 Sources : constant Variable_Value :=
6530 Project.Project.Decl.Attributes,
6533 Source_List_File : constant Variable_Value :=
6535 (Name_Source_List_File,
6536 Project.Project.Decl.Attributes,
6539 Name_Loc : Name_Location;
6540 Has_Explicit_Sources : Boolean;
6543 pragma Assert (Sources.Kind = List, "Source_Files is not a list");
6545 (Source_List_File.Kind = Single,
6546 "Source_List_File is not a single string");
6548 Project.Source_List_File_Location := Source_List_File.Location;
6550 -- If the user has specified a Source_Files attribute
6552 if not Sources.Default then
6553 if not Source_List_File.Default then
6556 "?both attributes source_files and " &
6557 "source_list_file are present",
6558 Source_List_File.Location, Project.Project);
6561 -- Sources is a list of file names
6564 Current : String_List_Id := Sources.Values;
6565 Element : String_Element;
6566 Location : Source_Ptr;
6567 Name : File_Name_Type;
6570 if Current = Nil_String then
6571 Project.Project.Languages := No_Language_Index;
6573 -- This project contains no source. For projects that don't
6574 -- extend other projects, this also means that there is no
6575 -- need for an object directory, if not specified.
6577 if Project.Project.Extends = No_Project
6579 Project.Project.Object_Directory = Project.Project.Directory
6580 and then not (Project.Project.Qualifier = Aggregate_Library)
6582 Project.Project.Object_Directory := No_Path_Information;
6586 while Current /= Nil_String loop
6587 Element := Shared.String_Elements.Table (Current);
6588 Name := Canonical_Case_File_Name (Element.Value);
6589 Get_Name_String (Element.Value);
6591 -- If the element has no location, then use the location of
6592 -- Sources to report possible errors.
6594 if Element.Location = No_Location then
6595 Location := Sources.Location;
6597 Location := Element.Location;
6600 -- Check that there is no directory information
6602 for J in 1 .. Name_Len loop
6603 if Name_Buffer (J) = '/'
6605 Name_Buffer (J) = Directory_Separator
6607 Error_Msg_File_1 := Name;
6610 "file name cannot include directory " &
6612 Location, Project.Project);
6617 -- Check whether the file is already there: the same file name
6618 -- may be in the list. If the source is missing, the error will
6619 -- be on the first mention of the source file name.
6621 Name_Loc := Source_Names_Htable.Get
6622 (Project.Source_Names, Name);
6624 if Name_Loc = No_Name_Location then
6627 Location => Location,
6628 Source => No_Source,
6633 Name_Loc.Listed := True;
6636 Source_Names_Htable.Set
6637 (Project.Source_Names, Name, Name_Loc);
6639 Current := Element.Next;
6642 Has_Explicit_Sources := True;
6645 -- If we have no Source_Files attribute, check the Source_List_File
6648 elsif not Source_List_File.Default then
6650 -- Source_List_File is the name of the file that contains the source
6654 Source_File_Path_Name : constant String :=
6657 (Source_List_File.Value),
6659 Directory.Display_Name);
6662 Has_Explicit_Sources := True;
6664 if Source_File_Path_Name'Length = 0 then
6665 Err_Vars.Error_Msg_File_1 :=
6666 File_Name_Type (Source_List_File.Value);
6669 "file with sources { does not exist",
6670 Source_List_File.Location, Project.Project);
6673 Get_Sources_From_File
6674 (Source_File_Path_Name, Source_List_File.Location,
6680 -- Neither Source_Files nor Source_List_File has been specified. Find
6681 -- all the files that satisfy the naming scheme in all the source
6684 Has_Explicit_Sources := False;
6687 -- Remove any exception that is not in the specified list of sources
6689 if Has_Explicit_Sources then
6692 Iter : Source_Iterator;
6699 Iter := For_Each_Source (Data.Tree, Project.Project);
6703 Source := Prj.Element (Iter);
6704 exit Source_Loop when Source = No_Source;
6706 if Source.Naming_Exception /= No then
6707 NL := Source_Names_Htable.Get
6708 (Project.Source_Names, Source.File);
6710 if NL /= No_Name_Location and then not NL.Listed then
6712 -- Remove the exception
6714 Source_Names_Htable.Set
6715 (Project.Source_Names,
6718 Remove_Source (Data.Tree, Source, No_Source);
6720 if Source.Naming_Exception = Yes then
6721 Error_Msg_Name_1 := Name_Id (Source.File);
6724 "? unknown source file %%",
6735 end loop Source_Loop;
6737 exit Iter_Loop when not Again;
6745 For_All_Sources => Sources.Default and then Source_List_File.Default);
6747 -- Check if all exceptions have been found
6751 Iter : Source_Iterator;
6752 Found : Boolean := False;
6755 Iter := For_Each_Source (Data.Tree, Project.Project);
6757 Source := Prj.Element (Iter);
6758 exit when Source = No_Source;
6760 -- If the full source path is unknown for this source_id, there
6761 -- could be several reasons:
6762 -- * we simply did not find the file itself, this is an error
6763 -- * we have a multi-unit source file. Another Source_Id from
6764 -- the same file has received the full path, so we need to
6767 if Source.Path = No_Path_Information then
6768 if Source.Naming_Exception = Yes then
6769 if Source.Unit /= No_Unit_Index then
6772 if Source.Index /= 0 then -- Only multi-unit files
6775 Source_Files_Htable.Get
6776 (Data.Tree.Source_Files_HT, Source.File);
6779 while S /= null loop
6780 if S.Path /= No_Path_Information then
6781 Source.Path := S.Path;
6784 if Current_Verbosity = High then
6786 ("setting full path for "
6787 & Get_Name_String (Source.File)
6788 & " at" & Source.Index'Img
6790 & Get_Name_String (Source.Path.Name));
6796 S := S.Next_With_File_Name;
6802 Error_Msg_Name_1 := Name_Id (Source.Display_File);
6803 Error_Msg_Name_2 := Source.Unit.Name;
6805 (Data.Flags, Data.Flags.Missing_Source_Files,
6806 "source file %% for unit %% not found",
6807 No_Location, Project.Project);
6811 if Source.Path = No_Path_Information then
6812 Remove_Source (Data.Tree, Source, No_Source);
6815 elsif Source.Naming_Exception = Inherited then
6816 Remove_Source (Data.Tree, Source, No_Source);
6824 -- It is an error if a source file name in a source list or in a source
6825 -- list file is not found.
6827 if Has_Explicit_Sources then
6830 First_Error : Boolean;
6833 NL := Source_Names_Htable.Get_First (Project.Source_Names);
6834 First_Error := True;
6835 while NL /= No_Name_Location loop
6836 if not NL.Found then
6837 Err_Vars.Error_Msg_File_1 := NL.Name;
6840 (Data.Flags, Data.Flags.Missing_Source_Files,
6841 "source file { not found",
6842 NL.Location, Project.Project);
6843 First_Error := False;
6846 (Data.Flags, Data.Flags.Missing_Source_Files,
6847 "\source file { not found",
6848 NL.Location, Project.Project);
6852 NL := Source_Names_Htable.Get_Next (Project.Source_Names);
6862 procedure Initialize
6863 (Data : out Tree_Processing_Data;
6864 Tree : Project_Tree_Ref;
6865 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
6866 Flags : Prj.Processing_Flags)
6870 Data.Node_Tree := Node_Tree;
6871 Data.Flags := Flags;
6878 procedure Free (Data : in out Tree_Processing_Data) is
6879 pragma Unreferenced (Data);
6888 procedure Initialize
6889 (Data : in out Project_Processing_Data;
6890 Project : Project_Id)
6893 Data.Project := Project;
6900 procedure Free (Data : in out Project_Processing_Data) is
6902 Source_Names_Htable.Reset (Data.Source_Names);
6903 Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions);
6904 Excluded_Sources_Htable.Reset (Data.Excluded);
6907 -------------------------------
6908 -- Check_File_Naming_Schemes --
6909 -------------------------------
6911 procedure Check_File_Naming_Schemes
6912 (Project : Project_Processing_Data;
6913 File_Name : File_Name_Type;
6914 Alternate_Languages : out Language_List;
6915 Language : out Language_Ptr;
6916 Display_Language_Name : out Name_Id;
6918 Lang_Kind : out Language_Kind;
6919 Kind : out Source_Kind)
6921 Filename : constant String := Get_Name_String (File_Name);
6922 Config : Language_Config;
6923 Tmp_Lang : Language_Ptr;
6925 Header_File : Boolean := False;
6926 -- True if we found at least one language for which the file is a header
6927 -- In such a case, we search for all possible languages where this is
6928 -- also a header (C and C++ for instance), since the file might be used
6929 -- for several such languages.
6931 procedure Check_File_Based_Lang;
6932 -- Does the naming scheme test for file-based languages. For those,
6933 -- there is no Unit. Just check if the file name has the implementation
6934 -- or, if it is specified, the template suffix of the language.
6936 -- Returns True if the file belongs to the current language and we
6937 -- should stop searching for matching languages. Not that a given header
6938 -- file could belong to several languages (C and C++ for instance). Thus
6939 -- if we found a header we'll check whether it matches other languages.
6941 ---------------------------
6942 -- Check_File_Based_Lang --
6943 ---------------------------
6945 procedure Check_File_Based_Lang is
6948 and then Suffix_Matches (Filename, Config.Naming_Data.Body_Suffix)
6952 Language := Tmp_Lang;
6955 ("implementation of language ", Display_Language_Name);
6957 elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
6959 ("header of language ", Display_Language_Name);
6962 Alternate_Languages := new Language_List_Element'
6963 (Language
=> Language
,
6964 Next
=> Alternate_Languages
);
6967 Header_File
:= True;
6970 Language
:= Tmp_Lang
;
6973 end Check_File_Based_Lang
;
6975 -- Start of processing for Check_File_Naming_Schemes
6978 Language
:= No_Language_Index
;
6979 Alternate_Languages
:= null;
6980 Display_Language_Name
:= No_Name
;
6982 Lang_Kind
:= File_Based
;
6985 Tmp_Lang
:= Project
.Project
.Languages
;
6986 while Tmp_Lang
/= No_Language_Index
loop
6987 if Current_Verbosity
= High
then
6989 ("testing language "
6990 & Get_Name_String
(Tmp_Lang
.Name
)
6991 & " Header_File=" & Header_File
'Img);
6994 Display_Language_Name
:= Tmp_Lang
.Display_Name
;
6995 Config
:= Tmp_Lang
.Config
;
6996 Lang_Kind
:= Config
.Kind
;
7000 Check_File_Based_Lang
;
7001 exit when Kind
= Impl
;
7005 -- We know it belongs to a least a file_based language, no
7006 -- need to check unit-based ones.
7008 if not Header_File
then
7010 (File_Name
=> File_Name
,
7011 Naming
=> Config
.Naming_Data
,
7014 Project
=> Project
);
7016 if Unit
/= No_Name
then
7017 Language
:= Tmp_Lang
;
7023 Tmp_Lang
:= Tmp_Lang
.Next
;
7026 if Language
= No_Language_Index
then
7027 Debug_Output
("not a source of any language");
7029 end Check_File_Naming_Schemes
;
7035 procedure Override_Kind
(Source
: Source_Id
; Kind
: Source_Kind
) is
7037 -- If the file was previously already associated with a unit, change it
7039 if Source
.Unit
/= null
7040 and then Source
.Kind
in Spec_Or_Body
7041 and then Source
.Unit
.File_Names
(Source
.Kind
) /= null
7043 -- If we had another file referencing the same unit (for instance it
7044 -- was in an extended project), that source file is in fact invisible
7045 -- from now on, and in particular doesn't belong to the same unit.
7046 -- If the source is an inherited naming exception, then it may not
7047 -- really exist: the source potentially replaced is left untouched.
7049 if Source
.Unit
.File_Names
(Source
.Kind
) /= Source
then
7050 Source
.Unit
.File_Names
(Source
.Kind
).Unit
:= No_Unit_Index
;
7053 Source
.Unit
.File_Names
(Source
.Kind
) := null;
7056 Source
.Kind
:= Kind
;
7058 if Current_Verbosity
= High
and then Source
.File
/= No_File
then
7059 Debug_Output
("override kind for "
7060 & Get_Name_String
(Source
.File
)
7061 & " idx=" & Source
.Index
'Img
7062 & " kind=" & Source
.Kind
'Img);
7065 if Source
.Unit
/= null then
7066 if Source
.Kind
= Spec
then
7067 Source
.Unit
.File_Names
(Spec
) := Source
;
7069 Source
.Unit
.File_Names
(Impl
) := Source
;
7078 procedure Check_File
7079 (Project
: in out Project_Processing_Data
;
7080 Data
: in out Tree_Processing_Data
;
7081 Source_Dir_Rank
: Natural;
7082 Path
: Path_Name_Type
;
7083 Display_Path
: Path_Name_Type
;
7084 File_Name
: File_Name_Type
;
7085 Display_File_Name
: File_Name_Type
;
7086 Locally_Removed
: Boolean;
7087 For_All_Sources
: Boolean)
7089 Name_Loc
: Name_Location
:=
7090 Source_Names_Htable
.Get
7091 (Project
.Source_Names
, File_Name
);
7092 Check_Name
: Boolean := False;
7093 Alternate_Languages
: Language_List
;
7094 Language
: Language_Ptr
;
7096 Src_Ind
: Source_File_Index
;
7098 Display_Language_Name
: Name_Id
;
7099 Lang_Kind
: Language_Kind
;
7100 Kind
: Source_Kind
:= Spec
;
7103 if Current_Verbosity
= High
then
7104 Debug_Increase_Indent
7105 ("checking file (rank=" & Source_Dir_Rank
'Img & ")",
7106 Name_Id
(Display_Path
));
7109 if Name_Loc
= No_Name_Location
then
7110 Check_Name
:= For_All_Sources
;
7113 if Name_Loc
.Found
then
7115 -- Check if it is OK to have the same file name in several
7116 -- source directories.
7118 if Name_Loc
.Source
/= No_Source
7119 and then Source_Dir_Rank
= Name_Loc
.Source
.Source_Dir_Rank
7121 Error_Msg_File_1
:= File_Name
;
7124 "{ is found in several source directories",
7125 Name_Loc
.Location
, Project
.Project
);
7129 Name_Loc
.Found
:= True;
7131 Source_Names_Htable
.Set
7132 (Project
.Source_Names
, File_Name
, Name_Loc
);
7134 if Name_Loc
.Source
= No_Source
then
7138 -- Set the full path for the source_id (which might have been
7139 -- created when parsing the naming exceptions, and therefore
7140 -- might not have the full path).
7141 -- We only set this for this source_id, but not for other
7142 -- source_id in the same file (case of multi-unit source files)
7143 -- For the latter, they will be set in Find_Sources when we
7144 -- check that all source_id have known full paths.
7145 -- Doing this later saves one htable lookup per file in the
7146 -- common case where the user is not using multi-unit files.
7148 Name_Loc
.Source
.Path
:= (Path
, Display_Path
);
7150 Source_Paths_Htable
.Set
7151 (Data
.Tree
.Source_Paths_HT
, Path
, Name_Loc
.Source
);
7153 -- Check if this is a subunit
7155 if Name_Loc
.Source
.Unit
/= No_Unit_Index
7156 and then Name_Loc
.Source
.Kind
= Impl
7158 Src_Ind
:= Sinput
.P
.Load_Project_File
7159 (Get_Name_String
(Display_Path
));
7161 if Sinput
.P
.Source_File_Is_Subunit
(Src_Ind
) then
7162 Override_Kind
(Name_Loc
.Source
, Sep
);
7166 -- If this is an inherited naming exception, make sure that
7167 -- the naming exception it replaces is no longer a source.
7169 if Name_Loc
.Source
.Naming_Exception
= Inherited
then
7171 Proj
: Project_Id
:= Name_Loc
.Source
.Project
.Extends
;
7172 Iter
: Source_Iterator
;
7175 while Proj
/= No_Project
loop
7176 Iter
:= For_Each_Source
(Data
.Tree
, Proj
);
7177 Src
:= Prj
.Element
(Iter
);
7178 while Src
/= No_Source
loop
7179 if Src
.File
= Name_Loc
.Source
.File
then
7180 Src
.Replaced_By
:= Name_Loc
.Source
;
7185 Src
:= Prj
.Element
(Iter
);
7188 Proj
:= Proj
.Extends
;
7192 if Name_Loc
.Source
.Unit
/= No_Unit_Index
then
7193 if Name_Loc
.Source
.Kind
= Spec
then
7194 Name_Loc
.Source
.Unit
.File_Names
(Spec
) :=
7197 elsif Name_Loc
.Source
.Kind
= Impl
then
7198 Name_Loc
.Source
.Unit
.File_Names
(Impl
) :=
7203 (Data
.Tree
.Units_HT
,
7204 Name_Loc
.Source
.Unit
.Name
,
7205 Name_Loc
.Source
.Unit
);
7213 Check_File_Naming_Schemes
7214 (Project
=> Project
,
7215 File_Name
=> File_Name
,
7216 Alternate_Languages
=> Alternate_Languages
,
7217 Language
=> Language
,
7218 Display_Language_Name
=> Display_Language_Name
,
7220 Lang_Kind
=> Lang_Kind
,
7223 if Language
= No_Language_Index
then
7225 -- A file name in a list must be a source of a language
7227 if Data
.Flags
.Error_On_Unknown_Language
and then Name_Loc
.Found
7229 Error_Msg_File_1
:= File_Name
;
7232 "language unknown for {",
7233 Name_Loc
.Location
, Project
.Project
);
7239 Project
=> Project
.Project
,
7240 Source_Dir_Rank
=> Source_Dir_Rank
,
7241 Lang_Id
=> Language
,
7244 Alternate_Languages
=> Alternate_Languages
,
7245 File_Name
=> File_Name
,
7246 Display_File
=> Display_File_Name
,
7248 Locally_Removed
=> Locally_Removed
,
7249 Path
=> (Path
, Display_Path
));
7251 -- If it is a source specified in a list, update the entry in
7252 -- the Source_Names table.
7254 if Name_Loc
.Found
and then Name_Loc
.Source
= No_Source
then
7255 Name_Loc
.Source
:= Source
;
7256 Source_Names_Htable
.Set
7257 (Project
.Source_Names
, File_Name
, Name_Loc
);
7262 Debug_Decrease_Indent
;
7265 ---------------------------------
7266 -- Expand_Subdirectory_Pattern --
7267 ---------------------------------
7269 procedure Expand_Subdirectory_Pattern
7270 (Project
: Project_Id
;
7271 Data
: in out Tree_Processing_Data
;
7272 Patterns
: String_List_Id
;
7273 Ignore
: String_List_Id
;
7274 Search_For
: Search_Type
;
7275 Resolve_Links
: Boolean)
7277 Shared
: constant Shared_Project_Tree_Data_Access
:= Data
.Tree
.Shared
;
7279 package Recursive_Dirs
is new GNAT
.Dynamic_HTables
.Simple_HTable
7280 (Header_Num
=> Header_Num
,
7282 No_Element
=> False,
7283 Key
=> Path_Name_Type
,
7286 -- Hash table stores recursive source directories, to avoid looking
7287 -- several times, and to avoid cycles that may be introduced by symbolic
7290 File_Pattern
: GNAT
.Regexp
.Regexp
;
7291 -- Pattern to use when matching file names
7293 Visited
: Recursive_Dirs
.Instance
;
7295 procedure Find_Pattern
7296 (Pattern_Id
: Name_Id
;
7298 Location
: Source_Ptr
);
7299 -- Find a specific pattern
7301 function Recursive_Find_Dirs
7302 (Path
: Path_Information
;
7303 Rank
: Natural) return Boolean;
7304 -- Search all the subdirectories (recursively) of Path.
7305 -- Return True if at least one file or directory was processed
7307 function Subdirectory_Matches
7308 (Path
: Path_Information
;
7309 Rank
: Natural) return Boolean;
7310 -- Called when a matching directory was found. If the user is in fact
7311 -- searching for files, we then search for those files matching the
7312 -- pattern within the directory.
7313 -- Return True if at least one file or directory was processed
7315 --------------------------
7316 -- Subdirectory_Matches --
7317 --------------------------
7319 function Subdirectory_Matches
7320 (Path
: Path_Information
;
7321 Rank
: Natural) return Boolean
7324 Name
: String (1 .. 250);
7326 Found
: Path_Information
;
7327 Success
: Boolean := False;
7331 when Search_Directories
=>
7332 Callback
(Path
, Rank
);
7335 when Search_Files
=>
7336 Open
(Dir
, Get_Name_String
(Path
.Display_Name
));
7338 Read
(Dir
, Name
, Last
);
7341 if Name
(Name
'First .. Last
) /= "."
7342 and then Name
(Name
'First .. Last
) /= ".."
7343 and then Match
(Name
(Name
'First .. Last
), File_Pattern
)
7345 Get_Name_String
(Path
.Display_Name
);
7346 Add_Str_To_Name_Buffer
(Name
(Name
'First .. Last
));
7348 Found
.Display_Name
:= Name_Find
;
7349 Canonical_Case_File_Name
(Name_Buffer
(1 .. Name_Len
));
7350 Found
.Name
:= Name_Find
;
7352 Callback
(Found
, Rank
);
7361 end Subdirectory_Matches
;
7363 -------------------------
7364 -- Recursive_Find_Dirs --
7365 -------------------------
7367 function Recursive_Find_Dirs
7368 (Path
: Path_Information
;
7369 Rank
: Natural) return Boolean
7371 Path_Str
: constant String := Get_Name_String
(Path
.Display_Name
);
7373 Name
: String (1 .. 250);
7375 Success
: Boolean := False;
7378 Debug_Output
("looking for subdirs of ", Name_Id
(Path
.Display_Name
));
7380 if Recursive_Dirs
.Get
(Visited
, Path
.Name
) then
7384 Recursive_Dirs
.Set
(Visited
, Path
.Name
, True);
7386 Success
:= Subdirectory_Matches
(Path
, Rank
) or Success
;
7388 Open
(Dir
, Path_Str
);
7391 Read
(Dir
, Name
, Last
);
7394 if Name
(1 .. Last
) /= "." and then Name
(1 .. Last
) /= ".." then
7396 Path_Name
: constant String :=
7398 (Name
=> Name
(1 .. Last
),
7399 Directory
=> Path_Str
,
7400 Resolve_Links
=> Resolve_Links
)
7401 & Directory_Separator
;
7403 Path2
: Path_Information
;
7404 OK
: Boolean := True;
7407 if Is_Directory
(Path_Name
) then
7408 if Ignore
/= Nil_String
then
7410 Dir_Name
: String := Name
(1 .. Last
);
7411 List
: String_List_Id
:= Ignore
;
7414 Canonical_Case_File_Name
(Dir_Name
);
7416 while List
/= Nil_String
loop
7418 (Shared
.String_Elements
.Table
(List
).Value
);
7419 Canonical_Case_File_Name
7420 (Name_Buffer
(1 .. Name_Len
));
7421 OK
:= Name_Buffer
(1 .. Name_Len
) /= Dir_Name
;
7423 List
:= Shared
.String_Elements
.Table
(List
).Next
;
7430 Add_Str_To_Name_Buffer
(Path_Name
);
7431 Path2
.Display_Name
:= Name_Find
;
7433 Canonical_Case_File_Name
(Name_Buffer
(1 .. Name_Len
));
7434 Path2
.Name
:= Name_Find
;
7437 Recursive_Find_Dirs
(Path2
, Rank
) or Success
;
7449 when Directory_Error
=>
7451 end Recursive_Find_Dirs
;
7457 procedure Find_Pattern
7458 (Pattern_Id
: Name_Id
;
7460 Location
: Source_Ptr
)
7462 Pattern
: constant String := Get_Name_String
(Pattern_Id
);
7463 Pattern_End
: Natural := Pattern
'Last;
7464 Recursive
: Boolean;
7465 Dir
: File_Name_Type
;
7466 Path_Name
: Path_Information
;
7467 Dir_Exists
: Boolean;
7468 Has_Error
: Boolean := False;
7472 Debug_Increase_Indent
("Find_Pattern", Pattern_Id
);
7474 -- If we are looking for files, find the pattern for the files
7476 if Search_For
= Search_Files
then
7477 while Pattern_End
>= Pattern
'First
7478 and then Pattern
(Pattern_End
) /= '/'
7479 and then Pattern
(Pattern_End
) /= Directory_Separator
7481 Pattern_End
:= Pattern_End
- 1;
7484 if Pattern_End
= Pattern
'Last then
7485 Err_Vars
.Error_Msg_File_1
:= File_Name_Type
(Pattern_Id
);
7487 (Data
.Flags
, Data
.Flags
.Missing_Source_Files
,
7488 "Missing file name or pattern in {", Location
, Project
);
7492 if Current_Verbosity
= High
then
7494 Write_Str
("file_pattern=");
7495 Write_Str
(Pattern
(Pattern_End
+ 1 .. Pattern
'Last));
7496 Write_Str
(" dir_pattern=");
7497 Write_Line
(Pattern
(Pattern
'First .. Pattern_End
));
7500 File_Pattern
:= Compile
7501 (Pattern
(Pattern_End
+ 1 .. Pattern
'Last),
7503 Case_Sensitive
=> File_Names_Case_Sensitive
);
7505 -- If we had just "*.gpr", this is equivalent to "./*.gpr"
7507 if Pattern_End
> Pattern
'First then
7508 Pattern_End
:= Pattern_End
- 1; -- Skip directory separator
7513 Pattern_End
- 1 >= Pattern
'First
7514 and then Pattern
(Pattern_End
- 1 .. Pattern_End
) = "**"
7515 and then (Pattern_End
- 1 = Pattern
'First
7516 or else Pattern
(Pattern_End
- 2) = '/'
7517 or else Pattern
(Pattern_End
- 2) = Directory_Separator
);
7520 Pattern_End
:= Pattern_End
- 2;
7521 if Pattern_End
> Pattern
'First then
7522 Pattern_End
:= Pattern_End
- 1; -- Skip '/'
7526 Name_Len
:= Pattern_End
- Pattern
'First + 1;
7527 Name_Buffer
(1 .. Name_Len
) := Pattern
(Pattern
'First .. Pattern_End
);
7531 (Project
=> Project
,
7534 Dir_Exists
=> Dir_Exists
,
7536 Must_Exist
=> False);
7538 if not Dir_Exists
then
7539 Err_Vars
.Error_Msg_File_1
:= Dir
;
7541 (Data
.Flags
, Data
.Flags
.Missing_Source_Files
,
7542 "{ is not a valid directory", Location
, Project
);
7543 Has_Error
:= Data
.Flags
.Missing_Source_Files
= Error
;
7546 if not Has_Error
then
7548 -- Links have been resolved if necessary, and Path_Name
7549 -- always ends with a directory separator.
7552 Success
:= Recursive_Find_Dirs
(Path_Name
, Rank
);
7554 Success
:= Subdirectory_Matches
(Path_Name
, Rank
);
7559 when Search_Directories
=>
7560 null; -- Error can't occur
7562 when Search_Files
=>
7563 Err_Vars
.Error_Msg_File_1
:= File_Name_Type
(Pattern_Id
);
7565 (Data
.Flags
, Data
.Flags
.Missing_Source_Files
,
7566 "file { not found", Location
, Project
);
7571 Debug_Decrease_Indent
("done Find_Pattern");
7576 Pattern_Id
: String_List_Id
:= Patterns
;
7577 Element
: String_Element
;
7578 Rank
: Natural := 1;
7580 -- Start of processing for Expand_Subdirectory_Pattern
7583 while Pattern_Id
/= Nil_String
loop
7584 Element
:= Shared
.String_Elements
.Table
(Pattern_Id
);
7585 Find_Pattern
(Element
.Value
, Rank
, Element
.Location
);
7587 Pattern_Id
:= Element
.Next
;
7590 Recursive_Dirs
.Reset
(Visited
);
7591 end Expand_Subdirectory_Pattern
;
7593 ------------------------
7594 -- Search_Directories --
7595 ------------------------
7597 procedure Search_Directories
7598 (Project
: in out Project_Processing_Data
;
7599 Data
: in out Tree_Processing_Data
;
7600 For_All_Sources
: Boolean)
7602 Shared
: constant Shared_Project_Tree_Data_Access
:= Data
.Tree
.Shared
;
7604 Source_Dir
: String_List_Id
;
7605 Element
: String_Element
;
7606 Src_Dir_Rank
: Number_List_Index
;
7607 Num_Nod
: Number_Node
;
7609 Name
: String (1 .. 1_000
);
7611 File_Name
: File_Name_Type
;
7612 Display_File_Name
: File_Name_Type
;
7615 Debug_Increase_Indent
("looking for sources of", Project
.Project
.Name
);
7617 -- Loop through subdirectories
7619 Src_Dir_Rank
:= Project
.Project
.Source_Dir_Ranks
;
7621 Source_Dir
:= Project
.Project
.Source_Dirs
;
7622 while Source_Dir
/= Nil_String
loop
7624 Num_Nod
:= Shared
.Number_Lists
.Table
(Src_Dir_Rank
);
7625 Element
:= Shared
.String_Elements
.Table
(Source_Dir
);
7627 -- Use Element.Value in this test, not Display_Value, because we
7628 -- want the symbolic links to be resolved when appropriate.
7630 if Element
.Value
/= No_Name
then
7632 Source_Directory
: constant String :=
7633 Get_Name_String
(Element
.Value
)
7634 & Directory_Separator
;
7636 Dir_Last
: constant Natural :=
7637 Compute_Directory_Last
(Source_Directory
);
7639 Display_Source_Directory
: constant String :=
7641 (Element
.Display_Value
)
7642 & Directory_Separator
;
7643 -- Display_Source_Directory is to allow us to open a UTF-8
7644 -- encoded directory on Windows.
7647 if Current_Verbosity
= High
then
7648 Debug_Increase_Indent
7649 ("Source_Dir (node=" & Num_Nod
.Number
'Img & ") """
7650 & Source_Directory
(Source_Directory
'First .. Dir_Last
)
7654 -- We look to every entry in the source directory
7656 Open
(Dir
, Display_Source_Directory
);
7659 Read
(Dir
, Name
, Last
);
7662 -- In fast project loading mode (without -eL), the user
7663 -- guarantees that no directory has a name which is a
7664 -- valid source name, so we can avoid doing a system call
7665 -- here. This provides a very significant speed up on
7666 -- slow file systems (remote files for instance).
7668 if not Opt
.Follow_Links_For_Files
7669 or else Is_Regular_File
7670 (Display_Source_Directory
& Name
(1 .. Last
))
7673 Name_Buffer
(1 .. Name_Len
) := Name
(1 .. Last
);
7674 Display_File_Name
:= Name_Find
;
7676 if Osint
.File_Names_Case_Sensitive
then
7677 File_Name
:= Display_File_Name
;
7679 Canonical_Case_File_Name
7680 (Name_Buffer
(1 .. Name_Len
));
7681 File_Name
:= Name_Find
;
7685 Path_Name
: constant String :=
7690 (Source_Directory
'First ..
7693 Opt
.Follow_Links_For_Files
,
7694 Case_Sensitive
=> True);
7696 Path
: Path_Name_Type
;
7698 Excluded_Sources_Htable
.Get
7699 (Project
.Excluded
, File_Name
);
7700 To_Remove
: Boolean := False;
7703 Name_Len
:= Path_Name
'Length;
7704 Name_Buffer
(1 .. Name_Len
) := Path_Name
;
7706 if Osint
.File_Names_Case_Sensitive
then
7709 Canonical_Case_File_Name
7710 (Name_Buffer
(1 .. Name_Len
));
7714 if FF
/= No_File_Found
then
7715 if not FF
.Found
then
7717 Excluded_Sources_Htable
.Set
7718 (Project
.Excluded
, File_Name
, FF
);
7721 ("excluded source ",
7722 Name_Id
(Display_File_Name
));
7724 -- Will mark the file as removed, but we
7725 -- still need to add it to the list: if we
7726 -- don't, the file will not appear in the
7727 -- mapping file and will cause the compiler
7734 -- Preserve the user's original casing and use of
7735 -- links. The display_value (a directory) already
7736 -- ends with a directory separator by construction,
7737 -- so no need to add one.
7739 Get_Name_String
(Element
.Display_Value
);
7740 Get_Name_String_And_Append
(Display_File_Name
);
7743 (Project
=> Project
,
7744 Source_Dir_Rank
=> Num_Nod
.Number
,
7747 Display_Path
=> Name_Find
,
7748 File_Name
=> File_Name
,
7749 Locally_Removed
=> To_Remove
,
7750 Display_File_Name
=> Display_File_Name
,
7751 For_All_Sources
=> For_All_Sources
);
7755 if Current_Verbosity
= High
then
7756 Debug_Output
("ignore " & Name
(1 .. Last
));
7761 Debug_Decrease_Indent
;
7767 when Directory_Error
=>
7771 Source_Dir
:= Element
.Next
;
7772 Src_Dir_Rank
:= Num_Nod
.Next
;
7775 Debug_Decrease_Indent
("end looking for sources.");
7776 end Search_Directories
;
7778 ----------------------------
7779 -- Load_Naming_Exceptions --
7780 ----------------------------
7782 procedure Load_Naming_Exceptions
7783 (Project
: in out Project_Processing_Data
;
7784 Data
: in out Tree_Processing_Data
)
7787 Iter
: Source_Iterator
;
7790 Iter
:= For_Each_Source
(Data
.Tree
, Project
.Project
);
7792 Source
:= Prj
.Element
(Iter
);
7793 exit when Source
= No_Source
;
7795 -- An excluded file cannot also be an exception file name
7797 if Excluded_Sources_Htable
.Get
(Project
.Excluded
, Source
.File
) /=
7800 Error_Msg_File_1
:= Source
.File
;
7803 "{ cannot be both excluded and an exception file name",
7804 No_Location
, Project
.Project
);
7808 ("naming exception: adding source file to source_Names: ",
7809 Name_Id
(Source
.File
));
7811 Source_Names_Htable
.Set
7812 (Project
.Source_Names
,
7815 (Name => Source.File,
7816 Location => Source.Location,
7821 -- If this is an Ada exception, record in table Unit_Exceptions
7823 if Source.Unit /= No_Unit_Index then
7825 Unit_Except : Unit_Exception :=
7826 Unit_Exceptions_Htable.Get
7827 (Project.Unit_Exceptions, Source.Unit.Name);
7830 Unit_Except.Name := Source.Unit.Name;
7832 if Source.Kind = Spec then
7833 Unit_Except.Spec := Source.File;
7835 Unit_Except.Impl := Source.File;
7838 Unit_Exceptions_Htable.Set
7839 (Project.Unit_Exceptions, Source.Unit.Name, Unit_Except);
7845 end Load_Naming_Exceptions;
7847 ----------------------
7848 -- Look_For_Sources --
7849 ----------------------
7851 procedure Look_For_Sources
7852 (Project : in out Project_Processing_Data;
7853 Data : in out Tree_Processing_Data)
7855 Object_Files : Object_File_Names_Htable.Instance;
7856 Iter : Source_Iterator;
7859 procedure Check_Object (Src : Source_Id);
7860 -- Check if object file name of Src is already used in the project tree,
7861 -- and report an error if so.
7863 procedure Check_Object_Files;
7864 -- Check that no two sources of this project have the same object file
7866 procedure Mark_Excluded_Sources;
7867 -- Mark as such the sources that are declared as excluded
7869 procedure Check_Missing_Sources;
7870 -- Check whether one of the languages has no sources, and report an
7871 -- error when appropriate
7873 procedure Get_Sources_From_Source_Info;
7874 -- Get the source information from the tables that were created when a
7875 -- source info file was read.
7877 ---------------------------
7878 -- Check_Missing_Sources --
7879 ---------------------------
7881 procedure Check_Missing_Sources is
7882 Extending : constant Boolean :=
7883 Project.Project.Extends /= No_Project;
7884 Language : Language_Ptr;
7886 Alt_Lang : Language_List;
7887 Continuation : Boolean := False;
7888 Iter : Source_Iterator;
7890 if not Project.Project.Externally_Built and then not Extending then
7891 Language := Project.Project.Languages;
7892 while Language /= No_Language_Index loop
7894 -- If there are no sources for this language, check if there
7895 -- are sources for which this is an alternate language.
7897 if Language.First_Source = No_Source
7898 and then (Data.Flags.Require_Sources_Other_Lang
7899 or else Language.Name = Name_Ada)
7901 Iter := For_Each_Source (In_Tree => Data.Tree,
7902 Project => Project.Project);
7904 Source := Element (Iter);
7905 exit Source_Loop when Source = No_Source
7906 or else Source.Language = Language;
7908 Alt_Lang := Source.Alternate_Languages;
7909 while Alt_Lang /= null loop
7910 exit Source_Loop when Alt_Lang.Language = Language;
7911 Alt_Lang := Alt_Lang.Next;
7915 end loop Source_Loop;
7917 if Source = No_Source then
7920 Get_Name_String (Language.Display_Name),
7922 Project.Source_List_File_Location,
7924 Continuation := True;
7928 Language := Language.Next;
7931 end Check_Missing_Sources;
7937 procedure Check_Object (Src : Source_Id) is
7941 Source := Object_File_Names_Htable.Get (Object_Files, Src.Object);
7943 -- We cannot just check on "Source /= Src", since we might have
7944 -- two different entries for the same file (and since that's
7945 -- the same file it is expected that it has the same object)
7947 if Source /= No_Source
7948 and then Source.Replaced_By = No_Source
7949 and then Source.Path /= Src.Path
7950 and then Is_Extending (Src.Project, Source.Project)
7952 Error_Msg_File_1 := Src.File;
7953 Error_Msg_File_2 := Source.File;
7956 "{ and { have the same object file name",
7957 No_Location, Project.Project);
7960 Object_File_Names_Htable.Set (Object_Files, Src.Object, Src);
7964 ---------------------------
7965 -- Mark_Excluded_Sources --
7966 ---------------------------
7968 procedure Mark_Excluded_Sources is
7969 Source : Source_Id := No_Source;
7970 Excluded : File_Found;
7974 -- Minor optimization: if there are no excluded files, no need to
7975 -- traverse the list of sources. We cannot however also check whether
7976 -- the existing exceptions have ".Found" set to True (indicating we
7977 -- found them before) because we need to do some final processing on
7978 -- them in any case.
7980 if Excluded_Sources_Htable.Get_First (Project.Excluded) /=
7983 Proj := Project.Project;
7984 while Proj /= No_Project loop
7985 Iter := For_Each_Source (Data.Tree, Proj);
7986 while Prj.Element (Iter) /= No_Source loop
7987 Source := Prj.Element (Iter);
7988 Excluded := Excluded_Sources_Htable.Get
7989 (Project.Excluded, Source.File);
7991 if Excluded /= No_File_Found then
7992 Source.In_Interfaces := False;
7993 Source.Locally_Removed := True;
7995 if Proj = Project.Project then
7996 Source.Suppressed := True;
7999 if Current_Verbosity = High then
8001 Write_Str ("removing file ");
8003 (Get_Name_String (Excluded.File)
8004 & " " & Get_Name_String (Source.Project.Name));
8007 Excluded_Sources_Htable.Remove
8008 (Project.Excluded, Source.File);
8014 Proj := Proj.Extends;
8018 -- If we have any excluded element left, that means we did not find
8021 Excluded := Excluded_Sources_Htable.Get_First (Project.Excluded);
8022 while Excluded /= No_File_Found loop
8023 if not Excluded.Found then
8025 -- Check if the file belongs to another imported project to
8026 -- provide a better error message.
8029 (In_Tree => Data.Tree,
8030 Project => Project.Project,
8031 In_Imported_Only => True,
8032 Base_Name => Excluded.File);
8034 Err_Vars.Error_Msg_File_1 := Excluded.File;
8036 if Src = No_Source then
8037 if Excluded.Excl_File = No_File then
8040 "unknown file {", Excluded.Location, Project.Project);
8046 Get_Name_String (Excluded.Excl_File) & ":" &
8047 No_Space_Img (Excluded.Excl_Line) &
8048 ": unknown file {", Excluded.Location, Project.Project);
8052 if Excluded.Excl_File = No_File then
8055 "cannot remove a source from an imported project: {",
8056 Excluded.Location, Project.Project);
8062 Get_Name_String (Excluded.Excl_File) & ":" &
8063 No_Space_Img (Excluded.Excl_Line) &
8064 ": cannot remove a source from an imported project: {",
8065 Excluded.Location, Project.Project);
8070 Excluded := Excluded_Sources_Htable.Get_Next (Project.Excluded);
8072 end Mark_Excluded_Sources;
8074 ------------------------
8075 -- Check_Object_Files --
8076 ------------------------
8078 procedure Check_Object_Files is
8079 Iter : Source_Iterator;
8081 Src_Ind : Source_File_Index;
8084 Iter := For_Each_Source (Data.Tree);
8086 Src_Id := Prj.Element (Iter);
8087 exit when Src_Id = No_Source;
8089 if Is_Compilable (Src_Id)
8090 and then Src_Id.Language.Config.Object_Generated
8091 and then Is_Extending (Project.Project, Src_Id.Project)
8093 if Src_Id.Unit = No_Unit_Index then
8094 if Src_Id.Kind = Impl then
8095 Check_Object (Src_Id);
8101 if Other_Part (Src_Id) = No_Source then
8102 Check_Object (Src_Id);
8109 if Other_Part (Src_Id) /= No_Source then
8110 Check_Object (Src_Id);
8113 -- Check if it is a subunit
8116 Sinput.P.Load_Project_File
8117 (Get_Name_String (Src_Id.Path.Display_Name));
8119 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
8120 Override_Kind (Src_Id, Sep);
8122 Check_Object (Src_Id);
8131 end Check_Object_Files;
8133 ----------------------------------
8134 -- Get_Sources_From_Source_Info --
8135 ----------------------------------
8137 procedure Get_Sources_From_Source_Info is
8138 Iter : Source_Info_Iterator;
8141 Lang_Id : Language_Ptr;
8144 Initialize (Iter, Project.Project.Name);
8147 Src := Source_Info_Of (Iter);
8149 exit when Src = No_Source_Info;
8151 Id := new Source_Data;
8153 Id.Project := Project.Project;
8155 Lang_Id := Project.Project.Languages;
8156 while Lang_Id /= No_Language_Index
8157 and then Lang_Id.Name /= Src.Language
8159 Lang_Id := Lang_Id.Next;
8162 if Lang_Id = No_Language_Index then
8164 ("unknown language " &
8165 Get_Name_String (Src.Language) &
8167 Get_Name_String (Src.Project) &
8168 " in source info file");
8171 Id.Language := Lang_Id;
8172 Id.Kind := Src.Kind;
8173 Id.Index := Src.Index;
8176 (Path_Name_Type (Src.Display_Path_Name),
8177 Path_Name_Type (Src.Path_Name));
8180 Add_Str_To_Name_Buffer
8181 (Directories.Simple_Name (Get_Name_String (Src.Path_Name)));
8182 Id.File := Name_Find;
8184 Id.Next_With_File_Name :=
8185 Source_Files_Htable.Get (Data.Tree.Source_Files_HT, Id.File);
8186 Source_Files_Htable.Set (Data.Tree.Source_Files_HT, Id.File, Id);
8189 Add_Str_To_Name_Buffer
8190 (Directories.Simple_Name
8191 (Get_Name_String (Src.Display_Path_Name)));
8192 Id.Display_File := Name_Find;
8195 Dependency_Name (Id.File, Id.Language.Config.Dependency_Kind);
8196 Id.Naming_Exception := Src.Naming_Exception;
8198 Object_Name (Id.File, Id.Language.Config.Object_File_Suffix);
8199 Id.Switches := Switches_Name (Id.File);
8201 -- Add the source id to the Unit_Sources_HT hash table, if the
8202 -- unit name is not null.
8204 if Src.Kind /= Sep and then Src.Unit_Name /= No_Name then
8206 UData : Unit_Index :=
8207 Units_Htable.Get (Data.Tree.Units_HT, Src.Unit_Name);
8209 if UData = No_Unit_Index then
8210 UData := new Unit_Data;
8211 UData.Name := Src.Unit_Name;
8213 (Data.Tree.Units_HT, Src.Unit_Name, UData);
8219 -- Note that this updates Unit information as well
8221 Override_Kind (Id, Id.Kind);
8224 if Src.Index /= 0 then
8225 Project.Project.Has_Multi_Unit_Sources := True;
8228 -- Add the source to the language list
8230 Id.Next_In_Lang := Id.Language.First_Source;
8231 Id.Language.First_Source := Id;
8235 end Get_Sources_From_Source_Info;
8237 -- Start of processing for Look_For_Sources
8240 if Data.Tree.Source_Info_File_Exists then
8241 Get_Sources_From_Source_Info;
8244 if Project.Project.Source_Dirs /= Nil_String then
8245 Find_Excluded_Sources (Project, Data);
8247 if Project.Project.Languages /= No_Language_Index then
8248 Load_Naming_Exceptions (Project, Data);
8249 Find_Sources (Project, Data);
8250 Mark_Excluded_Sources;
8252 Check_Missing_Sources;
8256 Object_File_Names_Htable.Reset (Object_Files);
8258 end Look_For_Sources;
8264 function Path_Name_Of
8265 (File_Name : File_Name_Type;
8266 Directory : Path_Name_Type) return String
8268 Result : String_Access;
8269 The_Directory : constant String := Get_Name_String (Directory);
8272 Debug_Output ("Path_Name_Of file name=", Name_Id (File_Name));
8273 Debug_Output ("Path_Name_Of directory=", Name_Id (Directory));
8274 Get_Name_String (File_Name);
8277 (File_Name => Name_Buffer (1 .. Name_Len),
8278 Path => The_Directory);
8280 if Result = null then
8284 R : constant String := Result.all;
8296 procedure Remove_Source
8297 (Tree : Project_Tree_Ref;
8299 Replaced_By : Source_Id)
8304 if Current_Verbosity = High then
8306 Write_Str ("removing source ");
8307 Write_Str (Get_Name_String (Id.File));
8309 if Id.Index /= 0 then
8310 Write_Str (" at" & Id.Index'Img);
8316 if Replaced_By /= No_Source then
8317 Id.Replaced_By := Replaced_By;
8318 Replaced_By.Declared_In_Interfaces := Id.Declared_In_Interfaces;
8320 if Id.File /= Replaced_By.File then
8322 Replacement : constant File_Name_Type :=
8323 Replaced_Source_HTable.Get
8324 (Tree.Replaced_Sources, Id.File);
8327 Replaced_Source_HTable.Set
8328 (Tree.Replaced_Sources, Id.File, Replaced_By.File);
8330 if Replacement = No_File then
8331 Tree.Replaced_Source_Number :=
8332 Tree.Replaced_Source_Number + 1;
8338 Id.In_Interfaces := False;
8339 Id.Locally_Removed := True;
8341 -- ??? Should we remove the source from the unit ? The file is not used,
8342 -- so probably should not be referenced from the unit. On the other hand
8343 -- it might give useful additional info
8344 -- if Id.Unit /= null then
8345 -- Id.Unit.File_Names (Id.Kind) := null;
8348 Source := Id.Language.First_Source;
8351 Id.Language.First_Source := Id.Next_In_Lang;
8354 while Source.Next_In_Lang /= Id loop
8355 Source := Source.Next_In_Lang;
8358 Source.Next_In_Lang := Id.Next_In_Lang;
8362 -----------------------
8363 -- Report_No_Sources --
8364 -----------------------
8366 procedure Report_No_Sources
8367 (Project : Project_Id;
8369 Data : Tree_Processing_Data;
8370 Location : Source_Ptr;
8371 Continuation : Boolean := False)
8374 case Data.Flags.When_No_Sources is
8378 when Warning | Error =>
8380 Msg : constant String :=
8382 & Lang_Name & " sources in this project";
8385 Error_Msg_Warn := Data.Flags.When_No_Sources = Warning;
8387 if Continuation then
8388 Error_Msg (Data.Flags, "\" & Msg, Location, Project);
8390 Error_Msg (Data.Flags, Msg, Location, Project);
8394 end Report_No_Sources;
8396 ----------------------
8397 -- Show_Source_Dirs --
8398 ----------------------
8400 procedure Show_Source_Dirs
8401 (Project : Project_Id;
8402 Shared : Shared_Project_Tree_Data_Access)
8404 Current : String_List_Id;
8405 Element : String_Element;
8408 if Project.Source_Dirs = Nil_String then
8409 Debug_Output ("no Source_Dirs");
8411 Debug_Increase_Indent ("Source_Dirs:");
8413 Current := Project.Source_Dirs;
8414 while Current /= Nil_String loop
8415 Element := Shared.String_Elements.Table (Current);
8416 Debug_Output (Get_Name_String (Element.Display_Value));
8417 Current := Element.Next;
8420 Debug_Decrease_Indent ("end Source_Dirs.");
8422 end Show_Source_Dirs;
8424 ---------------------------
8425 -- Process_Naming_Scheme --
8426 ---------------------------
8428 procedure Process_Naming_Scheme
8429 (Tree : Project_Tree_Ref;
8430 Root_Project : Project_Id;
8431 Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
8432 Flags : Processing_Flags)
8436 (Project : Project_Id;
8437 In_Aggregate_Lib : Boolean;
8438 Data : in out Tree_Processing_Data);
8439 -- Process the naming scheme for a single project
8441 procedure Recursive_Check
8442 (Project : Project_Id;
8443 Prj_Tree : Project_Tree_Ref;
8444 Context : Project_Context;
8445 Data : in out Tree_Processing_Data);
8446 -- Check_Naming_Scheme for the project
8453 (Project : Project_Id;
8454 In_Aggregate_Lib : Boolean;
8455 Data : in out Tree_Processing_Data)
8457 procedure Check_Aggregated;
8458 -- Check aggregated projects which should not be externally built
8460 ----------------------
8461 -- Check_Aggregated --
8462 ----------------------
8464 procedure Check_Aggregated is
8465 L : Aggregated_Project_List;
8468 -- Check that aggregated projects are not externally built
8470 L := Project.Aggregated_Projects;
8471 while L /= null loop
8473 Var : constant Prj.Variable_Value :=
8475 (Snames.Name_Externally_Built,
8476 L.Project.Decl.Attributes,
8479 if not Var.Default then
8480 Error_Msg_Name_1 := L.Project.Display_Name;
8483 "cannot aggregate externally built project %%",
8484 Var.Location, Project);
8490 end Check_Aggregated;
8494 Shared : constant Shared_Project_Tree_Data_Access :=
8496 Prj_Data : Project_Processing_Data;
8498 -- Start of processing for Check
8501 Debug_Increase_Indent ("check", Project.Name);
8503 Initialize (Prj_Data, Project);
8505 Check_If_Externally_Built (Project, Data);
8507 case Project.Qualifier is
8511 when Aggregate_Library =>
8514 if Project.Object_Directory = No_Path_Information then
8515 Project.Object_Directory := Project.Directory;
8519 Get_Directories (Project, Data);
8520 Check_Programming_Languages (Project, Data);
8522 if Current_Verbosity = High then
8523 Show_Source_Dirs (Project, Shared);
8526 if Project.Qualifier = Abstract_Project then
8527 Check_Abstract_Project (Project, Data);
8531 -- Check configuration. Must be done for gnatmake (even though no
8532 -- user configuration file was provided) since the default config we
8533 -- generate indicates whether libraries are supported for instance.
8535 Check_Configuration (Project, Data);
8537 if Project.Qualifier /= Aggregate then
8538 Check_Library_Attributes (Project, Data);
8539 Check_Package_Naming (Project, Data);
8541 -- An aggregate library has no source, no need to look for them
8543 if Project.Qualifier /= Aggregate_Library then
8544 Look_For_Sources (Prj_Data, Data);
8547 Check_Interfaces (Project, Data);
8549 -- If this library is part of an aggregated library don't check it
8550 -- as it has no sources by itself and so interface won't be found.
8552 if Project.Library and not In_Aggregate_Lib then
8553 Check_Stand_Alone_Library (Project, Data);
8556 Get_Mains (Project, Data);
8561 Debug_Decrease_Indent ("done check");
8564 ---------------------
8565 -- Recursive_Check --
8566 ---------------------
8568 procedure Recursive_Check
8569 (Project : Project_Id;
8570 Prj_Tree : Project_Tree_Ref;
8571 Context : Project_Context;
8572 Data : in out Tree_Processing_Data)
8575 if Current_Verbosity = High then
8576 Debug_Increase_Indent
8577 ("Processing_Naming_Scheme for project", Project.Name);
8580 Data.Tree := Prj_Tree;
8581 Data.In_Aggregate_Lib := Context.In_Aggregate_Lib;
8583 Check (Project, Context.In_Aggregate_Lib, Data);
8585 if Current_Verbosity = High then
8586 Debug_Decrease_Indent ("done Processing_Naming_Scheme");
8588 end Recursive_Check;
8590 procedure Check_All_Projects is new For_Every_Project_Imported_Context
8591 (Tree_Processing_Data, Recursive_Check);
8592 -- Comment required???
8596 Data : Tree_Processing_Data;
8598 -- Start of processing for Process_Naming_Scheme
8601 Lib_Data_Table.Init;
8602 Initialize (Data, Tree => Tree, Node_Tree => Node_Tree, Flags => Flags);
8603 Check_All_Projects (Root_Project, Tree, Data, Imported_First => True);
8606 -- Adjust language configs for projects that are extended
8609 List : Project_List;
8612 Lang : Language_Ptr;
8613 Elng : Language_Ptr;
8616 List := Tree.Projects;
8617 while List /= null loop
8618 Proj := List.Project;
8621 while Exte.Extended_By /= No_Project loop
8622 Exte := Exte.Extended_By;
8625 if Exte /= Proj then
8626 Lang := Proj.Languages;
8628 if Lang /= No_Language_Index then
8630 Elng := Get_Language_From_Name
8631 (Exte, Get_Name_String (Lang.Name));
8632 exit when Elng /= No_Language_Index;
8633 Exte := Exte.Extends;
8636 if Elng /= Lang then
8637 Lang.Config := Elng.Config;
8645 end Process_Naming_Scheme;