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;
30 with Err_Vars; use Err_Vars;
34 with Osint; use Osint;
35 with Output; use Output;
36 with Prj.Env; use Prj.Env;
38 with Prj.Util; use Prj.Util;
40 with Snames; use Snames;
41 with Table; use Table;
42 with Targparm; use Targparm;
44 with Ada.Characters.Handling; use Ada.Characters.Handling;
45 with Ada.Directories; use Ada.Directories;
46 with Ada.Strings; use Ada.Strings;
47 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
48 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
50 package body Prj.Nmsc is
52 No_Continuation_String : aliased String := "";
53 Continuation_String : aliased String := "\";
54 -- Used in Check_Library for continuation error messages at the same
57 Error_Report : Put_Line_Access := null;
58 -- Set to point to error reporting procedure
60 When_No_Sources : Error_Warning := Error;
61 -- Indicates what should be done when there is no Ada sources in a non
62 -- extending Ada project.
64 ALI_Suffix : constant String := ".ali";
65 -- File suffix for ali files
67 type Name_Location is record
68 Name : File_Name_Type;
69 Location : Source_Ptr;
70 Source : Source_Id := No_Source;
71 Except : Boolean := False;
72 Found : Boolean := False;
74 -- Information about file names found in string list attribute:
75 -- Source_Files or in a source list file, stored in hash table.
76 -- Source_Names, used by procedure Get_Path_Names_And_Record_Sources.
77 -- Except is set to True if source is a naming exception in the project.
79 No_Name_Location : constant Name_Location :=
81 Location => No_Location,
86 package Source_Names is new GNAT.HTable.Simple_HTable
87 (Header_Num => Header_Num,
88 Element => Name_Location,
89 No_Element => No_Name_Location,
90 Key => File_Name_Type,
93 -- Hash table to store file names found in string list attribute
94 -- Source_Files or in a source list file, stored in hash table
95 -- Source_Names, used by procedure Get_Path_Names_And_Record_Sources.
97 -- ??? Should not be a global table, as it is needed only when processing
100 -- More documentation needed on what unit exceptions are about ???
102 type Unit_Exception is record
104 Spec : File_Name_Type;
105 Impl : File_Name_Type;
107 -- Record special naming schemes for Ada units (name of spec file and name
108 -- of implementation file).
110 No_Unit_Exception : constant Unit_Exception :=
115 package Unit_Exceptions is new GNAT.HTable.Simple_HTable
116 (Header_Num => Header_Num,
117 Element => Unit_Exception,
118 No_Element => No_Unit_Exception,
122 -- Hash table to store the unit exceptions.
123 -- ??? Seems to be used only by the multi_lang mode
124 -- ??? Should not be a global array, but stored in the project_data
126 package Recursive_Dirs is new GNAT.HTable.Simple_HTable
127 (Header_Num => Header_Num,
133 -- Hash table to store recursive source directories, to avoid looking
134 -- several times, and to avoid cycles that may be introduced by symbolic
137 type Ada_Naming_Exception_Id is new Nat;
138 No_Ada_Naming_Exception : constant Ada_Naming_Exception_Id := 0;
140 type Unit_Info is record
143 Next : Ada_Naming_Exception_Id := No_Ada_Naming_Exception;
147 package Ada_Naming_Exception_Table is new Table.Table
148 (Table_Component_Type => Unit_Info,
149 Table_Index_Type => Ada_Naming_Exception_Id,
150 Table_Low_Bound => 1,
152 Table_Increment => 100,
153 Table_Name => "Prj.Nmsc.Ada_Naming_Exception_Table");
155 package Ada_Naming_Exceptions is new GNAT.HTable.Simple_HTable
156 (Header_Num => Header_Num,
157 Element => Ada_Naming_Exception_Id,
158 No_Element => No_Ada_Naming_Exception,
159 Key => File_Name_Type,
162 -- A hash table to store naming exceptions for Ada. For each file name
163 -- there is one or several unit in table Ada_Naming_Exception_Table.
164 -- ??? This is for ada_only mode, we should be able to merge with
165 -- Unit_Exceptions table, used by multi_lang mode.
167 package Object_File_Names is new GNAT.HTable.Simple_HTable
168 (Header_Num => Header_Num,
169 Element => File_Name_Type,
170 No_Element => No_File,
171 Key => File_Name_Type,
174 -- A hash table to store the object file names for a project, to check that
175 -- two different sources have different object file names.
177 type File_Found is record
178 File : File_Name_Type := No_File;
179 Found : Boolean := False;
180 Location : Source_Ptr := No_Location;
182 No_File_Found : constant File_Found := (No_File, False, No_Location);
183 -- Comments needed ???
185 package Excluded_Sources_Htable is new GNAT.HTable.Simple_HTable
186 (Header_Num => Header_Num,
187 Element => File_Found,
188 No_Element => No_File_Found,
189 Key => File_Name_Type,
192 -- A hash table to store the excluded files, if any. This is filled by
193 -- Find_Excluded_Sources below.
195 procedure Find_Excluded_Sources
196 (Project : Project_Id;
197 In_Tree : Project_Tree_Ref);
198 -- Find the list of files that should not be considered as source files
199 -- for this project. Sets the list in the Excluded_Sources_Htable.
201 procedure Override_Kind (Source : Source_Id; Kind : Source_Kind);
202 -- Override the reference kind for a source file. This properly updates
203 -- the unit data if necessary.
205 function Hash (Unit : Unit_Info) return Header_Num;
207 type Name_And_Index is record
208 Name : Name_Id := No_Name;
211 No_Name_And_Index : constant Name_And_Index :=
212 (Name => No_Name, Index => 0);
213 -- Name of a unit, and its index inside the source file. The first unit has
214 -- index 1 (see doc for pragma Source_File_Name), but the index might be
215 -- set to 0 when the source file contains a single unit.
217 package Reverse_Ada_Naming_Exceptions is new GNAT.HTable.Simple_HTable
218 (Header_Num => Header_Num,
219 Element => Name_And_Index,
220 No_Element => No_Name_And_Index,
224 -- A table to check if a unit with an exceptional name will hide a source
225 -- with a file name following the naming convention.
227 procedure Load_Naming_Exceptions
228 (Project : Project_Id;
229 In_Tree : Project_Tree_Ref);
230 -- All source files in Data.First_Source are considered as naming
231 -- exceptions, and copied into the Source_Names and Unit_Exceptions tables
236 In_Tree : Project_Tree_Ref;
237 Project : Project_Id;
238 Lang_Id : Language_Ptr;
240 File_Name : File_Name_Type;
241 Display_File : File_Name_Type;
242 Naming_Exception : Boolean := False;
243 Path : Path_Information := No_Path_Information;
244 Alternate_Languages : Language_List := null;
245 Unit : Name_Id := No_Name;
247 Source_To_Replace : Source_Id := No_Source);
248 -- Add a new source to the different lists: list of all sources in the
249 -- project tree, list of source of a project and list of sources of a
252 -- If Path is specified, the file is also added to Source_Paths_HT.
253 -- If Source_To_Replace is specified, it points to the source in the
254 -- extended project that the new file is overriding.
256 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type;
257 -- Same as Osint.Canonical_Case_File_Name but applies to Name_Id.
258 -- This alters Name_Buffer
260 function Suffix_Matches
262 Suffix : File_Name_Type) return Boolean;
263 -- True if the file name ends with the given suffix. Always returns False
264 -- if Suffix is No_Name.
266 procedure Replace_Into_Name_Buffer
269 Replacement : Character);
270 -- Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is
271 -- converted to lower-case at the same time.
273 function ALI_File_Name (Source : String) return String;
274 -- Return the ALI file name corresponding to a source
276 procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
277 -- Check that a name is a valid Ada unit name
279 procedure Check_Package_Naming
280 (Project : Project_Id;
281 In_Tree : Project_Tree_Ref;
282 Is_Config_File : Boolean;
283 Bodies : out Array_Element_Id;
284 Specs : out Array_Element_Id);
285 -- Check the naming scheme part of Data, and initialize the naming scheme
286 -- data in the config of the various languages. Is_Config_File should be
287 -- True if Project is a config file (.cgpr) This also returns the naming
288 -- scheme exceptions for unit-based languages (Bodies and Specs are
289 -- associative arrays mapping individual unit names to source file names).
291 procedure Check_Configuration
292 (Project : Project_Id;
293 In_Tree : Project_Tree_Ref;
294 Compiler_Driver_Mandatory : Boolean);
295 -- Check the configuration attributes for the project
296 -- If Compiler_Driver_Mandatory is true, then a Compiler.Driver attribute
297 -- for each language must be defined, or we will not look for its source
300 procedure Check_If_Externally_Built
301 (Project : Project_Id;
302 In_Tree : Project_Tree_Ref);
303 -- Check attribute Externally_Built of project Project in project tree
304 -- In_Tree and modify its data Data if it has the value "true".
306 procedure Check_Interfaces
307 (Project : Project_Id;
308 In_Tree : Project_Tree_Ref);
309 -- If a list of sources is specified in attribute Interfaces, set
310 -- In_Interfaces only for the sources specified in the list.
312 procedure Check_Library_Attributes
313 (Project : Project_Id;
314 In_Tree : Project_Tree_Ref);
315 -- Check the library attributes of project Project in project tree In_Tree
316 -- and modify its data Data accordingly.
317 -- Current_Dir should represent the current directory, and is passed for
318 -- efficiency to avoid system calls to recompute it.
320 procedure Check_Programming_Languages
321 (In_Tree : Project_Tree_Ref;
322 Project : Project_Id);
323 -- Check attribute Languages for the project with data Data in project
324 -- tree In_Tree and set the components of Data for all the programming
325 -- languages indicated in attribute Languages, if any.
327 function Check_Project
329 Root_Project : Project_Id;
330 Extending : Boolean) return Boolean;
331 -- Returns True if P is Root_Project or, if Extending is True, a project
332 -- extended by Root_Project.
334 procedure Check_Stand_Alone_Library
335 (Project : Project_Id;
336 In_Tree : Project_Tree_Ref;
337 Current_Dir : String;
338 Extending : Boolean);
339 -- Check if project Project in project tree In_Tree is a Stand-Alone
340 -- Library project, and modify its data Data accordingly if it is one.
341 -- Current_Dir should represent the current directory, and is passed for
342 -- efficiency to avoid system calls to recompute it.
344 procedure Check_And_Normalize_Unit_Names
345 (Project : Project_Id;
346 In_Tree : Project_Tree_Ref;
347 List : Array_Element_Id;
348 Debug_Name : String);
349 -- Check that a list of unit names contains only valid names. Casing
350 -- is normalized where appropriate.
351 -- Debug_Name is the name representing the list, and is used for debug
354 procedure Find_Ada_Sources
355 (Project : Project_Id;
356 In_Tree : Project_Tree_Ref;
357 Explicit_Sources_Only : Boolean;
358 Proc_Data : in out Processing_Data);
359 -- Find all Ada sources by traversing all source directories. If
360 -- Explicit_Sources_Only is True, then the sources found must belong to
361 -- the list of sources specified explicitly in the project file. If
362 -- Explicit_Sources_Only is False, then all sources matching the naming
363 -- scheme are recorded.
365 function Compute_Directory_Last (Dir : String) return Natural;
366 -- Return the index of the last significant character in Dir. This is used
367 -- to avoid duplicate '/' (slash) characters at the end of directory names.
370 (Project : Project_Id;
371 In_Tree : Project_Tree_Ref;
373 Flag_Location : Source_Ptr);
374 -- Output an error message. If Error_Report is null, simply call
375 -- Prj.Err.Error_Msg. Otherwise, disregard Flag_Location and use
378 procedure Search_Directories
379 (Project : Project_Id;
380 In_Tree : Project_Tree_Ref;
381 For_All_Sources : Boolean;
382 Allow_Duplicate_Basenames : Boolean);
383 -- Search the source directories to find the sources. If For_All_Sources is
384 -- True, check each regular file name against the naming schemes of the
385 -- different languages. Otherwise consider only the file names in the hash
386 -- table Source_Names. If Allow_Duplicate_Basenames, then files with the
387 -- same base names are authorized within a project for source-based
388 -- languages (never for unit based languages)
391 (Project : Project_Id;
392 In_Tree : Project_Tree_Ref;
393 Path : Path_Name_Type;
394 File_Name : File_Name_Type;
395 Display_File_Name : File_Name_Type;
396 For_All_Sources : Boolean;
397 Allow_Duplicate_Basenames : Boolean);
398 -- Check if file File_Name is a valid source of the project. This is used
399 -- in multi-language mode only. When the file matches one of the naming
400 -- schemes, it is added to various htables through Add_Source and to
401 -- Source_Paths_Htable.
403 -- Name is the name of the candidate file. It hasn't been normalized yet
404 -- and is the direct result of readdir().
406 -- File_Name is the same as Name, but has been normalized.
407 -- Display_File_Name, however, has not been normalized.
409 -- Source_Directory is the directory in which the file
410 -- was found. It hasn't been normalized (nor has had links resolved).
411 -- It should not end with a directory separator, to avoid duplicates
414 -- If For_All_Sources is True, then all possible file names are analyzed
415 -- otherwise only those currently set in the Source_Names htable.
417 -- If Allow_Duplicate_Basenames, then files with the same base names are
418 -- authorized within a project for source-based languages (never for unit
421 procedure Check_File_Naming_Schemes
422 (In_Tree : Project_Tree_Ref;
423 Project : Project_Id;
424 File_Name : File_Name_Type;
425 Alternate_Languages : out Language_List;
426 Language : out Language_Ptr;
427 Display_Language_Name : out Name_Id;
429 Lang_Kind : out Language_Kind;
430 Kind : out Source_Kind);
431 -- Check if the file name File_Name conforms to one of the naming
432 -- schemes of the project.
434 -- If the file does not match one of the naming schemes, set Language
435 -- to No_Language_Index.
437 -- Filename is the name of the file being investigated. It has been
438 -- normalized (case-folded). File_Name is the same value.
440 procedure Free_Ada_Naming_Exceptions;
441 -- Free the internal hash tables used for checking naming exceptions
443 procedure Get_Directories
444 (Project : Project_Id;
445 In_Tree : Project_Tree_Ref;
446 Current_Dir : String);
447 -- Get the object directory, the exec directory and the source directories
450 -- Current_Dir should represent the current directory, and is passed for
451 -- efficiency to avoid system calls to recompute it.
454 (Project : Project_Id;
455 In_Tree : Project_Tree_Ref);
456 -- Get the mains of a project from attribute Main, if it exists, and put
457 -- them in the project data.
459 procedure Get_Sources_From_File
461 Location : Source_Ptr;
462 Project : Project_Id;
463 In_Tree : Project_Tree_Ref);
464 -- Get the list of sources from a text file and put them in hash table
467 procedure Find_Sources
468 (Project : Project_Id;
469 In_Tree : Project_Tree_Ref;
470 Proc_Data : in out Processing_Data;
471 Allow_Duplicate_Basenames : Boolean);
472 -- Process the Source_Files and Source_List_File attributes, and store
473 -- the list of source files into the Source_Names htable.
474 -- When these attributes are not defined, find all files matching the
475 -- naming schemes in the source directories.
476 -- If Allow_Duplicate_Basenames, then files with the same base names are
477 -- authorized within a project for source-based languages (never for unit
480 procedure Compute_Unit_Name
481 (File_Name : File_Name_Type;
482 Naming : Lang_Naming_Data;
483 Kind : out Source_Kind;
485 In_Tree : Project_Tree_Ref);
486 -- Check whether the file matches the naming scheme. If it does,
487 -- compute its unit name. If Unit is set to No_Name on exit, none of the
488 -- other out parameters are relevant.
491 (In_Tree : Project_Tree_Ref;
492 Canonical_File_Name : File_Name_Type;
493 Project : Project_Id;
494 Exception_Id : out Ada_Naming_Exception_Id;
495 Unit_Name : out Name_Id;
496 Unit_Kind : out Spec_Or_Body);
497 -- Find out, from a file name, the unit name, the unit kind and if a
498 -- specific SFN pragma is needed. If the file name corresponds to no unit,
499 -- then Unit_Name will be No_Name. If the file is a multi-unit source or an
500 -- exception to the naming scheme, then Exception_Id is set to the unit or
501 -- units that the source contains, and the other information are not set.
503 function Is_Illegal_Suffix
504 (Suffix : File_Name_Type;
505 Dot_Replacement : File_Name_Type) return Boolean;
506 -- Returns True if the string Suffix cannot be used as a spec suffix, a
507 -- body suffix or a separate suffix.
509 procedure Locate_Directory
510 (Project : Project_Id;
511 In_Tree : Project_Tree_Ref;
512 Name : File_Name_Type;
513 Path : out Path_Information;
514 Dir_Exists : out Boolean;
515 Create : String := "";
516 Location : Source_Ptr := No_Location;
517 Must_Exist : Boolean := True;
518 Externally_Built : Boolean := False);
519 -- Locate a directory. Name is the directory name.
520 -- Relative paths are resolved relative to the project's directory.
521 -- If the directory does not exist and Setup_Projects
522 -- is True and Create is a non null string, an attempt is made to create
524 -- If the directory does not exist, it is either created if Setup_Projects
525 -- is False (and then returned), or simply returned without checking for
526 -- its existence (if Must_Exist is False) or No_Path_Information is
527 -- returned. In all cases, Dir_Exists indicates whether the directory now
530 -- Create is also used for debugging traces to show which path we are
533 procedure Look_For_Sources
534 (Project : Project_Id;
535 In_Tree : Project_Tree_Ref;
536 Proc_Data : in out Processing_Data;
537 Allow_Duplicate_Basenames : Boolean);
538 -- Find all the sources of project Project in project tree In_Tree and
539 -- update its Data accordingly. This assumes that Data.First_Source has
540 -- been initialized with the list of excluded sources and special naming
541 -- exceptions. If Allow_Duplicate_Basenames, then files with the same base
542 -- names are authorized within a project for source-based languages (never
543 -- for unit based languages)
545 function Path_Name_Of
546 (File_Name : File_Name_Type;
547 Directory : Path_Name_Type) return String;
548 -- Returns the path name of a (non project) file. Returns an empty string
549 -- if file cannot be found.
551 procedure Prepare_Ada_Naming_Exceptions
552 (List : Array_Element_Id;
553 In_Tree : Project_Tree_Ref;
554 Kind : Spec_Or_Body);
555 -- Prepare the internal hash tables used for checking naming exceptions
556 -- for Ada. Insert all elements of List in the tables.
558 procedure Record_Ada_Source
559 (File_Name : File_Name_Type;
560 Path_Name : Path_Name_Type;
561 Project : Project_Id;
562 In_Tree : Project_Tree_Ref;
563 Proc_Data : in out Processing_Data;
564 Ada_Language : Language_Ptr;
565 Location : Source_Ptr;
566 Source_Recorded : in out Boolean);
567 -- Put a unit in the list of units of a project, if the file name
568 -- corresponds to a valid unit name. Ada_Language is a pointer to the
569 -- Language_Data for "Ada" in Project.
571 procedure Remove_Source
573 Replaced_By : Source_Id);
574 -- Remove a file from the list of sources of a project.
575 -- This might be because the file is replaced by another one in an
576 -- extending project, or because a file was added as a naming exception
577 -- but was not found in the end.
579 procedure Report_No_Sources
580 (Project : Project_Id;
582 In_Tree : Project_Tree_Ref;
583 Location : Source_Ptr;
584 Continuation : Boolean := False);
585 -- Report an error or a warning depending on the value of When_No_Sources
586 -- when there are no sources for language Lang_Name.
588 procedure Show_Source_Dirs
589 (Project : Project_Id; In_Tree : Project_Tree_Ref);
590 -- List all the source directories of a project
592 procedure Warn_If_Not_Sources
593 (Project : Project_Id;
594 In_Tree : Project_Tree_Ref;
595 Conventions : Array_Element_Id;
597 Extending : Boolean);
598 -- Check that individual naming conventions apply to immediate sources of
599 -- the project. If not, issue a warning.
601 procedure Write_Attr (Name, Value : String);
602 -- Debug print a value for a specific property. Does nothing when not in
605 ------------------------------
606 -- Replace_Into_Name_Buffer --
607 ------------------------------
609 procedure Replace_Into_Name_Buffer
612 Replacement : Character)
614 Max : constant Integer := Str'Last - Pattern'Length + 1;
621 while J <= Str'Last loop
622 Name_Len := Name_Len + 1;
625 and then Str (J .. J + Pattern'Length - 1) = Pattern
627 Name_Buffer (Name_Len) := Replacement;
628 J := J + Pattern'Length;
631 Name_Buffer (Name_Len) := GNAT.Case_Util.To_Lower (Str (J));
635 end Replace_Into_Name_Buffer;
641 function Suffix_Matches
643 Suffix : File_Name_Type) return Boolean
645 Min_Prefix_Length : Natural := 0;
647 if Suffix = No_File or else Suffix = Empty_File then
652 Suf : constant String := Get_Name_String (Suffix);
655 -- The file name must end with the suffix (which is not an extension)
656 -- For instance a suffix "configure.in" must match a file with the
657 -- same name. To avoid dummy cases, though, a suffix starting with
658 -- '.' requires a file that is at least one character longer ('.cpp'
659 -- should not match a file with the same name)
661 if Suf (Suf'First) = '.' then
662 Min_Prefix_Length := 1;
665 return Filename'Length >= Suf'Length + Min_Prefix_Length
667 (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;
675 procedure Write_Attr (Name, Value : String) is
677 if Current_Verbosity = High then
678 Write_Str (" " & Name & " = """);
691 In_Tree : Project_Tree_Ref;
692 Project : Project_Id;
693 Lang_Id : Language_Ptr;
695 File_Name : File_Name_Type;
696 Display_File : File_Name_Type;
697 Naming_Exception : Boolean := False;
698 Path : Path_Information := No_Path_Information;
699 Alternate_Languages : Language_List := null;
700 Unit : Name_Id := No_Name;
702 Source_To_Replace : Source_Id := No_Source)
704 Config : constant Language_Config := Lang_Id.Config;
708 Id := new Source_Data;
710 if Current_Verbosity = High then
711 Write_Str ("Adding source File: ");
712 Write_Str (Get_Name_String (File_Name));
714 if Lang_Id.Config.Kind = Unit_Based then
715 Write_Str (" Unit: ");
716 -- ??? in gprclean, it seems we sometimes pass an empty Unit name
717 -- (see test extended_projects)
718 if Unit /= No_Name then
719 Write_Str (Get_Name_String (Unit));
721 Write_Str (" Kind: ");
722 Write_Str (Source_Kind'Image (Kind));
728 Id.Project := Project;
729 Id.Language := Lang_Id;
731 Id.Alternate_Languages := Alternate_Languages;
733 -- Add the source id to the Unit_Sources_HT hash table, if the unit name
736 if Unit /= No_Name then
737 Unit_Sources_Htable.Set (In_Tree.Unit_Sources_HT, Unit, Id);
739 -- ??? Record_Unit has already fetched that earlier, so this isn't
740 -- the most efficient way. But we can't really pass a parameter since
741 -- Process_Exceptions_Unit_Based and Check_File haven't looked it up.
743 UData := Units_Htable.Get (In_Tree.Units_HT, Unit);
745 if UData = No_Unit_Index then
746 UData := new Unit_Data;
748 Units_Htable.Set (In_Tree.Units_HT, Unit, UData);
753 -- Note that this updates Unit information as well
755 Override_Kind (Id, Kind);
759 Id.File := File_Name;
760 Id.Display_File := Display_File;
761 Id.Dep_Name := Dependency_Name
762 (File_Name, Lang_Id.Config.Dependency_Kind);
763 Id.Naming_Exception := Naming_Exception;
765 if Is_Compilable (Id) and then Config.Object_Generated then
766 Id.Object := Object_Name (File_Name, Config.Object_File_Suffix);
767 Id.Switches := Switches_Name (File_Name);
770 if Path /= No_Path_Information then
772 Source_Paths_Htable.Set (In_Tree.Source_Paths_HT, Path.Name, Id);
775 -- Add the source to the language list
777 Id.Next_In_Lang := Lang_Id.First_Source;
778 Lang_Id.First_Source := Id;
780 if Source_To_Replace /= No_Source then
781 Remove_Source (Source_To_Replace, Id);
789 function ALI_File_Name (Source : String) return String is
791 -- If the source name has extension, replace it with the ALI suffix
793 for Index in reverse Source'First + 1 .. Source'Last loop
794 if Source (Index) = '.' then
795 return Source (Source'First .. Index - 1) & ALI_Suffix;
799 -- If no dot, or if it is the first character, just add the ALI suffix
801 return Source & ALI_Suffix;
804 ------------------------------
805 -- Canonical_Case_File_Name --
806 ------------------------------
808 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type is
810 if Osint.File_Names_Case_Sensitive then
811 return File_Name_Type (Name);
813 Get_Name_String (Name);
814 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
817 end Canonical_Case_File_Name;
824 (Project : Project_Id;
825 In_Tree : Project_Tree_Ref;
826 Report_Error : Put_Line_Access;
827 When_No_Sources : Error_Warning;
828 Current_Dir : String;
829 Proc_Data : in out Processing_Data;
830 Is_Config_File : Boolean;
831 Compiler_Driver_Mandatory : Boolean;
832 Allow_Duplicate_Basenames : Boolean)
834 Specs : Array_Element_Id;
835 Bodies : Array_Element_Id;
836 Extending : Boolean := False;
839 Nmsc.When_No_Sources := When_No_Sources;
840 Error_Report := Report_Error;
842 Recursive_Dirs.Reset;
844 Check_If_Externally_Built (Project, In_Tree);
846 -- Object, exec and source directories
848 Get_Directories (Project, In_Tree, Current_Dir);
850 -- Get the programming languages
852 Check_Programming_Languages (In_Tree, Project);
854 if Project.Qualifier = Dry
855 and then Project.Source_Dirs /= Nil_String
858 Source_Dirs : constant Variable_Value :=
861 Project.Decl.Attributes, In_Tree);
862 Source_Files : constant Variable_Value :=
865 Project.Decl.Attributes, In_Tree);
866 Source_List_File : constant Variable_Value :=
868 (Name_Source_List_File,
869 Project.Decl.Attributes, In_Tree);
870 Languages : constant Variable_Value :=
873 Project.Decl.Attributes, In_Tree);
876 if Source_Dirs.Values = Nil_String
877 and then Source_Files.Values = Nil_String
878 and then Languages.Values = Nil_String
879 and then Source_List_File.Default
881 Project.Source_Dirs := Nil_String;
886 "at least one of Source_Files, Source_Dirs or Languages " &
887 "must be declared empty for an abstract project",
893 -- Check configuration in multi language mode
895 if Must_Check_Configuration then
898 Compiler_Driver_Mandatory => Compiler_Driver_Mandatory);
901 -- Library attributes
903 Check_Library_Attributes (Project, In_Tree);
905 if Current_Verbosity = High then
906 Show_Source_Dirs (Project, In_Tree);
909 Extending := Project.Extends /= No_Project;
911 Check_Package_Naming (Project, In_Tree, Is_Config_File, Bodies, Specs);
913 if Get_Mode = Ada_Only then
914 Prepare_Ada_Naming_Exceptions (Bodies, In_Tree, Impl);
915 Prepare_Ada_Naming_Exceptions (Specs, In_Tree, Spec);
920 if Project.Source_Dirs /= Nil_String then
922 (Project, In_Tree, Proc_Data, Allow_Duplicate_Basenames);
924 if Get_Mode = Ada_Only then
926 -- Check that all individual naming conventions apply to sources
927 -- of this project file.
930 (Project, In_Tree, Bodies,
932 Extending => Extending);
934 (Project, In_Tree, Specs,
936 Extending => Extending);
938 elsif Get_Mode = Multi_Language and then
939 (not Project.Externally_Built) and then
943 Language : Language_Ptr;
945 Alt_Lang : Language_List;
946 Continuation : Boolean := False;
947 Iter : Source_Iterator;
950 Language := Project.Languages;
951 while Language /= No_Language_Index loop
953 -- If there are no sources for this language, check whether
954 -- there are sources for which this is an alternate
957 if Language.First_Source = No_Source then
958 Iter := For_Each_Source (In_Tree => In_Tree,
961 Source := Element (Iter);
962 exit Source_Loop when Source = No_Source
963 or else Source.Language = Language;
965 Alt_Lang := Source.Alternate_Languages;
966 while Alt_Lang /= null loop
967 exit Source_Loop when Alt_Lang.Language = Language;
968 Alt_Lang := Alt_Lang.Next;
972 end loop Source_Loop;
974 if Source = No_Source then
977 Get_Name_String (Language.Display_Name),
981 Continuation := True;
985 Language := Language.Next;
991 if Get_Mode = Multi_Language then
993 -- If a list of sources is specified in attribute Interfaces, set
994 -- In_Interfaces only for the sources specified in the list.
996 Check_Interfaces (Project, In_Tree);
999 -- If it is a library project file, check if it is a standalone library
1001 if Project.Library then
1002 Check_Stand_Alone_Library
1003 (Project, In_Tree, Current_Dir, Extending);
1006 -- Put the list of Mains, if any, in the project data
1008 Get_Mains (Project, In_Tree);
1010 Free_Ada_Naming_Exceptions;
1013 --------------------
1014 -- Check_Ada_Name --
1015 --------------------
1017 procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is
1018 The_Name : String := Name;
1019 Real_Name : Name_Id;
1020 Need_Letter : Boolean := True;
1021 Last_Underscore : Boolean := False;
1022 OK : Boolean := The_Name'Length > 0;
1025 function Is_Reserved (Name : Name_Id) return Boolean;
1026 function Is_Reserved (S : String) return Boolean;
1027 -- Check that the given name is not an Ada 95 reserved word. The reason
1028 -- for the Ada 95 here is that we do not want to exclude the case of an
1029 -- Ada 95 unit called Interface (for example). In Ada 2005, such a unit
1030 -- name would be rejected anyway by the compiler. That means there is no
1031 -- requirement that the project file parser reject this.
1037 function Is_Reserved (S : String) return Boolean is
1040 Add_Str_To_Name_Buffer (S);
1041 return Is_Reserved (Name_Find);
1048 function Is_Reserved (Name : Name_Id) return Boolean is
1050 if Get_Name_Table_Byte (Name) /= 0
1051 and then Name /= Name_Project
1052 and then Name /= Name_Extends
1053 and then Name /= Name_External
1054 and then Name not in Ada_2005_Reserved_Words
1058 if Current_Verbosity = High then
1059 Write_Str (The_Name);
1060 Write_Line (" is an Ada reserved word.");
1070 -- Start of processing for Check_Ada_Name
1073 To_Lower (The_Name);
1075 Name_Len := The_Name'Length;
1076 Name_Buffer (1 .. Name_Len) := The_Name;
1078 -- Special cases of children of packages A, G, I and S on VMS
1080 if OpenVMS_On_Target
1081 and then Name_Len > 3
1082 and then Name_Buffer (2 .. 3) = "__"
1084 ((Name_Buffer (1) = 'a') or else
1085 (Name_Buffer (1) = 'g') or else
1086 (Name_Buffer (1) = 'i') or else
1087 (Name_Buffer (1) = 's'))
1089 Name_Buffer (2) := '.';
1090 Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
1091 Name_Len := Name_Len - 1;
1094 Real_Name := Name_Find;
1096 if Is_Reserved (Real_Name) then
1100 First := The_Name'First;
1102 for Index in The_Name'Range loop
1105 -- We need a letter (at the beginning, and following a dot),
1106 -- but we don't have one.
1108 if Is_Letter (The_Name (Index)) then
1109 Need_Letter := False;
1114 if Current_Verbosity = High then
1115 Write_Int (Types.Int (Index));
1117 Write_Char (The_Name (Index));
1118 Write_Line ("' is not a letter.");
1124 elsif Last_Underscore
1125 and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
1127 -- Two underscores are illegal, and a dot cannot follow
1132 if Current_Verbosity = High then
1133 Write_Int (Types.Int (Index));
1135 Write_Char (The_Name (Index));
1136 Write_Line ("' is illegal here.");
1141 elsif The_Name (Index) = '.' then
1143 -- First, check if the name before the dot is not a reserved word
1144 if Is_Reserved (The_Name (First .. Index - 1)) then
1150 -- We need a letter after a dot
1152 Need_Letter := True;
1154 elsif The_Name (Index) = '_' then
1155 Last_Underscore := True;
1158 -- We need an letter or a digit
1160 Last_Underscore := False;
1162 if not Is_Alphanumeric (The_Name (Index)) then
1165 if Current_Verbosity = High then
1166 Write_Int (Types.Int (Index));
1168 Write_Char (The_Name (Index));
1169 Write_Line ("' is not alphanumeric.");
1177 -- Cannot end with an underscore or a dot
1179 OK := OK and then not Need_Letter and then not Last_Underscore;
1182 if First /= Name'First and then
1183 Is_Reserved (The_Name (First .. The_Name'Last))
1191 -- Signal a problem with No_Name
1197 -------------------------
1198 -- Check_Configuration --
1199 -------------------------
1201 procedure Check_Configuration
1202 (Project : Project_Id;
1203 In_Tree : Project_Tree_Ref;
1204 Compiler_Driver_Mandatory : Boolean)
1206 Dot_Replacement : File_Name_Type := No_File;
1207 Casing : Casing_Type := All_Lower_Case;
1208 Separate_Suffix : File_Name_Type := No_File;
1210 Lang_Index : Language_Ptr := No_Language_Index;
1211 -- The index of the language data being checked
1213 Prev_Index : Language_Ptr := No_Language_Index;
1214 -- The index of the previous language
1216 procedure Process_Project_Level_Simple_Attributes;
1217 -- Process the simple attributes at the project level
1219 procedure Process_Project_Level_Array_Attributes;
1220 -- Process the associate array attributes at the project level
1222 procedure Process_Packages;
1223 -- Read the packages of the project
1225 ----------------------
1226 -- Process_Packages --
1227 ----------------------
1229 procedure Process_Packages is
1230 Packages : Package_Id;
1231 Element : Package_Element;
1233 procedure Process_Binder (Arrays : Array_Id);
1234 -- Process the associate array attributes of package Binder
1236 procedure Process_Builder (Attributes : Variable_Id);
1237 -- Process the simple attributes of package Builder
1239 procedure Process_Compiler (Arrays : Array_Id);
1240 -- Process the associate array attributes of package Compiler
1242 procedure Process_Naming (Attributes : Variable_Id);
1243 -- Process the simple attributes of package Naming
1245 procedure Process_Naming (Arrays : Array_Id);
1246 -- Process the associate array attributes of package Naming
1248 procedure Process_Linker (Attributes : Variable_Id);
1249 -- Process the simple attributes of package Linker of a
1250 -- configuration project.
1252 --------------------
1253 -- Process_Binder --
1254 --------------------
1256 procedure Process_Binder (Arrays : Array_Id) is
1257 Current_Array_Id : Array_Id;
1258 Current_Array : Array_Data;
1259 Element_Id : Array_Element_Id;
1260 Element : Array_Element;
1263 -- Process the associative array attribute of package Binder
1265 Current_Array_Id := Arrays;
1266 while Current_Array_Id /= No_Array loop
1267 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1269 Element_Id := Current_Array.Value;
1270 while Element_Id /= No_Array_Element loop
1271 Element := In_Tree.Array_Elements.Table (Element_Id);
1273 if Element.Index /= All_Other_Names then
1275 -- Get the name of the language
1278 Get_Language_From_Name
1279 (Project, Get_Name_String (Element.Index));
1281 if Lang_Index /= No_Language_Index then
1282 case Current_Array.Name is
1285 -- Attribute Driver (<language>)
1287 Lang_Index.Config.Binder_Driver :=
1288 File_Name_Type (Element.Value.Value);
1290 when Name_Required_Switches =>
1293 Lang_Index.Config.Binder_Required_Switches,
1294 From_List => Element.Value.Values,
1295 In_Tree => In_Tree);
1299 -- Attribute Prefix (<language>)
1301 Lang_Index.Config.Binder_Prefix :=
1302 Element.Value.Value;
1304 when Name_Objects_Path =>
1306 -- Attribute Objects_Path (<language>)
1308 Lang_Index.Config.Objects_Path :=
1309 Element.Value.Value;
1311 when Name_Objects_Path_File =>
1313 -- Attribute Objects_Path (<language>)
1315 Lang_Index.Config.Objects_Path_File :=
1316 Element.Value.Value;
1324 Element_Id := Element.Next;
1327 Current_Array_Id := Current_Array.Next;
1331 ---------------------
1332 -- Process_Builder --
1333 ---------------------
1335 procedure Process_Builder (Attributes : Variable_Id) is
1336 Attribute_Id : Variable_Id;
1337 Attribute : Variable;
1340 -- Process non associated array attribute from package Builder
1342 Attribute_Id := Attributes;
1343 while Attribute_Id /= No_Variable loop
1345 In_Tree.Variable_Elements.Table (Attribute_Id);
1347 if not Attribute.Value.Default then
1348 if Attribute.Name = Name_Executable_Suffix then
1350 -- Attribute Executable_Suffix: the suffix of the
1353 Project.Config.Executable_Suffix :=
1354 Attribute.Value.Value;
1358 Attribute_Id := Attribute.Next;
1360 end Process_Builder;
1362 ----------------------
1363 -- Process_Compiler --
1364 ----------------------
1366 procedure Process_Compiler (Arrays : Array_Id) is
1367 Current_Array_Id : Array_Id;
1368 Current_Array : Array_Data;
1369 Element_Id : Array_Element_Id;
1370 Element : Array_Element;
1371 List : String_List_Id;
1374 -- Process the associative array attribute of package Compiler
1376 Current_Array_Id := Arrays;
1377 while Current_Array_Id /= No_Array loop
1378 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1380 Element_Id := Current_Array.Value;
1381 while Element_Id /= No_Array_Element loop
1382 Element := In_Tree.Array_Elements.Table (Element_Id);
1384 if Element.Index /= All_Other_Names then
1386 -- Get the name of the language
1388 Lang_Index := Get_Language_From_Name
1389 (Project, Get_Name_String (Element.Index));
1391 if Lang_Index /= No_Language_Index then
1392 case Current_Array.Name is
1393 when Name_Dependency_Switches =>
1395 -- Attribute Dependency_Switches (<language>)
1397 if Lang_Index.Config.Dependency_Kind = None then
1398 Lang_Index.Config.Dependency_Kind := Makefile;
1401 List := Element.Value.Values;
1403 if List /= Nil_String then
1405 Lang_Index.Config.Dependency_Option,
1407 In_Tree => In_Tree);
1410 when Name_Dependency_Driver =>
1412 -- Attribute Dependency_Driver (<language>)
1414 if Lang_Index.Config.Dependency_Kind = None then
1415 Lang_Index.Config.Dependency_Kind := Makefile;
1418 List := Element.Value.Values;
1420 if List /= Nil_String then
1422 Lang_Index.Config.Compute_Dependency,
1424 In_Tree => In_Tree);
1427 when Name_Include_Switches =>
1429 -- Attribute Include_Switches (<language>)
1431 List := Element.Value.Values;
1433 if List = Nil_String then
1437 "include option cannot be null",
1438 Element.Value.Location);
1442 Lang_Index.Config.Include_Option,
1444 In_Tree => In_Tree);
1446 when Name_Include_Path =>
1448 -- Attribute Include_Path (<language>)
1450 Lang_Index.Config.Include_Path :=
1451 Element.Value.Value;
1453 when Name_Include_Path_File =>
1455 -- Attribute Include_Path_File (<language>)
1457 Lang_Index.Config.Include_Path_File :=
1458 Element.Value.Value;
1462 -- Attribute Driver (<language>)
1464 Lang_Index.Config.Compiler_Driver :=
1465 File_Name_Type (Element.Value.Value);
1467 when Name_Required_Switches |
1468 Name_Leading_Required_Switches =>
1471 Compiler_Leading_Required_Switches,
1472 From_List => Element.Value.Values,
1473 In_Tree => In_Tree);
1475 when Name_Trailing_Required_Switches =>
1478 Compiler_Trailing_Required_Switches,
1479 From_List => Element.Value.Values,
1480 In_Tree => In_Tree);
1482 when Name_Path_Syntax =>
1484 Lang_Index.Config.Path_Syntax :=
1485 Path_Syntax_Kind'Value
1486 (Get_Name_String (Element.Value.Value));
1489 when Constraint_Error =>
1493 "invalid value for Path_Syntax",
1494 Element.Value.Location);
1497 when Name_Object_File_Suffix =>
1498 if Get_Name_String (Element.Value.Value) = "" then
1501 "object file suffix cannot be empty",
1502 Element.Value.Location);
1505 Lang_Index.Config.Object_File_Suffix :=
1506 Element.Value.Value;
1509 when Name_Object_File_Switches =>
1511 Lang_Index.Config.Object_File_Switches,
1512 From_List => Element.Value.Values,
1513 In_Tree => In_Tree);
1515 when Name_Pic_Option =>
1517 -- Attribute Compiler_Pic_Option (<language>)
1519 List := Element.Value.Values;
1521 if List = Nil_String then
1525 "compiler PIC option cannot be null",
1526 Element.Value.Location);
1530 Lang_Index.Config.Compilation_PIC_Option,
1532 In_Tree => In_Tree);
1534 when Name_Mapping_File_Switches =>
1536 -- Attribute Mapping_File_Switches (<language>)
1538 List := Element.Value.Values;
1540 if List = Nil_String then
1544 "mapping file switches cannot be null",
1545 Element.Value.Location);
1549 Lang_Index.Config.Mapping_File_Switches,
1551 In_Tree => In_Tree);
1553 when Name_Mapping_Spec_Suffix =>
1555 -- Attribute Mapping_Spec_Suffix (<language>)
1557 Lang_Index.Config.Mapping_Spec_Suffix :=
1558 File_Name_Type (Element.Value.Value);
1560 when Name_Mapping_Body_Suffix =>
1562 -- Attribute Mapping_Body_Suffix (<language>)
1564 Lang_Index.Config.Mapping_Body_Suffix :=
1565 File_Name_Type (Element.Value.Value);
1567 when Name_Config_File_Switches =>
1569 -- Attribute Config_File_Switches (<language>)
1571 List := Element.Value.Values;
1573 if List = Nil_String then
1577 "config file switches cannot be null",
1578 Element.Value.Location);
1582 Lang_Index.Config.Config_File_Switches,
1584 In_Tree => In_Tree);
1586 when Name_Objects_Path =>
1588 -- Attribute Objects_Path (<language>)
1590 Lang_Index.Config.Objects_Path :=
1591 Element.Value.Value;
1593 when Name_Objects_Path_File =>
1595 -- Attribute Objects_Path_File (<language>)
1597 Lang_Index.Config.Objects_Path_File :=
1598 Element.Value.Value;
1600 when Name_Config_Body_File_Name =>
1602 -- Attribute Config_Body_File_Name (<language>)
1604 Lang_Index.Config.Config_Body :=
1605 Element.Value.Value;
1607 when Name_Config_Body_File_Name_Pattern =>
1609 -- Attribute Config_Body_File_Name_Pattern
1612 Lang_Index.Config.Config_Body_Pattern :=
1613 Element.Value.Value;
1615 when Name_Config_Spec_File_Name =>
1617 -- Attribute Config_Spec_File_Name (<language>)
1619 Lang_Index.Config.Config_Spec :=
1620 Element.Value.Value;
1622 when Name_Config_Spec_File_Name_Pattern =>
1624 -- Attribute Config_Spec_File_Name_Pattern
1627 Lang_Index.Config.Config_Spec_Pattern :=
1628 Element.Value.Value;
1630 when Name_Config_File_Unique =>
1632 -- Attribute Config_File_Unique (<language>)
1635 Lang_Index.Config.Config_File_Unique :=
1637 (Get_Name_String (Element.Value.Value));
1639 when Constraint_Error =>
1643 "illegal value for Config_File_Unique",
1644 Element.Value.Location);
1653 Element_Id := Element.Next;
1656 Current_Array_Id := Current_Array.Next;
1658 end Process_Compiler;
1660 --------------------
1661 -- Process_Naming --
1662 --------------------
1664 procedure Process_Naming (Attributes : Variable_Id) is
1665 Attribute_Id : Variable_Id;
1666 Attribute : Variable;
1669 -- Process non associated array attribute from package Naming
1671 Attribute_Id := Attributes;
1672 while Attribute_Id /= No_Variable loop
1673 Attribute := In_Tree.Variable_Elements.Table (Attribute_Id);
1675 if not Attribute.Value.Default then
1676 if Attribute.Name = Name_Separate_Suffix then
1678 -- Attribute Separate_Suffix
1680 Get_Name_String (Attribute.Value.Value);
1681 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1682 Separate_Suffix := Name_Find;
1684 elsif Attribute.Name = Name_Casing then
1690 Value (Get_Name_String (Attribute.Value.Value));
1693 when Constraint_Error =>
1697 "invalid value for Casing",
1698 Attribute.Value.Location);
1701 elsif Attribute.Name = Name_Dot_Replacement then
1703 -- Attribute Dot_Replacement
1705 Dot_Replacement := File_Name_Type (Attribute.Value.Value);
1710 Attribute_Id := Attribute.Next;
1714 procedure Process_Naming (Arrays : Array_Id) is
1715 Current_Array_Id : Array_Id;
1716 Current_Array : Array_Data;
1717 Element_Id : Array_Element_Id;
1718 Element : Array_Element;
1720 -- Process the associative array attribute of package Naming
1722 Current_Array_Id := Arrays;
1723 while Current_Array_Id /= No_Array loop
1724 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1726 Element_Id := Current_Array.Value;
1727 while Element_Id /= No_Array_Element loop
1728 Element := In_Tree.Array_Elements.Table (Element_Id);
1730 -- Get the name of the language
1732 Lang_Index := Get_Language_From_Name
1733 (Project, Get_Name_String (Element.Index));
1735 if Lang_Index /= No_Language_Index then
1736 case Current_Array.Name is
1737 when Name_Spec_Suffix | Name_Specification_Suffix =>
1739 -- Attribute Spec_Suffix (<language>)
1741 Get_Name_String (Element.Value.Value);
1742 Canonical_Case_File_Name
1743 (Name_Buffer (1 .. Name_Len));
1744 Lang_Index.Config.Naming_Data.Spec_Suffix :=
1747 when Name_Implementation_Suffix | Name_Body_Suffix =>
1749 Get_Name_String (Element.Value.Value);
1750 Canonical_Case_File_Name
1751 (Name_Buffer (1 .. Name_Len));
1753 -- Attribute Body_Suffix (<language>)
1755 Lang_Index.Config.Naming_Data.Body_Suffix :=
1757 Lang_Index.Config.Naming_Data.Separate_Suffix :=
1758 Lang_Index.Config.Naming_Data.Body_Suffix;
1765 Element_Id := Element.Next;
1768 Current_Array_Id := Current_Array.Next;
1772 --------------------
1773 -- Process_Linker --
1774 --------------------
1776 procedure Process_Linker (Attributes : Variable_Id) is
1777 Attribute_Id : Variable_Id;
1778 Attribute : Variable;
1781 -- Process non associated array attribute from package Linker
1783 Attribute_Id := Attributes;
1784 while Attribute_Id /= No_Variable loop
1786 In_Tree.Variable_Elements.Table (Attribute_Id);
1788 if not Attribute.Value.Default then
1789 if Attribute.Name = Name_Driver then
1791 -- Attribute Linker'Driver: the default linker to use
1793 Project.Config.Linker :=
1794 Path_Name_Type (Attribute.Value.Value);
1796 -- Linker'Driver is also used to link shared libraries
1797 -- if the obsolescent attribute Library_GCC has not been
1800 if Project.Config.Shared_Lib_Driver = No_File then
1801 Project.Config.Shared_Lib_Driver :=
1802 File_Name_Type (Attribute.Value.Value);
1805 elsif Attribute.Name = Name_Required_Switches then
1807 -- Attribute Required_Switches: the minimum
1808 -- options to use when invoking the linker
1810 Put (Into_List => Project.Config.Minimum_Linker_Options,
1811 From_List => Attribute.Value.Values,
1812 In_Tree => In_Tree);
1814 elsif Attribute.Name = Name_Map_File_Option then
1815 Project.Config.Map_File_Option := Attribute.Value.Value;
1817 elsif Attribute.Name = Name_Max_Command_Line_Length then
1819 Project.Config.Max_Command_Line_Length :=
1820 Natural'Value (Get_Name_String
1821 (Attribute.Value.Value));
1824 when Constraint_Error =>
1828 "value must be positive or equal to 0",
1829 Attribute.Value.Location);
1832 elsif Attribute.Name = Name_Response_File_Format then
1837 Get_Name_String (Attribute.Value.Value);
1838 To_Lower (Name_Buffer (1 .. Name_Len));
1841 if Name = Name_None then
1842 Project.Config.Resp_File_Format := None;
1844 elsif Name = Name_Gnu then
1845 Project.Config.Resp_File_Format := GNU;
1847 elsif Name = Name_Object_List then
1848 Project.Config.Resp_File_Format := Object_List;
1850 elsif Name = Name_Option_List then
1851 Project.Config.Resp_File_Format := Option_List;
1857 "illegal response file format",
1858 Attribute.Value.Location);
1862 elsif Attribute.Name = Name_Response_File_Switches then
1863 Put (Into_List => Project.Config.Resp_File_Options,
1864 From_List => Attribute.Value.Values,
1865 In_Tree => In_Tree);
1869 Attribute_Id := Attribute.Next;
1873 -- Start of processing for Process_Packages
1876 Packages := Project.Decl.Packages;
1877 while Packages /= No_Package loop
1878 Element := In_Tree.Packages.Table (Packages);
1880 case Element.Name is
1883 -- Process attributes of package Binder
1885 Process_Binder (Element.Decl.Arrays);
1887 when Name_Builder =>
1889 -- Process attributes of package Builder
1891 Process_Builder (Element.Decl.Attributes);
1893 when Name_Compiler =>
1895 -- Process attributes of package Compiler
1897 Process_Compiler (Element.Decl.Arrays);
1901 -- Process attributes of package Linker
1903 Process_Linker (Element.Decl.Attributes);
1907 -- Process attributes of package Naming
1909 Process_Naming (Element.Decl.Attributes);
1910 Process_Naming (Element.Decl.Arrays);
1916 Packages := Element.Next;
1918 end Process_Packages;
1920 ---------------------------------------------
1921 -- Process_Project_Level_Simple_Attributes --
1922 ---------------------------------------------
1924 procedure Process_Project_Level_Simple_Attributes is
1925 Attribute_Id : Variable_Id;
1926 Attribute : Variable;
1927 List : String_List_Id;
1930 -- Process non associated array attribute at project level
1932 Attribute_Id := Project.Decl.Attributes;
1933 while Attribute_Id /= No_Variable loop
1935 In_Tree.Variable_Elements.Table (Attribute_Id);
1937 if not Attribute.Value.Default then
1938 if Attribute.Name = Name_Target then
1940 -- Attribute Target: the target specified
1942 Project.Config.Target := Attribute.Value.Value;
1944 elsif Attribute.Name = Name_Library_Builder then
1946 -- Attribute Library_Builder: the application to invoke
1947 -- to build libraries.
1949 Project.Config.Library_Builder :=
1950 Path_Name_Type (Attribute.Value.Value);
1952 elsif Attribute.Name = Name_Archive_Builder then
1954 -- Attribute Archive_Builder: the archive builder
1955 -- (usually "ar") and its minimum options (usually "cr").
1957 List := Attribute.Value.Values;
1959 if List = Nil_String then
1963 "archive builder cannot be null",
1964 Attribute.Value.Location);
1967 Put (Into_List => Project.Config.Archive_Builder,
1969 In_Tree => In_Tree);
1971 elsif Attribute.Name = Name_Archive_Builder_Append_Option then
1973 -- Attribute Archive_Builder: the archive builder
1974 -- (usually "ar") and its minimum options (usually "cr").
1976 List := Attribute.Value.Values;
1978 if List /= Nil_String then
1981 Project.Config.Archive_Builder_Append_Option,
1983 In_Tree => In_Tree);
1986 elsif Attribute.Name = Name_Archive_Indexer then
1988 -- Attribute Archive_Indexer: the optional archive
1989 -- indexer (usually "ranlib") with its minimum options
1992 List := Attribute.Value.Values;
1994 if List = Nil_String then
1998 "archive indexer cannot be null",
1999 Attribute.Value.Location);
2002 Put (Into_List => Project.Config.Archive_Indexer,
2004 In_Tree => In_Tree);
2006 elsif Attribute.Name = Name_Library_Partial_Linker then
2008 -- Attribute Library_Partial_Linker: the optional linker
2009 -- driver with its minimum options, to partially link
2012 List := Attribute.Value.Values;
2014 if List = Nil_String then
2018 "partial linker cannot be null",
2019 Attribute.Value.Location);
2022 Put (Into_List => Project.Config.Lib_Partial_Linker,
2024 In_Tree => In_Tree);
2026 elsif Attribute.Name = Name_Library_GCC then
2027 Project.Config.Shared_Lib_Driver :=
2028 File_Name_Type (Attribute.Value.Value);
2032 "?Library_'G'C'C is an obsolescent attribute, " &
2033 "use Linker''Driver instead",
2034 Attribute.Value.Location);
2036 elsif Attribute.Name = Name_Archive_Suffix then
2037 Project.Config.Archive_Suffix :=
2038 File_Name_Type (Attribute.Value.Value);
2040 elsif Attribute.Name = Name_Linker_Executable_Option then
2042 -- Attribute Linker_Executable_Option: optional options
2043 -- to specify an executable name. Defaults to "-o".
2045 List := Attribute.Value.Values;
2047 if List = Nil_String then
2051 "linker executable option cannot be null",
2052 Attribute.Value.Location);
2055 Put (Into_List => Project.Config.Linker_Executable_Option,
2057 In_Tree => In_Tree);
2059 elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
2061 -- Attribute Linker_Lib_Dir_Option: optional options
2062 -- to specify a library search directory. Defaults to
2065 Get_Name_String (Attribute.Value.Value);
2067 if Name_Len = 0 then
2071 "linker library directory option cannot be empty",
2072 Attribute.Value.Location);
2075 Project.Config.Linker_Lib_Dir_Option :=
2076 Attribute.Value.Value;
2078 elsif Attribute.Name = Name_Linker_Lib_Name_Option then
2080 -- Attribute Linker_Lib_Name_Option: optional options
2081 -- to specify the name of a library to be linked in.
2082 -- Defaults to "-l".
2084 Get_Name_String (Attribute.Value.Value);
2086 if Name_Len = 0 then
2090 "linker library name option cannot be empty",
2091 Attribute.Value.Location);
2094 Project.Config.Linker_Lib_Name_Option :=
2095 Attribute.Value.Value;
2097 elsif Attribute.Name = Name_Run_Path_Option then
2099 -- Attribute Run_Path_Option: optional options to
2100 -- specify a path for libraries.
2102 List := Attribute.Value.Values;
2104 if List /= Nil_String then
2105 Put (Into_List => Project.Config.Run_Path_Option,
2107 In_Tree => In_Tree);
2110 elsif Attribute.Name = Name_Separate_Run_Path_Options then
2112 pragma Unsuppress (All_Checks);
2114 Project.Config.Separate_Run_Path_Options :=
2115 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2117 when Constraint_Error =>
2121 "invalid value """ &
2122 Get_Name_String (Attribute.Value.Value) &
2123 """ for Separate_Run_Path_Options",
2124 Attribute.Value.Location);
2127 elsif Attribute.Name = Name_Library_Support then
2129 pragma Unsuppress (All_Checks);
2131 Project.Config.Lib_Support :=
2132 Library_Support'Value (Get_Name_String
2133 (Attribute.Value.Value));
2135 when Constraint_Error =>
2139 "invalid value """ &
2140 Get_Name_String (Attribute.Value.Value) &
2141 """ for Library_Support",
2142 Attribute.Value.Location);
2145 elsif Attribute.Name = Name_Shared_Library_Prefix then
2146 Project.Config.Shared_Lib_Prefix :=
2147 File_Name_Type (Attribute.Value.Value);
2149 elsif Attribute.Name = Name_Shared_Library_Suffix then
2150 Project.Config.Shared_Lib_Suffix :=
2151 File_Name_Type (Attribute.Value.Value);
2153 elsif Attribute.Name = Name_Symbolic_Link_Supported then
2155 pragma Unsuppress (All_Checks);
2157 Project.Config.Symbolic_Link_Supported :=
2158 Boolean'Value (Get_Name_String
2159 (Attribute.Value.Value));
2161 when Constraint_Error =>
2166 & Get_Name_String (Attribute.Value.Value)
2167 & """ for Symbolic_Link_Supported",
2168 Attribute.Value.Location);
2172 Attribute.Name = Name_Library_Major_Minor_Id_Supported
2175 pragma Unsuppress (All_Checks);
2177 Project.Config.Lib_Maj_Min_Id_Supported :=
2178 Boolean'Value (Get_Name_String
2179 (Attribute.Value.Value));
2181 when Constraint_Error =>
2185 "invalid value """ &
2186 Get_Name_String (Attribute.Value.Value) &
2187 """ for Library_Major_Minor_Id_Supported",
2188 Attribute.Value.Location);
2191 elsif Attribute.Name = Name_Library_Auto_Init_Supported then
2193 pragma Unsuppress (All_Checks);
2195 Project.Config.Auto_Init_Supported :=
2196 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2198 when Constraint_Error =>
2203 & Get_Name_String (Attribute.Value.Value)
2204 & """ for Library_Auto_Init_Supported",
2205 Attribute.Value.Location);
2208 elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
2209 List := Attribute.Value.Values;
2211 if List /= Nil_String then
2212 Put (Into_List => Project.Config.Shared_Lib_Min_Options,
2214 In_Tree => In_Tree);
2217 elsif Attribute.Name = Name_Library_Version_Switches then
2218 List := Attribute.Value.Values;
2220 if List /= Nil_String then
2221 Put (Into_List => Project.Config.Lib_Version_Options,
2223 In_Tree => In_Tree);
2228 Attribute_Id := Attribute.Next;
2230 end Process_Project_Level_Simple_Attributes;
2232 --------------------------------------------
2233 -- Process_Project_Level_Array_Attributes --
2234 --------------------------------------------
2236 procedure Process_Project_Level_Array_Attributes is
2237 Current_Array_Id : Array_Id;
2238 Current_Array : Array_Data;
2239 Element_Id : Array_Element_Id;
2240 Element : Array_Element;
2241 List : String_List_Id;
2244 -- Process the associative array attributes at project level
2246 Current_Array_Id := Project.Decl.Arrays;
2247 while Current_Array_Id /= No_Array loop
2248 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
2250 Element_Id := Current_Array.Value;
2251 while Element_Id /= No_Array_Element loop
2252 Element := In_Tree.Array_Elements.Table (Element_Id);
2254 -- Get the name of the language
2257 Get_Language_From_Name
2258 (Project, Get_Name_String (Element.Index));
2260 if Lang_Index /= No_Language_Index then
2261 case Current_Array.Name is
2262 when Name_Inherit_Source_Path =>
2263 List := Element.Value.Values;
2265 if List /= Nil_String then
2268 Lang_Index.Config.Include_Compatible_Languages,
2271 Lower_Case => True);
2274 when Name_Toolchain_Description =>
2276 -- Attribute Toolchain_Description (<language>)
2278 Lang_Index.Config.Toolchain_Description :=
2279 Element.Value.Value;
2281 when Name_Toolchain_Version =>
2283 -- Attribute Toolchain_Version (<language>)
2285 Lang_Index.Config.Toolchain_Version :=
2286 Element.Value.Value;
2288 when Name_Runtime_Library_Dir =>
2290 -- Attribute Runtime_Library_Dir (<language>)
2292 Lang_Index.Config.Runtime_Library_Dir :=
2293 Element.Value.Value;
2295 when Name_Runtime_Source_Dir =>
2297 -- Attribute Runtime_Library_Dir (<language>)
2299 Lang_Index.Config.Runtime_Source_Dir :=
2300 Element.Value.Value;
2302 when Name_Object_Generated =>
2304 pragma Unsuppress (All_Checks);
2310 (Get_Name_String (Element.Value.Value));
2312 Lang_Index.Config.Object_Generated := Value;
2314 -- If no object is generated, no object may be
2318 Lang_Index.Config.Objects_Linked := False;
2322 when Constraint_Error =>
2327 & Get_Name_String (Element.Value.Value)
2328 & """ for Object_Generated",
2329 Element.Value.Location);
2332 when Name_Objects_Linked =>
2334 pragma Unsuppress (All_Checks);
2340 (Get_Name_String (Element.Value.Value));
2342 -- No change if Object_Generated is False, as this
2343 -- forces Objects_Linked to be False too.
2345 if Lang_Index.Config.Object_Generated then
2346 Lang_Index.Config.Objects_Linked := Value;
2350 when Constraint_Error =>
2355 & Get_Name_String (Element.Value.Value)
2356 & """ for Objects_Linked",
2357 Element.Value.Location);
2364 Element_Id := Element.Next;
2367 Current_Array_Id := Current_Array.Next;
2369 end Process_Project_Level_Array_Attributes;
2372 Process_Project_Level_Simple_Attributes;
2373 Process_Project_Level_Array_Attributes;
2376 -- For unit based languages, set Casing, Dot_Replacement and
2377 -- Separate_Suffix in Naming_Data.
2379 Lang_Index := Project.Languages;
2380 while Lang_Index /= No_Language_Index loop
2381 if Lang_Index.Name = Name_Ada then
2382 Lang_Index.Config.Naming_Data.Casing := Casing;
2383 Lang_Index.Config.Naming_Data.Dot_Replacement := Dot_Replacement;
2385 if Separate_Suffix /= No_File then
2386 Lang_Index.Config.Naming_Data.Separate_Suffix :=
2393 Lang_Index := Lang_Index.Next;
2396 -- Give empty names to various prefixes/suffixes, if they have not
2397 -- been specified in the configuration.
2399 if Project.Config.Archive_Suffix = No_File then
2400 Project.Config.Archive_Suffix := Empty_File;
2403 if Project.Config.Shared_Lib_Prefix = No_File then
2404 Project.Config.Shared_Lib_Prefix := Empty_File;
2407 if Project.Config.Shared_Lib_Suffix = No_File then
2408 Project.Config.Shared_Lib_Suffix := Empty_File;
2411 Lang_Index := Project.Languages;
2412 while Lang_Index /= No_Language_Index loop
2413 -- For all languages, Compiler_Driver needs to be specified. This is
2414 -- only needed if we do intend to compile (not in GPS for instance).
2416 if Compiler_Driver_Mandatory
2417 and then Lang_Index.Config.Compiler_Driver = No_File
2419 Error_Msg_Name_1 := Lang_Index.Display_Name;
2423 "?no compiler specified for language %%" &
2424 ", ignoring all its sources",
2427 if Lang_Index = Project.Languages then
2428 Project.Languages := Lang_Index.Next;
2430 Prev_Index.Next := Lang_Index.Next;
2433 elsif Lang_Index.Name = Name_Ada then
2434 Prev_Index := Lang_Index;
2436 -- For unit based languages, Dot_Replacement, Spec_Suffix and
2437 -- Body_Suffix need to be specified.
2439 if Lang_Index.Config.Naming_Data.Dot_Replacement = No_File then
2443 "Dot_Replacement not specified for Ada",
2447 if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File then
2451 "Spec_Suffix not specified for Ada",
2455 if Lang_Index.Config.Naming_Data.Body_Suffix = No_File then
2459 "Body_Suffix not specified for Ada",
2464 Prev_Index := Lang_Index;
2466 -- For file based languages, either Spec_Suffix or Body_Suffix
2467 -- need to be specified.
2469 if Lang_Index.Config.Naming_Data.Spec_Suffix = No_File and then
2470 Lang_Index.Config.Naming_Data.Body_Suffix = No_File
2472 Error_Msg_Name_1 := Lang_Index.Display_Name;
2476 "no suffixes specified for %%",
2481 Lang_Index := Lang_Index.Next;
2483 end Check_Configuration;
2485 -------------------------------
2486 -- Check_If_Externally_Built --
2487 -------------------------------
2489 procedure Check_If_Externally_Built
2490 (Project : Project_Id;
2491 In_Tree : Project_Tree_Ref)
2493 Externally_Built : constant Variable_Value :=
2495 (Name_Externally_Built,
2496 Project.Decl.Attributes, In_Tree);
2499 if not Externally_Built.Default then
2500 Get_Name_String (Externally_Built.Value);
2501 To_Lower (Name_Buffer (1 .. Name_Len));
2503 if Name_Buffer (1 .. Name_Len) = "true" then
2504 Project.Externally_Built := True;
2506 elsif Name_Buffer (1 .. Name_Len) /= "false" then
2507 Error_Msg (Project, In_Tree,
2508 "Externally_Built may only be true or false",
2509 Externally_Built.Location);
2513 -- A virtual project extending an externally built project is itself
2514 -- externally built.
2516 if Project.Virtual and then Project.Extends /= No_Project then
2517 Project.Externally_Built := Project.Extends.Externally_Built;
2520 if Current_Verbosity = High then
2521 Write_Str ("Project is ");
2523 if not Project.Externally_Built then
2527 Write_Line ("externally built.");
2529 end Check_If_Externally_Built;
2531 ----------------------
2532 -- Check_Interfaces --
2533 ----------------------
2535 procedure Check_Interfaces
2536 (Project : Project_Id;
2537 In_Tree : Project_Tree_Ref)
2539 Interfaces : constant Prj.Variable_Value :=
2541 (Snames.Name_Interfaces,
2542 Project.Decl.Attributes,
2545 List : String_List_Id;
2546 Element : String_Element;
2547 Name : File_Name_Type;
2548 Iter : Source_Iterator;
2550 Project_2 : Project_Id;
2554 if not Interfaces.Default then
2556 -- Set In_Interfaces to False for all sources. It will be set to True
2557 -- later for the sources in the Interfaces list.
2559 Project_2 := Project;
2560 while Project_2 /= No_Project loop
2561 Iter := For_Each_Source (In_Tree, Project_2);
2564 Source := Prj.Element (Iter);
2565 exit when Source = No_Source;
2566 Source.In_Interfaces := False;
2570 Project_2 := Project_2.Extends;
2573 List := Interfaces.Values;
2574 while List /= Nil_String loop
2575 Element := In_Tree.String_Elements.Table (List);
2576 Name := Canonical_Case_File_Name (Element.Value);
2578 Project_2 := Project;
2580 while Project_2 /= No_Project loop
2581 Iter := For_Each_Source (In_Tree, Project_2);
2584 Source := Prj.Element (Iter);
2585 exit when Source = No_Source;
2587 if Source.File = Name then
2588 if not Source.Locally_Removed then
2589 Source.In_Interfaces := True;
2590 Source.Declared_In_Interfaces := True;
2592 Other := Other_Part (Source);
2594 if Other /= No_Source then
2595 Other.In_Interfaces := True;
2596 Other.Declared_In_Interfaces := True;
2599 if Current_Verbosity = High then
2600 Write_Str (" interface: ");
2601 Write_Line (Get_Name_String (Source.Path.Name));
2611 Project_2 := Project_2.Extends;
2614 if Source = No_Source then
2615 Error_Msg_File_1 := File_Name_Type (Element.Value);
2616 Error_Msg_Name_1 := Project.Name;
2621 "{ cannot be an interface of project %% "
2622 & "as it is not one of its sources",
2626 List := Element.Next;
2629 Project.Interfaces_Defined := True;
2631 elsif Project.Extends /= No_Project then
2632 Project.Interfaces_Defined := Project.Extends.Interfaces_Defined;
2634 if Project.Interfaces_Defined then
2635 Iter := For_Each_Source (In_Tree, Project);
2637 Source := Prj.Element (Iter);
2638 exit when Source = No_Source;
2640 if not Source.Declared_In_Interfaces then
2641 Source.In_Interfaces := False;
2648 end Check_Interfaces;
2650 ------------------------------------
2651 -- Check_And_Normalize_Unit_Names --
2652 ------------------------------------
2654 procedure Check_And_Normalize_Unit_Names
2655 (Project : Project_Id;
2656 In_Tree : Project_Tree_Ref;
2657 List : Array_Element_Id;
2658 Debug_Name : String)
2660 Current : Array_Element_Id;
2661 Element : Array_Element;
2662 Unit_Name : Name_Id;
2665 if Current_Verbosity = High then
2666 Write_Line (" Checking unit names in " & Debug_Name);
2670 while Current /= No_Array_Element loop
2671 Element := In_Tree.Array_Elements.Table (Current);
2672 Element.Value.Value :=
2673 Name_Id (Canonical_Case_File_Name (Element.Value.Value));
2675 -- Check that it contains a valid unit name
2677 Get_Name_String (Element.Index);
2678 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name);
2680 if Unit_Name = No_Name then
2681 Err_Vars.Error_Msg_Name_1 := Element.Index;
2684 "%% is not a valid unit name.",
2685 Element.Value.Location);
2688 if Current_Verbosity = High then
2689 Write_Str (" for unit: ");
2690 Write_Line (Get_Name_String (Unit_Name));
2693 Element.Index := Unit_Name;
2694 In_Tree.Array_Elements.Table (Current) := Element;
2697 Current := Element.Next;
2699 end Check_And_Normalize_Unit_Names;
2701 --------------------------
2702 -- Check_Package_Naming --
2703 --------------------------
2705 procedure Check_Package_Naming
2706 (Project : Project_Id;
2707 In_Tree : Project_Tree_Ref;
2708 Is_Config_File : Boolean;
2709 Bodies : out Array_Element_Id;
2710 Specs : out Array_Element_Id)
2712 Naming_Id : constant Package_Id :=
2713 Util.Value_Of (Name_Naming, Project.Decl.Packages, In_Tree);
2714 Naming : Package_Element;
2716 Ada_Body_Suffix_Loc : Source_Ptr := No_Location;
2717 Ada_Spec_Suffix_Loc : Source_Ptr := No_Location;
2719 procedure Check_Naming_Ada_Only;
2720 -- Does Check_Naming_Schemes processing in Ada_Only mode.
2721 -- If there is a package Naming, puts in Data.Naming the contents of
2724 procedure Check_Naming_Multi_Lang;
2725 -- Does Check_Naming_Schemes processing for Multi_Language mode
2727 procedure Check_Common
2728 (Dot_Replacement : in out File_Name_Type;
2729 Casing : in out Casing_Type;
2730 Casing_Defined : out Boolean;
2731 Separate_Suffix : in out File_Name_Type;
2732 Sep_Suffix_Loc : out Source_Ptr);
2733 -- Check attributes common to Ada_Only and Multi_Lang modes
2735 procedure Process_Exceptions_File_Based
2736 (Lang_Id : Language_Ptr;
2737 Kind : Source_Kind);
2738 procedure Process_Exceptions_Unit_Based
2739 (Lang_Id : Language_Ptr;
2740 Kind : Source_Kind);
2741 -- In Multi_Lang mode, process the naming exceptions for the two types
2742 -- of languages we can have.
2744 procedure Initialize_Naming_Data;
2745 -- Initialize internal naming data for the various languages
2751 procedure Check_Common
2752 (Dot_Replacement : in out File_Name_Type;
2753 Casing : in out Casing_Type;
2754 Casing_Defined : out Boolean;
2755 Separate_Suffix : in out File_Name_Type;
2756 Sep_Suffix_Loc : out Source_Ptr)
2758 Dot_Repl : constant Variable_Value :=
2760 (Name_Dot_Replacement,
2761 Naming.Decl.Attributes,
2763 Casing_String : constant Variable_Value :=
2766 Naming.Decl.Attributes,
2768 Sep_Suffix : constant Variable_Value :=
2770 (Name_Separate_Suffix,
2771 Naming.Decl.Attributes,
2773 Dot_Repl_Loc : Source_Ptr;
2776 Sep_Suffix_Loc := No_Location;
2778 if not Dot_Repl.Default then
2780 (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
2782 if Length_Of_Name (Dot_Repl.Value) = 0 then
2785 "Dot_Replacement cannot be empty",
2789 Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
2790 Dot_Repl_Loc := Dot_Repl.Location;
2793 Repl : constant String := Get_Name_String (Dot_Replacement);
2796 -- Dot_Replacement cannot
2798 -- - start or end with an alphanumeric
2799 -- - be a single '_'
2800 -- - start with an '_' followed by an alphanumeric
2801 -- - contain a '.' except if it is "."
2804 or else Is_Alphanumeric (Repl (Repl'First))
2805 or else Is_Alphanumeric (Repl (Repl'Last))
2806 or else (Repl (Repl'First) = '_'
2810 Is_Alphanumeric (Repl (Repl'First + 1))))
2811 or else (Repl'Length > 1
2813 Index (Source => Repl, Pattern => ".") /= 0)
2818 """ is illegal for Dot_Replacement.",
2824 if Dot_Replacement /= No_File then
2826 ("Dot_Replacement", Get_Name_String (Dot_Replacement));
2829 Casing_Defined := False;
2831 if not Casing_String.Default then
2833 (Casing_String.Kind = Single, "Casing is not a string");
2836 Casing_Image : constant String :=
2837 Get_Name_String (Casing_String.Value);
2839 if Casing_Image'Length = 0 then
2842 "Casing cannot be an empty string",
2843 Casing_String.Location);
2846 Casing := Value (Casing_Image);
2847 Casing_Defined := True;
2850 when Constraint_Error =>
2851 Name_Len := Casing_Image'Length;
2852 Name_Buffer (1 .. Name_Len) := Casing_Image;
2853 Err_Vars.Error_Msg_Name_1 := Name_Find;
2856 "%% is not a correct Casing",
2857 Casing_String.Location);
2861 Write_Attr ("Casing", Image (Casing));
2863 if not Sep_Suffix.Default then
2864 if Length_Of_Name (Sep_Suffix.Value) = 0 then
2867 "Separate_Suffix cannot be empty",
2868 Sep_Suffix.Location);
2871 Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
2872 Sep_Suffix_Loc := Sep_Suffix.Location;
2874 if Is_Illegal_Suffix (Separate_Suffix, Dot_Replacement) then
2875 Err_Vars.Error_Msg_File_1 := Separate_Suffix;
2878 "{ is illegal for Separate_Suffix",
2879 Sep_Suffix.Location);
2884 if Separate_Suffix /= No_File then
2886 ("Separate_Suffix", Get_Name_String (Separate_Suffix));
2890 -----------------------------------
2891 -- Process_Exceptions_File_Based --
2892 -----------------------------------
2894 procedure Process_Exceptions_File_Based
2895 (Lang_Id : Language_Ptr;
2898 Lang : constant Name_Id := Lang_Id.Name;
2899 Exceptions : Array_Element_Id;
2900 Exception_List : Variable_Value;
2901 Element_Id : String_List_Id;
2902 Element : String_Element;
2903 File_Name : File_Name_Type;
2905 Iter : Source_Iterator;
2912 (Name_Implementation_Exceptions,
2913 In_Arrays => Naming.Decl.Arrays,
2914 In_Tree => In_Tree);
2919 (Name_Specification_Exceptions,
2920 In_Arrays => Naming.Decl.Arrays,
2921 In_Tree => In_Tree);
2924 Exception_List := Value_Of
2926 In_Array => Exceptions,
2927 In_Tree => In_Tree);
2929 if Exception_List /= Nil_Variable_Value then
2930 Element_Id := Exception_List.Values;
2931 while Element_Id /= Nil_String loop
2932 Element := In_Tree.String_Elements.Table (Element_Id);
2933 File_Name := Canonical_Case_File_Name (Element.Value);
2935 Iter := For_Each_Source (In_Tree, Project);
2937 Source := Prj.Element (Iter);
2938 exit when Source = No_Source or else Source.File = File_Name;
2942 if Source = No_Source then
2949 File_Name => File_Name,
2950 Display_File => File_Name_Type (Element.Value),
2951 Naming_Exception => True);
2954 -- Check if the file name is already recorded for another
2955 -- language or another kind.
2957 if Source.Language /= Lang_Id then
2961 "the same file cannot be a source of two languages",
2964 elsif Source.Kind /= Kind then
2968 "the same file cannot be a source and a template",
2972 -- If the file is already recorded for the same
2973 -- language and the same kind, it means that the file
2974 -- name appears several times in the *_Exceptions
2975 -- attribute; so there is nothing to do.
2978 Element_Id := Element.Next;
2981 end Process_Exceptions_File_Based;
2983 -----------------------------------
2984 -- Process_Exceptions_Unit_Based --
2985 -----------------------------------
2987 procedure Process_Exceptions_Unit_Based
2988 (Lang_Id : Language_Ptr;
2991 Lang : constant Name_Id := Lang_Id.Name;
2992 Exceptions : Array_Element_Id;
2993 Element : Array_Element;
2996 File_Name : File_Name_Type;
2998 Source_To_Replace : Source_Id := No_Source;
2999 Other_Project : Project_Id;
3000 Iter : Source_Iterator;
3005 Exceptions := Value_Of
3007 In_Arrays => Naming.Decl.Arrays,
3008 In_Tree => In_Tree);
3010 if Exceptions = No_Array_Element then
3013 (Name_Implementation,
3014 In_Arrays => Naming.Decl.Arrays,
3015 In_Tree => In_Tree);
3022 In_Arrays => Naming.Decl.Arrays,
3023 In_Tree => In_Tree);
3025 if Exceptions = No_Array_Element then
3026 Exceptions := Value_Of
3028 In_Arrays => Naming.Decl.Arrays,
3029 In_Tree => In_Tree);
3033 while Exceptions /= No_Array_Element loop
3034 Element := In_Tree.Array_Elements.Table (Exceptions);
3035 File_Name := Canonical_Case_File_Name (Element.Value.Value);
3037 Get_Name_String (Element.Index);
3038 To_Lower (Name_Buffer (1 .. Name_Len));
3040 Index := Element.Value.Index;
3042 -- For Ada, check if it is a valid unit name
3044 if Lang = Name_Ada then
3045 Get_Name_String (Element.Index);
3046 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
3048 if Unit = No_Name then
3049 Err_Vars.Error_Msg_Name_1 := Element.Index;
3052 "%% is not a valid unit name.",
3053 Element.Value.Location);
3057 if Unit /= No_Name then
3059 -- Check if the source already exists
3060 -- ??? In Ada_Only mode (Record_Unit), we use a htable for
3063 Source_To_Replace := No_Source;
3064 Iter := For_Each_Source (In_Tree);
3067 Source := Prj.Element (Iter);
3068 exit when Source = No_Source
3069 or else (Source.Unit /= null
3070 and then Source.Unit.Name = Unit
3071 and then Source.Index = Index);
3075 if Source /= No_Source then
3076 if Source.Kind /= Kind then
3079 Source := Prj.Element (Iter);
3081 exit when Source = No_Source
3082 or else (Source.Unit /= null
3083 and then Source.Unit.Name = Unit
3084 and then Source.Index = Index);
3088 if Source /= No_Source then
3089 Other_Project := Source.Project;
3091 if Is_Extending (Project, Other_Project) then
3092 Source_To_Replace := Source;
3093 Source := No_Source;
3096 Error_Msg_Name_1 := Unit;
3097 Error_Msg_Name_2 := Other_Project.Name;
3101 "%% is already a source of project %%",
3102 Element.Value.Location);
3107 if Source = No_Source then
3114 File_Name => File_Name,
3115 Display_File => File_Name_Type (Element.Value.Value),
3118 Naming_Exception => True,
3119 Source_To_Replace => Source_To_Replace);
3123 Exceptions := Element.Next;
3125 end Process_Exceptions_Unit_Based;
3127 ---------------------------
3128 -- Check_Naming_Ada_Only --
3129 ---------------------------
3131 procedure Check_Naming_Ada_Only is
3132 Ada : constant Language_Ptr :=
3133 Get_Language_From_Name (Project, "ada");
3135 Casing_Defined : Boolean;
3136 Sep_Suffix_Loc : Source_Ptr;
3139 -- If no language, then nothing to do
3146 Data : Lang_Naming_Data renames Ada.Config.Naming_Data;
3149 -- The default value of separate suffix should be the same as the
3150 -- body suffix, so we need to compute that first.
3152 Data.Separate_Suffix := Data.Body_Suffix;
3153 Write_Attr ("Body_Suffix", Get_Name_String (Data.Body_Suffix));
3155 -- We'll need the dot replacement below, so compute it now
3158 (Dot_Replacement => Data.Dot_Replacement,
3159 Casing => Data.Casing,
3160 Casing_Defined => Casing_Defined,
3161 Separate_Suffix => Data.Separate_Suffix,
3162 Sep_Suffix_Loc => Sep_Suffix_Loc);
3164 Bodies := Util.Value_Of (Name_Body, Naming.Decl.Arrays, In_Tree);
3166 if Bodies /= No_Array_Element then
3167 Check_And_Normalize_Unit_Names
3168 (Project, In_Tree, Bodies, "Naming.Bodies");
3171 Specs := Util.Value_Of (Name_Spec, Naming.Decl.Arrays, In_Tree);
3173 if Specs /= No_Array_Element then
3174 Check_And_Normalize_Unit_Names
3175 (Project, In_Tree, Specs, "Naming.Specs");
3178 -- Check Spec_Suffix
3180 if Is_Illegal_Suffix (Data.Spec_Suffix, Data.Dot_Replacement) then
3181 Err_Vars.Error_Msg_File_1 := Data.Spec_Suffix;
3184 "{ is illegal for Spec_Suffix",
3185 Ada_Spec_Suffix_Loc);
3188 Write_Attr ("Spec_Suffix", Get_Name_String (Data.Spec_Suffix));
3190 -- Check Body_Suffix
3192 if Is_Illegal_Suffix (Data.Body_Suffix, Data.Dot_Replacement) then
3193 Err_Vars.Error_Msg_File_1 := Data.Body_Suffix;
3196 "{ is illegal for Body_Suffix",
3197 Ada_Body_Suffix_Loc);
3200 -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
3201 -- since that would cause a clear ambiguity. Note that we do allow
3202 -- a Spec_Suffix to have the same termination as one of these,
3203 -- which causes a potential ambiguity, but we resolve that my
3204 -- matching the longest possible suffix.
3206 if Data.Spec_Suffix = Data.Body_Suffix then
3210 & Get_Name_String (Data.Body_Suffix)
3211 & """) cannot be the same as Spec_Suffix.",
3212 Ada_Body_Suffix_Loc);
3215 if Data.Body_Suffix /= Data.Separate_Suffix
3216 and then Data.Spec_Suffix = Data.Separate_Suffix
3220 "Separate_Suffix ("""
3221 & Get_Name_String (Data.Separate_Suffix)
3222 & """) cannot be the same as Spec_Suffix.",
3226 end Check_Naming_Ada_Only;
3228 -----------------------------
3229 -- Check_Naming_Multi_Lang --
3230 -----------------------------
3232 procedure Check_Naming_Multi_Lang is
3233 Dot_Replacement : File_Name_Type := No_File;
3234 Separate_Suffix : File_Name_Type := No_File;
3235 Casing : Casing_Type := All_Lower_Case;
3236 Casing_Defined : Boolean;
3237 Lang_Id : Language_Ptr;
3238 Sep_Suffix_Loc : Source_Ptr;
3239 Suffix : Variable_Value;
3244 (Dot_Replacement => Dot_Replacement,
3246 Casing_Defined => Casing_Defined,
3247 Separate_Suffix => Separate_Suffix,
3248 Sep_Suffix_Loc => Sep_Suffix_Loc);
3250 -- For all unit based languages, if any, set the specified value
3251 -- of Dot_Replacement, Casing and/or Separate_Suffix. Do not
3252 -- systematically overwrite, since the defaults come from the
3253 -- configuration file
3255 if Dot_Replacement /= No_File
3256 or else Casing_Defined
3257 or else Separate_Suffix /= No_File
3259 Lang_Id := Project.Languages;
3260 while Lang_Id /= No_Language_Index loop
3261 if Lang_Id.Config.Kind = Unit_Based then
3262 if Dot_Replacement /= No_File then
3263 Lang_Id.Config.Naming_Data.Dot_Replacement :=
3267 if Casing_Defined then
3268 Lang_Id.Config.Naming_Data.Casing := Casing;
3271 if Separate_Suffix /= No_File then
3272 Lang_Id.Config.Naming_Data.Separate_Suffix :=
3277 Lang_Id := Lang_Id.Next;
3281 -- Next, get the spec and body suffixes
3283 Lang_Id := Project.Languages;
3284 while Lang_Id /= No_Language_Index loop
3285 Lang := Lang_Id.Name;
3291 Attribute_Or_Array_Name => Name_Spec_Suffix,
3292 In_Package => Naming_Id,
3293 In_Tree => In_Tree);
3295 if Suffix = Nil_Variable_Value then
3298 Attribute_Or_Array_Name => Name_Spec_Suffix,
3299 In_Package => Naming_Id,
3300 In_Tree => In_Tree);
3303 if Suffix /= Nil_Variable_Value then
3304 Lang_Id.Config.Naming_Data.Spec_Suffix :=
3305 File_Name_Type (Suffix.Value);
3312 Attribute_Or_Array_Name => Name_Body_Suffix,
3313 In_Package => Naming_Id,
3314 In_Tree => In_Tree);
3316 if Suffix = Nil_Variable_Value then
3319 Attribute_Or_Array_Name => Name_Implementation_Suffix,
3320 In_Package => Naming_Id,
3321 In_Tree => In_Tree);
3324 if Suffix /= Nil_Variable_Value then
3325 Lang_Id.Config.Naming_Data.Body_Suffix :=
3326 File_Name_Type (Suffix.Value);
3329 -- ??? As opposed to what is done in Check_Naming_Ada_Only,
3330 -- we do not check whether spec_suffix=body_suffix, which
3331 -- should be illegal. Best would be to share this code into
3332 -- Check_Common, but we access the attributes from the project
3333 -- files slightly differently apparently.
3335 Lang_Id := Lang_Id.Next;
3338 -- Get the naming exceptions for all languages
3340 for Kind in Spec .. Impl loop
3341 Lang_Id := Project.Languages;
3342 while Lang_Id /= No_Language_Index loop
3343 case Lang_Id.Config.Kind is
3345 Process_Exceptions_File_Based (Lang_Id, Kind);
3348 Process_Exceptions_Unit_Based (Lang_Id, Kind);
3351 Lang_Id := Lang_Id.Next;
3354 end Check_Naming_Multi_Lang;
3356 ----------------------------
3357 -- Initialize_Naming_Data --
3358 ----------------------------
3360 procedure Initialize_Naming_Data is
3361 Specs : Array_Element_Id :=
3366 Impls : Array_Element_Id :=
3371 Lang : Language_Ptr;
3372 Lang_Name : Name_Id;
3373 Value : Variable_Value;
3374 Extended : Project_Id;
3377 -- At this stage, the project already contains the default
3378 -- extensions for the various languages. We now merge those
3379 -- suffixes read in the user project, and they override the
3382 while Specs /= No_Array_Element loop
3383 Lang_Name := In_Tree.Array_Elements.Table (Specs).Index;
3384 Lang := Get_Language_From_Name
3385 (Project, Name => Get_Name_String (Lang_Name));
3387 -- An extending project inherits its parent projects' languages
3388 -- so if needed we should create entries for those languages
3391 Extended := Project.Extends;
3393 while Extended /= null loop
3394 Lang := Get_Language_From_Name
3395 (Extended, Name => Get_Name_String (Lang_Name));
3396 exit when Lang /= null;
3398 Extended := Extended.Extends;
3401 if Lang /= null then
3402 Lang := new Language_Data'(Lang.all);
3403 Lang.First_Source := null;
3404 Lang.Next := Project.Languages;
3405 Project.Languages := Lang;
3409 -- If the language was not found in project or the projects it
3413 if Current_Verbosity = High then
3415 ("Ignoring spec naming data for "
3416 & Get_Name_String (Lang_Name)
3417 & " since language is not defined for this project");
3420 Value := In_Tree.Array_Elements.Table (Specs).Value;
3422 if Lang.Name = Name_Ada then
3423 Ada_Spec_Suffix_Loc := Value.Location;
3426 if Value.Kind = Single then
3427 Lang.Config.Naming_Data.Spec_Suffix :=
3428 Canonical_Case_File_Name (Value.Value);
3432 Specs := In_Tree.Array_Elements.Table (Specs).Next;
3435 while Impls /= No_Array_Element loop
3436 Lang_Name := In_Tree.Array_Elements.Table (Impls).Index;
3437 Lang := Get_Language_From_Name
3438 (Project, Name => Get_Name_String (Lang_Name));
3441 if Current_Verbosity = High then
3443 ("Ignoring impl naming data for "
3444 & Get_Name_String (Lang_Name)
3445 & " since language is not defined for this project");
3448 Value := In_Tree.Array_Elements.Table (Impls).Value;
3450 if Lang.Name = Name_Ada then
3451 Ada_Body_Suffix_Loc := Value.Location;
3454 if Value.Kind = Single then
3455 Lang.Config.Naming_Data.Body_Suffix :=
3456 Canonical_Case_File_Name (Value.Value);
3460 Impls := In_Tree.Array_Elements.Table (Impls).Next;
3462 end Initialize_Naming_Data;
3464 -- Start of processing for Check_Naming_Schemes
3467 Specs := No_Array_Element;
3468 Bodies := No_Array_Element;
3470 -- No Naming package or parsing a configuration file? nothing to do
3472 if Naming_Id /= No_Package and not Is_Config_File then
3473 Naming := In_Tree.Packages.Table (Naming_Id);
3475 if Current_Verbosity = High then
3476 Write_Line ("Checking package Naming for project "
3477 & Get_Name_String (Project.Name));
3480 Initialize_Naming_Data;
3484 Check_Naming_Ada_Only;
3485 when Multi_Language =>
3486 Check_Naming_Multi_Lang;
3489 end Check_Package_Naming;
3491 ------------------------------
3492 -- Check_Library_Attributes --
3493 ------------------------------
3495 procedure Check_Library_Attributes
3496 (Project : Project_Id;
3497 In_Tree : Project_Tree_Ref)
3499 Attributes : constant Prj.Variable_Id := Project.Decl.Attributes;
3501 Lib_Dir : constant Prj.Variable_Value :=
3503 (Snames.Name_Library_Dir, Attributes, In_Tree);
3505 Lib_Name : constant Prj.Variable_Value :=
3507 (Snames.Name_Library_Name, Attributes, In_Tree);
3509 Lib_Version : constant Prj.Variable_Value :=
3511 (Snames.Name_Library_Version, Attributes, In_Tree);
3513 Lib_ALI_Dir : constant Prj.Variable_Value :=
3515 (Snames.Name_Library_Ali_Dir, Attributes, In_Tree);
3517 Lib_GCC : constant Prj.Variable_Value :=
3519 (Snames.Name_Library_GCC, Attributes, In_Tree);
3521 The_Lib_Kind : constant Prj.Variable_Value :=
3523 (Snames.Name_Library_Kind, Attributes, In_Tree);
3525 Imported_Project_List : Project_List;
3527 Continuation : String_Access := No_Continuation_String'Access;
3529 Support_For_Libraries : Library_Support;
3531 Library_Directory_Present : Boolean;
3533 procedure Check_Library (Proj : Project_Id; Extends : Boolean);
3534 -- Check if an imported or extended project if also a library project
3540 procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
3542 Iter : Source_Iterator;
3545 if Proj /= No_Project then
3546 if not Proj.Library then
3548 -- The only not library projects that are OK are those that
3549 -- have no sources. However, header files from non-Ada
3550 -- languages are OK, as there is nothing to compile.
3552 Iter := For_Each_Source (In_Tree, Proj);
3554 Src_Id := Prj.Element (Iter);
3555 exit when Src_Id = No_Source
3556 or else Src_Id.Language.Config.Kind /= File_Based
3557 or else Src_Id.Kind /= Spec;
3561 if Src_Id /= No_Source then
3562 Error_Msg_Name_1 := Project.Name;
3563 Error_Msg_Name_2 := Proj.Name;
3566 if Project.Library_Kind /= Static then
3570 "shared library project %% cannot extend " &
3571 "project %% that is not a library project",
3573 Continuation := Continuation_String'Access;
3576 elsif (not Unchecked_Shared_Lib_Imports)
3577 and then Project.Library_Kind /= Static
3582 "shared library project %% cannot import project %% " &
3583 "that is not a shared library project",
3585 Continuation := Continuation_String'Access;
3589 elsif Project.Library_Kind /= Static and then
3590 Proj.Library_Kind = Static
3592 Error_Msg_Name_1 := Project.Name;
3593 Error_Msg_Name_2 := Proj.Name;
3599 "shared library project %% cannot extend static " &
3600 "library project %%",
3602 Continuation := Continuation_String'Access;
3604 elsif not Unchecked_Shared_Lib_Imports then
3608 "shared library project %% cannot import static " &
3609 "library project %%",
3611 Continuation := Continuation_String'Access;
3618 Dir_Exists : Boolean;
3620 -- Start of processing for Check_Library_Attributes
3623 Library_Directory_Present := Lib_Dir.Value /= Empty_String;
3625 -- Special case of extending project
3627 if Project.Extends /= No_Project then
3629 -- If the project extended is a library project, we inherit the
3630 -- library name, if it is not redefined; we check that the library
3631 -- directory is specified.
3633 if Project.Extends.Library then
3634 if Project.Qualifier = Standard then
3637 "a standard project cannot extend a library project",
3641 if Lib_Name.Default then
3642 Project.Library_Name := Project.Extends.Library_Name;
3645 if Lib_Dir.Default then
3646 if not Project.Virtual then
3649 "a project extending a library project must " &
3650 "specify an attribute Library_Dir",
3654 -- For a virtual project extending a library project,
3655 -- inherit library directory.
3657 Project.Library_Dir := Project.Extends.Library_Dir;
3658 Library_Directory_Present := True;
3665 pragma Assert (Lib_Name.Kind = Single);
3667 if Lib_Name.Value = Empty_String then
3668 if Current_Verbosity = High
3669 and then Project.Library_Name = No_Name
3671 Write_Line ("No library name");
3675 -- There is no restriction on the syntax of library names
3677 Project.Library_Name := Lib_Name.Value;
3680 if Project.Library_Name /= No_Name then
3681 if Current_Verbosity = High then
3683 ("Library name", Get_Name_String (Project.Library_Name));
3686 pragma Assert (Lib_Dir.Kind = Single);
3688 if not Library_Directory_Present then
3689 if Current_Verbosity = High then
3690 Write_Line ("No library directory");
3694 -- Find path name (unless inherited), check that it is a directory
3696 if Project.Library_Dir = No_Path_Information then
3700 File_Name_Type (Lib_Dir.Value),
3701 Path => Project.Library_Dir,
3702 Dir_Exists => Dir_Exists,
3703 Create => "library",
3704 Must_Exist => False,
3705 Location => Lib_Dir.Location,
3706 Externally_Built => Project.Externally_Built);
3712 (Project.Library_Dir.Display_Name));
3715 if not Dir_Exists then
3716 -- Get the absolute name of the library directory that
3717 -- does not exist, to report an error.
3719 Err_Vars.Error_Msg_File_1 :=
3720 File_Name_Type (Project.Library_Dir.Display_Name);
3723 "library directory { does not exist",
3726 -- The library directory cannot be the same as the Object
3729 elsif Project.Library_Dir.Name = Project.Object_Directory.Name then
3732 "library directory cannot be the same " &
3733 "as object directory",
3735 Project.Library_Dir := No_Path_Information;
3739 OK : Boolean := True;
3740 Dirs_Id : String_List_Id;
3741 Dir_Elem : String_Element;
3745 -- The library directory cannot be the same as a source
3746 -- directory of the current project.
3748 Dirs_Id := Project.Source_Dirs;
3749 while Dirs_Id /= Nil_String loop
3750 Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
3751 Dirs_Id := Dir_Elem.Next;
3753 if Project.Library_Dir.Name =
3754 Path_Name_Type (Dir_Elem.Value)
3756 Err_Vars.Error_Msg_File_1 :=
3757 File_Name_Type (Dir_Elem.Value);
3760 "library directory cannot be the same " &
3761 "as source directory {",
3770 -- The library directory cannot be the same as a source
3771 -- directory of another project either.
3773 Pid := In_Tree.Projects;
3775 exit Project_Loop when Pid = null;
3777 if Pid.Project /= Project then
3778 Dirs_Id := Pid.Project.Source_Dirs;
3780 Dir_Loop : while Dirs_Id /= Nil_String loop
3782 In_Tree.String_Elements.Table (Dirs_Id);
3783 Dirs_Id := Dir_Elem.Next;
3785 if Project.Library_Dir.Name =
3786 Path_Name_Type (Dir_Elem.Value)
3788 Err_Vars.Error_Msg_File_1 :=
3789 File_Name_Type (Dir_Elem.Value);
3790 Err_Vars.Error_Msg_Name_1 := Pid.Project.Name;
3794 "library directory cannot be the same " &
3795 "as source directory { of project %%",
3804 end loop Project_Loop;
3808 Project.Library_Dir := No_Path_Information;
3810 elsif Current_Verbosity = High then
3812 -- Display the Library directory in high verbosity
3815 ("Library directory",
3816 Get_Name_String (Project.Library_Dir.Display_Name));
3825 Project.Library_Dir /= No_Path_Information
3826 and then Project.Library_Name /= No_Name;
3828 if Project.Extends = No_Project then
3829 case Project.Qualifier is
3831 if Project.Library then
3834 "a standard project cannot be a library project",
3839 if not Project.Library then
3840 if Project.Library_Dir = No_Path_Information then
3843 "\attribute Library_Dir not declared",
3847 if Project.Library_Name = No_Name then
3850 "\attribute Library_Name not declared",
3861 if Project.Library then
3862 if Get_Mode = Multi_Language then
3863 Support_For_Libraries := Project.Config.Lib_Support;
3866 Support_For_Libraries := MLib.Tgt.Support_For_Libraries;
3869 if Support_For_Libraries = Prj.None then
3872 "?libraries are not supported on this platform",
3874 Project.Library := False;
3877 if Lib_ALI_Dir.Value = Empty_String then
3878 if Current_Verbosity = High then
3879 Write_Line ("No library ALI directory specified");
3882 Project.Library_ALI_Dir := Project.Library_Dir;
3885 -- Find path name, check that it is a directory
3890 File_Name_Type (Lib_ALI_Dir.Value),
3891 Path => Project.Library_ALI_Dir,
3892 Create => "library ALI",
3893 Dir_Exists => Dir_Exists,
3894 Must_Exist => False,
3895 Location => Lib_ALI_Dir.Location,
3896 Externally_Built => Project.Externally_Built);
3898 if not Dir_Exists then
3899 -- Get the absolute name of the library ALI directory that
3900 -- does not exist, to report an error.
3902 Err_Vars.Error_Msg_File_1 :=
3903 File_Name_Type (Project.Library_ALI_Dir.Display_Name);
3906 "library 'A'L'I directory { does not exist",
3907 Lib_ALI_Dir.Location);
3910 if Project.Library_ALI_Dir /= Project.Library_Dir then
3912 -- The library ALI directory cannot be the same as the
3913 -- Object directory.
3915 if Project.Library_ALI_Dir = Project.Object_Directory then
3918 "library 'A'L'I directory cannot be the same " &
3919 "as object directory",
3920 Lib_ALI_Dir.Location);
3921 Project.Library_ALI_Dir := No_Path_Information;
3925 OK : Boolean := True;
3926 Dirs_Id : String_List_Id;
3927 Dir_Elem : String_Element;
3931 -- The library ALI directory cannot be the same as
3932 -- a source directory of the current project.
3934 Dirs_Id := Project.Source_Dirs;
3935 while Dirs_Id /= Nil_String loop
3936 Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
3937 Dirs_Id := Dir_Elem.Next;
3939 if Project.Library_ALI_Dir.Name =
3940 Path_Name_Type (Dir_Elem.Value)
3942 Err_Vars.Error_Msg_File_1 :=
3943 File_Name_Type (Dir_Elem.Value);
3946 "library 'A'L'I directory cannot be " &
3947 "the same as source directory {",
3948 Lib_ALI_Dir.Location);
3956 -- The library ALI directory cannot be the same as
3957 -- a source directory of another project either.
3959 Pid := In_Tree.Projects;
3960 ALI_Project_Loop : loop
3961 exit ALI_Project_Loop when Pid = null;
3963 if Pid.Project /= Project then
3964 Dirs_Id := Pid.Project.Source_Dirs;
3967 while Dirs_Id /= Nil_String loop
3969 In_Tree.String_Elements.Table (Dirs_Id);
3970 Dirs_Id := Dir_Elem.Next;
3972 if Project.Library_ALI_Dir.Name =
3973 Path_Name_Type (Dir_Elem.Value)
3975 Err_Vars.Error_Msg_File_1 :=
3976 File_Name_Type (Dir_Elem.Value);
3977 Err_Vars.Error_Msg_Name_1 :=
3982 "library 'A'L'I directory cannot " &
3983 "be the same as source directory " &
3985 Lib_ALI_Dir.Location);
3987 exit ALI_Project_Loop;
3989 end loop ALI_Dir_Loop;
3992 end loop ALI_Project_Loop;
3996 Project.Library_ALI_Dir := No_Path_Information;
3998 elsif Current_Verbosity = High then
4000 -- Display the Library ALI directory in high
4006 (Project.Library_ALI_Dir.Display_Name));
4013 pragma Assert (Lib_Version.Kind = Single);
4015 if Lib_Version.Value = Empty_String then
4016 if Current_Verbosity = High then
4017 Write_Line ("No library version specified");
4021 Project.Lib_Internal_Name := Lib_Version.Value;
4024 pragma Assert (The_Lib_Kind.Kind = Single);
4026 if The_Lib_Kind.Value = Empty_String then
4027 if Current_Verbosity = High then
4028 Write_Line ("No library kind specified");
4032 Get_Name_String (The_Lib_Kind.Value);
4035 Kind_Name : constant String :=
4036 To_Lower (Name_Buffer (1 .. Name_Len));
4038 OK : Boolean := True;
4041 if Kind_Name = "static" then
4042 Project.Library_Kind := Static;
4044 elsif Kind_Name = "dynamic" then
4045 Project.Library_Kind := Dynamic;
4047 elsif Kind_Name = "relocatable" then
4048 Project.Library_Kind := Relocatable;
4053 "illegal value for Library_Kind",
4054 The_Lib_Kind.Location);
4058 if Current_Verbosity = High and then OK then
4059 Write_Attr ("Library kind", Kind_Name);
4062 if Project.Library_Kind /= Static then
4063 if Support_For_Libraries = Prj.Static_Only then
4066 "only static libraries are supported " &
4068 The_Lib_Kind.Location);
4069 Project.Library := False;
4072 -- Check if (obsolescent) attribute Library_GCC or
4073 -- Linker'Driver is declared.
4075 if Lib_GCC.Value /= Empty_String then
4079 "?Library_'G'C'C is an obsolescent attribute, " &
4080 "use Linker''Driver instead",
4082 Project.Config.Shared_Lib_Driver :=
4083 File_Name_Type (Lib_GCC.Value);
4087 Linker : constant Package_Id :=
4090 Project.Decl.Packages,
4092 Driver : constant Variable_Value :=
4095 Attribute_Or_Array_Name =>
4097 In_Package => Linker,
4102 if Driver /= Nil_Variable_Value
4103 and then Driver.Value /= Empty_String
4105 Project.Config.Shared_Lib_Driver :=
4106 File_Name_Type (Driver.Value);
4115 if Project.Library then
4116 if Current_Verbosity = High then
4117 Write_Line ("This is a library project file");
4120 if Get_Mode = Multi_Language then
4121 Check_Library (Project.Extends, Extends => True);
4123 Imported_Project_List := Project.Imported_Projects;
4124 while Imported_Project_List /= null loop
4126 (Imported_Project_List.Project,
4128 Imported_Project_List := Imported_Project_List.Next;
4136 -- Check if Linker'Switches or Linker'Default_Switches are declared.
4137 -- Warn if they are declared, as it is a common error to think that
4138 -- library are "linked" with Linker switches.
4140 if Project.Library then
4142 Linker_Package_Id : constant Package_Id :=
4145 Project.Decl.Packages, In_Tree);
4146 Linker_Package : Package_Element;
4147 Switches : Array_Element_Id := No_Array_Element;
4150 if Linker_Package_Id /= No_Package then
4151 Linker_Package := In_Tree.Packages.Table (Linker_Package_Id);
4155 (Name => Name_Switches,
4156 In_Arrays => Linker_Package.Decl.Arrays,
4157 In_Tree => In_Tree);
4159 if Switches = No_Array_Element then
4162 (Name => Name_Default_Switches,
4163 In_Arrays => Linker_Package.Decl.Arrays,
4164 In_Tree => In_Tree);
4167 if Switches /= No_Array_Element then
4170 "?Linker switches not taken into account in library " &
4178 if Project.Extends /= No_Project then
4179 Project.Extends.Library := False;
4181 end Check_Library_Attributes;
4183 ---------------------------------
4184 -- Check_Programming_Languages --
4185 ---------------------------------
4187 procedure Check_Programming_Languages
4188 (In_Tree : Project_Tree_Ref;
4189 Project : Project_Id)
4191 Languages : Variable_Value := Nil_Variable_Value;
4192 Def_Lang : Variable_Value := Nil_Variable_Value;
4193 Def_Lang_Id : Name_Id;
4195 procedure Add_Language (Name, Display_Name : Name_Id);
4196 -- Add a new language to the list of languages for the project.
4197 -- Nothing is done if the language has already been defined
4199 procedure Add_Language (Name, Display_Name : Name_Id) is
4200 Lang : Language_Ptr := Project.Languages;
4202 while Lang /= No_Language_Index loop
4203 if Name = Lang.Name then
4210 Lang := new Language_Data'(No_Language_Data);
4211 Lang.Next := Project.Languages;
4212 Project.Languages := Lang;
4214 Lang.Display_Name := Display_Name;
4216 if Name = Name_Ada then
4217 Lang.Config.Kind := Unit_Based;
4218 Lang.Config.Dependency_Kind := ALI_File;
4220 if Get_Mode = Ada_Only then
4221 -- Create a default config for Ada (since there is no
4222 -- configuration file to create it for us)
4223 -- ??? We should do as GPS does and create a dummy config
4226 Lang.Config.Naming_Data :=
4227 (Dot_Replacement => File_Name_Type
4228 (First_Name_Id + Character'Pos ('-')),
4229 Casing => All_Lower_Case,
4230 Separate_Suffix => Default_Ada_Body_Suffix,
4231 Spec_Suffix => Default_Ada_Spec_Suffix,
4232 Body_Suffix => Default_Ada_Body_Suffix);
4236 Lang.Config.Kind := File_Based;
4240 -- Start of processing for Check_Programming_Languages
4243 Project.Languages := null;
4245 Prj.Util.Value_Of (Name_Languages, Project.Decl.Attributes, In_Tree);
4248 (Name_Default_Language, Project.Decl.Attributes, In_Tree);
4250 -- Shouldn't these be set to False by default, and only set to True when
4251 -- we actually find some source file???
4253 if Project.Source_Dirs /= Nil_String then
4255 -- Check if languages are specified in this project
4257 if Languages.Default then
4259 -- In Ada_Only mode, the default language is Ada
4261 if Get_Mode = Ada_Only then
4262 Def_Lang_Id := Name_Ada;
4265 -- Fail if there is no default language defined
4267 if Def_Lang.Default then
4268 if not Default_Language_Is_Ada then
4272 "no languages defined for this project",
4274 Def_Lang_Id := No_Name;
4277 Def_Lang_Id := Name_Ada;
4281 Get_Name_String (Def_Lang.Value);
4282 To_Lower (Name_Buffer (1 .. Name_Len));
4283 Def_Lang_Id := Name_Find;
4287 if Def_Lang_Id /= No_Name then
4288 Get_Name_String (Def_Lang_Id);
4289 Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
4291 (Name => Def_Lang_Id,
4292 Display_Name => Name_Find);
4297 Current : String_List_Id := Languages.Values;
4298 Element : String_Element;
4301 -- If there are no languages declared, there are no sources
4303 if Current = Nil_String then
4304 Project.Source_Dirs := Nil_String;
4306 if Project.Qualifier = Standard then
4310 "a standard project must have at least one language",
4311 Languages.Location);
4315 -- Look through all the languages specified in attribute
4318 while Current /= Nil_String loop
4319 Element := In_Tree.String_Elements.Table (Current);
4320 Get_Name_String (Element.Value);
4321 To_Lower (Name_Buffer (1 .. Name_Len));
4325 Display_Name => Element.Value);
4327 Current := Element.Next;
4333 end Check_Programming_Languages;
4339 function Check_Project
4341 Root_Project : Project_Id;
4342 Extending : Boolean) return Boolean
4347 if P = Root_Project then
4350 elsif Extending then
4351 Prj := Root_Project;
4352 while Prj.Extends /= No_Project loop
4353 if P = Prj.Extends then
4364 -------------------------------
4365 -- Check_Stand_Alone_Library --
4366 -------------------------------
4368 procedure Check_Stand_Alone_Library
4369 (Project : Project_Id;
4370 In_Tree : Project_Tree_Ref;
4371 Current_Dir : String;
4372 Extending : Boolean)
4374 Lib_Interfaces : constant Prj.Variable_Value :=
4376 (Snames.Name_Library_Interface,
4377 Project.Decl.Attributes,
4380 Lib_Auto_Init : constant Prj.Variable_Value :=
4382 (Snames.Name_Library_Auto_Init,
4383 Project.Decl.Attributes,
4386 Lib_Src_Dir : constant Prj.Variable_Value :=
4388 (Snames.Name_Library_Src_Dir,
4389 Project.Decl.Attributes,
4392 Lib_Symbol_File : constant Prj.Variable_Value :=
4394 (Snames.Name_Library_Symbol_File,
4395 Project.Decl.Attributes,
4398 Lib_Symbol_Policy : constant Prj.Variable_Value :=
4400 (Snames.Name_Library_Symbol_Policy,
4401 Project.Decl.Attributes,
4404 Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
4406 (Snames.Name_Library_Reference_Symbol_File,
4407 Project.Decl.Attributes,
4410 Auto_Init_Supported : Boolean;
4411 OK : Boolean := True;
4413 Next_Proj : Project_Id;
4414 Iter : Source_Iterator;
4417 if Get_Mode = Multi_Language then
4418 Auto_Init_Supported := Project.Config.Auto_Init_Supported;
4420 Auto_Init_Supported :=
4421 MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported;
4424 pragma Assert (Lib_Interfaces.Kind = List);
4426 -- It is a stand-alone library project file if attribute
4427 -- Library_Interface is defined.
4429 if not Lib_Interfaces.Default then
4430 SAL_Library : declare
4431 Interfaces : String_List_Id := Lib_Interfaces.Values;
4432 Interface_ALIs : String_List_Id := Nil_String;
4436 procedure Add_ALI_For (Source : File_Name_Type);
4437 -- Add an ALI file name to the list of Interface ALIs
4443 procedure Add_ALI_For (Source : File_Name_Type) is
4445 Get_Name_String (Source);
4448 ALI : constant String :=
4449 ALI_File_Name (Name_Buffer (1 .. Name_Len));
4450 ALI_Name_Id : Name_Id;
4453 Name_Len := ALI'Length;
4454 Name_Buffer (1 .. Name_Len) := ALI;
4455 ALI_Name_Id := Name_Find;
4457 String_Element_Table.Increment_Last
4458 (In_Tree.String_Elements);
4459 In_Tree.String_Elements.Table
4460 (String_Element_Table.Last
4461 (In_Tree.String_Elements)) :=
4462 (Value => ALI_Name_Id,
4464 Display_Value => ALI_Name_Id,
4466 In_Tree.String_Elements.Table
4467 (Interfaces).Location,
4469 Next => Interface_ALIs);
4470 Interface_ALIs := String_Element_Table.Last
4471 (In_Tree.String_Elements);
4475 -- Start of processing for SAL_Library
4478 Project.Standalone_Library := True;
4480 -- Library_Interface cannot be an empty list
4482 if Interfaces = Nil_String then
4485 "Library_Interface cannot be an empty list",
4486 Lib_Interfaces.Location);
4489 -- Process each unit name specified in the attribute
4490 -- Library_Interface.
4492 while Interfaces /= Nil_String loop
4494 (In_Tree.String_Elements.Table (Interfaces).Value);
4495 To_Lower (Name_Buffer (1 .. Name_Len));
4497 if Name_Len = 0 then
4500 "an interface cannot be an empty string",
4501 In_Tree.String_Elements.Table (Interfaces).Location);
4505 Error_Msg_Name_1 := Unit;
4507 if Get_Mode = Ada_Only then
4508 UData := Units_Htable.Get (In_Tree.Units_HT, Unit);
4510 if UData = No_Unit_Index then
4514 In_Tree.String_Elements.Table
4515 (Interfaces).Location);
4518 -- Check that the unit is part of the project
4520 if UData.File_Names (Impl) /= null
4521 and then not UData.File_Names (Impl).Locally_Removed
4524 (UData.File_Names (Impl).Project,
4527 -- There is a body for this unit. If there is
4528 -- no spec, we need to check that it is not a
4531 if UData.File_Names (Spec) = null then
4533 Src_Ind : Source_File_Index;
4537 Sinput.P.Load_Project_File
4538 (Get_Name_String (UData.File_Names
4541 if Sinput.P.Source_File_Is_Subunit
4546 "%% is a subunit; " &
4547 "it cannot be an interface",
4549 String_Elements.Table
4550 (Interfaces).Location);
4555 -- The unit is not a subunit, so we add the
4556 -- ALI file for its body to the Interface ALIs.
4559 (UData.File_Names (Impl).File);
4564 "%% is not an unit of this project",
4565 In_Tree.String_Elements.Table
4566 (Interfaces).Location);
4569 elsif UData.File_Names (Spec) /= null
4570 and then not UData.File_Names (Spec).Locally_Removed
4571 and then Check_Project
4572 (UData.File_Names (Spec).Project,
4576 -- The unit is part of the project, it has a spec,
4577 -- but no body. We add the ALI for its spec to the
4581 (UData.File_Names (Spec).File);
4586 "%% is not an unit of this project",
4587 In_Tree.String_Elements.Table
4588 (Interfaces).Location);
4593 -- Multi_Language mode
4595 Next_Proj := Project.Extends;
4596 Iter := For_Each_Source (In_Tree, Project);
4598 while Prj.Element (Iter) /= No_Source
4600 (Prj.Element (Iter).Unit = null
4601 or else Prj.Element (Iter).Unit.Name /= Unit)
4606 Source := Prj.Element (Iter);
4607 exit when Source /= No_Source
4608 or else Next_Proj = No_Project;
4610 Iter := For_Each_Source (In_Tree, Next_Proj);
4611 Next_Proj := Next_Proj.Extends;
4614 if Source /= No_Source then
4615 if Source.Kind = Sep then
4616 Source := No_Source;
4617 elsif Source.Kind = Spec
4618 and then Other_Part (Source) /= No_Source
4620 Source := Other_Part (Source);
4624 if Source /= No_Source then
4625 if Source.Project /= Project
4626 and then not Is_Extending (Project, Source.Project)
4628 Source := No_Source;
4632 if Source = No_Source then
4635 "%% is not an unit of this project",
4636 In_Tree.String_Elements.Table
4637 (Interfaces).Location);
4640 if Source.Kind = Spec
4641 and then Other_Part (Source) /= No_Source
4643 Source := Other_Part (Source);
4646 String_Element_Table.Increment_Last
4647 (In_Tree.String_Elements);
4649 In_Tree.String_Elements.Table
4650 (String_Element_Table.Last
4651 (In_Tree.String_Elements)) :=
4652 (Value => Name_Id (Source.Dep_Name),
4654 Display_Value => Name_Id (Source.Dep_Name),
4656 In_Tree.String_Elements.Table
4657 (Interfaces).Location,
4659 Next => Interface_ALIs);
4662 String_Element_Table.Last (In_Tree.String_Elements);
4670 In_Tree.String_Elements.Table (Interfaces).Next;
4673 -- Put the list of Interface ALIs in the project data
4675 Project.Lib_Interface_ALIs := Interface_ALIs;
4677 -- Check value of attribute Library_Auto_Init and set
4678 -- Lib_Auto_Init accordingly.
4680 if Lib_Auto_Init.Default then
4682 -- If no attribute Library_Auto_Init is declared, then set auto
4683 -- init only if it is supported.
4685 Project.Lib_Auto_Init := Auto_Init_Supported;
4688 Get_Name_String (Lib_Auto_Init.Value);
4689 To_Lower (Name_Buffer (1 .. Name_Len));
4691 if Name_Buffer (1 .. Name_Len) = "false" then
4692 Project.Lib_Auto_Init := False;
4694 elsif Name_Buffer (1 .. Name_Len) = "true" then
4695 if Auto_Init_Supported then
4696 Project.Lib_Auto_Init := True;
4699 -- Library_Auto_Init cannot be "true" if auto init is not
4704 "library auto init not supported " &
4706 Lib_Auto_Init.Location);
4712 "invalid value for attribute Library_Auto_Init",
4713 Lib_Auto_Init.Location);
4718 -- If attribute Library_Src_Dir is defined and not the empty string,
4719 -- check if the directory exist and is not the object directory or
4720 -- one of the source directories. This is the directory where copies
4721 -- of the interface sources will be copied. Note that this directory
4722 -- may be the library directory.
4724 if Lib_Src_Dir.Value /= Empty_String then
4726 Dir_Id : constant File_Name_Type :=
4727 File_Name_Type (Lib_Src_Dir.Value);
4728 Dir_Exists : Boolean;
4735 Path => Project.Library_Src_Dir,
4736 Dir_Exists => Dir_Exists,
4737 Must_Exist => False,
4738 Create => "library source copy",
4739 Location => Lib_Src_Dir.Location,
4740 Externally_Built => Project.Externally_Built);
4742 -- If directory does not exist, report an error
4744 if not Dir_Exists then
4745 -- Get the absolute name of the library directory that does
4746 -- not exist, to report an error.
4748 Err_Vars.Error_Msg_File_1 :=
4749 File_Name_Type (Project.Library_Src_Dir.Display_Name);
4752 "Directory { does not exist",
4753 Lib_Src_Dir.Location);
4755 -- Report error if it is the same as the object directory
4757 elsif Project.Library_Src_Dir = Project.Object_Directory then
4760 "directory to copy interfaces cannot be " &
4761 "the object directory",
4762 Lib_Src_Dir.Location);
4763 Project.Library_Src_Dir := No_Path_Information;
4767 Src_Dirs : String_List_Id;
4768 Src_Dir : String_Element;
4772 -- Interface copy directory cannot be one of the source
4773 -- directory of the current project.
4775 Src_Dirs := Project.Source_Dirs;
4776 while Src_Dirs /= Nil_String loop
4777 Src_Dir := In_Tree.String_Elements.Table (Src_Dirs);
4779 -- Report error if it is one of the source directories
4781 if Project.Library_Src_Dir.Name =
4782 Path_Name_Type (Src_Dir.Value)
4786 "directory to copy interfaces cannot " &
4787 "be one of the source directories",
4788 Lib_Src_Dir.Location);
4789 Project.Library_Src_Dir := No_Path_Information;
4793 Src_Dirs := Src_Dir.Next;
4796 if Project.Library_Src_Dir /= No_Path_Information then
4798 -- It cannot be a source directory of any other
4801 Pid := In_Tree.Projects;
4803 exit Project_Loop when Pid = null;
4805 Src_Dirs := Pid.Project.Source_Dirs;
4806 Dir_Loop : while Src_Dirs /= Nil_String loop
4808 In_Tree.String_Elements.Table (Src_Dirs);
4810 -- Report error if it is one of the source
4813 if Project.Library_Src_Dir.Name =
4814 Path_Name_Type (Src_Dir.Value)
4817 File_Name_Type (Src_Dir.Value);
4818 Error_Msg_Name_1 := Pid.Project.Name;
4821 "directory to copy interfaces cannot " &
4822 "be the same as source directory { of " &
4824 Lib_Src_Dir.Location);
4825 Project.Library_Src_Dir :=
4826 No_Path_Information;
4830 Src_Dirs := Src_Dir.Next;
4834 end loop Project_Loop;
4838 -- In high verbosity, if there is a valid Library_Src_Dir,
4839 -- display its path name.
4841 if Project.Library_Src_Dir /= No_Path_Information
4842 and then Current_Verbosity = High
4845 ("Directory to copy interfaces",
4846 Get_Name_String (Project.Library_Src_Dir.Name));
4852 -- Check the symbol related attributes
4854 -- First, the symbol policy
4856 if not Lib_Symbol_Policy.Default then
4858 Value : constant String :=
4860 (Get_Name_String (Lib_Symbol_Policy.Value));
4863 -- Symbol policy must hove one of a limited number of values
4865 if Value = "autonomous" or else Value = "default" then
4866 Project.Symbol_Data.Symbol_Policy := Autonomous;
4868 elsif Value = "compliant" then
4869 Project.Symbol_Data.Symbol_Policy := Compliant;
4871 elsif Value = "controlled" then
4872 Project.Symbol_Data.Symbol_Policy := Controlled;
4874 elsif Value = "restricted" then
4875 Project.Symbol_Data.Symbol_Policy := Restricted;
4877 elsif Value = "direct" then
4878 Project.Symbol_Data.Symbol_Policy := Direct;
4883 "illegal value for Library_Symbol_Policy",
4884 Lib_Symbol_Policy.Location);
4889 -- If attribute Library_Symbol_File is not specified, symbol policy
4890 -- cannot be Restricted.
4892 if Lib_Symbol_File.Default then
4893 if Project.Symbol_Data.Symbol_Policy = Restricted then
4896 "Library_Symbol_File needs to be defined when " &
4897 "symbol policy is Restricted",
4898 Lib_Symbol_Policy.Location);
4902 -- Library_Symbol_File is defined
4904 Project.Symbol_Data.Symbol_File :=
4905 Path_Name_Type (Lib_Symbol_File.Value);
4907 Get_Name_String (Lib_Symbol_File.Value);
4909 if Name_Len = 0 then
4912 "symbol file name cannot be an empty string",
4913 Lib_Symbol_File.Location);
4916 OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
4919 for J in 1 .. Name_Len loop
4920 if Name_Buffer (J) = '/'
4921 or else Name_Buffer (J) = Directory_Separator
4930 Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
4933 "symbol file name { is illegal. " &
4934 "Name cannot include directory info.",
4935 Lib_Symbol_File.Location);
4940 -- If attribute Library_Reference_Symbol_File is not defined,
4941 -- symbol policy cannot be Compliant or Controlled.
4943 if Lib_Ref_Symbol_File.Default then
4944 if Project.Symbol_Data.Symbol_Policy = Compliant
4945 or else Project.Symbol_Data.Symbol_Policy = Controlled
4949 "a reference symbol file needs to be defined",
4950 Lib_Symbol_Policy.Location);
4954 -- Library_Reference_Symbol_File is defined, check file exists
4956 Project.Symbol_Data.Reference :=
4957 Path_Name_Type (Lib_Ref_Symbol_File.Value);
4959 Get_Name_String (Lib_Ref_Symbol_File.Value);
4961 if Name_Len = 0 then
4964 "reference symbol file name cannot be an empty string",
4965 Lib_Symbol_File.Location);
4968 if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
4970 Add_Str_To_Name_Buffer
4971 (Get_Name_String (Project.Directory.Name));
4972 Add_Char_To_Name_Buffer (Directory_Separator);
4973 Add_Str_To_Name_Buffer
4974 (Get_Name_String (Lib_Ref_Symbol_File.Value));
4975 Project.Symbol_Data.Reference := Name_Find;
4978 if not Is_Regular_File
4979 (Get_Name_String (Project.Symbol_Data.Reference))
4982 File_Name_Type (Lib_Ref_Symbol_File.Value);
4984 -- For controlled and direct symbol policies, it is an error
4985 -- if the reference symbol file does not exist. For other
4986 -- symbol policies, this is just a warning
4989 Project.Symbol_Data.Symbol_Policy /= Controlled
4990 and then Project.Symbol_Data.Symbol_Policy /= Direct;
4994 "<library reference symbol file { does not exist",
4995 Lib_Ref_Symbol_File.Location);
4997 -- In addition in the non-controlled case, if symbol policy
4998 -- is Compliant, it is changed to Autonomous, because there
4999 -- is no reference to check against, and we don't want to
5000 -- fail in this case.
5002 if Project.Symbol_Data.Symbol_Policy /= Controlled then
5003 if Project.Symbol_Data.Symbol_Policy = Compliant then
5004 Project.Symbol_Data.Symbol_Policy := Autonomous;
5009 -- If both the reference symbol file and the symbol file are
5010 -- defined, then check that they are not the same file.
5012 if Project.Symbol_Data.Symbol_File /= No_Path then
5013 Get_Name_String (Project.Symbol_Data.Symbol_File);
5015 if Name_Len > 0 then
5017 Symb_Path : constant String :=
5020 (Project.Object_Directory.Name) &
5021 Directory_Separator &
5022 Name_Buffer (1 .. Name_Len),
5023 Directory => Current_Dir,
5025 Opt.Follow_Links_For_Files);
5026 Ref_Path : constant String :=
5029 (Project.Symbol_Data.Reference),
5030 Directory => Current_Dir,
5032 Opt.Follow_Links_For_Files);
5034 if Symb_Path = Ref_Path then
5037 "library reference symbol file and library" &
5038 " symbol file cannot be the same file",
5039 Lib_Ref_Symbol_File.Location);
5047 end Check_Stand_Alone_Library;
5049 ----------------------------
5050 -- Compute_Directory_Last --
5051 ----------------------------
5053 function Compute_Directory_Last (Dir : String) return Natural is
5056 and then (Dir (Dir'Last - 1) = Directory_Separator
5057 or else Dir (Dir'Last - 1) = '/')
5059 return Dir'Last - 1;
5063 end Compute_Directory_Last;
5070 (Project : Project_Id;
5071 In_Tree : Project_Tree_Ref;
5073 Flag_Location : Source_Ptr)
5075 Real_Location : Source_Ptr := Flag_Location;
5076 Error_Buffer : String (1 .. 5_000);
5077 Error_Last : Natural := 0;
5078 Name_Number : Natural := 0;
5079 File_Number : Natural := 0;
5080 First : Positive := Msg'First;
5083 procedure Add (C : Character);
5084 -- Add a character to the buffer
5086 procedure Add (S : String);
5087 -- Add a string to the buffer
5090 -- Add a name to the buffer
5093 -- Add a file name to the buffer
5099 procedure Add (C : Character) is
5101 Error_Last := Error_Last + 1;
5102 Error_Buffer (Error_Last) := C;
5105 procedure Add (S : String) is
5107 Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S;
5108 Error_Last := Error_Last + S'Length;
5115 procedure Add_File is
5116 File : File_Name_Type;
5120 File_Number := File_Number + 1;
5124 File := Err_Vars.Error_Msg_File_1;
5126 File := Err_Vars.Error_Msg_File_2;
5128 File := Err_Vars.Error_Msg_File_3;
5133 Get_Name_String (File);
5134 Add (Name_Buffer (1 .. Name_Len));
5142 procedure Add_Name is
5147 Name_Number := Name_Number + 1;
5151 Name := Err_Vars.Error_Msg_Name_1;
5153 Name := Err_Vars.Error_Msg_Name_2;
5155 Name := Err_Vars.Error_Msg_Name_3;
5160 Get_Name_String (Name);
5161 Add (Name_Buffer (1 .. Name_Len));
5165 -- Start of processing for Error_Msg
5168 -- If location of error is unknown, use the location of the project
5170 if Real_Location = No_Location then
5171 Real_Location := Project.Location;
5174 if Error_Report = null then
5175 Prj.Err.Error_Msg (Msg, Real_Location);
5179 -- Ignore continuation character
5181 if Msg (First) = '\' then
5185 -- Warning character is always the first one in this package
5186 -- this is an undocumented kludge???
5188 if Msg (First) = '?' then
5192 elsif Msg (First) = '<' then
5195 if Err_Vars.Error_Msg_Warn then
5201 while Index <= Msg'Last loop
5202 if Msg (Index) = '{' then
5205 elsif Msg (Index) = '%' then
5206 if Index < Msg'Last and then Msg (Index + 1) = '%' then
5218 Error_Report (Error_Buffer (1 .. Error_Last), Project, In_Tree);
5221 --------------------------------
5222 -- Free_Ada_Naming_Exceptions --
5223 --------------------------------
5225 procedure Free_Ada_Naming_Exceptions is
5227 Ada_Naming_Exception_Table.Set_Last (0);
5228 Ada_Naming_Exceptions.Reset;
5229 Reverse_Ada_Naming_Exceptions.Reset;
5230 end Free_Ada_Naming_Exceptions;
5232 ---------------------
5233 -- Get_Directories --
5234 ---------------------
5236 procedure Get_Directories
5237 (Project : Project_Id;
5238 In_Tree : Project_Tree_Ref;
5239 Current_Dir : String)
5241 Object_Dir : constant Variable_Value :=
5243 (Name_Object_Dir, Project.Decl.Attributes, In_Tree);
5245 Exec_Dir : constant Variable_Value :=
5247 (Name_Exec_Dir, Project.Decl.Attributes, In_Tree);
5249 Source_Dirs : constant Variable_Value :=
5251 (Name_Source_Dirs, Project.Decl.Attributes, In_Tree);
5253 Excluded_Source_Dirs : constant Variable_Value :=
5255 (Name_Excluded_Source_Dirs,
5256 Project.Decl.Attributes,
5259 Source_Files : constant Variable_Value :=
5261 (Name_Source_Files, Project.Decl.Attributes, In_Tree);
5263 Last_Source_Dir : String_List_Id := Nil_String;
5265 Languages : constant Variable_Value :=
5267 (Name_Languages, Project.Decl.Attributes, In_Tree);
5269 procedure Find_Source_Dirs
5270 (From : File_Name_Type;
5271 Location : Source_Ptr;
5272 Removed : Boolean := False);
5273 -- Find one or several source directories, and add (or remove, if
5274 -- Removed is True) them to list of source directories of the project.
5276 ----------------------
5277 -- Find_Source_Dirs --
5278 ----------------------
5280 procedure Find_Source_Dirs
5281 (From : File_Name_Type;
5282 Location : Source_Ptr;
5283 Removed : Boolean := False)
5285 Directory : constant String := Get_Name_String (From);
5286 Element : String_Element;
5288 procedure Recursive_Find_Dirs (Path : Name_Id);
5289 -- Find all the subdirectories (recursively) of Path and add them
5290 -- to the list of source directories of the project.
5292 -------------------------
5293 -- Recursive_Find_Dirs --
5294 -------------------------
5296 procedure Recursive_Find_Dirs (Path : Name_Id) is
5298 Name : String (1 .. 250);
5300 List : String_List_Id;
5301 Prev : String_List_Id;
5302 Element : String_Element;
5303 Found : Boolean := False;
5305 Non_Canonical_Path : Name_Id := No_Name;
5306 Canonical_Path : Name_Id := No_Name;
5308 The_Path : constant String :=
5310 (Get_Name_String (Path),
5311 Directory => Current_Dir,
5312 Resolve_Links => Opt.Follow_Links_For_Dirs) &
5313 Directory_Separator;
5315 The_Path_Last : constant Natural :=
5316 Compute_Directory_Last (The_Path);
5319 Name_Len := The_Path_Last - The_Path'First + 1;
5320 Name_Buffer (1 .. Name_Len) :=
5321 The_Path (The_Path'First .. The_Path_Last);
5322 Non_Canonical_Path := Name_Find;
5324 Name_Id (Canonical_Case_File_Name (Non_Canonical_Path));
5326 -- To avoid processing the same directory several times, check
5327 -- if the directory is already in Recursive_Dirs. If it is, then
5328 -- there is nothing to do, just return. If it is not, put it there
5329 -- and continue recursive processing.
5332 if Recursive_Dirs.Get (Canonical_Path) then
5335 Recursive_Dirs.Set (Canonical_Path, True);
5339 -- Check if directory is already in list
5341 List := Project.Source_Dirs;
5343 while List /= Nil_String loop
5344 Element := In_Tree.String_Elements.Table (List);
5346 if Element.Value /= No_Name then
5347 Found := Element.Value = Canonical_Path;
5352 List := Element.Next;
5355 -- If directory is not already in list, put it there
5357 if (not Removed) and (not Found) then
5358 if Current_Verbosity = High then
5360 Write_Line (The_Path (The_Path'First .. The_Path_Last));
5363 String_Element_Table.Increment_Last
5364 (In_Tree.String_Elements);
5366 (Value => Canonical_Path,
5367 Display_Value => Non_Canonical_Path,
5368 Location => No_Location,
5373 -- Case of first source directory
5375 if Last_Source_Dir = Nil_String then
5376 Project.Source_Dirs := String_Element_Table.Last
5377 (In_Tree.String_Elements);
5379 -- Here we already have source directories
5382 -- Link the previous last to the new one
5384 In_Tree.String_Elements.Table
5385 (Last_Source_Dir).Next :=
5386 String_Element_Table.Last
5387 (In_Tree.String_Elements);
5390 -- And register this source directory as the new last
5392 Last_Source_Dir := String_Element_Table.Last
5393 (In_Tree.String_Elements);
5394 In_Tree.String_Elements.Table (Last_Source_Dir) :=
5397 elsif Removed and Found then
5398 if Prev = Nil_String then
5399 Project.Source_Dirs :=
5400 In_Tree.String_Elements.Table (List).Next;
5402 In_Tree.String_Elements.Table (Prev).Next :=
5403 In_Tree.String_Elements.Table (List).Next;
5407 -- Now look for subdirectories. We do that even when this
5408 -- directory is already in the list, because some of its
5409 -- subdirectories may not be in the list yet.
5411 Open (Dir, The_Path (The_Path'First .. The_Path_Last));
5414 Read (Dir, Name, Last);
5417 if Name (1 .. Last) /= "."
5418 and then Name (1 .. Last) /= ".."
5420 -- Avoid . and .. directories
5422 if Current_Verbosity = High then
5423 Write_Str (" Checking ");
5424 Write_Line (Name (1 .. Last));
5428 Path_Name : constant String :=
5430 (Name => Name (1 .. Last),
5432 The_Path (The_Path'First .. The_Path_Last),
5433 Resolve_Links => Opt.Follow_Links_For_Dirs,
5434 Case_Sensitive => True);
5437 if Is_Directory (Path_Name) then
5438 -- We have found a new subdirectory, call self
5440 Name_Len := Path_Name'Length;
5441 Name_Buffer (1 .. Name_Len) := Path_Name;
5442 Recursive_Find_Dirs (Name_Find);
5451 when Directory_Error =>
5453 end Recursive_Find_Dirs;
5455 -- Start of processing for Find_Source_Dirs
5458 if Current_Verbosity = High and then not Removed then
5459 Write_Str ("Find_Source_Dirs (""");
5460 Write_Str (Directory);
5464 -- First, check if we are looking for a directory tree, indicated
5465 -- by "/**" at the end.
5467 if Directory'Length >= 3
5468 and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
5469 and then (Directory (Directory'Last - 2) = '/'
5471 Directory (Directory'Last - 2) = Directory_Separator)
5474 Project.Known_Order_Of_Source_Dirs := False;
5477 Name_Len := Directory'Length - 3;
5479 if Name_Len = 0 then
5481 -- Case of "/**": all directories in file system
5484 Name_Buffer (1) := Directory (Directory'First);
5487 Name_Buffer (1 .. Name_Len) :=
5488 Directory (Directory'First .. Directory'Last - 3);
5491 if Current_Verbosity = High then
5492 Write_Str ("Looking for all subdirectories of """);
5493 Write_Str (Name_Buffer (1 .. Name_Len));
5498 Base_Dir : constant File_Name_Type := Name_Find;
5499 Root_Dir : constant String :=
5501 (Name => Get_Name_String (Base_Dir),
5504 (Project.Directory.Display_Name),
5505 Resolve_Links => False,
5506 Case_Sensitive => True);
5509 if Root_Dir'Length = 0 then
5510 Err_Vars.Error_Msg_File_1 := Base_Dir;
5512 if Location = No_Location then
5515 "{ is not a valid directory.",
5520 "{ is not a valid directory.",
5525 -- We have an existing directory, we register it and all of
5526 -- its subdirectories.
5528 if Current_Verbosity = High then
5529 Write_Line ("Looking for source directories:");
5532 Name_Len := Root_Dir'Length;
5533 Name_Buffer (1 .. Name_Len) := Root_Dir;
5534 Recursive_Find_Dirs (Name_Find);
5536 if Current_Verbosity = High then
5537 Write_Line ("End of looking for source directories.");
5542 -- We have a single directory
5546 Path_Name : Path_Information;
5547 List : String_List_Id;
5548 Prev : String_List_Id;
5549 Dir_Exists : Boolean;
5553 (Project => Project,
5557 Dir_Exists => Dir_Exists,
5558 Must_Exist => False);
5560 if not Dir_Exists then
5561 Err_Vars.Error_Msg_File_1 := From;
5563 if Location = No_Location then
5566 "{ is not a valid directory",
5571 "{ is not a valid directory",
5577 Path : constant String :=
5578 Get_Name_String (Path_Name.Name) &
5579 Directory_Separator;
5580 Last_Path : constant Natural :=
5581 Compute_Directory_Last (Path);
5583 Display_Path : constant String :=
5585 (Path_Name.Display_Name) &
5586 Directory_Separator;
5587 Last_Display_Path : constant Natural :=
5588 Compute_Directory_Last
5590 Display_Path_Id : Name_Id;
5594 Add_Str_To_Name_Buffer (Path (Path'First .. Last_Path));
5595 Path_Id := Name_Find;
5597 Add_Str_To_Name_Buffer
5599 (Display_Path'First .. Last_Display_Path));
5600 Display_Path_Id := Name_Find;
5604 -- As it is an existing directory, we add it to the
5605 -- list of directories.
5607 String_Element_Table.Increment_Last
5608 (In_Tree.String_Elements);
5612 Display_Value => Display_Path_Id,
5613 Location => No_Location,
5615 Next => Nil_String);
5617 if Last_Source_Dir = Nil_String then
5619 -- This is the first source directory
5621 Project.Source_Dirs := String_Element_Table.Last
5622 (In_Tree.String_Elements);
5625 -- We already have source directories, link the
5626 -- previous last to the new one.
5628 In_Tree.String_Elements.Table
5629 (Last_Source_Dir).Next :=
5630 String_Element_Table.Last
5631 (In_Tree.String_Elements);
5634 -- And register this source directory as the new last
5636 Last_Source_Dir := String_Element_Table.Last
5637 (In_Tree.String_Elements);
5638 In_Tree.String_Elements.Table
5639 (Last_Source_Dir) := Element;
5642 -- Remove source dir, if present
5646 -- Look for source dir in current list
5648 List := Project.Source_Dirs;
5649 while List /= Nil_String loop
5650 Element := In_Tree.String_Elements.Table (List);
5651 exit when Element.Value = Path_Id;
5653 List := Element.Next;
5656 if List /= Nil_String then
5657 -- Source dir was found, remove it from the list
5659 if Prev = Nil_String then
5660 Project.Source_Dirs :=
5661 In_Tree.String_Elements.Table (List).Next;
5664 In_Tree.String_Elements.Table (Prev).Next :=
5665 In_Tree.String_Elements.Table (List).Next;
5673 end Find_Source_Dirs;
5675 -- Start of processing for Get_Directories
5677 Dir_Exists : Boolean;
5680 if Current_Verbosity = High then
5681 Write_Line ("Starting to look for directories");
5684 -- Set the object directory to its default which may be nil, if there
5685 -- is no sources in the project.
5687 if (((not Source_Files.Default)
5688 and then Source_Files.Values = Nil_String)
5690 ((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String)
5692 ((not Languages.Default) and then Languages.Values = Nil_String))
5693 and then Project.Extends = No_Project
5695 Project.Object_Directory := No_Path_Information;
5697 Project.Object_Directory := Project.Directory;
5700 -- Check the object directory
5702 if Object_Dir.Value /= Empty_String then
5703 Get_Name_String (Object_Dir.Value);
5705 if Name_Len = 0 then
5708 "Object_Dir cannot be empty",
5709 Object_Dir.Location);
5712 -- We check that the specified object directory does exist.
5713 -- However, even when it doesn't exist, we set it to a default
5714 -- value. This is for the benefit of tools that recover from
5715 -- errors; for example, these tools could create the non existent
5717 -- We always return an absolute directory name though
5722 File_Name_Type (Object_Dir.Value),
5723 Path => Project.Object_Directory,
5725 Dir_Exists => Dir_Exists,
5726 Location => Object_Dir.Location,
5727 Must_Exist => False,
5728 Externally_Built => Project.Externally_Built);
5731 and then not Project.Externally_Built
5733 -- The object directory does not exist, report an error if
5734 -- the project is not externally built.
5736 Err_Vars.Error_Msg_File_1 :=
5737 File_Name_Type (Object_Dir.Value);
5740 "object directory { not found",
5745 elsif Project.Object_Directory /= No_Path_Information
5746 and then Subdirs /= null
5749 Name_Buffer (1) := '.';
5754 Path => Project.Object_Directory,
5756 Dir_Exists => Dir_Exists,
5757 Location => Object_Dir.Location,
5758 Externally_Built => Project.Externally_Built);
5761 if Current_Verbosity = High then
5762 if Project.Object_Directory = No_Path_Information then
5763 Write_Line ("No object directory");
5766 ("Object directory",
5767 Get_Name_String (Project.Object_Directory.Display_Name));
5771 -- Check the exec directory
5773 -- We set the object directory to its default
5775 Project.Exec_Directory := Project.Object_Directory;
5777 if Exec_Dir.Value /= Empty_String then
5778 Get_Name_String (Exec_Dir.Value);
5780 if Name_Len = 0 then
5783 "Exec_Dir cannot be empty",
5787 -- We check that the specified exec directory does exist
5792 File_Name_Type (Exec_Dir.Value),
5793 Path => Project.Exec_Directory,
5794 Dir_Exists => Dir_Exists,
5796 Location => Exec_Dir.Location,
5797 Externally_Built => Project.Externally_Built);
5799 if not Dir_Exists then
5800 Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
5803 "exec directory { not found",
5809 if Current_Verbosity = High then
5810 if Project.Exec_Directory = No_Path_Information then
5811 Write_Line ("No exec directory");
5813 Write_Str ("Exec directory: """);
5814 Write_Str (Get_Name_String (Project.Exec_Directory.Display_Name));
5819 -- Look for the source directories
5821 if Current_Verbosity = High then
5822 Write_Line ("Starting to look for source directories");
5825 pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
5827 if (not Source_Files.Default) and then
5828 Source_Files.Values = Nil_String
5830 Project.Source_Dirs := Nil_String;
5832 if Project.Qualifier = Standard then
5836 "a standard project cannot have no sources",
5837 Source_Files.Location);
5840 elsif Source_Dirs.Default then
5842 -- No Source_Dirs specified: the single source directory is the one
5843 -- containing the project file
5845 String_Element_Table.Append (In_Tree.String_Elements,
5846 (Value => Name_Id (Project.Directory.Name),
5847 Display_Value => Name_Id (Project.Directory.Display_Name),
5848 Location => No_Location,
5852 Project.Source_Dirs := String_Element_Table.Last
5853 (In_Tree.String_Elements);
5855 if Current_Verbosity = High then
5857 ("Default source directory",
5858 Get_Name_String (Project.Directory.Display_Name));
5861 elsif Source_Dirs.Values = Nil_String then
5862 if Project.Qualifier = Standard then
5866 "a standard project cannot have no source directories",
5867 Source_Dirs.Location);
5870 Project.Source_Dirs := Nil_String;
5874 Source_Dir : String_List_Id;
5875 Element : String_Element;
5878 -- Process the source directories for each element of the list
5880 Source_Dir := Source_Dirs.Values;
5881 while Source_Dir /= Nil_String loop
5882 Element := In_Tree.String_Elements.Table (Source_Dir);
5884 (File_Name_Type (Element.Value), Element.Location);
5885 Source_Dir := Element.Next;
5890 if not Excluded_Source_Dirs.Default
5891 and then Excluded_Source_Dirs.Values /= Nil_String
5894 Source_Dir : String_List_Id;
5895 Element : String_Element;
5898 -- Process the source directories for each element of the list
5900 Source_Dir := Excluded_Source_Dirs.Values;
5901 while Source_Dir /= Nil_String loop
5902 Element := In_Tree.String_Elements.Table (Source_Dir);
5904 (File_Name_Type (Element.Value),
5907 Source_Dir := Element.Next;
5912 if Current_Verbosity = High then
5913 Write_Line ("Putting source directories in canonical cases");
5917 Current : String_List_Id := Project.Source_Dirs;
5918 Element : String_Element;
5921 while Current /= Nil_String loop
5922 Element := In_Tree.String_Elements.Table (Current);
5923 if Element.Value /= No_Name then
5925 Name_Id (Canonical_Case_File_Name (Name_Id (Element.Value)));
5926 In_Tree.String_Elements.Table (Current) := Element;
5929 Current := Element.Next;
5932 end Get_Directories;
5939 (Project : Project_Id;
5940 In_Tree : Project_Tree_Ref)
5942 Mains : constant Variable_Value :=
5943 Prj.Util.Value_Of (Name_Main, Project.Decl.Attributes, In_Tree);
5944 List : String_List_Id;
5945 Elem : String_Element;
5948 Project.Mains := Mains.Values;
5950 -- If no Mains were specified, and if we are an extending project,
5951 -- inherit the Mains from the project we are extending.
5953 if Mains.Default then
5954 if not Project.Library and then Project.Extends /= No_Project then
5955 Project.Mains := Project.Extends.Mains;
5958 -- In a library project file, Main cannot be specified
5960 elsif Project.Library then
5963 "a library project file cannot have Main specified",
5967 List := Mains.Values;
5968 while List /= Nil_String loop
5969 Elem := In_Tree.String_Elements.Table (List);
5971 if Length_Of_Name (Elem.Value) = 0 then
5974 "?a main cannot have an empty name",
5984 ---------------------------
5985 -- Get_Sources_From_File --
5986 ---------------------------
5988 procedure Get_Sources_From_File
5990 Location : Source_Ptr;
5991 Project : Project_Id;
5992 In_Tree : Project_Tree_Ref)
5994 File : Prj.Util.Text_File;
5995 Line : String (1 .. 250);
5997 Source_Name : File_Name_Type;
5998 Name_Loc : Name_Location;
6001 if Get_Mode = Ada_Only then
6005 if Current_Verbosity = High then
6006 Write_Str ("Opening """);
6013 Prj.Util.Open (File, Path);
6015 if not Prj.Util.Is_Valid (File) then
6016 Error_Msg (Project, In_Tree, "file does not exist", Location);
6019 -- Read the lines one by one
6021 while not Prj.Util.End_Of_File (File) loop
6022 Prj.Util.Get_Line (File, Line, Last);
6024 -- A non empty, non comment line should contain a file name
6027 and then (Last = 1 or else Line (1 .. 2) /= "--")
6030 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6031 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6032 Source_Name := Name_Find;
6034 -- Check that there is no directory information
6036 for J in 1 .. Last loop
6037 if Line (J) = '/' or else Line (J) = Directory_Separator then
6038 Error_Msg_File_1 := Source_Name;
6042 "file name cannot include directory information ({)",
6048 Name_Loc := Source_Names.Get (Source_Name);
6050 if Name_Loc = No_Name_Location then
6052 (Name => Source_Name,
6053 Location => Location,
6054 Source => No_Source,
6059 Source_Names.Set (Source_Name, Name_Loc);
6063 Prj.Util.Close (File);
6066 end Get_Sources_From_File;
6068 -----------------------
6069 -- Compute_Unit_Name --
6070 -----------------------
6072 procedure Compute_Unit_Name
6073 (File_Name : File_Name_Type;
6074 Naming : Lang_Naming_Data;
6075 Kind : out Source_Kind;
6077 In_Tree : Project_Tree_Ref)
6079 Filename : constant String := Get_Name_String (File_Name);
6080 Last : Integer := Filename'Last;
6081 Sep_Len : constant Integer :=
6082 Integer (Length_Of_Name (Naming.Separate_Suffix));
6083 Body_Len : constant Integer :=
6084 Integer (Length_Of_Name (Naming.Body_Suffix));
6085 Spec_Len : constant Integer :=
6086 Integer (Length_Of_Name (Naming.Spec_Suffix));
6088 Standard_GNAT : constant Boolean :=
6089 Naming.Spec_Suffix = Default_Ada_Spec_Suffix
6091 Naming.Body_Suffix = Default_Ada_Body_Suffix;
6093 Unit_Except : Unit_Exception;
6094 Masked : Boolean := False;
6100 if Naming.Dot_Replacement = No_File then
6101 if Current_Verbosity = High then
6102 Write_Line (" No dot_replacement specified");
6108 -- Choose the longest suffix that matches. If there are several matches,
6109 -- give priority to specs, then bodies, then separates.
6111 if Naming.Separate_Suffix /= Naming.Body_Suffix
6112 and then Suffix_Matches (Filename, Naming.Separate_Suffix)
6114 Last := Filename'Last - Sep_Len;
6118 if Filename'Last - Body_Len <= Last
6119 and then Suffix_Matches (Filename, Naming.Body_Suffix)
6121 Last := Natural'Min (Last, Filename'Last - Body_Len);
6125 if Filename'Last - Spec_Len <= Last
6126 and then Suffix_Matches (Filename, Naming.Spec_Suffix)
6128 Last := Natural'Min (Last, Filename'Last - Spec_Len);
6132 if Last = Filename'Last then
6133 if Current_Verbosity = High then
6134 Write_Line (" No matching suffix");
6140 -- Check that the casing matches
6142 if File_Names_Case_Sensitive then
6143 case Naming.Casing is
6144 when All_Lower_Case =>
6145 for J in Filename'First .. Last loop
6146 if Is_Letter (Filename (J))
6147 and then not Is_Lower (Filename (J))
6149 if Current_Verbosity = High then
6150 Write_Line (" Invalid casing");
6157 when All_Upper_Case =>
6158 for J in Filename'First .. Last loop
6159 if Is_Letter (Filename (J))
6160 and then not Is_Upper (Filename (J))
6162 if Current_Verbosity = High then
6163 Write_Line (" Invalid casing");
6170 when Mixed_Case | Unknown =>
6175 -- If Dot_Replacement is not a single dot, then there should not
6176 -- be any dot in the name.
6179 Dot_Repl : constant String :=
6180 Get_Name_String (Naming.Dot_Replacement);
6183 if Dot_Repl /= "." then
6184 for Index in Filename'First .. Last loop
6185 if Filename (Index) = '.' then
6186 if Current_Verbosity = High then
6187 Write_Line (" Invalid name, contains dot");
6194 Replace_Into_Name_Buffer
6195 (Filename (Filename'First .. Last), Dot_Repl, '.');
6198 Name_Len := Last - Filename'First + 1;
6199 Name_Buffer (1 .. Name_Len) := Filename (Filename'First .. Last);
6201 (Source => Name_Buffer (1 .. Name_Len),
6202 Mapping => Lower_Case_Map);
6206 -- In the standard GNAT naming scheme, check for special cases: children
6207 -- or separates of A, G, I or S, and run time sources.
6209 if Standard_GNAT and then Name_Len >= 3 then
6211 S1 : constant Character := Name_Buffer (1);
6212 S2 : constant Character := Name_Buffer (2);
6213 S3 : constant Character := Name_Buffer (3);
6221 -- Children or separates of packages A, G, I or S. These names
6222 -- are x__ ... or x~... (where x is a, g, i, or s). Both
6223 -- versions (x__... and x~...) are allowed in all platforms,
6224 -- because it is not possible to know the platform before
6225 -- processing of the project files.
6227 if S2 = '_' and then S3 = '_' then
6228 Name_Buffer (2) := '.';
6229 Name_Buffer (3 .. Name_Len - 1) :=
6230 Name_Buffer (4 .. Name_Len);
6231 Name_Len := Name_Len - 1;
6234 Name_Buffer (2) := '.';
6238 -- If it is potentially a run time source, disable filling
6239 -- of the mapping file to avoid warnings.
6241 Set_Mapping_File_Initial_State_To_Empty (In_Tree);
6247 -- Name_Buffer contains the name of the the unit in lower-cases. Check
6248 -- that this is a valid unit name
6250 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
6252 -- If there is a naming exception for the same unit, the file is not
6253 -- a source for the unit. Currently, this only applies in multi_lang
6254 -- mode, since Unit_Exceptions is no set in ada_only mode.
6256 if Unit /= No_Name then
6257 Unit_Except := Unit_Exceptions.Get (Unit);
6260 Masked := Unit_Except.Spec /= No_File
6262 Unit_Except.Spec /= File_Name;
6264 Masked := Unit_Except.Impl /= No_File
6266 Unit_Except.Impl /= File_Name;
6270 if Current_Verbosity = High then
6271 Write_Str (" """ & Filename & """ contains the ");
6274 Write_Str ("spec of a unit found in """);
6275 Write_Str (Get_Name_String (Unit_Except.Spec));
6277 Write_Str ("body of a unit found in """);
6278 Write_Str (Get_Name_String (Unit_Except.Impl));
6281 Write_Line (""" (ignored)");
6289 and then Current_Verbosity = High
6292 when Spec => Write_Str (" spec of ");
6293 when Impl => Write_Str (" body of ");
6294 when Sep => Write_Str (" sep of ");
6297 Write_Line (Get_Name_String (Unit));
6299 end Compute_Unit_Name;
6306 (In_Tree : Project_Tree_Ref;
6307 Canonical_File_Name : File_Name_Type;
6308 Project : Project_Id;
6309 Exception_Id : out Ada_Naming_Exception_Id;
6310 Unit_Name : out Name_Id;
6311 Unit_Kind : out Spec_Or_Body)
6313 Info_Id : Ada_Naming_Exception_Id :=
6314 Ada_Naming_Exceptions.Get (Canonical_File_Name);
6315 VMS_Name : File_Name_Type;
6317 Lang : Language_Ptr;
6320 if Info_Id = No_Ada_Naming_Exception
6321 and then Hostparm.OpenVMS
6323 VMS_Name := Canonical_File_Name;
6324 Get_Name_String (VMS_Name);
6326 if Name_Buffer (Name_Len) = '.' then
6327 Name_Len := Name_Len - 1;
6328 VMS_Name := Name_Find;
6331 Info_Id := Ada_Naming_Exceptions.Get (VMS_Name);
6334 if Info_Id /= No_Ada_Naming_Exception then
6335 Exception_Id := Info_Id;
6336 Unit_Name := No_Name;
6340 Exception_Id := No_Ada_Naming_Exception;
6341 Lang := Get_Language_From_Name (Project, "ada");
6344 Unit_Name := No_Name;
6348 (File_Name => Canonical_File_Name,
6349 Naming => Lang.Config.Naming_Data,
6352 In_Tree => In_Tree);
6355 when Spec => Unit_Kind := Spec;
6356 when Impl | Sep => Unit_Kind := Impl;
6366 function Hash (Unit : Unit_Info) return Header_Num is
6368 return Header_Num (Unit.Unit mod 2048);
6371 -----------------------
6372 -- Is_Illegal_Suffix --
6373 -----------------------
6375 function Is_Illegal_Suffix
6376 (Suffix : File_Name_Type;
6377 Dot_Replacement : File_Name_Type) return Boolean
6379 Suffix_Str : constant String := Get_Name_String (Suffix);
6382 if Suffix_Str'Length = 0 then
6384 elsif Index (Suffix_Str, ".") = 0 then
6388 -- Case of dot replacement is a single dot, and first character of
6389 -- suffix is also a dot.
6391 if Get_Name_String (Dot_Replacement) = "."
6392 and then Suffix_Str (Suffix_Str'First) = '.'
6394 for Index in Suffix_Str'First + 1 .. Suffix_Str'Last loop
6396 -- Case of following dot
6398 if Suffix_Str (Index) = '.' then
6400 -- It is illegal to have a letter following the initial dot
6402 return Is_Letter (Suffix_Str (Suffix_Str'First + 1));
6408 end Is_Illegal_Suffix;
6410 ----------------------
6411 -- Locate_Directory --
6412 ----------------------
6414 procedure Locate_Directory
6415 (Project : Project_Id;
6416 In_Tree : Project_Tree_Ref;
6417 Name : File_Name_Type;
6418 Path : out Path_Information;
6419 Dir_Exists : out Boolean;
6420 Create : String := "";
6421 Location : Source_Ptr := No_Location;
6422 Must_Exist : Boolean := True;
6423 Externally_Built : Boolean := False)
6425 Parent : constant Path_Name_Type :=
6426 Project.Directory.Display_Name;
6427 The_Parent : constant String :=
6428 Get_Name_String (Parent) & Directory_Separator;
6429 The_Parent_Last : constant Natural :=
6430 Compute_Directory_Last (The_Parent);
6431 Full_Name : File_Name_Type;
6432 The_Name : File_Name_Type;
6435 Get_Name_String (Name);
6437 -- Add Subdirs.all if it is a directory that may be created and
6438 -- Subdirs is not null;
6440 if Create /= "" and then Subdirs /= null then
6441 if Name_Buffer (Name_Len) /= Directory_Separator then
6442 Add_Char_To_Name_Buffer (Directory_Separator);
6445 Add_Str_To_Name_Buffer (Subdirs.all);
6448 -- Convert '/' to directory separator (for Windows)
6450 for J in 1 .. Name_Len loop
6451 if Name_Buffer (J) = '/' then
6452 Name_Buffer (J) := Directory_Separator;
6456 The_Name := Name_Find;
6458 if Current_Verbosity = High then
6459 Write_Str ("Locate_Directory (""");
6460 Write_Str (Get_Name_String (The_Name));
6461 Write_Str (""", """);
6462 Write_Str (The_Parent);
6466 Path := No_Path_Information;
6467 Dir_Exists := False;
6469 if Is_Absolute_Path (Get_Name_String (The_Name)) then
6470 Full_Name := The_Name;
6474 Add_Str_To_Name_Buffer
6475 (The_Parent (The_Parent'First .. The_Parent_Last));
6476 Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
6477 Full_Name := Name_Find;
6481 Full_Path_Name : String_Access :=
6482 new String'(Get_Name_String (Full_Name));
6485 if (Setup_Projects or else Subdirs /= null)
6486 and then Create'Length > 0
6488 if not Is_Directory (Full_Path_Name.all) then
6490 -- If project is externally built, do not create a subdir,
6491 -- use the specified directory, without the subdir.
6493 if Externally_Built then
6494 if Is_Absolute_Path (Get_Name_String (Name)) then
6495 Get_Name_String (Name);
6499 Add_Str_To_Name_Buffer
6500 (The_Parent (The_Parent'First .. The_Parent_Last));
6501 Add_Str_To_Name_Buffer (Get_Name_String (Name));
6504 Full_Path_Name := new String'(Name_Buffer (1 .. Name_Len));
6508 Create_Path (Full_Path_Name.all);
6510 if not Quiet_Output then
6512 Write_Str (" directory """);
6513 Write_Str (Full_Path_Name.all);
6514 Write_Str (""" created for project ");
6515 Write_Line (Get_Name_String (Project.Name));
6522 "could not create " & Create &
6523 " directory " & Full_Path_Name.all,
6530 Dir_Exists := Is_Directory (Full_Path_Name.all);
6532 if not Must_Exist or else Dir_Exists then
6534 Normed : constant String :=
6536 (Full_Path_Name.all,
6538 The_Parent (The_Parent'First .. The_Parent_Last),
6539 Resolve_Links => False,
6540 Case_Sensitive => True);
6542 Canonical_Path : constant String :=
6547 (The_Parent'First .. The_Parent_Last),
6549 Opt.Follow_Links_For_Dirs,
6550 Case_Sensitive => False);
6553 Name_Len := Normed'Length;
6554 Name_Buffer (1 .. Name_Len) := Normed;
6555 Path.Display_Name := Name_Find;
6557 Name_Len := Canonical_Path'Length;
6558 Name_Buffer (1 .. Name_Len) := Canonical_Path;
6559 Path.Name := Name_Find;
6563 Free (Full_Path_Name);
6565 end Locate_Directory;
6567 ---------------------------
6568 -- Find_Excluded_Sources --
6569 ---------------------------
6571 procedure Find_Excluded_Sources
6572 (Project : Project_Id;
6573 In_Tree : Project_Tree_Ref)
6575 Excluded_Source_List_File : constant Variable_Value :=
6577 (Name_Excluded_Source_List_File,
6578 Project.Decl.Attributes,
6581 Excluded_Sources : Variable_Value := Util.Value_Of
6582 (Name_Excluded_Source_Files,
6583 Project.Decl.Attributes,
6586 Current : String_List_Id;
6587 Element : String_Element;
6588 Location : Source_Ptr;
6589 Name : File_Name_Type;
6590 File : Prj.Util.Text_File;
6591 Line : String (1 .. 300);
6593 Locally_Removed : Boolean := False;
6596 -- If Excluded_Source_Files is not declared, check
6597 -- Locally_Removed_Files.
6599 if Excluded_Sources.Default then
6600 Locally_Removed := True;
6603 (Name_Locally_Removed_Files, Project.Decl.Attributes, In_Tree);
6606 Excluded_Sources_Htable.Reset;
6608 -- If there are excluded sources, put them in the table
6610 if not Excluded_Sources.Default then
6611 if not Excluded_Source_List_File.Default then
6612 if Locally_Removed then
6615 "?both attributes Locally_Removed_Files and " &
6616 "Excluded_Source_List_File are present",
6617 Excluded_Source_List_File.Location);
6621 "?both attributes Excluded_Source_Files and " &
6622 "Excluded_Source_List_File are present",
6623 Excluded_Source_List_File.Location);
6627 Current := Excluded_Sources.Values;
6628 while Current /= Nil_String loop
6629 Element := In_Tree.String_Elements.Table (Current);
6630 Name := Canonical_Case_File_Name (Element.Value);
6632 -- If the element has no location, then use the location of
6633 -- Excluded_Sources to report possible errors.
6635 if Element.Location = No_Location then
6636 Location := Excluded_Sources.Location;
6638 Location := Element.Location;
6641 Excluded_Sources_Htable.Set (Name, (Name, False, Location));
6642 Current := Element.Next;
6645 elsif not Excluded_Source_List_File.Default then
6646 Location := Excluded_Source_List_File.Location;
6649 Source_File_Path_Name : constant String :=
6652 (Excluded_Source_List_File.Value),
6653 Project.Directory.Name);
6656 if Source_File_Path_Name'Length = 0 then
6657 Err_Vars.Error_Msg_File_1 :=
6658 File_Name_Type (Excluded_Source_List_File.Value);
6661 "file with excluded sources { does not exist",
6662 Excluded_Source_List_File.Location);
6667 Prj.Util.Open (File, Source_File_Path_Name);
6669 if not Prj.Util.Is_Valid (File) then
6671 (Project, In_Tree, "file does not exist", Location);
6673 -- Read the lines one by one
6675 while not Prj.Util.End_Of_File (File) loop
6676 Prj.Util.Get_Line (File, Line, Last);
6678 -- Non empty, non comment line should contain a file name
6681 and then (Last = 1 or else Line (1 .. 2) /= "--")
6684 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6685 Canonical_Case_File_Name
6686 (Name_Buffer (1 .. Name_Len));
6689 -- Check that there is no directory information
6691 for J in 1 .. Last loop
6693 or else Line (J) = Directory_Separator
6695 Error_Msg_File_1 := Name;
6699 "file name cannot include " &
6700 "directory information ({)",
6706 Excluded_Sources_Htable.Set
6707 (Name, (Name, False, Location));
6711 Prj.Util.Close (File);
6716 end Find_Excluded_Sources;
6722 procedure Find_Sources
6723 (Project : Project_Id;
6724 In_Tree : Project_Tree_Ref;
6725 Proc_Data : in out Processing_Data;
6726 Allow_Duplicate_Basenames : Boolean)
6728 Sources : constant Variable_Value :=
6731 Project.Decl.Attributes,
6733 Source_List_File : constant Variable_Value :=
6735 (Name_Source_List_File,
6736 Project.Decl.Attributes,
6738 Name_Loc : Name_Location;
6740 Has_Explicit_Sources : Boolean;
6743 pragma Assert (Sources.Kind = List, "Source_Files is not a list");
6745 (Source_List_File.Kind = Single,
6746 "Source_List_File is not a single string");
6748 -- If the user has specified a Source_Files attribute
6750 if not Sources.Default then
6751 if not Source_List_File.Default then
6754 "?both attributes source_files and " &
6755 "source_list_file are present",
6756 Source_List_File.Location);
6759 -- Sources is a list of file names
6762 Current : String_List_Id := Sources.Values;
6763 Element : String_Element;
6764 Location : Source_Ptr;
6765 Name : File_Name_Type;
6768 if Get_Mode = Multi_Language then
6769 if Current = Nil_String then
6770 Project.Languages := No_Language_Index;
6772 -- This project contains no source. For projects that don't
6773 -- extend other projects, this also means that there is no
6774 -- need for an object directory, if not specified.
6776 if Project.Extends = No_Project
6777 and then Project.Object_Directory = Project.Directory
6779 Project.Object_Directory := No_Path_Information;
6784 while Current /= Nil_String loop
6785 Element := In_Tree.String_Elements.Table (Current);
6786 Name := Canonical_Case_File_Name (Element.Value);
6787 Get_Name_String (Element.Value);
6789 -- If the element has no location, then use the location of
6790 -- Sources to report possible errors.
6792 if Element.Location = No_Location then
6793 Location := Sources.Location;
6795 Location := Element.Location;
6798 -- Check that there is no directory information
6800 for J in 1 .. Name_Len loop
6801 if Name_Buffer (J) = '/'
6802 or else Name_Buffer (J) = Directory_Separator
6804 Error_Msg_File_1 := Name;
6808 "file name cannot include directory " &
6815 -- In Multi_Language mode, check whether the file is already
6816 -- there: the same file name may be in the list. If the source
6817 -- is missing, the error will be on the first mention of the
6818 -- source file name.
6822 Name_Loc := No_Name_Location;
6823 when Multi_Language =>
6824 Name_Loc := Source_Names.Get (Name);
6827 if Name_Loc = No_Name_Location then
6830 Location => Location,
6831 Source => No_Source,
6834 Source_Names.Set (Name, Name_Loc);
6837 Current := Element.Next;
6840 Has_Explicit_Sources := True;
6843 -- If we have no Source_Files attribute, check the Source_List_File
6846 elsif not Source_List_File.Default then
6848 -- Source_List_File is the name of the file that contains the source
6852 Source_File_Path_Name : constant String :=
6854 (File_Name_Type (Source_List_File.Value),
6855 Project.Directory.Name);
6858 Has_Explicit_Sources := True;
6860 if Source_File_Path_Name'Length = 0 then
6861 Err_Vars.Error_Msg_File_1 :=
6862 File_Name_Type (Source_List_File.Value);
6865 "file with sources { does not exist",
6866 Source_List_File.Location);
6869 Get_Sources_From_File
6870 (Source_File_Path_Name, Source_List_File.Location,
6876 -- Neither Source_Files nor Source_List_File has been specified. Find
6877 -- all the files that satisfy the naming scheme in all the source
6880 Has_Explicit_Sources := False;
6883 if Get_Mode = Ada_Only then
6886 Explicit_Sources_Only => Has_Explicit_Sources,
6887 Proc_Data => Proc_Data);
6893 Sources.Default and then Source_List_File.Default,
6894 Allow_Duplicate_Basenames => Allow_Duplicate_Basenames);
6897 -- Check if all exceptions have been found. For Ada, it is an error if
6898 -- an exception is not found. For other language, the source is simply
6903 Iter : Source_Iterator;
6906 Iter := For_Each_Source (In_Tree, Project);
6908 Source := Prj.Element (Iter);
6909 exit when Source = No_Source;
6911 if Source.Naming_Exception
6912 and then Source.Path = No_Path_Information
6914 if Source.Unit /= No_Unit_Index then
6915 Error_Msg_Name_1 := Name_Id (Source.Display_File);
6916 Error_Msg_Name_2 := Name_Id (Source.Unit.Name);
6919 "source file %% for unit %% not found",
6923 Remove_Source (Source, No_Source);
6930 -- It is an error if a source file name in a source list or in a source
6931 -- list file is not found.
6933 if Has_Explicit_Sources then
6936 First_Error : Boolean;
6939 NL := Source_Names.Get_First;
6940 First_Error := True;
6941 while NL /= No_Name_Location loop
6942 if not NL.Found then
6943 Err_Vars.Error_Msg_File_1 := NL.Name;
6948 "source file { not found",
6950 First_Error := False;
6955 "\source file { not found",
6960 NL := Source_Names.Get_Next;
6965 if Get_Mode = Ada_Only
6966 and then Project.Extends = No_Project
6968 -- We should have found at least one source, if not report an error
6970 if not Has_Ada_Sources (Project) then
6972 (Project, "Ada", In_Tree, Source_List_File.Location);
6981 procedure Initialize (Proc_Data : in out Processing_Data) is
6983 Files_Htable.Reset (Proc_Data.Units);
6990 procedure Free (Proc_Data : in out Processing_Data) is
6992 Files_Htable.Reset (Proc_Data.Units);
6995 ----------------------
6996 -- Find_Ada_Sources --
6997 ----------------------
6999 procedure Find_Ada_Sources
7000 (Project : Project_Id;
7001 In_Tree : Project_Tree_Ref;
7002 Explicit_Sources_Only : Boolean;
7003 Proc_Data : in out Processing_Data)
7005 Source_Dir : String_List_Id;
7006 Element : String_Element;
7008 Dir_Has_Source : Boolean := False;
7010 Ada_Language : Language_Ptr;
7013 if Current_Verbosity = High then
7014 Write_Line ("Looking for Ada sources:");
7017 Ada_Language := Project.Languages;
7018 while Ada_Language /= No_Language_Index
7019 and then Ada_Language.Name /= Name_Ada
7021 Ada_Language := Ada_Language.Next;
7024 -- We look in all source directories for the file names in the hash
7025 -- table Source_Names.
7027 Source_Dir := Project.Source_Dirs;
7028 while Source_Dir /= Nil_String loop
7029 Dir_Has_Source := False;
7030 Element := In_Tree.String_Elements.Table (Source_Dir);
7033 Dir_Path : constant String :=
7034 Get_Name_String (Element.Display_Value) &
7035 Directory_Separator;
7036 Dir_Last : constant Natural := Compute_Directory_Last (Dir_Path);
7039 if Current_Verbosity = High then
7040 Write_Line ("checking directory """ & Dir_Path & """");
7043 -- Look for all files in the current source directory
7045 Open (Dir, Dir_Path (Dir_Path'First .. Dir_Last));
7048 Read (Dir, Name_Buffer, Name_Len);
7049 exit when Name_Len = 0;
7051 if Current_Verbosity = High then
7052 Write_Line (" Checking " & Name_Buffer (1 .. Name_Len));
7056 Name : constant File_Name_Type := Name_Find;
7057 Canonical_Name : File_Name_Type;
7059 -- ??? We could probably optimize the following call: we
7060 -- need to resolve links only once for the directory itself,
7061 -- and then do a single call to readlink() for each file.
7062 -- Unfortunately that would require a change in
7063 -- Normalize_Pathname so that it has the option of not
7064 -- resolving links for its Directory parameter, only for
7067 Path : constant String :=
7069 (Name => Name_Buffer (1 .. Name_Len),
7070 Directory => Dir_Path (Dir_Path'First .. Dir_Last),
7071 Resolve_Links => Opt.Follow_Links_For_Files,
7072 Case_Sensitive => True); -- no case folding
7074 Path_Name : Path_Name_Type;
7075 To_Record : Boolean := False;
7076 Location : Source_Ptr;
7079 -- If the file was listed in the explicit list of sources,
7080 -- mark it as such (since we'll need to report an error when
7081 -- an explicit source was not found)
7083 if Explicit_Sources_Only then
7085 Canonical_Case_File_Name (Name_Id (Name));
7086 NL := Source_Names.Get (Canonical_Name);
7087 To_Record := NL /= No_Name_Location and then not NL.Found;
7091 Location := NL.Location;
7092 Source_Names.Set (Canonical_Name, NL);
7097 Location := No_Location;
7101 Name_Len := Path'Length;
7102 Name_Buffer (1 .. Name_Len) := Path;
7103 Path_Name := Name_Find;
7105 if Current_Verbosity = High then
7106 Write_Line (" recording " & Get_Name_String (Name));
7109 -- Register the source if it is an Ada compilation unit
7113 Path_Name => Path_Name,
7116 Proc_Data => Proc_Data,
7117 Ada_Language => Ada_Language,
7118 Location => Location,
7119 Source_Recorded => Dir_Has_Source);
7132 if Dir_Has_Source then
7133 In_Tree.String_Elements.Table (Source_Dir).Flag := True;
7136 Source_Dir := Element.Next;
7139 if Current_Verbosity = High then
7140 Write_Line ("End looking for sources");
7142 end Find_Ada_Sources;
7144 -------------------------------
7145 -- Check_File_Naming_Schemes --
7146 -------------------------------
7148 procedure Check_File_Naming_Schemes
7149 (In_Tree : Project_Tree_Ref;
7150 Project : Project_Id;
7151 File_Name : File_Name_Type;
7152 Alternate_Languages : out Language_List;
7153 Language : out Language_Ptr;
7154 Display_Language_Name : out Name_Id;
7156 Lang_Kind : out Language_Kind;
7157 Kind : out Source_Kind)
7159 Filename : constant String := Get_Name_String (File_Name);
7160 Config : Language_Config;
7161 Tmp_Lang : Language_Ptr;
7163 Header_File : Boolean := False;
7164 -- True if we found at least one language for which the file is a header
7165 -- In such a case, we search for all possible languages where this is
7166 -- also a header (C and C++ for instance), since the file might be used
7167 -- for several such languages.
7169 procedure Check_File_Based_Lang;
7170 -- Does the naming scheme test for file-based languages. For those,
7171 -- there is no Unit. Just check if the file name has the implementation
7172 -- or, if it is specified, the template suffix of the language.
7174 -- Returns True if the file belongs to the current language and we
7175 -- should stop searching for matching languages. Not that a given header
7176 -- file could belong to several languages (C and C++ for instance). Thus
7177 -- if we found a header we'll check whether it matches other languages.
7179 ---------------------------
7180 -- Check_File_Based_Lang --
7181 ---------------------------
7183 procedure Check_File_Based_Lang is
7186 and then Suffix_Matches (Filename, Config.Naming_Data.Body_Suffix)
7190 Language := Tmp_Lang;
7192 if Current_Verbosity = High then
7193 Write_Str (" implementation of language ");
7194 Write_Line (Get_Name_String (Display_Language_Name));
7197 elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
7198 if Current_Verbosity = High then
7199 Write_Str (" header of language ");
7200 Write_Line (Get_Name_String (Display_Language_Name));
7204 Alternate_Languages := new Language_List_Element'
7205 (Language => Language,
7206 Next => Alternate_Languages);
7209 Header_File := True;
7212 Language := Tmp_Lang;
7215 end Check_File_Based_Lang;
7217 -- Start of processing for Check_File_Naming_Schemes
7220 Language := No_Language_Index;
7221 Alternate_Languages := null;
7222 Display_Language_Name := No_Name;
7224 Lang_Kind := File_Based;
7227 Tmp_Lang := Project.Languages;
7228 while Tmp_Lang /= No_Language_Index loop
7229 if Current_Verbosity = High then
7231 (" Testing language "
7232 & Get_Name_String (Tmp_Lang.Name)
7233 & " Header_File=" & Header_File'Img);
7236 Display_Language_Name := Tmp_Lang.Display_Name;
7237 Config := Tmp_Lang.Config;
7238 Lang_Kind := Config.Kind;
7242 Check_File_Based_Lang;
7243 exit when Kind = Impl;
7247 -- We know it belongs to a least a file_based language, no
7248 -- need to check unit-based ones.
7250 if not Header_File then
7252 (File_Name => File_Name,
7253 Naming => Config.Naming_Data,
7256 In_Tree => In_Tree);
7258 if Unit /= No_Name then
7259 Language := Tmp_Lang;
7265 Tmp_Lang := Tmp_Lang.Next;
7268 if Language = No_Language_Index
7269 and then Current_Verbosity = High
7271 Write_Line (" not a source of any language");
7273 end Check_File_Naming_Schemes;
7279 procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is
7281 -- If the file was previously already associated with a unit, change it
7283 if Source.Unit /= null
7284 and then Source.Kind in Spec_Or_Body
7285 and then Source.Unit.File_Names (Source.Kind) /= null
7287 -- If we had another file referencing the same unit (for instance it
7288 -- was in an extended project), that source file is in fact invisible
7289 -- from now on, and in particular doesn't belong to the same unit.
7291 if Source.Unit.File_Names (Source.Kind) /= Source then
7292 Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
7295 Source.Unit.File_Names (Source.Kind) := null;
7298 Source.Kind := Kind;
7300 if Source.Kind in Spec_Or_Body and then Source.Unit /= null then
7301 Source.Unit.File_Names (Source.Kind) := Source;
7309 procedure Check_File
7310 (Project : Project_Id;
7311 In_Tree : Project_Tree_Ref;
7312 Path : Path_Name_Type;
7313 File_Name : File_Name_Type;
7314 Display_File_Name : File_Name_Type;
7315 For_All_Sources : Boolean;
7316 Allow_Duplicate_Basenames : Boolean)
7318 Canonical_Path : constant Path_Name_Type :=
7320 (Canonical_Case_File_Name (Name_Id (Path)));
7322 Name_Loc : Name_Location := Source_Names.Get (File_Name);
7323 Check_Name : Boolean := False;
7324 Alternate_Languages : Language_List;
7325 Language : Language_Ptr;
7328 Src_Ind : Source_File_Index;
7330 Source_To_Replace : Source_Id := No_Source;
7331 Display_Language_Name : Name_Id;
7332 Lang_Kind : Language_Kind;
7333 Kind : Source_Kind := Spec;
7334 Iter : Source_Iterator;
7337 if Name_Loc = No_Name_Location then
7338 Check_Name := For_All_Sources;
7341 if Name_Loc.Found then
7342 -- Check if it is OK to have the same file name in several
7343 -- source directories.
7345 if not Project.Known_Order_Of_Source_Dirs then
7346 Error_Msg_File_1 := File_Name;
7349 "{ is found in several source directories",
7354 Name_Loc.Found := True;
7356 Source_Names.Set (File_Name, Name_Loc);
7358 if Name_Loc.Source = No_Source then
7362 -- ??? Issue: there could be several entries for the same
7363 -- source file in the list of sources, in case the file
7364 -- contains multiple units. We should share the data as much
7365 -- as possible, and more importantly set the path for all
7368 Name_Loc.Source.Path := (Canonical_Path, Path);
7370 Source_Paths_Htable.Set
7371 (In_Tree.Source_Paths_HT,
7375 -- Check if this is a subunit
7377 if Name_Loc.Source.Unit /= No_Unit_Index
7378 and then Name_Loc.Source.Kind = Impl
7380 Src_Ind := Sinput.P.Load_Project_File
7381 (Get_Name_String (Canonical_Path));
7383 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
7384 Override_Kind (Name_Loc.Source, Sep);
7392 Check_File_Naming_Schemes
7393 (In_Tree => In_Tree,
7395 File_Name => File_Name,
7396 Alternate_Languages => Alternate_Languages,
7397 Language => Language,
7398 Display_Language_Name => Display_Language_Name,
7400 Lang_Kind => Lang_Kind,
7403 if Language = No_Language_Index then
7405 -- A file name in a list must be a source of a language
7407 if Name_Loc.Found then
7408 Error_Msg_File_1 := File_Name;
7412 "language unknown for {",
7417 -- Check if the same file name or unit is used in the prj tree
7419 Iter := For_Each_Source (In_Tree);
7422 Source := Prj.Element (Iter);
7423 exit when Source = No_Source;
7426 and then Source.Unit /= No_Unit_Index
7427 and then Source.Unit.Name = Unit
7429 ((Source.Kind = Spec and then Kind = Impl)
7431 (Source.Kind = Impl and then Kind = Spec))
7433 -- We found the "other_part (source)"
7437 elsif (Unit /= No_Name
7438 and then Source.Unit /= No_Unit_Index
7439 and then Source.Unit.Name = Unit
7443 (Source.Kind = Sep and then Kind = Impl)
7445 (Source.Kind = Impl and then Kind = Sep)))
7447 (Unit = No_Name and then Source.File = File_Name)
7449 -- Duplication of file/unit in same project is only
7450 -- allowed if order of source directories is known.
7452 if Project = Source.Project then
7453 if Unit = No_Name then
7454 if Allow_Duplicate_Basenames then
7456 elsif Project.Known_Order_Of_Source_Dirs then
7459 Error_Msg_File_1 := File_Name;
7461 (Project, In_Tree, "duplicate source file name {",
7467 if Project.Known_Order_Of_Source_Dirs then
7470 Error_Msg_Name_1 := Unit;
7472 (Project, In_Tree, "duplicate unit %%",
7478 -- Do not allow the same unit name in different projects,
7479 -- except if one is extending the other.
7481 -- For a file based language, the same file name replaces
7482 -- a file in a project being extended, but it is allowed
7483 -- to have the same file name in unrelated projects.
7485 elsif Is_Extending (Project, Source.Project) then
7486 Source_To_Replace := Source;
7488 elsif Unit /= No_Name
7489 and then not Source.Locally_Removed
7491 Error_Msg_Name_1 := Unit;
7494 "unit %% cannot belong to several projects",
7497 Error_Msg_Name_1 := Project.Name;
7498 Error_Msg_Name_2 := Name_Id (Path);
7500 (Project, In_Tree, "\ project %%, %%", No_Location);
7502 Error_Msg_Name_1 := Source.Project.Name;
7503 Error_Msg_Name_2 := Name_Id (Source.Path.Display_Name);
7505 (Project, In_Tree, "\ project %%, %%", No_Location);
7519 Lang_Id => Language,
7521 Alternate_Languages => Alternate_Languages,
7522 File_Name => File_Name,
7523 Display_File => Display_File_Name,
7525 Path => (Canonical_Path, Path),
7526 Source_To_Replace => Source_To_Replace);
7532 ------------------------
7533 -- Search_Directories --
7534 ------------------------
7536 procedure Search_Directories
7537 (Project : Project_Id;
7538 In_Tree : Project_Tree_Ref;
7539 For_All_Sources : Boolean;
7540 Allow_Duplicate_Basenames : Boolean)
7542 Source_Dir : String_List_Id;
7543 Element : String_Element;
7545 Name : String (1 .. 1_000);
7547 File_Name : File_Name_Type;
7548 Display_File_Name : File_Name_Type;
7551 if Current_Verbosity = High then
7552 Write_Line ("Looking for sources:");
7555 -- Loop through subdirectories
7557 Source_Dir := Project.Source_Dirs;
7558 while Source_Dir /= Nil_String loop
7560 Element := In_Tree.String_Elements.Table (Source_Dir);
7561 if Element.Value /= No_Name then
7562 Get_Name_String (Element.Display_Value);
7565 Source_Directory : constant String :=
7566 Name_Buffer (1 .. Name_Len) &
7567 Directory_Separator;
7569 Dir_Last : constant Natural :=
7570 Compute_Directory_Last
7574 if Current_Verbosity = High then
7575 Write_Attr ("Source_Dir", Source_Directory);
7578 -- We look to every entry in the source directory
7580 Open (Dir, Source_Directory);
7583 Read (Dir, Name, Last);
7587 -- ??? Duplicate system call here, we just did a
7588 -- a similar one. Maybe Ada.Directories would be more
7592 (Source_Directory & Name (1 .. Last))
7594 if Current_Verbosity = High then
7595 Write_Str (" Checking ");
7596 Write_Line (Name (1 .. Last));
7600 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
7601 Display_File_Name := Name_Find;
7603 if Osint.File_Names_Case_Sensitive then
7604 File_Name := Display_File_Name;
7606 Canonical_Case_File_Name
7607 (Name_Buffer (1 .. Name_Len));
7608 File_Name := Name_Find;
7612 Path_Name : constant String :=
7617 (Source_Directory'First ..
7620 Opt.Follow_Links_For_Files,
7621 Case_Sensitive => True);
7622 -- Case_Sensitive set True (no folding)
7624 Path : Path_Name_Type;
7626 Excluded_Sources_Htable.Get (File_Name);
7629 Name_Len := Path_Name'Length;
7630 Name_Buffer (1 .. Name_Len) := Path_Name;
7633 if FF /= No_File_Found then
7634 if not FF.Found then
7636 Excluded_Sources_Htable.Set (File_Name, FF);
7638 if Current_Verbosity = High then
7639 Write_Str (" excluded source """);
7640 Write_Str (Get_Name_String (File_Name));
7647 (Project => Project,
7650 File_Name => File_Name,
7651 Display_File_Name =>
7653 For_All_Sources => For_All_Sources,
7654 Allow_Duplicate_Basenames =>
7655 Allow_Duplicate_Basenames);
7666 when Directory_Error =>
7670 Source_Dir := Element.Next;
7673 if Current_Verbosity = High then
7674 Write_Line ("end Looking for sources.");
7676 end Search_Directories;
7678 ----------------------------
7679 -- Load_Naming_Exceptions --
7680 ----------------------------
7682 procedure Load_Naming_Exceptions
7683 (Project : Project_Id;
7684 In_Tree : Project_Tree_Ref)
7687 Iter : Source_Iterator;
7690 Unit_Exceptions.Reset;
7692 Iter := For_Each_Source (In_Tree, Project);
7694 Source := Prj.Element (Iter);
7695 exit when Source = No_Source;
7697 -- An excluded file cannot also be an exception file name
7699 if Excluded_Sources_Htable.Get (Source.File) /= No_File_Found then
7700 Error_Msg_File_1 := Source.File;
7703 "{ cannot be both excluded and an exception file name",
7707 if Current_Verbosity = High then
7708 Write_Str ("Naming exception: Putting source file ");
7709 Write_Str (Get_Name_String (Source.File));
7710 Write_Line (" in Source_Names");
7716 (Name => Source.File,
7717 Location => No_Location,
7719 Except => Source.Unit /= No_Unit_Index,
7722 -- If this is an Ada exception, record in table Unit_Exceptions
7724 if Source.Unit /= No_Unit_Index then
7726 Unit_Except : Unit_Exception :=
7727 Unit_Exceptions.Get (Source.Unit.Name);
7730 Unit_Except.Name := Source.Unit.Name;
7732 if Source.Kind = Spec then
7733 Unit_Except.Spec := Source.File;
7735 Unit_Except.Impl := Source.File;
7738 Unit_Exceptions.Set (Source.Unit.Name, Unit_Except);
7744 end Load_Naming_Exceptions;
7746 ----------------------
7747 -- Look_For_Sources --
7748 ----------------------
7750 procedure Look_For_Sources
7751 (Project : Project_Id;
7752 In_Tree : Project_Tree_Ref;
7753 Proc_Data : in out Processing_Data;
7754 Allow_Duplicate_Basenames : Boolean)
7756 Iter : Source_Iterator;
7758 procedure Process_Sources_In_Multi_Language_Mode;
7759 -- Find all source files when in multi language mode
7761 procedure Mark_Excluded_Sources;
7762 -- Mark as such the sources that are declared as excluded
7764 ---------------------------
7765 -- Mark_Excluded_Sources --
7766 ---------------------------
7768 procedure Mark_Excluded_Sources is
7769 Source : Source_Id := No_Source;
7771 Excluded : File_Found;
7774 Excluded := Excluded_Sources_Htable.Get_First;
7775 while Excluded /= No_File_Found loop
7778 -- ??? Don't we have a hash table to map files to Source_Id?
7780 Iter := For_Each_Source (In_Tree);
7782 Source := Prj.Element (Iter);
7783 exit when Source = No_Source;
7785 if Source.File = Excluded.File then
7786 if Source.Project = Project
7787 or else Is_Extending (Project, Source.Project)
7790 Source.Locally_Removed := True;
7791 Source.In_Interfaces := False;
7793 if Current_Verbosity = High then
7794 Write_Str ("Removing file ");
7795 Write_Line (Get_Name_String (Excluded.File));
7801 "cannot remove a source from another project",
7811 OK := OK or Excluded.Found;
7814 Err_Vars.Error_Msg_File_1 := Excluded.File;
7816 (Project, In_Tree, "unknown file {", Excluded.Location);
7819 Excluded := Excluded_Sources_Htable.Get_Next;
7821 end Mark_Excluded_Sources;
7823 --------------------------------------------
7824 -- Process_Sources_In_Multi_Language_Mode --
7825 --------------------------------------------
7827 procedure Process_Sources_In_Multi_Language_Mode is
7828 Iter : Source_Iterator;
7831 -- Check that two sources of this project do not have the same object
7834 Check_Object_File_Names : declare
7836 Source_Name : File_Name_Type;
7838 procedure Check_Object (Src : Source_Id);
7839 -- Check if object file name of the current source is already in
7840 -- hash table Object_File_Names. If it is, report an error. If it
7841 -- is not, put it there with the file name of the current source.
7847 procedure Check_Object (Src : Source_Id) is
7849 Source_Name := Object_File_Names.Get (Src.Object);
7851 if Source_Name /= No_File then
7852 Error_Msg_File_1 := Src.File;
7853 Error_Msg_File_2 := Source_Name;
7857 "{ and { have the same object file name",
7861 Object_File_Names.Set (Src.Object, Src.File);
7865 -- Start of processing for Check_Object_File_Names
7868 Object_File_Names.Reset;
7869 Iter := For_Each_Source (In_Tree);
7871 Src_Id := Prj.Element (Iter);
7872 exit when Src_Id = No_Source;
7874 if Is_Compilable (Src_Id)
7875 and then Src_Id.Language.Config.Object_Generated
7876 and then Is_Extending (Project, Src_Id.Project)
7878 if Src_Id.Unit = No_Unit_Index then
7879 if Src_Id.Kind = Impl then
7880 Check_Object (Src_Id);
7886 if Other_Part (Src_Id) = No_Source then
7887 Check_Object (Src_Id);
7894 if Other_Part (Src_Id) /= No_Source then
7895 Check_Object (Src_Id);
7898 -- Check if it is a subunit
7901 Src_Ind : constant Source_File_Index :=
7902 Sinput.P.Load_Project_File
7904 (Src_Id.Path.Name));
7906 if Sinput.P.Source_File_Is_Subunit
7909 Override_Kind (Src_Id, Sep);
7911 Check_Object (Src_Id);
7921 end Check_Object_File_Names;
7922 end Process_Sources_In_Multi_Language_Mode;
7924 -- Start of processing for Look_For_Sources
7928 Find_Excluded_Sources (Project, In_Tree);
7930 if (Get_Mode = Ada_Only and then Is_A_Language (Project, Name_Ada))
7931 or else (Get_Mode = Multi_Language
7932 and then Project.Languages /= No_Language_Index)
7934 if Get_Mode = Multi_Language then
7935 Load_Naming_Exceptions (Project, In_Tree);
7938 Find_Sources (Project, In_Tree, Proc_Data, Allow_Duplicate_Basenames);
7939 Mark_Excluded_Sources;
7941 if Get_Mode = Multi_Language then
7942 Process_Sources_In_Multi_Language_Mode;
7945 end Look_For_Sources;
7951 function Path_Name_Of
7952 (File_Name : File_Name_Type;
7953 Directory : Path_Name_Type) return String
7955 Result : String_Access;
7956 The_Directory : constant String := Get_Name_String (Directory);
7959 Get_Name_String (File_Name);
7962 (File_Name => Name_Buffer (1 .. Name_Len),
7963 Path => The_Directory);
7965 if Result = null then
7969 R : String := Result.all;
7972 Canonical_Case_File_Name (R);
7978 -----------------------------------
7979 -- Prepare_Ada_Naming_Exceptions --
7980 -----------------------------------
7982 procedure Prepare_Ada_Naming_Exceptions
7983 (List : Array_Element_Id;
7984 In_Tree : Project_Tree_Ref;
7985 Kind : Spec_Or_Body)
7987 Current : Array_Element_Id;
7988 Element : Array_Element;
7992 -- Traverse the list
7995 while Current /= No_Array_Element loop
7996 Element := In_Tree.Array_Elements.Table (Current);
7998 if Element.Index /= No_Name then
8001 Unit => Element.Index,
8002 Next => No_Ada_Naming_Exception);
8003 Reverse_Ada_Naming_Exceptions.Set
8004 (Unit, (Element.Value.Value, Element.Value.Index));
8006 Ada_Naming_Exceptions.Get (File_Name_Type (Element.Value.Value));
8007 Ada_Naming_Exception_Table.Increment_Last;
8008 Ada_Naming_Exception_Table.Table
8009 (Ada_Naming_Exception_Table.Last) := Unit;
8010 Ada_Naming_Exceptions.Set
8011 (File_Name_Type (Element.Value.Value),
8012 Ada_Naming_Exception_Table.Last);
8015 Current := Element.Next;
8017 end Prepare_Ada_Naming_Exceptions;
8019 -----------------------
8020 -- Record_Ada_Source --
8021 -----------------------
8023 procedure Record_Ada_Source
8024 (File_Name : File_Name_Type;
8025 Path_Name : Path_Name_Type;
8026 Project : Project_Id;
8027 In_Tree : Project_Tree_Ref;
8028 Proc_Data : in out Processing_Data;
8029 Ada_Language : Language_Ptr;
8030 Location : Source_Ptr;
8031 Source_Recorded : in out Boolean)
8033 Canonical_File : File_Name_Type;
8034 Canonical_Path : Path_Name_Type;
8036 File_Recorded : Boolean := False;
8037 -- True when at least one file has been recorded
8039 procedure Record_Unit
8040 (Unit_Name : Name_Id;
8041 Unit_Ind : Int := 0;
8042 Unit_Kind : Spec_Or_Body;
8043 Needs_Pragma : Boolean);
8044 -- Register of the units contained in the source file (there is in
8045 -- general a single such unit except when exceptions to the naming
8046 -- scheme indicate there are several such units)
8052 procedure Record_Unit
8053 (Unit_Name : Name_Id;
8054 Unit_Ind : Int := 0;
8055 Unit_Kind : Spec_Or_Body;
8056 Needs_Pragma : Boolean)
8058 UData : constant Unit_Index :=
8059 Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
8060 -- ??? Add_Source will look it up again, can we do that only once ?
8063 To_Record : Boolean := False;
8064 The_Location : Source_Ptr := Location;
8065 Unit_Prj : Project_Id;
8068 if Current_Verbosity = High then
8069 Write_Str (" Putting ");
8070 Write_Str (Get_Name_String (Unit_Name));
8071 Write_Line (" in the unit list.");
8074 -- The unit is already in the list, but may be it is only the other
8075 -- unit kind (spec or body), or what is in the unit list is a unit of
8076 -- a project we are extending.
8078 if UData /= No_Unit_Index then
8079 if UData.File_Names (Unit_Kind) = null
8081 (UData.File_Names (Unit_Kind).File = Canonical_File
8082 and then UData.File_Names (Unit_Kind).Locally_Removed)
8083 or else Is_Extending
8084 (Project.Extends, UData.File_Names (Unit_Kind).Project)
8088 -- If the same file is already in the list, do not add it again
8090 elsif UData.File_Names (Unit_Kind).Project = Project
8092 (Project.Known_Order_Of_Source_Dirs
8094 UData.File_Names (Unit_Kind).Path.Name = Canonical_Path)
8098 -- Else, same unit but not same file => It is an error to have two
8099 -- units with the same name and the same kind (spec or body).
8102 if The_Location = No_Location then
8103 The_Location := Project.Location;
8106 Err_Vars.Error_Msg_Name_1 := Unit_Name;
8108 (Project, In_Tree, "duplicate unit %%", The_Location);
8110 Err_Vars.Error_Msg_Name_1 :=
8111 UData.File_Names (Unit_Kind).Project.Name;
8112 Err_Vars.Error_Msg_File_1 :=
8113 File_Name_Type (UData.File_Names (Unit_Kind).Path.Name);
8116 "\ project file %%, {", The_Location);
8118 Err_Vars.Error_Msg_Name_1 := Project.Name;
8119 Err_Vars.Error_Msg_File_1 := File_Name_Type (Canonical_Path);
8121 (Project, In_Tree, "\ project file %%, {", The_Location);
8126 -- It is a new unit, create a new record
8129 -- First, check if there is no other unit with this file name in
8130 -- another project. If it is, report error but note we do that
8131 -- only for the first unit in the source file.
8133 Unit_Prj := Files_Htable.Get (Proc_Data.Units, Canonical_File);
8135 if not File_Recorded
8136 and then Unit_Prj /= No_Project
8138 Error_Msg_File_1 := File_Name;
8139 Error_Msg_Name_1 := Unit_Prj.Name;
8142 "{ is already a source of project %%",
8151 Files_Htable.Set (Proc_Data.Units, Canonical_File, Project);
8156 Lang_Id => Ada_Language,
8157 File_Name => Canonical_File,
8158 Display_File => File_Name,
8160 Path => (Canonical_Path, Path_Name),
8161 Naming_Exception => Needs_Pragma,
8164 Source_Recorded := True;
8168 Exception_Id : Ada_Naming_Exception_Id;
8169 Unit_Name : Name_Id;
8170 Unit_Kind : Spec_Or_Body;
8171 Unit_Ind : Int := 0;
8173 Name_Index : Name_And_Index;
8174 Except_Name : Name_And_Index := No_Name_And_Index;
8175 Needs_Pragma : Boolean;
8178 Canonical_File := Canonical_Case_File_Name (Name_Id (File_Name));
8180 Path_Name_Type (Canonical_Case_File_Name (Name_Id (Path_Name)));
8182 -- Check the naming scheme to get extra file properties
8185 (In_Tree => In_Tree,
8186 Canonical_File_Name => Canonical_File,
8188 Exception_Id => Exception_Id,
8189 Unit_Name => Unit_Name,
8190 Unit_Kind => Unit_Kind);
8192 Needs_Pragma := Exception_Id /= No_Ada_Naming_Exception;
8194 if Exception_Id = No_Ada_Naming_Exception
8195 and then Unit_Name = No_Name
8197 if Current_Verbosity = High then
8199 Write_Str (Get_Name_String (Canonical_File));
8200 Write_Line (""" is not a valid source file name (ignored).");
8205 -- Check to see if the source has been hidden by an exception,
8206 -- but only if it is not an exception.
8208 if not Needs_Pragma then
8210 Reverse_Ada_Naming_Exceptions.Get
8211 ((Unit_Kind, Unit_Name, No_Ada_Naming_Exception));
8213 if Except_Name /= No_Name_And_Index then
8214 if Current_Verbosity = High then
8216 Write_Str (Get_Name_String (Canonical_File));
8217 Write_Str (""" contains a unit that is found in """);
8218 Write_Str (Get_Name_String (Except_Name.Name));
8219 Write_Line (""" (ignored).");
8222 -- The file is not included in the source of the project since it
8223 -- is hidden by the exception. So, nothing else to do.
8229 -- The following loop registers the unit in the appropriate table. It
8230 -- will be executed multiple times when the file is a multi-unit file,
8231 -- in which case Exception_Id initially points to the first file and
8232 -- then to each other unit in the file.
8235 if Exception_Id /= No_Ada_Naming_Exception then
8236 Info := Ada_Naming_Exception_Table.Table (Exception_Id);
8237 Exception_Id := Info.Next;
8238 Info.Next := No_Ada_Naming_Exception;
8239 Name_Index := Reverse_Ada_Naming_Exceptions.Get (Info);
8241 Unit_Name := Info.Unit;
8242 Unit_Ind := Name_Index.Index;
8243 Unit_Kind := Info.Kind;
8246 Record_Unit (Unit_Name, Unit_Ind, Unit_Kind, Needs_Pragma);
8247 File_Recorded := True;
8249 exit when Exception_Id = No_Ada_Naming_Exception;
8251 end Record_Ada_Source;
8257 procedure Remove_Source
8259 Replaced_By : Source_Id)
8264 if Current_Verbosity = High then
8265 Write_Str ("Removing source ");
8266 Write_Line (Get_Name_String (Id.File));
8269 if Replaced_By /= No_Source then
8270 Id.Replaced_By := Replaced_By;
8271 Replaced_By.Declared_In_Interfaces := Id.Declared_In_Interfaces;
8274 Source := Id.Language.First_Source;
8277 Id.Language.First_Source := Id.Next_In_Lang;
8280 while Source.Next_In_Lang /= Id loop
8281 Source := Source.Next_In_Lang;
8284 Source.Next_In_Lang := Id.Next_In_Lang;
8288 -----------------------
8289 -- Report_No_Sources --
8290 -----------------------
8292 procedure Report_No_Sources
8293 (Project : Project_Id;
8295 In_Tree : Project_Tree_Ref;
8296 Location : Source_Ptr;
8297 Continuation : Boolean := False)
8300 case When_No_Sources is
8304 when Warning | Error =>
8306 Msg : constant String :=
8309 " sources in this project";
8312 Error_Msg_Warn := When_No_Sources = Warning;
8314 if Continuation then
8315 Error_Msg (Project, In_Tree, "\" & Msg, Location);
8317 Error_Msg (Project, In_Tree, Msg, Location);
8321 end Report_No_Sources;
8323 ----------------------
8324 -- Show_Source_Dirs --
8325 ----------------------
8327 procedure Show_Source_Dirs
8328 (Project : Project_Id;
8329 In_Tree : Project_Tree_Ref)
8331 Current : String_List_Id;
8332 Element : String_Element;
8335 Write_Line ("Source_Dirs:");
8337 Current := Project.Source_Dirs;
8338 while Current /= Nil_String loop
8339 Element := In_Tree.String_Elements.Table (Current);
8341 Write_Line (Get_Name_String (Element.Value));
8342 Current := Element.Next;
8345 Write_Line ("end Source_Dirs.");
8346 end Show_Source_Dirs;
8348 -------------------------
8349 -- Warn_If_Not_Sources --
8350 -------------------------
8352 -- comments needed in this body ???
8354 procedure Warn_If_Not_Sources
8355 (Project : Project_Id;
8356 In_Tree : Project_Tree_Ref;
8357 Conventions : Array_Element_Id;
8359 Extending : Boolean)
8361 Conv : Array_Element_Id;
8363 The_Unit_Data : Unit_Index;
8364 Location : Source_Ptr;
8367 Conv := Conventions;
8368 while Conv /= No_Array_Element loop
8369 Unit := In_Tree.Array_Elements.Table (Conv).Index;
8370 Error_Msg_Name_1 := Unit;
8371 Get_Name_String (Unit);
8372 To_Lower (Name_Buffer (1 .. Name_Len));
8374 The_Unit_Data := Units_Htable.Get (In_Tree.Units_HT, Unit);
8375 Location := In_Tree.Array_Elements.Table (Conv).Value.Location;
8377 if The_Unit_Data = No_Unit_Index then
8378 Error_Msg (Project, In_Tree, "?unknown unit %%", Location);
8382 In_Tree.Array_Elements.Table (Conv).Value.Value;
8385 if not Check_Project
8386 (The_Unit_Data.File_Names (Spec).Project,
8391 "?source of spec of unit %% (%%)" &
8392 " not found in this project",
8397 if The_Unit_Data.File_Names (Impl) = null
8398 or else not Check_Project
8399 (The_Unit_Data.File_Names (Impl).Project,
8404 "?source of body of unit %% (%%)" &
8405 " not found in this project",
8411 Conv := In_Tree.Array_Elements.Table (Conv).Next;
8413 end Warn_If_Not_Sources;