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 Source_Dir_Rank : Natural;
196 Lang_Id : Language_Ptr;
198 File_Name : File_Name_Type;
199 Display_File : File_Name_Type;
200 Naming_Exception : Boolean := False;
201 Path : Path_Information := No_Path_Information;
202 Alternate_Languages : Language_List := null;
203 Unit : Name_Id := No_Name;
205 Locally_Removed : Boolean := False;
206 Location : Source_Ptr := No_Location);
207 -- Add a new source to the different lists: list of all sources in the
208 -- project tree, list of source of a project and list of sources of a
211 -- If Path is specified, the file is also added to Source_Paths_HT.
213 -- Location is used for error messages
215 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type;
216 -- Same as Osint.Canonical_Case_File_Name but applies to Name_Id.
217 -- This alters Name_Buffer
219 function Suffix_Matches
221 Suffix : File_Name_Type) return Boolean;
222 -- True if the file name ends with the given suffix. Always returns False
223 -- if Suffix is No_Name.
225 procedure Replace_Into_Name_Buffer
228 Replacement : Character);
229 -- Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is
230 -- converted to lower-case at the same time.
232 procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
233 -- Check that a name is a valid Ada unit name
235 procedure Check_Package_Naming
236 (Project : Project_Id;
237 Data : in out Tree_Processing_Data;
238 Bodies : out Array_Element_Id;
239 Specs : out Array_Element_Id);
240 -- Check the naming scheme part of Data, and initialize the naming scheme
241 -- data in the config of the various languages. This also returns the
242 -- naming scheme exceptions for unit-based languages (Bodies and Specs are
243 -- associative arrays mapping individual unit names to source file names).
245 procedure Check_Configuration
246 (Project : Project_Id;
247 Data : in out Tree_Processing_Data);
248 -- Check the configuration attributes for the project
250 procedure Check_If_Externally_Built
251 (Project : Project_Id;
252 Data : in out Tree_Processing_Data);
253 -- Check attribute Externally_Built of project Project in project tree
254 -- Data.Tree and modify its data Data if it has the value "true".
256 procedure Check_Interfaces
257 (Project : Project_Id;
258 Data : in out Tree_Processing_Data);
259 -- If a list of sources is specified in attribute Interfaces, set
260 -- In_Interfaces only for the sources specified in the list.
262 procedure Check_Library_Attributes
263 (Project : Project_Id;
264 Data : in out Tree_Processing_Data);
265 -- Check the library attributes of project Project in project tree
266 -- and modify its data Data accordingly.
268 procedure Check_Programming_Languages
269 (Project : Project_Id;
270 Data : in out Tree_Processing_Data);
271 -- Check attribute Languages for the project with data Data in project
272 -- tree Data.Tree and set the components of Data for all the programming
273 -- languages indicated in attribute Languages, if any.
275 procedure Check_Stand_Alone_Library
276 (Project : Project_Id;
277 Data : in out Tree_Processing_Data);
278 -- Check if project Project in project tree Data.Tree is a Stand-Alone
279 -- Library project, and modify its data Data accordingly if it is one.
281 function Compute_Directory_Last (Dir : String) return Natural;
282 -- Return the index of the last significant character in Dir. This is used
283 -- to avoid duplicate '/' (slash) characters at the end of directory names.
285 procedure Search_Directories
286 (Project : in out Project_Processing_Data;
287 Data : in out Tree_Processing_Data;
288 For_All_Sources : Boolean);
289 -- Search the source directories to find the sources. If For_All_Sources is
290 -- True, check each regular file name against the naming schemes of the
291 -- various languages. Otherwise consider only the file names in hash table
292 -- Source_Names. If Allow_Duplicate_Basenames then files with identical
293 -- base names are permitted within a project for source-based languages
294 -- (never for unit based languages).
297 (Project : in out Project_Processing_Data;
298 Data : in out Tree_Processing_Data;
299 Source_Dir_Rank : Natural;
300 Path : Path_Name_Type;
301 File_Name : File_Name_Type;
302 Display_File_Name : File_Name_Type;
303 Locally_Removed : Boolean;
304 For_All_Sources : Boolean);
305 -- Check if file File_Name is a valid source of the project. This is used
306 -- in multi-language mode only. When the file matches one of the naming
307 -- schemes, it is added to various htables through Add_Source and to
308 -- Source_Paths_Htable.
310 -- Name is the name of the candidate file. It hasn't been normalized yet
311 -- and is the direct result of readdir().
313 -- File_Name is the same as Name, but has been normalized.
314 -- Display_File_Name, however, has not been normalized.
316 -- Source_Directory is the directory in which the file was found. It is
317 -- neither normalized nor has had links resolved, and must not end with a
318 -- a directory separator, to avoid duplicates later on.
320 -- If For_All_Sources is True, then all possible file names are analyzed
321 -- otherwise only those currently set in the Source_Names hash table.
323 procedure Check_File_Naming_Schemes
324 (In_Tree : Project_Tree_Ref;
325 Project : Project_Processing_Data;
326 File_Name : File_Name_Type;
327 Alternate_Languages : out Language_List;
328 Language : out Language_Ptr;
329 Display_Language_Name : out Name_Id;
331 Lang_Kind : out Language_Kind;
332 Kind : out Source_Kind);
333 -- Check if the file name File_Name conforms to one of the naming schemes
334 -- of the project. If the file does not match one of the naming schemes,
335 -- set Language to No_Language_Index. Filename is the name of the file
336 -- being investigated. It has been normalized (case-folded). File_Name is
339 procedure Get_Directories
340 (Project : Project_Id;
341 Data : in out Tree_Processing_Data);
342 -- Get the object directory, the exec directory and the source directories
346 (Project : Project_Id;
347 Data : in out Tree_Processing_Data);
348 -- Get the mains of a project from attribute Main, if it exists, and put
349 -- them in the project data.
351 procedure Get_Sources_From_File
353 Location : Source_Ptr;
354 Project : in out Project_Processing_Data;
355 Data : in out Tree_Processing_Data);
356 -- Get the list of sources from a text file and put them in hash table
359 procedure Find_Sources
360 (Project : in out Project_Processing_Data;
361 Data : in out Tree_Processing_Data);
362 -- Process the Source_Files and Source_List_File attributes, and store the
363 -- list of source files into the Source_Names htable. When these attributes
364 -- are not defined, find all files matching the naming schemes in the
365 -- source directories. If Allow_Duplicate_Basenames, then files with the
366 -- same base names are authorized within a project for source-based
367 -- languages (never for unit based languages)
369 procedure Compute_Unit_Name
370 (File_Name : File_Name_Type;
371 Naming : Lang_Naming_Data;
372 Kind : out Source_Kind;
374 Project : Project_Processing_Data;
375 In_Tree : Project_Tree_Ref);
376 -- Check whether the file matches the naming scheme. If it does,
377 -- compute its unit name. If Unit is set to No_Name on exit, none of the
378 -- other out parameters are relevant.
380 procedure Check_Illegal_Suffix
381 (Project : Project_Id;
382 Suffix : File_Name_Type;
383 Dot_Replacement : File_Name_Type;
384 Attribute_Name : String;
385 Location : Source_Ptr;
386 Data : in out Tree_Processing_Data);
387 -- Display an error message if the given suffix is illegal for some reason.
388 -- The name of the attribute we are testing is specified in Attribute_Name,
389 -- which is used in the error message. Location is the location where the
390 -- suffix is defined.
392 procedure Locate_Directory
393 (Project : Project_Id;
394 Name : File_Name_Type;
395 Path : out Path_Information;
396 Dir_Exists : out Boolean;
397 Data : in out Tree_Processing_Data;
398 Create : String := "";
399 Location : Source_Ptr := No_Location;
400 Must_Exist : Boolean := True;
401 Externally_Built : Boolean := False);
402 -- Locate a directory. Name is the directory name. Relative paths are
403 -- resolved relative to the project's directory. If the directory does not
404 -- exist and Setup_Projects is True and Create is a non null string, an
405 -- attempt is made to create the directory. If the directory does not
406 -- exist, it is either created if Setup_Projects is False (and then
407 -- returned), or simply returned without checking for its existence (if
408 -- Must_Exist is False) or No_Path_Information is returned. In all cases,
409 -- Dir_Exists indicates whether the directory now exists. Create is also
410 -- used for debugging traces to show which path we are computing.
412 procedure Look_For_Sources
413 (Project : in out Project_Processing_Data;
414 Data : in out Tree_Processing_Data);
415 -- Find all the sources of project Project in project tree Data.Tree and
416 -- update its Data accordingly. This assumes that Data.First_Source has
417 -- been initialized with the list of excluded sources and special naming
420 function Path_Name_Of
421 (File_Name : File_Name_Type;
422 Directory : Path_Name_Type) return String;
423 -- Returns the path name of a (non project) file. Returns an empty string
424 -- if file cannot be found.
426 procedure Remove_Source
428 Replaced_By : Source_Id);
429 -- Remove a file from the list of sources of a project. This might be
430 -- because the file is replaced by another one in an extending project,
431 -- or because a file was added as a naming exception but was not found
434 procedure Report_No_Sources
435 (Project : Project_Id;
437 Data : Tree_Processing_Data;
438 Location : Source_Ptr;
439 Continuation : Boolean := False);
440 -- Report an error or a warning depending on the value of When_No_Sources
441 -- when there are no sources for language Lang_Name.
443 procedure Show_Source_Dirs
444 (Project : Project_Id; In_Tree : Project_Tree_Ref);
445 -- List all the source directories of a project
447 procedure Write_Attr (Name, Value : String);
448 -- Debug print a value for a specific property. Does nothing when not in
451 ------------------------------
452 -- Replace_Into_Name_Buffer --
453 ------------------------------
455 procedure Replace_Into_Name_Buffer
458 Replacement : Character)
460 Max : constant Integer := Str'Last - Pattern'Length + 1;
467 while J <= Str'Last loop
468 Name_Len := Name_Len + 1;
471 and then Str (J .. J + Pattern'Length - 1) = Pattern
473 Name_Buffer (Name_Len) := Replacement;
474 J := J + Pattern'Length;
477 Name_Buffer (Name_Len) := GNAT.Case_Util.To_Lower (Str (J));
481 end Replace_Into_Name_Buffer;
487 function Suffix_Matches
489 Suffix : File_Name_Type) return Boolean
491 Min_Prefix_Length : Natural := 0;
494 if Suffix = No_File or else Suffix = Empty_File then
499 Suf : String := Get_Name_String (Suffix);
502 -- On non case-sensitive systems, use proper suffix casing
504 Canonical_Case_File_Name (Suf);
506 -- The file name must end with the suffix (which is not an extension)
507 -- For instance a suffix "configure.in" must match a file with the
508 -- same name. To avoid dummy cases, though, a suffix starting with
509 -- '.' requires a file that is at least one character longer ('.cpp'
510 -- should not match a file with the same name)
512 if Suf (Suf'First) = '.' then
513 Min_Prefix_Length := 1;
516 return Filename'Length >= Suf'Length + Min_Prefix_Length
518 (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;
526 procedure Write_Attr (Name, Value : String) is
528 if Current_Verbosity = High then
529 Write_Str (" " & Name & " = """);
542 Data : in out Tree_Processing_Data;
543 Project : Project_Id;
544 Source_Dir_Rank : Natural;
545 Lang_Id : Language_Ptr;
547 File_Name : File_Name_Type;
548 Display_File : File_Name_Type;
549 Naming_Exception : Boolean := False;
550 Path : Path_Information := No_Path_Information;
551 Alternate_Languages : Language_List := null;
552 Unit : Name_Id := No_Name;
554 Locally_Removed : Boolean := False;
555 Location : Source_Ptr := No_Location)
557 Config : constant Language_Config := Lang_Id.Config;
561 Prev_Unit : Unit_Index := No_Unit_Index;
563 Source_To_Replace : Source_Id := No_Source;
566 -- Check if the same file name or unit is used in the prj tree
570 if Unit /= No_Name then
571 Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit);
574 if Prev_Unit /= No_Unit_Index
575 and then (Kind = Impl or else Kind = Spec)
576 and then Prev_Unit.File_Names (Kind) /= null
578 -- Suspicious, we need to check later whether this is authorized
581 Source := Prev_Unit.File_Names (Kind);
584 Source := Files_Htable.Get (Data.File_To_Source, File_Name);
586 if Source /= No_Source
587 and then Source.Index = Index
593 -- Duplication of file/unit in same project is allowed if order of
594 -- source directories is known.
596 if Add_Src = False then
599 if Project = Source.Project then
600 if Prev_Unit = No_Unit_Index then
601 if Data.Flags.Allow_Duplicate_Basenames then
604 elsif Source_Dir_Rank /= Source.Source_Dir_Rank then
608 Error_Msg_File_1 := File_Name;
610 (Data.Flags, "duplicate source file name {",
616 if Source_Dir_Rank /= Source.Source_Dir_Rank then
619 -- We might be seeing the same file through a different path
620 -- (for instance because of symbolic links).
622 elsif Source.Path.Name /= Path.Name then
623 Error_Msg_Name_1 := Unit;
625 (Data.Flags, "duplicate unit %%", Location, Project);
630 -- Do not allow the same unit name in different projects, except
631 -- if one is extending the other.
633 -- For a file based language, the same file name replaces a file
634 -- in a project being extended, but it is allowed to have the same
635 -- file name in unrelated projects.
637 elsif Is_Extending (Project, Source.Project) then
638 if not Locally_Removed then
639 Source_To_Replace := Source;
642 elsif Prev_Unit /= No_Unit_Index
643 and then not Source.Locally_Removed
645 -- Path is set if this is a source we found on the disk, in which
646 -- case we can provide more explicit error message. Path is unset
647 -- when the source is added from one of the naming exceptions in
650 if Path /= No_Path_Information then
651 Error_Msg_Name_1 := Unit;
654 "unit %% cannot belong to several projects",
657 Error_Msg_Name_1 := Project.Name;
658 Error_Msg_Name_2 := Name_Id (Path.Name);
660 (Data.Flags, "\ project %%, %%", Location, Project);
662 Error_Msg_Name_1 := Source.Project.Name;
663 Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);
665 (Data.Flags, "\ project %%, %%", Location, Project);
668 Error_Msg_Name_1 := Unit;
669 Error_Msg_Name_2 := Source.Project.Name;
671 (Data.Flags, "unit %% already belongs to project %%",
677 elsif not Source.Locally_Removed
678 and then not Data.Flags.Allow_Duplicate_Basenames
679 and then Lang_Id.Config.Kind = Unit_Based
681 Error_Msg_File_1 := File_Name;
682 Error_Msg_File_2 := File_Name_Type (Source.Project.Name);
685 "{ is already a source of project {", Location, Project);
687 -- Add the file anyway, to avoid further warnings like "language
700 Id := new Source_Data;
702 if Current_Verbosity = High then
703 Write_Str ("Adding source File: ");
704 Write_Str (Get_Name_String (File_Name));
707 Write_Str (" at" & Index'Img);
710 if Lang_Id.Config.Kind = Unit_Based then
711 Write_Str (" Unit: ");
713 -- ??? in gprclean, it seems we sometimes pass an empty Unit name
714 -- (see test extended_projects).
716 if Unit /= No_Name then
717 Write_Str (Get_Name_String (Unit));
720 Write_Str (" Kind: ");
721 Write_Str (Source_Kind'Image (Kind));
727 Id.Project := Project;
728 Id.Source_Dir_Rank := Source_Dir_Rank;
729 Id.Language := Lang_Id;
731 Id.Alternate_Languages := Alternate_Languages;
732 Id.Locally_Removed := Locally_Removed;
734 Id.File := File_Name;
735 Id.Display_File := Display_File;
736 Id.Dep_Name := Dependency_Name
737 (File_Name, Lang_Id.Config.Dependency_Kind);
738 Id.Naming_Exception := Naming_Exception;
740 -- Add the source id to the Unit_Sources_HT hash table, if the unit name
743 if Unit /= No_Name then
745 -- Note: we might be creating a dummy unit here, when we in fact have
746 -- a separate. For instance, file file-bar.adb will initially be
747 -- assumed to be the IMPL of unit "file.bar". Only later on (in
748 -- Check_Object_Files) will we parse those units that only have an
749 -- impl and no spec to make sure whether we have a Separate in fact
750 -- (that significantly reduces the number of times we need to parse
751 -- the files, since we are then only interested in those with no
752 -- spec). We still need those dummy units in the table, since that's
753 -- the name we find in the ALI file
755 UData := Units_Htable.Get (Data.Tree.Units_HT, Unit);
757 if UData = No_Unit_Index then
758 UData := new Unit_Data;
760 Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
765 -- Note that this updates Unit information as well
767 Override_Kind (Id, Kind);
770 if Is_Compilable (Id) and then Config.Object_Generated then
771 Id.Object := Object_Name (File_Name, Config.Object_File_Suffix);
772 Id.Switches := Switches_Name (File_Name);
775 if Path /= No_Path_Information then
777 Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id);
781 Project.Has_Multi_Unit_Sources := True;
784 -- Add the source to the language list
786 Id.Next_In_Lang := Lang_Id.First_Source;
787 Lang_Id.First_Source := Id;
789 if Source_To_Replace /= No_Source then
790 Remove_Source (Source_To_Replace, Id);
793 Files_Htable.Set (Data.File_To_Source, File_Name, Id);
796 ------------------------------
797 -- Canonical_Case_File_Name --
798 ------------------------------
800 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type is
802 if Osint.File_Names_Case_Sensitive then
803 return File_Name_Type (Name);
805 Get_Name_String (Name);
806 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
809 end Canonical_Case_File_Name;
816 (Project : Project_Id;
817 Data : in out Tree_Processing_Data)
819 Specs : Array_Element_Id;
820 Bodies : Array_Element_Id;
821 Extending : Boolean := False;
822 Prj_Data : Project_Processing_Data;
825 Initialize (Prj_Data, Project);
827 Check_If_Externally_Built (Project, Data);
829 -- Object, exec and source directories
831 Get_Directories (Project, Data);
833 -- Get the programming languages
835 Check_Programming_Languages (Project, Data);
837 if Project.Qualifier = Dry
838 and then Project.Source_Dirs /= Nil_String
841 Source_Dirs : constant Variable_Value :=
844 Project.Decl.Attributes, Data.Tree);
845 Source_Files : constant Variable_Value :=
848 Project.Decl.Attributes, Data.Tree);
849 Source_List_File : constant Variable_Value :=
851 (Name_Source_List_File,
852 Project.Decl.Attributes, Data.Tree);
853 Languages : constant Variable_Value :=
856 Project.Decl.Attributes, Data.Tree);
859 if Source_Dirs.Values = Nil_String
860 and then Source_Files.Values = Nil_String
861 and then Languages.Values = Nil_String
862 and then Source_List_File.Default
864 Project.Source_Dirs := Nil_String;
869 "at least one of Source_Files, Source_Dirs or Languages "
870 & "must be declared empty for an abstract project",
871 Project.Location, Project);
876 -- Check configuration. This must be done even for gnatmake (even though
877 -- no user configuration file was provided) since the default config we
878 -- generate indicates whether libraries are supported for instance.
880 Check_Configuration (Project, Data);
882 -- Library attributes
884 Check_Library_Attributes (Project, Data);
886 if Current_Verbosity = High then
887 Show_Source_Dirs (Project, Data.Tree);
890 Extending := Project.Extends /= No_Project;
892 Check_Package_Naming (Project, Data, Bodies => Bodies, Specs => Specs);
896 if Project.Source_Dirs /= Nil_String then
897 Look_For_Sources (Prj_Data, Data);
899 if not Project.Externally_Built
900 and then not Extending
903 Language : Language_Ptr;
905 Alt_Lang : Language_List;
906 Continuation : Boolean := False;
907 Iter : Source_Iterator;
910 Language := Project.Languages;
911 while Language /= No_Language_Index loop
913 -- If there are no sources for this language, check if there
914 -- are sources for which this is an alternate language.
916 if Language.First_Source = No_Source
917 and then (Data.Flags.Require_Sources_Other_Lang
918 or else Language.Name = Name_Ada)
920 Iter := For_Each_Source (In_Tree => Data.Tree,
923 Source := Element (Iter);
924 exit Source_Loop when Source = No_Source
925 or else Source.Language = Language;
927 Alt_Lang := Source.Alternate_Languages;
928 while Alt_Lang /= null loop
929 exit Source_Loop when Alt_Lang.Language = Language;
930 Alt_Lang := Alt_Lang.Next;
934 end loop Source_Loop;
936 if Source = No_Source then
940 Get_Name_String (Language.Display_Name),
942 Prj_Data.Source_List_File_Location,
944 Continuation := True;
948 Language := Language.Next;
954 -- If a list of sources is specified in attribute Interfaces, set
955 -- In_Interfaces only for the sources specified in the list.
957 Check_Interfaces (Project, Data);
959 -- If it is a library project file, check if it is a standalone library
961 if Project.Library then
962 Check_Stand_Alone_Library (Project, Data);
965 -- Put the list of Mains, if any, in the project data
967 Get_Mains (Project, Data);
976 procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is
977 The_Name : String := Name;
979 Need_Letter : Boolean := True;
980 Last_Underscore : Boolean := False;
981 OK : Boolean := The_Name'Length > 0;
984 function Is_Reserved (Name : Name_Id) return Boolean;
985 function Is_Reserved (S : String) return Boolean;
986 -- Check that the given name is not an Ada 95 reserved word. The reason
987 -- for the Ada 95 here is that we do not want to exclude the case of an
988 -- Ada 95 unit called Interface (for example). In Ada 2005, such a unit
989 -- name would be rejected anyway by the compiler. That means there is no
990 -- requirement that the project file parser reject this.
996 function Is_Reserved (S : String) return Boolean is
999 Add_Str_To_Name_Buffer (S);
1000 return Is_Reserved (Name_Find);
1007 function Is_Reserved (Name : Name_Id) return Boolean is
1009 if Get_Name_Table_Byte (Name) /= 0
1010 and then Name /= Name_Project
1011 and then Name /= Name_Extends
1012 and then Name /= Name_External
1013 and then Name not in Ada_2005_Reserved_Words
1017 if Current_Verbosity = High then
1018 Write_Str (The_Name);
1019 Write_Line (" is an Ada reserved word.");
1029 -- Start of processing for Check_Ada_Name
1032 To_Lower (The_Name);
1034 Name_Len := The_Name'Length;
1035 Name_Buffer (1 .. Name_Len) := The_Name;
1037 -- Special cases of children of packages A, G, I and S on VMS
1039 if OpenVMS_On_Target
1040 and then Name_Len > 3
1041 and then Name_Buffer (2 .. 3) = "__"
1043 ((Name_Buffer (1) = 'a') or else
1044 (Name_Buffer (1) = 'g') or else
1045 (Name_Buffer (1) = 'i') or else
1046 (Name_Buffer (1) = 's'))
1048 Name_Buffer (2) := '.';
1049 Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
1050 Name_Len := Name_Len - 1;
1053 Real_Name := Name_Find;
1055 if Is_Reserved (Real_Name) then
1059 First := The_Name'First;
1061 for Index in The_Name'Range loop
1064 -- We need a letter (at the beginning, and following a dot),
1065 -- but we don't have one.
1067 if Is_Letter (The_Name (Index)) then
1068 Need_Letter := False;
1073 if Current_Verbosity = High then
1074 Write_Int (Types.Int (Index));
1076 Write_Char (The_Name (Index));
1077 Write_Line ("' is not a letter.");
1083 elsif Last_Underscore
1084 and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
1086 -- Two underscores are illegal, and a dot cannot follow
1091 if Current_Verbosity = High then
1092 Write_Int (Types.Int (Index));
1094 Write_Char (The_Name (Index));
1095 Write_Line ("' is illegal here.");
1100 elsif The_Name (Index) = '.' then
1102 -- First, check if the name before the dot is not a reserved word
1104 if Is_Reserved (The_Name (First .. Index - 1)) then
1110 -- We need a letter after a dot
1112 Need_Letter := True;
1114 elsif The_Name (Index) = '_' then
1115 Last_Underscore := True;
1118 -- We need an letter or a digit
1120 Last_Underscore := False;
1122 if not Is_Alphanumeric (The_Name (Index)) then
1125 if Current_Verbosity = High then
1126 Write_Int (Types.Int (Index));
1128 Write_Char (The_Name (Index));
1129 Write_Line ("' is not alphanumeric.");
1137 -- Cannot end with an underscore or a dot
1139 OK := OK and then not Need_Letter and then not Last_Underscore;
1142 if First /= Name'First and then
1143 Is_Reserved (The_Name (First .. The_Name'Last))
1151 -- Signal a problem with No_Name
1157 -------------------------
1158 -- Check_Configuration --
1159 -------------------------
1161 procedure Check_Configuration
1162 (Project : Project_Id;
1163 Data : in out Tree_Processing_Data)
1165 Dot_Replacement : File_Name_Type := No_File;
1166 Casing : Casing_Type := All_Lower_Case;
1167 Separate_Suffix : File_Name_Type := No_File;
1169 Lang_Index : Language_Ptr := No_Language_Index;
1170 -- The index of the language data being checked
1172 Prev_Index : Language_Ptr := No_Language_Index;
1173 -- The index of the previous language
1175 procedure Process_Project_Level_Simple_Attributes;
1176 -- Process the simple attributes at the project level
1178 procedure Process_Project_Level_Array_Attributes;
1179 -- Process the associate array attributes at the project level
1181 procedure Process_Packages;
1182 -- Read the packages of the project
1184 ----------------------
1185 -- Process_Packages --
1186 ----------------------
1188 procedure Process_Packages is
1189 Packages : Package_Id;
1190 Element : Package_Element;
1192 procedure Process_Binder (Arrays : Array_Id);
1193 -- Process the associate array attributes of package Binder
1195 procedure Process_Builder (Attributes : Variable_Id);
1196 -- Process the simple attributes of package Builder
1198 procedure Process_Compiler (Arrays : Array_Id);
1199 -- Process the associate array attributes of package Compiler
1201 procedure Process_Naming (Attributes : Variable_Id);
1202 -- Process the simple attributes of package Naming
1204 procedure Process_Naming (Arrays : Array_Id);
1205 -- Process the associate array attributes of package Naming
1207 procedure Process_Linker (Attributes : Variable_Id);
1208 -- Process the simple attributes of package Linker of a
1209 -- configuration project.
1211 --------------------
1212 -- Process_Binder --
1213 --------------------
1215 procedure Process_Binder (Arrays : Array_Id) is
1216 Current_Array_Id : Array_Id;
1217 Current_Array : Array_Data;
1218 Element_Id : Array_Element_Id;
1219 Element : Array_Element;
1222 -- Process the associative array attribute of package Binder
1224 Current_Array_Id := Arrays;
1225 while Current_Array_Id /= No_Array loop
1226 Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
1228 Element_Id := Current_Array.Value;
1229 while Element_Id /= No_Array_Element loop
1230 Element := Data.Tree.Array_Elements.Table (Element_Id);
1232 if Element.Index /= All_Other_Names then
1234 -- Get the name of the language
1237 Get_Language_From_Name
1238 (Project, Get_Name_String (Element.Index));
1240 if Lang_Index /= No_Language_Index then
1241 case Current_Array.Name is
1244 -- Attribute Driver (<language>)
1246 Lang_Index.Config.Binder_Driver :=
1247 File_Name_Type (Element.Value.Value);
1249 when Name_Required_Switches =>
1252 Lang_Index.Config.Binder_Required_Switches,
1253 From_List => Element.Value.Values,
1254 In_Tree => Data.Tree);
1258 -- Attribute Prefix (<language>)
1260 Lang_Index.Config.Binder_Prefix :=
1261 Element.Value.Value;
1263 when Name_Objects_Path =>
1265 -- Attribute Objects_Path (<language>)
1267 Lang_Index.Config.Objects_Path :=
1268 Element.Value.Value;
1270 when Name_Objects_Path_File =>
1272 -- Attribute Objects_Path (<language>)
1274 Lang_Index.Config.Objects_Path_File :=
1275 Element.Value.Value;
1283 Element_Id := Element.Next;
1286 Current_Array_Id := Current_Array.Next;
1290 ---------------------
1291 -- Process_Builder --
1292 ---------------------
1294 procedure Process_Builder (Attributes : Variable_Id) is
1295 Attribute_Id : Variable_Id;
1296 Attribute : Variable;
1299 -- Process non associated array attribute from package Builder
1301 Attribute_Id := Attributes;
1302 while Attribute_Id /= No_Variable loop
1304 Data.Tree.Variable_Elements.Table (Attribute_Id);
1306 if not Attribute.Value.Default then
1307 if Attribute.Name = Name_Executable_Suffix then
1309 -- Attribute Executable_Suffix: the suffix of the
1312 Project.Config.Executable_Suffix :=
1313 Attribute.Value.Value;
1317 Attribute_Id := Attribute.Next;
1319 end Process_Builder;
1321 ----------------------
1322 -- Process_Compiler --
1323 ----------------------
1325 procedure Process_Compiler (Arrays : Array_Id) is
1326 Current_Array_Id : Array_Id;
1327 Current_Array : Array_Data;
1328 Element_Id : Array_Element_Id;
1329 Element : Array_Element;
1330 List : String_List_Id;
1333 -- Process the associative array attribute of package Compiler
1335 Current_Array_Id := Arrays;
1336 while Current_Array_Id /= No_Array loop
1337 Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
1339 Element_Id := Current_Array.Value;
1340 while Element_Id /= No_Array_Element loop
1341 Element := Data.Tree.Array_Elements.Table (Element_Id);
1343 if Element.Index /= All_Other_Names then
1345 -- Get the name of the language
1347 Lang_Index := Get_Language_From_Name
1348 (Project, Get_Name_String (Element.Index));
1350 if Lang_Index /= No_Language_Index then
1351 case Current_Array.Name is
1352 when Name_Dependency_Switches =>
1354 -- Attribute Dependency_Switches (<language>)
1356 if Lang_Index.Config.Dependency_Kind = None then
1357 Lang_Index.Config.Dependency_Kind := Makefile;
1360 List := Element.Value.Values;
1362 if List /= Nil_String then
1364 Lang_Index.Config.Dependency_Option,
1366 In_Tree => Data.Tree);
1369 when Name_Dependency_Driver =>
1371 -- Attribute Dependency_Driver (<language>)
1373 if Lang_Index.Config.Dependency_Kind = None then
1374 Lang_Index.Config.Dependency_Kind := Makefile;
1377 List := Element.Value.Values;
1379 if List /= Nil_String then
1381 Lang_Index.Config.Compute_Dependency,
1383 In_Tree => Data.Tree);
1386 when Name_Include_Switches =>
1388 -- Attribute Include_Switches (<language>)
1390 List := Element.Value.Values;
1392 if List = Nil_String then
1394 (Data.Flags, "include option cannot be null",
1395 Element.Value.Location, Project);
1398 Put (Into_List => Lang_Index.Config.Include_Option,
1400 In_Tree => Data.Tree);
1402 when Name_Include_Path =>
1404 -- Attribute Include_Path (<language>)
1406 Lang_Index.Config.Include_Path :=
1407 Element.Value.Value;
1409 when Name_Include_Path_File =>
1411 -- Attribute Include_Path_File (<language>)
1413 Lang_Index.Config.Include_Path_File :=
1414 Element.Value.Value;
1418 -- Attribute Driver (<language>)
1420 Lang_Index.Config.Compiler_Driver :=
1421 File_Name_Type (Element.Value.Value);
1423 when Name_Required_Switches |
1424 Name_Leading_Required_Switches =>
1427 Compiler_Leading_Required_Switches,
1428 From_List => Element.Value.Values,
1429 In_Tree => Data.Tree);
1431 when Name_Trailing_Required_Switches =>
1434 Compiler_Trailing_Required_Switches,
1435 From_List => Element.Value.Values,
1436 In_Tree => Data.Tree);
1438 when Name_Multi_Unit_Switches =>
1440 Lang_Index.Config.Multi_Unit_Switches,
1441 From_List => Element.Value.Values,
1442 In_Tree => Data.Tree);
1444 when Name_Multi_Unit_Object_Separator =>
1445 Get_Name_String (Element.Value.Value);
1447 if Name_Len /= 1 then
1450 "multi-unit object separator must have " &
1451 "a single character",
1452 Element.Value.Location, Project);
1454 elsif Name_Buffer (1) = ' ' then
1457 "multi-unit object separator cannot be " &
1459 Element.Value.Location, Project);
1462 Lang_Index.Config.Multi_Unit_Object_Separator :=
1466 when Name_Path_Syntax =>
1468 Lang_Index.Config.Path_Syntax :=
1469 Path_Syntax_Kind'Value
1470 (Get_Name_String (Element.Value.Value));
1473 when Constraint_Error =>
1476 "invalid value for Path_Syntax",
1477 Element.Value.Location, Project);
1480 when Name_Object_File_Suffix =>
1481 if Get_Name_String (Element.Value.Value) = "" then
1484 "object file suffix cannot be empty",
1485 Element.Value.Location, Project);
1488 Lang_Index.Config.Object_File_Suffix :=
1489 Element.Value.Value;
1492 when Name_Object_File_Switches =>
1494 Lang_Index.Config.Object_File_Switches,
1495 From_List => Element.Value.Values,
1496 In_Tree => Data.Tree);
1498 when Name_Pic_Option =>
1500 -- Attribute Compiler_Pic_Option (<language>)
1502 List := Element.Value.Values;
1504 if List = Nil_String then
1507 "compiler PIC option cannot be null",
1508 Element.Value.Location, Project);
1512 Lang_Index.Config.Compilation_PIC_Option,
1514 In_Tree => Data.Tree);
1516 when Name_Mapping_File_Switches =>
1518 -- Attribute Mapping_File_Switches (<language>)
1520 List := Element.Value.Values;
1522 if List = Nil_String then
1525 "mapping file switches cannot be null",
1526 Element.Value.Location, Project);
1530 Lang_Index.Config.Mapping_File_Switches,
1532 In_Tree => Data.Tree);
1534 when Name_Mapping_Spec_Suffix =>
1536 -- Attribute Mapping_Spec_Suffix (<language>)
1538 Lang_Index.Config.Mapping_Spec_Suffix :=
1539 File_Name_Type (Element.Value.Value);
1541 when Name_Mapping_Body_Suffix =>
1543 -- Attribute Mapping_Body_Suffix (<language>)
1545 Lang_Index.Config.Mapping_Body_Suffix :=
1546 File_Name_Type (Element.Value.Value);
1548 when Name_Config_File_Switches =>
1550 -- Attribute Config_File_Switches (<language>)
1552 List := Element.Value.Values;
1554 if List = Nil_String then
1557 "config file switches cannot be null",
1558 Element.Value.Location, Project);
1562 Lang_Index.Config.Config_File_Switches,
1564 In_Tree => Data.Tree);
1566 when Name_Objects_Path =>
1568 -- Attribute Objects_Path (<language>)
1570 Lang_Index.Config.Objects_Path :=
1571 Element.Value.Value;
1573 when Name_Objects_Path_File =>
1575 -- Attribute Objects_Path_File (<language>)
1577 Lang_Index.Config.Objects_Path_File :=
1578 Element.Value.Value;
1580 when Name_Config_Body_File_Name =>
1582 -- Attribute Config_Body_File_Name (<language>)
1584 Lang_Index.Config.Config_Body :=
1585 Element.Value.Value;
1587 when Name_Config_Body_File_Name_Index =>
1589 -- Attribute Config_Body_File_Name_Index
1592 Lang_Index.Config.Config_Body_Index :=
1593 Element.Value.Value;
1595 when Name_Config_Body_File_Name_Pattern =>
1597 -- Attribute Config_Body_File_Name_Pattern
1600 Lang_Index.Config.Config_Body_Pattern :=
1601 Element.Value.Value;
1603 when Name_Config_Spec_File_Name =>
1605 -- Attribute Config_Spec_File_Name (<language>)
1607 Lang_Index.Config.Config_Spec :=
1608 Element.Value.Value;
1610 when Name_Config_Spec_File_Name_Index =>
1612 -- Attribute Config_Spec_File_Name_Index
1615 Lang_Index.Config.Config_Spec_Index :=
1616 Element.Value.Value;
1618 when Name_Config_Spec_File_Name_Pattern =>
1620 -- Attribute Config_Spec_File_Name_Pattern
1623 Lang_Index.Config.Config_Spec_Pattern :=
1624 Element.Value.Value;
1626 when Name_Config_File_Unique =>
1628 -- Attribute Config_File_Unique (<language>)
1631 Lang_Index.Config.Config_File_Unique :=
1633 (Get_Name_String (Element.Value.Value));
1635 when Constraint_Error =>
1638 "illegal value for Config_File_Unique",
1639 Element.Value.Location, Project);
1648 Element_Id := Element.Next;
1651 Current_Array_Id := Current_Array.Next;
1653 end Process_Compiler;
1655 --------------------
1656 -- Process_Naming --
1657 --------------------
1659 procedure Process_Naming (Attributes : Variable_Id) is
1660 Attribute_Id : Variable_Id;
1661 Attribute : Variable;
1664 -- Process non associated array attribute from package Naming
1666 Attribute_Id := Attributes;
1667 while Attribute_Id /= No_Variable loop
1668 Attribute := Data.Tree.Variable_Elements.Table (Attribute_Id);
1670 if not Attribute.Value.Default then
1671 if Attribute.Name = Name_Separate_Suffix then
1673 -- Attribute Separate_Suffix
1675 Get_Name_String (Attribute.Value.Value);
1676 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1677 Separate_Suffix := Name_Find;
1679 elsif Attribute.Name = Name_Casing then
1685 Value (Get_Name_String (Attribute.Value.Value));
1688 when Constraint_Error =>
1691 "invalid value for Casing",
1692 Attribute.Value.Location, Project);
1695 elsif Attribute.Name = Name_Dot_Replacement then
1697 -- Attribute Dot_Replacement
1699 Dot_Replacement := File_Name_Type (Attribute.Value.Value);
1704 Attribute_Id := Attribute.Next;
1708 procedure Process_Naming (Arrays : Array_Id) is
1709 Current_Array_Id : Array_Id;
1710 Current_Array : Array_Data;
1711 Element_Id : Array_Element_Id;
1712 Element : Array_Element;
1715 -- Process the associative array attribute of package Naming
1717 Current_Array_Id := Arrays;
1718 while Current_Array_Id /= No_Array loop
1719 Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
1721 Element_Id := Current_Array.Value;
1722 while Element_Id /= No_Array_Element loop
1723 Element := Data.Tree.Array_Elements.Table (Element_Id);
1725 -- Get the name of the language
1727 Lang_Index := Get_Language_From_Name
1728 (Project, Get_Name_String (Element.Index));
1730 if Lang_Index /= No_Language_Index then
1731 case Current_Array.Name is
1732 when Name_Spec_Suffix | Name_Specification_Suffix =>
1734 -- Attribute Spec_Suffix (<language>)
1736 Get_Name_String (Element.Value.Value);
1737 Canonical_Case_File_Name
1738 (Name_Buffer (1 .. Name_Len));
1739 Lang_Index.Config.Naming_Data.Spec_Suffix :=
1742 when Name_Implementation_Suffix | Name_Body_Suffix =>
1744 Get_Name_String (Element.Value.Value);
1745 Canonical_Case_File_Name
1746 (Name_Buffer (1 .. Name_Len));
1748 -- Attribute Body_Suffix (<language>)
1750 Lang_Index.Config.Naming_Data.Body_Suffix :=
1752 Lang_Index.Config.Naming_Data.Separate_Suffix :=
1753 Lang_Index.Config.Naming_Data.Body_Suffix;
1760 Element_Id := Element.Next;
1763 Current_Array_Id := Current_Array.Next;
1767 --------------------
1768 -- Process_Linker --
1769 --------------------
1771 procedure Process_Linker (Attributes : Variable_Id) is
1772 Attribute_Id : Variable_Id;
1773 Attribute : Variable;
1776 -- Process non associated array attribute from package Linker
1778 Attribute_Id := Attributes;
1779 while Attribute_Id /= No_Variable loop
1781 Data.Tree.Variable_Elements.Table (Attribute_Id);
1783 if not Attribute.Value.Default then
1784 if Attribute.Name = Name_Driver then
1786 -- Attribute Linker'Driver: the default linker to use
1788 Project.Config.Linker :=
1789 Path_Name_Type (Attribute.Value.Value);
1791 -- Linker'Driver is also used to link shared libraries
1792 -- if the obsolescent attribute Library_GCC has not been
1795 if Project.Config.Shared_Lib_Driver = No_File then
1796 Project.Config.Shared_Lib_Driver :=
1797 File_Name_Type (Attribute.Value.Value);
1800 elsif Attribute.Name = Name_Required_Switches then
1802 -- Attribute Required_Switches: the minimum
1803 -- options to use when invoking the linker
1805 Put (Into_List => Project.Config.Minimum_Linker_Options,
1806 From_List => Attribute.Value.Values,
1807 In_Tree => Data.Tree);
1809 elsif Attribute.Name = Name_Map_File_Option then
1810 Project.Config.Map_File_Option := Attribute.Value.Value;
1812 elsif Attribute.Name = Name_Max_Command_Line_Length then
1814 Project.Config.Max_Command_Line_Length :=
1815 Natural'Value (Get_Name_String
1816 (Attribute.Value.Value));
1819 when Constraint_Error =>
1822 "value must be positive or equal to 0",
1823 Attribute.Value.Location, Project);
1826 elsif Attribute.Name = Name_Response_File_Format then
1831 Get_Name_String (Attribute.Value.Value);
1832 To_Lower (Name_Buffer (1 .. Name_Len));
1835 if Name = Name_None then
1836 Project.Config.Resp_File_Format := None;
1838 elsif Name = Name_Gnu then
1839 Project.Config.Resp_File_Format := GNU;
1841 elsif Name = Name_Object_List then
1842 Project.Config.Resp_File_Format := Object_List;
1844 elsif Name = Name_Option_List then
1845 Project.Config.Resp_File_Format := Option_List;
1850 "illegal response file format",
1851 Attribute.Value.Location, Project);
1855 elsif Attribute.Name = Name_Response_File_Switches then
1856 Put (Into_List => Project.Config.Resp_File_Options,
1857 From_List => Attribute.Value.Values,
1858 In_Tree => Data.Tree);
1862 Attribute_Id := Attribute.Next;
1866 -- Start of processing for Process_Packages
1869 Packages := Project.Decl.Packages;
1870 while Packages /= No_Package loop
1871 Element := Data.Tree.Packages.Table (Packages);
1873 case Element.Name is
1876 -- Process attributes of package Binder
1878 Process_Binder (Element.Decl.Arrays);
1880 when Name_Builder =>
1882 -- Process attributes of package Builder
1884 Process_Builder (Element.Decl.Attributes);
1886 when Name_Compiler =>
1888 -- Process attributes of package Compiler
1890 Process_Compiler (Element.Decl.Arrays);
1894 -- Process attributes of package Linker
1896 Process_Linker (Element.Decl.Attributes);
1900 -- Process attributes of package Naming
1902 Process_Naming (Element.Decl.Attributes);
1903 Process_Naming (Element.Decl.Arrays);
1909 Packages := Element.Next;
1911 end Process_Packages;
1913 ---------------------------------------------
1914 -- Process_Project_Level_Simple_Attributes --
1915 ---------------------------------------------
1917 procedure Process_Project_Level_Simple_Attributes is
1918 Attribute_Id : Variable_Id;
1919 Attribute : Variable;
1920 List : String_List_Id;
1923 -- Process non associated array attribute at project level
1925 Attribute_Id := Project.Decl.Attributes;
1926 while Attribute_Id /= No_Variable loop
1928 Data.Tree.Variable_Elements.Table (Attribute_Id);
1930 if not Attribute.Value.Default then
1931 if Attribute.Name = Name_Target then
1933 -- Attribute Target: the target specified
1935 Project.Config.Target := Attribute.Value.Value;
1937 elsif Attribute.Name = Name_Library_Builder then
1939 -- Attribute Library_Builder: the application to invoke
1940 -- to build libraries.
1942 Project.Config.Library_Builder :=
1943 Path_Name_Type (Attribute.Value.Value);
1945 elsif Attribute.Name = Name_Archive_Builder then
1947 -- Attribute Archive_Builder: the archive builder
1948 -- (usually "ar") and its minimum options (usually "cr").
1950 List := Attribute.Value.Values;
1952 if List = Nil_String then
1955 "archive builder cannot be null",
1956 Attribute.Value.Location, Project);
1959 Put (Into_List => Project.Config.Archive_Builder,
1961 In_Tree => Data.Tree);
1963 elsif Attribute.Name = Name_Archive_Builder_Append_Option then
1965 -- Attribute Archive_Builder: the archive builder
1966 -- (usually "ar") and its minimum options (usually "cr").
1968 List := Attribute.Value.Values;
1970 if List /= Nil_String then
1973 Project.Config.Archive_Builder_Append_Option,
1975 In_Tree => Data.Tree);
1978 elsif Attribute.Name = Name_Archive_Indexer then
1980 -- Attribute Archive_Indexer: the optional archive
1981 -- indexer (usually "ranlib") with its minimum options
1984 List := Attribute.Value.Values;
1986 if List = Nil_String then
1989 "archive indexer cannot be null",
1990 Attribute.Value.Location, Project);
1993 Put (Into_List => Project.Config.Archive_Indexer,
1995 In_Tree => Data.Tree);
1997 elsif Attribute.Name = Name_Library_Partial_Linker then
1999 -- Attribute Library_Partial_Linker: the optional linker
2000 -- driver with its minimum options, to partially link
2003 List := Attribute.Value.Values;
2005 if List = Nil_String then
2008 "partial linker cannot be null",
2009 Attribute.Value.Location, Project);
2012 Put (Into_List => Project.Config.Lib_Partial_Linker,
2014 In_Tree => Data.Tree);
2016 elsif Attribute.Name = Name_Library_GCC then
2017 Project.Config.Shared_Lib_Driver :=
2018 File_Name_Type (Attribute.Value.Value);
2021 "?Library_'G'C'C is an obsolescent attribute, " &
2022 "use Linker''Driver instead",
2023 Attribute.Value.Location, Project);
2025 elsif Attribute.Name = Name_Archive_Suffix then
2026 Project.Config.Archive_Suffix :=
2027 File_Name_Type (Attribute.Value.Value);
2029 elsif Attribute.Name = Name_Linker_Executable_Option then
2031 -- Attribute Linker_Executable_Option: optional options
2032 -- to specify an executable name. Defaults to "-o".
2034 List := Attribute.Value.Values;
2036 if List = Nil_String then
2039 "linker executable option cannot be null",
2040 Attribute.Value.Location, Project);
2043 Put (Into_List => Project.Config.Linker_Executable_Option,
2045 In_Tree => Data.Tree);
2047 elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
2049 -- Attribute Linker_Lib_Dir_Option: optional options
2050 -- to specify a library search directory. Defaults to
2053 Get_Name_String (Attribute.Value.Value);
2055 if Name_Len = 0 then
2058 "linker library directory option cannot be empty",
2059 Attribute.Value.Location, Project);
2062 Project.Config.Linker_Lib_Dir_Option :=
2063 Attribute.Value.Value;
2065 elsif Attribute.Name = Name_Linker_Lib_Name_Option then
2067 -- Attribute Linker_Lib_Name_Option: optional options
2068 -- to specify the name of a library to be linked in.
2069 -- Defaults to "-l".
2071 Get_Name_String (Attribute.Value.Value);
2073 if Name_Len = 0 then
2076 "linker library name option cannot be empty",
2077 Attribute.Value.Location, Project);
2080 Project.Config.Linker_Lib_Name_Option :=
2081 Attribute.Value.Value;
2083 elsif Attribute.Name = Name_Run_Path_Option then
2085 -- Attribute Run_Path_Option: optional options to
2086 -- specify a path for libraries.
2088 List := Attribute.Value.Values;
2090 if List /= Nil_String then
2091 Put (Into_List => Project.Config.Run_Path_Option,
2093 In_Tree => Data.Tree);
2096 elsif Attribute.Name = Name_Separate_Run_Path_Options then
2098 pragma Unsuppress (All_Checks);
2100 Project.Config.Separate_Run_Path_Options :=
2101 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2103 when Constraint_Error =>
2106 "invalid value """ &
2107 Get_Name_String (Attribute.Value.Value) &
2108 """ for Separate_Run_Path_Options",
2109 Attribute.Value.Location, Project);
2112 elsif Attribute.Name = Name_Library_Support then
2114 pragma Unsuppress (All_Checks);
2116 Project.Config.Lib_Support :=
2117 Library_Support'Value (Get_Name_String
2118 (Attribute.Value.Value));
2120 when Constraint_Error =>
2123 "invalid value """ &
2124 Get_Name_String (Attribute.Value.Value) &
2125 """ for Library_Support",
2126 Attribute.Value.Location, Project);
2129 elsif Attribute.Name = Name_Shared_Library_Prefix then
2130 Project.Config.Shared_Lib_Prefix :=
2131 File_Name_Type (Attribute.Value.Value);
2133 elsif Attribute.Name = Name_Shared_Library_Suffix then
2134 Project.Config.Shared_Lib_Suffix :=
2135 File_Name_Type (Attribute.Value.Value);
2137 elsif Attribute.Name = Name_Symbolic_Link_Supported then
2139 pragma Unsuppress (All_Checks);
2141 Project.Config.Symbolic_Link_Supported :=
2142 Boolean'Value (Get_Name_String
2143 (Attribute.Value.Value));
2145 when Constraint_Error =>
2149 & Get_Name_String (Attribute.Value.Value)
2150 & """ for Symbolic_Link_Supported",
2151 Attribute.Value.Location, Project);
2155 Attribute.Name = Name_Library_Major_Minor_Id_Supported
2158 pragma Unsuppress (All_Checks);
2160 Project.Config.Lib_Maj_Min_Id_Supported :=
2161 Boolean'Value (Get_Name_String
2162 (Attribute.Value.Value));
2164 when Constraint_Error =>
2167 "invalid value """ &
2168 Get_Name_String (Attribute.Value.Value) &
2169 """ for Library_Major_Minor_Id_Supported",
2170 Attribute.Value.Location, Project);
2173 elsif Attribute.Name = Name_Library_Auto_Init_Supported then
2175 pragma Unsuppress (All_Checks);
2177 Project.Config.Auto_Init_Supported :=
2178 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2180 when Constraint_Error =>
2184 & Get_Name_String (Attribute.Value.Value)
2185 & """ for Library_Auto_Init_Supported",
2186 Attribute.Value.Location, Project);
2189 elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
2190 List := Attribute.Value.Values;
2192 if List /= Nil_String then
2193 Put (Into_List => Project.Config.Shared_Lib_Min_Options,
2195 In_Tree => Data.Tree);
2198 elsif Attribute.Name = Name_Library_Version_Switches then
2199 List := Attribute.Value.Values;
2201 if List /= Nil_String then
2202 Put (Into_List => Project.Config.Lib_Version_Options,
2204 In_Tree => Data.Tree);
2209 Attribute_Id := Attribute.Next;
2211 end Process_Project_Level_Simple_Attributes;
2213 --------------------------------------------
2214 -- Process_Project_Level_Array_Attributes --
2215 --------------------------------------------
2217 procedure Process_Project_Level_Array_Attributes is
2218 Current_Array_Id : Array_Id;
2219 Current_Array : Array_Data;
2220 Element_Id : Array_Element_Id;
2221 Element : Array_Element;
2222 List : String_List_Id;
2225 -- Process the associative array attributes at project level
2227 Current_Array_Id := Project.Decl.Arrays;
2228 while Current_Array_Id /= No_Array loop
2229 Current_Array := Data.Tree.Arrays.Table (Current_Array_Id);
2231 Element_Id := Current_Array.Value;
2232 while Element_Id /= No_Array_Element loop
2233 Element := Data.Tree.Array_Elements.Table (Element_Id);
2235 -- Get the name of the language
2238 Get_Language_From_Name
2239 (Project, Get_Name_String (Element.Index));
2241 if Lang_Index /= No_Language_Index then
2242 case Current_Array.Name is
2243 when Name_Inherit_Source_Path =>
2244 List := Element.Value.Values;
2246 if List /= Nil_String then
2249 Lang_Index.Config.Include_Compatible_Languages,
2251 In_Tree => Data.Tree,
2252 Lower_Case => True);
2255 when Name_Toolchain_Description =>
2257 -- Attribute Toolchain_Description (<language>)
2259 Lang_Index.Config.Toolchain_Description :=
2260 Element.Value.Value;
2262 when Name_Toolchain_Version =>
2264 -- Attribute Toolchain_Version (<language>)
2266 Lang_Index.Config.Toolchain_Version :=
2267 Element.Value.Value;
2269 when Name_Runtime_Library_Dir =>
2271 -- Attribute Runtime_Library_Dir (<language>)
2273 Lang_Index.Config.Runtime_Library_Dir :=
2274 Element.Value.Value;
2276 when Name_Runtime_Source_Dir =>
2278 -- Attribute Runtime_Library_Dir (<language>)
2280 Lang_Index.Config.Runtime_Source_Dir :=
2281 Element.Value.Value;
2283 when Name_Object_Generated =>
2285 pragma Unsuppress (All_Checks);
2291 (Get_Name_String (Element.Value.Value));
2293 Lang_Index.Config.Object_Generated := Value;
2295 -- If no object is generated, no object may be
2299 Lang_Index.Config.Objects_Linked := False;
2303 when Constraint_Error =>
2307 & Get_Name_String (Element.Value.Value)
2308 & """ for Object_Generated",
2309 Element.Value.Location, Project);
2312 when Name_Objects_Linked =>
2314 pragma Unsuppress (All_Checks);
2320 (Get_Name_String (Element.Value.Value));
2322 -- No change if Object_Generated is False, as this
2323 -- forces Objects_Linked to be False too.
2325 if Lang_Index.Config.Object_Generated then
2326 Lang_Index.Config.Objects_Linked := Value;
2330 when Constraint_Error =>
2334 & Get_Name_String (Element.Value.Value)
2335 & """ for Objects_Linked",
2336 Element.Value.Location, Project);
2343 Element_Id := Element.Next;
2346 Current_Array_Id := Current_Array.Next;
2348 end Process_Project_Level_Array_Attributes;
2350 -- Start of processing for Check_Configuration
2353 Process_Project_Level_Simple_Attributes;
2354 Process_Project_Level_Array_Attributes;
2357 -- For unit based languages, set Casing, Dot_Replacement and
2358 -- Separate_Suffix in Naming_Data.
2360 Lang_Index := Project.Languages;
2361 while Lang_Index /= No_Language_Index loop
2362 if Lang_Index.Name = Name_Ada then
2363 Lang_Index.Config.Naming_Data.Casing := Casing;
2364 Lang_Index.Config.Naming_Data.Dot_Replacement := Dot_Replacement;
2366 if Separate_Suffix /= No_File then
2367 Lang_Index.Config.Naming_Data.Separate_Suffix :=
2374 Lang_Index := Lang_Index.Next;
2377 -- Give empty names to various prefixes/suffixes, if they have not
2378 -- been specified in the configuration.
2380 if Project.Config.Archive_Suffix = No_File then
2381 Project.Config.Archive_Suffix := Empty_File;
2384 if Project.Config.Shared_Lib_Prefix = No_File then
2385 Project.Config.Shared_Lib_Prefix := Empty_File;
2388 if Project.Config.Shared_Lib_Suffix = No_File then
2389 Project.Config.Shared_Lib_Suffix := Empty_File;
2392 Lang_Index := Project.Languages;
2393 while Lang_Index /= No_Language_Index loop
2395 -- For all languages, Compiler_Driver needs to be specified. This is
2396 -- only needed if we do intend to compile (not in GPS for instance).
2398 if Data.Flags.Compiler_Driver_Mandatory
2399 and then Lang_Index.Config.Compiler_Driver = No_File
2401 Error_Msg_Name_1 := Lang_Index.Display_Name;
2404 "?no compiler specified for language %%" &
2405 ", ignoring all its sources",
2406 No_Location, Project);
2408 if Lang_Index = Project.Languages then
2409 Project.Languages := Lang_Index.Next;
2411 Prev_Index.Next := Lang_Index.Next;
2414 elsif Lang_Index.Name = Name_Ada then
2415 Prev_Index := Lang_Index;
2417 -- For unit based languages, Dot_Replacement, Spec_Suffix and
2418 -- Body_Suffix need to be specified.
2420 if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then
2423 "Dot_Replacement not specified for Ada",
2424 No_Location, Project);
2427 if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
2430 "Spec_Suffix not specified for Ada",
2431 No_Location, Project);
2434 if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
2437 "Body_Suffix not specified for Ada",
2438 No_Location, Project);
2442 Prev_Index := Lang_Index;
2444 -- For file based languages, either Spec_Suffix or Body_Suffix
2445 -- need to be specified.
2447 if Data.Flags.Require_Sources_Other_Lang
2448 and then Lang_Index.Config.Naming_Data.Spec_Suffix = No_File
2449 and then Lang_Index.Config.Naming_Data.Body_Suffix = No_File
2451 Error_Msg_Name_1 := Lang_Index.Display_Name;
2454 "no suffixes specified for %%",
2455 No_Location, Project);
2459 Lang_Index := Lang_Index.Next;
2461 end Check_Configuration;
2463 -------------------------------
2464 -- Check_If_Externally_Built --
2465 -------------------------------
2467 procedure Check_If_Externally_Built
2468 (Project : Project_Id;
2469 Data : in out Tree_Processing_Data)
2471 Externally_Built : constant Variable_Value :=
2473 (Name_Externally_Built,
2474 Project.Decl.Attributes, Data.Tree);
2477 if not Externally_Built.Default then
2478 Get_Name_String (Externally_Built.Value);
2479 To_Lower (Name_Buffer (1 .. Name_Len));
2481 if Name_Buffer (1 .. Name_Len) = "true" then
2482 Project.Externally_Built := True;
2484 elsif Name_Buffer (1 .. Name_Len) /= "false" then
2485 Error_Msg (Data.Flags,
2486 "Externally_Built may only be true or false",
2487 Externally_Built.Location, Project);
2491 -- A virtual project extending an externally built project is itself
2492 -- externally built.
2494 if Project.Virtual and then Project.Extends /= No_Project then
2495 Project.Externally_Built := Project.Extends.Externally_Built;
2498 if Current_Verbosity = High then
2499 Write_Str ("Project is ");
2501 if not Project.Externally_Built then
2505 Write_Line ("externally built.");
2507 end Check_If_Externally_Built;
2509 ----------------------
2510 -- Check_Interfaces --
2511 ----------------------
2513 procedure Check_Interfaces
2514 (Project : Project_Id;
2515 Data : in out Tree_Processing_Data)
2517 Interfaces : constant Prj.Variable_Value :=
2519 (Snames.Name_Interfaces,
2520 Project.Decl.Attributes,
2523 List : String_List_Id;
2524 Element : String_Element;
2525 Name : File_Name_Type;
2526 Iter : Source_Iterator;
2528 Project_2 : Project_Id;
2532 if not Interfaces.Default then
2534 -- Set In_Interfaces to False for all sources. It will be set to True
2535 -- later for the sources in the Interfaces list.
2537 Project_2 := Project;
2538 while Project_2 /= No_Project loop
2539 Iter := For_Each_Source (Data.Tree, Project_2);
2541 Source := Prj.Element (Iter);
2542 exit when Source = No_Source;
2543 Source.In_Interfaces := False;
2547 Project_2 := Project_2.Extends;
2550 List := Interfaces.Values;
2551 while List /= Nil_String loop
2552 Element := Data.Tree.String_Elements.Table (List);
2553 Name := Canonical_Case_File_Name (Element.Value);
2555 Project_2 := Project;
2557 while Project_2 /= No_Project loop
2558 Iter := For_Each_Source (Data.Tree, Project_2);
2561 Source := Prj.Element (Iter);
2562 exit when Source = No_Source;
2564 if Source.File = Name then
2565 if not Source.Locally_Removed then
2566 Source.In_Interfaces := True;
2567 Source.Declared_In_Interfaces := True;
2569 Other := Other_Part (Source);
2571 if Other /= No_Source then
2572 Other.In_Interfaces := True;
2573 Other.Declared_In_Interfaces := True;
2576 if Current_Verbosity = High then
2577 Write_Str (" interface: ");
2578 Write_Line (Get_Name_String (Source.Path.Name));
2588 Project_2 := Project_2.Extends;
2591 if Source = No_Source then
2592 Error_Msg_File_1 := File_Name_Type (Element.Value);
2593 Error_Msg_Name_1 := Project.Name;
2597 "{ cannot be an interface of project %% "
2598 & "as it is not one of its sources",
2599 Element.Location, Project);
2602 List := Element.Next;
2605 Project.Interfaces_Defined := True;
2607 elsif Project.Extends /= No_Project then
2608 Project.Interfaces_Defined := Project.Extends.Interfaces_Defined;
2610 if Project.Interfaces_Defined then
2611 Iter := For_Each_Source (Data.Tree, Project);
2613 Source := Prj.Element (Iter);
2614 exit when Source = No_Source;
2616 if not Source.Declared_In_Interfaces then
2617 Source.In_Interfaces := False;
2624 end Check_Interfaces;
2626 --------------------------
2627 -- Check_Package_Naming --
2628 --------------------------
2630 procedure Check_Package_Naming
2631 (Project : Project_Id;
2632 Data : in out Tree_Processing_Data;
2633 Bodies : out Array_Element_Id;
2634 Specs : out Array_Element_Id)
2636 Naming_Id : constant Package_Id :=
2638 (Name_Naming, Project.Decl.Packages, Data.Tree);
2639 Naming : Package_Element;
2641 Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
2643 procedure Check_Naming;
2644 -- Check the validity of the Naming package (suffixes valid, ...)
2646 procedure Check_Common
2647 (Dot_Replacement : in out File_Name_Type;
2648 Casing : in out Casing_Type;
2649 Casing_Defined : out Boolean;
2650 Separate_Suffix : in out File_Name_Type;
2651 Sep_Suffix_Loc : out Source_Ptr);
2652 -- Check attributes common
2654 procedure Process_Exceptions_File_Based
2655 (Lang_Id : Language_Ptr;
2656 Kind : Source_Kind);
2657 procedure Process_Exceptions_Unit_Based
2658 (Lang_Id : Language_Ptr;
2659 Kind : Source_Kind);
2660 -- Process the naming exceptions for the two types of languages
2662 procedure Initialize_Naming_Data;
2663 -- Initialize internal naming data for the various languages
2669 procedure Check_Common
2670 (Dot_Replacement : in out File_Name_Type;
2671 Casing : in out Casing_Type;
2672 Casing_Defined : out Boolean;
2673 Separate_Suffix : in out File_Name_Type;
2674 Sep_Suffix_Loc : out Source_Ptr)
2676 Dot_Repl : constant Variable_Value :=
2678 (Name_Dot_Replacement,
2679 Naming.Decl.Attributes,
2681 Casing_String : constant Variable_Value :=
2684 Naming.Decl.Attributes,
2686 Sep_Suffix : constant Variable_Value :=
2688 (Name_Separate_Suffix,
2689 Naming.Decl.Attributes,
2691 Dot_Repl_Loc : Source_Ptr;
2694 Sep_Suffix_Loc := No_Location;
2696 if not Dot_Repl.Default then
2698 (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
2700 if Length_Of_Name (Dot_Repl.Value) = 0 then
2702 (Data.Flags, "Dot_Replacement cannot be empty",
2703 Dot_Repl.Location, Project);
2706 Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
2707 Dot_Repl_Loc := Dot_Repl.Location;
2710 Repl : constant String := Get_Name_String (Dot_Replacement);
2713 -- Dot_Replacement cannot
2715 -- - start or end with an alphanumeric
2716 -- - be a single '_'
2717 -- - start with an '_' followed by an alphanumeric
2718 -- - contain a '.' except if it is "."
2721 or else Is_Alphanumeric (Repl (Repl'First))
2722 or else Is_Alphanumeric (Repl (Repl'Last))
2723 or else (Repl (Repl'First) = '_'
2727 Is_Alphanumeric (Repl (Repl'First + 1))))
2728 or else (Repl'Length > 1
2730 Index (Source => Repl, Pattern => ".") /= 0)
2735 """ is illegal for Dot_Replacement.",
2736 Dot_Repl_Loc, Project);
2741 if Dot_Replacement /= No_File then
2743 ("Dot_Replacement", Get_Name_String (Dot_Replacement));
2746 Casing_Defined := False;
2748 if not Casing_String.Default then
2750 (Casing_String.Kind = Single, "Casing is not a string");
2753 Casing_Image : constant String :=
2754 Get_Name_String (Casing_String.Value);
2757 if Casing_Image'Length = 0 then
2760 "Casing cannot be an empty string",
2761 Casing_String.Location, Project);
2764 Casing := Value (Casing_Image);
2765 Casing_Defined := True;
2768 when Constraint_Error =>
2769 Name_Len := Casing_Image'Length;
2770 Name_Buffer (1 .. Name_Len) := Casing_Image;
2771 Err_Vars.Error_Msg_Name_1 := Name_Find;
2774 "%% is not a correct Casing",
2775 Casing_String.Location, Project);
2779 Write_Attr ("Casing", Image (Casing));
2781 if not Sep_Suffix.Default then
2782 if Length_Of_Name (Sep_Suffix.Value) = 0 then
2785 "Separate_Suffix cannot be empty",
2786 Sep_Suffix.Location, Project);
2789 Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
2790 Sep_Suffix_Loc := Sep_Suffix.Location;
2792 Check_Illegal_Suffix
2793 (Project, Separate_Suffix,
2794 Dot_Replacement, "Separate_Suffix", Sep_Suffix.Location,
2799 if Separate_Suffix /= No_File then
2801 ("Separate_Suffix", Get_Name_String (Separate_Suffix));
2805 -----------------------------------
2806 -- Process_Exceptions_File_Based --
2807 -----------------------------------
2809 procedure Process_Exceptions_File_Based
2810 (Lang_Id : Language_Ptr;
2813 Lang : constant Name_Id := Lang_Id.Name;
2814 Exceptions : Array_Element_Id;
2815 Exception_List : Variable_Value;
2816 Element_Id : String_List_Id;
2817 Element : String_Element;
2818 File_Name : File_Name_Type;
2820 Iter : Source_Iterator;
2827 (Name_Implementation_Exceptions,
2828 In_Arrays => Naming.Decl.Arrays,
2829 In_Tree => Data.Tree);
2834 (Name_Specification_Exceptions,
2835 In_Arrays => Naming.Decl.Arrays,
2836 In_Tree => Data.Tree);
2839 Exception_List := Value_Of
2841 In_Array => Exceptions,
2842 In_Tree => Data.Tree);
2844 if Exception_List /= Nil_Variable_Value then
2845 Element_Id := Exception_List.Values;
2846 while Element_Id /= Nil_String loop
2847 Element := Data.Tree.String_Elements.Table (Element_Id);
2848 File_Name := Canonical_Case_File_Name (Element.Value);
2850 Iter := For_Each_Source (Data.Tree, Project);
2852 Source := Prj.Element (Iter);
2853 exit when Source = No_Source or else Source.File = File_Name;
2857 if Source = No_Source then
2862 Source_Dir_Rank => 0,
2865 File_Name => File_Name,
2866 Display_File => File_Name_Type (Element.Value),
2867 Naming_Exception => True);
2870 -- Check if the file name is already recorded for another
2871 -- language or another kind.
2873 if Source.Language /= Lang_Id then
2876 "the same file cannot be a source of two languages",
2877 Element.Location, Project);
2879 elsif Source.Kind /= Kind then
2882 "the same file cannot be a source and a template",
2883 Element.Location, Project);
2886 -- If the file is already recorded for the same
2887 -- language and the same kind, it means that the file
2888 -- name appears several times in the *_Exceptions
2889 -- attribute; so there is nothing to do.
2892 Element_Id := Element.Next;
2895 end Process_Exceptions_File_Based;
2897 -----------------------------------
2898 -- Process_Exceptions_Unit_Based --
2899 -----------------------------------
2901 procedure Process_Exceptions_Unit_Based
2902 (Lang_Id : Language_Ptr;
2905 Lang : constant Name_Id := Lang_Id.Name;
2906 Exceptions : Array_Element_Id;
2907 Element : Array_Element;
2910 File_Name : File_Name_Type;
2919 In_Arrays => Naming.Decl.Arrays,
2920 In_Tree => Data.Tree);
2922 if Exceptions = No_Array_Element then
2925 (Name_Implementation,
2926 In_Arrays => Naming.Decl.Arrays,
2927 In_Tree => Data.Tree);
2934 In_Arrays => Naming.Decl.Arrays,
2935 In_Tree => Data.Tree);
2937 if Exceptions = No_Array_Element then
2941 In_Arrays => Naming.Decl.Arrays,
2942 In_Tree => Data.Tree);
2946 while Exceptions /= No_Array_Element loop
2947 Element := Data.Tree.Array_Elements.Table (Exceptions);
2948 File_Name := Canonical_Case_File_Name (Element.Value.Value);
2950 Get_Name_String (Element.Index);
2951 To_Lower (Name_Buffer (1 .. Name_Len));
2953 Index := Element.Value.Index;
2955 -- For Ada, check if it is a valid unit name
2957 if Lang = Name_Ada then
2958 Get_Name_String (Element.Index);
2959 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
2961 if Unit = No_Name then
2962 Err_Vars.Error_Msg_Name_1 := Element.Index;
2965 "%% is not a valid unit name.",
2966 Element.Value.Location, Project);
2970 if Unit /= No_Name then
2975 Source_Dir_Rank => 0,
2978 File_Name => File_Name,
2979 Display_File => File_Name_Type (Element.Value.Value),
2982 Location => Element.Value.Location,
2983 Naming_Exception => True);
2986 Exceptions := Element.Next;
2988 end Process_Exceptions_Unit_Based;
2994 procedure Check_Naming is
2995 Dot_Replacement : File_Name_Type :=
2997 (First_Name_Id + Character'Pos ('-'));
2998 Separate_Suffix : File_Name_Type := No_File;
2999 Casing : Casing_Type := All_Lower_Case;
3000 Casing_Defined : Boolean;
3001 Lang_Id : Language_Ptr;
3002 Sep_Suffix_Loc : Source_Ptr;
3003 Suffix : Variable_Value;
3008 (Dot_Replacement => Dot_Replacement,
3010 Casing_Defined => Casing_Defined,
3011 Separate_Suffix => Separate_Suffix,
3012 Sep_Suffix_Loc => Sep_Suffix_Loc);
3014 -- For all unit based languages, if any, set the specified value
3015 -- of Dot_Replacement, Casing and/or Separate_Suffix. Do not
3016 -- systematically overwrite, since the defaults come from the
3017 -- configuration file.
3019 if Dot_Replacement /= No_File
3020 or else Casing_Defined
3021 or else Separate_Suffix /= No_File
3023 Lang_Id := Project.Languages;
3024 while Lang_Id /= No_Language_Index loop
3025 if Lang_Id.Config.Kind = Unit_Based then
3026 if Dot_Replacement /= No_File then
3027 Lang_Id.Config.Naming_Data.Dot_Replacement :=
3031 if Casing_Defined then
3032 Lang_Id.Config.Naming_Data.Casing := Casing;
3036 Lang_Id := Lang_Id.Next;
3040 -- Next, get the spec and body suffixes
3042 Lang_Id := Project.Languages;
3043 while Lang_Id /= No_Language_Index loop
3044 Lang := Lang_Id.Name;
3050 Attribute_Or_Array_Name => Name_Spec_Suffix,
3051 In_Package => Naming_Id,
3052 In_Tree => Data.Tree);
3054 if Suffix = Nil_Variable_Value then
3057 Attribute_Or_Array_Name => Name_Specification_Suffix,
3058 In_Package => Naming_Id,
3059 In_Tree => Data.Tree);
3062 if Suffix /= Nil_Variable_Value then
3063 Lang_Id.Config.Naming_Data.Spec_Suffix :=
3064 File_Name_Type (Suffix.Value);
3066 Check_Illegal_Suffix
3068 Lang_Id.Config.Naming_Data.Spec_Suffix,
3069 Lang_Id.Config.Naming_Data.Dot_Replacement,
3070 "Spec_Suffix", Suffix.Location, Data);
3074 Get_Name_String (Lang_Id.Config.Naming_Data.Spec_Suffix));
3082 Attribute_Or_Array_Name => Name_Body_Suffix,
3083 In_Package => Naming_Id,
3084 In_Tree => Data.Tree);
3086 if Suffix = Nil_Variable_Value then
3090 Attribute_Or_Array_Name => Name_Implementation_Suffix,
3091 In_Package => Naming_Id,
3092 In_Tree => Data.Tree);
3095 if Suffix /= Nil_Variable_Value then
3096 Lang_Id.Config.Naming_Data.Body_Suffix :=
3097 File_Name_Type (Suffix.Value);
3099 -- The default value of separate suffix should be the same as
3100 -- the body suffix, so we need to compute that first.
3102 if Separate_Suffix = No_File then
3103 Lang_Id.Config.Naming_Data.Separate_Suffix :=
3104 Lang_Id.Config.Naming_Data.Body_Suffix;
3108 (Lang_Id.Config.Naming_Data.Separate_Suffix));
3110 Lang_Id.Config.Naming_Data.Separate_Suffix :=
3114 Check_Illegal_Suffix
3116 Lang_Id.Config.Naming_Data.Body_Suffix,
3117 Lang_Id.Config.Naming_Data.Dot_Replacement,
3118 "Body_Suffix", Suffix.Location, Data);
3122 Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix));
3124 elsif Separate_Suffix /= No_File then
3125 Lang_Id.Config.Naming_Data.Separate_Suffix := Separate_Suffix;
3128 -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
3129 -- since that would cause a clear ambiguity. Note that we do allow
3130 -- a Spec_Suffix to have the same termination as one of these,
3131 -- which causes a potential ambiguity, but we resolve that my
3132 -- matching the longest possible suffix.
3134 if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
3135 and then Lang_Id.Config.Naming_Data.Spec_Suffix =
3136 Lang_Id.Config.Naming_Data.Body_Suffix
3141 & Get_Name_String (Lang_Id.Config.Naming_Data.Body_Suffix)
3142 & """) cannot be the same as Spec_Suffix.",
3143 Ada_Body_Suffix_Loc, Project);
3146 if Lang_Id.Config.Naming_Data.Body_Suffix /=
3147 Lang_Id.Config.Naming_Data.Separate_Suffix
3148 and then Lang_Id.Config.Naming_Data.Spec_Suffix =
3149 Lang_Id.Config.Naming_Data.Separate_Suffix
3153 "Separate_Suffix ("""
3155 (Lang_Id.Config.Naming_Data.Separate_Suffix)
3156 & """) cannot be the same as Spec_Suffix.",
3157 Sep_Suffix_Loc, Project);
3160 Lang_Id := Lang_Id.Next;
3163 -- Get the naming exceptions for all languages
3165 for Kind in Spec .. Impl loop
3166 Lang_Id := Project.Languages;
3167 while Lang_Id /= No_Language_Index loop
3168 case Lang_Id.Config.Kind is
3170 Process_Exceptions_File_Based (Lang_Id, Kind);
3173 Process_Exceptions_Unit_Based (Lang_Id, Kind);
3176 Lang_Id := Lang_Id.Next;
3181 ----------------------------
3182 -- Initialize_Naming_Data --
3183 ----------------------------
3185 procedure Initialize_Naming_Data is
3186 Specs : Array_Element_Id :=
3192 Impls : Array_Element_Id :=
3198 Lang : Language_Ptr;
3199 Lang_Name : Name_Id;
3200 Value : Variable_Value;
3201 Extended : Project_Id;
3204 -- At this stage, the project already contains the default extensions
3205 -- for the various languages. We now merge those suffixes read in the
3206 -- user project, and they override the default.
3208 while Specs /= No_Array_Element loop
3209 Lang_Name := Data.Tree.Array_Elements.Table (Specs).Index;
3211 Get_Language_From_Name
3212 (Project, Name => Get_Name_String (Lang_Name));
3214 -- An extending project inherits its parent projects' languages
3215 -- so if needed we should create entries for those languages
3218 Extended := Project.Extends;
3219 while Extended /= null loop
3220 Lang := Get_Language_From_Name
3221 (Extended, Name => Get_Name_String (Lang_Name));
3222 exit when Lang /= null;
3224 Extended := Extended.Extends;
3227 if Lang /= null then
3228 Lang := new Language_Data'(Lang.all);
3229 Lang.First_Source := null;
3230 Lang.Next := Project.Languages;
3231 Project.Languages := Lang;
3235 -- If language was not found in project or the projects it extends
3238 if Current_Verbosity = High then
3240 ("Ignoring spec naming data for "
3241 & Get_Name_String (Lang_Name)
3242 & " since language is not defined for this project");
3246 Value := Data.Tree.Array_Elements.Table (Specs).Value;
3248 if Value.Kind = Single then
3249 Lang.Config.Naming_Data.Spec_Suffix :=
3250 Canonical_Case_File_Name (Value.Value);
3254 Specs := Data.Tree.Array_Elements.Table (Specs).Next;
3257 while Impls /= No_Array_Element loop
3258 Lang_Name := Data.Tree.Array_Elements.Table (Impls).Index;
3260 Get_Language_From_Name
3261 (Project, Name => Get_Name_String (Lang_Name));
3264 if Current_Verbosity = High then
3266 ("Ignoring impl naming data for "
3267 & Get_Name_String (Lang_Name)
3268 & " since language is not defined for this project");
3271 Value := Data.Tree.Array_Elements.Table (Impls).Value;
3273 if Lang.Name = Name_Ada then
3274 Ada_Body_Suffix_Loc := Value.Location;
3277 if Value.Kind = Single then
3278 Lang.Config.Naming_Data.Body_Suffix :=
3279 Canonical_Case_File_Name (Value.Value);
3283 Impls := Data.Tree.Array_Elements.Table (Impls).Next;
3285 end Initialize_Naming_Data;
3287 -- Start of processing for Check_Naming_Schemes
3290 Specs := No_Array_Element;
3291 Bodies := No_Array_Element;
3293 -- No Naming package or parsing a configuration file? nothing to do
3295 if Naming_Id /= No_Package
3296 and then Project.Qualifier /= Configuration
3298 Naming := Data.Tree.Packages.Table (Naming_Id);
3300 if Current_Verbosity = High then
3301 Write_Line ("Checking package Naming for project "
3302 & Get_Name_String (Project.Name));
3305 Initialize_Naming_Data;
3308 end Check_Package_Naming;
3310 ------------------------------
3311 -- Check_Library_Attributes --
3312 ------------------------------
3314 procedure Check_Library_Attributes
3315 (Project : Project_Id;
3316 Data : in out Tree_Processing_Data)
3318 Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
3320 Lib_Dir : constant Prj.Variable_Value :=
3322 (Snames.Name_Library_Dir, Attributes, Data.Tree);
3324 Lib_Name : constant Prj.Variable_Value :=
3326 (Snames.Name_Library_Name, Attributes, Data.Tree);
3328 Lib_Version : constant Prj.Variable_Value :=
3330 (Snames.Name_Library_Version, Attributes, Data.Tree);
3332 Lib_ALI_Dir : constant Prj.Variable_Value :=
3334 (Snames.Name_Library_Ali_Dir, Attributes, Data.Tree);
3336 Lib_GCC : constant Prj.Variable_Value :=
3338 (Snames.Name_Library_GCC, Attributes, Data.Tree);
3340 The_Lib_Kind : constant Prj.Variable_Value :=
3342 (Snames.Name_Library_Kind, Attributes, Data.Tree);
3344 Imported_Project_List : Project_List;
3346 Continuation : String_Access := No_Continuation_String'Access;
3348 Support_For_Libraries : Library_Support;
3350 Library_Directory_Present : Boolean;
3352 procedure Check_Library (Proj : Project_Id; Extends : Boolean);
3353 -- Check if an imported or extended project if also a library project
3359 procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
3361 Iter : Source_Iterator;
3364 if Proj /= No_Project then
3365 if not Proj.Library then
3367 -- The only not library projects that are OK are those that
3368 -- have no sources. However, header files from non-Ada
3369 -- languages are OK, as there is nothing to compile.
3371 Iter := For_Each_Source (Data.Tree, Proj);
3373 Src_Id := Prj.Element (Iter);
3374 exit when Src_Id = No_Source
3375 or else Src_Id.Language.Config.Kind /= File_Based
3376 or else Src_Id.Kind /= Spec;
3380 if Src_Id /= No_Source then
3381 Error_Msg_Name_1 := Project.Name;
3382 Error_Msg_Name_2 := Proj.Name;
3385 if Project.Library_Kind /= Static then
3389 "shared library project %% cannot extend " &
3390 "project %% that is not a library project",
3391 Project.Location, Project);
3392 Continuation := Continuation_String'Access;
3395 elsif (not Unchecked_Shared_Lib_Imports)
3396 and then Project.Library_Kind /= Static
3401 "shared library project %% cannot import project %% " &
3402 "that is not a shared library project",
3403 Project.Location, Project);
3404 Continuation := Continuation_String'Access;
3408 elsif Project.Library_Kind /= Static and then
3409 Proj.Library_Kind = Static
3411 Error_Msg_Name_1 := Project.Name;
3412 Error_Msg_Name_2 := Proj.Name;
3418 "shared library project %% cannot extend static " &
3419 "library project %%",
3420 Project.Location, Project);
3421 Continuation := Continuation_String'Access;
3423 elsif not Unchecked_Shared_Lib_Imports then
3427 "shared library project %% cannot import static " &
3428 "library project %%",
3429 Project.Location, Project);
3430 Continuation := Continuation_String'Access;
3437 Dir_Exists : Boolean;
3439 -- Start of processing for Check_Library_Attributes
3442 Library_Directory_Present := Lib_Dir.Value /= Empty_String;
3444 -- Special case of extending project
3446 if Project.Extends /= No_Project then
3448 -- If the project extended is a library project, we inherit the
3449 -- library name, if it is not redefined; we check that the library
3450 -- directory is specified.
3452 if Project.Extends.Library then
3453 if Project.Qualifier = Standard then
3456 "a standard project cannot extend a library project",
3457 Project.Location, Project);
3460 if Lib_Name.Default then
3461 Project.Library_Name := Project.Extends.Library_Name;
3464 if Lib_Dir.Default then
3465 if not Project.Virtual then
3468 "a project extending a library project must " &
3469 "specify an attribute Library_Dir",
3470 Project.Location, Project);
3473 -- For a virtual project extending a library project,
3474 -- inherit library directory.
3476 Project.Library_Dir := Project.Extends.Library_Dir;
3477 Library_Directory_Present := True;
3484 pragma Assert (Lib_Name.Kind = Single);
3486 if Lib_Name.Value = Empty_String then
3487 if Current_Verbosity = High
3488 and then Project.Library_Name = No_Name
3490 Write_Line ("No library name");
3494 -- There is no restriction on the syntax of library names
3496 Project.Library_Name := Lib_Name.Value;
3499 if Project.Library_Name /= No_Name then
3500 if Current_Verbosity = High then
3502 ("Library name", Get_Name_String (Project.Library_Name));
3505 pragma Assert (Lib_Dir.Kind = Single);
3507 if not Library_Directory_Present then
3508 if Current_Verbosity = High then
3509 Write_Line ("No library directory");
3513 -- Find path name (unless inherited), check that it is a directory
3515 if Project.Library_Dir = No_Path_Information then
3518 File_Name_Type (Lib_Dir.Value),
3519 Path => Project.Library_Dir,
3520 Dir_Exists => Dir_Exists,
3522 Create => "library",
3523 Must_Exist => False,
3524 Location => Lib_Dir.Location,
3525 Externally_Built => Project.Externally_Built);
3531 (Project.Library_Dir.Display_Name));
3534 if not Dir_Exists then
3536 -- Get the absolute name of the library directory that
3537 -- does not exist, to report an error.
3539 Err_Vars.Error_Msg_File_1 :=
3540 File_Name_Type (Project.Library_Dir.Display_Name);
3543 "library directory { does not exist",
3544 Lib_Dir.Location, Project);
3546 -- The library directory cannot be the same as the Object
3549 elsif Project.Library_Dir.Name = Project.Object_Directory.Name then
3552 "library directory cannot be the same " &
3553 "as object directory",
3554 Lib_Dir.Location, Project);
3555 Project.Library_Dir := No_Path_Information;
3559 OK : Boolean := True;
3560 Dirs_Id : String_List_Id;
3561 Dir_Elem : String_Element;
3565 -- The library directory cannot be the same as a source
3566 -- directory of the current project.
3568 Dirs_Id := Project.Source_Dirs;
3569 while Dirs_Id /= Nil_String loop
3570 Dir_Elem := Data.Tree.String_Elements.Table (Dirs_Id);
3571 Dirs_Id := Dir_Elem.Next;
3573 if Project.Library_Dir.Name =
3574 Path_Name_Type (Dir_Elem.Value)
3576 Err_Vars.Error_Msg_File_1 :=
3577 File_Name_Type (Dir_Elem.Value);
3580 "library directory cannot be the same " &
3581 "as source directory {",
3582 Lib_Dir.Location, Project);
3590 -- The library directory cannot be the same as a source
3591 -- directory of another project either.
3593 Pid := Data.Tree.Projects;
3595 exit Project_Loop when Pid = null;
3597 if Pid.Project /= Project then
3598 Dirs_Id := Pid.Project.Source_Dirs;
3600 Dir_Loop : while Dirs_Id /= Nil_String loop
3602 Data.Tree.String_Elements.Table (Dirs_Id);
3603 Dirs_Id := Dir_Elem.Next;
3605 if Project.Library_Dir.Name =
3606 Path_Name_Type (Dir_Elem.Value)
3608 Err_Vars.Error_Msg_File_1 :=
3609 File_Name_Type (Dir_Elem.Value);
3610 Err_Vars.Error_Msg_Name_1 := Pid.Project.Name;
3614 "library directory cannot be the same " &
3615 "as source directory { of project %%",
3616 Lib_Dir.Location, Project);
3624 end loop Project_Loop;
3628 Project.Library_Dir := No_Path_Information;
3630 elsif Current_Verbosity = High then
3632 -- Display the Library directory in high verbosity
3635 ("Library directory",
3636 Get_Name_String (Project.Library_Dir.Display_Name));
3645 Project.Library_Dir /= No_Path_Information
3646 and then Project.Library_Name /= No_Name;
3648 if Project.Extends = No_Project then
3649 case Project.Qualifier is
3651 if Project.Library then
3654 "a standard project cannot be a library project",
3655 Lib_Name.Location, Project);
3659 if not Project.Library then
3660 if Project.Library_Dir = No_Path_Information then
3663 "\attribute Library_Dir not declared",
3664 Project.Location, Project);
3667 if Project.Library_Name = No_Name then
3670 "\attribute Library_Name not declared",
3671 Project.Location, Project);
3681 if Project.Library then
3682 Support_For_Libraries := Project.Config.Lib_Support;
3684 if Support_For_Libraries = Prj.None then
3687 "?libraries are not supported on this platform",
3688 Lib_Name.Location, Project);
3689 Project.Library := False;
3692 if Lib_ALI_Dir.Value = Empty_String then
3693 if Current_Verbosity = High then
3694 Write_Line ("No library ALI directory specified");
3697 Project.Library_ALI_Dir := Project.Library_Dir;
3700 -- Find path name, check that it is a directory
3704 File_Name_Type (Lib_ALI_Dir.Value),
3705 Path => Project.Library_ALI_Dir,
3706 Create => "library ALI",
3707 Dir_Exists => Dir_Exists,
3709 Must_Exist => False,
3710 Location => Lib_ALI_Dir.Location,
3711 Externally_Built => Project.Externally_Built);
3713 if not Dir_Exists then
3715 -- Get the absolute name of the library ALI directory that
3716 -- does not exist, to report an error.
3718 Err_Vars.Error_Msg_File_1 :=
3719 File_Name_Type (Project.Library_ALI_Dir.Display_Name);
3722 "library 'A'L'I directory { does not exist",
3723 Lib_ALI_Dir.Location, Project);
3726 if Project.Library_ALI_Dir /= Project.Library_Dir then
3728 -- The library ALI directory cannot be the same as the
3729 -- Object directory.
3731 if Project.Library_ALI_Dir = Project.Object_Directory then
3734 "library 'A'L'I directory cannot be the same " &
3735 "as object directory",
3736 Lib_ALI_Dir.Location, Project);
3737 Project.Library_ALI_Dir := No_Path_Information;
3741 OK : Boolean := True;
3742 Dirs_Id : String_List_Id;
3743 Dir_Elem : String_Element;
3747 -- The library ALI directory cannot be the same as
3748 -- a source directory of the current project.
3750 Dirs_Id := Project.Source_Dirs;
3751 while Dirs_Id /= Nil_String loop
3753 Data.Tree.String_Elements.Table (Dirs_Id);
3754 Dirs_Id := Dir_Elem.Next;
3756 if Project.Library_ALI_Dir.Name =
3757 Path_Name_Type (Dir_Elem.Value)
3759 Err_Vars.Error_Msg_File_1 :=
3760 File_Name_Type (Dir_Elem.Value);
3763 "library 'A'L'I directory cannot be " &
3764 "the same as source directory {",
3765 Lib_ALI_Dir.Location, Project);
3773 -- The library ALI directory cannot be the same as
3774 -- a source directory of another project either.
3776 Pid := Data.Tree.Projects;
3777 ALI_Project_Loop : loop
3778 exit ALI_Project_Loop when Pid = null;
3780 if Pid.Project /= Project then
3781 Dirs_Id := Pid.Project.Source_Dirs;
3784 while Dirs_Id /= Nil_String loop
3786 Data.Tree.String_Elements.Table
3788 Dirs_Id := Dir_Elem.Next;
3790 if Project.Library_ALI_Dir.Name =
3791 Path_Name_Type (Dir_Elem.Value)
3793 Err_Vars.Error_Msg_File_1 :=
3794 File_Name_Type (Dir_Elem.Value);
3795 Err_Vars.Error_Msg_Name_1 :=
3800 "library 'A'L'I directory cannot " &
3801 "be the same as source directory " &
3803 Lib_ALI_Dir.Location, Project);
3805 exit ALI_Project_Loop;
3807 end loop ALI_Dir_Loop;
3810 end loop ALI_Project_Loop;
3814 Project.Library_ALI_Dir := No_Path_Information;
3816 elsif Current_Verbosity = High then
3818 -- Display Library ALI directory in high verbosity
3823 (Project.Library_ALI_Dir.Display_Name));
3830 pragma Assert (Lib_Version.Kind = Single);
3832 if Lib_Version.Value = Empty_String then
3833 if Current_Verbosity = High then
3834 Write_Line ("No library version specified");
3838 Project.Lib_Internal_Name := Lib_Version.Value;
3841 pragma Assert (The_Lib_Kind.Kind = Single);
3843 if The_Lib_Kind.Value = Empty_String then
3844 if Current_Verbosity = High then
3845 Write_Line ("No library kind specified");
3849 Get_Name_String (The_Lib_Kind.Value);
3852 Kind_Name : constant String :=
3853 To_Lower (Name_Buffer (1 .. Name_Len));
3855 OK : Boolean := True;
3858 if Kind_Name = "static" then
3859 Project.Library_Kind := Static;
3861 elsif Kind_Name = "dynamic" then
3862 Project.Library_Kind := Dynamic;
3864 elsif Kind_Name = "relocatable" then
3865 Project.Library_Kind := Relocatable;
3870 "illegal value for Library_Kind",
3871 The_Lib_Kind.Location, Project);
3875 if Current_Verbosity = High and then OK then
3876 Write_Attr ("Library kind", Kind_Name);
3879 if Project.Library_Kind /= Static then
3880 if Support_For_Libraries = Prj.Static_Only then
3883 "only static libraries are supported " &
3885 The_Lib_Kind.Location, Project);
3886 Project.Library := False;
3889 -- Check if (obsolescent) attribute Library_GCC or
3890 -- Linker'Driver is declared.
3892 if Lib_GCC.Value /= Empty_String then
3895 "?Library_'G'C'C is an obsolescent attribute, " &
3896 "use Linker''Driver instead",
3897 Lib_GCC.Location, Project);
3898 Project.Config.Shared_Lib_Driver :=
3899 File_Name_Type (Lib_GCC.Value);
3903 Linker : constant Package_Id :=
3906 Project.Decl.Packages,
3908 Driver : constant Variable_Value :=
3911 Attribute_Or_Array_Name =>
3913 In_Package => Linker,
3914 In_Tree => Data.Tree);
3917 if Driver /= Nil_Variable_Value
3918 and then Driver.Value /= Empty_String
3920 Project.Config.Shared_Lib_Driver :=
3921 File_Name_Type (Driver.Value);
3930 if Project.Library then
3931 if Current_Verbosity = High then
3932 Write_Line ("This is a library project file");
3935 Check_Library (Project.Extends, Extends => True);
3937 Imported_Project_List := Project.Imported_Projects;
3938 while Imported_Project_List /= null loop
3940 (Imported_Project_List.Project,
3942 Imported_Project_List := Imported_Project_List.Next;
3949 -- Check if Linker'Switches or Linker'Default_Switches are declared.
3950 -- Warn if they are declared, as it is a common error to think that
3951 -- library are "linked" with Linker switches.
3953 if Project.Library then
3955 Linker_Package_Id : constant Package_Id :=
3958 Project.Decl.Packages, Data.Tree);
3959 Linker_Package : Package_Element;
3960 Switches : Array_Element_Id := No_Array_Element;
3963 if Linker_Package_Id /= No_Package then
3964 Linker_Package := Data.Tree.Packages.Table (Linker_Package_Id);
3968 (Name => Name_Switches,
3969 In_Arrays => Linker_Package.Decl.Arrays,
3970 In_Tree => Data.Tree);
3972 if Switches = No_Array_Element then
3975 (Name => Name_Default_Switches,
3976 In_Arrays => Linker_Package.Decl.Arrays,
3977 In_Tree => Data.Tree);
3980 if Switches /= No_Array_Element then
3983 "?Linker switches not taken into account in library " &
3985 No_Location, Project);
3991 if Project.Extends /= No_Project then
3992 Project.Extends.Library := False;
3994 end Check_Library_Attributes;
3996 ---------------------------------
3997 -- Check_Programming_Languages --
3998 ---------------------------------
4000 procedure Check_Programming_Languages
4001 (Project : Project_Id;
4002 Data : in out Tree_Processing_Data)
4004 Languages : Variable_Value := Nil_Variable_Value;
4005 Def_Lang : Variable_Value := Nil_Variable_Value;
4006 Def_Lang_Id : Name_Id;
4008 procedure Add_Language (Name, Display_Name : Name_Id);
4009 -- Add a new language to the list of languages for the project.
4010 -- Nothing is done if the language has already been defined
4016 procedure Add_Language (Name, Display_Name : Name_Id) is
4017 Lang : Language_Ptr;
4020 Lang := Project.Languages;
4021 while Lang /= No_Language_Index loop
4022 if Name = Lang.Name then
4029 Lang := new Language_Data'(No_Language_Data);
4030 Lang.Next := Project.Languages;
4031 Project.Languages := Lang;
4033 Lang.Display_Name := Display_Name;
4035 if Name = Name_Ada then
4036 Lang.Config.Kind := Unit_Based;
4037 Lang.Config.Dependency_Kind := ALI_File;
4039 Lang.Config.Kind := File_Based;
4043 -- Start of processing for Check_Programming_Languages
4046 Project.Languages := null;
4048 Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, Data.Tree);
4051 (Name_Default_Language, Project.Decl.Attributes, Data.Tree);
4053 if Project.Source_Dirs /= Nil_String then
4055 -- Check if languages are specified in this project
4057 if Languages.Default then
4059 -- Fail if there is no default language defined
4061 if Def_Lang.Default then
4064 "no languages defined for this project",
4065 Project.Location, Project);
4066 Def_Lang_Id := No_Name;
4069 Get_Name_String (Def_Lang.Value);
4070 To_Lower (Name_Buffer (1 .. Name_Len));
4071 Def_Lang_Id := Name_Find;
4074 if Def_Lang_Id /= No_Name then
4075 Get_Name_String (Def_Lang_Id);
4076 Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
4078 (Name => Def_Lang_Id,
4079 Display_Name => Name_Find);
4084 Current : String_List_Id := Languages.Values;
4085 Element : String_Element;
4088 -- If there are no languages declared, there are no sources
4090 if Current = Nil_String then
4091 Project.Source_Dirs := Nil_String;
4093 if Project.Qualifier = Standard then
4096 "a standard project must have at least one language",
4097 Languages.Location, Project);
4101 -- Look through all the languages specified in attribute
4104 while Current /= Nil_String loop
4105 Element := Data.Tree.String_Elements.Table (Current);
4106 Get_Name_String (Element.Value);
4107 To_Lower (Name_Buffer (1 .. Name_Len));
4111 Display_Name => Element.Value);
4113 Current := Element.Next;
4119 end Check_Programming_Languages;
4121 -------------------------------
4122 -- Check_Stand_Alone_Library --
4123 -------------------------------
4125 procedure Check_Stand_Alone_Library
4126 (Project : Project_Id;
4127 Data : in out Tree_Processing_Data)
4129 Lib_Interfaces : constant Prj.Variable_Value :=
4131 (Snames.Name_Library_Interface,
4132 Project.Decl.Attributes,
4135 Lib_Auto_Init : constant Prj.Variable_Value :=
4137 (Snames.Name_Library_Auto_Init,
4138 Project.Decl.Attributes,
4141 Lib_Src_Dir : constant Prj.Variable_Value :=
4143 (Snames.Name_Library_Src_Dir,
4144 Project.Decl.Attributes,
4147 Lib_Symbol_File : constant Prj.Variable_Value :=
4149 (Snames.Name_Library_Symbol_File,
4150 Project.Decl.Attributes,
4153 Lib_Symbol_Policy : constant Prj.Variable_Value :=
4155 (Snames.Name_Library_Symbol_Policy,
4156 Project.Decl.Attributes,
4159 Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
4161 (Snames.Name_Library_Reference_Symbol_File,
4162 Project.Decl.Attributes,
4165 Auto_Init_Supported : Boolean;
4166 OK : Boolean := True;
4168 Next_Proj : Project_Id;
4169 Iter : Source_Iterator;
4172 Auto_Init_Supported := Project.Config.Auto_Init_Supported;
4174 pragma Assert (Lib_Interfaces.Kind = List);
4176 -- It is a stand-alone library project file if attribute
4177 -- Library_Interface is defined.
4179 if not Lib_Interfaces.Default then
4181 Interfaces : String_List_Id := Lib_Interfaces.Values;
4182 Interface_ALIs : String_List_Id := Nil_String;
4186 Project.Standalone_Library := True;
4188 -- Library_Interface cannot be an empty list
4190 if Interfaces = Nil_String then
4193 "Library_Interface cannot be an empty list",
4194 Lib_Interfaces.Location, Project);
4197 -- Process each unit name specified in the attribute
4198 -- Library_Interface.
4200 while Interfaces /= Nil_String loop
4202 (Data.Tree.String_Elements.Table (Interfaces).Value);
4203 To_Lower (Name_Buffer (1 .. Name_Len));
4205 if Name_Len = 0 then
4208 "an interface cannot be an empty string",
4209 Data.Tree.String_Elements.Table (Interfaces).Location,
4214 Error_Msg_Name_1 := Unit;
4216 Next_Proj := Project.Extends;
4217 Iter := For_Each_Source (Data.Tree, Project);
4219 while Prj.Element (Iter) /= No_Source
4221 (Prj.Element (Iter).Unit = null
4222 or else Prj.Element (Iter).Unit.Name /= Unit)
4227 Source := Prj.Element (Iter);
4228 exit when Source /= No_Source
4229 or else Next_Proj = No_Project;
4231 Iter := For_Each_Source (Data.Tree, Next_Proj);
4232 Next_Proj := Next_Proj.Extends;
4235 if Source /= No_Source then
4236 if Source.Kind = Sep then
4237 Source := No_Source;
4239 elsif Source.Kind = Spec
4240 and then Other_Part (Source) /= No_Source
4242 Source := Other_Part (Source);
4246 if Source /= No_Source then
4247 if Source.Project /= Project
4248 and then not Is_Extending (Project, Source.Project)
4250 Source := No_Source;
4254 if Source = No_Source then
4257 "%% is not a unit of this project",
4258 Data.Tree.String_Elements.Table
4259 (Interfaces).Location, Project);
4262 if Source.Kind = Spec
4263 and then Other_Part (Source) /= No_Source
4265 Source := Other_Part (Source);
4268 String_Element_Table.Increment_Last
4269 (Data.Tree.String_Elements);
4271 Data.Tree.String_Elements.Table
4272 (String_Element_Table.Last
4273 (Data.Tree.String_Elements)) :=
4274 (Value => Name_Id (Source.Dep_Name),
4276 Display_Value => Name_Id (Source.Dep_Name),
4278 Data.Tree.String_Elements.Table
4279 (Interfaces).Location,
4281 Next => Interface_ALIs);
4284 String_Element_Table.Last
4285 (Data.Tree.String_Elements);
4289 Interfaces := Data.Tree.String_Elements.Table (Interfaces).Next;
4292 -- Put the list of Interface ALIs in the project data
4294 Project.Lib_Interface_ALIs := Interface_ALIs;
4296 -- Check value of attribute Library_Auto_Init and set
4297 -- Lib_Auto_Init accordingly.
4299 if Lib_Auto_Init.Default then
4301 -- If no attribute Library_Auto_Init is declared, then set auto
4302 -- init only if it is supported.
4304 Project.Lib_Auto_Init := Auto_Init_Supported;
4307 Get_Name_String (Lib_Auto_Init.Value);
4308 To_Lower (Name_Buffer (1 .. Name_Len));
4310 if Name_Buffer (1 .. Name_Len) = "false" then
4311 Project.Lib_Auto_Init := False;
4313 elsif Name_Buffer (1 .. Name_Len) = "true" then
4314 if Auto_Init_Supported then
4315 Project.Lib_Auto_Init := True;
4318 -- Library_Auto_Init cannot be "true" if auto init is not
4323 "library auto init not supported " &
4325 Lib_Auto_Init.Location, Project);
4331 "invalid value for attribute Library_Auto_Init",
4332 Lib_Auto_Init.Location, Project);
4337 -- If attribute Library_Src_Dir is defined and not the empty string,
4338 -- check if the directory exist and is not the object directory or
4339 -- one of the source directories. This is the directory where copies
4340 -- of the interface sources will be copied. Note that this directory
4341 -- may be the library directory.
4343 if Lib_Src_Dir.Value /= Empty_String then
4345 Dir_Id : constant File_Name_Type :=
4346 File_Name_Type (Lib_Src_Dir.Value);
4347 Dir_Exists : Boolean;
4353 Path => Project.Library_Src_Dir,
4354 Dir_Exists => Dir_Exists,
4356 Must_Exist => False,
4357 Create => "library source copy",
4358 Location => Lib_Src_Dir.Location,
4359 Externally_Built => Project.Externally_Built);
4361 -- If directory does not exist, report an error
4363 if not Dir_Exists then
4365 -- Get the absolute name of the library directory that does
4366 -- not exist, to report an error.
4368 Err_Vars.Error_Msg_File_1 :=
4369 File_Name_Type (Project.Library_Src_Dir.Display_Name);
4372 "Directory { does not exist",
4373 Lib_Src_Dir.Location, Project);
4375 -- Report error if it is the same as the object directory
4377 elsif Project.Library_Src_Dir = Project.Object_Directory then
4380 "directory to copy interfaces cannot be " &
4381 "the object directory",
4382 Lib_Src_Dir.Location, Project);
4383 Project.Library_Src_Dir := No_Path_Information;
4387 Src_Dirs : String_List_Id;
4388 Src_Dir : String_Element;
4392 -- Interface copy directory cannot be one of the source
4393 -- directory of the current project.
4395 Src_Dirs := Project.Source_Dirs;
4396 while Src_Dirs /= Nil_String loop
4397 Src_Dir := Data.Tree.String_Elements.Table (Src_Dirs);
4399 -- Report error if it is one of the source directories
4401 if Project.Library_Src_Dir.Name =
4402 Path_Name_Type (Src_Dir.Value)
4406 "directory to copy interfaces cannot " &
4407 "be one of the source directories",
4408 Lib_Src_Dir.Location, Project);
4409 Project.Library_Src_Dir := No_Path_Information;
4413 Src_Dirs := Src_Dir.Next;
4416 if Project.Library_Src_Dir /= No_Path_Information then
4418 -- It cannot be a source directory of any other
4421 Pid := Data.Tree.Projects;
4423 exit Project_Loop when Pid = null;
4425 Src_Dirs := Pid.Project.Source_Dirs;
4426 Dir_Loop : while Src_Dirs /= Nil_String loop
4428 Data.Tree.String_Elements.Table (Src_Dirs);
4430 -- Report error if it is one of the source
4433 if Project.Library_Src_Dir.Name =
4434 Path_Name_Type (Src_Dir.Value)
4437 File_Name_Type (Src_Dir.Value);
4438 Error_Msg_Name_1 := Pid.Project.Name;
4441 "directory to copy interfaces cannot " &
4442 "be the same as source directory { of " &
4444 Lib_Src_Dir.Location, Project);
4445 Project.Library_Src_Dir :=
4446 No_Path_Information;
4450 Src_Dirs := Src_Dir.Next;
4454 end loop Project_Loop;
4458 -- In high verbosity, if there is a valid Library_Src_Dir,
4459 -- display its path name.
4461 if Project.Library_Src_Dir /= No_Path_Information
4462 and then Current_Verbosity = High
4465 ("Directory to copy interfaces",
4466 Get_Name_String (Project.Library_Src_Dir.Name));
4472 -- Check the symbol related attributes
4474 -- First, the symbol policy
4476 if not Lib_Symbol_Policy.Default then
4478 Value : constant String :=
4480 (Get_Name_String (Lib_Symbol_Policy.Value));
4483 -- Symbol policy must hove one of a limited number of values
4485 if Value = "autonomous" or else Value = "default" then
4486 Project.Symbol_Data.Symbol_Policy := Autonomous;
4488 elsif Value = "compliant" then
4489 Project.Symbol_Data.Symbol_Policy := Compliant;
4491 elsif Value = "controlled" then
4492 Project.Symbol_Data.Symbol_Policy := Controlled;
4494 elsif Value = "restricted" then
4495 Project.Symbol_Data.Symbol_Policy := Restricted;
4497 elsif Value = "direct" then
4498 Project.Symbol_Data.Symbol_Policy := Direct;
4503 "illegal value for Library_Symbol_Policy",
4504 Lib_Symbol_Policy.Location, Project);
4509 -- If attribute Library_Symbol_File is not specified, symbol policy
4510 -- cannot be Restricted.
4512 if Lib_Symbol_File.Default then
4513 if Project.Symbol_Data.Symbol_Policy = Restricted then
4516 "Library_Symbol_File needs to be defined when " &
4517 "symbol policy is Restricted",
4518 Lib_Symbol_Policy.Location, Project);
4522 -- Library_Symbol_File is defined
4524 Project.Symbol_Data.Symbol_File :=
4525 Path_Name_Type (Lib_Symbol_File.Value);
4527 Get_Name_String (Lib_Symbol_File.Value);
4529 if Name_Len = 0 then
4532 "symbol file name cannot be an empty string",
4533 Lib_Symbol_File.Location, Project);
4536 OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
4539 for J in 1 .. Name_Len loop
4540 if Name_Buffer (J) = '/'
4541 or else Name_Buffer (J) = Directory_Separator
4550 Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
4553 "symbol file name { is illegal. " &
4554 "Name cannot include directory info.",
4555 Lib_Symbol_File.Location, Project);
4560 -- If attribute Library_Reference_Symbol_File is not defined,
4561 -- symbol policy cannot be Compliant or Controlled.
4563 if Lib_Ref_Symbol_File.Default then
4564 if Project.Symbol_Data.Symbol_Policy = Compliant
4565 or else Project.Symbol_Data.Symbol_Policy = Controlled
4569 "a reference symbol file needs to be defined",
4570 Lib_Symbol_Policy.Location, Project);
4574 -- Library_Reference_Symbol_File is defined, check file exists
4576 Project.Symbol_Data.Reference :=
4577 Path_Name_Type (Lib_Ref_Symbol_File.Value);
4579 Get_Name_String (Lib_Ref_Symbol_File.Value);
4581 if Name_Len = 0 then
4584 "reference symbol file name cannot be an empty string",
4585 Lib_Symbol_File.Location, Project);
4588 if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
4590 Add_Str_To_Name_Buffer
4591 (Get_Name_String (Project.Directory.Name));
4592 Add_Str_To_Name_Buffer
4593 (Get_Name_String (Lib_Ref_Symbol_File.Value));
4594 Project.Symbol_Data.Reference := Name_Find;
4597 if not Is_Regular_File
4598 (Get_Name_String (Project.Symbol_Data.Reference))
4601 File_Name_Type (Lib_Ref_Symbol_File.Value);
4603 -- For controlled and direct symbol policies, it is an error
4604 -- if the reference symbol file does not exist. For other
4605 -- symbol policies, this is just a warning
4608 Project.Symbol_Data.Symbol_Policy /= Controlled
4609 and then Project.Symbol_Data.Symbol_Policy /= Direct;
4613 "<library reference symbol file { does not exist",
4614 Lib_Ref_Symbol_File.Location, Project);
4616 -- In addition in the non-controlled case, if symbol policy
4617 -- is Compliant, it is changed to Autonomous, because there
4618 -- is no reference to check against, and we don't want to
4619 -- fail in this case.
4621 if Project.Symbol_Data.Symbol_Policy /= Controlled then
4622 if Project.Symbol_Data.Symbol_Policy = Compliant then
4623 Project.Symbol_Data.Symbol_Policy := Autonomous;
4628 -- If both the reference symbol file and the symbol file are
4629 -- defined, then check that they are not the same file.
4631 if Project.Symbol_Data.Symbol_File /= No_Path then
4632 Get_Name_String (Project.Symbol_Data.Symbol_File);
4634 if Name_Len > 0 then
4636 -- We do not need to pass a Directory to
4637 -- Normalize_Pathname, since the path_information
4638 -- already contains absolute information.
4640 Symb_Path : constant String :=
4643 (Project.Object_Directory.Name) &
4644 Name_Buffer (1 .. Name_Len),
4647 Opt.Follow_Links_For_Files);
4648 Ref_Path : constant String :=
4651 (Project.Symbol_Data.Reference),
4654 Opt.Follow_Links_For_Files);
4656 if Symb_Path = Ref_Path then
4659 "library reference symbol file and library" &
4660 " symbol file cannot be the same file",
4661 Lib_Ref_Symbol_File.Location, Project);
4669 end Check_Stand_Alone_Library;
4671 ----------------------------
4672 -- Compute_Directory_Last --
4673 ----------------------------
4675 function Compute_Directory_Last (Dir : String) return Natural is
4678 and then (Dir (Dir'Last - 1) = Directory_Separator
4680 Dir (Dir'Last - 1) = '/')
4682 return Dir'Last - 1;
4686 end Compute_Directory_Last;
4688 ---------------------
4689 -- Get_Directories --
4690 ---------------------
4692 procedure Get_Directories
4693 (Project : Project_Id;
4694 Data : in out Tree_Processing_Data)
4696 package Recursive_Dirs is new GNAT.Dynamic_HTables.Simple_HTable
4697 (Header_Num => Header_Num,
4699 No_Element => False,
4703 -- Hash table stores recursive source directories, to avoid looking
4704 -- several times, and to avoid cycles that may be introduced by symbolic
4707 Visited : Recursive_Dirs.Instance;
4709 Object_Dir : constant Variable_Value :=
4711 (Name_Object_Dir, Project.Decl.Attributes, Data.Tree);
4713 Exec_Dir : constant Variable_Value :=
4715 (Name_Exec_Dir, Project.Decl.Attributes, Data.Tree);
4717 Source_Dirs : constant Variable_Value :=
4719 (Name_Source_Dirs, Project.Decl.Attributes, Data.Tree);
4721 Excluded_Source_Dirs : constant Variable_Value :=
4723 (Name_Excluded_Source_Dirs,
4724 Project.Decl.Attributes,
4727 Source_Files : constant Variable_Value :=
4730 Project.Decl.Attributes, Data.Tree);
4732 Last_Source_Dir : String_List_Id := Nil_String;
4733 Last_Src_Dir_Rank : Number_List_Index := No_Number_List;
4735 Languages : constant Variable_Value :=
4737 (Name_Languages, Project.Decl.Attributes, Data.Tree);
4739 procedure Find_Source_Dirs
4740 (From : File_Name_Type;
4741 Location : Source_Ptr;
4743 Removed : Boolean := False);
4744 -- Find one or several source directories, and add (or remove, if
4745 -- Removed is True) them to list of source directories of the project.
4747 ----------------------
4748 -- Find_Source_Dirs --
4749 ----------------------
4751 procedure Find_Source_Dirs
4752 (From : File_Name_Type;
4753 Location : Source_Ptr;
4755 Removed : Boolean := False)
4757 Directory : constant String := Get_Name_String (From);
4759 procedure Add_To_Or_Remove_From_List
4761 Display_Path_Id : Name_Id);
4762 -- When Removed = False, the directory Path_Id to the list of
4763 -- source_dirs if not already in the list. When Removed = True,
4764 -- removed directory Path_Id if in the list.
4766 procedure Recursive_Find_Dirs (Path : Name_Id);
4767 -- Find all the subdirectories (recursively) of Path and add them
4768 -- to the list of source directories of the project.
4770 --------------------------------
4771 -- Add_To_Or_Remove_From_List --
4772 --------------------------------
4774 procedure Add_To_Or_Remove_From_List
4776 Display_Path_Id : Name_Id)
4778 List : String_List_Id;
4779 Prev : String_List_Id;
4780 Rank_List : Number_List_Index;
4781 Prev_Rank : Number_List_Index;
4782 Element : String_Element;
4786 Prev_Rank := No_Number_List;
4787 List := Project.Source_Dirs;
4788 Rank_List := Project.Source_Dir_Ranks;
4789 while List /= Nil_String loop
4790 Element := Data.Tree.String_Elements.Table (List);
4791 exit when Element.Value = Path_Id;
4793 List := Element.Next;
4794 Prev_Rank := Rank_List;
4795 Rank_List := Data.Tree.Number_Lists.Table (Prev_Rank).Next;
4798 -- The directory is in the list if List is not Nil_String
4800 if not Removed and then List = Nil_String then
4801 if Current_Verbosity = High then
4802 Write_Str (" Adding Source Dir=");
4803 Write_Line (Get_Name_String (Path_Id));
4806 String_Element_Table.Increment_Last (Data.Tree.String_Elements);
4810 Display_Value => Display_Path_Id,
4811 Location => No_Location,
4813 Next => Nil_String);
4815 Number_List_Table.Increment_Last (Data.Tree.Number_Lists);
4817 if Last_Source_Dir = Nil_String then
4819 -- This is the first source directory
4821 Project.Source_Dirs :=
4822 String_Element_Table.Last (Data.Tree.String_Elements);
4823 Project.Source_Dir_Ranks :=
4824 Number_List_Table.Last (Data.Tree.Number_Lists);
4827 -- We already have source directories, link the previous
4828 -- last to the new one.
4830 Data.Tree.String_Elements.Table (Last_Source_Dir).Next :=
4831 String_Element_Table.Last (Data.Tree.String_Elements);
4832 Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank).Next :=
4833 Number_List_Table.Last (Data.Tree.Number_Lists);
4836 -- And register this source directory as the new last
4839 String_Element_Table.Last (Data.Tree.String_Elements);
4840 Data.Tree.String_Elements.Table (Last_Source_Dir) := Element;
4841 Last_Src_Dir_Rank :=
4842 Number_List_Table.Last (Data.Tree.Number_Lists);
4843 Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank) :=
4844 (Number => Rank, Next => No_Number_List);
4846 elsif Removed and then List /= Nil_String then
4848 -- Remove source dir, if present
4850 if Prev = Nil_String then
4851 Project.Source_Dirs :=
4852 Data.Tree.String_Elements.Table (List).Next;
4853 Project.Source_Dir_Ranks :=
4854 Data.Tree.Number_Lists.Table (Rank_List).Next;
4857 Data.Tree.String_Elements.Table (Prev).Next :=
4858 Data.Tree.String_Elements.Table (List).Next;
4859 Data.Tree.Number_Lists.Table (Prev_Rank).Next :=
4860 Data.Tree.Number_Lists.Table (Rank_List).Next;
4863 end Add_To_Or_Remove_From_List;
4865 -------------------------
4866 -- Recursive_Find_Dirs --
4867 -------------------------
4869 procedure Recursive_Find_Dirs (Path : Name_Id) is
4871 Name : String (1 .. 250);
4874 Non_Canonical_Path : Name_Id := No_Name;
4875 Canonical_Path : Name_Id := No_Name;
4877 The_Path : constant String :=
4879 (Get_Name_String (Path),
4881 Get_Name_String (Project.Directory.Display_Name),
4882 Resolve_Links => Opt.Follow_Links_For_Dirs) &
4883 Directory_Separator;
4885 The_Path_Last : constant Natural :=
4886 Compute_Directory_Last (The_Path);
4889 Name_Len := The_Path_Last - The_Path'First + 1;
4890 Name_Buffer (1 .. Name_Len) :=
4891 The_Path (The_Path'First .. The_Path_Last);
4892 Non_Canonical_Path := Name_Find;
4894 Name_Id (Canonical_Case_File_Name (Non_Canonical_Path));
4896 -- To avoid processing the same directory several times, check
4897 -- if the directory is already in Recursive_Dirs. If it is, then
4898 -- there is nothing to do, just return. If it is not, put it there
4899 -- and continue recursive processing.
4902 if Recursive_Dirs.Get (Visited, Canonical_Path) then
4905 Recursive_Dirs.Set (Visited, Canonical_Path, True);
4909 Add_To_Or_Remove_From_List
4910 (Path_Id => Canonical_Path,
4911 Display_Path_Id => Non_Canonical_Path);
4913 -- Now look for subdirectories. Do that even when this directory
4914 -- is already in the list, because some of its subdirectories may
4915 -- not be in the list yet.
4917 Open (Dir, The_Path (The_Path'First .. The_Path_Last));
4920 Read (Dir, Name, Last);
4923 if Name (1 .. Last) /= "."
4924 and then Name (1 .. Last) /= ".."
4926 -- Avoid . and .. directories
4928 if Current_Verbosity = High then
4929 Write_Str (" Checking ");
4930 Write_Line (Name (1 .. Last));
4934 Path_Name : constant String :=
4936 (Name => Name (1 .. Last),
4939 (The_Path'First .. The_Path_Last),
4941 Opt.Follow_Links_For_Dirs,
4942 Case_Sensitive => True);
4945 if Is_Directory (Path_Name) then
4947 -- We have found a new subdirectory, call self
4949 Name_Len := Path_Name'Length;
4950 Name_Buffer (1 .. Name_Len) := Path_Name;
4951 Recursive_Find_Dirs (Name_Find);
4960 when Directory_Error =>
4962 end Recursive_Find_Dirs;
4964 -- Start of processing for Find_Source_Dirs
4967 if Current_Verbosity = High and then not Removed then
4968 Write_Str ("Find_Source_Dirs (""");
4969 Write_Str (Directory);
4971 Write_Str (Rank'Img);
4975 -- First, check if we are looking for a directory tree, indicated
4976 -- by "/**" at the end.
4978 if Directory'Length >= 3
4979 and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
4980 and then (Directory (Directory'Last - 2) = '/'
4982 Directory (Directory'Last - 2) = Directory_Separator)
4984 Name_Len := Directory'Length - 3;
4986 if Name_Len = 0 then
4988 -- Case of "/**": all directories in file system
4991 Name_Buffer (1) := Directory (Directory'First);
4994 Name_Buffer (1 .. Name_Len) :=
4995 Directory (Directory'First .. Directory'Last - 3);
4998 if Current_Verbosity = High then
4999 Write_Str ("Looking for all subdirectories of """);
5000 Write_Str (Name_Buffer (1 .. Name_Len));
5005 Base_Dir : constant File_Name_Type := Name_Find;
5006 Root_Dir : constant String :=
5008 (Name => Get_Name_String (Base_Dir),
5011 (Project.Directory.Display_Name),
5013 Opt.Follow_Links_For_Dirs,
5014 Case_Sensitive => True);
5017 if Root_Dir'Length = 0 then
5018 Err_Vars.Error_Msg_File_1 := Base_Dir;
5020 if Location = No_Location then
5023 "{ is not a valid directory.",
5024 Project.Location, Project);
5028 "{ is not a valid directory.",
5033 -- We have an existing directory, we register it and all of
5034 -- its subdirectories.
5036 if Current_Verbosity = High then
5037 Write_Line ("Looking for source directories:");
5040 Name_Len := Root_Dir'Length;
5041 Name_Buffer (1 .. Name_Len) := Root_Dir;
5042 Recursive_Find_Dirs (Name_Find);
5044 if Current_Verbosity = High then
5045 Write_Line ("End of looking for source directories.");
5050 -- We have a single directory
5054 Path_Name : Path_Information;
5055 Dir_Exists : Boolean;
5059 (Project => Project,
5062 Dir_Exists => Dir_Exists,
5064 Must_Exist => False);
5066 if not Dir_Exists then
5067 Err_Vars.Error_Msg_File_1 := From;
5069 if Location = No_Location then
5072 "{ is not a valid directory",
5073 Project.Location, Project);
5077 "{ is not a valid directory",
5083 Path : constant String :=
5086 Get_Name_String (Path_Name.Name),
5088 Get_Name_String (Project.Directory.Name),
5089 Resolve_Links => Opt.Follow_Links_For_Dirs,
5090 Case_Sensitive => True) &
5091 Directory_Separator;
5093 Last_Path : constant Natural :=
5094 Compute_Directory_Last (Path);
5096 Display_Path : constant String :=
5098 (Path_Name.Display_Name);
5099 Last_Display_Path : constant Natural :=
5100 Compute_Directory_Last
5102 Display_Path_Id : Name_Id;
5106 Add_Str_To_Name_Buffer (Path (Path'First .. Last_Path));
5107 Path_Id := Name_Find;
5110 Add_Str_To_Name_Buffer
5112 (Display_Path'First .. Last_Display_Path));
5113 Display_Path_Id := Name_Find;
5115 Add_To_Or_Remove_From_List
5116 (Path_Id => Path_Id,
5117 Display_Path_Id => Display_Path_Id);
5123 Recursive_Dirs.Reset (Visited);
5124 end Find_Source_Dirs;
5126 -- Start of processing for Get_Directories
5128 Dir_Exists : Boolean;
5131 if Current_Verbosity = High then
5132 Write_Line ("Starting to look for directories");
5135 -- Set the object directory to its default which may be nil, if there
5136 -- is no sources in the project.
5138 if (((not Source_Files.Default)
5139 and then Source_Files.Values = Nil_String)
5141 ((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String)
5143 ((not Languages.Default) and then Languages.Values = Nil_String))
5144 and then Project.Extends = No_Project
5146 Project.Object_Directory := No_Path_Information;
5148 Project.Object_Directory := Project.Directory;
5151 -- Check the object directory
5153 if Object_Dir.Value /= Empty_String then
5154 Get_Name_String (Object_Dir.Value);
5156 if Name_Len = 0 then
5159 "Object_Dir cannot be empty",
5160 Object_Dir.Location, Project);
5163 -- We check that the specified object directory does exist.
5164 -- However, even when it doesn't exist, we set it to a default
5165 -- value. This is for the benefit of tools that recover from
5166 -- errors; for example, these tools could create the non existent
5167 -- directory. We always return an absolute directory name though.
5171 File_Name_Type (Object_Dir.Value),
5172 Path => Project.Object_Directory,
5174 Dir_Exists => Dir_Exists,
5176 Location => Object_Dir.Location,
5177 Must_Exist => False,
5178 Externally_Built => Project.Externally_Built);
5181 and then not Project.Externally_Built
5183 -- The object directory does not exist, report an error if
5184 -- the project is not externally built.
5186 Err_Vars.Error_Msg_File_1 :=
5187 File_Name_Type (Object_Dir.Value);
5189 case Data.Flags.Require_Obj_Dirs is
5193 "object directory { not found",
5194 Project.Location, Project);
5198 "?object directory { not found",
5199 Project.Location, Project);
5206 elsif Project.Object_Directory /= No_Path_Information
5207 and then Subdirs /= null
5210 Name_Buffer (1) := '.';
5214 Path => Project.Object_Directory,
5216 Dir_Exists => Dir_Exists,
5218 Location => Object_Dir.Location,
5219 Externally_Built => Project.Externally_Built);
5222 if Current_Verbosity = High then
5223 if Project.Object_Directory = No_Path_Information then
5224 Write_Line ("No object directory");
5227 ("Object directory",
5228 Get_Name_String (Project.Object_Directory.Display_Name));
5232 -- Check the exec directory
5234 -- We set the object directory to its default
5236 Project.Exec_Directory := Project.Object_Directory;
5238 if Exec_Dir.Value /= Empty_String then
5239 Get_Name_String (Exec_Dir.Value);
5241 if Name_Len = 0 then
5244 "Exec_Dir cannot be empty",
5245 Exec_Dir.Location, Project);
5248 -- We check that the specified exec directory does exist
5252 File_Name_Type (Exec_Dir.Value),
5253 Path => Project.Exec_Directory,
5254 Dir_Exists => Dir_Exists,
5257 Location => Exec_Dir.Location,
5258 Externally_Built => Project.Externally_Built);
5260 if not Dir_Exists then
5261 Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
5264 "exec directory { not found",
5265 Project.Location, Project);
5270 if Current_Verbosity = High then
5271 if Project.Exec_Directory = No_Path_Information then
5272 Write_Line ("No exec directory");
5274 Write_Str ("Exec directory: """);
5275 Write_Str (Get_Name_String (Project.Exec_Directory.Display_Name));
5280 -- Look for the source directories
5282 if Current_Verbosity = High then
5283 Write_Line ("Starting to look for source directories");
5286 pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
5288 if (not Source_Files.Default)
5289 and then Source_Files.Values = Nil_String
5291 Project.Source_Dirs := Nil_String;
5293 if Project.Qualifier = Standard then
5296 "a standard project cannot have no sources",
5297 Source_Files.Location, Project);
5300 elsif Source_Dirs.Default then
5302 -- No Source_Dirs specified: the single source directory is the one
5303 -- containing the project file.
5305 String_Element_Table.Append (Data.Tree.String_Elements,
5306 (Value => Name_Id (Project.Directory.Name),
5307 Display_Value => Name_Id (Project.Directory.Display_Name),
5308 Location => No_Location,
5313 Project.Source_Dirs :=
5314 String_Element_Table.Last (Data.Tree.String_Elements);
5316 Number_List_Table.Append
5317 (Data.Tree.Number_Lists,
5318 (Number => 1, Next => No_Number_List));
5320 Project.Source_Dir_Ranks :=
5321 Number_List_Table.Last (Data.Tree.Number_Lists);
5323 if Current_Verbosity = High then
5325 ("Default source directory",
5326 Get_Name_String (Project.Directory.Display_Name));
5329 elsif Source_Dirs.Values = Nil_String then
5330 if Project.Qualifier = Standard then
5333 "a standard project cannot have no source directories",
5334 Source_Dirs.Location, Project);
5337 Project.Source_Dirs := Nil_String;
5341 Source_Dir : String_List_Id;
5342 Element : String_Element;
5345 -- Process the source directories for each element of the list
5347 Source_Dir := Source_Dirs.Values;
5349 while Source_Dir /= Nil_String loop
5350 Element := Data.Tree.String_Elements.Table (Source_Dir);
5353 (File_Name_Type (Element.Value), Element.Location, Rank);
5354 Source_Dir := Element.Next;
5359 if not Excluded_Source_Dirs.Default
5360 and then Excluded_Source_Dirs.Values /= Nil_String
5363 Source_Dir : String_List_Id;
5364 Element : String_Element;
5367 -- Process the source directories for each element of the list
5369 Source_Dir := Excluded_Source_Dirs.Values;
5370 while Source_Dir /= Nil_String loop
5371 Element := Data.Tree.String_Elements.Table (Source_Dir);
5373 (File_Name_Type (Element.Value),
5377 Source_Dir := Element.Next;
5382 if Current_Verbosity = High then
5383 Write_Line ("Putting source directories in canonical cases");
5387 Current : String_List_Id := Project.Source_Dirs;
5388 Element : String_Element;
5391 while Current /= Nil_String loop
5392 Element := Data.Tree.String_Elements.Table (Current);
5393 if Element.Value /= No_Name then
5395 Name_Id (Canonical_Case_File_Name (Name_Id (Element.Value)));
5396 Data.Tree.String_Elements.Table (Current) := Element;
5399 Current := Element.Next;
5402 end Get_Directories;
5409 (Project : Project_Id;
5410 Data : in out Tree_Processing_Data)
5412 Mains : constant Variable_Value :=
5414 (Name_Main, Project.Decl.Attributes, Data.Tree);
5415 List : String_List_Id;
5416 Elem : String_Element;
5419 Project.Mains := Mains.Values;
5421 -- If no Mains were specified, and if we are an extending project,
5422 -- inherit the Mains from the project we are extending.
5424 if Mains.Default then
5425 if not Project.Library and then Project.Extends /= No_Project then
5426 Project.Mains := Project.Extends.Mains;
5429 -- In a library project file, Main cannot be specified
5431 elsif Project.Library then
5434 "a library project file cannot have Main specified",
5435 Mains.Location, Project);
5438 List := Mains.Values;
5439 while List /= Nil_String loop
5440 Elem := Data.Tree.String_Elements.Table (List);
5442 if Length_Of_Name (Elem.Value) = 0 then
5445 "?a main cannot have an empty name",
5446 Elem.Location, Project);
5455 ---------------------------
5456 -- Get_Sources_From_File --
5457 ---------------------------
5459 procedure Get_Sources_From_File
5461 Location : Source_Ptr;
5462 Project : in out Project_Processing_Data;
5463 Data : in out Tree_Processing_Data)
5465 File : Prj.Util.Text_File;
5466 Line : String (1 .. 250);
5468 Source_Name : File_Name_Type;
5469 Name_Loc : Name_Location;
5472 if Current_Verbosity = High then
5473 Write_Str ("Opening """);
5480 Prj.Util.Open (File, Path);
5482 if not Prj.Util.Is_Valid (File) then
5484 (Data.Flags, "file does not exist", Location, Project.Project);
5487 -- Read the lines one by one
5489 while not Prj.Util.End_Of_File (File) loop
5490 Prj.Util.Get_Line (File, Line, Last);
5492 -- A non empty, non comment line should contain a file name
5495 and then (Last = 1 or else Line (1 .. 2) /= "--")
5498 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
5499 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
5500 Source_Name := Name_Find;
5502 -- Check that there is no directory information
5504 for J in 1 .. Last loop
5505 if Line (J) = '/' or else Line (J) = Directory_Separator then
5506 Error_Msg_File_1 := Source_Name;
5509 "file name cannot include directory information ({)",
5510 Location, Project.Project);
5515 Name_Loc := Source_Names_Htable.Get
5516 (Project.Source_Names, Source_Name);
5518 if Name_Loc = No_Name_Location then
5520 (Name => Source_Name,
5521 Location => Location,
5522 Source => No_Source,
5526 Source_Names_Htable.Set
5527 (Project.Source_Names, Source_Name, Name_Loc);
5531 Prj.Util.Close (File);
5534 end Get_Sources_From_File;
5536 -----------------------
5537 -- Compute_Unit_Name --
5538 -----------------------
5540 procedure Compute_Unit_Name
5541 (File_Name : File_Name_Type;
5542 Naming : Lang_Naming_Data;
5543 Kind : out Source_Kind;
5545 Project : Project_Processing_Data;
5546 In_Tree : Project_Tree_Ref)
5548 Filename : constant String := Get_Name_String (File_Name);
5549 Last : Integer := Filename'Last;
5554 Unit_Except : Unit_Exception;
5555 Masked : Boolean := False;
5561 if Naming.Separate_Suffix = No_File
5562 or else Naming.Body_Suffix = No_File
5563 or else Naming.Spec_Suffix = No_File
5568 if Naming.Dot_Replacement = No_File then
5569 if Current_Verbosity = High then
5570 Write_Line (" No dot_replacement specified");
5576 Sep_Len := Integer (Length_Of_Name (Naming.Separate_Suffix));
5577 Spec_Len := Integer (Length_Of_Name (Naming.Spec_Suffix));
5578 Body_Len := Integer (Length_Of_Name (Naming.Body_Suffix));
5580 -- Choose the longest suffix that matches. If there are several matches,
5581 -- give priority to specs, then bodies, then separates.
5583 if Naming.Separate_Suffix /= Naming.Body_Suffix
5584 and then Suffix_Matches (Filename, Naming.Separate_Suffix)
5586 Last := Filename'Last - Sep_Len;
5590 if Filename'Last - Body_Len <= Last
5591 and then Suffix_Matches (Filename, Naming.Body_Suffix)
5593 Last := Natural'Min (Last, Filename'Last - Body_Len);
5597 if Filename'Last - Spec_Len <= Last
5598 and then Suffix_Matches (Filename, Naming.Spec_Suffix)
5600 Last := Natural'Min (Last, Filename'Last - Spec_Len);
5604 if Last = Filename'Last then
5605 if Current_Verbosity = High then
5606 Write_Line (" no matching suffix");
5612 -- Check that the casing matches
5614 if File_Names_Case_Sensitive then
5615 case Naming.Casing is
5616 when All_Lower_Case =>
5617 for J in Filename'First .. Last loop
5618 if Is_Letter (Filename (J))
5619 and then not Is_Lower (Filename (J))
5621 if Current_Verbosity = High then
5622 Write_Line (" Invalid casing");
5629 when All_Upper_Case =>
5630 for J in Filename'First .. Last loop
5631 if Is_Letter (Filename (J))
5632 and then not Is_Upper (Filename (J))
5634 if Current_Verbosity = High then
5635 Write_Line (" Invalid casing");
5642 when Mixed_Case | Unknown =>
5647 -- If Dot_Replacement is not a single dot, then there should not
5648 -- be any dot in the name.
5651 Dot_Repl : constant String :=
5652 Get_Name_String (Naming.Dot_Replacement);
5655 if Dot_Repl /= "." then
5656 for Index in Filename'First .. Last loop
5657 if Filename (Index) = '.' then
5658 if Current_Verbosity = High then
5659 Write_Line (" Invalid name, contains dot");
5666 Replace_Into_Name_Buffer
5667 (Filename (Filename'First .. Last), Dot_Repl, '.');
5670 Name_Len := Last - Filename'First + 1;
5671 Name_Buffer (1 .. Name_Len) := Filename (Filename'First .. Last);
5673 (Source => Name_Buffer (1 .. Name_Len),
5674 Mapping => Lower_Case_Map);
5678 -- In the standard GNAT naming scheme, check for special cases: children
5679 -- or separates of A, G, I or S, and run time sources.
5681 if Is_Standard_GNAT_Naming (Naming)
5682 and then Name_Len >= 3
5685 S1 : constant Character := Name_Buffer (1);
5686 S2 : constant Character := Name_Buffer (2);
5687 S3 : constant Character := Name_Buffer (3);
5695 -- Children or separates of packages A, G, I or S. These names
5696 -- are x__ ... or x~... (where x is a, g, i, or s). Both
5697 -- versions (x__... and x~...) are allowed in all platforms,
5698 -- because it is not possible to know the platform before
5699 -- processing of the project files.
5701 if S2 = '_' and then S3 = '_' then
5702 Name_Buffer (2) := '.';
5703 Name_Buffer (3 .. Name_Len - 1) :=
5704 Name_Buffer (4 .. Name_Len);
5705 Name_Len := Name_Len - 1;
5708 Name_Buffer (2) := '.';
5712 -- If it is potentially a run time source
5720 -- Name_Buffer contains the name of the the unit in lower-cases. Check
5721 -- that this is a valid unit name
5723 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
5725 -- If there is a naming exception for the same unit, the file is not
5726 -- a source for the unit.
5728 if Unit /= No_Name then
5730 Unit_Exceptions_Htable.Get (Project.Unit_Exceptions, Unit);
5733 Masked := Unit_Except.Spec /= No_File
5735 Unit_Except.Spec /= File_Name;
5737 Masked := Unit_Except.Impl /= No_File
5739 Unit_Except.Impl /= File_Name;
5743 if Current_Verbosity = High then
5744 Write_Str (" """ & Filename & """ contains the ");
5747 Write_Str ("spec of a unit found in """);
5748 Write_Str (Get_Name_String (Unit_Except.Spec));
5750 Write_Str ("body of a unit found in """);
5751 Write_Str (Get_Name_String (Unit_Except.Impl));
5754 Write_Line (""" (ignored)");
5762 and then Current_Verbosity = High
5765 when Spec => Write_Str (" spec of ");
5766 when Impl => Write_Str (" body of ");
5767 when Sep => Write_Str (" sep of ");
5770 Write_Line (Get_Name_String (Unit));
5772 end Compute_Unit_Name;
5774 --------------------------
5775 -- Check_Illegal_Suffix --
5776 --------------------------
5778 procedure Check_Illegal_Suffix
5779 (Project : Project_Id;
5780 Suffix : File_Name_Type;
5781 Dot_Replacement : File_Name_Type;
5782 Attribute_Name : String;
5783 Location : Source_Ptr;
5784 Data : in out Tree_Processing_Data)
5786 Suffix_Str : constant String := Get_Name_String (Suffix);
5789 if Suffix_Str'Length = 0 then
5795 elsif Index (Suffix_Str, ".") = 0 then
5796 Err_Vars.Error_Msg_File_1 := Suffix;
5799 "{ is illegal for " & Attribute_Name & ": must have a dot",
5804 -- Case of dot replacement is a single dot, and first character of
5805 -- suffix is also a dot.
5807 if Dot_Replacement /= No_File
5808 and then Get_Name_String (Dot_Replacement) = "."
5809 and then Suffix_Str (Suffix_Str'First) = '.'
5811 for Index in Suffix_Str'First + 1 .. Suffix_Str'Last loop
5813 -- If there are multiple dots in the name
5815 if Suffix_Str (Index) = '.' then
5817 -- It is illegal to have a letter following the initial dot
5819 if Is_Letter (Suffix_Str (Suffix_Str'First + 1)) then
5820 Err_Vars.Error_Msg_File_1 := Suffix;
5823 "{ is illegal for " & Attribute_Name
5824 & ": ambiguous prefix when Dot_Replacement is a dot",
5831 end Check_Illegal_Suffix;
5833 ----------------------
5834 -- Locate_Directory --
5835 ----------------------
5837 procedure Locate_Directory
5838 (Project : Project_Id;
5839 Name : File_Name_Type;
5840 Path : out Path_Information;
5841 Dir_Exists : out Boolean;
5842 Data : in out Tree_Processing_Data;
5843 Create : String := "";
5844 Location : Source_Ptr := No_Location;
5845 Must_Exist : Boolean := True;
5846 Externally_Built : Boolean := False)
5848 Parent : constant Path_Name_Type :=
5849 Project.Directory.Display_Name;
5850 The_Parent : constant String :=
5851 Get_Name_String (Parent);
5852 The_Parent_Last : constant Natural :=
5853 Compute_Directory_Last (The_Parent);
5854 Full_Name : File_Name_Type;
5855 The_Name : File_Name_Type;
5858 Get_Name_String (Name);
5860 -- Add Subdirs.all if it is a directory that may be created and
5861 -- Subdirs is not null;
5863 if Create /= "" and then Subdirs /= null then
5864 if Name_Buffer (Name_Len) /= Directory_Separator then
5865 Add_Char_To_Name_Buffer (Directory_Separator);
5868 Add_Str_To_Name_Buffer (Subdirs.all);
5871 -- Convert '/' to directory separator (for Windows)
5873 for J in 1 .. Name_Len loop
5874 if Name_Buffer (J) = '/' then
5875 Name_Buffer (J) := Directory_Separator;
5879 The_Name := Name_Find;
5881 if Current_Verbosity = High then
5882 Write_Str ("Locate_Directory (""");
5883 Write_Str (Get_Name_String (The_Name));
5884 Write_Str (""", """);
5885 Write_Str (The_Parent);
5889 Path := No_Path_Information;
5890 Dir_Exists := False;
5892 if Is_Absolute_Path (Get_Name_String (The_Name)) then
5893 Full_Name := The_Name;
5897 Add_Str_To_Name_Buffer
5898 (The_Parent (The_Parent'First .. The_Parent_Last));
5899 Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
5900 Full_Name := Name_Find;
5904 Full_Path_Name : String_Access :=
5905 new String'(Get_Name_String (Full_Name));
5908 if (Setup_Projects or else Subdirs /= null)
5909 and then Create'Length > 0
5911 if not Is_Directory (Full_Path_Name.all) then
5913 -- If project is externally built, do not create a subdir,
5914 -- use the specified directory, without the subdir.
5916 if Externally_Built then
5917 if Is_Absolute_Path (Get_Name_String (Name)) then
5918 Get_Name_String (Name);
5922 Add_Str_To_Name_Buffer
5923 (The_Parent (The_Parent'First .. The_Parent_Last));
5924 Add_Str_To_Name_Buffer (Get_Name_String (Name));
5927 Full_Path_Name := new String'(Name_Buffer (1 .. Name_Len));
5931 Create_Path (Full_Path_Name.all);
5933 if not Quiet_Output then
5935 Write_Str (" directory """);
5936 Write_Str (Full_Path_Name.all);
5937 Write_Str (""" created for project ");
5938 Write_Line (Get_Name_String (Project.Name));
5945 "could not create " & Create &
5946 " directory " & Full_Path_Name.all,
5953 Dir_Exists := Is_Directory (Full_Path_Name.all);
5955 if not Must_Exist or else Dir_Exists then
5957 Normed : constant String :=
5959 (Full_Path_Name.all,
5961 The_Parent (The_Parent'First .. The_Parent_Last),
5962 Resolve_Links => False,
5963 Case_Sensitive => True);
5965 Canonical_Path : constant String :=
5970 (The_Parent'First .. The_Parent_Last),
5972 Opt.Follow_Links_For_Dirs,
5973 Case_Sensitive => False);
5976 Name_Len := Normed'Length;
5977 Name_Buffer (1 .. Name_Len) := Normed;
5979 -- Directories should always end with a directory separator
5981 if Name_Buffer (Name_Len) /= Directory_Separator then
5982 Add_Char_To_Name_Buffer (Directory_Separator);
5985 Path.Display_Name := Name_Find;
5987 Name_Len := Canonical_Path'Length;
5988 Name_Buffer (1 .. Name_Len) := Canonical_Path;
5990 if Name_Buffer (Name_Len) /= Directory_Separator then
5991 Add_Char_To_Name_Buffer (Directory_Separator);
5994 Path.Name := Name_Find;
5998 Free (Full_Path_Name);
6000 end Locate_Directory;
6002 ---------------------------
6003 -- Find_Excluded_Sources --
6004 ---------------------------
6006 procedure Find_Excluded_Sources
6007 (Project : in out Project_Processing_Data;
6008 Data : in out Tree_Processing_Data)
6010 Excluded_Source_List_File : constant Variable_Value :=
6012 (Name_Excluded_Source_List_File,
6013 Project.Project.Decl.Attributes,
6015 Excluded_Sources : Variable_Value := Util.Value_Of
6016 (Name_Excluded_Source_Files,
6017 Project.Project.Decl.Attributes,
6020 Current : String_List_Id;
6021 Element : String_Element;
6022 Location : Source_Ptr;
6023 Name : File_Name_Type;
6024 File : Prj.Util.Text_File;
6025 Line : String (1 .. 300);
6027 Locally_Removed : Boolean := False;
6030 -- If Excluded_Source_Files is not declared, check Locally_Removed_Files
6032 if Excluded_Sources.Default then
6033 Locally_Removed := True;
6036 (Name_Locally_Removed_Files,
6037 Project.Project.Decl.Attributes, Data.Tree);
6040 -- If there are excluded sources, put them in the table
6042 if not Excluded_Sources.Default then
6043 if not Excluded_Source_List_File.Default then
6044 if Locally_Removed then
6047 "?both attributes Locally_Removed_Files and " &
6048 "Excluded_Source_List_File are present",
6049 Excluded_Source_List_File.Location, Project.Project);
6053 "?both attributes Excluded_Source_Files and " &
6054 "Excluded_Source_List_File are present",
6055 Excluded_Source_List_File.Location, Project.Project);
6059 Current := Excluded_Sources.Values;
6060 while Current /= Nil_String loop
6061 Element := Data.Tree.String_Elements.Table (Current);
6062 Name := Canonical_Case_File_Name (Element.Value);
6064 -- If the element has no location, then use the location of
6065 -- Excluded_Sources to report possible errors.
6067 if Element.Location = No_Location then
6068 Location := Excluded_Sources.Location;
6070 Location := Element.Location;
6073 Excluded_Sources_Htable.Set
6074 (Project.Excluded, Name, (Name, False, Location));
6075 Current := Element.Next;
6078 elsif not Excluded_Source_List_File.Default then
6079 Location := Excluded_Source_List_File.Location;
6082 Source_File_Path_Name : constant String :=
6085 (Excluded_Source_List_File.Value),
6086 Project.Project.Directory.Name);
6089 if Source_File_Path_Name'Length = 0 then
6090 Err_Vars.Error_Msg_File_1 :=
6091 File_Name_Type (Excluded_Source_List_File.Value);
6094 "file with excluded sources { does not exist",
6095 Excluded_Source_List_File.Location, Project.Project);
6100 Prj.Util.Open (File, Source_File_Path_Name);
6102 if not Prj.Util.Is_Valid (File) then
6104 (Data.Flags, "file does not exist",
6105 Location, Project.Project);
6107 -- Read the lines one by one
6109 while not Prj.Util.End_Of_File (File) loop
6110 Prj.Util.Get_Line (File, Line, Last);
6112 -- Non empty, non comment line should contain a file name
6115 and then (Last = 1 or else Line (1 .. 2) /= "--")
6118 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6119 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6122 -- Check that there is no directory information
6124 for J in 1 .. Last loop
6126 or else Line (J) = Directory_Separator
6128 Error_Msg_File_1 := Name;
6131 "file name cannot include " &
6132 "directory information ({)",
6133 Location, Project.Project);
6138 Excluded_Sources_Htable.Set
6139 (Project.Excluded, Name, (Name, False, Location));
6143 Prj.Util.Close (File);
6148 end Find_Excluded_Sources;
6154 procedure Find_Sources
6155 (Project : in out Project_Processing_Data;
6156 Data : in out Tree_Processing_Data)
6158 Sources : constant Variable_Value :=
6161 Project.Project.Decl.Attributes,
6164 Source_List_File : constant Variable_Value :=
6166 (Name_Source_List_File,
6167 Project.Project.Decl.Attributes,
6170 Name_Loc : Name_Location;
6171 Has_Explicit_Sources : Boolean;
6174 pragma Assert (Sources.Kind = List, "Source_Files is not a list");
6176 (Source_List_File.Kind = Single,
6177 "Source_List_File is not a single string");
6179 Project.Source_List_File_Location := Source_List_File.Location;
6181 -- If the user has specified a Source_Files attribute
6183 if not Sources.Default then
6184 if not Source_List_File.Default then
6187 "?both attributes source_files and " &
6188 "source_list_file are present",
6189 Source_List_File.Location, Project.Project);
6192 -- Sources is a list of file names
6195 Current : String_List_Id := Sources.Values;
6196 Element : String_Element;
6197 Location : Source_Ptr;
6198 Name : File_Name_Type;
6201 if Current = Nil_String then
6202 Project.Project.Languages := No_Language_Index;
6204 -- This project contains no source. For projects that don't
6205 -- extend other projects, this also means that there is no
6206 -- need for an object directory, if not specified.
6208 if Project.Project.Extends = No_Project
6209 and then Project.Project.Object_Directory =
6210 Project.Project.Directory
6212 Project.Project.Object_Directory := No_Path_Information;
6216 while Current /= Nil_String loop
6217 Element := Data.Tree.String_Elements.Table (Current);
6218 Name := Canonical_Case_File_Name (Element.Value);
6219 Get_Name_String (Element.Value);
6221 -- If the element has no location, then use the location of
6222 -- Sources to report possible errors.
6224 if Element.Location = No_Location then
6225 Location := Sources.Location;
6227 Location := Element.Location;
6230 -- Check that there is no directory information
6232 for J in 1 .. Name_Len loop
6233 if Name_Buffer (J) = '/'
6234 or else Name_Buffer (J) = Directory_Separator
6236 Error_Msg_File_1 := Name;
6239 "file name cannot include directory " &
6241 Location, Project.Project);
6246 -- Check whether the file is already there: the same file name
6247 -- may be in the list. If the source is missing, the error will
6248 -- be on the first mention of the source file name.
6250 Name_Loc := Source_Names_Htable.Get
6251 (Project.Source_Names, Name);
6253 if Name_Loc = No_Name_Location then
6256 Location => Location,
6257 Source => No_Source,
6259 Source_Names_Htable.Set
6260 (Project.Source_Names, Name, Name_Loc);
6263 Current := Element.Next;
6266 Has_Explicit_Sources := True;
6269 -- If we have no Source_Files attribute, check the Source_List_File
6272 elsif not Source_List_File.Default then
6274 -- Source_List_File is the name of the file that contains the source
6278 Source_File_Path_Name : constant String :=
6280 (File_Name_Type (Source_List_File.Value),
6281 Project.Project.Directory.Name);
6284 Has_Explicit_Sources := True;
6286 if Source_File_Path_Name'Length = 0 then
6287 Err_Vars.Error_Msg_File_1 :=
6288 File_Name_Type (Source_List_File.Value);
6291 "file with sources { does not exist",
6292 Source_List_File.Location, Project.Project);
6295 Get_Sources_From_File
6296 (Source_File_Path_Name, Source_List_File.Location,
6302 -- Neither Source_Files nor Source_List_File has been specified. Find
6303 -- all the files that satisfy the naming scheme in all the source
6306 Has_Explicit_Sources := False;
6312 For_All_Sources => Sources.Default and then Source_List_File.Default);
6314 -- Check if all exceptions have been found
6318 Iter : Source_Iterator;
6321 Iter := For_Each_Source (Data.Tree, Project.Project);
6323 Source := Prj.Element (Iter);
6324 exit when Source = No_Source;
6326 if Source.Naming_Exception
6327 and then Source.Path = No_Path_Information
6329 if Source.Unit /= No_Unit_Index then
6331 -- For multi-unit source files, source_id gets duplicated
6332 -- once for every unit. Only the first source_id got its
6333 -- full path set. So if it isn't set for that first one,
6334 -- the file wasn't found. Otherwise we need to update for
6335 -- units after the first one.
6338 or else Source.Index = 1
6340 Error_Msg_Name_1 := Name_Id (Source.Display_File);
6341 Error_Msg_Name_2 := Name_Id (Source.Unit.Name);
6344 "source file %% for unit %% not found",
6345 No_Location, Project.Project);
6348 Source.Path := Files_Htable.Get
6349 (Data.File_To_Source, Source.File).Path;
6351 if Current_Verbosity = High then
6352 if Source.Path /= No_Path_Information then
6353 Write_Line ("Setting full path for "
6354 & Get_Name_String (Source.File)
6355 & " at" & Source.Index'Img
6357 & Get_Name_String (Source.Path.Name));
6363 if Source.Path = No_Path_Information then
6364 Remove_Source (Source, No_Source);
6372 -- It is an error if a source file name in a source list or in a source
6373 -- list file is not found.
6375 if Has_Explicit_Sources then
6378 First_Error : Boolean;
6381 NL := Source_Names_Htable.Get_First (Project.Source_Names);
6382 First_Error := True;
6383 while NL /= No_Name_Location loop
6384 if not NL.Found then
6385 Err_Vars.Error_Msg_File_1 := NL.Name;
6390 "source file { not found",
6391 NL.Location, Project.Project);
6392 First_Error := False;
6397 "\source file { not found",
6398 NL.Location, Project.Project);
6402 NL := Source_Names_Htable.Get_Next (Project.Source_Names);
6412 procedure Initialize
6413 (Data : out Tree_Processing_Data;
6414 Tree : Project_Tree_Ref;
6415 Flags : Prj.Processing_Flags)
6418 Files_Htable.Reset (Data.File_To_Source);
6420 Data.Flags := Flags;
6427 procedure Free (Data : in out Tree_Processing_Data) is
6429 Files_Htable.Reset (Data.File_To_Source);
6436 procedure Initialize
6437 (Data : in out Project_Processing_Data;
6438 Project : Project_Id)
6441 Data.Project := Project;
6448 procedure Free (Data : in out Project_Processing_Data) is
6450 Source_Names_Htable.Reset (Data.Source_Names);
6451 Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions);
6452 Excluded_Sources_Htable.Reset (Data.Excluded);
6455 -------------------------------
6456 -- Check_File_Naming_Schemes --
6457 -------------------------------
6459 procedure Check_File_Naming_Schemes
6460 (In_Tree : Project_Tree_Ref;
6461 Project : Project_Processing_Data;
6462 File_Name : File_Name_Type;
6463 Alternate_Languages : out Language_List;
6464 Language : out Language_Ptr;
6465 Display_Language_Name : out Name_Id;
6467 Lang_Kind : out Language_Kind;
6468 Kind : out Source_Kind)
6470 Filename : constant String := Get_Name_String (File_Name);
6471 Config : Language_Config;
6472 Tmp_Lang : Language_Ptr;
6474 Header_File : Boolean := False;
6475 -- True if we found at least one language for which the file is a header
6476 -- In such a case, we search for all possible languages where this is
6477 -- also a header (C and C++ for instance), since the file might be used
6478 -- for several such languages.
6480 procedure Check_File_Based_Lang;
6481 -- Does the naming scheme test for file-based languages. For those,
6482 -- there is no Unit. Just check if the file name has the implementation
6483 -- or, if it is specified, the template suffix of the language.
6485 -- Returns True if the file belongs to the current language and we
6486 -- should stop searching for matching languages. Not that a given header
6487 -- file could belong to several languages (C and C++ for instance). Thus
6488 -- if we found a header we'll check whether it matches other languages.
6490 ---------------------------
6491 -- Check_File_Based_Lang --
6492 ---------------------------
6494 procedure Check_File_Based_Lang is
6497 and then Suffix_Matches (Filename, Config.Naming_Data.Body_Suffix)
6501 Language := Tmp_Lang;
6503 if Current_Verbosity = High then
6504 Write_Str (" implementation of language ");
6505 Write_Line (Get_Name_String (Display_Language_Name));
6508 elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
6509 if Current_Verbosity = High then
6510 Write_Str (" header of language ");
6511 Write_Line (Get_Name_String (Display_Language_Name));
6515 Alternate_Languages := new Language_List_Element'
6516 (Language => Language,
6517 Next => Alternate_Languages);
6520 Header_File := True;
6523 Language := Tmp_Lang;
6526 end Check_File_Based_Lang;
6528 -- Start of processing for Check_File_Naming_Schemes
6531 Language := No_Language_Index;
6532 Alternate_Languages := null;
6533 Display_Language_Name := No_Name;
6535 Lang_Kind := File_Based;
6538 Tmp_Lang := Project.Project.Languages;
6539 while Tmp_Lang /= No_Language_Index loop
6540 if Current_Verbosity = High then
6542 (" Testing language "
6543 & Get_Name_String (Tmp_Lang.Name)
6544 & " Header_File=" & Header_File'Img);
6547 Display_Language_Name := Tmp_Lang.Display_Name;
6548 Config := Tmp_Lang.Config;
6549 Lang_Kind := Config.Kind;
6553 Check_File_Based_Lang;
6554 exit when Kind = Impl;
6558 -- We know it belongs to a least a file_based language, no
6559 -- need to check unit-based ones.
6561 if not Header_File then
6563 (File_Name => File_Name,
6564 Naming => Config.Naming_Data,
6568 In_Tree => In_Tree);
6570 if Unit /= No_Name then
6571 Language := Tmp_Lang;
6577 Tmp_Lang := Tmp_Lang.Next;
6580 if Language = No_Language_Index
6581 and then Current_Verbosity = High
6583 Write_Line (" not a source of any language");
6585 end Check_File_Naming_Schemes;
6591 procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is
6593 -- If the file was previously already associated with a unit, change it
6595 if Source.Unit /= null
6596 and then Source.Kind in Spec_Or_Body
6597 and then Source.Unit.File_Names (Source.Kind) /= null
6599 -- If we had another file referencing the same unit (for instance it
6600 -- was in an extended project), that source file is in fact invisible
6601 -- from now on, and in particular doesn't belong to the same unit.
6603 if Source.Unit.File_Names (Source.Kind) /= Source then
6604 Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
6607 Source.Unit.File_Names (Source.Kind) := null;
6610 Source.Kind := Kind;
6612 if Current_Verbosity = High
6613 and then Source.File /= No_File
6615 Write_Line ("Override kind for "
6616 & Get_Name_String (Source.File)
6617 & " kind=" & Source.Kind'Img);
6620 if Source.Kind in Spec_Or_Body and then Source.Unit /= null then
6621 Source.Unit.File_Names (Source.Kind) := Source;
6629 procedure Check_File
6630 (Project : in out Project_Processing_Data;
6631 Data : in out Tree_Processing_Data;
6632 Source_Dir_Rank : Natural;
6633 Path : Path_Name_Type;
6634 File_Name : File_Name_Type;
6635 Display_File_Name : File_Name_Type;
6636 Locally_Removed : Boolean;
6637 For_All_Sources : Boolean)
6639 Canonical_Path : constant Path_Name_Type :=
6641 (Canonical_Case_File_Name (Name_Id (Path)));
6643 Name_Loc : Name_Location :=
6644 Source_Names_Htable.Get
6645 (Project.Source_Names, File_Name);
6646 Check_Name : Boolean := False;
6647 Alternate_Languages : Language_List;
6648 Language : Language_Ptr;
6650 Src_Ind : Source_File_Index;
6652 Display_Language_Name : Name_Id;
6653 Lang_Kind : Language_Kind;
6654 Kind : Source_Kind := Spec;
6657 if Current_Verbosity = High then
6658 Write_Line ("Checking file:");
6659 Write_Str (" Path = ");
6660 Write_Line (Get_Name_String (Path));
6661 Write_Str (" Rank =");
6662 Write_Line (Source_Dir_Rank'Img);
6665 if Name_Loc = No_Name_Location then
6666 Check_Name := For_All_Sources;
6669 if Name_Loc.Found then
6671 -- Check if it is OK to have the same file name in several
6672 -- source directories.
6674 if Source_Dir_Rank = Name_Loc.Source.Source_Dir_Rank then
6675 Error_Msg_File_1 := File_Name;
6678 "{ is found in several source directories",
6679 Name_Loc.Location, Project.Project);
6683 Name_Loc.Found := True;
6685 Source_Names_Htable.Set
6686 (Project.Source_Names, File_Name, Name_Loc);
6688 if Name_Loc.Source = No_Source then
6692 Name_Loc.Source.Path := (Canonical_Path, Path);
6694 Source_Paths_Htable.Set
6695 (Data.Tree.Source_Paths_HT,
6699 -- Check if this is a subunit
6701 if Name_Loc.Source.Unit /= No_Unit_Index
6702 and then Name_Loc.Source.Kind = Impl
6704 Src_Ind := Sinput.P.Load_Project_File
6705 (Get_Name_String (Canonical_Path));
6707 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
6708 Override_Kind (Name_Loc.Source, Sep);
6713 (Data.File_To_Source, File_Name, Name_Loc.Source);
6719 Check_File_Naming_Schemes
6720 (In_Tree => Data.Tree,
6722 File_Name => File_Name,
6723 Alternate_Languages => Alternate_Languages,
6724 Language => Language,
6725 Display_Language_Name => Display_Language_Name,
6727 Lang_Kind => Lang_Kind,
6730 if Language = No_Language_Index then
6732 -- A file name in a list must be a source of a language
6734 if Data.Flags.Error_On_Unknown_Language
6735 and then Name_Loc.Found
6737 Error_Msg_File_1 := File_Name;
6740 "language unknown for {",
6741 Name_Loc.Location, Project.Project);
6747 Project => Project.Project,
6748 Source_Dir_Rank => Source_Dir_Rank,
6749 Lang_Id => Language,
6752 Alternate_Languages => Alternate_Languages,
6753 File_Name => File_Name,
6754 Display_File => Display_File_Name,
6756 Locally_Removed => Locally_Removed,
6757 Path => (Canonical_Path, Path));
6759 -- If it is a source specified in a list, update the entry in
6760 -- the Source_Names table.
6762 if Name_Loc.Found and then Name_Loc.Source = No_Source then
6763 Name_Loc.Source := Source;
6764 Source_Names_Htable.Set
6765 (Project.Source_Names, File_Name, Name_Loc);
6771 ------------------------
6772 -- Search_Directories --
6773 ------------------------
6775 procedure Search_Directories
6776 (Project : in out Project_Processing_Data;
6777 Data : in out Tree_Processing_Data;
6778 For_All_Sources : Boolean)
6780 Source_Dir : String_List_Id;
6781 Element : String_Element;
6782 Src_Dir_Rank : Number_List_Index;
6783 Num_Nod : Number_Node;
6785 Name : String (1 .. 1_000);
6787 File_Name : File_Name_Type;
6788 Display_File_Name : File_Name_Type;
6791 if Current_Verbosity = High then
6792 Write_Line ("Looking for sources:");
6795 -- Loop through subdirectories
6797 Source_Dir := Project.Project.Source_Dirs;
6798 Src_Dir_Rank := Project.Project.Source_Dir_Ranks;
6799 while Source_Dir /= Nil_String loop
6801 Num_Nod := Data.Tree.Number_Lists.Table (Src_Dir_Rank);
6802 Element := Data.Tree.String_Elements.Table (Source_Dir);
6804 if Element.Value /= No_Name then
6805 Get_Name_String (Element.Display_Value);
6807 if Current_Verbosity = High then
6808 Write_Str ("Directory: ");
6809 Write_Str (Name_Buffer (1 .. Name_Len));
6810 Write_Line (Num_Nod.Number'Img);
6814 Source_Directory : constant String :=
6815 Name_Buffer (1 .. Name_Len) &
6816 Directory_Separator;
6818 Dir_Last : constant Natural :=
6819 Compute_Directory_Last
6823 if Current_Verbosity = High then
6824 Write_Attr ("Source_Dir", Source_Directory);
6827 -- We look to every entry in the source directory
6829 Open (Dir, Source_Directory);
6832 Read (Dir, Name, Last);
6836 -- ??? Duplicate system call here, we just did a a
6837 -- similar one. Maybe Ada.Directories would be more
6838 -- appropriate here.
6841 (Source_Directory & Name (1 .. Last))
6843 if Current_Verbosity = High then
6844 Write_Str (" Checking ");
6845 Write_Line (Name (1 .. Last));
6849 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
6850 Display_File_Name := Name_Find;
6852 if Osint.File_Names_Case_Sensitive then
6853 File_Name := Display_File_Name;
6855 Canonical_Case_File_Name
6856 (Name_Buffer (1 .. Name_Len));
6857 File_Name := Name_Find;
6861 Path_Name : constant String :=
6866 (Source_Directory'First ..
6869 Opt.Follow_Links_For_Files,
6870 Case_Sensitive => True);
6871 -- Case_Sensitive set True (no folding)
6873 Path : Path_Name_Type;
6874 FF : File_Found := Excluded_Sources_Htable.Get
6875 (Project.Excluded, File_Name);
6876 To_Remove : Boolean := False;
6879 Name_Len := Path_Name'Length;
6880 Name_Buffer (1 .. Name_Len) := Path_Name;
6883 if FF /= No_File_Found then
6884 if not FF.Found then
6886 Excluded_Sources_Htable.Set
6887 (Project.Excluded, File_Name, FF);
6889 if Current_Verbosity = High then
6890 Write_Str (" excluded source """);
6891 Write_Str (Get_Name_String (File_Name));
6895 -- Will mark the file as removed, but we
6896 -- still need to add it to the list: if we
6897 -- don't, the file will not appear in the
6898 -- mapping file and will cause the compiler
6906 (Project => Project,
6907 Source_Dir_Rank => Num_Nod.Number,
6910 File_Name => File_Name,
6911 Locally_Removed => To_Remove,
6912 Display_File_Name => Display_File_Name,
6913 For_All_Sources => For_All_Sources);
6923 when Directory_Error =>
6927 Source_Dir := Element.Next;
6928 Src_Dir_Rank := Num_Nod.Next;
6931 if Current_Verbosity = High then
6932 Write_Line ("end Looking for sources.");
6934 end Search_Directories;
6936 ----------------------------
6937 -- Load_Naming_Exceptions --
6938 ----------------------------
6940 procedure Load_Naming_Exceptions
6941 (Project : in out Project_Processing_Data;
6942 Data : in out Tree_Processing_Data)
6945 Iter : Source_Iterator;
6948 Iter := For_Each_Source (Data.Tree, Project.Project);
6950 Source := Prj.Element (Iter);
6951 exit when Source = No_Source;
6953 -- An excluded file cannot also be an exception file name
6955 if Excluded_Sources_Htable.Get (Project.Excluded, Source.File) /=
6958 Error_Msg_File_1 := Source.File;
6961 "{ cannot be both excluded and an exception file name",
6962 No_Location, Project.Project);
6965 if Current_Verbosity = High then
6966 Write_Str ("Naming exception: Putting source file ");
6967 Write_Str (Get_Name_String (Source.File));
6968 Write_Line (" in Source_Names");
6971 Source_Names_Htable.Set
6972 (Project.Source_Names,
6975 (Name => Source.File,
6976 Location => No_Location,
6980 -- If this is an Ada exception, record in table Unit_Exceptions
6982 if Source.Unit /= No_Unit_Index then
6984 Unit_Except : Unit_Exception :=
6985 Unit_Exceptions_Htable.Get
6986 (Project.Unit_Exceptions, Source.Unit.Name);
6989 Unit_Except.Name := Source.Unit.Name;
6991 if Source.Kind = Spec then
6992 Unit_Except.Spec := Source.File;
6994 Unit_Except.Impl := Source.File;
6997 Unit_Exceptions_Htable.Set
6998 (Project.Unit_Exceptions, Source.Unit.Name, Unit_Except);
7004 end Load_Naming_Exceptions;
7006 ----------------------
7007 -- Look_For_Sources --
7008 ----------------------
7010 procedure Look_For_Sources
7011 (Project : in out Project_Processing_Data;
7012 Data : in out Tree_Processing_Data)
7014 Object_Files : Object_File_Names_Htable.Instance;
7015 Iter : Source_Iterator;
7018 procedure Check_Object (Src : Source_Id);
7019 -- Check if object file name of Src is already used in the project tree,
7020 -- and report an error if so.
7022 procedure Check_Object_Files;
7023 -- Check that no two sources of this project have the same object file
7025 procedure Mark_Excluded_Sources;
7026 -- Mark as such the sources that are declared as excluded
7032 procedure Check_Object (Src : Source_Id) is
7036 Source := Object_File_Names_Htable.Get (Object_Files, Src.Object);
7038 -- We cannot just check on "Source /= Src", since we might have
7039 -- two different entries for the same file (and since that's
7040 -- the same file it is expected that it has the same object)
7042 if Source /= No_Source
7043 and then Source.Path /= Src.Path
7045 Error_Msg_File_1 := Src.File;
7046 Error_Msg_File_2 := Source.File;
7049 "{ and { have the same object file name",
7050 No_Location, Project.Project);
7053 Object_File_Names_Htable.Set (Object_Files, Src.Object, Src);
7057 ---------------------------
7058 -- Mark_Excluded_Sources --
7059 ---------------------------
7061 procedure Mark_Excluded_Sources is
7062 Source : Source_Id := No_Source;
7063 Excluded : File_Found;
7067 -- Minor optimization: if there are no excluded files, no need to
7068 -- traverse the list of sources. We cannot however also check whether
7069 -- the existing exceptions have ".Found" set to True (indicating we
7070 -- found them before) because we need to do some final processing on
7071 -- them in any case.
7073 if Excluded_Sources_Htable.Get_First (Project.Excluded) /=
7076 Proj := Project.Project;
7077 while Proj /= No_Project loop
7078 Iter := For_Each_Source (Data.Tree, Proj);
7079 while Prj.Element (Iter) /= No_Source loop
7080 Source := Prj.Element (Iter);
7081 Excluded := Excluded_Sources_Htable.Get
7082 (Project.Excluded, Source.File);
7084 if Excluded /= No_File_Found then
7085 Source.Locally_Removed := True;
7086 Source.In_Interfaces := False;
7088 if Current_Verbosity = High then
7089 Write_Str ("Removing file ");
7091 (Get_Name_String (Excluded.File)
7092 & " " & Get_Name_String (Source.Project.Name));
7095 Excluded_Sources_Htable.Remove
7096 (Project.Excluded, Source.File);
7102 Proj := Proj.Extends;
7106 -- If we have any excluded element left, that means we did not find
7109 Excluded := Excluded_Sources_Htable.Get_First (Project.Excluded);
7110 while Excluded /= No_File_Found loop
7111 if not Excluded.Found then
7113 -- Check if the file belongs to another imported project to
7114 -- provide a better error message.
7117 (In_Tree => Data.Tree,
7118 Project => Project.Project,
7119 In_Imported_Only => True,
7120 Base_Name => Excluded.File);
7122 Err_Vars.Error_Msg_File_1 := Excluded.File;
7124 if Src = No_Source then
7127 "unknown file {", Excluded.Location, Project.Project);
7131 "cannot remove a source from an imported project: {",
7132 Excluded.Location, Project.Project);
7136 Excluded := Excluded_Sources_Htable.Get_Next (Project.Excluded);
7138 end Mark_Excluded_Sources;
7140 ------------------------
7141 -- Check_Object_Files --
7142 ------------------------
7144 procedure Check_Object_Files is
7145 Iter : Source_Iterator;
7147 Src_Ind : Source_File_Index;
7150 Iter := For_Each_Source (Data.Tree);
7152 Src_Id := Prj.Element (Iter);
7153 exit when Src_Id = No_Source;
7155 if Is_Compilable (Src_Id)
7156 and then Src_Id.Language.Config.Object_Generated
7157 and then Is_Extending (Project.Project, Src_Id.Project)
7159 if Src_Id.Unit = No_Unit_Index then
7160 if Src_Id.Kind = Impl then
7161 Check_Object (Src_Id);
7167 if Other_Part (Src_Id) = No_Source then
7168 Check_Object (Src_Id);
7175 if Other_Part (Src_Id) /= No_Source then
7176 Check_Object (Src_Id);
7179 -- Check if it is a subunit
7182 Sinput.P.Load_Project_File
7183 (Get_Name_String (Src_Id.Path.Name));
7185 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
7186 Override_Kind (Src_Id, Sep);
7188 Check_Object (Src_Id);
7197 end Check_Object_Files;
7199 -- Start of processing for Look_For_Sources
7202 Find_Excluded_Sources (Project, Data);
7204 if Project.Project.Languages /= No_Language_Index then
7205 Load_Naming_Exceptions (Project, Data);
7206 Find_Sources (Project, Data);
7207 Mark_Excluded_Sources;
7211 Object_File_Names_Htable.Reset (Object_Files);
7212 end Look_For_Sources;
7218 function Path_Name_Of
7219 (File_Name : File_Name_Type;
7220 Directory : Path_Name_Type) return String
7222 Result : String_Access;
7223 The_Directory : constant String := Get_Name_String (Directory);
7226 Get_Name_String (File_Name);
7229 (File_Name => Name_Buffer (1 .. Name_Len),
7230 Path => The_Directory);
7232 if Result = null then
7236 R : String := Result.all;
7239 Canonical_Case_File_Name (R);
7249 procedure Remove_Source
7251 Replaced_By : Source_Id)
7256 if Current_Verbosity = High then
7257 Write_Str ("Removing source ");
7258 Write_Str (Get_Name_String (Id.File));
7260 if Id.Index /= 0 then
7261 Write_Str (" at" & Id.Index'Img);
7267 if Replaced_By /= No_Source then
7268 Id.Replaced_By := Replaced_By;
7269 Replaced_By.Declared_In_Interfaces := Id.Declared_In_Interfaces;
7272 Id.In_Interfaces := False;
7273 Id.Locally_Removed := True;
7275 -- ??? Should we remove the source from the unit ? The file is not used,
7276 -- so probably should not be referenced from the unit. On the other hand
7277 -- it might give useful additional info
7278 -- if Id.Unit /= null then
7279 -- Id.Unit.File_Names (Id.Kind) := null;
7282 Source := Id.Language.First_Source;
7285 Id.Language.First_Source := Id.Next_In_Lang;
7288 while Source.Next_In_Lang /= Id loop
7289 Source := Source.Next_In_Lang;
7292 Source.Next_In_Lang := Id.Next_In_Lang;
7296 -----------------------
7297 -- Report_No_Sources --
7298 -----------------------
7300 procedure Report_No_Sources
7301 (Project : Project_Id;
7303 Data : Tree_Processing_Data;
7304 Location : Source_Ptr;
7305 Continuation : Boolean := False)
7308 case Data.Flags.When_No_Sources is
7312 when Warning | Error =>
7314 Msg : constant String :=
7317 " sources in this project";
7320 Error_Msg_Warn := Data.Flags.When_No_Sources = Warning;
7322 if Continuation then
7323 Error_Msg (Data.Flags, "\" & Msg, Location, Project);
7325 Error_Msg (Data.Flags, Msg, Location, Project);
7329 end Report_No_Sources;
7331 ----------------------
7332 -- Show_Source_Dirs --
7333 ----------------------
7335 procedure Show_Source_Dirs
7336 (Project : Project_Id;
7337 In_Tree : Project_Tree_Ref)
7339 Current : String_List_Id;
7340 Element : String_Element;
7343 Write_Line ("Source_Dirs:");
7345 Current := Project.Source_Dirs;
7346 while Current /= Nil_String loop
7347 Element := In_Tree.String_Elements.Table (Current);
7349 Write_Line (Get_Name_String (Element.Value));
7350 Current := Element.Next;
7353 Write_Line ("end Source_Dirs.");
7354 end Show_Source_Dirs;
7356 ---------------------------
7357 -- Process_Naming_Scheme --
7358 ---------------------------
7360 procedure Process_Naming_Scheme
7361 (Tree : Project_Tree_Ref;
7362 Root_Project : Project_Id;
7363 Flags : Processing_Flags)
7365 procedure Recursive_Check
7366 (Project : Project_Id;
7367 Data : in out Tree_Processing_Data);
7368 -- Check_Naming_Scheme for the project
7370 ---------------------
7371 -- Recursive_Check --
7372 ---------------------
7374 procedure Recursive_Check
7375 (Project : Project_Id;
7376 Data : in out Tree_Processing_Data)
7379 if Verbose_Mode then
7380 Write_Str ("Processing_Naming_Scheme for project """);
7381 Write_Str (Get_Name_String (Project.Name));
7385 Prj.Nmsc.Check (Project, Data);
7386 end Recursive_Check;
7388 procedure Check_All_Projects is new
7389 For_Every_Project_Imported (Tree_Processing_Data, Recursive_Check);
7391 Data : Tree_Processing_Data;
7393 -- Start of processing for Process_Naming_Scheme
7395 Initialize (Data, Tree => Tree, Flags => Flags);
7396 Check_All_Projects (Root_Project, Data, Imported_First => True);
7398 end Process_Naming_Scheme;