1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2000-2009, 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 GNAT.Case_Util; use GNAT.Case_Util;
27 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
28 with GNAT.Dynamic_HTables;
30 with Err_Vars; use Err_Vars;
32 with Osint; use Osint;
33 with Output; use Output;
34 with Prj.Err; use Prj.Err;
35 with Prj.Util; use Prj.Util;
37 with Snames; use Snames;
38 with Targparm; use Targparm;
40 with Ada.Characters.Handling; use Ada.Characters.Handling;
41 with Ada.Directories; use Ada.Directories;
42 with Ada.Strings; use Ada.Strings;
43 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
44 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
46 package body Prj.Nmsc is
48 No_Continuation_String : aliased String := "";
49 Continuation_String : aliased String := "\";
50 -- Used in Check_Library for continuation error messages at the same
53 type Name_Location is record
54 Name : File_Name_Type; -- ??? duplicates the key
55 Location : Source_Ptr;
56 Source : Source_Id := No_Source;
57 Found : Boolean := False;
59 No_Name_Location : constant Name_Location :=
60 (No_File, No_Location, No_Source, False);
61 package Source_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable
62 (Header_Num => Header_Num,
63 Element => Name_Location,
64 No_Element => No_Name_Location,
65 Key => File_Name_Type,
68 -- Information about file names found in string list attribute
69 -- (Source_Files or Source_List_File).
70 -- Except is set to True if source is a naming exception in the project.
71 -- This is used to check that all referenced files were indeed found on the
74 type Unit_Exception is record
75 Name : Name_Id; -- ??? duplicates the key
76 Spec : File_Name_Type;
77 Impl : File_Name_Type;
80 No_Unit_Exception : constant Unit_Exception := (No_Name, No_File, No_File);
82 package Unit_Exceptions_Htable is new GNAT.Dynamic_HTables.Simple_HTable
83 (Header_Num => Header_Num,
84 Element => Unit_Exception,
85 No_Element => No_Unit_Exception,
89 -- Record special naming schemes for Ada units (name of spec file and name
90 -- of implementation file). The elements in this list come from the naming
91 -- exceptions specified in the project files.
93 type File_Found is record
94 File : File_Name_Type := No_File;
95 Found : Boolean := False;
96 Location : Source_Ptr := No_Location;
99 No_File_Found : constant File_Found := (No_File, False, No_Location);
101 package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable
102 (Header_Num => Header_Num,
103 Element => File_Found,
104 No_Element => No_File_Found,
105 Key => File_Name_Type,
108 -- A hash table to store the base names of excluded files, if any
110 package Object_File_Names_Htable is new GNAT.Dynamic_HTables.Simple_HTable
111 (Header_Num => Header_Num,
112 Element => Source_Id,
113 No_Element => No_Source,
114 Key => File_Name_Type,
117 -- A hash table to store the object file names for a project, to check that
118 -- two different sources have different object file names.
120 type Project_Processing_Data is record
121 Project : Project_Id;
122 Source_Names : Source_Names_Htable.Instance;
123 Unit_Exceptions : Unit_Exceptions_Htable.Instance;
124 Excluded : Excluded_Sources_Htable.Instance;
126 Source_List_File_Location : Source_Ptr;
127 -- Location of the Source_List_File attribute, for error messages
129 -- This is similar to Tree_Processing_Data, but contains project-specific
130 -- information which is only useful while processing the project, and can
131 -- be discarded as soon as we have finished processing the project
133 package Files_Htable is new GNAT.Dynamic_HTables.Simple_HTable
134 (Header_Num => Header_Num,
135 Element => Source_Id,
136 No_Element => No_Source,
137 Key => File_Name_Type,
140 -- Mapping from base file names to Source_Id (containing full info about
143 type Tree_Processing_Data is record
144 Tree : Project_Tree_Ref;
145 File_To_Source : Files_Htable.Instance;
146 Flags : Prj.Processing_Flags;
148 -- Temporary data which is needed while parsing a project. It does not need
149 -- to be kept in memory once a project has been fully loaded, but is
150 -- necessary while performing consistency checks (duplicate sources,...)
151 -- This data must be initialized before processing any project, and the
152 -- same data is used for processing all projects in the tree.
155 (Data : out Tree_Processing_Data;
156 Tree : Project_Tree_Ref;
157 Flags : Prj.Processing_Flags);
160 procedure Free (Data : in out Tree_Processing_Data);
161 -- Free the memory occupied by Data
164 (Project : Project_Id;
165 Data : in out Tree_Processing_Data);
166 -- Process the naming scheme for a single project
169 (Data : in out Project_Processing_Data;
170 Project : Project_Id);
171 procedure Free (Data : in out Project_Processing_Data);
172 -- Initialize or free memory for a project-specific data
174 procedure Find_Excluded_Sources
175 (Project : in out Project_Processing_Data;
176 Data : in out Tree_Processing_Data);
177 -- Find the list of files that should not be considered as source files
178 -- for this project. Sets the list in the Project.Excluded_Sources_Htable.
180 procedure Override_Kind (Source : Source_Id; Kind : Source_Kind);
181 -- Override the reference kind for a source file. This properly updates
182 -- the unit data if necessary.
184 procedure Load_Naming_Exceptions
185 (Project : in out Project_Processing_Data;
186 Data : in out Tree_Processing_Data);
187 -- All source files in Data.First_Source are considered as naming
188 -- exceptions, and copied into the Source_Names and Unit_Exceptions tables
193 Data : in out Tree_Processing_Data;
194 Project : Project_Id;
195 Lang_Id : Language_Ptr;
197 File_Name : File_Name_Type;
198 Display_File : File_Name_Type;
199 Naming_Exception : Boolean := False;
200 Path : Path_Information := No_Path_Information;
201 Alternate_Languages : Language_List := null;
202 Unit : Name_Id := No_Name;
204 Locally_Removed : Boolean := False;
205 Location : Source_Ptr := No_Location);
206 -- Add a new source to the different lists: list of all sources in the
207 -- project tree, list of source of a project and list of sources of a
210 -- If Path is specified, the file is also added to Source_Paths_HT.
212 -- Location is used for error messages
214 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type;
215 -- Same as Osint.Canonical_Case_File_Name but applies to Name_Id.
216 -- This alters Name_Buffer
218 function Suffix_Matches
220 Suffix : File_Name_Type) return Boolean;
221 -- True if the file name ends with the given suffix. Always returns False
222 -- if Suffix is No_Name.
224 procedure Replace_Into_Name_Buffer
227 Replacement : Character);
228 -- Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is
229 -- converted to lower-case at the same time.
231 procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
232 -- Check that a name is a valid Ada unit name
234 procedure Check_Package_Naming
235 (Project : Project_Id;
236 Data : in out Tree_Processing_Data;
237 Bodies : out Array_Element_Id;
238 Specs : out Array_Element_Id);
239 -- Check the naming scheme part of Data, and initialize the naming scheme
240 -- data in the config of the various languages. This also returns the
241 -- naming scheme exceptions for unit-based languages (Bodies and Specs are
242 -- associative arrays mapping individual unit names to source file names).
244 procedure Check_Configuration
245 (Project : Project_Id;
246 Data : in out Tree_Processing_Data);
247 -- Check the configuration attributes for the project
249 procedure Check_If_Externally_Built
250 (Project : Project_Id;
251 Data : in out Tree_Processing_Data);
252 -- Check attribute Externally_Built of project Project in project tree
253 -- Data.Tree and modify its data Data if it has the value "true".
255 procedure Check_Interfaces
256 (Project : Project_Id;
257 Data : in out Tree_Processing_Data);
258 -- If a list of sources is specified in attribute Interfaces, set
259 -- In_Interfaces only for the sources specified in the list.
261 procedure Check_Library_Attributes
262 (Project : Project_Id;
263 Data : in out Tree_Processing_Data);
264 -- Check the library attributes of project Project in project tree
265 -- and modify its data Data accordingly.
267 procedure Check_Programming_Languages
268 (Project : Project_Id;
269 Data : in out Tree_Processing_Data);
270 -- Check attribute Languages for the project with data Data in project
271 -- tree Data.Tree and set the components of Data for all the programming
272 -- languages indicated in attribute Languages, if any.
274 procedure Check_Stand_Alone_Library
275 (Project : Project_Id;
276 Data : in out Tree_Processing_Data);
277 -- Check if project Project in project tree Data.Tree is a Stand-Alone
278 -- Library project, and modify its data Data accordingly if it is one.
280 function Compute_Directory_Last (Dir : String) return Natural;
281 -- Return the index of the last significant character in Dir. This is used
282 -- to avoid duplicate '/' (slash) characters at the end of directory names.
284 procedure Search_Directories
285 (Project : in out Project_Processing_Data;
286 Data : in out Tree_Processing_Data;
287 For_All_Sources : Boolean);
288 -- Search the source directories to find the sources. If For_All_Sources is
289 -- True, check each regular file name against the naming schemes of the
290 -- various languages. Otherwise consider only the file names in hash table
291 -- Source_Names. If Allow_Duplicate_Basenames then files with identical
292 -- base names are permitted within a project for source-based languages
293 -- (never for unit based languages).
296 (Project : in out Project_Processing_Data;
297 Data : in out Tree_Processing_Data;
298 Path : Path_Name_Type;
299 File_Name : File_Name_Type;
300 Display_File_Name : File_Name_Type;
301 Locally_Removed : Boolean;
302 For_All_Sources : Boolean);
303 -- Check if file File_Name is a valid source of the project. This is used
304 -- in multi-language mode only. When the file matches one of the naming
305 -- schemes, it is added to various htables through Add_Source and to
306 -- Source_Paths_Htable.
308 -- Name is the name of the candidate file. It hasn't been normalized yet
309 -- and is the direct result of readdir().
311 -- File_Name is the same as Name, but has been normalized.
312 -- Display_File_Name, however, has not been normalized.
314 -- Source_Directory is the directory in which the file was found. It is
315 -- neither normalized nor has had links resolved, and must not end with a
316 -- a directory separator, to avoid duplicates later on.
318 -- If For_All_Sources is True, then all possible file names are analyzed
319 -- otherwise only those currently set in the Source_Names hash table.
321 procedure Check_File_Naming_Schemes
322 (In_Tree : Project_Tree_Ref;
323 Project : Project_Processing_Data;
324 File_Name : File_Name_Type;
325 Alternate_Languages : out Language_List;
326 Language : out Language_Ptr;
327 Display_Language_Name : out Name_Id;
329 Lang_Kind : out Language_Kind;
330 Kind : out Source_Kind);
331 -- Check if the file name File_Name conforms to one of the naming schemes
332 -- of the project. If the file does not match one of the naming schemes,
333 -- set Language to No_Language_Index. Filename is the name of the file
334 -- being investigated. It has been normalized (case-folded). File_Name is
337 procedure Get_Directories
338 (Project : Project_Id;
339 Data : in out Tree_Processing_Data);
340 -- Get the object directory, the exec directory and the source directories
344 (Project : Project_Id;
345 Data : in out Tree_Processing_Data);
346 -- Get the mains of a project from attribute Main, if it exists, and put
347 -- them in the project data.
349 procedure Get_Sources_From_File
351 Location : Source_Ptr;
352 Project : in out Project_Processing_Data;
353 Data : in out Tree_Processing_Data);
354 -- Get the list of sources from a text file and put them in hash table
357 procedure Find_Sources
358 (Project : in out Project_Processing_Data;
359 Data : in out Tree_Processing_Data);
360 -- Process the Source_Files and Source_List_File attributes, and store the
361 -- list of source files into the Source_Names htable. When these attributes
362 -- are not defined, find all files matching the naming schemes in the
363 -- source directories. If Allow_Duplicate_Basenames, then files with the
364 -- same base names are authorized within a project for source-based
365 -- languages (never for unit based languages)
367 procedure Compute_Unit_Name
368 (File_Name : File_Name_Type;
369 Naming : Lang_Naming_Data;
370 Kind : out Source_Kind;
372 Project : Project_Processing_Data;
373 In_Tree : Project_Tree_Ref);
374 -- Check whether the file matches the naming scheme. If it does,
375 -- compute its unit name. If Unit is set to No_Name on exit, none of the
376 -- other out parameters are relevant.
378 procedure Check_Illegal_Suffix
379 (Project : Project_Id;
380 Suffix : File_Name_Type;
381 Dot_Replacement : File_Name_Type;
382 Attribute_Name : String;
383 Location : Source_Ptr;
384 Data : in out Tree_Processing_Data);
385 -- Display an error message if the given suffix is illegal for some reason.
386 -- The name of the attribute we are testing is specified in Attribute_Name,
387 -- which is used in the error message. Location is the location where the
388 -- suffix is defined.
390 procedure Locate_Directory
391 (Project : Project_Id;
392 Name : File_Name_Type;
393 Path : out Path_Information;
394 Dir_Exists : out Boolean;
395 Data : in out Tree_Processing_Data;
396 Create : String := "";
397 Location : Source_Ptr := No_Location;
398 Must_Exist : Boolean := True;
399 Externally_Built : Boolean := False);
400 -- Locate a directory. Name is the directory name. Relative paths are
401 -- resolved relative to the project's directory. If the directory does not
402 -- exist and Setup_Projects is True and Create is a non null string, an
403 -- attempt is made to create the directory. If the directory does not
404 -- exist, it is either created if Setup_Projects is False (and then
405 -- returned), or simply returned without checking for its existence (if
406 -- Must_Exist is False) or No_Path_Information is returned. In all cases,
407 -- Dir_Exists indicates whether the directory now exists. Create is also
408 -- used for debugging traces to show which path we are computing.
410 procedure Look_For_Sources
411 (Project : in out Project_Processing_Data;
412 Data : in out Tree_Processing_Data);
413 -- Find all the sources of project Project in project tree Data.Tree and
414 -- update its Data accordingly. This assumes that Data.First_Source has
415 -- been initialized with the list of excluded sources and special naming
418 function Path_Name_Of
419 (File_Name : File_Name_Type;
420 Directory : Path_Name_Type) return String;
421 -- Returns the path name of a (non project) file. Returns an empty string
422 -- if file cannot be found.
424 procedure Remove_Source
426 Replaced_By : Source_Id);
427 -- Remove a file from the list of sources of a project. This might be
428 -- because the file is replaced by another one in an extending project,
429 -- or because a file was added as a naming exception but was not found
432 procedure Report_No_Sources
433 (Project : Project_Id;
435 Data : Tree_Processing_Data;
436 Location : Source_Ptr;
437 Continuation : Boolean := False);
438 -- Report an error or a warning depending on the value of When_No_Sources
439 -- when there are no sources for language Lang_Name.
441 procedure Show_Source_Dirs
442 (Project : Project_Id; In_Tree : Project_Tree_Ref);
443 -- List all the source directories of a project
445 procedure Write_Attr (Name, Value : String);
446 -- Debug print a value for a specific property. Does nothing when not in
449 ------------------------------
450 -- Replace_Into_Name_Buffer --
451 ------------------------------
453 procedure Replace_Into_Name_Buffer
456 Replacement : Character)
458 Max : constant Integer := Str'Last - Pattern'Length + 1;
465 while J <= Str'Last loop
466 Name_Len := Name_Len + 1;
469 and then Str (J .. J + Pattern'Length - 1) = Pattern
471 Name_Buffer (Name_Len) := Replacement;
472 J := J + Pattern'Length;
475 Name_Buffer (Name_Len) := GNAT.Case_Util.To_Lower (Str (J));
479 end Replace_Into_Name_Buffer;
485 function Suffix_Matches
487 Suffix : File_Name_Type) return Boolean
489 Min_Prefix_Length : Natural := 0;
492 if Suffix = No_File or else Suffix = Empty_File then
497 Suf : String := Get_Name_String (Suffix);
500 -- On non case-sensitive systems, use proper suffix casing
502 Canonical_Case_File_Name (Suf);
504 -- The file name must end with the suffix (which is not an extension)
505 -- For instance a suffix "configure.in" must match a file with the
506 -- same name. To avoid dummy cases, though, a suffix starting with
507 -- '.' requires a file that is at least one character longer ('.cpp'
508 -- should not match a file with the same name)
510 if Suf (Suf'First) = '.' then
511 Min_Prefix_Length := 1;
514 return Filename'Length >= Suf'Length + Min_Prefix_Length
516 (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;
524 procedure Write_Attr (Name, Value : String) is
526 if Current_Verbosity = High then
527 Write_Str (" " & Name & " = """);
540 Data : in out Tree_Processing_Data;
541 Project : Project_Id;
542 Lang_Id : Language_Ptr;
544 File_Name : File_Name_Type;
545 Display_File : File_Name_Type;
546 Naming_Exception : Boolean := False;
547 Path : Path_Information := No_Path_Information;
548 Alternate_Languages : Language_List := null;
549 Unit : Name_Id := No_Name;
551 Locally_Removed : Boolean := False;
552 Location : Source_Ptr := No_Location)
554 Config : constant Language_Config := Lang_Id.Config;
558 Prev_Unit : Unit_Index := No_Unit_Index;
560 Source_To_Replace : Source_Id := No_Source;
563 -- Check if the same file name or unit is used in the prj tree
567 if Unit /= No_Name then
568 Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit);
571 if Prev_Unit /= No_Unit_Index
572 and then (Kind = Impl or else Kind = Spec)
573 and then Prev_Unit.File_Names (Kind) /= null
575 -- Suspicious, we need to check later whether this is authorized
578 Source := Prev_Unit.File_Names (Kind);
581 Source := Files_Htable.Get (Data.File_To_Source, File_Name);
583 if Source /= No_Source
584 and then Source.Index = Index
590 -- Duplication of file/unit in same project is allowed if order of
591 -- source directories is known.
593 if Add_Src = False then
596 if Project = Source.Project then
597 if Prev_Unit = No_Unit_Index then
598 if Data.Flags.Allow_Duplicate_Basenames then
601 elsif Project.Known_Order_Of_Source_Dirs then
605 Error_Msg_File_1 := File_Name;
607 (Data.Flags, "duplicate source file name {",
613 if Project.Known_Order_Of_Source_Dirs then
616 -- We might be seeing the same file through a different path
617 -- (for instance because of symbolic links).
619 elsif Source.Path.Name /= Path.Name then
620 Error_Msg_Name_1 := Unit;
622 (Data.Flags, "duplicate unit %%", Location, Project);
627 -- Do not allow the same unit name in different projects, except
628 -- if one is extending the other.
630 -- For a file based language, the same file name replaces a file
631 -- in a project being extended, but it is allowed to have the same
632 -- file name in unrelated projects.
634 elsif Is_Extending (Project, Source.Project) then
635 if not Locally_Removed then
636 Source_To_Replace := Source;
639 elsif Prev_Unit /= No_Unit_Index
640 and then not Source.Locally_Removed
642 -- Path is set if this is a source we found on the disk, in which
643 -- case we can provide more explicit error message. Path is unset
644 -- when the source is added from one of the naming exceptions in
647 if Path /= No_Path_Information then
648 Error_Msg_Name_1 := Unit;
651 "unit %% cannot belong to several projects",
654 Error_Msg_Name_1 := Project.Name;
655 Error_Msg_Name_2 := Name_Id (Path.Name);
657 (Data.Flags, "\ project %%, %%", Location, Project);
659 Error_Msg_Name_1 := Source.Project.Name;
660 Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);
662 (Data.Flags, "\ project %%, %%", Location, Project);
665 Error_Msg_Name_1 := Unit;
666 Error_Msg_Name_2 := Source.Project.Name;
668 (Data.Flags, "unit %% already belongs to project %%",
674 elsif not Source.Locally_Removed
675 and then not Data.Flags.Allow_Duplicate_Basenames
676 and then Lang_Id.Config.Kind = Unit_Based
678 Error_Msg_File_1 := File_Name;
679 Error_Msg_File_2 := File_Name_Type (Source.Project.Name);
682 "{ is already a source of project {", Location, Project);
684 -- Add the file anyway, to avoid further warnings like "language
697 Id := new Source_Data;
699 if Current_Verbosity = High then
700 Write_Str ("Adding source File: ");
701 Write_Str (Get_Name_String (File_Name));
704 Write_Str (" at" & Index'Img);
707 if Lang_Id.Config.Kind = Unit_Based then
708 Write_Str (" Unit: ");
710 -- ??? in gprclean, it seems we sometimes pass an empty Unit name
711 -- (see test extended_projects).
713 if Unit /= No_Name then
714 Write_Str (Get_Name_String (Unit));
717 Write_Str (" Kind: ");
718 Write_Str (Source_Kind'Image (Kind));
724 Id.Project := Project;
725 Id.Language := Lang_Id;
727 Id.Alternate_Languages := Alternate_Languages;
728 Id.Locally_Removed := Locally_Removed;
730 Id.File := File_Name;
731 Id.Display_File := Display_File;
732 Id.Dep_Name := Dependency_Name
733 (File_Name, Lang_Id.Config.Dependency_Kind);
734 Id.Naming_Exception := Naming_Exception;
736 -- Add the source id to the Unit_Sources_HT hash table, if the unit name
739 if Unit /= No_Name then
741 -- Note: we might be creating a dummy unit here, when we in fact have
742 -- a separate. For instance, file file-bar.adb will initially be
743 -- assumed to be the IMPL of unit "file.bar". Only later on (in
744 -- Check_Object_Files) will we parse those units that only have an
745 -- impl and no spec to make sure whether we have a Separate in fact
746 -- (that significantly reduces the number of times we need to parse
747 -- the files, since we are then only interested in those with no
748 -- spec). We still need those dummy units in the table, since that's
749 -- the name we find in the ALI file
751 UData := Units_Htable.Get (Data.Tree.Units_HT, Unit);
753 if UData = No_Unit_Index then
754 UData := new Unit_Data;
756 Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
761 -- Note that this updates Unit information as well
763 Override_Kind (Id, Kind);
766 if Is_Compilable (Id) and then Config.Object_Generated then
767 Id.Object := Object_Name (File_Name, Config.Object_File_Suffix);
768 Id.Switches := Switches_Name (File_Name);
771 if Path /= No_Path_Information then
773 Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id);
776 -- Add the source to the language list
778 Id.Next_In_Lang := Lang_Id.First_Source;
779 Lang_Id.First_Source := Id;
781 if Source_To_Replace /= No_Source then
782 Remove_Source (Source_To_Replace, Id);
785 Files_Htable.Set (Data.File_To_Source, File_Name, Id);
788 ------------------------------
789 -- Canonical_Case_File_Name --
790 ------------------------------
792 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type is
794 if Osint.File_Names_Case_Sensitive then
795 return File_Name_Type (Name);
797 Get_Name_String (Name);
798 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
801 end Canonical_Case_File_Name;
808 (Project : Project_Id;
809 Data : in out Tree_Processing_Data)
811 Specs : Array_Element_Id;
812 Bodies : Array_Element_Id;
813 Extending : Boolean := False;
814 Prj_Data : Project_Processing_Data;
817 Initialize (Prj_Data, Project);
819 Check_If_Externally_Built (Project, Data);
821 -- Object, exec and source directories
823 Get_Directories (Project, Data);
825 -- Get the programming languages
827 Check_Programming_Languages (Project, Data);
829 if Project.Qualifier = Dry
830 and then Project.Source_Dirs /= Nil_String
833 Source_Dirs : constant Variable_Value :=
836 Project.Decl.Attributes, Data.Tree);
837 Source_Files : constant Variable_Value :=
840 Project.Decl.Attributes, Data.Tree);
841 Source_List_File : constant Variable_Value :=
843 (Name_Source_List_File,
844 Project.Decl.Attributes, Data.Tree);
845 Languages : constant Variable_Value :=
848 Project.Decl.Attributes, Data.Tree);
851 if Source_Dirs.Values = Nil_String
852 and then Source_Files.Values = Nil_String
853 and then Languages.Values = Nil_String
854 and then Source_List_File.Default
856 Project.Source_Dirs := Nil_String;
861 "at least one of Source_Files, Source_Dirs or Languages "
862 & "must be declared empty for an abstract project",
863 Project.Location, Project);
868 -- Check configuration. This must be done even for gnatmake (even though
869 -- no user configuration file was provided) since the default config we
870 -- generate indicates whether libraries are supported for instance.
872 Check_Configuration (Project, Data);
874 -- Library attributes
876 Check_Library_Attributes (Project, Data);
878 if Current_Verbosity = High then
879 Show_Source_Dirs (Project, Data.Tree);
882 Extending := Project.Extends /= No_Project;
884 Check_Package_Naming (Project, Data, Bodies => Bodies, Specs => Specs);
888 if Project.Source_Dirs /= Nil_String then
889 Look_For_Sources (Prj_Data, Data);
891 if not Project.Externally_Built
892 and then not Extending
895 Language : Language_Ptr;
897 Alt_Lang : Language_List;
898 Continuation : Boolean := False;
899 Iter : Source_Iterator;
902 Language := Project.Languages;
903 while Language /= No_Language_Index loop
905 -- If there are no sources for this language, check if there
906 -- are sources for which this is an alternate language.
908 if Language.First_Source = No_Source
909 and then (Data.Flags.Require_Sources_Other_Lang
910 or else Language.Name = Name_Ada)
912 Iter := For_Each_Source (In_Tree => Data.Tree,
915 Source := Element (Iter);
916 exit Source_Loop when Source = No_Source
917 or else Source.Language = Language;
919 Alt_Lang := Source.Alternate_Languages;
920 while Alt_Lang /= null loop
921 exit Source_Loop when Alt_Lang.Language = Language;
922 Alt_Lang := Alt_Lang.Next;
926 end loop Source_Loop;
928 if Source = No_Source then
932 Get_Name_String (Language.Display_Name),
934 Prj_Data.Source_List_File_Location,
936 Continuation := True;
940 Language := Language.Next;
946 -- If a list of sources is specified in attribute Interfaces, set
947 -- In_Interfaces only for the sources specified in the list.
949 Check_Interfaces (Project, Data);
951 -- If it is a library project file, check if it is a standalone library
953 if Project.Library then
954 Check_Stand_Alone_Library (Project, Data);
957 -- Put the list of Mains, if any, in the project data
959 Get_Mains (Project, Data);
968 procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is
969 The_Name : String := Name;
971 Need_Letter : Boolean := True;
972 Last_Underscore : Boolean := False;
973 OK : Boolean := The_Name'Length > 0;
976 function Is_Reserved (Name : Name_Id) return Boolean;
977 function Is_Reserved (S : String) return Boolean;
978 -- Check that the given name is not an Ada 95 reserved word. The reason
979 -- for the Ada 95 here is that we do not want to exclude the case of an
980 -- Ada 95 unit called Interface (for example). In Ada 2005, such a unit
981 -- name would be rejected anyway by the compiler. That means there is no
982 -- requirement that the project file parser reject this.
988 function Is_Reserved (S : String) return Boolean is
991 Add_Str_To_Name_Buffer (S);
992 return Is_Reserved (Name_Find);
999 function Is_Reserved (Name : Name_Id) return Boolean is
1001 if Get_Name_Table_Byte (Name) /= 0
1002 and then Name /= Name_Project
1003 and then Name /= Name_Extends
1004 and then Name /= Name_External
1005 and then Name not in Ada_2005_Reserved_Words
1009 if Current_Verbosity = High then
1010 Write_Str (The_Name);
1011 Write_Line (" is an Ada reserved word.");
1021 -- Start of processing for Check_Ada_Name
1024 To_Lower (The_Name);
1026 Name_Len := The_Name'Length;
1027 Name_Buffer (1 .. Name_Len) := The_Name;
1029 -- Special cases of children of packages A, G, I and S on VMS
1031 if OpenVMS_On_Target
1032 and then Name_Len > 3
1033 and then Name_Buffer (2 .. 3) = "__"
1035 ((Name_Buffer (1) = 'a') or else
1036 (Name_Buffer (1) = 'g') or else
1037 (Name_Buffer (1) = 'i') or else
1038 (Name_Buffer (1) = 's'))
1040 Name_Buffer (2) := '.';
1041 Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
1042 Name_Len := Name_Len - 1;
1045 Real_Name := Name_Find;
1047 if Is_Reserved (Real_Name) then
1051 First := The_Name'First;
1053 for Index in The_Name'Range loop
1056 -- We need a letter (at the beginning, and following a dot),
1057 -- but we don't have one.
1059 if Is_Letter (The_Name (Index)) then
1060 Need_Letter := False;
1065 if Current_Verbosity = High then
1066 Write_Int (Types.Int (Index));
1068 Write_Char (The_Name (Index));
1069 Write_Line ("' is not a letter.");
1075 elsif Last_Underscore
1076 and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
1078 -- Two underscores are illegal, and a dot cannot follow
1083 if Current_Verbosity = High then
1084 Write_Int (Types.Int (Index));
1086 Write_Char (The_Name (Index));
1087 Write_Line ("' is illegal here.");
1092 elsif The_Name (Index) = '.' then
1094 -- First, check if the name before the dot is not a reserved word
1096 if Is_Reserved (The_Name (First .. Index - 1)) then
1102 -- We need a letter after a dot
1104 Need_Letter := True;
1106 elsif The_Name (Index) = '_' then
1107 Last_Underscore := True;
1110 -- We need an letter or a digit
1112 Last_Underscore := False;
1114 if not Is_Alphanumeric (The_Name (Index)) then
1117 if Current_Verbosity = High then
1118 Write_Int (Types.Int (Index));
1120 Write_Char (The_Name (Index));
1121 Write_Line ("' is not alphanumeric.");
1129 -- Cannot end with an underscore or a dot
1131 OK := OK and then not Need_Letter and then not Last_Underscore;
1134 if First /= Name'First and then
1135 Is_Reserved (The_Name (First .. The_Name'Last))
1143 -- Signal a problem with No_Name
1149 -------------------------
1150 -- Check_Configuration --
1151 -------------------------
1153 procedure Check_Configuration
1154 (Project : Project_Id;
1155 Data : in out Tree_Processing_Data)
1157 Dot_Replacement : File_Name_Type := No_File;
1158 Casing : Casing_Type := All_Lower_Case;
1159 Separate_Suffix : File_Name_Type := No_File;
1161 Lang_Index : Language_Ptr := No_Language_Index;
1162 -- The index of the language data being checked
1164 Prev_Index : Language_Ptr := No_Language_Index;
1165 -- The index of the previous language
1167 procedure Process_Project_Level_Simple_Attributes;
1168 -- Process the simple attributes at the project level
1170 procedure Process_Project_Level_Array_Attributes;
1171 -- Process the associate array attributes at the project level
1173 procedure Process_Packages;
1174 -- Read the packages of the project
1176 ----------------------
1177 -- Process_Packages --
1178 ----------------------
1180 procedure Process_Packages is
1181 Packages : Package_Id;
1182 Element : Package_Element;
1184 procedure Process_Binder (Arrays : Array_Id);
1185 -- Process the associate array attributes of package Binder
1187 procedure Process_Builder (Attributes : Variable_Id);
1188 -- Process the simple attributes of package Builder
1190 procedure Process_Compiler (Arrays : Array_Id);
1191 -- Process the associate array attributes of package Compiler
1193 procedure Process_Naming (Attributes : Variable_Id);
1194 -- Process the simple attributes of package Naming
1196 procedure Process_Naming (Arrays : Array_Id);
1197 -- Process the associate array attributes of package Naming
1199 procedure Process_Linker (Attributes : Variable_Id);
1200 -- Process the simple attributes of package Linker of a
1201 -- configuration project.
1203 --------------------
1204 -- Process_Binder --
1205 --------------------
1207 procedure Process_Binder (Arrays : Array_Id) is
1208 Current_Array_Id : Array_Id;
1209 Current_Array : Array_Data;
1210 Element_Id : Array_Element_Id;
1211 Element : Array_Element;
1214 -- Process the associative array attribute of package Binder
1216 Current_Array_Id := Arrays;
1217 while Current_Array_Id /= No_Array loop
1218 Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
1220 Element_Id := Current_Array.Value;
1221 while Element_Id /= No_Array_Element loop
1222 Element := Data.Tree.Array_Elements.Table (Element_Id);
1224 if Element.Index /= All_Other_Names then
1226 -- Get the name of the language
1229 Get_Language_From_Name
1230 (Project, Get_Name_String (Element.Index));
1232 if Lang_Index /= No_Language_Index then
1233 case Current_Array.Name is
1236 -- Attribute Driver (<language>)
1238 Lang_Index.Config.Binder_Driver :=
1239 File_Name_Type (Element.Value.Value);
1241 when Name_Required_Switches =>
1244 Lang_Index.Config.Binder_Required_Switches,
1245 From_List => Element.Value.Values,
1246 In_Tree => Data.Tree);
1250 -- Attribute Prefix (<language>)
1252 Lang_Index.Config.Binder_Prefix :=
1253 Element.Value.Value;
1255 when Name_Objects_Path =>
1257 -- Attribute Objects_Path (<language>)
1259 Lang_Index.Config.Objects_Path :=
1260 Element.Value.Value;
1262 when Name_Objects_Path_File =>
1264 -- Attribute Objects_Path (<language>)
1266 Lang_Index.Config.Objects_Path_File :=
1267 Element.Value.Value;
1275 Element_Id := Element.Next;
1278 Current_Array_Id := Current_Array.Next;
1282 ---------------------
1283 -- Process_Builder --
1284 ---------------------
1286 procedure Process_Builder (Attributes : Variable_Id) is
1287 Attribute_Id : Variable_Id;
1288 Attribute : Variable;
1291 -- Process non associated array attribute from package Builder
1293 Attribute_Id := Attributes;
1294 while Attribute_Id /= No_Variable loop
1296 Data.Tree.Variable_Elements.Table (Attribute_Id);
1298 if not Attribute.Value.Default then
1299 if Attribute.Name = Name_Executable_Suffix then
1301 -- Attribute Executable_Suffix: the suffix of the
1304 Project.Config.Executable_Suffix :=
1305 Attribute.Value.Value;
1309 Attribute_Id := Attribute.Next;
1311 end Process_Builder;
1313 ----------------------
1314 -- Process_Compiler --
1315 ----------------------
1317 procedure Process_Compiler (Arrays : Array_Id) is
1318 Current_Array_Id : Array_Id;
1319 Current_Array : Array_Data;
1320 Element_Id : Array_Element_Id;
1321 Element : Array_Element;
1322 List : String_List_Id;
1325 -- Process the associative array attribute of package Compiler
1327 Current_Array_Id := Arrays;
1328 while Current_Array_Id /= No_Array loop
1329 Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
1331 Element_Id := Current_Array.Value;
1332 while Element_Id /= No_Array_Element loop
1333 Element := Data.Tree.Array_Elements.Table (Element_Id);
1335 if Element.Index /= All_Other_Names then
1337 -- Get the name of the language
1339 Lang_Index := Get_Language_From_Name
1340 (Project, Get_Name_String (Element.Index));
1342 if Lang_Index /= No_Language_Index then
1343 case Current_Array.Name is
1344 when Name_Dependency_Switches =>
1346 -- Attribute Dependency_Switches (<language>)
1348 if Lang_Index.Config.Dependency_Kind = None then
1349 Lang_Index.Config.Dependency_Kind := Makefile;
1352 List := Element.Value.Values;
1354 if List /= Nil_String then
1356 Lang_Index.Config.Dependency_Option,
1358 In_Tree => Data.Tree);
1361 when Name_Dependency_Driver =>
1363 -- Attribute Dependency_Driver (<language>)
1365 if Lang_Index.Config.Dependency_Kind = None then
1366 Lang_Index.Config.Dependency_Kind := Makefile;
1369 List := Element.Value.Values;
1371 if List /= Nil_String then
1373 Lang_Index.Config.Compute_Dependency,
1375 In_Tree => Data.Tree);
1378 when Name_Include_Switches =>
1380 -- Attribute Include_Switches (<language>)
1382 List := Element.Value.Values;
1384 if List = Nil_String then
1386 (Data.Flags, "include option cannot be null",
1387 Element.Value.Location, Project);
1390 Put (Into_List => Lang_Index.Config.Include_Option,
1392 In_Tree => Data.Tree);
1394 when Name_Include_Path =>
1396 -- Attribute Include_Path (<language>)
1398 Lang_Index.Config.Include_Path :=
1399 Element.Value.Value;
1401 when Name_Include_Path_File =>
1403 -- Attribute Include_Path_File (<language>)
1405 Lang_Index.Config.Include_Path_File :=
1406 Element.Value.Value;
1410 -- Attribute Driver (<language>)
1412 Lang_Index.Config.Compiler_Driver :=
1413 File_Name_Type (Element.Value.Value);
1415 when Name_Required_Switches |
1416 Name_Leading_Required_Switches =>
1419 Compiler_Leading_Required_Switches,
1420 From_List => Element.Value.Values,
1421 In_Tree => Data.Tree);
1423 when Name_Trailing_Required_Switches =>
1426 Compiler_Trailing_Required_Switches,
1427 From_List => Element.Value.Values,
1428 In_Tree => Data.Tree);
1430 when Name_Path_Syntax =>
1432 Lang_Index.Config.Path_Syntax :=
1433 Path_Syntax_Kind'Value
1434 (Get_Name_String (Element.Value.Value));
1437 when Constraint_Error =>
1440 "invalid value for Path_Syntax",
1441 Element.Value.Location, Project);
1444 when Name_Object_File_Suffix =>
1445 if Get_Name_String (Element.Value.Value) = "" then
1448 "object file suffix cannot be empty",
1449 Element.Value.Location, Project);
1452 Lang_Index.Config.Object_File_Suffix :=
1453 Element.Value.Value;
1456 when Name_Object_File_Switches =>
1458 Lang_Index.Config.Object_File_Switches,
1459 From_List => Element.Value.Values,
1460 In_Tree => Data.Tree);
1462 when Name_Pic_Option =>
1464 -- Attribute Compiler_Pic_Option (<language>)
1466 List := Element.Value.Values;
1468 if List = Nil_String then
1471 "compiler PIC option cannot be null",
1472 Element.Value.Location, Project);
1476 Lang_Index.Config.Compilation_PIC_Option,
1478 In_Tree => Data.Tree);
1480 when Name_Mapping_File_Switches =>
1482 -- Attribute Mapping_File_Switches (<language>)
1484 List := Element.Value.Values;
1486 if List = Nil_String then
1489 "mapping file switches cannot be null",
1490 Element.Value.Location, Project);
1494 Lang_Index.Config.Mapping_File_Switches,
1496 In_Tree => Data.Tree);
1498 when Name_Mapping_Spec_Suffix =>
1500 -- Attribute Mapping_Spec_Suffix (<language>)
1502 Lang_Index.Config.Mapping_Spec_Suffix :=
1503 File_Name_Type (Element.Value.Value);
1505 when Name_Mapping_Body_Suffix =>
1507 -- Attribute Mapping_Body_Suffix (<language>)
1509 Lang_Index.Config.Mapping_Body_Suffix :=
1510 File_Name_Type (Element.Value.Value);
1512 when Name_Config_File_Switches =>
1514 -- Attribute Config_File_Switches (<language>)
1516 List := Element.Value.Values;
1518 if List = Nil_String then
1521 "config file switches cannot be null",
1522 Element.Value.Location, Project);
1526 Lang_Index.Config.Config_File_Switches,
1528 In_Tree => Data.Tree);
1530 when Name_Objects_Path =>
1532 -- Attribute Objects_Path (<language>)
1534 Lang_Index.Config.Objects_Path :=
1535 Element.Value.Value;
1537 when Name_Objects_Path_File =>
1539 -- Attribute Objects_Path_File (<language>)
1541 Lang_Index.Config.Objects_Path_File :=
1542 Element.Value.Value;
1544 when Name_Config_Body_File_Name =>
1546 -- Attribute Config_Body_File_Name (<language>)
1548 Lang_Index.Config.Config_Body :=
1549 Element.Value.Value;
1551 when Name_Config_Body_File_Name_Pattern =>
1553 -- Attribute Config_Body_File_Name_Pattern
1556 Lang_Index.Config.Config_Body_Pattern :=
1557 Element.Value.Value;
1559 when Name_Config_Spec_File_Name =>
1561 -- Attribute Config_Spec_File_Name (<language>)
1563 Lang_Index.Config.Config_Spec :=
1564 Element.Value.Value;
1566 when Name_Config_Spec_File_Name_Pattern =>
1568 -- Attribute Config_Spec_File_Name_Pattern
1571 Lang_Index.Config.Config_Spec_Pattern :=
1572 Element.Value.Value;
1574 when Name_Config_File_Unique =>
1576 -- Attribute Config_File_Unique (<language>)
1579 Lang_Index.Config.Config_File_Unique :=
1581 (Get_Name_String (Element.Value.Value));
1583 when Constraint_Error =>
1586 "illegal value for Config_File_Unique",
1587 Element.Value.Location, Project);
1596 Element_Id := Element.Next;
1599 Current_Array_Id := Current_Array.Next;
1601 end Process_Compiler;
1603 --------------------
1604 -- Process_Naming --
1605 --------------------
1607 procedure Process_Naming (Attributes : Variable_Id) is
1608 Attribute_Id : Variable_Id;
1609 Attribute : Variable;
1612 -- Process non associated array attribute from package Naming
1614 Attribute_Id := Attributes;
1615 while Attribute_Id /= No_Variable loop
1616 Attribute := Data.Tree.Variable_Elements.Table (Attribute_Id);
1618 if not Attribute.Value.Default then
1619 if Attribute.Name = Name_Separate_Suffix then
1621 -- Attribute Separate_Suffix
1623 Get_Name_String (Attribute.Value.Value);
1624 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1625 Separate_Suffix := Name_Find;
1627 elsif Attribute.Name = Name_Casing then
1633 Value (Get_Name_String (Attribute.Value.Value));
1636 when Constraint_Error =>
1639 "invalid value for Casing",
1640 Attribute.Value.Location, Project);
1643 elsif Attribute.Name = Name_Dot_Replacement then
1645 -- Attribute Dot_Replacement
1647 Dot_Replacement := File_Name_Type (Attribute.Value.Value);
1652 Attribute_Id := Attribute.Next;
1656 procedure Process_Naming (Arrays : Array_Id) is
1657 Current_Array_Id : Array_Id;
1658 Current_Array : Array_Data;
1659 Element_Id : Array_Element_Id;
1660 Element : Array_Element;
1663 -- Process the associative array attribute of package Naming
1665 Current_Array_Id := Arrays;
1666 while Current_Array_Id /= No_Array loop
1667 Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
1669 Element_Id := Current_Array.Value;
1670 while Element_Id /= No_Array_Element loop
1671 Element := Data.Tree.Array_Elements.Table (Element_Id);
1673 -- Get the name of the language
1675 Lang_Index := Get_Language_From_Name
1676 (Project, Get_Name_String (Element.Index));
1678 if Lang_Index /= No_Language_Index then
1679 case Current_Array.Name is
1680 when Name_Spec_Suffix | Name_Specification_Suffix =>
1682 -- Attribute Spec_Suffix (<language>)
1684 Get_Name_String (Element.Value.Value);
1685 Canonical_Case_File_Name
1686 (Name_Buffer (1 .. Name_Len));
1687 Lang_Index.Config.Naming_Data.Spec_Suffix :=
1690 when Name_Implementation_Suffix | Name_Body_Suffix =>
1692 Get_Name_String (Element.Value.Value);
1693 Canonical_Case_File_Name
1694 (Name_Buffer (1 .. Name_Len));
1696 -- Attribute Body_Suffix (<language>)
1698 Lang_Index.Config.Naming_Data.Body_Suffix :=
1700 Lang_Index.Config.Naming_Data.Separate_Suffix :=
1701 Lang_Index.Config.Naming_Data.Body_Suffix;
1708 Element_Id := Element.Next;
1711 Current_Array_Id := Current_Array.Next;
1715 --------------------
1716 -- Process_Linker --
1717 --------------------
1719 procedure Process_Linker (Attributes : Variable_Id) is
1720 Attribute_Id : Variable_Id;
1721 Attribute : Variable;
1724 -- Process non associated array attribute from package Linker
1726 Attribute_Id := Attributes;
1727 while Attribute_Id /= No_Variable loop
1729 Data.Tree.Variable_Elements.Table (Attribute_Id);
1731 if not Attribute.Value.Default then
1732 if Attribute.Name = Name_Driver then
1734 -- Attribute Linker'Driver: the default linker to use
1736 Project.Config.Linker :=
1737 Path_Name_Type (Attribute.Value.Value);
1739 -- Linker'Driver is also used to link shared libraries
1740 -- if the obsolescent attribute Library_GCC has not been
1743 if Project.Config.Shared_Lib_Driver = No_File then
1744 Project.Config.Shared_Lib_Driver :=
1745 File_Name_Type (Attribute.Value.Value);
1748 elsif Attribute.Name = Name_Required_Switches then
1750 -- Attribute Required_Switches: the minimum
1751 -- options to use when invoking the linker
1753 Put (Into_List => Project.Config.Minimum_Linker_Options,
1754 From_List => Attribute.Value.Values,
1755 In_Tree => Data.Tree);
1757 elsif Attribute.Name = Name_Map_File_Option then
1758 Project.Config.Map_File_Option := Attribute.Value.Value;
1760 elsif Attribute.Name = Name_Max_Command_Line_Length then
1762 Project.Config.Max_Command_Line_Length :=
1763 Natural'Value (Get_Name_String
1764 (Attribute.Value.Value));
1767 when Constraint_Error =>
1770 "value must be positive or equal to 0",
1771 Attribute.Value.Location, Project);
1774 elsif Attribute.Name = Name_Response_File_Format then
1779 Get_Name_String (Attribute.Value.Value);
1780 To_Lower (Name_Buffer (1 .. Name_Len));
1783 if Name = Name_None then
1784 Project.Config.Resp_File_Format := None;
1786 elsif Name = Name_Gnu then
1787 Project.Config.Resp_File_Format := GNU;
1789 elsif Name = Name_Object_List then
1790 Project.Config.Resp_File_Format := Object_List;
1792 elsif Name = Name_Option_List then
1793 Project.Config.Resp_File_Format := Option_List;
1798 "illegal response file format",
1799 Attribute.Value.Location, Project);
1803 elsif Attribute.Name = Name_Response_File_Switches then
1804 Put (Into_List => Project.Config.Resp_File_Options,
1805 From_List => Attribute.Value.Values,
1806 In_Tree => Data.Tree);
1810 Attribute_Id := Attribute.Next;
1814 -- Start of processing for Process_Packages
1817 Packages := Project.Decl.Packages;
1818 while Packages /= No_Package loop
1819 Element := Data.Tree.Packages.Table (Packages);
1821 case Element.Name is
1824 -- Process attributes of package Binder
1826 Process_Binder (Element.Decl.Arrays);
1828 when Name_Builder =>
1830 -- Process attributes of package Builder
1832 Process_Builder (Element.Decl.Attributes);
1834 when Name_Compiler =>
1836 -- Process attributes of package Compiler
1838 Process_Compiler (Element.Decl.Arrays);
1842 -- Process attributes of package Linker
1844 Process_Linker (Element.Decl.Attributes);
1848 -- Process attributes of package Naming
1850 Process_Naming (Element.Decl.Attributes);
1851 Process_Naming (Element.Decl.Arrays);
1857 Packages := Element.Next;
1859 end Process_Packages;
1861 ---------------------------------------------
1862 -- Process_Project_Level_Simple_Attributes --
1863 ---------------------------------------------
1865 procedure Process_Project_Level_Simple_Attributes is
1866 Attribute_Id : Variable_Id;
1867 Attribute : Variable;
1868 List : String_List_Id;
1871 -- Process non associated array attribute at project level
1873 Attribute_Id := Project.Decl.Attributes;
1874 while Attribute_Id /= No_Variable loop
1876 Data.Tree.Variable_Elements.Table (Attribute_Id);
1878 if not Attribute.Value.Default then
1879 if Attribute.Name = Name_Target then
1881 -- Attribute Target: the target specified
1883 Project.Config.Target := Attribute.Value.Value;
1885 elsif Attribute.Name = Name_Library_Builder then
1887 -- Attribute Library_Builder: the application to invoke
1888 -- to build libraries.
1890 Project.Config.Library_Builder :=
1891 Path_Name_Type (Attribute.Value.Value);
1893 elsif Attribute.Name = Name_Archive_Builder then
1895 -- Attribute Archive_Builder: the archive builder
1896 -- (usually "ar") and its minimum options (usually "cr").
1898 List := Attribute.Value.Values;
1900 if List = Nil_String then
1903 "archive builder cannot be null",
1904 Attribute.Value.Location, Project);
1907 Put (Into_List => Project.Config.Archive_Builder,
1909 In_Tree => Data.Tree);
1911 elsif Attribute.Name = Name_Archive_Builder_Append_Option then
1913 -- Attribute Archive_Builder: the archive builder
1914 -- (usually "ar") and its minimum options (usually "cr").
1916 List := Attribute.Value.Values;
1918 if List /= Nil_String then
1921 Project.Config.Archive_Builder_Append_Option,
1923 In_Tree => Data.Tree);
1926 elsif Attribute.Name = Name_Archive_Indexer then
1928 -- Attribute Archive_Indexer: the optional archive
1929 -- indexer (usually "ranlib") with its minimum options
1932 List := Attribute.Value.Values;
1934 if List = Nil_String then
1937 "archive indexer cannot be null",
1938 Attribute.Value.Location, Project);
1941 Put (Into_List => Project.Config.Archive_Indexer,
1943 In_Tree => Data.Tree);
1945 elsif Attribute.Name = Name_Library_Partial_Linker then
1947 -- Attribute Library_Partial_Linker: the optional linker
1948 -- driver with its minimum options, to partially link
1951 List := Attribute.Value.Values;
1953 if List = Nil_String then
1956 "partial linker cannot be null",
1957 Attribute.Value.Location, Project);
1960 Put (Into_List => Project.Config.Lib_Partial_Linker,
1962 In_Tree => Data.Tree);
1964 elsif Attribute.Name = Name_Library_GCC then
1965 Project.Config.Shared_Lib_Driver :=
1966 File_Name_Type (Attribute.Value.Value);
1969 "?Library_'G'C'C is an obsolescent attribute, " &
1970 "use Linker''Driver instead",
1971 Attribute.Value.Location, Project);
1973 elsif Attribute.Name = Name_Archive_Suffix then
1974 Project.Config.Archive_Suffix :=
1975 File_Name_Type (Attribute.Value.Value);
1977 elsif Attribute.Name = Name_Linker_Executable_Option then
1979 -- Attribute Linker_Executable_Option: optional options
1980 -- to specify an executable name. Defaults to "-o".
1982 List := Attribute.Value.Values;
1984 if List = Nil_String then
1987 "linker executable option cannot be null",
1988 Attribute.Value.Location, Project);
1991 Put (Into_List => Project.Config.Linker_Executable_Option,
1993 In_Tree => Data.Tree);
1995 elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
1997 -- Attribute Linker_Lib_Dir_Option: optional options
1998 -- to specify a library search directory. Defaults to
2001 Get_Name_String (Attribute.Value.Value);
2003 if Name_Len = 0 then
2006 "linker library directory option cannot be empty",
2007 Attribute.Value.Location, Project);
2010 Project.Config.Linker_Lib_Dir_Option :=
2011 Attribute.Value.Value;
2013 elsif Attribute.Name = Name_Linker_Lib_Name_Option then
2015 -- Attribute Linker_Lib_Name_Option: optional options
2016 -- to specify the name of a library to be linked in.
2017 -- Defaults to "-l".
2019 Get_Name_String (Attribute.Value.Value);
2021 if Name_Len = 0 then
2024 "linker library name option cannot be empty",
2025 Attribute.Value.Location, Project);
2028 Project.Config.Linker_Lib_Name_Option :=
2029 Attribute.Value.Value;
2031 elsif Attribute.Name = Name_Run_Path_Option then
2033 -- Attribute Run_Path_Option: optional options to
2034 -- specify a path for libraries.
2036 List := Attribute.Value.Values;
2038 if List /= Nil_String then
2039 Put (Into_List => Project.Config.Run_Path_Option,
2041 In_Tree => Data.Tree);
2044 elsif Attribute.Name = Name_Separate_Run_Path_Options then
2046 pragma Unsuppress (All_Checks);
2048 Project.Config.Separate_Run_Path_Options :=
2049 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2051 when Constraint_Error =>
2054 "invalid value """ &
2055 Get_Name_String (Attribute.Value.Value) &
2056 """ for Separate_Run_Path_Options",
2057 Attribute.Value.Location, Project);
2060 elsif Attribute.Name = Name_Library_Support then
2062 pragma Unsuppress (All_Checks);
2064 Project.Config.Lib_Support :=
2065 Library_Support'Value (Get_Name_String
2066 (Attribute.Value.Value));
2068 when Constraint_Error =>
2071 "invalid value """ &
2072 Get_Name_String (Attribute.Value.Value) &
2073 """ for Library_Support",
2074 Attribute.Value.Location, Project);
2077 elsif Attribute.Name = Name_Shared_Library_Prefix then
2078 Project.Config.Shared_Lib_Prefix :=
2079 File_Name_Type (Attribute.Value.Value);
2081 elsif Attribute.Name = Name_Shared_Library_Suffix then
2082 Project.Config.Shared_Lib_Suffix :=
2083 File_Name_Type (Attribute.Value.Value);
2085 elsif Attribute.Name = Name_Symbolic_Link_Supported then
2087 pragma Unsuppress (All_Checks);
2089 Project.Config.Symbolic_Link_Supported :=
2090 Boolean'Value (Get_Name_String
2091 (Attribute.Value.Value));
2093 when Constraint_Error =>
2097 & Get_Name_String (Attribute.Value.Value)
2098 & """ for Symbolic_Link_Supported",
2099 Attribute.Value.Location, Project);
2103 Attribute.Name = Name_Library_Major_Minor_Id_Supported
2106 pragma Unsuppress (All_Checks);
2108 Project.Config.Lib_Maj_Min_Id_Supported :=
2109 Boolean'Value (Get_Name_String
2110 (Attribute.Value.Value));
2112 when Constraint_Error =>
2115 "invalid value """ &
2116 Get_Name_String (Attribute.Value.Value) &
2117 """ for Library_Major_Minor_Id_Supported",
2118 Attribute.Value.Location, Project);
2121 elsif Attribute.Name = Name_Library_Auto_Init_Supported then
2123 pragma Unsuppress (All_Checks);
2125 Project.Config.Auto_Init_Supported :=
2126 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2128 when Constraint_Error =>
2132 & Get_Name_String (Attribute.Value.Value)
2133 & """ for Library_Auto_Init_Supported",
2134 Attribute.Value.Location, Project);
2137 elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
2138 List := Attribute.Value.Values;
2140 if List /= Nil_String then
2141 Put (Into_List => Project.Config.Shared_Lib_Min_Options,
2143 In_Tree => Data.Tree);
2146 elsif Attribute.Name = Name_Library_Version_Switches then
2147 List := Attribute.Value.Values;
2149 if List /= Nil_String then
2150 Put (Into_List => Project.Config.Lib_Version_Options,
2152 In_Tree => Data.Tree);
2157 Attribute_Id := Attribute.Next;
2159 end Process_Project_Level_Simple_Attributes;
2161 --------------------------------------------
2162 -- Process_Project_Level_Array_Attributes --
2163 --------------------------------------------
2165 procedure Process_Project_Level_Array_Attributes is
2166 Current_Array_Id : Array_Id;
2167 Current_Array : Array_Data;
2168 Element_Id : Array_Element_Id;
2169 Element : Array_Element;
2170 List : String_List_Id;
2173 -- Process the associative array attributes at project level
2175 Current_Array_Id := Project.Decl.Arrays;
2176 while Current_Array_Id /= No_Array loop
2177 Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
2179 Element_Id := Current_Array.Value;
2180 while Element_Id /= No_Array_Element loop
2181 Element := Data.Tree.Array_Elements.Table (Element_Id);
2183 -- Get the name of the language
2186 Get_Language_From_Name
2187 (Project, Get_Name_String (Element.Index));
2189 if Lang_Index /= No_Language_Index then
2190 case Current_Array.Name is
2191 when Name_Inherit_Source_Path =>
2192 List := Element.Value.Values;
2194 if List /= Nil_String then
2197 Lang_Index.Config.Include_Compatible_Languages,
2199 In_Tree => Data.Tree,
2200 Lower_Case => True);
2203 when Name_Toolchain_Description =>
2205 -- Attribute Toolchain_Description (<language>)
2207 Lang_Index.Config.Toolchain_Description :=
2208 Element.Value.Value;
2210 when Name_Toolchain_Version =>
2212 -- Attribute Toolchain_Version (<language>)
2214 Lang_Index.Config.Toolchain_Version :=
2215 Element.Value.Value;
2217 when Name_Runtime_Library_Dir =>
2219 -- Attribute Runtime_Library_Dir (<language>)
2221 Lang_Index.Config.Runtime_Library_Dir :=
2222 Element.Value.Value;
2224 when Name_Runtime_Source_Dir =>
2226 -- Attribute Runtime_Library_Dir (<language>)
2228 Lang_Index.Config.Runtime_Source_Dir :=
2229 Element.Value.Value;
2231 when Name_Object_Generated =>
2233 pragma Unsuppress (All_Checks);
2239 (Get_Name_String (Element.Value.Value));
2241 Lang_Index.Config.Object_Generated := Value;
2243 -- If no object is generated, no object may be
2247 Lang_Index.Config.Objects_Linked := False;
2251 when Constraint_Error =>
2255 & Get_Name_String (Element.Value.Value)
2256 & """ for Object_Generated",
2257 Element.Value.Location, Project);
2260 when Name_Objects_Linked =>
2262 pragma Unsuppress (All_Checks);
2268 (Get_Name_String (Element.Value.Value));
2270 -- No change if Object_Generated is False, as this
2271 -- forces Objects_Linked to be False too.
2273 if Lang_Index.Config.Object_Generated then
2274 Lang_Index.Config.Objects_Linked := Value;
2278 when Constraint_Error =>
2282 & Get_Name_String (Element.Value.Value)
2283 & """ for Objects_Linked",
2284 Element.Value.Location, Project);
2291 Element_Id := Element.Next;
2294 Current_Array_Id := Current_Array.Next;
2296 end Process_Project_Level_Array_Attributes;
2298 -- Start of processing for Check_Configuration
2301 Process_Project_Level_Simple_Attributes;
2302 Process_Project_Level_Array_Attributes;
2305 -- For unit based languages, set Casing, Dot_Replacement and
2306 -- Separate_Suffix in Naming_Data.
2308 Lang_Index := Project.Languages;
2309 while Lang_Index /= No_Language_Index loop
2310 if Lang_Index.Name = Name_Ada then
2311 Lang_Index.Config.Naming_Data.Casing := Casing;
2312 Lang_Index.Config.Naming_Data.Dot_Replacement := Dot_Replacement;
2314 if Separate_Suffix /= No_File then
2315 Lang_Index.Config.Naming_Data.Separate_Suffix :=
2322 Lang_Index := Lang_Index.Next;
2325 -- Give empty names to various prefixes/suffixes, if they have not
2326 -- been specified in the configuration.
2328 if Project.Config.Archive_Suffix = No_File then
2329 Project.Config.Archive_Suffix := Empty_File;
2332 if Project.Config.Shared_Lib_Prefix = No_File then
2333 Project.Config.Shared_Lib_Prefix := Empty_File;
2336 if Project.Config.Shared_Lib_Suffix = No_File then
2337 Project.Config.Shared_Lib_Suffix := Empty_File;
2340 Lang_Index := Project.Languages;
2341 while Lang_Index /= No_Language_Index loop
2343 -- For all languages, Compiler_Driver needs to be specified. This is
2344 -- only needed if we do intend to compile (not in GPS for instance).
2346 if Data.Flags.Compiler_Driver_Mandatory
2347 and then Lang_Index.Config.Compiler_Driver = No_File
2349 Error_Msg_Name_1 := Lang_Index.Display_Name;
2352 "?no compiler specified for language %%" &
2353 ", ignoring all its sources",
2354 No_Location, Project);
2356 if Lang_Index = Project.Languages then
2357 Project.Languages := Lang_Index.Next;
2359 Prev_Index.Next := Lang_Index.Next;
2362 elsif Lang_Index.Name = Name_Ada then
2363 Prev_Index := Lang_Index;
2365 -- For unit based languages, Dot_Replacement, Spec_Suffix and
2366 -- Body_Suffix need to be specified.
2368 if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then
2371 "Dot_Replacement not specified for Ada",
2372 No_Location, Project);
2375 if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
2378 "Spec_Suffix not specified for Ada",
2379 No_Location, Project);
2382 if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
2385 "Body_Suffix not specified for Ada",
2386 No_Location, Project);
2390 Prev_Index := Lang_Index;
2392 -- For file based languages, either Spec_Suffix or Body_Suffix
2393 -- need to be specified.
2395 if Data.Flags.Require_Sources_Other_Lang
2396 and then Lang_Index.Config.Naming_Data.Spec_Suffix = No_File
2397 and then Lang_Index.Config.Naming_Data.Body_Suffix = No_File
2399 Error_Msg_Name_1 := Lang_Index.Display_Name;
2402 "no suffixes specified for %%",
2403 No_Location, Project);
2407 Lang_Index := Lang_Index.Next;
2409 end Check_Configuration;
2411 -------------------------------
2412 -- Check_If_Externally_Built --
2413 -------------------------------
2415 procedure Check_If_Externally_Built
2416 (Project : Project_Id;
2417 Data : in out Tree_Processing_Data)
2419 Externally_Built : constant Variable_Value :=
2421 (Name_Externally_Built,
2422 Project.Decl.Attributes, Data.Tree);
2425 if not Externally_Built.Default then
2426 Get_Name_String (Externally_Built.Value);
2427 To_Lower (Name_Buffer (1 .. Name_Len));
2429 if Name_Buffer (1 .. Name_Len) = "true" then
2430 Project.Externally_Built := True;
2432 elsif Name_Buffer (1 .. Name_Len) /= "false" then
2433 Error_Msg (Data.Flags,
2434 "Externally_Built may only be true or false",
2435 Externally_Built.Location, Project);
2439 -- A virtual project extending an externally built project is itself
2440 -- externally built.
2442 if Project.Virtual and then Project.Extends /= No_Project then
2443 Project.Externally_Built := Project.Extends.Externally_Built;
2446 if Current_Verbosity = High then
2447 Write_Str ("Project is ");
2449 if not Project.Externally_Built then
2453 Write_Line ("externally built.");
2455 end Check_If_Externally_Built;
2457 ----------------------
2458 -- Check_Interfaces --
2459 ----------------------
2461 procedure Check_Interfaces
2462 (Project : Project_Id;
2463 Data : in out Tree_Processing_Data)
2465 Interfaces : constant Prj.Variable_Value :=
2467 (Snames.Name_Interfaces,
2468 Project.Decl.Attributes,
2471 List : String_List_Id;
2472 Element : String_Element;
2473 Name : File_Name_Type;
2474 Iter : Source_Iterator;
2476 Project_2 : Project_Id;
2480 if not Interfaces.Default then
2482 -- Set In_Interfaces to False for all sources. It will be set to True
2483 -- later for the sources in the Interfaces list.
2485 Project_2 := Project;
2486 while Project_2 /= No_Project loop
2487 Iter := For_Each_Source (Data.Tree, Project_2);
2489 Source := Prj.Element (Iter);
2490 exit when Source = No_Source;
2491 Source.In_Interfaces := False;
2495 Project_2 := Project_2.Extends;
2498 List := Interfaces.Values;
2499 while List /= Nil_String loop
2500 Element := Data.Tree.String_Elements.Table (List);
2501 Name := Canonical_Case_File_Name (Element.Value);
2503 Project_2 := Project;
2505 while Project_2 /= No_Project loop
2506 Iter := For_Each_Source (Data.Tree, Project_2);
2509 Source := Prj.Element (Iter);
2510 exit when Source = No_Source;
2512 if Source.File = Name then
2513 if not Source.Locally_Removed then
2514 Source.In_Interfaces := True;
2515 Source.Declared_In_Interfaces := True;
2517 Other := Other_Part (Source);
2519 if Other /= No_Source then
2520 Other.In_Interfaces := True;
2521 Other.Declared_In_Interfaces := True;
2524 if Current_Verbosity = High then
2525 Write_Str (" interface: ");
2526 Write_Line (Get_Name_String (Source.Path.Name));
2536 Project_2 := Project_2.Extends;
2539 if Source = No_Source then
2540 Error_Msg_File_1 := File_Name_Type (Element.Value);
2541 Error_Msg_Name_1 := Project.Name;
2545 "{ cannot be an interface of project %% "
2546 & "as it is not one of its sources",
2547 Element.Location, Project);
2550 List := Element.Next;
2553 Project.Interfaces_Defined := True;
2555 elsif Project.Extends /= No_Project then
2556 Project.Interfaces_Defined := Project.Extends.Interfaces_Defined;
2558 if Project.Interfaces_Defined then
2559 Iter := For_Each_Source (Data.Tree, Project);
2561 Source := Prj.Element (Iter);
2562 exit when Source = No_Source;
2564 if not Source.Declared_In_Interfaces then
2565 Source.In_Interfaces := False;
2572 end Check_Interfaces;
2574 --------------------------
2575 -- Check_Package_Naming --
2576 --------------------------
2578 procedure Check_Package_Naming
2579 (Project : Project_Id;
2580 Data : in out Tree_Processing_Data;
2581 Bodies : out Array_Element_Id;
2582 Specs : out Array_Element_Id)
2584 Naming_Id : constant Package_Id :=
2586 (Name_Naming, Project.Decl.Packages, Data.Tree);
2587 Naming : Package_Element;
2589 Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
2591 procedure Check_Naming;
2592 -- Check the validity of the Naming package (suffixes valid, ...)
2594 procedure Check_Common
2595 (Dot_Replacement : in out File_Name_Type;
2596 Casing : in out Casing_Type;
2597 Casing_Defined : out Boolean;
2598 Separate_Suffix : in out File_Name_Type;
2599 Sep_Suffix_Loc : out Source_Ptr);
2600 -- Check attributes common
2602 procedure Process_Exceptions_File_Based
2603 (Lang_Id : Language_Ptr;
2604 Kind : Source_Kind);
2605 procedure Process_Exceptions_Unit_Based
2606 (Lang_Id : Language_Ptr;
2607 Kind : Source_Kind);
2608 -- Process the naming exceptions for the two types of languages
2610 procedure Initialize_Naming_Data;
2611 -- Initialize internal naming data for the various languages
2617 procedure Check_Common
2618 (Dot_Replacement : in out File_Name_Type;
2619 Casing : in out Casing_Type;
2620 Casing_Defined : out Boolean;
2621 Separate_Suffix : in out File_Name_Type;
2622 Sep_Suffix_Loc : out Source_Ptr)
2624 Dot_Repl : constant Variable_Value :=
2626 (Name_Dot_Replacement,
2627 Naming.Decl.Attributes,
2629 Casing_String : constant Variable_Value :=
2632 Naming.Decl.Attributes,
2634 Sep_Suffix : constant Variable_Value :=
2636 (Name_Separate_Suffix,
2637 Naming.Decl.Attributes,
2639 Dot_Repl_Loc : Source_Ptr;
2642 Sep_Suffix_Loc := No_Location;
2644 if not Dot_Repl.Default then
2646 (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
2648 if Length_Of_Name (Dot_Repl.Value) = 0 then
2650 (Data.Flags, "Dot_Replacement cannot be empty",
2651 Dot_Repl.Location, Project);
2654 Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
2655 Dot_Repl_Loc := Dot_Repl.Location;
2658 Repl : constant String := Get_Name_String (Dot_Replacement);
2661 -- Dot_Replacement cannot
2663 -- - start or end with an alphanumeric
2664 -- - be a single '_'
2665 -- - start with an '_' followed by an alphanumeric
2666 -- - contain a '.' except if it is "."
2669 or else Is_Alphanumeric (Repl (Repl'First))
2670 or else Is_Alphanumeric (Repl (Repl'Last))
2671 or else (Repl (Repl'First) = '_'
2675 Is_Alphanumeric (Repl (Repl'First + 1))))
2676 or else (Repl'Length > 1
2678 Index (Source => Repl, Pattern => ".") /= 0)
2683 """ is illegal for Dot_Replacement.",
2684 Dot_Repl_Loc, Project);
2689 if Dot_Replacement /= No_File then
2691 ("Dot_Replacement", Get_Name_String (Dot_Replacement));
2694 Casing_Defined := False;
2696 if not Casing_String.Default then
2698 (Casing_String.Kind = Single, "Casing is not a string");
2701 Casing_Image : constant String :=
2702 Get_Name_String (Casing_String.Value);
2705 if Casing_Image'Length = 0 then
2708 "Casing cannot be an empty string",
2709 Casing_String.Location, Project);
2712 Casing := Value (Casing_Image);
2713 Casing_Defined := True;
2716 when Constraint_Error =>
2717 Name_Len := Casing_Image'Length;
2718 Name_Buffer (1 .. Name_Len) := Casing_Image;
2719 Err_Vars.Error_Msg_Name_1 := Name_Find;
2722 "%% is not a correct Casing",
2723 Casing_String.Location, Project);
2727 Write_Attr ("Casing", Image (Casing));
2729 if not Sep_Suffix.Default then
2730 if Length_Of_Name (Sep_Suffix.Value) = 0 then
2733 "Separate_Suffix cannot be empty",
2734 Sep_Suffix.Location, Project);
2737 Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
2738 Sep_Suffix_Loc := Sep_Suffix.Location;
2740 Check_Illegal_Suffix
2741 (Project, Separate_Suffix,
2742 Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location,
2747 if Separate_Suffix /= No_File then
2749 ("Separate_Suffix", Get_Name_String (Separate_Suffix));
2753 -----------------------------------
2754 -- Process_Exceptions_File_Based --
2755 -----------------------------------
2757 procedure Process_Exceptions_File_Based
2758 (Lang_Id : Language_Ptr;
2761 Lang : constant Name_Id := Lang_Id.Name;
2762 Exceptions : Array_Element_Id;
2763 Exception_List : Variable_Value;
2764 Element_Id : String_List_Id;
2765 Element : String_Element;
2766 File_Name : File_Name_Type;
2768 Iter : Source_Iterator;
2775 (Name_Implementation_Exceptions,
2776 In_Arrays => Naming.Decl.Arrays,
2777 In_Tree => Data.Tree);
2782 (Name_Specification_Exceptions,
2783 In_Arrays => Naming.Decl.Arrays,
2784 In_Tree => Data.Tree);
2787 Exception_List := Value_Of
2789 In_Array => Exceptions,
2790 In_Tree => Data.Tree);
2792 if Exception_List /= Nil_Variable_Value then
2793 Element_Id := Exception_List.Values;
2794 while Element_Id /= Nil_String loop
2795 Element := Data.Tree.String_Elements.Table (Element_Id);
2796 File_Name := Canonical_Case_File_Name (Element.Value);
2798 Iter := For_Each_Source (Data.Tree, Project);
2800 Source := Prj.Element (Iter);
2801 exit when Source = No_Source or else Source.File = File_Name;
2805 if Source = No_Source then
2812 File_Name => File_Name,
2813 Display_File => File_Name_Type (Element.Value),
2814 Naming_Exception => True);
2817 -- Check if the file name is already recorded for another
2818 -- language or another kind.
2820 if Source.Language /= Lang_Id then
2823 "the same file cannot be a source of two languages",
2824 Element.Location, Project);
2826 elsif Source.Kind /= Kind then
2829 "the same file cannot be a source and a template",
2830 Element.Location, Project);
2833 -- If the file is already recorded for the same
2834 -- language and the same kind, it means that the file
2835 -- name appears several times in the *_Exceptions
2836 -- attribute; so there is nothing to do.
2839 Element_Id := Element.Next;
2842 end Process_Exceptions_File_Based;
2844 -----------------------------------
2845 -- Process_Exceptions_Unit_Based --
2846 -----------------------------------
2848 procedure Process_Exceptions_Unit_Based
2849 (Lang_Id : Language_Ptr;
2852 Lang : constant Name_Id := Lang_Id.Name;
2853 Exceptions : Array_Element_Id;
2854 Element : Array_Element;
2857 File_Name : File_Name_Type;
2866 In_Arrays => Naming.Decl.Arrays,
2867 In_Tree => Data.Tree);
2869 if Exceptions = No_Array_Element then
2872 (Name_Implementation,
2873 In_Arrays => Naming.Decl.Arrays,
2874 In_Tree => Data.Tree);
2881 In_Arrays => Naming.Decl.Arrays,
2882 In_Tree => Data.Tree);
2884 if Exceptions = No_Array_Element then
2888 In_Arrays => Naming.Decl.Arrays,
2889 In_Tree => Data.Tree);
2893 while Exceptions /= No_Array_Element loop
2894 Element := Data.Tree.Array_Elements.Table (Exceptions);
2895 File_Name := Canonical_Case_File_Name (Element.Value.Value);
2897 Get_Name_String (Element.Index);
2898 To_Lower (Name_Buffer (1 .. Name_Len));
2900 Index := Element.Value.Index;
2902 -- For Ada, check if it is a valid unit name
2904 if Lang = Name_Ada then
2905 Get_Name_String (Element.Index);
2906 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
2908 if Unit = No_Name then
2909 Err_Vars.Error_Msg_Name_1 := Element.Index;
2912 "%% is not a valid unit name.",
2913 Element.Value.Location, Project);
2917 if Unit /= No_Name then
2924 File_Name => File_Name,
2925 Display_File => File_Name_Type (Element.Value.Value),
2928 Location => Element.Value.Location,
2929 Naming_Exception => True);
2932 Exceptions := Element.Next;
2934 end Process_Exceptions_Unit_Based;
2940 procedure Check_Naming is
2941 Dot_Replacement : File_Name_Type :=
2943 (First_Name_Id + Character'Pos ('-'));
2944 Separate_Suffix : File_Name_Type := No_File;
2945 Casing : Casing_Type := All_Lower_Case;
2946 Casing_Defined : Boolean;
2947 Lang_Id : Language_Ptr;
2948 Sep_Suffix_Loc : Source_Ptr;
2949 Suffix : Variable_Value;
2954 (Dot_Replacement => Dot_Replacement,
2956 Casing_Defined => Casing_Defined,
2957 Separate_Suffix => Separate_Suffix,
2958 Sep_Suffix_Loc => Sep_Suffix_Loc);
2960 -- For all unit based languages, if any, set the specified value
2961 -- of Dot_Replacement, Casing and/or Separate_Suffix. Do not
2962 -- systematically overwrite, since the defaults come from the
2963 -- configuration file.
2965 if Dot_Replacement /= No_File
2966 or else Casing_Defined
2967 or else Separate_Suffix /= No_File
2969 Lang_Id := Project.Languages;
2970 while Lang_Id /= No_Language_Index loop
2971 if Lang_Id.Config.Kind = Unit_Based then
2972 if Dot_Replacement /= No_File then
2973 Lang_Id.Config.Naming_Data.Dot_Replacement :=
2977 if Casing_Defined then
2978 Lang_Id.Config.Naming_Data.Casing := Casing;
2982 Lang_Id := Lang_Id.Next;
2986 -- Next, get the spec and body suffixes
2988 Lang_Id := Project.Languages;
2989 while Lang_Id /= No_Language_Index loop
2990 Lang := Lang_Id.Name;
2996 Attribute_Or_Array_Name => Name_Spec_Suffix,
2997 In_Package => Naming_Id,
2998 In_Tree => Data.Tree);
3000 if Suffix = Nil_Variable_Value then
3003 Attribute_Or_Array_Name => Name_Specification_Suffix,
3004 In_Package => Naming_Id,
3005 In_Tree => Data.Tree);
3008 if Suffix /= Nil_Variable_Value then
3009 Lang_Id.Config.Naming_Data.Spec_Suffix :=
3010 File_Name_Type (Suffix.Value);
3012 Check_Illegal_Suffix
3014 Lang_Id.Config.Naming_Data.Spec_Suffix,
3015 Lang_Id.Config.Naming_Data.Dot_Replacement,
3016 "Spec_Suffix", Suffix.Location, Data);
3020 Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix));
3028 Attribute_Or_Array_Name => Name_Body_Suffix,
3029 In_Package => Naming_Id,
3030 In_Tree => Data.Tree);
3032 if Suffix = Nil_Variable_Value then
3036 Attribute_Or_Array_Name => Name_Implementation_Suffix,
3037 In_Package => Naming_Id,
3038 In_Tree => Data.Tree);
3041 if Suffix /= Nil_Variable_Value then
3042 Lang_Id.Config.Naming_Data.Body_Suffix :=
3043 File_Name_Type (Suffix.Value);
3045 -- The default value of separate suffix should be the same as
3046 -- the body suffix, so we need to compute that first.
3048 if Separate_Suffix = No_File then
3049 Lang_Id.Config.Naming_Data.Separate_Suffix :=
3050 Lang_Id.Config.Naming_Data.Body_Suffix;
3054 (Lang_Id.Config.Naming_Data.Separate_Suffix));
3056 Lang_Id.Config.Naming_Data.Separate_Suffix :=
3060 Check_Illegal_Suffix
3062 Lang_Id.Config.Naming_Data.Body_Suffix,
3063 Lang_Id.Config.Naming_Data.Dot_Replacement,
3064 "Body_Suffix", Suffix.Location, Data);
3068 Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix));
3070 elsif Separate_Suffix /= No_File then
3071 Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix;
3074 -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
3075 -- since that would cause a clear ambiguity. Note that we do allow
3076 -- a Spec_Suffix to have the same termination as one of these,
3077 -- which causes a potential ambiguity, but we resolve that my
3078 -- matching the longest possible suffix.
3080 if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
3081 and then Lang_Id.Config.Naming_Data.Spec_Suffix =
3082 Lang_Id.Config.Naming_Data.Body_Suffix
3087 & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)
3088 & """) cannot be the same as Spec_Suffix.",
3089 Ada_Body_Suffix_Loc, Project);
3092 if Lang_Id.Config.Naming_Data.Body_Suffix /=
3093 Lang_Id.Config.Naming_Data.Separate_Suffix
3094 and then Lang_Id.Config.Naming_Data.Spec_Suffix =
3095 Lang_Id.Config.Naming_Data.Separate_Suffix
3099 "Separate_Suffix ("""
3101 (Lang_Id.Config.Naming_Data.Separate_Suffix)
3102 & """) cannot be the same as Spec_Suffix.",
3103 Sep_Suffix_Loc, Project);
3106 Lang_Id := Lang_Id.Next;
3109 -- Get the naming exceptions for all languages
3111 for Kind in Spec .. Impl loop
3112 Lang_Id := Project.Languages;
3113 while Lang_Id /= No_Language_Index loop
3114 case Lang_Id.Config.Kind is
3116 Process_Exceptions_File_Based (Lang_Id, Kind);
3119 Process_Exceptions_Unit_Based (Lang_Id, Kind);
3122 Lang_Id := Lang_Id.Next;
3127 ----------------------------
3128 -- Initialize_Naming_Data --
3129 ----------------------------
3131 procedure Initialize_Naming_Data is
3132 Specs : Array_Element_Id :=
3138 Impls : Array_Element_Id :=
3144 Lang : Language_Ptr;
3145 Lang_Name : Name_Id;
3146 Value : Variable_Value;
3147 Extended : Project_Id;
3150 -- At this stage, the project already contains the default extensions
3151 -- for the various languages. We now merge those suffixes read in the
3152 -- user project, and they override the default.
3154 while Specs /= No_Array_Element loop
3155 Lang_Name := Data.Tree.Array_Elements.Table (Specs).Index;
3157 Get_Language_From_Name
3158 (Project, Name => Get_Name_String (Lang_Name));
3160 -- An extending project inherits its parent projects' languages
3161 -- so if needed we should create entries for those languages
3164 Extended := Project.Extends;
3165 while Extended /= null loop
3166 Lang := Get_Language_From_Name
3167 (Extended, Name => Get_Name_String (Lang_Name));
3168 exit when Lang /= null;
3170 Extended := Extended.Extends;
3173 if Lang /= null then
3174 Lang := new Language_Data'(Lang.all);
3175 Lang.First_Source := null;
3176 Lang.Next := Project.Languages;
3177 Project.Languages := Lang;
3181 -- If language was not found in project or the projects it extends
3184 if Current_Verbosity = High then
3186 ("Ignoring spec naming data for "
3187 & Get_Name_String (Lang_Name)
3188 & " since language is not defined for this project");
3192 Value := Data.Tree.Array_Elements.Table (Specs).Value;
3194 if Value.Kind = Single then
3195 Lang.Config.Naming_Data.Spec_Suffix :=
3196 Canonical_Case_File_Name (Value.Value);
3200 Specs := Data.Tree.Array_Elements.Table (Specs).Next;
3203 while Impls /= No_Array_Element loop
3204 Lang_Name := Data.Tree.Array_Elements.Table (Impls).Index;
3206 Get_Language_From_Name
3207 (Project, Name => Get_Name_String (Lang_Name));
3210 if Current_Verbosity = High then
3212 ("Ignoring impl naming data for "
3213 & Get_Name_String (Lang_Name)
3214 & " since language is not defined for this project");
3217 Value := Data.Tree.Array_Elements.Table (Impls).Value;
3219 if Lang.Name = Name_Ada then
3220 Ada_Body_Suffix_Loc := Value.Location;
3223 if Value.Kind = Single then
3224 Lang.Config.Naming_Data.Body_Suffix :=
3225 Canonical_Case_File_Name (Value.Value);
3229 Impls := Data.Tree.Array_Elements.Table (Impls).Next;
3231 end Initialize_Naming_Data;
3233 -- Start of processing for Check_Naming_Schemes
3236 Specs := No_Array_Element;
3237 Bodies := No_Array_Element;
3239 -- No Naming package or parsing a configuration file? nothing to do
3241 if Naming_Id /= No_Package
3242 and then Project.Qualifier /= Configuration
3244 Naming := Data.Tree.Packages.Table (Naming_Id);
3246 if Current_Verbosity = High then
3247 Write_Line ("Checking package Naming for project "
3248 & Get_Name_String (Project.Name));
3251 Initialize_Naming_Data;
3254 end Check_Package_Naming;
3256 ------------------------------
3257 -- Check_Library_Attributes --
3258 ------------------------------
3260 procedure Check_Library_Attributes
3261 (Project : Project_Id;
3262 Data : in out Tree_Processing_Data)
3264 Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
3266 Lib_Dir : constant Prj.Variable_Value :=
3268 (Snames.Name_Library_Dir, Attributes, Data.Tree);
3270 Lib_Name : constant Prj.Variable_Value :=
3272 (Snames.Name_Library_Name, Attributes, Data.Tree);
3274 Lib_Version : constant Prj.Variable_Value :=
3276 (Snames.Name_Library_Version, Attributes, Data.Tree);
3278 Lib_ALI_Dir : constant Prj.Variable_Value :=
3280 (Snames.Name_Library_Ali_Dir, Attributes, Data.Tree);
3282 Lib_GCC : constant Prj.Variable_Value :=
3284 (Snames.Name_Library_GCC, Attributes, Data.Tree);
3286 The_Lib_Kind : constant Prj.Variable_Value :=
3288 (Snames.Name_Library_Kind, Attributes, Data.Tree);
3290 Imported_Project_List : Project_List;
3292 Continuation : String_Access := No_Continuation_String'Access;
3294 Support_For_Libraries : Library_Support;
3296 Library_Directory_Present : Boolean;
3298 procedure Check_Library (Proj : Project_Id; Extends : Boolean);
3299 -- Check if an imported or extended project if also a library project
3305 procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
3307 Iter : Source_Iterator;
3310 if Proj /= No_Project then
3311 if not Proj.Library then
3313 -- The only not library projects that are OK are those that
3314 -- have no sources. However, header files from non-Ada
3315 -- languages are OK, as there is nothing to compile.
3317 Iter := For_Each_Source (Data.Tree, Proj);
3319 Src_Id := Prj.Element (Iter);
3320 exit when Src_Id = No_Source
3321 or else Src_Id.Language.Config.Kind /= File_Based
3322 or else Src_Id.Kind /= Spec;
3326 if Src_Id /= No_Source then
3327 Error_Msg_Name_1 := Project.Name;
3328 Error_Msg_Name_2 := Proj.Name;
3331 if Project.Library_Kind /= Static then
3335 "shared library project %% cannot extend " &
3336 "project %% that is not a library project",
3337 Project.Location, Project);
3338 Continuation := Continuation_String'Access;
3341 elsif (not Unchecked_Shared_Lib_Imports)
3342 and then Project.Library_Kind /= Static
3347 "shared library project %% cannot import project %% " &
3348 "that is not a shared library project",
3349 Project.Location, Project);
3350 Continuation := Continuation_String'Access;
3354 elsif Project.Library_Kind /= Static and then
3355 Proj.Library_Kind = Static
3357 Error_Msg_Name_1 := Project.Name;
3358 Error_Msg_Name_2 := Proj.Name;
3364 "shared library project %% cannot extend static " &
3365 "library project %%",
3366 Project.Location, Project);
3367 Continuation := Continuation_String'Access;
3369 elsif not Unchecked_Shared_Lib_Imports then
3373 "shared library project %% cannot import static " &
3374 "library project %%",
3375 Project.Location, Project);
3376 Continuation := Continuation_String'Access;
3383 Dir_Exists : Boolean;
3385 -- Start of processing for Check_Library_Attributes
3388 Library_Directory_Present := Lib_Dir.Value /= Empty_String;
3390 -- Special case of extending project
3392 if Project.Extends /= No_Project then
3394 -- If the project extended is a library project, we inherit the
3395 -- library name, if it is not redefined; we check that the library
3396 -- directory is specified.
3398 if Project.Extends.Library then
3399 if Project.Qualifier = Standard then
3402 "a standard project cannot extend a library project",
3403 Project.Location, Project);
3406 if Lib_Name.Default then
3407 Project.Library_Name := Project.Extends.Library_Name;
3410 if Lib_Dir.Default then
3411 if not Project.Virtual then
3414 "a project extending a library project must " &
3415 "specify an attribute Library_Dir",
3416 Project.Location, Project);
3419 -- For a virtual project extending a library project,
3420 -- inherit library directory.
3422 Project.Library_Dir := Project.Extends.Library_Dir;
3423 Library_Directory_Present := True;
3430 pragma Assert (Lib_Name.Kind = Single);
3432 if Lib_Name.Value = Empty_String then
3433 if Current_Verbosity = High
3434 and then Project.Library_Name = No_Name
3436 Write_Line ("No library name");
3440 -- There is no restriction on the syntax of library names
3442 Project.Library_Name := Lib_Name.Value;
3445 if Project.Library_Name /= No_Name then
3446 if Current_Verbosity = High then
3448 ("Library name", Get_Name_String (Project.Library_Name));
3451 pragma Assert (Lib_Dir.Kind = Single);
3453 if not Library_Directory_Present then
3454 if Current_Verbosity = High then
3455 Write_Line ("No library directory");
3459 -- Find path name (unless inherited), check that it is a directory
3461 if Project.Library_Dir = No_Path_Information then
3464 File_Name_Type (Lib_Dir.Value),
3465 Path => Project.Library_Dir,
3466 Dir_Exists => Dir_Exists,
3468 Create => "library",
3469 Must_Exist => False,
3470 Location => Lib_Dir.Location,
3471 Externally_Built => Project.Externally_Built);
3477 (Project.Library_Dir.Display_Name));
3480 if not Dir_Exists then
3482 -- Get the absolute name of the library directory that
3483 -- does not exist, to report an error.
3485 Err_Vars.Error_Msg_File_1 :=
3486 File_Name_Type (Project.Library_Dir.Display_Name);
3489 "library directory { does not exist",
3490 Lib_Dir.Location, Project);
3492 -- The library directory cannot be the same as the Object
3495 elsif Project.Library_Dir.Name = Project.Object_Directory.Name then
3498 "library directory cannot be the same " &
3499 "as object directory",
3500 Lib_Dir.Location, Project);
3501 Project.Library_Dir := No_Path_Information;
3505 OK : Boolean := True;
3506 Dirs_Id : String_List_Id;
3507 Dir_Elem : String_Element;
3511 -- The library directory cannot be the same as a source
3512 -- directory of the current project.
3514 Dirs_Id := Project.Source_Dirs;
3515 while Dirs_Id /= Nil_String loop
3516 Dir_Elem := Data.Tree.String_Elements.Table (Dirs_Id);
3517 Dirs_Id := Dir_Elem.Next;
3519 if Project.Library_Dir.Name =
3520 Path_Name_Type (Dir_Elem.Value)
3522 Err_Vars.Error_Msg_File_1 :=
3523 File_Name_Type (Dir_Elem.Value);
3526 "library directory cannot be the same " &
3527 "as source directory {",
3528 Lib_Dir.Location, Project);
3536 -- The library directory cannot be the same as a source
3537 -- directory of another project either.
3539 Pid := Data.Tree.Projects;
3541 exit Project_Loop when Pid = null;
3543 if Pid.Project /= Project then
3544 Dirs_Id := Pid.Project.Source_Dirs;
3546 Dir_Loop : while Dirs_Id /= Nil_String loop
3548 Data.Tree.String_Elements.Table (Dirs_Id);
3549 Dirs_Id := Dir_Elem.Next;
3551 if Project.Library_Dir.Name =
3552 Path_Name_Type (Dir_Elem.Value)
3554 Err_Vars.Error_Msg_File_1 :=
3555 File_Name_Type (Dir_Elem.Value);
3556 Err_Vars.Error_Msg_Name_1 := Pid.Project.Name;
3560 "library directory cannot be the same " &
3561 "as source directory { of project %%",
3562 Lib_Dir.Location, Project);
3570 end loop Project_Loop;
3574 Project.Library_Dir := No_Path_Information;
3576 elsif Current_Verbosity = High then
3578 -- Display the Library directory in high verbosity
3581 ("Library directory",
3582 Get_Name_String (Project.Library_Dir.Display_Name));
3591 Project.Library_Dir /= No_Path_Information
3592 and then Project.Library_Name /= No_Name;
3594 if Project.Extends = No_Project then
3595 case Project.Qualifier is
3597 if Project.Library then
3600 "a standard project cannot be a library project",
3601 Lib_Name.Location, Project);
3605 if not Project.Library then
3606 if Project.Library_Dir = No_Path_Information then
3609 "\attribute Library_Dir not declared",
3610 Project.Location, Project);
3613 if Project.Library_Name = No_Name then
3616 "\attribute Library_Name not declared",
3617 Project.Location, Project);
3627 if Project.Library then
3628 Support_For_Libraries := Project.Config.Lib_Support;
3630 if Support_For_Libraries = Prj.None then
3633 "?libraries are not supported on this platform",
3634 Lib_Name.Location, Project);
3635 Project.Library := False;
3638 if Lib_ALI_Dir.Value = Empty_String then
3639 if Current_Verbosity = High then
3640 Write_Line ("No library ALI directory specified");
3643 Project.Library_ALI_Dir := Project.Library_Dir;
3646 -- Find path name, check that it is a directory
3650 File_Name_Type (Lib_ALI_Dir.Value),
3651 Path => Project.Library_ALI_Dir,
3652 Create => "library ALI",
3653 Dir_Exists => Dir_Exists,
3655 Must_Exist => False,
3656 Location => Lib_ALI_Dir.Location,
3657 Externally_Built => Project.Externally_Built);
3659 if not Dir_Exists then
3661 -- Get the absolute name of the library ALI directory that
3662 -- does not exist, to report an error.
3664 Err_Vars.Error_Msg_File_1 :=
3665 File_Name_Type (Project.Library_ALI_Dir.Display_Name);
3668 "library 'A'L'I directory { does not exist",
3669 Lib_ALI_Dir.Location, Project);
3672 if Project.Library_ALI_Dir /= Project.Library_Dir then
3674 -- The library ALI directory cannot be the same as the
3675 -- Object directory.
3677 if Project.Library_ALI_Dir = Project.Object_Directory then
3680 "library 'A'L'I directory cannot be the same " &
3681 "as object directory",
3682 Lib_ALI_Dir.Location, Project);
3683 Project.Library_ALI_Dir := No_Path_Information;
3687 OK : Boolean := True;
3688 Dirs_Id : String_List_Id;
3689 Dir_Elem : String_Element;
3693 -- The library ALI directory cannot be the same as
3694 -- a source directory of the current project.
3696 Dirs_Id := Project.Source_Dirs;
3697 while Dirs_Id /= Nil_String loop
3699 Data.Tree.String_Elements.Table (Dirs_Id);
3700 Dirs_Id := Dir_Elem.Next;
3702 if Project.Library_ALI_Dir.Name =
3703 Path_Name_Type (Dir_Elem.Value)
3705 Err_Vars.Error_Msg_File_1 :=
3706 File_Name_Type (Dir_Elem.Value);
3709 "library 'A'L'I directory cannot be " &
3710 "the same as source directory {",
3711 Lib_ALI_Dir.Location, Project);
3719 -- The library ALI directory cannot be the same as
3720 -- a source directory of another project either.
3722 Pid := Data.Tree.Projects;
3723 ALI_Project_Loop : loop
3724 exit ALI_Project_Loop when Pid = null;
3726 if Pid.Project /= Project then
3727 Dirs_Id := Pid.Project.Source_Dirs;
3730 while Dirs_Id /= Nil_String loop
3732 Data.Tree.String_Elements.Table
3734 Dirs_Id := Dir_Elem.Next;
3736 if Project.Library_ALI_Dir.Name =
3737 Path_Name_Type (Dir_Elem.Value)
3739 Err_Vars.Error_Msg_File_1 :=
3740 File_Name_Type (Dir_Elem.Value);
3741 Err_Vars.Error_Msg_Name_1 :=
3746 "library 'A'L'I directory cannot " &
3747 "be the same as source directory " &
3749 Lib_ALI_Dir.Location, Project);
3751 exit ALI_Project_Loop;
3753 end loop ALI_Dir_Loop;
3756 end loop ALI_Project_Loop;
3760 Project.Library_ALI_Dir := No_Path_Information;
3762 elsif Current_Verbosity = High then
3764 -- Display Library ALI directory in high verbosity
3769 (Project.Library_ALI_Dir.Display_Name));
3776 pragma Assert (Lib_Version.Kind = Single);
3778 if Lib_Version.Value = Empty_String then
3779 if Current_Verbosity = High then
3780 Write_Line ("No library version specified");
3784 Project.Lib_Internal_Name := Lib_Version.Value;
3787 pragma Assert (The_Lib_Kind.Kind = Single);
3789 if The_Lib_Kind.Value = Empty_String then
3790 if Current_Verbosity = High then
3791 Write_Line ("No library kind specified");
3795 Get_Name_String (The_Lib_Kind.Value);
3798 Kind_Name : constant String :=
3799 To_Lower (Name_Buffer (1 .. Name_Len));
3801 OK : Boolean := True;
3804 if Kind_Name = "static" then
3805 Project.Library_Kind := Static;
3807 elsif Kind_Name = "dynamic" then
3808 Project.Library_Kind := Dynamic;
3810 elsif Kind_Name = "relocatable" then
3811 Project.Library_Kind := Relocatable;
3816 "illegal value for Library_Kind",
3817 The_Lib_Kind.Location, Project);
3821 if Current_Verbosity = High and then OK then
3822 Write_Attr ("Library kind", Kind_Name);
3825 if Project.Library_Kind /= Static then
3826 if Support_For_Libraries = Prj.Static_Only then
3829 "only static libraries are supported " &
3831 The_Lib_Kind.Location, Project);
3832 Project.Library := False;
3835 -- Check if (obsolescent) attribute Library_GCC or
3836 -- Linker'Driver is declared.
3838 if Lib_GCC.Value /= Empty_String then
3841 "?Library_'G'C'C is an obsolescent attribute, " &
3842 "use Linker''Driver instead",
3843 Lib_GCC.Location, Project);
3844 Project.Config.Shared_Lib_Driver :=
3845 File_Name_Type (Lib_GCC.Value);
3849 Linker : constant Package_Id :=
3852 Project.Decl.Packages,
3854 Driver : constant Variable_Value :=
3857 Attribute_Or_Array_Name =>
3859 In_Package => Linker,
3860 In_Tree => Data.Tree);
3863 if Driver /= Nil_Variable_Value
3864 and then Driver.Value /= Empty_String
3866 Project.Config.Shared_Lib_Driver :=
3867 File_Name_Type (Driver.Value);
3876 if Project.Library then
3877 if Current_Verbosity = High then
3878 Write_Line ("This is a library project file");
3881 Check_Library (Project.Extends, Extends => True);
3883 Imported_Project_List := Project.Imported_Projects;
3884 while Imported_Project_List /= null loop
3886 (Imported_Project_List.Project,
3888 Imported_Project_List := Imported_Project_List.Next;
3895 -- Check if Linker'Switches or Linker'Default_Switches are declared.
3896 -- Warn if they are declared, as it is a common error to think that
3897 -- library are "linked" with Linker switches.
3899 if Project.Library then
3901 Linker_Package_Id : constant Package_Id :=
3904 Project.Decl.Packages, Data.Tree);
3905 Linker_Package : Package_Element;
3906 Switches : Array_Element_Id := No_Array_Element;
3909 if Linker_Package_Id /= No_Package then
3910 Linker_Package := Data.Tree.Packages.Table (Linker_Package_Id);
3914 (Name => Name_Switches,
3915 In_Arrays => Linker_Package.Decl.Arrays,
3916 In_Tree => Data.Tree);
3918 if Switches = No_Array_Element then
3921 (Name => Name_Default_Switches,
3922 In_Arrays => Linker_Package.Decl.Arrays,
3923 In_Tree => Data.Tree);
3926 if Switches /= No_Array_Element then
3929 "?Linker switches not taken into account in library " &
3931 No_Location, Project);
3937 if Project.Extends /= No_Project then
3938 Project.Extends.Library := False;
3940 end Check_Library_Attributes;
3942 ---------------------------------
3943 -- Check_Programming_Languages --
3944 ---------------------------------
3946 procedure Check_Programming_Languages
3947 (Project : Project_Id;
3948 Data : in out Tree_Processing_Data)
3950 Languages : Variable_Value := Nil_Variable_Value;
3951 Def_Lang : Variable_Value := Nil_Variable_Value;
3952 Def_Lang_Id : Name_Id;
3954 procedure Add_Language (Name, Display_Name : Name_Id);
3955 -- Add a new language to the list of languages for the project.
3956 -- Nothing is done if the language has already been defined
3962 procedure Add_Language (Name, Display_Name : Name_Id) is
3963 Lang : Language_Ptr;
3966 Lang := Project.Languages;
3967 while Lang /= No_Language_Index loop
3968 if Name = Lang.Name then
3975 Lang := new Language_Data'(No_Language_Data);
3976 Lang.Next := Project.Languages;
3977 Project.Languages := Lang;
3979 Lang.Display_Name := Display_Name;
3981 if Name = Name_Ada then
3982 Lang.Config.Kind := Unit_Based;
3983 Lang.Config.Dependency_Kind := ALI_File;
3985 Lang.Config.Kind := File_Based;
3989 -- Start of processing for Check_Programming_Languages
3992 Project.Languages := null;
3994 Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Data.Tree);
3997 (Name_Default_Language, Project.Decl.Attributes, Data.Tree);
3999 if Project.Source_Dirs /= Nil_String then
4001 -- Check if languages are specified in this project
4003 if Languages.Default then
4005 -- Fail if there is no default language defined
4007 if Def_Lang.Default then
4010 "no languages defined for this project",
4011 Project.Location, Project);
4012 Def_Lang_Id := No_Name;
4015 Get_Name_String (Def_Lang.Value);
4016 To_Lower (Name_Buffer (1 .. Name_Len));
4017 Def_Lang_Id := Name_Find;
4020 if Def_Lang_Id /= No_Name then
4021 Get_Name_String (Def_Lang_Id);
4022 Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
4024 (Name => Def_Lang_Id,
4025 Display_Name => Name_Find);
4030 Current : String_List_Id := Languages.Values;
4031 Element : String_Element;
4034 -- If there are no languages declared, there are no sources
4036 if Current = Nil_String then
4037 Project.Source_Dirs := Nil_String;
4039 if Project.Qualifier = Standard then
4042 "a standard project must have at least one language",
4043 Languages.Location, Project);
4047 -- Look through all the languages specified in attribute
4050 while Current /= Nil_String loop
4051 Element := Data.Tree.String_Elements.Table (Current);
4052 Get_Name_String (Element.Value);
4053 To_Lower (Name_Buffer (1 .. Name_Len));
4057 Display_Name => Element.Value);
4059 Current := Element.Next;
4065 end Check_Programming_Languages;
4067 -------------------------------
4068 -- Check_Stand_Alone_Library --
4069 -------------------------------
4071 procedure Check_Stand_Alone_Library
4072 (Project : Project_Id;
4073 Data : in out Tree_Processing_Data)
4075 Lib_Interfaces : constant Prj.Variable_Value :=
4077 (Snames.Name_Library_Interface,
4078 Project.Decl.Attributes,
4081 Lib_Auto_Init : constant Prj.Variable_Value :=
4083 (Snames.Name_Library_Auto_Init,
4084 Project.Decl.Attributes,
4087 Lib_Src_Dir : constant Prj.Variable_Value :=
4089 (Snames.Name_Library_Src_Dir,
4090 Project.Decl.Attributes,
4093 Lib_Symbol_File : constant Prj.Variable_Value :=
4095 (Snames.Name_Library_Symbol_File,
4096 Project.Decl.Attributes,
4099 Lib_Symbol_Policy : constant Prj.Variable_Value :=
4101 (Snames.Name_Library_Symbol_Policy,
4102 Project.Decl.Attributes,
4105 Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
4107 (Snames.Name_Library_Reference_Symbol_File,
4108 Project.Decl.Attributes,
4111 Auto_Init_Supported : Boolean;
4112 OK : Boolean := True;
4114 Next_Proj : Project_Id;
4115 Iter : Source_Iterator;
4118 Auto_Init_Supported := Project.Config.Auto_Init_Supported;
4120 pragma Assert (Lib_Interfaces.Kind = List);
4122 -- It is a stand-alone library project file if attribute
4123 -- Library_Interface is defined.
4125 if not Lib_Interfaces.Default then
4127 Interfaces : String_List_Id := Lib_Interfaces.Values;
4128 Interface_ALIs : String_List_Id := Nil_String;
4132 Project.Standalone_Library := True;
4134 -- Library_Interface cannot be an empty list
4136 if Interfaces = Nil_String then
4139 "Library_Interface cannot be an empty list",
4140 Lib_Interfaces.Location, Project);
4143 -- Process each unit name specified in the attribute
4144 -- Library_Interface.
4146 while Interfaces /= Nil_String loop
4148 (Data.Tree.String_Elements.Table (Interfaces).Value);
4149 To_Lower (Name_Buffer (1 .. Name_Len));
4151 if Name_Len = 0 then
4154 "an interface cannot be an empty string",
4155 Data.Tree.String_Elements.Table (Interfaces).Location,
4160 Error_Msg_Name_1 := Unit;
4162 Next_Proj := Project.Extends;
4163 Iter := For_Each_Source (Data.Tree, Project);
4165 while Prj.Element (Iter) /= No_Source
4167 (Prj.Element (Iter).Unit = null
4168 or else Prj.Element (Iter).Unit.Name /= Unit)
4173 Source := Prj.Element (Iter);
4174 exit when Source /= No_Source
4175 or else Next_Proj = No_Project;
4177 Iter := For_Each_Source (Data.Tree, Next_Proj);
4178 Next_Proj := Next_Proj.Extends;
4181 if Source /= No_Source then
4182 if Source.Kind = Sep then
4183 Source := No_Source;
4185 elsif Source.Kind = Spec
4186 and then Other_Part (Source) /= No_Source
4188 Source := Other_Part (Source);
4192 if Source /= No_Source then
4193 if Source.Project /= Project
4194 and then not Is_Extending (Project, Source.Project)
4196 Source := No_Source;
4200 if Source = No_Source then
4203 "%% is not a unit of this project",
4204 Data.Tree.String_Elements.Table
4205 (Interfaces).Location, Project);
4208 if Source.Kind = Spec
4209 and then Other_Part (Source) /= No_Source
4211 Source := Other_Part (Source);
4214 String_Element_Table.Increment_Last
4215 (Data.Tree.String_Elements);
4217 Data.Tree.String_Elements.Table
4218 (String_Element_Table.Last
4219 (Data.Tree.String_Elements)) :=
4220 (Value => Name_Id (Source.Dep_Name),
4222 Display_Value => Name_Id (Source.Dep_Name),
4224 Data.Tree.String_Elements.Table
4225 (Interfaces).Location,
4227 Next => Interface_ALIs);
4230 String_Element_Table.Last
4231 (Data.Tree.String_Elements);
4235 Interfaces := Data.Tree.String_Elements.Table (Interfaces).Next;
4238 -- Put the list of Interface ALIs in the project data
4240 Project.Lib_Interface_ALIs := Interface_ALIs;
4242 -- Check value of attribute Library_Auto_Init and set
4243 -- Lib_Auto_Init accordingly.
4245 if Lib_Auto_Init.Default then
4247 -- If no attribute Library_Auto_Init is declared, then set auto
4248 -- init only if it is supported.
4250 Project.Lib_Auto_Init := Auto_Init_Supported;
4253 Get_Name_String (Lib_Auto_Init.Value);
4254 To_Lower (Name_Buffer (1 .. Name_Len));
4256 if Name_Buffer (1 .. Name_Len) = "false" then
4257 Project.Lib_Auto_Init := False;
4259 elsif Name_Buffer (1 .. Name_Len) = "true" then
4260 if Auto_Init_Supported then
4261 Project.Lib_Auto_Init := True;
4264 -- Library_Auto_Init cannot be "true" if auto init is not
4269 "library auto init not supported " &
4271 Lib_Auto_Init.Location, Project);
4277 "invalid value for attribute Library_Auto_Init",
4278 Lib_Auto_Init.Location, Project);
4283 -- If attribute Library_Src_Dir is defined and not the empty string,
4284 -- check if the directory exist and is not the object directory or
4285 -- one of the source directories. This is the directory where copies
4286 -- of the interface sources will be copied. Note that this directory
4287 -- may be the library directory.
4289 if Lib_Src_Dir.Value /= Empty_String then
4291 Dir_Id : constant File_Name_Type :=
4292 File_Name_Type (Lib_Src_Dir.Value);
4293 Dir_Exists : Boolean;
4299 Path => Project.Library_Src_Dir,
4300 Dir_Exists => Dir_Exists,
4302 Must_Exist => False,
4303 Create => "library source copy",
4304 Location => Lib_Src_Dir.Location,
4305 Externally_Built => Project.Externally_Built);
4307 -- If directory does not exist, report an error
4309 if not Dir_Exists then
4311 -- Get the absolute name of the library directory that does
4312 -- not exist, to report an error.
4314 Err_Vars.Error_Msg_File_1 :=
4315 File_Name_Type (Project.Library_Src_Dir.Display_Name);
4318 "Directory { does not exist",
4319 Lib_Src_Dir.Location, Project);
4321 -- Report error if it is the same as the object directory
4323 elsif Project.Library_Src_Dir = Project.Object_Directory then
4326 "directory to copy interfaces cannot be " &
4327 "the object directory",
4328 Lib_Src_Dir.Location, Project);
4329 Project.Library_Src_Dir := No_Path_Information;
4333 Src_Dirs : String_List_Id;
4334 Src_Dir : String_Element;
4338 -- Interface copy directory cannot be one of the source
4339 -- directory of the current project.
4341 Src_Dirs := Project.Source_Dirs;
4342 while Src_Dirs /= Nil_String loop
4343 Src_Dir := Data.Tree.String_Elements.Table (Src_Dirs);
4345 -- Report error if it is one of the source directories
4347 if Project.Library_Src_Dir.Name =
4348 Path_Name_Type (Src_Dir.Value)
4352 "directory to copy interfaces cannot " &
4353 "be one of the source directories",
4354 Lib_Src_Dir.Location, Project);
4355 Project.Library_Src_Dir := No_Path_Information;
4359 Src_Dirs := Src_Dir.Next;
4362 if Project.Library_Src_Dir /= No_Path_Information then
4364 -- It cannot be a source directory of any other
4367 Pid := Data.Tree.Projects;
4369 exit Project_Loop when Pid = null;
4371 Src_Dirs := Pid.Project.Source_Dirs;
4372 Dir_Loop : while Src_Dirs /= Nil_String loop
4374 Data.Tree.String_Elements.Table (Src_Dirs);
4376 -- Report error if it is one of the source
4379 if Project.Library_Src_Dir.Name =
4380 Path_Name_Type (Src_Dir.Value)
4383 File_Name_Type (Src_Dir.Value);
4384 Error_Msg_Name_1 := Pid.Project.Name;
4387 "directory to copy interfaces cannot " &
4388 "be the same as source directory { of " &
4390 Lib_Src_Dir.Location, Project);
4391 Project.Library_Src_Dir :=
4392 No_Path_Information;
4396 Src_Dirs := Src_Dir.Next;
4400 end loop Project_Loop;
4404 -- In high verbosity, if there is a valid Library_Src_Dir,
4405 -- display its path name.
4407 if Project.Library_Src_Dir /= No_Path_Information
4408 and then Current_Verbosity = High
4411 ("Directory to copy interfaces",
4412 Get_Name_String (Project.Library_Src_Dir.Name));
4418 -- Check the symbol related attributes
4420 -- First, the symbol policy
4422 if not Lib_Symbol_Policy.Default then
4424 Value : constant String :=
4426 (Get_Name_String (Lib_Symbol_Policy.Value));
4429 -- Symbol policy must hove one of a limited number of values
4431 if Value = "autonomous" or else Value = "default" then
4432 Project.Symbol_Data.Symbol_Policy := Autonomous;
4434 elsif Value = "compliant" then
4435 Project.Symbol_Data.Symbol_Policy := Compliant;
4437 elsif Value = "controlled" then
4438 Project.Symbol_Data.Symbol_Policy := Controlled;
4440 elsif Value = "restricted" then
4441 Project.Symbol_Data.Symbol_Policy := Restricted;
4443 elsif Value = "direct" then
4444 Project.Symbol_Data.Symbol_Policy := Direct;
4449 "illegal value for Library_Symbol_Policy",
4450 Lib_Symbol_Policy.Location, Project);
4455 -- If attribute Library_Symbol_File is not specified, symbol policy
4456 -- cannot be Restricted.
4458 if Lib_Symbol_File.Default then
4459 if Project.Symbol_Data.Symbol_Policy = Restricted then
4462 "Library_Symbol_File needs to be defined when " &
4463 "symbol policy is Restricted",
4464 Lib_Symbol_Policy.Location, Project);
4468 -- Library_Symbol_File is defined
4470 Project.Symbol_Data.Symbol_File :=
4471 Path_Name_Type (Lib_Symbol_File.Value);
4473 Get_Name_String (Lib_Symbol_File.Value);
4475 if Name_Len = 0 then
4478 "symbol file name cannot be an empty string",
4479 Lib_Symbol_File.Location, Project);
4482 OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
4485 for J in 1 .. Name_Len loop
4486 if Name_Buffer (J) = '/'
4487 or else Name_Buffer (J) = Directory_Separator
4496 Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
4499 "symbol file name { is illegal. " &
4500 "Name cannot include directory info.",
4501 Lib_Symbol_File.Location, Project);
4506 -- If attribute Library_Reference_Symbol_File is not defined,
4507 -- symbol policy cannot be Compliant or Controlled.
4509 if Lib_Ref_Symbol_File.Default then
4510 if Project.Symbol_Data.Symbol_Policy = Compliant
4511 or else Project.Symbol_Data.Symbol_Policy = Controlled
4515 "a reference symbol file needs to be defined",
4516 Lib_Symbol_Policy.Location, Project);
4520 -- Library_Reference_Symbol_File is defined, check file exists
4522 Project.Symbol_Data.Reference :=
4523 Path_Name_Type (Lib_Ref_Symbol_File.Value);
4525 Get_Name_String (Lib_Ref_Symbol_File.Value);
4527 if Name_Len = 0 then
4530 "reference symbol file name cannot be an empty string",
4531 Lib_Symbol_File.Location, Project);
4534 if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
4536 Add_Str_To_Name_Buffer
4537 (Get_Name_String (Project.Directory.Name));
4538 Add_Str_To_Name_Buffer
4539 (Get_Name_String (Lib_Ref_Symbol_File.Value));
4540 Project.Symbol_Data.Reference := Name_Find;
4543 if not Is_Regular_File
4544 (Get_Name_String (Project.Symbol_Data.Reference))
4547 File_Name_Type (Lib_Ref_Symbol_File.Value);
4549 -- For controlled and direct symbol policies, it is an error
4550 -- if the reference symbol file does not exist. For other
4551 -- symbol policies, this is just a warning
4554 Project.Symbol_Data.Symbol_Policy /= Controlled
4555 and then Project.Symbol_Data.Symbol_Policy /= Direct;
4559 "<library reference symbol file { does not exist",
4560 Lib_Ref_Symbol_File.Location, Project);
4562 -- In addition in the non-controlled case, if symbol policy
4563 -- is Compliant, it is changed to Autonomous, because there
4564 -- is no reference to check against, and we don't want to
4565 -- fail in this case.
4567 if Project.Symbol_Data.Symbol_Policy /= Controlled then
4568 if Project.Symbol_Data.Symbol_Policy = Compliant then
4569 Project.Symbol_Data.Symbol_Policy := Autonomous;
4574 -- If both the reference symbol file and the symbol file are
4575 -- defined, then check that they are not the same file.
4577 if Project.Symbol_Data.Symbol_File /= No_Path then
4578 Get_Name_String (Project.Symbol_Data.Symbol_File);
4580 if Name_Len > 0 then
4582 -- We do not need to pass a Directory to
4583 -- Normalize_Pathname, since the path_information
4584 -- already contains absolute information.
4586 Symb_Path : constant String :=
4589 (Project.Object_Directory.Name) &
4590 Name_Buffer (1 .. Name_Len),
4593 Opt.Follow_Links_For_Files);
4594 Ref_Path : constant String :=
4597 (Project.Symbol_Data.Reference),
4600 Opt.Follow_Links_For_Files);
4602 if Symb_Path = Ref_Path then
4605 "library reference symbol file and library" &
4606 " symbol file cannot be the same file",
4607 Lib_Ref_Symbol_File.Location, Project);
4615 end Check_Stand_Alone_Library;
4617 ----------------------------
4618 -- Compute_Directory_Last --
4619 ----------------------------
4621 function Compute_Directory_Last (Dir : String) return Natural is
4624 and then (Dir (Dir'Last - 1) = Directory_Separator
4626 Dir (Dir'Last - 1) = '/')
4628 return Dir'Last - 1;
4632 end Compute_Directory_Last;
4634 ---------------------
4635 -- Get_Directories --
4636 ---------------------
4638 procedure Get_Directories
4639 (Project : Project_Id;
4640 Data : in out Tree_Processing_Data)
4642 package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable
4643 (Header_Num => Header_Num,
4645 No_Element => False,
4649 -- Hash table stores recursive source directories, to avoid looking
4650 -- several times, and to avoid cycles that may be introduced by symbolic
4653 Visited : Recursive_Dirs.Instance;
4655 Object_Dir : constant Variable_Value :=
4657 (Name_Object_Dir, Project.Decl.Attributes, Data.Tree);
4659 Exec_Dir : constant Variable_Value :=
4661 (Name_Exec_Dir, Project.Decl.Attributes, Data.Tree);
4663 Source_Dirs : constant Variable_Value :=
4665 (Name_Source_Dirs, Project.Decl.Attributes, Data.Tree);
4667 Excluded_Source_Dirs : constant Variable_Value :=
4669 (Name_Excluded_Source_Dirs,
4670 Project.Decl.Attributes,
4673 Source_Files : constant Variable_Value :=
4676 Project.Decl.Attributes, Data.Tree);
4678 Last_Source_Dir : String_List_Id := Nil_String;
4680 Languages : constant Variable_Value :=
4682 (Name_Languages, Project.Decl.Attributes, Data.Tree);
4684 procedure Find_Source_Dirs
4685 (From : File_Name_Type;
4686 Location : Source_Ptr;
4687 Removed : Boolean := False);
4688 -- Find one or several source directories, and add (or remove, if
4689 -- Removed is True) them to list of source directories of the project.
4691 ----------------------
4692 -- Find_Source_Dirs --
4693 ----------------------
4695 procedure Find_Source_Dirs
4696 (From : File_Name_Type;
4697 Location : Source_Ptr;
4698 Removed : Boolean := False)
4700 Directory : constant String := Get_Name_String (From);
4701 Element : String_Element;
4703 procedure Recursive_Find_Dirs (Path : Name_Id);
4704 -- Find all the subdirectories (recursively) of Path and add them
4705 -- to the list of source directories of the project.
4707 -------------------------
4708 -- Recursive_Find_Dirs --
4709 -------------------------
4711 procedure Recursive_Find_Dirs (Path : Name_Id) is
4713 Name : String (1 .. 250);
4715 List : String_List_Id;
4716 Prev : String_List_Id;
4717 Element : String_Element;
4718 Found : Boolean := False;
4720 Non_Canonical_Path : Name_Id := No_Name;
4721 Canonical_Path : Name_Id := No_Name;
4723 The_Path : constant String :=
4725 (Get_Name_String (Path),
4727 Get_Name_String (Project.Directory.Display_Name),
4728 Resolve_Links => Opt.Follow_Links_For_Dirs) &
4729 Directory_Separator;
4731 The_Path_Last : constant Natural :=
4732 Compute_Directory_Last (The_Path);
4735 Name_Len := The_Path_Last - The_Path'First + 1;
4736 Name_Buffer (1 .. Name_Len) :=
4737 The_Path (The_Path'First .. The_Path_Last);
4738 Non_Canonical_Path := Name_Find;
4740 Name_Id (Canonical_Case_File_Name (Non_Canonical_Path));
4742 -- To avoid processing the same directory several times, check
4743 -- if the directory is already in Recursive_Dirs. If it is, then
4744 -- there is nothing to do, just return. If it is not, put it there
4745 -- and continue recursive processing.
4748 if Recursive_Dirs.Get (Visited, Canonical_Path) then
4751 Recursive_Dirs.Set (Visited, Canonical_Path, True);
4755 -- Check if directory is already in list
4757 List := Project.Source_Dirs;
4759 while List /= Nil_String loop
4760 Element := Data.Tree.String_Elements.Table (List);
4762 if Element.Value /= No_Name then
4763 Found := Element.Value = Canonical_Path;
4768 List := Element.Next;
4771 -- If directory is not already in list, put it there
4773 if (not Removed) and (not Found) then
4774 if Current_Verbosity = High then
4776 Write_Line (The_Path (The_Path'First .. The_Path_Last));
4779 String_Element_Table.Increment_Last (Data.Tree.String_Elements);
4781 (Value => Canonical_Path,
4782 Display_Value => Non_Canonical_Path,
4783 Location => No_Location,
4788 -- Case of first source directory
4790 if Last_Source_Dir = Nil_String then
4791 Project.Source_Dirs :=
4792 String_Element_Table.Last (Data.Tree.String_Elements);
4794 -- Here we already have source directories
4797 -- Link the previous last to the new one
4799 Data.Tree.String_Elements.Table
4800 (Last_Source_Dir).Next :=
4801 String_Element_Table.Last (Data.Tree.String_Elements);
4804 -- And register this source directory as the new last
4807 String_Element_Table.Last (Data.Tree.String_Elements);
4808 Data.Tree.String_Elements.Table (Last_Source_Dir) := Element;
4810 elsif Removed and Found then
4811 if Prev = Nil_String then
4812 Project.Source_Dirs :=
4813 Data.Tree.String_Elements.Table (List).Next;
4815 Data.Tree.String_Elements.Table (Prev).Next :=
4816 Data.Tree.String_Elements.Table (List).Next;
4820 -- Now look for subdirectories. We do that even when this
4821 -- directory is already in the list, because some of its
4822 -- subdirectories may not be in the list yet.
4824 Open (Dir, The_Path (The_Path'First .. The_Path_Last));
4827 Read (Dir, Name, Last);
4830 if Name (1 .. Last) /= "."
4831 and then Name (1 .. Last) /= ".."
4833 -- Avoid . and .. directories
4835 if Current_Verbosity = High then
4836 Write_Str (" Checking ");
4837 Write_Line (Name (1 .. Last));
4841 Path_Name : constant String :=
4843 (Name => Name (1 .. Last),
4845 The_Path (The_Path'First .. The_Path_Last),
4846 Resolve_Links => Opt.Follow_Links_For_Dirs,
4847 Case_Sensitive => True);
4850 if Is_Directory (Path_Name) then
4852 -- We have found a new subdirectory, call self
4854 Name_Len := Path_Name'Length;
4855 Name_Buffer (1 .. Name_Len) := Path_Name;
4856 Recursive_Find_Dirs (Name_Find);
4865 when Directory_Error =>
4867 end Recursive_Find_Dirs;
4869 -- Start of processing for Find_Source_Dirs
4872 if Current_Verbosity = High and then not Removed then
4873 Write_Str ("Find_Source_Dirs (""");
4874 Write_Str (Directory);
4878 -- First, check if we are looking for a directory tree, indicated
4879 -- by "/**" at the end.
4881 if Directory'Length >= 3
4882 and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
4883 and then (Directory (Directory'Last - 2) = '/'
4885 Directory (Directory'Last - 2) = Directory_Separator)
4888 Project.Known_Order_Of_Source_Dirs := False;
4891 Name_Len := Directory'Length - 3;
4893 if Name_Len = 0 then
4895 -- Case of "/**": all directories in file system
4898 Name_Buffer (1) := Directory (Directory'First);
4901 Name_Buffer (1 .. Name_Len) :=
4902 Directory (Directory'First .. Directory'Last - 3);
4905 if Current_Verbosity = High then
4906 Write_Str ("Looking for all subdirectories of """);
4907 Write_Str (Name_Buffer (1 .. Name_Len));
4912 Base_Dir : constant File_Name_Type := Name_Find;
4913 Root_Dir : constant String :=
4915 (Name => Get_Name_String (Base_Dir),
4918 (Project.Directory.Display_Name),
4919 Resolve_Links => False,
4920 Case_Sensitive => True);
4923 if Root_Dir'Length = 0 then
4924 Err_Vars.Error_Msg_File_1 := Base_Dir;
4926 if Location = No_Location then
4929 "{ is not a valid directory.",
4930 Project.Location, Project);
4934 "{ is not a valid directory.",
4939 -- We have an existing directory, we register it and all of
4940 -- its subdirectories.
4942 if Current_Verbosity = High then
4943 Write_Line ("Looking for source directories:");
4946 Name_Len := Root_Dir'Length;
4947 Name_Buffer (1 .. Name_Len) := Root_Dir;
4948 Recursive_Find_Dirs (Name_Find);
4950 if Current_Verbosity = High then
4951 Write_Line ("End of looking for source directories.");
4956 -- We have a single directory
4960 Path_Name : Path_Information;
4961 List : String_List_Id;
4962 Prev : String_List_Id;
4963 Dir_Exists : Boolean;
4967 (Project => Project,
4970 Dir_Exists => Dir_Exists,
4972 Must_Exist => False);
4974 if not Dir_Exists then
4975 Err_Vars.Error_Msg_File_1 := From;
4977 if Location = No_Location then
4980 "{ is not a valid directory",
4981 Project.Location, Project);
4985 "{ is not a valid directory",
4991 Path : constant String :=
4992 Get_Name_String (Path_Name.Name);
4993 Last_Path : constant Natural :=
4994 Compute_Directory_Last (Path);
4996 Display_Path : constant String :=
4998 (Path_Name.Display_Name);
4999 Last_Display_Path : constant Natural :=
5000 Compute_Directory_Last
5002 Display_Path_Id : Name_Id;
5006 Add_Str_To_Name_Buffer (Path (Path'First .. Last_Path));
5007 Path_Id := Name_Find;
5009 Add_Str_To_Name_Buffer
5011 (Display_Path'First .. Last_Display_Path));
5012 Display_Path_Id := Name_Find;
5016 -- As it is an existing directory, we add it to the
5017 -- list of directories.
5019 String_Element_Table.Increment_Last
5020 (Data.Tree.String_Elements);
5024 Display_Value => Display_Path_Id,
5025 Location => No_Location,
5027 Next => Nil_String);
5029 if Last_Source_Dir = Nil_String then
5031 -- This is the first source directory
5033 Project.Source_Dirs := String_Element_Table.Last
5034 (Data.Tree.String_Elements);
5037 -- We already have source directories, link the
5038 -- previous last to the new one.
5040 Data.Tree.String_Elements.Table
5041 (Last_Source_Dir).Next :=
5042 String_Element_Table.Last
5043 (Data.Tree.String_Elements);
5046 -- And register this source directory as the new last
5048 Last_Source_Dir := String_Element_Table.Last
5049 (Data.Tree.String_Elements);
5050 Data.Tree.String_Elements.Table
5051 (Last_Source_Dir) := Element;
5054 -- Remove source dir, if present
5058 -- Look for source dir in current list
5060 List := Project.Source_Dirs;
5061 while List /= Nil_String loop
5062 Element := Data.Tree.String_Elements.Table (List);
5063 exit when Element.Value = Path_Id;
5065 List := Element.Next;
5068 if List /= Nil_String then
5069 -- Source dir was found, remove it from the list
5071 if Prev = Nil_String then
5072 Project.Source_Dirs :=
5073 Data.Tree.String_Elements.Table (List).Next;
5076 Data.Tree.String_Elements.Table (Prev).Next :=
5077 Data.Tree.String_Elements.Table (List).Next;
5086 Recursive_Dirs.Reset (Visited);
5087 end Find_Source_Dirs;
5089 -- Start of processing for Get_Directories
5091 Dir_Exists : Boolean;
5094 if Current_Verbosity = High then
5095 Write_Line ("Starting to look for directories");
5098 -- Set the object directory to its default which may be nil, if there
5099 -- is no sources in the project.
5101 if (((not Source_Files.Default)
5102 and then Source_Files.Values = Nil_String)
5104 ((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String)
5106 ((not Languages.Default) and then Languages.Values = Nil_String))
5107 and then Project.Extends = No_Project
5109 Project.Object_Directory := No_Path_Information;
5111 Project.Object_Directory := Project.Directory;
5114 -- Check the object directory
5116 if Object_Dir.Value /= Empty_String then
5117 Get_Name_String (Object_Dir.Value);
5119 if Name_Len = 0 then
5122 "Object_Dir cannot be empty",
5123 Object_Dir.Location, Project);
5126 -- We check that the specified object directory does exist.
5127 -- However, even when it doesn't exist, we set it to a default
5128 -- value. This is for the benefit of tools that recover from
5129 -- errors; for example, these tools could create the non existent
5130 -- directory. We always return an absolute directory name though.
5134 File_Name_Type (Object_Dir.Value),
5135 Path => Project.Object_Directory,
5137 Dir_Exists => Dir_Exists,
5139 Location => Object_Dir.Location,
5140 Must_Exist => False,
5141 Externally_Built => Project.Externally_Built);
5144 and then not Project.Externally_Built
5146 -- The object directory does not exist, report an error if
5147 -- the project is not externally built.
5149 Err_Vars.Error_Msg_File_1 :=
5150 File_Name_Type (Object_Dir.Value);
5152 case Data.Flags.Require_Obj_Dirs is
5156 "object directory { not found",
5157 Project.Location, Project);
5161 "?object directory { not found",
5162 Project.Location, Project);
5169 elsif Project.Object_Directory /= No_Path_Information
5170 and then Subdirs /= null
5173 Name_Buffer (1) := '.';
5177 Path => Project.Object_Directory,
5179 Dir_Exists => Dir_Exists,
5181 Location => Object_Dir.Location,
5182 Externally_Built => Project.Externally_Built);
5185 if Current_Verbosity = High then
5186 if Project.Object_Directory = No_Path_Information then
5187 Write_Line ("No object directory");
5190 ("Object directory",
5191 Get_Name_String (Project.Object_Directory.Display_Name));
5195 -- Check the exec directory
5197 -- We set the object directory to its default
5199 Project.Exec_Directory := Project.Object_Directory;
5201 if Exec_Dir.Value /= Empty_String then
5202 Get_Name_String (Exec_Dir.Value);
5204 if Name_Len = 0 then
5207 "Exec_Dir cannot be empty",
5208 Exec_Dir.Location, Project);
5211 -- We check that the specified exec directory does exist
5215 File_Name_Type (Exec_Dir.Value),
5216 Path => Project.Exec_Directory,
5217 Dir_Exists => Dir_Exists,
5220 Location => Exec_Dir.Location,
5221 Externally_Built => Project.Externally_Built);
5223 if not Dir_Exists then
5224 Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
5227 "exec directory { not found",
5228 Project.Location, Project);
5233 if Current_Verbosity = High then
5234 if Project.Exec_Directory = No_Path_Information then
5235 Write_Line ("No exec directory");
5237 Write_Str ("Exec directory: """);
5238 Write_Str (Get_Name_String (Project.Exec_Directory.Display_Name));
5243 -- Look for the source directories
5245 if Current_Verbosity = High then
5246 Write_Line ("Starting to look for source directories");
5249 pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
5251 if (not Source_Files.Default)
5252 and then Source_Files.Values = Nil_String
5254 Project.Source_Dirs := Nil_String;
5256 if Project.Qualifier = Standard then
5259 "a standard project cannot have no sources",
5260 Source_Files.Location, Project);
5263 elsif Source_Dirs.Default then
5265 -- No Source_Dirs specified: the single source directory is the one
5266 -- containing the project file.
5268 String_Element_Table.Append (Data.Tree.String_Elements,
5269 (Value => Name_Id (Project.Directory.Name),
5270 Display_Value => Name_Id (Project.Directory.Display_Name),
5271 Location => No_Location,
5276 Project.Source_Dirs :=
5277 String_Element_Table.Last (Data.Tree.String_Elements);
5279 if Current_Verbosity = High then
5281 ("Default source directory",
5282 Get_Name_String (Project.Directory.Display_Name));
5285 elsif Source_Dirs.Values = Nil_String then
5286 if Project.Qualifier = Standard then
5289 "a standard project cannot have no source directories",
5290 Source_Dirs.Location, Project);
5293 Project.Source_Dirs := Nil_String;
5297 Source_Dir : String_List_Id;
5298 Element : String_Element;
5301 -- Process the source directories for each element of the list
5303 Source_Dir := Source_Dirs.Values;
5304 while Source_Dir /= Nil_String loop
5305 Element := Data.Tree.String_Elements.Table (Source_Dir);
5307 (File_Name_Type (Element.Value), Element.Location);
5308 Source_Dir := Element.Next;
5313 if not Excluded_Source_Dirs.Default
5314 and then Excluded_Source_Dirs.Values /= Nil_String
5317 Source_Dir : String_List_Id;
5318 Element : String_Element;
5321 -- Process the source directories for each element of the list
5323 Source_Dir := Excluded_Source_Dirs.Values;
5324 while Source_Dir /= Nil_String loop
5325 Element := Data.Tree.String_Elements.Table (Source_Dir);
5327 (File_Name_Type (Element.Value),
5330 Source_Dir := Element.Next;
5335 if Current_Verbosity = High then
5336 Write_Line ("Putting source directories in canonical cases");
5340 Current : String_List_Id := Project.Source_Dirs;
5341 Element : String_Element;
5344 while Current /= Nil_String loop
5345 Element := Data.Tree.String_Elements.Table (Current);
5346 if Element.Value /= No_Name then
5348 Name_Id (Canonical_Case_File_Name (Name_Id (Element.Value)));
5349 Data.Tree.String_Elements.Table (Current) := Element;
5352 Current := Element.Next;
5355 end Get_Directories;
5362 (Project : Project_Id;
5363 Data : in out Tree_Processing_Data)
5365 Mains : constant Variable_Value :=
5367 (Name_Main, Project.Decl.Attributes, Data.Tree);
5368 List : String_List_Id;
5369 Elem : String_Element;
5372 Project.Mains := Mains.Values;
5374 -- If no Mains were specified, and if we are an extending project,
5375 -- inherit the Mains from the project we are extending.
5377 if Mains.Default then
5378 if not Project.Library and then Project.Extends /= No_Project then
5379 Project.Mains := Project.Extends.Mains;
5382 -- In a library project file, Main cannot be specified
5384 elsif Project.Library then
5387 "a library project file cannot have Main specified",
5388 Mains.Location, Project);
5391 List := Mains.Values;
5392 while List /= Nil_String loop
5393 Elem := Data.Tree.String_Elements.Table (List);
5395 if Length_Of_Name (Elem.Value) = 0 then
5398 "?a main cannot have an empty name",
5399 Elem.Location, Project);
5408 ---------------------------
5409 -- Get_Sources_From_File --
5410 ---------------------------
5412 procedure Get_Sources_From_File
5414 Location : Source_Ptr;
5415 Project : in out Project_Processing_Data;
5416 Data : in out Tree_Processing_Data)
5418 File : Prj.Util.Text_File;
5419 Line : String (1 .. 250);
5421 Source_Name : File_Name_Type;
5422 Name_Loc : Name_Location;
5425 if Current_Verbosity = High then
5426 Write_Str ("Opening """);
5433 Prj.Util.Open (File, Path);
5435 if not Prj.Util.Is_Valid (File) then
5437 (Data.Flags, "file does not exist", Location, Project.Project);
5440 -- Read the lines one by one
5442 while not Prj.Util.End_Of_File (File) loop
5443 Prj.Util.Get_Line (File, Line, Last);
5445 -- A non empty, non comment line should contain a file name
5448 and then (Last = 1 or else Line (1 .. 2) /= "--")
5451 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
5452 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
5453 Source_Name := Name_Find;
5455 -- Check that there is no directory information
5457 for J in 1 .. Last loop
5458 if Line (J) = '/' or else Line (J) = Directory_Separator then
5459 Error_Msg_File_1 := Source_Name;
5462 "file name cannot include directory information ({)",
5463 Location, Project.Project);
5468 Name_Loc := Source_Names_Htable.Get
5469 (Project.Source_Names, Source_Name);
5471 if Name_Loc = No_Name_Location then
5473 (Name => Source_Name,
5474 Location => Location,
5475 Source => No_Source,
5479 Source_Names_Htable.Set
5480 (Project.Source_Names, Source_Name, Name_Loc);
5484 Prj.Util.Close (File);
5487 end Get_Sources_From_File;
5489 -----------------------
5490 -- Compute_Unit_Name --
5491 -----------------------
5493 procedure Compute_Unit_Name
5494 (File_Name : File_Name_Type;
5495 Naming : Lang_Naming_Data;
5496 Kind : out Source_Kind;
5498 Project : Project_Processing_Data;
5499 In_Tree : Project_Tree_Ref)
5501 Filename : constant String := Get_Name_String (File_Name);
5502 Last : Integer := Filename'Last;
5507 Unit_Except : Unit_Exception;
5508 Masked : Boolean := False;
5514 if Naming.Separate_Suffix = No_File
5515 or else Naming.Body_Suffix = No_File
5516 or else Naming.Spec_Suffix = No_File
5521 if Naming.Dot_Replacement = No_File then
5522 if Current_Verbosity = High then
5523 Write_Line (" No dot_replacement specified");
5529 Sep_Len := Integer (Length_Of_Name (Naming.Separate_Suffix));
5530 Spec_Len := Integer (Length_Of_Name (Naming.Spec_Suffix));
5531 Body_Len := Integer (Length_Of_Name (Naming.Body_Suffix));
5533 -- Choose the longest suffix that matches. If there are several matches,
5534 -- give priority to specs, then bodies, then separates.
5536 if Naming.Separate_Suffix /= Naming.Body_Suffix
5537 and then Suffix_Matches (Filename, Naming.Separate_Suffix)
5539 Last := Filename'Last - Sep_Len;
5543 if Filename'Last - Body_Len <= Last
5544 and then Suffix_Matches (Filename, Naming.Body_Suffix)
5546 Last := Natural'Min (Last, Filename'Last - Body_Len);
5550 if Filename'Last - Spec_Len <= Last
5551 and then Suffix_Matches (Filename, Naming.Spec_Suffix)
5553 Last := Natural'Min (Last, Filename'Last - Spec_Len);
5557 if Last = Filename'Last then
5558 if Current_Verbosity = High then
5559 Write_Line (" no matching suffix");
5565 -- Check that the casing matches
5567 if File_Names_Case_Sensitive then
5568 case Naming.Casing is
5569 when All_Lower_Case =>
5570 for J in Filename'First .. Last loop
5571 if Is_Letter (Filename (J))
5572 and then not Is_Lower (Filename (J))
5574 if Current_Verbosity = High then
5575 Write_Line (" Invalid casing");
5582 when All_Upper_Case =>
5583 for J in Filename'First .. Last loop
5584 if Is_Letter (Filename (J))
5585 and then not Is_Upper (Filename (J))
5587 if Current_Verbosity = High then
5588 Write_Line (" Invalid casing");
5595 when Mixed_Case | Unknown =>
5600 -- If Dot_Replacement is not a single dot, then there should not
5601 -- be any dot in the name.
5604 Dot_Repl : constant String :=
5605 Get_Name_String (Naming.Dot_Replacement);
5608 if Dot_Repl /= "." then
5609 for Index in Filename'First .. Last loop
5610 if Filename (Index) = '.' then
5611 if Current_Verbosity = High then
5612 Write_Line (" Invalid name, contains dot");
5619 Replace_Into_Name_Buffer
5620 (Filename (Filename'First .. Last), Dot_Repl, '.');
5623 Name_Len := Last - Filename'First + 1;
5624 Name_Buffer (1 .. Name_Len) := Filename (Filename'First .. Last);
5626 (Source => Name_Buffer (1 .. Name_Len),
5627 Mapping => Lower_Case_Map);
5631 -- In the standard GNAT naming scheme, check for special cases: children
5632 -- or separates of A, G, I or S, and run time sources.
5634 if Is_Standard_GNAT_Naming (Naming)
5635 and then Name_Len >= 3
5638 S1 : constant Character := Name_Buffer (1);
5639 S2 : constant Character := Name_Buffer (2);
5640 S3 : constant Character := Name_Buffer (3);
5648 -- Children or separates of packages A, G, I or S. These names
5649 -- are x__ ... or x~... (where x is a, g, i, or s). Both
5650 -- versions (x__... and x~...) are allowed in all platforms,
5651 -- because it is not possible to know the platform before
5652 -- processing of the project files.
5654 if S2 = '_' and then S3 = '_' then
5655 Name_Buffer (2) := '.';
5656 Name_Buffer (3 .. Name_Len - 1) :=
5657 Name_Buffer (4 .. Name_Len);
5658 Name_Len := Name_Len - 1;
5661 Name_Buffer (2) := '.';
5665 -- If it is potentially a run time source
5673 -- Name_Buffer contains the name of the the unit in lower-cases. Check
5674 -- that this is a valid unit name
5676 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
5678 -- If there is a naming exception for the same unit, the file is not
5679 -- a source for the unit.
5681 if Unit /= No_Name then
5683 Unit_Exceptions_Htable.Get (Project.Unit_Exceptions, Unit);
5686 Masked := Unit_Except.Spec /= No_File
5688 Unit_Except.Spec /= File_Name;
5690 Masked := Unit_Except.Impl /= No_File
5692 Unit_Except.Impl /= File_Name;
5696 if Current_Verbosity = High then
5697 Write_Str (" """ & Filename & """ contains the ");
5700 Write_Str ("spec of a unit found in """);
5701 Write_Str (Get_Name_String (Unit_Except.Spec));
5703 Write_Str ("body of a unit found in """);
5704 Write_Str (Get_Name_String (Unit_Except.Impl));
5707 Write_Line (""" (ignored)");
5715 and then Current_Verbosity = High
5718 when Spec => Write_Str (" spec of ");
5719 when Impl => Write_Str (" body of ");
5720 when Sep => Write_Str (" sep of ");
5723 Write_Line (Get_Name_String (Unit));
5725 end Compute_Unit_Name;
5727 --------------------------
5728 -- Check_Illegal_Suffix --
5729 --------------------------
5731 procedure Check_Illegal_Suffix
5732 (Project : Project_Id;
5733 Suffix : File_Name_Type;
5734 Dot_Replacement : File_Name_Type;
5735 Attribute_Name : String;
5736 Location : Source_Ptr;
5737 Data : in out Tree_Processing_Data)
5739 Suffix_Str : constant String := Get_Name_String (Suffix);
5742 if Suffix_Str'Length = 0 then
5748 elsif Index (Suffix_Str, ".") = 0 then
5749 Err_Vars.Error_Msg_File_1 := Suffix;
5752 "{ is illegal for " & Attribute_Name & ": must have a dot",
5757 -- Case of dot replacement is a single dot, and first character of
5758 -- suffix is also a dot.
5760 if Dot_Replacement /= No_File
5761 and then Get_Name_String (Dot_Replacement) = "."
5762 and then Suffix_Str (Suffix_Str'First) = '.'
5764 for Index in Suffix_Str'First + 1 .. Suffix_Str'Last loop
5766 -- If there are multiple dots in the name
5768 if Suffix_Str (Index) = '.' then
5770 -- It is illegal to have a letter following the initial dot
5772 if Is_Letter (Suffix_Str (Suffix_Str'First + 1)) then
5773 Err_Vars.Error_Msg_File_1 := Suffix;
5776 "{ is illegal for " & Attribute_Name
5777 & ": ambiguous prefix when Dot_Replacement is a dot",
5784 end Check_Illegal_Suffix;
5786 ----------------------
5787 -- Locate_Directory --
5788 ----------------------
5790 procedure Locate_Directory
5791 (Project : Project_Id;
5792 Name : File_Name_Type;
5793 Path : out Path_Information;
5794 Dir_Exists : out Boolean;
5795 Data : in out Tree_Processing_Data;
5796 Create : String := "";
5797 Location : Source_Ptr := No_Location;
5798 Must_Exist : Boolean := True;
5799 Externally_Built : Boolean := False)
5801 Parent : constant Path_Name_Type :=
5802 Project.Directory.Display_Name;
5803 The_Parent : constant String :=
5804 Get_Name_String (Parent);
5805 The_Parent_Last : constant Natural :=
5806 Compute_Directory_Last (The_Parent);
5807 Full_Name : File_Name_Type;
5808 The_Name : File_Name_Type;
5811 Get_Name_String (Name);
5813 -- Add Subdirs.all if it is a directory that may be created and
5814 -- Subdirs is not null;
5816 if Create /= "" and then Subdirs /= null then
5817 if Name_Buffer (Name_Len) /= Directory_Separator then
5818 Add_Char_To_Name_Buffer (Directory_Separator);
5821 Add_Str_To_Name_Buffer (Subdirs.all);
5824 -- Convert '/' to directory separator (for Windows)
5826 for J in 1 .. Name_Len loop
5827 if Name_Buffer (J) = '/' then
5828 Name_Buffer (J) := Directory_Separator;
5832 The_Name := Name_Find;
5834 if Current_Verbosity = High then
5835 Write_Str ("Locate_Directory (""");
5836 Write_Str (Get_Name_String (The_Name));
5837 Write_Str (""", """);
5838 Write_Str (The_Parent);
5842 Path := No_Path_Information;
5843 Dir_Exists := False;
5845 if Is_Absolute_Path (Get_Name_String (The_Name)) then
5846 Full_Name := The_Name;
5850 Add_Str_To_Name_Buffer
5851 (The_Parent (The_Parent'First .. The_Parent_Last));
5852 Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
5853 Full_Name := Name_Find;
5857 Full_Path_Name : String_Access :=
5858 new String'(Get_Name_String (Full_Name));
5861 if (Setup_Projects or else Subdirs /= null)
5862 and then Create'Length > 0
5864 if not Is_Directory (Full_Path_Name.all) then
5866 -- If project is externally built, do not create a subdir,
5867 -- use the specified directory, without the subdir.
5869 if Externally_Built then
5870 if Is_Absolute_Path (Get_Name_String (Name)) then
5871 Get_Name_String (Name);
5875 Add_Str_To_Name_Buffer
5876 (The_Parent (The_Parent'First .. The_Parent_Last));
5877 Add_Str_To_Name_Buffer (Get_Name_String (Name));
5880 Full_Path_Name := new String'(Name_Buffer (1 .. Name_Len));
5884 Create_Path (Full_Path_Name.all);
5886 if not Quiet_Output then
5888 Write_Str (" directory """);
5889 Write_Str (Full_Path_Name.all);
5890 Write_Str (""" created for project ");
5891 Write_Line (Get_Name_String (Project.Name));
5898 "could not create " & Create &
5899 " directory " & Full_Path_Name.all,
5906 Dir_Exists := Is_Directory (Full_Path_Name.all);
5908 if not Must_Exist or else Dir_Exists then
5910 Normed : constant String :=
5912 (Full_Path_Name.all,
5914 The_Parent (The_Parent'First .. The_Parent_Last),
5915 Resolve_Links => False,
5916 Case_Sensitive => True);
5918 Canonical_Path : constant String :=
5923 (The_Parent'First .. The_Parent_Last),
5925 Opt.Follow_Links_For_Dirs,
5926 Case_Sensitive => False);
5929 Name_Len := Normed'Length;
5930 Name_Buffer (1 .. Name_Len) := Normed;
5932 -- Directories should always end with a directory separator
5934 if Name_Buffer (Name_Len) /= Directory_Separator then
5935 Add_Char_To_Name_Buffer (Directory_Separator);
5938 Path.Display_Name := Name_Find;
5940 Name_Len := Canonical_Path'Length;
5941 Name_Buffer (1 .. Name_Len) := Canonical_Path;
5943 if Name_Buffer (Name_Len) /= Directory_Separator then
5944 Add_Char_To_Name_Buffer (Directory_Separator);
5947 Path.Name := Name_Find;
5951 Free (Full_Path_Name);
5953 end Locate_Directory;
5955 ---------------------------
5956 -- Find_Excluded_Sources --
5957 ---------------------------
5959 procedure Find_Excluded_Sources
5960 (Project : in out Project_Processing_Data;
5961 Data : in out Tree_Processing_Data)
5963 Excluded_Source_List_File : constant Variable_Value :=
5965 (Name_Excluded_Source_List_File,
5966 Project.Project.Decl.Attributes,
5968 Excluded_Sources : Variable_Value := Util.Value_Of
5969 (Name_Excluded_Source_Files,
5970 Project.Project.Decl.Attributes,
5973 Current : String_List_Id;
5974 Element : String_Element;
5975 Location : Source_Ptr;
5976 Name : File_Name_Type;
5977 File : Prj.Util.Text_File;
5978 Line : String (1 .. 300);
5980 Locally_Removed : Boolean := False;
5983 -- If Excluded_Source_Files is not declared, check Locally_Removed_Files
5985 if Excluded_Sources.Default then
5986 Locally_Removed := True;
5989 (Name_Locally_Removed_Files,
5990 Project.Project.Decl.Attributes, Data.Tree);
5993 -- If there are excluded sources, put them in the table
5995 if not Excluded_Sources.Default then
5996 if not Excluded_Source_List_File.Default then
5997 if Locally_Removed then
6000 "?both attributes Locally_Removed_Files and " &
6001 "Excluded_Source_List_File are present",
6002 Excluded_Source_List_File.Location, Project.Project);
6006 "?both attributes Excluded_Source_Files and " &
6007 "Excluded_Source_List_File are present",
6008 Excluded_Source_List_File.Location, Project.Project);
6012 Current := Excluded_Sources.Values;
6013 while Current /= Nil_String loop
6014 Element := Data.Tree.String_Elements.Table (Current);
6015 Name := Canonical_Case_File_Name (Element.Value);
6017 -- If the element has no location, then use the location of
6018 -- Excluded_Sources to report possible errors.
6020 if Element.Location = No_Location then
6021 Location := Excluded_Sources.Location;
6023 Location := Element.Location;
6026 Excluded_Sources_Htable.Set
6027 (Project.Excluded, Name, (Name, False, Location));
6028 Current := Element.Next;
6031 elsif not Excluded_Source_List_File.Default then
6032 Location := Excluded_Source_List_File.Location;
6035 Source_File_Path_Name : constant String :=
6038 (Excluded_Source_List_File.Value),
6039 Project.Project.Directory.Name);
6042 if Source_File_Path_Name'Length = 0 then
6043 Err_Vars.Error_Msg_File_1 :=
6044 File_Name_Type (Excluded_Source_List_File.Value);
6047 "file with excluded sources { does not exist",
6048 Excluded_Source_List_File.Location, Project.Project);
6053 Prj.Util.Open (File, Source_File_Path_Name);
6055 if not Prj.Util.Is_Valid (File) then
6057 (Data.Flags, "file does not exist",
6058 Location, Project.Project);
6060 -- Read the lines one by one
6062 while not Prj.Util.End_Of_File (File) loop
6063 Prj.Util.Get_Line (File, Line, Last);
6065 -- Non empty, non comment line should contain a file name
6068 and then (Last = 1 or else Line (1 .. 2) /= "--")
6071 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6072 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6075 -- Check that there is no directory information
6077 for J in 1 .. Last loop
6079 or else Line (J) = Directory_Separator
6081 Error_Msg_File_1 := Name;
6084 "file name cannot include " &
6085 "directory information ({)",
6086 Location, Project.Project);
6091 Excluded_Sources_Htable.Set
6092 (Project.Excluded, Name, (Name, False, Location));
6096 Prj.Util.Close (File);
6101 end Find_Excluded_Sources;
6107 procedure Find_Sources
6108 (Project : in out Project_Processing_Data;
6109 Data : in out Tree_Processing_Data)
6111 Sources : constant Variable_Value :=
6114 Project.Project.Decl.Attributes,
6117 Source_List_File : constant Variable_Value :=
6119 (Name_Source_List_File,
6120 Project.Project.Decl.Attributes,
6123 Name_Loc : Name_Location;
6124 Has_Explicit_Sources : Boolean;
6127 pragma Assert (Sources.Kind = List, "Source_Files is not a list");
6129 (Source_List_File.Kind = Single,
6130 "Source_List_File is not a single string");
6132 Project.Source_List_File_Location := Source_List_File.Location;
6134 -- If the user has specified a Source_Files attribute
6136 if not Sources.Default then
6137 if not Source_List_File.Default then
6140 "?both attributes source_files and " &
6141 "source_list_file are present",
6142 Source_List_File.Location, Project.Project);
6145 -- Sources is a list of file names
6148 Current : String_List_Id := Sources.Values;
6149 Element : String_Element;
6150 Location : Source_Ptr;
6151 Name : File_Name_Type;
6154 if Current = Nil_String then
6155 Project.Project.Languages := No_Language_Index;
6157 -- This project contains no source. For projects that don't
6158 -- extend other projects, this also means that there is no
6159 -- need for an object directory, if not specified.
6161 if Project.Project.Extends = No_Project
6162 and then Project.Project.Object_Directory =
6163 Project.Project.Directory
6165 Project.Project.Object_Directory := No_Path_Information;
6169 while Current /= Nil_String loop
6170 Element := Data.Tree.String_Elements.Table (Current);
6171 Name := Canonical_Case_File_Name (Element.Value);
6172 Get_Name_String (Element.Value);
6174 -- If the element has no location, then use the location of
6175 -- Sources to report possible errors.
6177 if Element.Location = No_Location then
6178 Location := Sources.Location;
6180 Location := Element.Location;
6183 -- Check that there is no directory information
6185 for J in 1 .. Name_Len loop
6186 if Name_Buffer (J) = '/'
6187 or else Name_Buffer (J) = Directory_Separator
6189 Error_Msg_File_1 := Name;
6192 "file name cannot include directory " &
6194 Location, Project.Project);
6199 -- Check whether the file is already there: the same file name
6200 -- may be in the list. If the source is missing, the error will
6201 -- be on the first mention of the source file name.
6203 Name_Loc := Source_Names_Htable.Get
6204 (Project.Source_Names, Name);
6206 if Name_Loc = No_Name_Location then
6209 Location => Location,
6210 Source => No_Source,
6212 Source_Names_Htable.Set
6213 (Project.Source_Names, Name, Name_Loc);
6216 Current := Element.Next;
6219 Has_Explicit_Sources := True;
6222 -- If we have no Source_Files attribute, check the Source_List_File
6225 elsif not Source_List_File.Default then
6227 -- Source_List_File is the name of the file that contains the source
6231 Source_File_Path_Name : constant String :=
6233 (File_Name_Type (Source_List_File.Value),
6234 Project.Project.Directory.Name);
6237 Has_Explicit_Sources := True;
6239 if Source_File_Path_Name'Length = 0 then
6240 Err_Vars.Error_Msg_File_1 :=
6241 File_Name_Type (Source_List_File.Value);
6244 "file with sources { does not exist",
6245 Source_List_File.Location, Project.Project);
6248 Get_Sources_From_File
6249 (Source_File_Path_Name, Source_List_File.Location,
6255 -- Neither Source_Files nor Source_List_File has been specified. Find
6256 -- all the files that satisfy the naming scheme in all the source
6259 Has_Explicit_Sources := False;
6265 For_All_Sources => Sources.Default and then Source_List_File.Default);
6267 -- Check if all exceptions have been found
6271 Iter : Source_Iterator;
6274 Iter := For_Each_Source (Data.Tree, Project.Project);
6276 Source := Prj.Element (Iter);
6277 exit when Source = No_Source;
6279 if Source.Naming_Exception
6280 and then Source.Path = No_Path_Information
6282 if Source.Unit /= No_Unit_Index then
6284 -- For multi-unit source files, source_id gets duplicated
6285 -- once for every unit. Only the first source_id got its
6286 -- full path set. So if it isn't set for that first one,
6287 -- the file wasn't found. Otherwise we need to update for
6288 -- units after the first one.
6291 or else Source.Index = 1
6293 Error_Msg_Name_1 := Name_Id (Source.Display_File);
6294 Error_Msg_Name_2 := Name_Id (Source.Unit.Name);
6297 "source file %% for unit %% not found",
6298 No_Location, Project.Project);
6301 Source.Path := Files_Htable.Get
6302 (Data.File_To_Source, Source.File).Path;
6304 if Current_Verbosity = High then
6305 if Source.Path /= No_Path_Information then
6306 Write_Line ("Setting full path for "
6307 & Get_Name_String (Source.File)
6308 & " at" & Source.Index'Img
6310 & Get_Name_String (Source.Path.Name));
6316 if Source.Path = No_Path_Information then
6317 Remove_Source (Source, No_Source);
6325 -- It is an error if a source file name in a source list or in a source
6326 -- list file is not found.
6328 if Has_Explicit_Sources then
6331 First_Error : Boolean;
6334 NL := Source_Names_Htable.Get_First (Project.Source_Names);
6335 First_Error := True;
6336 while NL /= No_Name_Location loop
6337 if not NL.Found then
6338 Err_Vars.Error_Msg_File_1 := NL.Name;
6343 "source file { not found",
6344 NL.Location, Project.Project);
6345 First_Error := False;
6350 "\source file { not found",
6351 NL.Location, Project.Project);
6355 NL := Source_Names_Htable.Get_Next (Project.Source_Names);
6365 procedure Initialize
6366 (Data : out Tree_Processing_Data;
6367 Tree : Project_Tree_Ref;
6368 Flags : Prj.Processing_Flags)
6371 Files_Htable.Reset (Data.File_To_Source);
6373 Data.Flags := Flags;
6380 procedure Free (Data : in out Tree_Processing_Data) is
6382 Files_Htable.Reset (Data.File_To_Source);
6389 procedure Initialize
6390 (Data : in out Project_Processing_Data;
6391 Project : Project_Id)
6394 Data.Project := Project;
6401 procedure Free (Data : in out Project_Processing_Data) is
6403 Source_Names_Htable.Reset (Data.Source_Names);
6404 Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions);
6405 Excluded_Sources_Htable.Reset (Data.Excluded);
6408 -------------------------------
6409 -- Check_File_Naming_Schemes --
6410 -------------------------------
6412 procedure Check_File_Naming_Schemes
6413 (In_Tree : Project_Tree_Ref;
6414 Project : Project_Processing_Data;
6415 File_Name : File_Name_Type;
6416 Alternate_Languages : out Language_List;
6417 Language : out Language_Ptr;
6418 Display_Language_Name : out Name_Id;
6420 Lang_Kind : out Language_Kind;
6421 Kind : out Source_Kind)
6423 Filename : constant String := Get_Name_String (File_Name);
6424 Config : Language_Config;
6425 Tmp_Lang : Language_Ptr;
6427 Header_File : Boolean := False;
6428 -- True if we found at least one language for which the file is a header
6429 -- In such a case, we search for all possible languages where this is
6430 -- also a header (C and C++ for instance), since the file might be used
6431 -- for several such languages.
6433 procedure Check_File_Based_Lang;
6434 -- Does the naming scheme test for file-based languages. For those,
6435 -- there is no Unit. Just check if the file name has the implementation
6436 -- or, if it is specified, the template suffix of the language.
6438 -- Returns True if the file belongs to the current language and we
6439 -- should stop searching for matching languages. Not that a given header
6440 -- file could belong to several languages (C and C++ for instance). Thus
6441 -- if we found a header we'll check whether it matches other languages.
6443 ---------------------------
6444 -- Check_File_Based_Lang --
6445 ---------------------------
6447 procedure Check_File_Based_Lang is
6450 and then Suffix_Matches (Filename, Config.Naming_Data.Body_Suffix)
6454 Language := Tmp_Lang;
6456 if Current_Verbosity = High then
6457 Write_Str (" implementation of language ");
6458 Write_Line (Get_Name_String (Display_Language_Name));
6461 elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
6462 if Current_Verbosity = High then
6463 Write_Str (" header of language ");
6464 Write_Line (Get_Name_String (Display_Language_Name));
6468 Alternate_Languages := new Language_List_Element'
6469 (Language => Language,
6470 Next => Alternate_Languages);
6473 Header_File := True;
6476 Language := Tmp_Lang;
6479 end Check_File_Based_Lang;
6481 -- Start of processing for Check_File_Naming_Schemes
6484 Language := No_Language_Index;
6485 Alternate_Languages := null;
6486 Display_Language_Name := No_Name;
6488 Lang_Kind := File_Based;
6491 Tmp_Lang := Project.Project.Languages;
6492 while Tmp_Lang /= No_Language_Index loop
6493 if Current_Verbosity = High then
6495 (" Testing language "
6496 & Get_Name_String (Tmp_Lang.Name)
6497 & " Header_File=" & Header_File'Img);
6500 Display_Language_Name := Tmp_Lang.Display_Name;
6501 Config := Tmp_Lang.Config;
6502 Lang_Kind := Config.Kind;
6506 Check_File_Based_Lang;
6507 exit when Kind = Impl;
6511 -- We know it belongs to a least a file_based language, no
6512 -- need to check unit-based ones.
6514 if not Header_File then
6516 (File_Name => File_Name,
6517 Naming => Config.Naming_Data,
6521 In_Tree => In_Tree);
6523 if Unit /= No_Name then
6524 Language := Tmp_Lang;
6530 Tmp_Lang := Tmp_Lang.Next;
6533 if Language = No_Language_Index
6534 and then Current_Verbosity = High
6536 Write_Line (" not a source of any language");
6538 end Check_File_Naming_Schemes;
6544 procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is
6546 -- If the file was previously already associated with a unit, change it
6548 if Source.Unit /= null
6549 and then Source.Kind in Spec_Or_Body
6550 and then Source.Unit.File_Names (Source.Kind) /= null
6552 -- If we had another file referencing the same unit (for instance it
6553 -- was in an extended project), that source file is in fact invisible
6554 -- from now on, and in particular doesn't belong to the same unit.
6556 if Source.Unit.File_Names (Source.Kind) /= Source then
6557 Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
6560 Source.Unit.File_Names (Source.Kind) := null;
6563 Source.Kind := Kind;
6565 if Current_Verbosity = High
6566 and then Source.File /= No_File
6568 Write_Line ("Override kind for "
6569 & Get_Name_String (Source.File)
6570 & " kind=" & Source.Kind'Img);
6573 if Source.Kind in Spec_Or_Body and then Source.Unit /= null then
6574 Source.Unit.File_Names (Source.Kind) := Source;
6582 procedure Check_File
6583 (Project : in out Project_Processing_Data;
6584 Data : in out Tree_Processing_Data;
6585 Path : Path_Name_Type;
6586 File_Name : File_Name_Type;
6587 Display_File_Name : File_Name_Type;
6588 Locally_Removed : Boolean;
6589 For_All_Sources : Boolean)
6591 Canonical_Path : constant Path_Name_Type :=
6593 (Canonical_Case_File_Name (Name_Id (Path)));
6595 Name_Loc : Name_Location :=
6596 Source_Names_Htable.Get
6597 (Project.Source_Names, File_Name);
6598 Check_Name : Boolean := False;
6599 Alternate_Languages : Language_List;
6600 Language : Language_Ptr;
6602 Src_Ind : Source_File_Index;
6604 Display_Language_Name : Name_Id;
6605 Lang_Kind : Language_Kind;
6606 Kind : Source_Kind := Spec;
6609 if Name_Loc = No_Name_Location then
6610 Check_Name := For_All_Sources;
6613 if Name_Loc.Found then
6615 -- Check if it is OK to have the same file name in several
6616 -- source directories.
6618 if not Project.Project.Known_Order_Of_Source_Dirs then
6619 Error_Msg_File_1 := File_Name;
6622 "{ is found in several source directories",
6623 Name_Loc.Location, Project.Project);
6627 Name_Loc.Found := True;
6629 Source_Names_Htable.Set
6630 (Project.Source_Names, File_Name, Name_Loc);
6632 if Name_Loc.Source = No_Source then
6636 Name_Loc.Source.Path := (Canonical_Path, Path);
6638 Source_Paths_Htable.Set
6639 (Data.Tree.Source_Paths_HT,
6643 -- Check if this is a subunit
6645 if Name_Loc.Source.Unit /= No_Unit_Index
6646 and then Name_Loc.Source.Kind = Impl
6648 Src_Ind := Sinput.P.Load_Project_File
6649 (Get_Name_String (Canonical_Path));
6651 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
6652 Override_Kind (Name_Loc.Source, Sep);
6657 (Data.File_To_Source, File_Name, Name_Loc.Source);
6663 Check_File_Naming_Schemes
6664 (In_Tree => Data.Tree,
6666 File_Name => File_Name,
6667 Alternate_Languages => Alternate_Languages,
6668 Language => Language,
6669 Display_Language_Name => Display_Language_Name,
6671 Lang_Kind => Lang_Kind,
6674 if Language = No_Language_Index then
6676 -- A file name in a list must be a source of a language
6678 if Data.Flags.Error_On_Unknown_Language
6679 and then Name_Loc.Found
6681 Error_Msg_File_1 := File_Name;
6684 "language unknown for {",
6685 Name_Loc.Location, Project.Project);
6691 Project => Project.Project,
6692 Lang_Id => Language,
6695 Alternate_Languages => Alternate_Languages,
6696 File_Name => File_Name,
6697 Display_File => Display_File_Name,
6699 Locally_Removed => Locally_Removed,
6700 Path => (Canonical_Path, Path));
6705 ------------------------
6706 -- Search_Directories --
6707 ------------------------
6709 procedure Search_Directories
6710 (Project : in out Project_Processing_Data;
6711 Data : in out Tree_Processing_Data;
6712 For_All_Sources : Boolean)
6714 Source_Dir : String_List_Id;
6715 Element : String_Element;
6717 Name : String (1 .. 1_000);
6719 File_Name : File_Name_Type;
6720 Display_File_Name : File_Name_Type;
6723 if Current_Verbosity = High then
6724 Write_Line ("Looking for sources:");
6727 -- Loop through subdirectories
6729 Source_Dir := Project.Project.Source_Dirs;
6730 while Source_Dir /= Nil_String loop
6732 Element := Data.Tree.String_Elements.Table (Source_Dir);
6733 if Element.Value /= No_Name then
6734 Get_Name_String (Element.Display_Value);
6737 Source_Directory : constant String :=
6738 Name_Buffer (1 .. Name_Len) &
6739 Directory_Separator;
6741 Dir_Last : constant Natural :=
6742 Compute_Directory_Last
6746 if Current_Verbosity = High then
6747 Write_Attr ("Source_Dir", Source_Directory);
6750 -- We look to every entry in the source directory
6752 Open (Dir, Source_Directory);
6755 Read (Dir, Name, Last);
6759 -- ??? Duplicate system call here, we just did a a
6760 -- similar one. Maybe Ada.Directories would be more
6761 -- appropriate here.
6764 (Source_Directory & Name (1 .. Last))
6766 if Current_Verbosity = High then
6767 Write_Str (" Checking ");
6768 Write_Line (Name (1 .. Last));
6772 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
6773 Display_File_Name := Name_Find;
6775 if Osint.File_Names_Case_Sensitive then
6776 File_Name := Display_File_Name;
6778 Canonical_Case_File_Name
6779 (Name_Buffer (1 .. Name_Len));
6780 File_Name := Name_Find;
6784 Path_Name : constant String :=
6789 (Source_Directory'First ..
6792 Opt.Follow_Links_For_Files,
6793 Case_Sensitive => True);
6794 -- Case_Sensitive set True (no folding)
6796 Path : Path_Name_Type;
6797 FF : File_Found := Excluded_Sources_Htable.Get
6798 (Project.Excluded, File_Name);
6799 To_Remove : Boolean := False;
6802 Name_Len := Path_Name'Length;
6803 Name_Buffer (1 .. Name_Len) := Path_Name;
6806 if FF /= No_File_Found then
6807 if not FF.Found then
6809 Excluded_Sources_Htable.Set
6810 (Project.Excluded, File_Name, FF);
6812 if Current_Verbosity = High then
6813 Write_Str (" excluded source """);
6814 Write_Str (Get_Name_String (File_Name));
6818 -- Will mark the file as removed, but we
6819 -- still need to add it to the list: if we
6820 -- don't, the file will not appear in the
6821 -- mapping file and will cause the compiler
6829 (Project => Project,
6832 File_Name => File_Name,
6833 Locally_Removed => To_Remove,
6834 Display_File_Name => Display_File_Name,
6835 For_All_Sources => For_All_Sources);
6845 when Directory_Error =>
6849 Source_Dir := Element.Next;
6852 if Current_Verbosity = High then
6853 Write_Line ("end Looking for sources.");
6855 end Search_Directories;
6857 ----------------------------
6858 -- Load_Naming_Exceptions --
6859 ----------------------------
6861 procedure Load_Naming_Exceptions
6862 (Project : in out Project_Processing_Data;
6863 Data : in out Tree_Processing_Data)
6866 Iter : Source_Iterator;
6869 Iter := For_Each_Source (Data.Tree, Project.Project);
6871 Source := Prj.Element (Iter);
6872 exit when Source = No_Source;
6874 -- An excluded file cannot also be an exception file name
6876 if Excluded_Sources_Htable.Get (Project.Excluded, Source.File) /=
6879 Error_Msg_File_1 := Source.File;
6882 "{ cannot be both excluded and an exception file name",
6883 No_Location, Project.Project);
6886 if Current_Verbosity = High then
6887 Write_Str ("Naming exception: Putting source file ");
6888 Write_Str (Get_Name_String (Source.File));
6889 Write_Line (" in Source_Names");
6892 Source_Names_Htable.Set
6893 (Project.Source_Names,
6896 (Name => Source.File,
6897 Location => No_Location,
6901 -- If this is an Ada exception, record in table Unit_Exceptions
6903 if Source.Unit /= No_Unit_Index then
6905 Unit_Except : Unit_Exception :=
6906 Unit_Exceptions_Htable.Get
6907 (Project.Unit_Exceptions, Source.Unit.Name);
6910 Unit_Except.Name := Source.Unit.Name;
6912 if Source.Kind = Spec then
6913 Unit_Except.Spec := Source.File;
6915 Unit_Except.Impl := Source.File;
6918 Unit_Exceptions_Htable.Set
6919 (Project.Unit_Exceptions, Source.Unit.Name, Unit_Except);
6925 end Load_Naming_Exceptions;
6927 ----------------------
6928 -- Look_For_Sources --
6929 ----------------------
6931 procedure Look_For_Sources
6932 (Project : in out Project_Processing_Data;
6933 Data : in out Tree_Processing_Data)
6935 Object_Files : Object_File_Names_Htable.Instance;
6936 Iter : Source_Iterator;
6939 procedure Check_Object (Src : Source_Id);
6940 -- Check if object file name of Src is already used in the project tree,
6941 -- and report an error if so.
6943 procedure Check_Object_Files;
6944 -- Check that no two sources of this project have the same object file
6946 procedure Mark_Excluded_Sources;
6947 -- Mark as such the sources that are declared as excluded
6953 procedure Check_Object (Src : Source_Id) is
6957 Source := Object_File_Names_Htable.Get (Object_Files, Src.Object);
6959 -- We cannot just check on "Source /= Src", since we might have
6960 -- two different entries for the same file (and since that's
6961 -- the same file it is expected that it has the same object)
6963 if Source /= No_Source
6964 and then Source.Path /= Src.Path
6966 Error_Msg_File_1 := Src.File;
6967 Error_Msg_File_2 := Source.File;
6970 "{ and { have the same object file name",
6971 No_Location, Project.Project);
6974 Object_File_Names_Htable.Set (Object_Files, Src.Object, Src);
6978 ---------------------------
6979 -- Mark_Excluded_Sources --
6980 ---------------------------
6982 procedure Mark_Excluded_Sources is
6983 Source : Source_Id := No_Source;
6984 Excluded : File_Found;
6988 -- Minor optimization: if there are no excluded files, no need to
6989 -- traverse the list of sources. We cannot however also check whether
6990 -- the existing exceptions have ".Found" set to True (indicating we
6991 -- found them before) because we need to do some final processing on
6992 -- them in any case.
6994 if Excluded_Sources_Htable.Get_First (Project.Excluded) /=
6997 Proj := Project.Project;
6998 while Proj /= No_Project loop
6999 Iter := For_Each_Source (Data.Tree, Proj);
7000 while Prj.Element (Iter) /= No_Source loop
7001 Source := Prj.Element (Iter);
7002 Excluded := Excluded_Sources_Htable.Get
7003 (Project.Excluded, Source.File);
7005 if Excluded /= No_File_Found then
7006 Source.Locally_Removed := True;
7007 Source.In_Interfaces := False;
7009 if Current_Verbosity = High then
7010 Write_Str ("Removing file ");
7012 (Get_Name_String (Excluded.File)
7013 & " " & Get_Name_String (Source.Project.Name));
7016 Excluded_Sources_Htable.Remove
7017 (Project.Excluded, Source.File);
7023 Proj := Proj.Extends;
7027 -- If we have any excluded element left, that means we did not find
7030 Excluded := Excluded_Sources_Htable.Get_First (Project.Excluded);
7031 while Excluded /= No_File_Found loop
7032 if not Excluded.Found then
7034 -- Check if the file belongs to another imported project to
7035 -- provide a better error message.
7038 (In_Tree => Data.Tree,
7039 Project => Project.Project,
7040 In_Imported_Only => True,
7041 Base_Name => Excluded.File);
7043 Err_Vars.Error_Msg_File_1 := Excluded.File;
7045 if Src = No_Source then
7048 "unknown file {", Excluded.Location, Project.Project);
7052 "cannot remove a source from an imported project: {",
7053 Excluded.Location, Project.Project);
7057 Excluded := Excluded_Sources_Htable.Get_Next (Project.Excluded);
7059 end Mark_Excluded_Sources;
7061 ------------------------
7062 -- Check_Object_Files --
7063 ------------------------
7065 procedure Check_Object_Files is
7066 Iter : Source_Iterator;
7068 Src_Ind : Source_File_Index;
7071 Iter := For_Each_Source (Data.Tree);
7073 Src_Id := Prj.Element (Iter);
7074 exit when Src_Id = No_Source;
7076 if Is_Compilable (Src_Id)
7077 and then Src_Id.Language.Config.Object_Generated
7078 and then Is_Extending (Project.Project, Src_Id.Project)
7080 if Src_Id.Unit = No_Unit_Index then
7081 if Src_Id.Kind = Impl then
7082 Check_Object (Src_Id);
7088 if Other_Part (Src_Id) = No_Source then
7089 Check_Object (Src_Id);
7096 if Other_Part (Src_Id) /= No_Source then
7097 Check_Object (Src_Id);
7100 -- Check if it is a subunit
7103 Sinput.P.Load_Project_File
7104 (Get_Name_String (Src_Id.Path.Name));
7106 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
7107 Override_Kind (Src_Id, Sep);
7109 Check_Object (Src_Id);
7118 end Check_Object_Files;
7120 -- Start of processing for Look_For_Sources
7123 Find_Excluded_Sources (Project, Data);
7125 if Project.Project.Languages /= No_Language_Index then
7126 Load_Naming_Exceptions (Project, Data);
7127 Find_Sources (Project, Data);
7128 Mark_Excluded_Sources;
7132 Object_File_Names_Htable.Reset (Object_Files);
7133 end Look_For_Sources;
7139 function Path_Name_Of
7140 (File_Name : File_Name_Type;
7141 Directory : Path_Name_Type) return String
7143 Result : String_Access;
7144 The_Directory : constant String := Get_Name_String (Directory);
7147 Get_Name_String (File_Name);
7150 (File_Name => Name_Buffer (1 .. Name_Len),
7151 Path => The_Directory);
7153 if Result = null then
7157 R : String := Result.all;
7160 Canonical_Case_File_Name (R);
7170 procedure Remove_Source
7172 Replaced_By : Source_Id)
7177 if Current_Verbosity = High then
7178 Write_Str ("Removing source ");
7179 Write_Line (Get_Name_String (Id.File) & " at" & Id.Index'Img);
7182 if Replaced_By /= No_Source then
7183 Id.Replaced_By := Replaced_By;
7184 Replaced_By.Declared_In_Interfaces := Id.Declared_In_Interfaces;
7187 Id.In_Interfaces := False;
7188 Id.Locally_Removed := True;
7190 -- ??? Should we remove the source from the unit ? The file is not used,
7191 -- so probably should not be referenced from the unit. On the other hand
7192 -- it might give useful additional info
7193 -- if Id.Unit /= null then
7194 -- Id.Unit.File_Names (Id.Kind) := null;
7197 Source := Id.Language.First_Source;
7200 Id.Language.First_Source := Id.Next_In_Lang;
7203 while Source.Next_In_Lang /= Id loop
7204 Source := Source.Next_In_Lang;
7207 Source.Next_In_Lang := Id.Next_In_Lang;
7211 -----------------------
7212 -- Report_No_Sources --
7213 -----------------------
7215 procedure Report_No_Sources
7216 (Project : Project_Id;
7218 Data : Tree_Processing_Data;
7219 Location : Source_Ptr;
7220 Continuation : Boolean := False)
7223 case Data.Flags.When_No_Sources is
7227 when Warning | Error =>
7229 Msg : constant String :=
7232 " sources in this project";
7235 Error_Msg_Warn := Data.Flags.When_No_Sources = Warning;
7237 if Continuation then
7238 Error_Msg (Data.Flags, "\" & Msg, Location, Project);
7240 Error_Msg (Data.Flags, Msg, Location, Project);
7244 end Report_No_Sources;
7246 ----------------------
7247 -- Show_Source_Dirs --
7248 ----------------------
7250 procedure Show_Source_Dirs
7251 (Project : Project_Id;
7252 In_Tree : Project_Tree_Ref)
7254 Current : String_List_Id;
7255 Element : String_Element;
7258 Write_Line ("Source_Dirs:");
7260 Current := Project.Source_Dirs;
7261 while Current /= Nil_String loop
7262 Element := In_Tree.String_Elements.Table (Current);
7264 Write_Line (Get_Name_String (Element.Value));
7265 Current := Element.Next;
7268 Write_Line ("end Source_Dirs.");
7269 end Show_Source_Dirs;
7271 ---------------------------
7272 -- Process_Naming_Scheme --
7273 ---------------------------
7275 procedure Process_Naming_Scheme
7276 (Tree : Project_Tree_Ref;
7277 Root_Project : Project_Id;
7278 Flags : Processing_Flags)
7280 procedure Recursive_Check
7281 (Project : Project_Id;
7282 Data : in out Tree_Processing_Data);
7283 -- Check_Naming_Scheme for the project
7285 ---------------------
7286 -- Recursive_Check --
7287 ---------------------
7289 procedure Recursive_Check
7290 (Project : Project_Id;
7291 Data : in out Tree_Processing_Data)
7294 if Verbose_Mode then
7295 Write_Str ("Processing_Naming_Scheme for project """);
7296 Write_Str (Get_Name_String (Project.Name));
7300 Prj.Nmsc.Check (Project, Data);
7301 end Recursive_Check;
7303 procedure Check_All_Projects is new
7304 For_Every_Project_Imported (Tree_Processing_Data, Recursive_Check);
7306 Data : Tree_Processing_Data;
7308 -- Start of processing for Process_Naming_Scheme
7310 Initialize (Data, Tree => Tree, Flags => Flags);
7311 Check_All_Projects (Root_Project, Data, Imported_First => True);
7313 end Process_Naming_Scheme;