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;
35 with Osint; use Osint;
36 with Output; use Output;
37 with Prj.Env; use Prj.Env;
39 with Prj.Util; use Prj.Util;
41 with Snames; use Snames;
42 with Table; use Table;
43 with Targparm; use Targparm;
45 with Ada.Characters.Handling; use Ada.Characters.Handling;
46 with Ada.Directories; use Ada.Directories;
47 with Ada.Strings; use Ada.Strings;
48 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
49 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
51 package body Prj.Nmsc is
53 No_Continuation_String : aliased String := "";
54 Continuation_String : aliased String := "\";
55 -- Used in Check_Library for continuation error messages at the same
58 Error_Report : Put_Line_Access := null;
59 -- Set to point to error reporting procedure
61 When_No_Sources : Error_Warning := Error;
62 -- Indicates what should be done when there is no Ada sources in a non
63 -- extending Ada project.
65 ALI_Suffix : constant String := ".ali";
66 -- File suffix for ali files
68 type Name_Location is record
69 Name : File_Name_Type;
70 Location : Source_Ptr;
71 Source : Source_Id := No_Source;
72 Except : Boolean := False;
73 Found : Boolean := False;
75 -- Information about file names found in string list attribute:
76 -- Source_Files or in a source list file, stored in hash table.
77 -- Source_Names, used by procedure Get_Path_Names_And_Record_Sources.
78 -- Except is set to True if source is a naming exception in the project.
80 No_Name_Location : constant Name_Location :=
82 Location => No_Location,
87 package Source_Names is new GNAT.HTable.Simple_HTable
88 (Header_Num => Header_Num,
89 Element => Name_Location,
90 No_Element => No_Name_Location,
91 Key => File_Name_Type,
94 -- Hash table to store file names found in string list attribute
95 -- Source_Files or in a source list file, stored in hash table
96 -- Source_Names, used by procedure Get_Path_Names_And_Record_Sources.
98 -- More documentation needed on what unit exceptions are about ???
100 type Unit_Exception is record
102 Spec : File_Name_Type;
103 Impl : File_Name_Type;
105 -- Record special naming schemes for Ada units (name of spec file and name
106 -- of implementation file).
108 No_Unit_Exception : constant Unit_Exception :=
113 package Unit_Exceptions is new GNAT.HTable.Simple_HTable
114 (Header_Num => Header_Num,
115 Element => Unit_Exception,
116 No_Element => No_Unit_Exception,
120 -- Hash table to store the unit exceptions.
121 -- ??? Seems to be used only by the multi_lang mode
122 -- ??? Should not be a global array, but stored in the project_data
124 package Recursive_Dirs is new GNAT.HTable.Simple_HTable
125 (Header_Num => Header_Num,
131 -- Hash table to store recursive source directories, to avoid looking
132 -- several times, and to avoid cycles that may be introduced by symbolic
135 type Ada_Naming_Exception_Id is new Nat;
136 No_Ada_Naming_Exception : constant Ada_Naming_Exception_Id := 0;
138 type Unit_Info is record
141 Next : Ada_Naming_Exception_Id := No_Ada_Naming_Exception;
145 package Ada_Naming_Exception_Table is new Table.Table
146 (Table_Component_Type => Unit_Info,
147 Table_Index_Type => Ada_Naming_Exception_Id,
148 Table_Low_Bound => 1,
150 Table_Increment => 100,
151 Table_Name => "Prj.Nmsc.Ada_Naming_Exception_Table");
153 package Ada_Naming_Exceptions is new GNAT.HTable.Simple_HTable
154 (Header_Num => Header_Num,
155 Element => Ada_Naming_Exception_Id,
156 No_Element => No_Ada_Naming_Exception,
157 Key => File_Name_Type,
160 -- A hash table to store naming exceptions for Ada. For each file name
161 -- there is one or several unit in table Ada_Naming_Exception_Table.
162 -- ??? This is for ada_only mode, we should be able to merge with
163 -- Unit_Exceptions table, used by multi_lang mode.
165 package Object_File_Names is new GNAT.HTable.Simple_HTable
166 (Header_Num => Header_Num,
167 Element => File_Name_Type,
168 No_Element => No_File,
169 Key => File_Name_Type,
172 -- A hash table to store the object file names for a project, to check that
173 -- two different sources have different object file names.
175 type File_Found is record
176 File : File_Name_Type := No_File;
177 Found : Boolean := False;
178 Location : Source_Ptr := No_Location;
180 No_File_Found : constant File_Found := (No_File, False, No_Location);
181 -- Comments needed ???
183 package Excluded_Sources_Htable is new GNAT.HTable.Simple_HTable
184 (Header_Num => Header_Num,
185 Element => File_Found,
186 No_Element => No_File_Found,
187 Key => File_Name_Type,
190 -- A hash table to store the excluded files, if any. This is filled by
191 -- Find_Excluded_Sources below.
193 procedure Find_Excluded_Sources
194 (Project : Project_Id;
195 In_Tree : Project_Tree_Ref;
196 Data : Project_Data);
197 -- Find the list of files that should not be considered as source files
198 -- for this project. Sets the list in the Excluded_Sources_Htable.
200 function Hash (Unit : Unit_Info) return Header_Num;
202 type Name_And_Index is record
203 Name : Name_Id := No_Name;
206 No_Name_And_Index : constant Name_And_Index :=
207 (Name => No_Name, Index => 0);
209 package Reverse_Ada_Naming_Exceptions is new GNAT.HTable.Simple_HTable
210 (Header_Num => Header_Num,
211 Element => Name_And_Index,
212 No_Element => No_Name_And_Index,
216 -- A table to check if a unit with an exceptional name will hide a source
217 -- with a file name following the naming convention.
219 procedure Load_Naming_Exceptions
220 (Project : Project_Id;
221 In_Tree : Project_Tree_Ref;
222 Data : in out Project_Data);
223 -- All source files in Data.First_Source are considered as naming
224 -- exceptions, and copied into the Source_Names and Unit_Exceptions tables
229 Data : in out Project_Data;
230 In_Tree : Project_Tree_Ref;
231 Project : Project_Id;
233 Lang_Id : Language_Index;
235 File_Name : File_Name_Type;
236 Display_File : File_Name_Type;
237 Lang_Kind : Language_Kind;
238 Naming_Exception : Boolean := False;
239 Path : Path_Name_Type := No_Path;
240 Display_Path : Path_Name_Type := No_Path;
241 Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
242 Other_Part : Source_Id := No_Source;
243 Unit : Name_Id := No_Name;
245 Source_To_Replace : Source_Id := No_Source);
246 -- Add a new source to the different lists: list of all sources in the
247 -- project tree, list of source of a project and list of sources of a
250 -- If Path is specified, the file is also added to Source_Paths_HT.
251 -- If Source_To_Replace is specified, it points to the source in the
252 -- extended project that the new file is overriding.
254 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type;
255 -- Same as Osint.Canonical_Case_File_Name but applies to Name_Id.
256 -- This alters Name_Buffer
258 function Suffix_Matches
260 Suffix : File_Name_Type) return Boolean;
261 -- True if the filename ends with the given suffix. It always returns False
262 -- if Suffix is No_Name
264 procedure Replace_Into_Name_Buffer
267 Replacement : Character);
268 -- Copy Str into Name_Buffer, replacing Pattern with Replacement. Str is
269 -- converted to lower-case at the same time.
271 function ALI_File_Name (Source : String) return String;
272 -- Return the ALI file name corresponding to a source
274 procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
275 -- Check that a name is a valid Ada unit name
277 procedure Check_Naming_Schemes
278 (Data : in out Project_Data;
279 Project : Project_Id;
280 In_Tree : Project_Tree_Ref);
281 -- Check the naming scheme part of Data
283 procedure Check_Configuration
284 (Project : Project_Id;
285 In_Tree : Project_Tree_Ref;
286 Data : in out Project_Data);
287 -- Check the configuration attributes for the project
289 procedure Check_If_Externally_Built
290 (Project : Project_Id;
291 In_Tree : Project_Tree_Ref;
292 Data : in out Project_Data);
293 -- Check attribute Externally_Built of project Project in project tree
294 -- In_Tree and modify its data Data if it has the value "true".
296 procedure Check_Interfaces
297 (Project : Project_Id;
298 In_Tree : Project_Tree_Ref;
299 Data : in out Project_Data);
300 -- If a list of sources is specified in attribute Interfaces, set
301 -- In_Interfaces only for the sources specified in the list.
303 procedure Check_Library_Attributes
304 (Project : Project_Id;
305 In_Tree : Project_Tree_Ref;
306 Current_Dir : String;
307 Data : in out Project_Data);
308 -- Check the library attributes of project Project in project tree In_Tree
309 -- and modify its data Data accordingly.
310 -- Current_Dir should represent the current directory, and is passed for
311 -- efficiency to avoid system calls to recompute it.
313 procedure Check_Package_Naming
314 (Project : Project_Id;
315 In_Tree : Project_Tree_Ref;
316 Data : in out Project_Data);
317 -- Check package Naming of project Project in project tree In_Tree and
318 -- modify its data Data accordingly.
320 procedure Check_Programming_Languages
321 (In_Tree : Project_Tree_Ref;
322 Project : Project_Id;
323 Data : in out Project_Data);
324 -- Check attribute Languages for the project with data Data in project
325 -- tree In_Tree and set the components of Data for all the programming
326 -- languages indicated in attribute Languages, if any.
328 function Check_Project
330 Root_Project : Project_Id;
331 In_Tree : Project_Tree_Ref;
332 Extending : Boolean) return Boolean;
333 -- Returns True if P is Root_Project or, if Extending is True, a project
334 -- extended by Root_Project.
336 procedure Check_Stand_Alone_Library
337 (Project : Project_Id;
338 In_Tree : Project_Tree_Ref;
339 Data : in out Project_Data;
340 Current_Dir : String;
341 Extending : Boolean);
342 -- Check if project Project in project tree In_Tree is a Stand-Alone
343 -- Library project, and modify its data Data accordingly if it is one.
344 -- Current_Dir should represent the current directory, and is passed for
345 -- efficiency to avoid system calls to recompute it.
347 procedure Check_And_Normalize_Unit_Names
348 (Project : Project_Id;
349 In_Tree : Project_Tree_Ref;
350 List : Array_Element_Id;
351 Debug_Name : String);
352 -- Check that a list of unit names contains only valid names. Casing
353 -- is normalized where appropriate.
354 -- Debug_Name is the name representing the list, and is used for debug
357 procedure Get_Path_Names_And_Record_Ada_Sources
358 (Project : Project_Id;
359 In_Tree : Project_Tree_Ref;
360 Data : in out Project_Data;
361 Current_Dir : String);
362 -- Find the path names of the source files in the Source_Names table
363 -- in the source directories and record those that are Ada sources.
365 function Get_Language_Processing_From_Lang
366 (In_Tree : Project_Tree_Ref;
368 Lang : Name_List_Index) return Language_Index;
369 -- Return the language_processing description associated for the given
372 function Compute_Directory_Last (Dir : String) return Natural;
373 -- Return the index of the last significant character in Dir. This is used
374 -- to avoid duplicate '/' (slash) characters at the end of directory names.
377 (Project : Project_Id;
378 In_Tree : Project_Tree_Ref;
380 Flag_Location : Source_Ptr);
381 -- Output an error message. If Error_Report is null, simply call
382 -- Prj.Err.Error_Msg. Otherwise, disregard Flag_Location and use
385 procedure Find_Ada_Sources
386 (Project : Project_Id;
387 In_Tree : Project_Tree_Ref;
388 Data : in out Project_Data;
389 Current_Dir : String);
390 -- Find all the Ada sources in all of the source directories of a project
391 -- Current_Dir should represent the current directory, and is passed for
392 -- efficiency to avoid system calls to recompute it.
394 procedure Search_Directories
395 (Project : Project_Id;
396 In_Tree : Project_Tree_Ref;
397 Data : in out Project_Data;
398 For_All_Sources : Boolean);
399 -- Search the source directories to find the sources.
400 -- If For_All_Sources is True, check each regular file name against the
401 -- naming schemes of the different languages. Otherwise consider only the
402 -- file names in the hash table Source_Names.
405 (Project : Project_Id;
406 In_Tree : Project_Tree_Ref;
407 Data : in out Project_Data;
409 File_Name : File_Name_Type;
410 Display_File_Name : File_Name_Type;
411 Source_Directory : String;
412 For_All_Sources : Boolean);
413 -- Check if file File_Name is a valid source of the project. This is used
414 -- in multi-language mode only.
415 -- When the file matches one of the naming schemes, it is added to
416 -- various htables through Add_Source and to Source_Paths_Htable.
418 -- Name is the name of the candidate file. It hasn't been normalized yet
419 -- and is the direct result of readdir().
421 -- File_Name is the same as Name, but has been normalized.
422 -- Display_File_Name, however, has not been normalized.
424 -- Source_Directory is the directory in which the file
425 -- was found. It hasn't been normalized (nor has had links resolved).
426 -- It should not end with a directory separator, to avoid duplicates
429 -- If For_All_Sources is True, then all possible file names are analyzed
430 -- otherwise only those currently set in the Source_Names htable.
432 procedure Check_File_Naming_Schemes
433 (In_Tree : Project_Tree_Ref;
434 Data : in out Project_Data;
435 File_Name : File_Name_Type;
436 Alternate_Languages : out Alternate_Language_Id;
437 Language : out Language_Index;
438 Language_Name : out Name_Id;
439 Display_Language_Name : out Name_Id;
441 Lang_Kind : out Language_Kind;
442 Kind : out Source_Kind);
443 -- Check if the file name File_Name conforms to one of the naming
444 -- schemes of the project.
446 -- If the file does not match one of the naming schemes, set Language
447 -- to No_Language_Index.
449 -- Filename is the name of the file being investigated. It has been
450 -- normalized (case-folded). File_Name is the same value.
452 procedure Free_Ada_Naming_Exceptions;
453 -- Free the internal hash tables used for checking naming exceptions
455 procedure Get_Directories
456 (Project : Project_Id;
457 In_Tree : Project_Tree_Ref;
458 Current_Dir : String;
459 Data : in out Project_Data);
460 -- Get the object directory, the exec directory and the source directories
463 -- Current_Dir should represent the current directory, and is passed for
464 -- efficiency to avoid system calls to recompute it.
467 (Project : Project_Id;
468 In_Tree : Project_Tree_Ref;
469 Data : in out Project_Data);
470 -- Get the mains of a project from attribute Main, if it exists, and put
471 -- them in the project data.
473 procedure Get_Sources_From_File
475 Location : Source_Ptr;
476 Project : Project_Id;
477 In_Tree : Project_Tree_Ref);
478 -- Get the list of sources from a text file and put them in hash table
481 procedure Find_Explicit_Sources
482 (Current_Dir : String;
483 Project : Project_Id;
484 In_Tree : Project_Tree_Ref;
485 Data : in out Project_Data);
486 -- Process the Source_Files and Source_List_File attributes, and store
487 -- the list of source files into the Source_Names htable.
489 -- Lang indicates which language is being processed when in Ada_Only mode
490 -- (all languages are processed anyway when in Multi_Language mode).
492 procedure Compute_Unit_Name
493 (File_Name : File_Name_Type;
494 Dot_Replacement : File_Name_Type;
495 Separate_Suffix : File_Name_Type;
496 Body_Suffix : File_Name_Type;
497 Spec_Suffix : File_Name_Type;
498 Casing : Casing_Type;
499 Kind : out Source_Kind;
501 -- Check whether the file matches the naming scheme. If it does,
502 -- compute its unit name. If Unit is set to No_Name on exit, none of the
503 -- other out parameters are relevant.
506 (In_Tree : Project_Tree_Ref;
507 Canonical_File_Name : File_Name_Type;
508 Naming : Naming_Data;
509 Exception_Id : out Ada_Naming_Exception_Id;
510 Unit_Name : out Name_Id;
511 Unit_Kind : out Spec_Or_Body;
512 Needs_Pragma : out Boolean);
513 -- Find out, from a file name, the unit name, the unit kind and if a
514 -- specific SFN pragma is needed. If the file name corresponds to no unit,
515 -- then Unit_Name will be No_Name. If the file is a multi-unit source or an
516 -- exception to the naming scheme, then Exception_Id is set to the unit or
517 -- units that the source contains.
519 function Is_Illegal_Suffix
520 (Suffix : File_Name_Type;
521 Dot_Replacement : File_Name_Type) return Boolean;
522 -- Returns True if the string Suffix cannot be used as a spec suffix, a
523 -- body suffix or a separate suffix.
525 procedure Locate_Directory
526 (Project : Project_Id;
527 In_Tree : Project_Tree_Ref;
528 Name : File_Name_Type;
529 Parent : Path_Name_Type;
530 Dir : out Path_Name_Type;
531 Display : out Path_Name_Type;
532 Create : String := "";
533 Current_Dir : String;
534 Location : Source_Ptr := No_Location;
535 Externally_Built : Boolean := False);
536 -- Locate a directory. Name is the directory name. Parent is the root
537 -- directory, if Name a relative path name. Dir is set to the canonical
538 -- case path name of the directory, and Display is the directory path name
539 -- for display purposes. If the directory does not exist and Setup_Projects
540 -- is True and Create is a non null string, an attempt is made to create
541 -- the directory. If the directory does not exist and Setup_Projects is
542 -- false, then Dir and Display are set to No_Name.
544 -- Current_Dir should represent the current directory, and is passed for
545 -- efficiency to avoid system calls to recompute it.
547 procedure Look_For_Sources
548 (Project : Project_Id;
549 In_Tree : Project_Tree_Ref;
550 Data : in out Project_Data;
551 Current_Dir : String);
552 -- Find all the sources of project Project in project tree In_Tree and
553 -- update its Data accordingly. This assumes that Data.First_Source has
554 -- been initialized with the list of excluded sources and special naming
557 -- Current_Dir should represent the current directory, and is passed for
558 -- efficiency to avoid system calls to recompute it.
560 function Path_Name_Of
561 (File_Name : File_Name_Type;
562 Directory : Path_Name_Type) return String;
563 -- Returns the path name of a (non project) file. Returns an empty string
564 -- if file cannot be found.
566 procedure Prepare_Ada_Naming_Exceptions
567 (List : Array_Element_Id;
568 In_Tree : Project_Tree_Ref;
569 Kind : Spec_Or_Body);
570 -- Prepare the internal hash tables used for checking naming exceptions
571 -- for Ada. Insert all elements of List in the tables.
573 procedure Record_Ada_Source
574 (File_Name : File_Name_Type;
575 Path_Name : Path_Name_Type;
576 Project : Project_Id;
577 In_Tree : Project_Tree_Ref;
578 Data : in out Project_Data;
579 Location : Source_Ptr;
580 Current_Source : in out String_List_Id;
581 Source_Recorded : in out Boolean;
582 Current_Dir : String);
583 -- Put a unit in the list of units of a project, if the file name
584 -- corresponds to a valid unit name.
586 -- Current_Dir should represent the current directory, and is passed for
587 -- efficiency to avoid system calls to recompute it.
589 procedure Remove_Source
591 Replaced_By : Source_Id;
592 Project : Project_Id;
593 Data : in out Project_Data;
594 In_Tree : Project_Tree_Ref);
597 procedure Report_No_Sources
598 (Project : Project_Id;
600 In_Tree : Project_Tree_Ref;
601 Location : Source_Ptr;
602 Continuation : Boolean := False);
603 -- Report an error or a warning depending on the value of When_No_Sources
604 -- when there are no sources for language Lang_Name.
606 procedure Show_Source_Dirs
607 (Data : Project_Data; In_Tree : Project_Tree_Ref);
608 -- List all the source directories of a project
610 procedure Warn_If_Not_Sources
611 (Project : Project_Id;
612 In_Tree : Project_Tree_Ref;
613 Conventions : Array_Element_Id;
615 Extending : Boolean);
616 -- Check that individual naming conventions apply to immediate sources of
617 -- the project. If not, issue a warning.
619 procedure Write_Attr (Name, Value : String);
620 -- Debug print a value for a specific property. Does nothing when not in
623 ------------------------------
624 -- Replace_Into_Name_Buffer --
625 ------------------------------
627 procedure Replace_Into_Name_Buffer
630 Replacement : Character)
632 Max : constant Integer := Str'Last - Pattern'Length + 1;
639 while J <= Str'Last loop
640 Name_Len := Name_Len + 1;
643 and then Str (J .. J + Pattern'Length - 1) = Pattern
645 Name_Buffer (Name_Len) := Replacement;
646 J := J + Pattern'Length;
649 Name_Buffer (Name_Len) := GNAT.Case_Util.To_Lower (Str (J));
653 end Replace_Into_Name_Buffer;
659 function Suffix_Matches
661 Suffix : File_Name_Type) return Boolean
664 if Suffix = No_File then
669 Suf : constant String := Get_Name_String (Suffix);
671 return Filename'Length > Suf'Length
673 (Filename'Last - Suf'Length + 1 .. Filename'Last) = Suf;
681 procedure Write_Attr (Name, Value : String) is
683 if Current_Verbosity = High then
684 Write_Str (" " & Name & " = """);
697 Data : in out Project_Data;
698 In_Tree : Project_Tree_Ref;
699 Project : Project_Id;
701 Lang_Id : Language_Index;
703 File_Name : File_Name_Type;
704 Display_File : File_Name_Type;
705 Lang_Kind : Language_Kind;
706 Naming_Exception : Boolean := False;
707 Path : Path_Name_Type := No_Path;
708 Display_Path : Path_Name_Type := No_Path;
709 Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
710 Other_Part : Source_Id := No_Source;
711 Unit : Name_Id := No_Name;
713 Source_To_Replace : Source_Id := No_Source)
715 Source : constant Source_Id := Data.Last_Source;
716 Src_Data : Source_Data := No_Source_Data;
717 Config : constant Language_Config :=
718 In_Tree.Languages_Data.Table (Lang_Id).Config;
721 -- This is a new source so create an entry for it in the Sources table
723 Source_Data_Table.Increment_Last (In_Tree.Sources);
724 Id := Source_Data_Table.Last (In_Tree.Sources);
726 if Current_Verbosity = High then
727 Write_Str ("Adding source #");
729 Write_Str (", File : ");
730 Write_Str (Get_Name_String (File_Name));
732 if Lang_Kind = Unit_Based then
733 Write_Str (", Unit : ");
734 Write_Str (Get_Name_String (Unit));
740 Src_Data.Project := Project;
741 Src_Data.Language := Lang_Id;
742 Src_Data.Lang_Kind := Lang_Kind;
743 Src_Data.Compiled := In_Tree.Languages_Data.Table
744 (Lang_Id).Config.Compiler_Driver /=
746 Src_Data.Kind := Kind;
747 Src_Data.Alternate_Languages := Alternate_Languages;
748 Src_Data.Other_Part := Other_Part;
750 Src_Data.Object_Exists := Config.Object_Generated;
751 Src_Data.Object_Linked := Config.Objects_Linked;
753 if Other_Part /= No_Source then
754 In_Tree.Sources.Table (Other_Part).Other_Part := Id;
757 Src_Data.Unit := Unit;
758 Src_Data.Index := Index;
759 Src_Data.File := File_Name;
760 Src_Data.Display_File := Display_File;
761 Src_Data.Dependency := In_Tree.Languages_Data.Table
762 (Lang_Id).Config.Dependency_Kind;
763 Src_Data.Dep_Name := Dependency_Name
764 (File_Name, Src_Data.Dependency);
765 Src_Data.Naming_Exception := Naming_Exception;
767 if Src_Data.Compiled and then Src_Data.Object_Exists then
769 Object_Name (File_Name, Config.Object_File_Suffix);
770 Src_Data.Switches := Switches_Name (File_Name);
773 if Path /= No_Path then
774 Src_Data.Path := (Path, Display_Path);
775 Source_Paths_Htable.Set (In_Tree.Source_Paths_HT, Path, Id);
778 -- Add the source id to the Unit_Sources_HT hash table, if the unit name
781 if Unit /= No_Name then
782 Unit_Sources_Htable.Set (In_Tree.Unit_Sources_HT, Unit, Id);
785 -- Add the source to the global list
787 Src_Data.Next_In_Sources := In_Tree.First_Source;
788 In_Tree.First_Source := Id;
790 -- Add the source to the project list
792 if Source = No_Source then
793 Data.First_Source := Id;
795 In_Tree.Sources.Table (Source).Next_In_Project := Id;
798 Data.Last_Source := Id;
800 -- Add the source to the language list
802 Src_Data.Next_In_Lang :=
803 In_Tree.Languages_Data.Table (Lang_Id).First_Source;
804 In_Tree.Languages_Data.Table (Lang_Id).First_Source := Id;
806 In_Tree.Sources.Table (Id) := Src_Data;
808 if Source_To_Replace /= No_Source then
809 Remove_Source (Source_To_Replace, Id, Project, Data, In_Tree);
817 function ALI_File_Name (Source : String) return String is
819 -- If the source name has an extension, then replace it with
822 for Index in reverse Source'First + 1 .. Source'Last loop
823 if Source (Index) = '.' then
824 return Source (Source'First .. Index - 1) & ALI_Suffix;
828 -- If there is no dot, or if it is the first character, just add the
831 return Source & ALI_Suffix;
834 ------------------------------
835 -- Canonical_Case_File_Name --
836 ------------------------------
838 function Canonical_Case_File_Name (Name : Name_Id) return File_Name_Type is
840 if Osint.File_Names_Case_Sensitive then
841 return File_Name_Type (Name);
843 Get_Name_String (Name);
844 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
847 end Canonical_Case_File_Name;
854 (Project : Project_Id;
855 In_Tree : Project_Tree_Ref;
856 Report_Error : Put_Line_Access;
857 When_No_Sources : Error_Warning;
858 Current_Dir : String)
860 Data : Project_Data := In_Tree.Projects.Table (Project);
861 Extending : Boolean := False;
864 Nmsc.When_No_Sources := When_No_Sources;
865 Error_Report := Report_Error;
867 Recursive_Dirs.Reset;
869 Check_If_Externally_Built (Project, In_Tree, Data);
871 -- Object, exec and source directories
873 Get_Directories (Project, In_Tree, Current_Dir, Data);
875 -- Get the programming languages
877 Check_Programming_Languages (In_Tree, Project, Data);
879 if Data.Qualifier = Dry and then Data.Source_Dirs /= Nil_String then
882 "an abstract project needs to have no language, no sources " &
883 "or no source directories",
887 -- Check configuration in multi language mode
889 if Must_Check_Configuration then
890 Check_Configuration (Project, In_Tree, Data);
893 -- Library attributes
895 Check_Library_Attributes (Project, In_Tree, Current_Dir, Data);
897 if Current_Verbosity = High then
898 Show_Source_Dirs (Data, In_Tree);
901 Check_Package_Naming (Project, In_Tree, Data);
903 Extending := Data.Extends /= No_Project;
905 Check_Naming_Schemes (Data, Project, In_Tree);
907 if Get_Mode = Ada_Only then
908 Prepare_Ada_Naming_Exceptions
909 (Data.Naming.Bodies, In_Tree, Body_Part);
910 Prepare_Ada_Naming_Exceptions
911 (Data.Naming.Specs, In_Tree, Specification);
916 if Data.Source_Dirs /= Nil_String then
917 Look_For_Sources (Project, In_Tree, Data, Current_Dir);
919 if Get_Mode = Ada_Only then
921 -- Check that all individual naming conventions apply to sources
922 -- of this project file.
925 (Project, In_Tree, Data.Naming.Bodies,
927 Extending => Extending);
929 (Project, In_Tree, Data.Naming.Specs,
931 Extending => Extending);
933 elsif Get_Mode = Multi_Language and then
934 (not Data.Externally_Built) and then
938 Language : Language_Index;
940 Alt_Lang : Alternate_Language_Id;
941 Alt_Lang_Data : Alternate_Language_Data;
942 Continuation : Boolean := False;
945 Language := Data.First_Language_Processing;
946 while Language /= No_Language_Index loop
947 Source := Data.First_Source;
948 Source_Loop : while Source /= No_Source loop
950 Src_Data : Source_Data renames
951 In_Tree.Sources.Table (Source);
954 exit Source_Loop when Src_Data.Language = Language;
956 Alt_Lang := Src_Data.Alternate_Languages;
959 while Alt_Lang /= No_Alternate_Language loop
961 In_Tree.Alt_Langs.Table (Alt_Lang);
963 when Alt_Lang_Data.Language = Language;
964 Alt_Lang := Alt_Lang_Data.Next;
965 end loop Alternate_Loop;
967 Source := Src_Data.Next_In_Project;
969 end loop Source_Loop;
971 if Source = No_Source then
975 (In_Tree.Languages_Data.Table
976 (Language).Display_Name),
980 Continuation := True;
983 Language := In_Tree.Languages_Data.Table (Language).Next;
989 if Get_Mode = Multi_Language then
991 -- If a list of sources is specified in attribute Interfaces, set
992 -- In_Interfaces only for the sources specified in the list.
994 Check_Interfaces (Project, In_Tree, Data);
997 -- If it is a library project file, check if it is a standalone library
1000 Check_Stand_Alone_Library
1001 (Project, In_Tree, Data, Current_Dir, Extending);
1004 -- Put the list of Mains, if any, in the project data
1006 Get_Mains (Project, In_Tree, Data);
1008 -- Update the project data in the Projects table
1010 In_Tree.Projects.Table (Project) := Data;
1012 Free_Ada_Naming_Exceptions;
1015 --------------------
1016 -- Check_Ada_Name --
1017 --------------------
1019 procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is
1020 The_Name : String := Name;
1021 Real_Name : Name_Id;
1022 Need_Letter : Boolean := True;
1023 Last_Underscore : Boolean := False;
1024 OK : Boolean := The_Name'Length > 0;
1027 function Is_Reserved (Name : Name_Id) return Boolean;
1028 function Is_Reserved (S : String) return Boolean;
1029 -- Check that the given name is not an Ada 95 reserved word. The reason
1030 -- for the Ada 95 here is that we do not want to exclude the case of an
1031 -- Ada 95 unit called Interface (for example). In Ada 2005, such a unit
1032 -- name would be rejected anyway by the compiler. That means there is no
1033 -- requirement that the project file parser reject this.
1039 function Is_Reserved (S : String) return Boolean is
1042 Add_Str_To_Name_Buffer (S);
1043 return Is_Reserved (Name_Find);
1050 function Is_Reserved (Name : Name_Id) return Boolean is
1052 if Get_Name_Table_Byte (Name) /= 0
1053 and then Name /= Name_Project
1054 and then Name /= Name_Extends
1055 and then Name /= Name_External
1056 and then Name not in Ada_2005_Reserved_Words
1060 if Current_Verbosity = High then
1061 Write_Str (The_Name);
1062 Write_Line (" is an Ada reserved word.");
1072 -- Start of processing for Check_Ada_Name
1075 To_Lower (The_Name);
1077 Name_Len := The_Name'Length;
1078 Name_Buffer (1 .. Name_Len) := The_Name;
1080 -- Special cases of children of packages A, G, I and S on VMS
1082 if OpenVMS_On_Target
1083 and then Name_Len > 3
1084 and then Name_Buffer (2 .. 3) = "__"
1086 ((Name_Buffer (1) = 'a') or else
1087 (Name_Buffer (1) = 'g') or else
1088 (Name_Buffer (1) = 'i') or else
1089 (Name_Buffer (1) = 's'))
1091 Name_Buffer (2) := '.';
1092 Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
1093 Name_Len := Name_Len - 1;
1096 Real_Name := Name_Find;
1098 if Is_Reserved (Real_Name) then
1102 First := The_Name'First;
1104 for Index in The_Name'Range loop
1107 -- We need a letter (at the beginning, and following a dot),
1108 -- but we don't have one.
1110 if Is_Letter (The_Name (Index)) then
1111 Need_Letter := False;
1116 if Current_Verbosity = High then
1117 Write_Int (Types.Int (Index));
1119 Write_Char (The_Name (Index));
1120 Write_Line ("' is not a letter.");
1126 elsif Last_Underscore
1127 and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
1129 -- Two underscores are illegal, and a dot cannot follow
1134 if Current_Verbosity = High then
1135 Write_Int (Types.Int (Index));
1137 Write_Char (The_Name (Index));
1138 Write_Line ("' is illegal here.");
1143 elsif The_Name (Index) = '.' then
1145 -- First, check if the name before the dot is not a reserved word
1146 if Is_Reserved (The_Name (First .. Index - 1)) then
1152 -- We need a letter after a dot
1154 Need_Letter := True;
1156 elsif The_Name (Index) = '_' then
1157 Last_Underscore := True;
1160 -- We need an letter or a digit
1162 Last_Underscore := False;
1164 if not Is_Alphanumeric (The_Name (Index)) then
1167 if Current_Verbosity = High then
1168 Write_Int (Types.Int (Index));
1170 Write_Char (The_Name (Index));
1171 Write_Line ("' is not alphanumeric.");
1179 -- Cannot end with an underscore or a dot
1181 OK := OK and then not Need_Letter and then not Last_Underscore;
1184 if First /= Name'First and then
1185 Is_Reserved (The_Name (First .. The_Name'Last))
1193 -- Signal a problem with No_Name
1199 -------------------------
1200 -- Check_Configuration --
1201 -------------------------
1203 procedure Check_Configuration
1204 (Project : Project_Id;
1205 In_Tree : Project_Tree_Ref;
1206 Data : in out Project_Data)
1208 Dot_Replacement : File_Name_Type := No_File;
1209 Casing : Casing_Type := All_Lower_Case;
1210 Separate_Suffix : File_Name_Type := No_File;
1212 Lang_Index : Language_Index := No_Language_Index;
1213 -- The index of the language data being checked
1215 Prev_Index : Language_Index := No_Language_Index;
1216 -- The index of the previous language
1218 Current_Language : Name_Id := No_Name;
1219 -- The name of the language
1221 Lang_Data : Language_Data;
1222 -- The data of the language being checked
1224 procedure Get_Language_Index_Of (Language : Name_Id);
1225 -- Get the language index of Language, if Language is one of the
1226 -- languages of the project.
1228 procedure Process_Project_Level_Simple_Attributes;
1229 -- Process the simple attributes at the project level
1231 procedure Process_Project_Level_Array_Attributes;
1232 -- Process the associate array attributes at the project level
1234 procedure Process_Packages;
1235 -- Read the packages of the project
1237 ---------------------------
1238 -- Get_Language_Index_Of --
1239 ---------------------------
1241 procedure Get_Language_Index_Of (Language : Name_Id) is
1242 Real_Language : Name_Id;
1245 Get_Name_String (Language);
1246 To_Lower (Name_Buffer (1 .. Name_Len));
1247 Real_Language := Name_Find;
1249 -- Nothing to do if the language is the same as the current language
1251 if Current_Language /= Real_Language then
1252 Lang_Index := Data.First_Language_Processing;
1253 while Lang_Index /= No_Language_Index loop
1254 exit when In_Tree.Languages_Data.Table (Lang_Index).Name =
1257 In_Tree.Languages_Data.Table (Lang_Index).Next;
1260 if Lang_Index = No_Language_Index then
1261 Current_Language := No_Name;
1263 Current_Language := Real_Language;
1266 end Get_Language_Index_Of;
1268 ----------------------
1269 -- Process_Packages --
1270 ----------------------
1272 procedure Process_Packages is
1273 Packages : Package_Id;
1274 Element : Package_Element;
1276 procedure Process_Binder (Arrays : Array_Id);
1277 -- Process the associate array attributes of package Binder
1279 procedure Process_Builder (Attributes : Variable_Id);
1280 -- Process the simple attributes of package Builder
1282 procedure Process_Compiler (Arrays : Array_Id);
1283 -- Process the associate array attributes of package Compiler
1285 procedure Process_Naming (Attributes : Variable_Id);
1286 -- Process the simple attributes of package Naming
1288 procedure Process_Naming (Arrays : Array_Id);
1289 -- Process the associate array attributes of package Naming
1291 procedure Process_Linker (Attributes : Variable_Id);
1292 -- Process the simple attributes of package Linker of a
1293 -- configuration project.
1295 --------------------
1296 -- Process_Binder --
1297 --------------------
1299 procedure Process_Binder (Arrays : Array_Id) is
1300 Current_Array_Id : Array_Id;
1301 Current_Array : Array_Data;
1302 Element_Id : Array_Element_Id;
1303 Element : Array_Element;
1306 -- Process the associative array attribute of package Binder
1308 Current_Array_Id := Arrays;
1309 while Current_Array_Id /= No_Array loop
1310 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1312 Element_Id := Current_Array.Value;
1313 while Element_Id /= No_Array_Element loop
1314 Element := In_Tree.Array_Elements.Table (Element_Id);
1316 if Element.Index /= All_Other_Names then
1318 -- Get the name of the language
1320 Get_Language_Index_Of (Element.Index);
1322 if Lang_Index /= No_Language_Index then
1323 case Current_Array.Name is
1326 -- Attribute Driver (<language>)
1328 In_Tree.Languages_Data.Table
1329 (Lang_Index).Config.Binder_Driver :=
1330 File_Name_Type (Element.Value.Value);
1332 when Name_Required_Switches =>
1334 In_Tree.Languages_Data.Table
1335 (Lang_Index).Config.Binder_Required_Switches,
1336 From_List => Element.Value.Values,
1337 In_Tree => In_Tree);
1341 -- Attribute Prefix (<language>)
1343 In_Tree.Languages_Data.Table
1344 (Lang_Index).Config.Binder_Prefix :=
1345 Element.Value.Value;
1347 when Name_Objects_Path =>
1349 -- Attribute Objects_Path (<language>)
1351 In_Tree.Languages_Data.Table
1352 (Lang_Index).Config.Objects_Path :=
1353 Element.Value.Value;
1355 when Name_Objects_Path_File =>
1357 -- Attribute Objects_Path (<language>)
1359 In_Tree.Languages_Data.Table
1360 (Lang_Index).Config.Objects_Path_File :=
1361 Element.Value.Value;
1369 Element_Id := Element.Next;
1372 Current_Array_Id := Current_Array.Next;
1376 ---------------------
1377 -- Process_Builder --
1378 ---------------------
1380 procedure Process_Builder (Attributes : Variable_Id) is
1381 Attribute_Id : Variable_Id;
1382 Attribute : Variable;
1385 -- Process non associated array attribute from package Builder
1387 Attribute_Id := Attributes;
1388 while Attribute_Id /= No_Variable loop
1390 In_Tree.Variable_Elements.Table (Attribute_Id);
1392 if not Attribute.Value.Default then
1393 if Attribute.Name = Name_Executable_Suffix then
1395 -- Attribute Executable_Suffix: the suffix of the
1398 Data.Config.Executable_Suffix :=
1399 Attribute.Value.Value;
1403 Attribute_Id := Attribute.Next;
1405 end Process_Builder;
1407 ----------------------
1408 -- Process_Compiler --
1409 ----------------------
1411 procedure Process_Compiler (Arrays : Array_Id) is
1412 Current_Array_Id : Array_Id;
1413 Current_Array : Array_Data;
1414 Element_Id : Array_Element_Id;
1415 Element : Array_Element;
1416 List : String_List_Id;
1419 -- Process the associative array attribute of package Compiler
1421 Current_Array_Id := Arrays;
1422 while Current_Array_Id /= No_Array loop
1423 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1425 Element_Id := Current_Array.Value;
1426 while Element_Id /= No_Array_Element loop
1427 Element := In_Tree.Array_Elements.Table (Element_Id);
1429 if Element.Index /= All_Other_Names then
1431 -- Get the name of the language
1433 Get_Language_Index_Of (Element.Index);
1435 if Lang_Index /= No_Language_Index then
1436 case Current_Array.Name is
1437 when Name_Dependency_Switches =>
1439 -- Attribute Dependency_Switches (<language>)
1441 if In_Tree.Languages_Data.Table
1442 (Lang_Index).Config.Dependency_Kind = None
1444 In_Tree.Languages_Data.Table
1445 (Lang_Index).Config.Dependency_Kind :=
1449 List := Element.Value.Values;
1451 if List /= Nil_String then
1453 In_Tree.Languages_Data.Table
1454 (Lang_Index).Config.Dependency_Option,
1456 In_Tree => In_Tree);
1459 when Name_Dependency_Driver =>
1461 -- Attribute Dependency_Driver (<language>)
1463 if In_Tree.Languages_Data.Table
1464 (Lang_Index).Config.Dependency_Kind = None
1466 In_Tree.Languages_Data.Table
1467 (Lang_Index).Config.Dependency_Kind :=
1471 List := Element.Value.Values;
1473 if List /= Nil_String then
1475 In_Tree.Languages_Data.Table
1476 (Lang_Index).Config.Compute_Dependency,
1478 In_Tree => In_Tree);
1481 when Name_Include_Switches =>
1483 -- Attribute Include_Switches (<language>)
1485 List := Element.Value.Values;
1487 if List = Nil_String then
1491 "include option cannot be null",
1492 Element.Value.Location);
1496 In_Tree.Languages_Data.Table
1497 (Lang_Index).Config.Include_Option,
1499 In_Tree => In_Tree);
1501 when Name_Include_Path =>
1503 -- Attribute Include_Path (<language>)
1505 In_Tree.Languages_Data.Table
1506 (Lang_Index).Config.Include_Path :=
1507 Element.Value.Value;
1509 when Name_Include_Path_File =>
1511 -- Attribute Include_Path_File (<language>)
1513 In_Tree.Languages_Data.Table
1514 (Lang_Index).Config.Include_Path_File :=
1515 Element.Value.Value;
1519 -- Attribute Driver (<language>)
1521 Get_Name_String (Element.Value.Value);
1523 In_Tree.Languages_Data.Table
1524 (Lang_Index).Config.Compiler_Driver :=
1525 File_Name_Type (Element.Value.Value);
1527 when Name_Required_Switches =>
1529 In_Tree.Languages_Data.Table
1530 (Lang_Index).Config.
1531 Compiler_Required_Switches,
1532 From_List => Element.Value.Values,
1533 In_Tree => In_Tree);
1535 when Name_Path_Syntax =>
1537 In_Tree.Languages_Data.Table
1538 (Lang_Index).Config.Path_Syntax :=
1539 Path_Syntax_Kind'Value
1540 (Get_Name_String (Element.Value.Value));
1543 when Constraint_Error =>
1547 "invalid value for Path_Syntax",
1548 Element.Value.Location);
1551 when Name_Object_File_Suffix =>
1552 if Get_Name_String (Element.Value.Value) = "" then
1555 "object file suffix cannot be empty",
1556 Element.Value.Location);
1559 In_Tree.Languages_Data.Table
1560 (Lang_Index).Config.Object_File_Suffix :=
1561 Element.Value.Value;
1564 when Name_Pic_Option =>
1566 -- Attribute Compiler_Pic_Option (<language>)
1568 List := Element.Value.Values;
1570 if List = Nil_String then
1574 "compiler PIC option cannot be null",
1575 Element.Value.Location);
1579 In_Tree.Languages_Data.Table
1580 (Lang_Index).Config.Compilation_PIC_Option,
1582 In_Tree => In_Tree);
1584 when Name_Mapping_File_Switches =>
1586 -- Attribute Mapping_File_Switches (<language>)
1588 List := Element.Value.Values;
1590 if List = Nil_String then
1594 "mapping file switches cannot be null",
1595 Element.Value.Location);
1599 In_Tree.Languages_Data.Table
1600 (Lang_Index).Config.Mapping_File_Switches,
1602 In_Tree => In_Tree);
1604 when Name_Mapping_Spec_Suffix =>
1606 -- Attribute Mapping_Spec_Suffix (<language>)
1608 In_Tree.Languages_Data.Table
1609 (Lang_Index).Config.Mapping_Spec_Suffix :=
1610 File_Name_Type (Element.Value.Value);
1612 when Name_Mapping_Body_Suffix =>
1614 -- Attribute Mapping_Body_Suffix (<language>)
1616 In_Tree.Languages_Data.Table
1617 (Lang_Index).Config.Mapping_Body_Suffix :=
1618 File_Name_Type (Element.Value.Value);
1620 when Name_Config_File_Switches =>
1622 -- Attribute Config_File_Switches (<language>)
1624 List := Element.Value.Values;
1626 if List = Nil_String then
1630 "config file switches cannot be null",
1631 Element.Value.Location);
1635 In_Tree.Languages_Data.Table
1636 (Lang_Index).Config.Config_File_Switches,
1638 In_Tree => In_Tree);
1640 when Name_Objects_Path =>
1642 -- Attribute Objects_Path (<language>)
1644 In_Tree.Languages_Data.Table
1645 (Lang_Index).Config.Objects_Path :=
1646 Element.Value.Value;
1648 when Name_Objects_Path_File =>
1650 -- Attribute Objects_Path_File (<language>)
1652 In_Tree.Languages_Data.Table
1653 (Lang_Index).Config.Objects_Path_File :=
1654 Element.Value.Value;
1656 when Name_Config_Body_File_Name =>
1658 -- Attribute Config_Body_File_Name (<language>)
1660 In_Tree.Languages_Data.Table
1661 (Lang_Index).Config.Config_Body :=
1662 Element.Value.Value;
1664 when Name_Config_Body_File_Name_Pattern =>
1666 -- Attribute Config_Body_File_Name_Pattern
1669 In_Tree.Languages_Data.Table
1670 (Lang_Index).Config.Config_Body_Pattern :=
1671 Element.Value.Value;
1673 when Name_Config_Spec_File_Name =>
1675 -- Attribute Config_Spec_File_Name (<language>)
1677 In_Tree.Languages_Data.Table
1678 (Lang_Index).Config.Config_Spec :=
1679 Element.Value.Value;
1681 when Name_Config_Spec_File_Name_Pattern =>
1683 -- Attribute Config_Spec_File_Name_Pattern
1686 In_Tree.Languages_Data.Table
1687 (Lang_Index).Config.Config_Spec_Pattern :=
1688 Element.Value.Value;
1690 when Name_Config_File_Unique =>
1692 -- Attribute Config_File_Unique (<language>)
1695 In_Tree.Languages_Data.Table
1696 (Lang_Index).Config.Config_File_Unique :=
1698 (Get_Name_String (Element.Value.Value));
1700 when Constraint_Error =>
1704 "illegal value for Config_File_Unique",
1705 Element.Value.Location);
1714 Element_Id := Element.Next;
1717 Current_Array_Id := Current_Array.Next;
1719 end Process_Compiler;
1721 --------------------
1722 -- Process_Naming --
1723 --------------------
1725 procedure Process_Naming (Attributes : Variable_Id) is
1726 Attribute_Id : Variable_Id;
1727 Attribute : Variable;
1730 -- Process non associated array attribute from package Naming
1732 Attribute_Id := Attributes;
1733 while Attribute_Id /= No_Variable loop
1734 Attribute := In_Tree.Variable_Elements.Table (Attribute_Id);
1736 if not Attribute.Value.Default then
1737 if Attribute.Name = Name_Separate_Suffix then
1739 -- Attribute Separate_Suffix
1741 Separate_Suffix := File_Name_Type (Attribute.Value.Value);
1743 elsif Attribute.Name = Name_Casing then
1749 Value (Get_Name_String (Attribute.Value.Value));
1752 when Constraint_Error =>
1756 "invalid value for Casing",
1757 Attribute.Value.Location);
1760 elsif Attribute.Name = Name_Dot_Replacement then
1762 -- Attribute Dot_Replacement
1764 Dot_Replacement := File_Name_Type (Attribute.Value.Value);
1769 Attribute_Id := Attribute.Next;
1773 procedure Process_Naming (Arrays : Array_Id) is
1774 Current_Array_Id : Array_Id;
1775 Current_Array : Array_Data;
1776 Element_Id : Array_Element_Id;
1777 Element : Array_Element;
1779 -- Process the associative array attribute of package Naming
1781 Current_Array_Id := Arrays;
1782 while Current_Array_Id /= No_Array loop
1783 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1785 Element_Id := Current_Array.Value;
1786 while Element_Id /= No_Array_Element loop
1787 Element := In_Tree.Array_Elements.Table (Element_Id);
1789 -- Get the name of the language
1791 Get_Language_Index_Of (Element.Index);
1793 if Lang_Index /= No_Language_Index then
1794 case Current_Array.Name is
1795 when Name_Specification_Suffix | Name_Spec_Suffix =>
1797 -- Attribute Spec_Suffix (<language>)
1799 In_Tree.Languages_Data.Table
1800 (Lang_Index).Config.Naming_Data.Spec_Suffix :=
1801 File_Name_Type (Element.Value.Value);
1803 when Name_Implementation_Suffix | Name_Body_Suffix =>
1805 -- Attribute Body_Suffix (<language>)
1807 In_Tree.Languages_Data.Table
1808 (Lang_Index).Config.Naming_Data.Body_Suffix :=
1809 File_Name_Type (Element.Value.Value);
1811 In_Tree.Languages_Data.Table
1812 (Lang_Index).Config.Naming_Data.Separate_Suffix :=
1813 File_Name_Type (Element.Value.Value);
1820 Element_Id := Element.Next;
1823 Current_Array_Id := Current_Array.Next;
1827 --------------------
1828 -- Process_Linker --
1829 --------------------
1831 procedure Process_Linker (Attributes : Variable_Id) is
1832 Attribute_Id : Variable_Id;
1833 Attribute : Variable;
1836 -- Process non associated array attribute from package Linker
1838 Attribute_Id := Attributes;
1839 while Attribute_Id /= No_Variable loop
1841 In_Tree.Variable_Elements.Table (Attribute_Id);
1843 if not Attribute.Value.Default then
1844 if Attribute.Name = Name_Driver then
1846 -- Attribute Linker'Driver: the default linker to use
1848 Data.Config.Linker :=
1849 Path_Name_Type (Attribute.Value.Value);
1851 -- Linker'Driver is also used to link shared libraries
1852 -- if the obsolescent attribute Library_GCC has not been
1855 if Data.Config.Shared_Lib_Driver = No_File then
1856 Data.Config.Shared_Lib_Driver :=
1857 File_Name_Type (Attribute.Value.Value);
1860 elsif Attribute.Name = Name_Required_Switches then
1862 -- Attribute Required_Switches: the minimum
1863 -- options to use when invoking the linker
1866 Data.Config.Minimum_Linker_Options,
1867 From_List => Attribute.Value.Values,
1868 In_Tree => In_Tree);
1870 elsif Attribute.Name = Name_Map_File_Option then
1871 Data.Config.Map_File_Option := Attribute.Value.Value;
1873 elsif Attribute.Name = Name_Max_Command_Line_Length then
1875 Data.Config.Max_Command_Line_Length :=
1876 Natural'Value (Get_Name_String
1877 (Attribute.Value.Value));
1880 when Constraint_Error =>
1884 "value must be positive or equal to 0",
1885 Attribute.Value.Location);
1888 elsif Attribute.Name = Name_Response_File_Format then
1893 Get_Name_String (Attribute.Value.Value);
1894 To_Lower (Name_Buffer (1 .. Name_Len));
1897 if Name = Name_None then
1898 Data.Config.Resp_File_Format := None;
1900 elsif Name = Name_Gnu then
1901 Data.Config.Resp_File_Format := GNU;
1903 elsif Name = Name_Object_List then
1904 Data.Config.Resp_File_Format := Object_List;
1906 elsif Name = Name_Option_List then
1907 Data.Config.Resp_File_Format := Option_List;
1913 "illegal response file format",
1914 Attribute.Value.Location);
1918 elsif Attribute.Name = Name_Response_File_Switches then
1920 Data.Config.Resp_File_Options,
1921 From_List => Attribute.Value.Values,
1922 In_Tree => In_Tree);
1926 Attribute_Id := Attribute.Next;
1930 -- Start of processing for Process_Packages
1933 Packages := Data.Decl.Packages;
1934 while Packages /= No_Package loop
1935 Element := In_Tree.Packages.Table (Packages);
1937 case Element.Name is
1940 -- Process attributes of package Binder
1942 Process_Binder (Element.Decl.Arrays);
1944 when Name_Builder =>
1946 -- Process attributes of package Builder
1948 Process_Builder (Element.Decl.Attributes);
1950 when Name_Compiler =>
1952 -- Process attributes of package Compiler
1954 Process_Compiler (Element.Decl.Arrays);
1958 -- Process attributes of package Linker
1960 Process_Linker (Element.Decl.Attributes);
1964 -- Process attributes of package Naming
1966 Process_Naming (Element.Decl.Attributes);
1967 Process_Naming (Element.Decl.Arrays);
1973 Packages := Element.Next;
1975 end Process_Packages;
1977 ---------------------------------------------
1978 -- Process_Project_Level_Simple_Attributes --
1979 ---------------------------------------------
1981 procedure Process_Project_Level_Simple_Attributes is
1982 Attribute_Id : Variable_Id;
1983 Attribute : Variable;
1984 List : String_List_Id;
1987 -- Process non associated array attribute at project level
1989 Attribute_Id := Data.Decl.Attributes;
1990 while Attribute_Id /= No_Variable loop
1992 In_Tree.Variable_Elements.Table (Attribute_Id);
1994 if not Attribute.Value.Default then
1995 if Attribute.Name = Name_Target then
1997 -- Attribute Target: the target specified
1999 Data.Config.Target := Attribute.Value.Value;
2001 elsif Attribute.Name = Name_Library_Builder then
2003 -- Attribute Library_Builder: the application to invoke
2004 -- to build libraries.
2006 Data.Config.Library_Builder :=
2007 Path_Name_Type (Attribute.Value.Value);
2009 elsif Attribute.Name = Name_Archive_Builder then
2011 -- Attribute Archive_Builder: the archive builder
2012 -- (usually "ar") and its minimum options (usually "cr").
2014 List := Attribute.Value.Values;
2016 if List = Nil_String then
2020 "archive builder cannot be null",
2021 Attribute.Value.Location);
2024 Put (Into_List => Data.Config.Archive_Builder,
2026 In_Tree => In_Tree);
2028 elsif Attribute.Name = Name_Archive_Builder_Append_Option then
2030 -- Attribute Archive_Builder: the archive builder
2031 -- (usually "ar") and its minimum options (usually "cr").
2033 List := Attribute.Value.Values;
2035 if List /= Nil_String then
2037 (Into_List => Data.Config.Archive_Builder_Append_Option,
2039 In_Tree => In_Tree);
2042 elsif Attribute.Name = Name_Archive_Indexer then
2044 -- Attribute Archive_Indexer: the optional archive
2045 -- indexer (usually "ranlib") with its minimum options
2048 List := Attribute.Value.Values;
2050 if List = Nil_String then
2054 "archive indexer cannot be null",
2055 Attribute.Value.Location);
2058 Put (Into_List => Data.Config.Archive_Indexer,
2060 In_Tree => In_Tree);
2062 elsif Attribute.Name = Name_Library_Partial_Linker then
2064 -- Attribute Library_Partial_Linker: the optional linker
2065 -- driver with its minimum options, to partially link
2068 List := Attribute.Value.Values;
2070 if List = Nil_String then
2074 "partial linker cannot be null",
2075 Attribute.Value.Location);
2078 Put (Into_List => Data.Config.Lib_Partial_Linker,
2080 In_Tree => In_Tree);
2082 elsif Attribute.Name = Name_Library_GCC then
2083 Data.Config.Shared_Lib_Driver :=
2084 File_Name_Type (Attribute.Value.Value);
2088 "?Library_'G'C'C is an obsolescent attribute, " &
2089 "use Linker''Driver instead",
2090 Attribute.Value.Location);
2092 elsif Attribute.Name = Name_Archive_Suffix then
2093 Data.Config.Archive_Suffix :=
2094 File_Name_Type (Attribute.Value.Value);
2096 elsif Attribute.Name = Name_Linker_Executable_Option then
2098 -- Attribute Linker_Executable_Option: optional options
2099 -- to specify an executable name. Defaults to "-o".
2101 List := Attribute.Value.Values;
2103 if List = Nil_String then
2107 "linker executable option cannot be null",
2108 Attribute.Value.Location);
2111 Put (Into_List => Data.Config.Linker_Executable_Option,
2113 In_Tree => In_Tree);
2115 elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
2117 -- Attribute Linker_Lib_Dir_Option: optional options
2118 -- to specify a library search directory. Defaults to
2121 Get_Name_String (Attribute.Value.Value);
2123 if Name_Len = 0 then
2127 "linker library directory option cannot be empty",
2128 Attribute.Value.Location);
2131 Data.Config.Linker_Lib_Dir_Option := Attribute.Value.Value;
2133 elsif Attribute.Name = Name_Linker_Lib_Name_Option then
2135 -- Attribute Linker_Lib_Name_Option: optional options
2136 -- to specify the name of a library to be linked in.
2137 -- Defaults to "-l".
2139 Get_Name_String (Attribute.Value.Value);
2141 if Name_Len = 0 then
2145 "linker library name option cannot be empty",
2146 Attribute.Value.Location);
2149 Data.Config.Linker_Lib_Name_Option := Attribute.Value.Value;
2151 elsif Attribute.Name = Name_Run_Path_Option then
2153 -- Attribute Run_Path_Option: optional options to
2154 -- specify a path for libraries.
2156 List := Attribute.Value.Values;
2158 if List /= Nil_String then
2159 Put (Into_List => Data.Config.Run_Path_Option,
2161 In_Tree => In_Tree);
2164 elsif Attribute.Name = Name_Separate_Run_Path_Options then
2166 pragma Unsuppress (All_Checks);
2168 Data.Config.Separate_Run_Path_Options :=
2169 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2171 when Constraint_Error =>
2175 "invalid value """ &
2176 Get_Name_String (Attribute.Value.Value) &
2177 """ for Separate_Run_Path_Options",
2178 Attribute.Value.Location);
2181 elsif Attribute.Name = Name_Library_Support then
2183 pragma Unsuppress (All_Checks);
2185 Data.Config.Lib_Support :=
2186 Library_Support'Value (Get_Name_String
2187 (Attribute.Value.Value));
2189 when Constraint_Error =>
2193 "invalid value """ &
2194 Get_Name_String (Attribute.Value.Value) &
2195 """ for Library_Support",
2196 Attribute.Value.Location);
2199 elsif Attribute.Name = Name_Shared_Library_Prefix then
2200 Data.Config.Shared_Lib_Prefix :=
2201 File_Name_Type (Attribute.Value.Value);
2203 elsif Attribute.Name = Name_Shared_Library_Suffix then
2204 Data.Config.Shared_Lib_Suffix :=
2205 File_Name_Type (Attribute.Value.Value);
2207 elsif Attribute.Name = Name_Symbolic_Link_Supported then
2209 pragma Unsuppress (All_Checks);
2211 Data.Config.Symbolic_Link_Supported :=
2212 Boolean'Value (Get_Name_String
2213 (Attribute.Value.Value));
2215 when Constraint_Error =>
2220 & Get_Name_String (Attribute.Value.Value)
2221 & """ for Symbolic_Link_Supported",
2222 Attribute.Value.Location);
2226 Attribute.Name = Name_Library_Major_Minor_Id_Supported
2229 pragma Unsuppress (All_Checks);
2231 Data.Config.Lib_Maj_Min_Id_Supported :=
2232 Boolean'Value (Get_Name_String
2233 (Attribute.Value.Value));
2235 when Constraint_Error =>
2239 "invalid value """ &
2240 Get_Name_String (Attribute.Value.Value) &
2241 """ for Library_Major_Minor_Id_Supported",
2242 Attribute.Value.Location);
2245 elsif Attribute.Name = Name_Library_Auto_Init_Supported then
2247 pragma Unsuppress (All_Checks);
2249 Data.Config.Auto_Init_Supported :=
2250 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2252 when Constraint_Error =>
2257 & Get_Name_String (Attribute.Value.Value)
2258 & """ for Library_Auto_Init_Supported",
2259 Attribute.Value.Location);
2262 elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
2263 List := Attribute.Value.Values;
2265 if List /= Nil_String then
2266 Put (Into_List => Data.Config.Shared_Lib_Min_Options,
2268 In_Tree => In_Tree);
2271 elsif Attribute.Name = Name_Library_Version_Switches then
2272 List := Attribute.Value.Values;
2274 if List /= Nil_String then
2275 Put (Into_List => Data.Config.Lib_Version_Options,
2277 In_Tree => In_Tree);
2282 Attribute_Id := Attribute.Next;
2284 end Process_Project_Level_Simple_Attributes;
2286 --------------------------------------------
2287 -- Process_Project_Level_Array_Attributes --
2288 --------------------------------------------
2290 procedure Process_Project_Level_Array_Attributes is
2291 Current_Array_Id : Array_Id;
2292 Current_Array : Array_Data;
2293 Element_Id : Array_Element_Id;
2294 Element : Array_Element;
2295 List : String_List_Id;
2298 -- Process the associative array attributes at project level
2300 Current_Array_Id := Data.Decl.Arrays;
2301 while Current_Array_Id /= No_Array loop
2302 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
2304 Element_Id := Current_Array.Value;
2305 while Element_Id /= No_Array_Element loop
2306 Element := In_Tree.Array_Elements.Table (Element_Id);
2308 -- Get the name of the language
2310 Get_Language_Index_Of (Element.Index);
2312 if Lang_Index /= No_Language_Index then
2313 case Current_Array.Name is
2314 when Name_Inherit_Source_Path =>
2315 List := Element.Value.Values;
2317 if List /= Nil_String then
2320 In_Tree.Languages_Data.Table (Lang_Index).
2321 Config.Include_Compatible_Languages,
2324 Lower_Case => True);
2327 when Name_Toolchain_Description =>
2329 -- Attribute Toolchain_Description (<language>)
2331 In_Tree.Languages_Data.Table
2332 (Lang_Index).Config.Toolchain_Description :=
2333 Element.Value.Value;
2335 when Name_Toolchain_Version =>
2337 -- Attribute Toolchain_Version (<language>)
2339 In_Tree.Languages_Data.Table
2340 (Lang_Index).Config.Toolchain_Version :=
2341 Element.Value.Value;
2343 when Name_Runtime_Library_Dir =>
2345 -- Attribute Runtime_Library_Dir (<language>)
2347 In_Tree.Languages_Data.Table
2348 (Lang_Index).Config.Runtime_Library_Dir :=
2349 Element.Value.Value;
2351 when Name_Runtime_Source_Dir =>
2353 -- Attribute Runtime_Library_Dir (<language>)
2355 In_Tree.Languages_Data.Table
2356 (Lang_Index).Config.Runtime_Source_Dir :=
2357 Element.Value.Value;
2359 when Name_Object_Generated =>
2361 pragma Unsuppress (All_Checks);
2367 (Get_Name_String (Element.Value.Value));
2369 In_Tree.Languages_Data.Table
2370 (Lang_Index).Config.Object_Generated := Value;
2372 -- If no object is generated, no object may be
2376 In_Tree.Languages_Data.Table
2377 (Lang_Index).Config.Objects_Linked := False;
2381 when Constraint_Error =>
2386 & Get_Name_String (Element.Value.Value)
2387 & """ for Object_Generated",
2388 Element.Value.Location);
2391 when Name_Objects_Linked =>
2393 pragma Unsuppress (All_Checks);
2399 (Get_Name_String (Element.Value.Value));
2401 -- No change if Object_Generated is False, as this
2402 -- forces Objects_Linked to be False too.
2404 if In_Tree.Languages_Data.Table
2405 (Lang_Index).Config.Object_Generated
2407 In_Tree.Languages_Data.Table
2408 (Lang_Index).Config.Objects_Linked :=
2413 when Constraint_Error =>
2418 & Get_Name_String (Element.Value.Value)
2419 & """ for Objects_Linked",
2420 Element.Value.Location);
2427 Element_Id := Element.Next;
2430 Current_Array_Id := Current_Array.Next;
2432 end Process_Project_Level_Array_Attributes;
2435 Process_Project_Level_Simple_Attributes;
2436 Process_Project_Level_Array_Attributes;
2439 -- For unit based languages, set Casing, Dot_Replacement and
2440 -- Separate_Suffix in Naming_Data.
2442 Lang_Index := Data.First_Language_Processing;
2443 while Lang_Index /= No_Language_Index loop
2444 if In_Tree.Languages_Data.Table
2445 (Lang_Index).Name = Name_Ada
2447 In_Tree.Languages_Data.Table
2448 (Lang_Index).Config.Naming_Data.Casing := Casing;
2449 In_Tree.Languages_Data.Table
2450 (Lang_Index).Config.Naming_Data.Dot_Replacement :=
2453 if Separate_Suffix /= No_File then
2454 In_Tree.Languages_Data.Table
2455 (Lang_Index).Config.Naming_Data.Separate_Suffix :=
2462 Lang_Index := In_Tree.Languages_Data.Table (Lang_Index).Next;
2465 -- Give empty names to various prefixes/suffixes, if they have not
2466 -- been specified in the configuration.
2468 if Data.Config.Archive_Suffix = No_File then
2469 Data.Config.Archive_Suffix := Empty_File;
2472 if Data.Config.Shared_Lib_Prefix = No_File then
2473 Data.Config.Shared_Lib_Prefix := Empty_File;
2476 if Data.Config.Shared_Lib_Suffix = No_File then
2477 Data.Config.Shared_Lib_Suffix := Empty_File;
2480 Lang_Index := Data.First_Language_Processing;
2481 while Lang_Index /= No_Language_Index loop
2482 Lang_Data := In_Tree.Languages_Data.Table (Lang_Index);
2484 Current_Language := Lang_Data.Display_Name;
2486 -- For all languages, Compiler_Driver needs to be specified
2488 if Lang_Data.Config.Compiler_Driver = No_File then
2489 Error_Msg_Name_1 := Current_Language;
2493 "?no compiler specified for language %%" &
2494 ", ignoring all its sources",
2497 if Lang_Index = Data.First_Language_Processing then
2498 Data.First_Language_Processing :=
2501 In_Tree.Languages_Data.Table (Prev_Index).Next :=
2505 elsif Lang_Data.Name = Name_Ada then
2506 Prev_Index := Lang_Index;
2508 -- For unit based languages, Dot_Replacement, Spec_Suffix and
2509 -- Body_Suffix need to be specified.
2511 if Lang_Data.Config.Naming_Data.Dot_Replacement = No_File then
2515 "Dot_Replacement not specified for Ada",
2519 if Lang_Data.Config.Naming_Data.Spec_Suffix = No_File then
2523 "Spec_Suffix not specified for Ada",
2527 if Lang_Data.Config.Naming_Data.Body_Suffix = No_File then
2531 "Body_Suffix not specified for Ada",
2536 Prev_Index := Lang_Index;
2538 -- For file based languages, either Spec_Suffix or Body_Suffix
2539 -- need to be specified.
2541 if Lang_Data.Config.Naming_Data.Spec_Suffix = No_File and then
2542 Lang_Data.Config.Naming_Data.Body_Suffix = No_File
2544 Error_Msg_Name_1 := Current_Language;
2548 "no suffixes specified for %%",
2553 Lang_Index := Lang_Data.Next;
2555 end Check_Configuration;
2557 -------------------------------
2558 -- Check_If_Externally_Built --
2559 -------------------------------
2561 procedure Check_If_Externally_Built
2562 (Project : Project_Id;
2563 In_Tree : Project_Tree_Ref;
2564 Data : in out Project_Data)
2566 Externally_Built : constant Variable_Value :=
2568 (Name_Externally_Built,
2569 Data.Decl.Attributes, In_Tree);
2572 if not Externally_Built.Default then
2573 Get_Name_String (Externally_Built.Value);
2574 To_Lower (Name_Buffer (1 .. Name_Len));
2576 if Name_Buffer (1 .. Name_Len) = "true" then
2577 Data.Externally_Built := True;
2579 elsif Name_Buffer (1 .. Name_Len) /= "false" then
2580 Error_Msg (Project, In_Tree,
2581 "Externally_Built may only be true or false",
2582 Externally_Built.Location);
2586 -- A virtual project extending an externally built project is itself
2587 -- externally built.
2589 if Data.Virtual and then Data.Extends /= No_Project then
2590 Data.Externally_Built :=
2591 In_Tree.Projects.Table (Data.Extends).Externally_Built;
2594 if Current_Verbosity = High then
2595 Write_Str ("Project is ");
2597 if not Data.Externally_Built then
2601 Write_Line ("externally built.");
2603 end Check_If_Externally_Built;
2605 ----------------------
2606 -- Check_Interfaces --
2607 ----------------------
2609 procedure Check_Interfaces
2610 (Project : Project_Id;
2611 In_Tree : Project_Tree_Ref;
2612 Data : in out Project_Data)
2614 Interfaces : constant Prj.Variable_Value :=
2616 (Snames.Name_Interfaces,
2617 Data.Decl.Attributes,
2620 List : String_List_Id;
2621 Element : String_Element;
2622 Name : File_Name_Type;
2626 Project_2 : Project_Id;
2627 Data_2 : Project_Data;
2630 if not Interfaces.Default then
2632 -- Set In_Interfaces to False for all sources. It will be set to True
2633 -- later for the sources in the Interfaces list.
2635 Project_2 := Project;
2638 Source := Data_2.First_Source;
2639 while Source /= No_Source loop
2641 Src_Data : Source_Data renames
2642 In_Tree.Sources.Table (Source);
2644 Src_Data.In_Interfaces := False;
2645 Source := Src_Data.Next_In_Project;
2649 Project_2 := Data_2.Extends;
2651 exit when Project_2 = No_Project;
2653 Data_2 := In_Tree.Projects.Table (Project_2);
2656 List := Interfaces.Values;
2657 while List /= Nil_String loop
2658 Element := In_Tree.String_Elements.Table (List);
2659 Name := Canonical_Case_File_Name (Element.Value);
2661 Project_2 := Project;
2665 Source := Data_2.First_Source;
2666 while Source /= No_Source loop
2668 Src_Data : Source_Data renames
2669 In_Tree.Sources.Table (Source);
2672 if Src_Data.File = Name then
2673 if not Src_Data.Locally_Removed then
2674 Src_Data.In_Interfaces := True;
2675 Src_Data.Declared_In_Interfaces := True;
2677 if Src_Data.Other_Part /= No_Source then
2678 In_Tree.Sources.Table
2679 (Src_Data.Other_Part).In_Interfaces := True;
2680 In_Tree.Sources.Table
2681 (Src_Data.Other_Part).Declared_In_Interfaces :=
2685 if Current_Verbosity = High then
2686 Write_Str (" interface: ");
2688 (Get_Name_String (Src_Data.Path.Name));
2695 Source := Src_Data.Next_In_Project;
2699 Project_2 := Data_2.Extends;
2701 exit Big_Loop when Project_2 = No_Project;
2703 Data_2 := In_Tree.Projects.Table (Project_2);
2706 if Source = No_Source then
2707 Error_Msg_File_1 := File_Name_Type (Element.Value);
2708 Error_Msg_Name_1 := Data.Name;
2713 "{ cannot be an interface of project %% "
2714 & "as it is not one of its sources",
2718 List := Element.Next;
2721 Data.Interfaces_Defined := True;
2723 elsif Data.Extends /= No_Project then
2724 Data.Interfaces_Defined :=
2725 In_Tree.Projects.Table (Data.Extends).Interfaces_Defined;
2727 if Data.Interfaces_Defined then
2728 Source := Data.First_Source;
2729 while Source /= No_Source loop
2731 Src_Data : Source_Data renames
2732 In_Tree.Sources.Table (Source);
2735 if not Src_Data.Declared_In_Interfaces then
2736 Src_Data.In_Interfaces := False;
2739 Source := Src_Data.Next_In_Project;
2744 end Check_Interfaces;
2746 ------------------------------------
2747 -- Check_And_Normalize_Unit_Names --
2748 ------------------------------------
2750 procedure Check_And_Normalize_Unit_Names
2751 (Project : Project_Id;
2752 In_Tree : Project_Tree_Ref;
2753 List : Array_Element_Id;
2754 Debug_Name : String)
2756 Current : Array_Element_Id;
2757 Element : Array_Element;
2758 Unit_Name : Name_Id;
2761 if Current_Verbosity = High then
2762 Write_Line (" Checking unit names in " & Debug_Name);
2766 while Current /= No_Array_Element loop
2767 Element := In_Tree.Array_Elements.Table (Current);
2768 Element.Value.Value :=
2769 Name_Id (Canonical_Case_File_Name (Element.Value.Value));
2771 -- Check that it contains a valid unit name
2773 Get_Name_String (Element.Index);
2774 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name);
2776 if Unit_Name = No_Name then
2777 Err_Vars.Error_Msg_Name_1 := Element.Index;
2780 "%% is not a valid unit name.",
2781 Element.Value.Location);
2784 if Current_Verbosity = High then
2785 Write_Str (" for unit: ");
2786 Write_Line (Get_Name_String (Unit_Name));
2789 Element.Index := Unit_Name;
2790 In_Tree.Array_Elements.Table (Current) := Element;
2793 Current := Element.Next;
2795 end Check_And_Normalize_Unit_Names;
2797 --------------------------
2798 -- Check_Naming_Schemes --
2799 --------------------------
2801 procedure Check_Naming_Schemes
2802 (Data : in out Project_Data;
2803 Project : Project_Id;
2804 In_Tree : Project_Tree_Ref)
2806 Naming_Id : constant Package_Id :=
2807 Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
2808 Naming : Package_Element;
2810 procedure Check_Naming_Ada_Only;
2811 -- Does Check_Naming_Schemes processing in Ada_Only mode.
2812 -- If there is a package Naming, puts in Data.Naming the contents of
2815 procedure Check_Naming_Multi_Lang;
2816 -- Does Check_Naming_Schemes processing for Multi_Language mode
2818 procedure Check_Common
2819 (Dot_Replacement : in out File_Name_Type;
2820 Casing : in out Casing_Type;
2821 Casing_Defined : out Boolean;
2822 Separate_Suffix : in out File_Name_Type;
2823 Sep_Suffix_Loc : out Source_Ptr);
2824 -- Check attributes common to Ada_Only and Multi_Lang modes
2826 procedure Process_Exceptions_File_Based
2827 (Lang_Id : Language_Index;
2828 Kind : Source_Kind);
2829 procedure Process_Exceptions_Unit_Based
2830 (Lang_Id : Language_Index;
2831 Kind : Source_Kind);
2832 -- In Multi_Lang mode, process the naming exceptions for the two types
2833 -- of languages we can have.
2839 procedure Check_Common
2840 (Dot_Replacement : in out File_Name_Type;
2841 Casing : in out Casing_Type;
2842 Casing_Defined : out Boolean;
2843 Separate_Suffix : in out File_Name_Type;
2844 Sep_Suffix_Loc : out Source_Ptr)
2846 Dot_Repl : constant Variable_Value :=
2848 (Name_Dot_Replacement,
2849 Naming.Decl.Attributes,
2851 Casing_String : constant Variable_Value :=
2854 Naming.Decl.Attributes,
2856 Sep_Suffix : constant Variable_Value :=
2858 (Name_Separate_Suffix,
2859 Naming.Decl.Attributes,
2861 Dot_Repl_Loc : Source_Ptr;
2864 Sep_Suffix_Loc := No_Location;
2866 if not Dot_Repl.Default then
2868 (Dot_Repl.Kind = Single, "Dot_Replacement is not a string");
2870 if Length_Of_Name (Dot_Repl.Value) = 0 then
2873 "Dot_Replacement cannot be empty",
2877 Dot_Replacement := Canonical_Case_File_Name (Dot_Repl.Value);
2878 Dot_Repl_Loc := Dot_Repl.Location;
2881 Repl : constant String := Get_Name_String (Dot_Replacement);
2884 -- Dot_Replacement cannot
2886 -- - start or end with an alphanumeric
2887 -- - be a single '_'
2888 -- - start with an '_' followed by an alphanumeric
2889 -- - contain a '.' except if it is "."
2892 or else Is_Alphanumeric (Repl (Repl'First))
2893 or else Is_Alphanumeric (Repl (Repl'Last))
2894 or else (Repl (Repl'First) = '_'
2898 Is_Alphanumeric (Repl (Repl'First + 1))))
2899 or else (Repl'Length > 1
2901 Index (Source => Repl, Pattern => ".") /= 0)
2906 """ is illegal for Dot_Replacement.",
2912 if Dot_Replacement /= No_File then
2914 ("Dot_Replacement", Get_Name_String (Dot_Replacement));
2917 Casing_Defined := False;
2919 if not Casing_String.Default then
2921 (Casing_String.Kind = Single, "Casing is not a string");
2924 Casing_Image : constant String :=
2925 Get_Name_String (Casing_String.Value);
2927 if Casing_Image'Length = 0 then
2930 "Casing cannot be an empty string",
2931 Casing_String.Location);
2934 Casing := Value (Casing_Image);
2935 Casing_Defined := True;
2938 when Constraint_Error =>
2939 Name_Len := Casing_Image'Length;
2940 Name_Buffer (1 .. Name_Len) := Casing_Image;
2941 Err_Vars.Error_Msg_Name_1 := Name_Find;
2944 "%% is not a correct Casing",
2945 Casing_String.Location);
2949 Write_Attr ("Casing", Image (Casing));
2951 if not Sep_Suffix.Default then
2952 if Length_Of_Name (Sep_Suffix.Value) = 0 then
2955 "Separate_Suffix cannot be empty",
2956 Sep_Suffix.Location);
2959 Separate_Suffix := Canonical_Case_File_Name (Sep_Suffix.Value);
2960 Sep_Suffix_Loc := Sep_Suffix.Location;
2962 if Is_Illegal_Suffix (Separate_Suffix, Dot_Replacement) then
2963 Err_Vars.Error_Msg_File_1 := Separate_Suffix;
2966 "{ is illegal for Separate_Suffix",
2967 Sep_Suffix.Location);
2972 if Separate_Suffix /= No_File then
2974 ("Separate_Suffix", Get_Name_String (Separate_Suffix));
2978 -----------------------------------
2979 -- Process_Exceptions_File_Based --
2980 -----------------------------------
2982 procedure Process_Exceptions_File_Based
2983 (Lang_Id : Language_Index;
2986 Lang : constant Name_Id :=
2987 In_Tree.Languages_Data.Table (Lang_Id).Name;
2988 Exceptions : Array_Element_Id;
2989 Exception_List : Variable_Value;
2990 Element_Id : String_List_Id;
2991 Element : String_Element;
2992 File_Name : File_Name_Type;
3000 (Name_Implementation_Exceptions,
3001 In_Arrays => Naming.Decl.Arrays,
3002 In_Tree => In_Tree);
3007 (Name_Specification_Exceptions,
3008 In_Arrays => Naming.Decl.Arrays,
3009 In_Tree => In_Tree);
3012 Exception_List := Value_Of
3014 In_Array => Exceptions,
3015 In_Tree => In_Tree);
3017 if Exception_List /= Nil_Variable_Value then
3018 Element_Id := Exception_List.Values;
3019 while Element_Id /= Nil_String loop
3020 Element := In_Tree.String_Elements.Table (Element_Id);
3021 File_Name := Canonical_Case_File_Name (Element.Value);
3023 Source := Data.First_Source;
3024 while Source /= No_Source
3025 and then In_Tree.Sources.Table (Source).File /= File_Name
3027 Source := In_Tree.Sources.Table (Source).Next_In_Project;
3030 if Source = No_Source then
3039 File_Name => File_Name,
3040 Display_File => File_Name_Type (Element.Value),
3041 Naming_Exception => True,
3042 Lang_Kind => File_Based);
3045 -- Check if the file name is already recorded for another
3046 -- language or another kind.
3048 if In_Tree.Sources.Table (Source).Language /= Lang_Id then
3052 "the same file cannot be a source of two languages",
3055 elsif In_Tree.Sources.Table (Source).Kind /= Kind then
3059 "the same file cannot be a source and a template",
3063 -- If the file is already recorded for the same
3064 -- language and the same kind, it means that the file
3065 -- name appears several times in the *_Exceptions
3066 -- attribute; so there is nothing to do.
3069 Element_Id := Element.Next;
3072 end Process_Exceptions_File_Based;
3074 -----------------------------------
3075 -- Process_Exceptions_Unit_Based --
3076 -----------------------------------
3078 procedure Process_Exceptions_Unit_Based
3079 (Lang_Id : Language_Index;
3082 Lang : constant Name_Id :=
3083 In_Tree.Languages_Data.Table (Lang_Id).Name;
3084 Exceptions : Array_Element_Id;
3085 Element : Array_Element;
3088 File_Name : File_Name_Type;
3090 Source_To_Replace : Source_Id := No_Source;
3091 Other_Project : Project_Id;
3092 Other_Part : Source_Id := No_Source;
3097 Exceptions := Value_Of
3099 In_Arrays => Naming.Decl.Arrays,
3100 In_Tree => In_Tree);
3102 if Exceptions = No_Array_Element then
3105 (Name_Implementation,
3106 In_Arrays => Naming.Decl.Arrays,
3107 In_Tree => In_Tree);
3114 In_Arrays => Naming.Decl.Arrays,
3115 In_Tree => In_Tree);
3117 if Exceptions = No_Array_Element then
3118 Exceptions := Value_Of
3119 (Name_Specification,
3120 In_Arrays => Naming.Decl.Arrays,
3121 In_Tree => In_Tree);
3125 while Exceptions /= No_Array_Element loop
3126 Element := In_Tree.Array_Elements.Table (Exceptions);
3127 File_Name := Canonical_Case_File_Name (Element.Value.Value);
3129 Get_Name_String (Element.Index);
3130 To_Lower (Name_Buffer (1 .. Name_Len));
3132 Index := Element.Value.Index;
3134 -- For Ada, check if it is a valid unit name
3136 if Lang = Name_Ada then
3137 Get_Name_String (Element.Index);
3138 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
3140 if Unit = No_Name then
3141 Err_Vars.Error_Msg_Name_1 := Element.Index;
3144 "%% is not a valid unit name.",
3145 Element.Value.Location);
3149 if Unit /= No_Name then
3151 -- Check if the source already exists
3153 Source := In_Tree.First_Source;
3154 Source_To_Replace := No_Source;
3156 while Source /= No_Source and then
3157 (In_Tree.Sources.Table (Source).Unit /= Unit or else
3158 In_Tree.Sources.Table (Source).Index /= Index)
3160 Source := In_Tree.Sources.Table (Source).Next_In_Sources;
3163 if Source /= No_Source then
3164 if In_Tree.Sources.Table (Source).Kind /= Kind then
3165 Other_Part := Source;
3169 In_Tree.Sources.Table (Source).Next_In_Sources;
3171 exit when Source = No_Source or else
3172 (In_Tree.Sources.Table (Source).Unit = Unit
3174 In_Tree.Sources.Table (Source).Index = Index);
3178 if Source /= No_Source then
3179 Other_Project := In_Tree.Sources.Table (Source).Project;
3181 if Is_Extending (Project, Other_Project, In_Tree) then
3183 In_Tree.Sources.Table (Source).Other_Part;
3185 -- Record the source to be removed
3187 Source_To_Replace := Source;
3188 Source := No_Source;
3191 Error_Msg_Name_1 := Unit;
3193 In_Tree.Projects.Table (Other_Project).Name;
3197 "%% is already a source of project %%",
3198 Element.Value.Location);
3203 if Source = No_Source then
3212 File_Name => File_Name,
3213 Display_File => File_Name_Type (Element.Value.Value),
3214 Lang_Kind => Unit_Based,
3215 Other_Part => Other_Part,
3218 Naming_Exception => True,
3219 Source_To_Replace => Source_To_Replace);
3223 Exceptions := Element.Next;
3225 end Process_Exceptions_Unit_Based;
3227 ---------------------------
3228 -- Check_Naming_Ada_Only --
3229 ---------------------------
3231 procedure Check_Naming_Ada_Only is
3232 Casing_Defined : Boolean;
3233 Spec_Suffix : File_Name_Type;
3234 Body_Suffix : File_Name_Type;
3235 Sep_Suffix_Loc : Source_Ptr;
3237 Ada_Spec_Suffix : constant Variable_Value :=
3241 In_Array => Data.Naming.Spec_Suffix,
3242 In_Tree => In_Tree);
3244 Ada_Body_Suffix : constant Variable_Value :=
3248 In_Array => Data.Naming.Body_Suffix,
3249 In_Tree => In_Tree);
3252 -- The default value of separate suffix should be the same as the
3253 -- body suffix, so we need to compute that first.
3255 if Ada_Body_Suffix.Kind = Single
3256 and then Length_Of_Name (Ada_Body_Suffix.Value) /= 0
3258 Body_Suffix := Canonical_Case_File_Name (Ada_Body_Suffix.Value);
3259 Data.Naming.Separate_Suffix := Body_Suffix;
3260 Set_Body_Suffix (In_Tree, "ada", Data.Naming, Body_Suffix);
3263 Body_Suffix := Default_Ada_Body_Suffix;
3264 Data.Naming.Separate_Suffix := Body_Suffix;
3265 Set_Body_Suffix (In_Tree, "ada", Data.Naming, Body_Suffix);
3268 Write_Attr ("Body_Suffix", Get_Name_String (Body_Suffix));
3270 -- We'll need the dot replacement below, so compute it now
3273 (Dot_Replacement => Data.Naming.Dot_Replacement,
3274 Casing => Data.Naming.Casing,
3275 Casing_Defined => Casing_Defined,
3276 Separate_Suffix => Data.Naming.Separate_Suffix,
3277 Sep_Suffix_Loc => Sep_Suffix_Loc);
3279 Data.Naming.Bodies :=
3280 Util.Value_Of (Name_Body, Naming.Decl.Arrays, In_Tree);
3282 if Data.Naming.Bodies /= No_Array_Element then
3283 Check_And_Normalize_Unit_Names
3284 (Project, In_Tree, Data.Naming.Bodies, "Naming.Bodies");
3287 Data.Naming.Specs :=
3288 Util.Value_Of (Name_Spec, Naming.Decl.Arrays, In_Tree);
3290 if Data.Naming.Specs /= No_Array_Element then
3291 Check_And_Normalize_Unit_Names
3292 (Project, In_Tree, Data.Naming.Specs, "Naming.Specs");
3295 -- Check Spec_Suffix
3297 if Ada_Spec_Suffix.Kind = Single
3298 and then Length_Of_Name (Ada_Spec_Suffix.Value) /= 0
3300 Spec_Suffix := Canonical_Case_File_Name (Ada_Spec_Suffix.Value);
3301 Set_Spec_Suffix (In_Tree, "ada", Data.Naming, Spec_Suffix);
3303 if Is_Illegal_Suffix
3304 (Spec_Suffix, Data.Naming.Dot_Replacement)
3306 Err_Vars.Error_Msg_File_1 := Spec_Suffix;
3309 "{ is illegal for Spec_Suffix",
3310 Ada_Spec_Suffix.Location);
3314 Spec_Suffix := Default_Ada_Spec_Suffix;
3315 Set_Spec_Suffix (In_Tree, "ada", Data.Naming, Spec_Suffix);
3318 Write_Attr ("Spec_Suffix", Get_Name_String (Spec_Suffix));
3320 -- Check Body_Suffix
3322 if Is_Illegal_Suffix (Body_Suffix, Data.Naming.Dot_Replacement) then
3323 Err_Vars.Error_Msg_File_1 := Body_Suffix;
3326 "{ is illegal for Body_Suffix",
3327 Ada_Body_Suffix.Location);
3330 -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
3331 -- since that would cause a clear ambiguity. Note that we do allow a
3332 -- Spec_Suffix to have the same termination as one of these, which
3333 -- causes a potential ambiguity, but we resolve that my matching the
3334 -- longest possible suffix.
3336 if Spec_Suffix = Body_Suffix then
3340 Get_Name_String (Body_Suffix) &
3341 """) cannot be the same as Spec_Suffix.",
3342 Ada_Body_Suffix.Location);
3345 if Body_Suffix /= Data.Naming.Separate_Suffix
3346 and then Spec_Suffix = Data.Naming.Separate_Suffix
3350 "Separate_Suffix (""" &
3351 Get_Name_String (Data.Naming.Separate_Suffix) &
3352 """) cannot be the same as Spec_Suffix.",
3355 end Check_Naming_Ada_Only;
3357 -----------------------------
3358 -- Check_Naming_Multi_Lang --
3359 -----------------------------
3361 procedure Check_Naming_Multi_Lang is
3362 Dot_Replacement : File_Name_Type := No_File;
3363 Separate_Suffix : File_Name_Type := No_File;
3364 Casing : Casing_Type := All_Lower_Case;
3365 Casing_Defined : Boolean;
3366 Lang_Id : Language_Index;
3367 Sep_Suffix_Loc : Source_Ptr;
3368 Suffix : Variable_Value;
3373 (Dot_Replacement => Dot_Replacement,
3375 Casing_Defined => Casing_Defined,
3376 Separate_Suffix => Separate_Suffix,
3377 Sep_Suffix_Loc => Sep_Suffix_Loc);
3379 -- For all unit based languages, if any, set the specified
3380 -- value of Dot_Replacement, Casing and/or Separate_Suffix. Do not
3381 -- systematically overwrite, since the defaults come from the
3382 -- configuration file
3384 if Dot_Replacement /= No_File
3385 or else Casing_Defined
3386 or else Separate_Suffix /= No_File
3388 Lang_Id := Data.First_Language_Processing;
3389 while Lang_Id /= No_Language_Index loop
3390 if In_Tree.Languages_Data.
3391 Table (Lang_Id).Config.Kind = Unit_Based
3393 if Dot_Replacement /= No_File then
3394 In_Tree.Languages_Data.Table
3395 (Lang_Id).Config.Naming_Data.Dot_Replacement :=
3399 if Casing_Defined then
3400 In_Tree.Languages_Data.Table
3401 (Lang_Id).Config.Naming_Data.Casing := Casing;
3404 if Separate_Suffix /= No_File then
3405 In_Tree.Languages_Data.Table
3406 (Lang_Id).Config.Naming_Data.Separate_Suffix :=
3411 Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next;
3415 -- Next, get the spec and body suffixes
3417 Lang_Id := Data.First_Language_Processing;
3418 while Lang_Id /= No_Language_Index loop
3419 Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
3425 Attribute_Or_Array_Name => Name_Spec_Suffix,
3426 In_Package => Naming_Id,
3427 In_Tree => In_Tree);
3429 if Suffix = Nil_Variable_Value then
3432 Attribute_Or_Array_Name => Name_Specification_Suffix,
3433 In_Package => Naming_Id,
3434 In_Tree => In_Tree);
3437 if Suffix /= Nil_Variable_Value then
3438 In_Tree.Languages_Data.Table (Lang_Id).
3439 Config.Naming_Data.Spec_Suffix :=
3440 File_Name_Type (Suffix.Value);
3447 Attribute_Or_Array_Name => Name_Body_Suffix,
3448 In_Package => Naming_Id,
3449 In_Tree => In_Tree);
3451 if Suffix = Nil_Variable_Value then
3454 Attribute_Or_Array_Name => Name_Implementation_Suffix,
3455 In_Package => Naming_Id,
3456 In_Tree => In_Tree);
3459 if Suffix /= Nil_Variable_Value then
3460 In_Tree.Languages_Data.Table (Lang_Id).
3461 Config.Naming_Data.Body_Suffix :=
3462 File_Name_Type (Suffix.Value);
3465 -- ??? As opposed to what is done in Check_Naming_Ada_Only,
3466 -- we do not check whether spec_suffix=body_suffix, which
3467 -- should be illegal. Best would be to share this code into
3468 -- Check_Common, but we access the attributes from the project
3469 -- files slightly differently apparently.
3471 Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next;
3474 -- Get the naming exceptions for all languages
3476 for Kind in Spec .. Impl loop
3477 Lang_Id := Data.First_Language_Processing;
3478 while Lang_Id /= No_Language_Index loop
3479 case In_Tree.Languages_Data.Table (Lang_Id).Config.Kind is
3481 Process_Exceptions_File_Based (Lang_Id, Kind);
3484 Process_Exceptions_Unit_Based (Lang_Id, Kind);
3487 Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next;
3490 end Check_Naming_Multi_Lang;
3492 -- Start of processing for Check_Naming_Schemes
3495 -- No Naming package or parsing a configuration file? nothing to do
3497 if Naming_Id /= No_Package and not In_Configuration then
3498 Naming := In_Tree.Packages.Table (Naming_Id);
3500 if Current_Verbosity = High then
3501 Write_Line ("Checking package Naming.");
3506 Check_Naming_Ada_Only;
3507 when Multi_Language =>
3508 Check_Naming_Multi_Lang;
3511 end Check_Naming_Schemes;
3513 ------------------------------
3514 -- Check_Library_Attributes --
3515 ------------------------------
3517 procedure Check_Library_Attributes
3518 (Project : Project_Id;
3519 In_Tree : Project_Tree_Ref;
3520 Current_Dir : String;
3521 Data : in out Project_Data)
3523 Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
3525 Lib_Dir : constant Prj.Variable_Value :=
3527 (Snames.Name_Library_Dir, Attributes, In_Tree);
3529 Lib_Name : constant Prj.Variable_Value :=
3531 (Snames.Name_Library_Name, Attributes, In_Tree);
3533 Lib_Version : constant Prj.Variable_Value :=
3535 (Snames.Name_Library_Version, Attributes, In_Tree);
3537 Lib_ALI_Dir : constant Prj.Variable_Value :=
3539 (Snames.Name_Library_Ali_Dir, Attributes, In_Tree);
3541 Lib_GCC : constant Prj.Variable_Value :=
3543 (Snames.Name_Library_GCC, Attributes, In_Tree);
3545 The_Lib_Kind : constant Prj.Variable_Value :=
3547 (Snames.Name_Library_Kind, Attributes, In_Tree);
3549 Imported_Project_List : Project_List := Empty_Project_List;
3551 Continuation : String_Access := No_Continuation_String'Access;
3553 Support_For_Libraries : Library_Support;
3555 Library_Directory_Present : Boolean;
3557 procedure Check_Library (Proj : Project_Id; Extends : Boolean);
3558 -- Check if an imported or extended project if also a library project
3564 procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
3565 Proj_Data : Project_Data;
3569 if Proj /= No_Project then
3570 Proj_Data := In_Tree.Projects.Table (Proj);
3572 if not Proj_Data.Library then
3574 -- The only not library projects that are OK are those that
3575 -- have no sources. However, header files from non-Ada
3576 -- languages are OK, as there is nothing to compile.
3578 Src_Id := Proj_Data.First_Source;
3579 while Src_Id /= No_Source loop
3581 Src : Source_Data renames In_Tree.Sources.Table (Src_Id);
3583 exit when Src.Lang_Kind /= File_Based
3584 or else Src.Kind /= Spec;
3585 Src_Id := Src.Next_In_Project;
3589 if Src_Id /= No_Source then
3590 Error_Msg_Name_1 := Data.Name;
3591 Error_Msg_Name_2 := Proj_Data.Name;
3594 if Data.Library_Kind /= Static then
3598 "shared library project %% cannot extend " &
3599 "project %% that is not a library project",
3601 Continuation := Continuation_String'Access;
3604 elsif Data.Library_Kind /= Static then
3608 "shared library project %% cannot import project %% " &
3609 "that is not a shared library project",
3611 Continuation := Continuation_String'Access;
3615 elsif Data.Library_Kind /= Static and then
3616 Proj_Data.Library_Kind = Static
3618 Error_Msg_Name_1 := Data.Name;
3619 Error_Msg_Name_2 := Proj_Data.Name;
3625 "shared library project %% cannot extend static " &
3626 "library project %%",
3633 "shared library project %% cannot import static " &
3634 "library project %%",
3638 Continuation := Continuation_String'Access;
3643 -- Start of processing for Check_Library_Attributes
3646 Library_Directory_Present := Lib_Dir.Value /= Empty_String;
3648 -- Special case of extending project
3650 if Data.Extends /= No_Project then
3652 Extended_Data : constant Project_Data :=
3653 In_Tree.Projects.Table (Data.Extends);
3656 -- If the project extended is a library project, we inherit the
3657 -- library name, if it is not redefined; we check that the library
3658 -- directory is specified.
3660 if Extended_Data.Library then
3661 if Data.Qualifier = Standard then
3664 "a standard project cannot extend a library project",
3668 if Lib_Name.Default then
3669 Data.Library_Name := Extended_Data.Library_Name;
3672 if Lib_Dir.Default then
3673 if not Data.Virtual then
3676 "a project extending a library project must " &
3677 "specify an attribute Library_Dir",
3681 -- For a virtual project extending a library project,
3682 -- inherit library directory.
3684 Data.Library_Dir := Extended_Data.Library_Dir;
3685 Library_Directory_Present := True;
3693 pragma Assert (Lib_Name.Kind = Single);
3695 if Lib_Name.Value = Empty_String then
3696 if Current_Verbosity = High
3697 and then Data.Library_Name = No_Name
3699 Write_Line ("No library name");
3703 -- There is no restriction on the syntax of library names
3705 Data.Library_Name := Lib_Name.Value;
3708 if Data.Library_Name /= No_Name then
3709 if Current_Verbosity = High then
3710 Write_Attr ("Library name", Get_Name_String (Data.Library_Name));
3713 pragma Assert (Lib_Dir.Kind = Single);
3715 if not Library_Directory_Present then
3716 if Current_Verbosity = High then
3717 Write_Line ("No library directory");
3721 -- Find path name (unless inherited), check that it is a directory
3723 if Data.Library_Dir = No_Path_Information then
3727 File_Name_Type (Lib_Dir.Value),
3728 Data.Directory.Display_Name,
3729 Data.Library_Dir.Name,
3730 Data.Library_Dir.Display_Name,
3731 Create => "library",
3732 Current_Dir => Current_Dir,
3733 Location => Lib_Dir.Location,
3734 Externally_Built => Data.Externally_Built);
3737 if Data.Library_Dir = No_Path_Information then
3739 -- Get the absolute name of the library directory that
3740 -- does not exist, to report an error.
3743 Dir_Name : constant String :=
3744 Get_Name_String (Lib_Dir.Value);
3747 if Is_Absolute_Path (Dir_Name) then
3748 Err_Vars.Error_Msg_File_1 :=
3749 File_Name_Type (Lib_Dir.Value);
3752 Get_Name_String (Data.Directory.Display_Name);
3754 if Name_Buffer (Name_Len) /= Directory_Separator then
3755 Name_Len := Name_Len + 1;
3756 Name_Buffer (Name_Len) := Directory_Separator;
3760 (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
3762 Name_Len := Name_Len + Dir_Name'Length;
3763 Err_Vars.Error_Msg_File_1 := Name_Find;
3770 "library directory { does not exist",
3774 -- The library directory cannot be the same as the Object
3777 elsif Data.Library_Dir.Name = Data.Object_Directory.Name then
3780 "library directory cannot be the same " &
3781 "as object directory",
3783 Data.Library_Dir := No_Path_Information;
3787 OK : Boolean := True;
3788 Dirs_Id : String_List_Id;
3789 Dir_Elem : String_Element;
3792 -- The library directory cannot be the same as a source
3793 -- directory of the current project.
3795 Dirs_Id := Data.Source_Dirs;
3796 while Dirs_Id /= Nil_String loop
3797 Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
3798 Dirs_Id := Dir_Elem.Next;
3801 Data.Library_Dir.Name = Path_Name_Type (Dir_Elem.Value)
3803 Err_Vars.Error_Msg_File_1 :=
3804 File_Name_Type (Dir_Elem.Value);
3807 "library directory cannot be the same " &
3808 "as source directory {",
3817 -- The library directory cannot be the same as a source
3818 -- directory of another project either.
3821 for Pid in 1 .. Project_Table.Last (In_Tree.Projects) loop
3822 if Pid /= Project then
3823 Dirs_Id := In_Tree.Projects.Table (Pid).Source_Dirs;
3825 Dir_Loop : while Dirs_Id /= Nil_String loop
3827 In_Tree.String_Elements.Table (Dirs_Id);
3828 Dirs_Id := Dir_Elem.Next;
3830 if Data.Library_Dir.Name =
3831 Path_Name_Type (Dir_Elem.Value)
3833 Err_Vars.Error_Msg_File_1 :=
3834 File_Name_Type (Dir_Elem.Value);
3835 Err_Vars.Error_Msg_Name_1 :=
3836 In_Tree.Projects.Table (Pid).Name;
3840 "library directory cannot be the same " &
3841 "as source directory { of project %%",
3848 end loop Project_Loop;
3852 Data.Library_Dir := No_Path_Information;
3854 elsif Current_Verbosity = High then
3856 -- Display the Library directory in high verbosity
3859 ("Library directory",
3860 Get_Name_String (Data.Library_Dir.Display_Name));
3869 Data.Library_Dir /= No_Path_Information
3871 Data.Library_Name /= No_Name;
3873 if Data.Extends = No_Project then
3874 case Data.Qualifier is
3876 if Data.Library then
3879 "a standard project cannot be a library project",
3884 if not Data.Library then
3885 if Data.Library_Dir = No_Path_Information then
3888 "\attribute Library_Dir not declared",
3892 if Data.Library_Name = No_Name then
3895 "\attribute Library_Name not declared",
3906 if Data.Library then
3907 if Get_Mode = Multi_Language then
3908 Support_For_Libraries := Data.Config.Lib_Support;
3911 Support_For_Libraries := MLib.Tgt.Support_For_Libraries;
3914 if Support_For_Libraries = Prj.None then
3917 "?libraries are not supported on this platform",
3919 Data.Library := False;
3922 if Lib_ALI_Dir.Value = Empty_String then
3923 if Current_Verbosity = High then
3924 Write_Line ("No library ALI directory specified");
3926 Data.Library_ALI_Dir := Data.Library_Dir;
3929 -- Find path name, check that it is a directory
3934 File_Name_Type (Lib_ALI_Dir.Value),
3935 Data.Directory.Display_Name,
3936 Data.Library_ALI_Dir.Name,
3937 Data.Library_ALI_Dir.Display_Name,
3938 Create => "library ALI",
3939 Current_Dir => Current_Dir,
3940 Location => Lib_ALI_Dir.Location,
3941 Externally_Built => Data.Externally_Built);
3943 if Data.Library_ALI_Dir = No_Path_Information then
3945 -- Get the absolute name of the library ALI directory that
3946 -- does not exist, to report an error.
3949 Dir_Name : constant String :=
3950 Get_Name_String (Lib_ALI_Dir.Value);
3953 if Is_Absolute_Path (Dir_Name) then
3954 Err_Vars.Error_Msg_File_1 :=
3955 File_Name_Type (Lib_Dir.Value);
3958 Get_Name_String (Data.Directory.Display_Name);
3960 if Name_Buffer (Name_Len) /= Directory_Separator then
3961 Name_Len := Name_Len + 1;
3962 Name_Buffer (Name_Len) := Directory_Separator;
3966 (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
3968 Name_Len := Name_Len + Dir_Name'Length;
3969 Err_Vars.Error_Msg_File_1 := Name_Find;
3976 "library 'A'L'I directory { does not exist",
3977 Lib_ALI_Dir.Location);
3981 if Data.Library_ALI_Dir /= Data.Library_Dir then
3983 -- The library ALI directory cannot be the same as the
3984 -- Object directory.
3986 if Data.Library_ALI_Dir = Data.Object_Directory then
3989 "library 'A'L'I directory cannot be the same " &
3990 "as object directory",
3991 Lib_ALI_Dir.Location);
3992 Data.Library_ALI_Dir := No_Path_Information;
3996 OK : Boolean := True;
3997 Dirs_Id : String_List_Id;
3998 Dir_Elem : String_Element;
4001 -- The library ALI directory cannot be the same as
4002 -- a source directory of the current project.
4004 Dirs_Id := Data.Source_Dirs;
4005 while Dirs_Id /= Nil_String loop
4006 Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
4007 Dirs_Id := Dir_Elem.Next;
4009 if Data.Library_ALI_Dir.Name =
4010 Path_Name_Type (Dir_Elem.Value)
4012 Err_Vars.Error_Msg_File_1 :=
4013 File_Name_Type (Dir_Elem.Value);
4016 "library 'A'L'I directory cannot be " &
4017 "the same as source directory {",
4018 Lib_ALI_Dir.Location);
4026 -- The library ALI directory cannot be the same as
4027 -- a source directory of another project either.
4031 Pid in 1 .. Project_Table.Last (In_Tree.Projects)
4033 if Pid /= Project then
4035 In_Tree.Projects.Table (Pid).Source_Dirs;
4038 while Dirs_Id /= Nil_String loop
4040 In_Tree.String_Elements.Table (Dirs_Id);
4041 Dirs_Id := Dir_Elem.Next;
4043 if Data.Library_ALI_Dir.Name =
4044 Path_Name_Type (Dir_Elem.Value)
4046 Err_Vars.Error_Msg_File_1 :=
4047 File_Name_Type (Dir_Elem.Value);
4048 Err_Vars.Error_Msg_Name_1 :=
4049 In_Tree.Projects.Table (Pid).Name;
4053 "library 'A'L'I directory cannot " &
4054 "be the same as source directory " &
4056 Lib_ALI_Dir.Location);
4058 exit ALI_Project_Loop;
4060 end loop ALI_Dir_Loop;
4062 end loop ALI_Project_Loop;
4066 Data.Library_ALI_Dir := No_Path_Information;
4068 elsif Current_Verbosity = High then
4070 -- Display the Library ALI directory in high
4076 (Data.Library_ALI_Dir.Display_Name));
4083 pragma Assert (Lib_Version.Kind = Single);
4085 if Lib_Version.Value = Empty_String then
4086 if Current_Verbosity = High then
4087 Write_Line ("No library version specified");
4091 Data.Lib_Internal_Name := Lib_Version.Value;
4094 pragma Assert (The_Lib_Kind.Kind = Single);
4096 if The_Lib_Kind.Value = Empty_String then
4097 if Current_Verbosity = High then
4098 Write_Line ("No library kind specified");
4102 Get_Name_String (The_Lib_Kind.Value);
4105 Kind_Name : constant String :=
4106 To_Lower (Name_Buffer (1 .. Name_Len));
4108 OK : Boolean := True;
4111 if Kind_Name = "static" then
4112 Data.Library_Kind := Static;
4114 elsif Kind_Name = "dynamic" then
4115 Data.Library_Kind := Dynamic;
4117 elsif Kind_Name = "relocatable" then
4118 Data.Library_Kind := Relocatable;
4123 "illegal value for Library_Kind",
4124 The_Lib_Kind.Location);
4128 if Current_Verbosity = High and then OK then
4129 Write_Attr ("Library kind", Kind_Name);
4132 if Data.Library_Kind /= Static then
4133 if Support_For_Libraries = Prj.Static_Only then
4136 "only static libraries are supported " &
4138 The_Lib_Kind.Location);
4139 Data.Library := False;
4142 -- Check if (obsolescent) attribute Library_GCC or
4143 -- Linker'Driver is declared.
4145 if Lib_GCC.Value /= Empty_String then
4149 "?Library_'G'C'C is an obsolescent attribute, " &
4150 "use Linker''Driver instead",
4152 Data.Config.Shared_Lib_Driver :=
4153 File_Name_Type (Lib_GCC.Value);
4157 Linker : constant Package_Id :=
4162 Driver : constant Variable_Value :=
4165 Attribute_Or_Array_Name =>
4167 In_Package => Linker,
4172 if Driver /= Nil_Variable_Value
4173 and then Driver.Value /= Empty_String
4175 Data.Config.Shared_Lib_Driver :=
4176 File_Name_Type (Driver.Value);
4185 if Data.Library then
4186 if Current_Verbosity = High then
4187 Write_Line ("This is a library project file");
4190 if Get_Mode = Multi_Language then
4191 Check_Library (Data.Extends, Extends => True);
4193 Imported_Project_List := Data.Imported_Projects;
4194 while Imported_Project_List /= Empty_Project_List loop
4196 (In_Tree.Project_Lists.Table
4197 (Imported_Project_List).Project,
4199 Imported_Project_List :=
4200 In_Tree.Project_Lists.Table
4201 (Imported_Project_List).Next;
4209 -- Check if Linker'Switches or Linker'Default_Switches are declared.
4210 -- Warn if they are declared, as it is a common error to think that
4211 -- library are "linked" with Linker switches.
4213 if Data.Library then
4215 Linker_Package_Id : constant Package_Id :=
4217 (Name_Linker, Data.Decl.Packages, In_Tree);
4218 Linker_Package : Package_Element;
4219 Switches : Array_Element_Id := No_Array_Element;
4222 if Linker_Package_Id /= No_Package then
4223 Linker_Package := In_Tree.Packages.Table (Linker_Package_Id);
4227 (Name => Name_Switches,
4228 In_Arrays => Linker_Package.Decl.Arrays,
4229 In_Tree => In_Tree);
4231 if Switches = No_Array_Element then
4234 (Name => Name_Default_Switches,
4235 In_Arrays => Linker_Package.Decl.Arrays,
4236 In_Tree => In_Tree);
4239 if Switches /= No_Array_Element then
4242 "?Linker switches not taken into account in library " &
4250 if Data.Extends /= No_Project then
4251 In_Tree.Projects.Table (Data.Extends).Library := False;
4253 end Check_Library_Attributes;
4255 --------------------------
4256 -- Check_Package_Naming --
4257 --------------------------
4259 procedure Check_Package_Naming
4260 (Project : Project_Id;
4261 In_Tree : Project_Tree_Ref;
4262 Data : in out Project_Data)
4264 Naming_Id : constant Package_Id :=
4265 Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
4267 Naming : Package_Element;
4270 -- If there is a package Naming, we will put in Data.Naming
4271 -- what is in this package Naming.
4273 if Naming_Id /= No_Package then
4274 Naming := In_Tree.Packages.Table (Naming_Id);
4276 if Current_Verbosity = High then
4277 Write_Line ("Checking ""Naming"".");
4280 -- Check Spec_Suffix
4283 Spec_Suffixs : Array_Element_Id :=
4289 Suffix : Array_Element_Id;
4290 Element : Array_Element;
4291 Suffix2 : Array_Element_Id;
4294 -- If some suffixes have been specified, we make sure that
4295 -- for each language for which a default suffix has been
4296 -- specified, there is a suffix specified, either the one
4297 -- in the project file or if there were none, the default.
4299 if Spec_Suffixs /= No_Array_Element then
4300 Suffix := Data.Naming.Spec_Suffix;
4302 while Suffix /= No_Array_Element loop
4304 In_Tree.Array_Elements.Table (Suffix);
4305 Suffix2 := Spec_Suffixs;
4307 while Suffix2 /= No_Array_Element loop
4308 exit when In_Tree.Array_Elements.Table
4309 (Suffix2).Index = Element.Index;
4310 Suffix2 := In_Tree.Array_Elements.Table
4314 -- There is a registered default suffix, but no
4315 -- suffix specified in the project file.
4316 -- Add the default to the array.
4318 if Suffix2 = No_Array_Element then
4319 Array_Element_Table.Increment_Last
4320 (In_Tree.Array_Elements);
4321 In_Tree.Array_Elements.Table
4322 (Array_Element_Table.Last
4323 (In_Tree.Array_Elements)) :=
4324 (Index => Element.Index,
4325 Src_Index => Element.Src_Index,
4326 Index_Case_Sensitive => False,
4327 Value => Element.Value,
4328 Next => Spec_Suffixs);
4329 Spec_Suffixs := Array_Element_Table.Last
4330 (In_Tree.Array_Elements);
4333 Suffix := Element.Next;
4336 -- Put the resulting array as the specification suffixes
4338 Data.Naming.Spec_Suffix := Spec_Suffixs;
4343 Current : Array_Element_Id;
4344 Element : Array_Element;
4347 Current := Data.Naming.Spec_Suffix;
4348 while Current /= No_Array_Element loop
4349 Element := In_Tree.Array_Elements.Table (Current);
4350 Get_Name_String (Element.Value.Value);
4352 if Name_Len = 0 then
4355 "Spec_Suffix cannot be empty",
4356 Element.Value.Location);
4359 In_Tree.Array_Elements.Table (Current) := Element;
4360 Current := Element.Next;
4364 -- Check Body_Suffix
4367 Impl_Suffixs : Array_Element_Id :=
4373 Suffix : Array_Element_Id;
4374 Element : Array_Element;
4375 Suffix2 : Array_Element_Id;
4378 -- If some suffixes have been specified, we make sure that
4379 -- for each language for which a default suffix has been
4380 -- specified, there is a suffix specified, either the one
4381 -- in the project file or if there were none, the default.
4383 if Impl_Suffixs /= No_Array_Element then
4384 Suffix := Data.Naming.Body_Suffix;
4385 while Suffix /= No_Array_Element loop
4387 In_Tree.Array_Elements.Table (Suffix);
4389 Suffix2 := Impl_Suffixs;
4390 while Suffix2 /= No_Array_Element loop
4391 exit when In_Tree.Array_Elements.Table
4392 (Suffix2).Index = Element.Index;
4393 Suffix2 := In_Tree.Array_Elements.Table
4397 -- There is a registered default suffix, but no suffix was
4398 -- specified in the project file. Add default to the array.
4400 if Suffix2 = No_Array_Element then
4401 Array_Element_Table.Increment_Last
4402 (In_Tree.Array_Elements);
4403 In_Tree.Array_Elements.Table
4404 (Array_Element_Table.Last
4405 (In_Tree.Array_Elements)) :=
4406 (Index => Element.Index,
4407 Src_Index => Element.Src_Index,
4408 Index_Case_Sensitive => False,
4409 Value => Element.Value,
4410 Next => Impl_Suffixs);
4411 Impl_Suffixs := Array_Element_Table.Last
4412 (In_Tree.Array_Elements);
4415 Suffix := Element.Next;
4418 -- Put the resulting array as the implementation suffixes
4420 Data.Naming.Body_Suffix := Impl_Suffixs;
4425 Current : Array_Element_Id;
4426 Element : Array_Element;
4429 Current := Data.Naming.Body_Suffix;
4430 while Current /= No_Array_Element loop
4431 Element := In_Tree.Array_Elements.Table (Current);
4432 Get_Name_String (Element.Value.Value);
4434 if Name_Len = 0 then
4437 "Body_Suffix cannot be empty",
4438 Element.Value.Location);
4441 In_Tree.Array_Elements.Table (Current) := Element;
4442 Current := Element.Next;
4446 -- Get the exceptions, if any
4448 Data.Naming.Specification_Exceptions :=
4450 (Name_Specification_Exceptions,
4451 In_Arrays => Naming.Decl.Arrays,
4452 In_Tree => In_Tree);
4454 Data.Naming.Implementation_Exceptions :=
4456 (Name_Implementation_Exceptions,
4457 In_Arrays => Naming.Decl.Arrays,
4458 In_Tree => In_Tree);
4460 end Check_Package_Naming;
4462 ---------------------------------
4463 -- Check_Programming_Languages --
4464 ---------------------------------
4466 procedure Check_Programming_Languages
4467 (In_Tree : Project_Tree_Ref;
4468 Project : Project_Id;
4469 Data : in out Project_Data)
4471 Languages : Variable_Value := Nil_Variable_Value;
4472 Def_Lang : Variable_Value := Nil_Variable_Value;
4473 Def_Lang_Id : Name_Id;
4476 Data.First_Language_Processing := No_Language_Index;
4478 Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes, In_Tree);
4481 (Name_Default_Language, Data.Decl.Attributes, In_Tree);
4482 Data.Ada_Sources_Present := Data.Source_Dirs /= Nil_String;
4483 Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String;
4485 if Data.Source_Dirs /= Nil_String then
4487 -- Check if languages are specified in this project
4489 if Languages.Default then
4491 -- Attribute Languages is not specified. So, it defaults to
4492 -- a project of the default language only.
4494 Name_List_Table.Increment_Last (In_Tree.Name_Lists);
4495 Data.Languages := Name_List_Table.Last (In_Tree.Name_Lists);
4497 -- In Ada_Only mode, the default language is Ada
4499 if Get_Mode = Ada_Only then
4500 In_Tree.Name_Lists.Table (Data.Languages) :=
4501 (Name => Name_Ada, Next => No_Name_List);
4503 -- Attribute Languages is not specified. So, it defaults to
4504 -- a project of language Ada only. No sources of languages
4507 Data.Other_Sources_Present := False;
4510 -- Fail if there is no default language defined
4512 if Def_Lang.Default then
4513 if not Default_Language_Is_Ada then
4517 "no languages defined for this project",
4519 Def_Lang_Id := No_Name;
4521 Def_Lang_Id := Name_Ada;
4525 Get_Name_String (Def_Lang.Value);
4526 To_Lower (Name_Buffer (1 .. Name_Len));
4527 Def_Lang_Id := Name_Find;
4530 if Def_Lang_Id /= No_Name then
4531 In_Tree.Name_Lists.Table (Data.Languages) :=
4532 (Name => Def_Lang_Id, Next => No_Name_List);
4534 Language_Data_Table.Increment_Last (In_Tree.Languages_Data);
4536 Data.First_Language_Processing :=
4537 Language_Data_Table.Last (In_Tree.Languages_Data);
4538 In_Tree.Languages_Data.Table
4539 (Data.First_Language_Processing) := No_Language_Data;
4540 In_Tree.Languages_Data.Table
4541 (Data.First_Language_Processing).Name := Def_Lang_Id;
4542 Get_Name_String (Def_Lang_Id);
4543 Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
4544 In_Tree.Languages_Data.Table
4545 (Data.First_Language_Processing).Display_Name := Name_Find;
4547 if Def_Lang_Id = Name_Ada then
4548 In_Tree.Languages_Data.Table
4549 (Data.First_Language_Processing).Config.Kind :=
4551 In_Tree.Languages_Data.Table
4552 (Data.First_Language_Processing).Config.
4553 Dependency_Kind := ALI_File;
4556 In_Tree.Languages_Data.Table
4557 (Data.First_Language_Processing).Config.Kind :=
4565 Current : String_List_Id := Languages.Values;
4566 Element : String_Element;
4567 Lang_Name : Name_Id;
4568 Index : Language_Index;
4569 Lang_Data : Language_Data;
4570 NL_Id : Name_List_Index := No_Name_List;
4573 -- Assume there are no language declared
4575 Data.Ada_Sources_Present := False;
4576 Data.Other_Sources_Present := False;
4578 -- If there are no languages declared, there are no sources
4580 if Current = Nil_String then
4581 Data.Source_Dirs := Nil_String;
4583 if Data.Qualifier = Standard then
4587 "a standard project cannot have no language declared",
4588 Languages.Location);
4592 -- Look through all the languages specified in attribute
4595 while Current /= Nil_String loop
4597 In_Tree.String_Elements.Table (Current);
4598 Get_Name_String (Element.Value);
4599 To_Lower (Name_Buffer (1 .. Name_Len));
4600 Lang_Name := Name_Find;
4602 NL_Id := Data.Languages;
4603 while NL_Id /= No_Name_List loop
4605 Lang_Name = In_Tree.Name_Lists.Table (NL_Id).Name;
4606 NL_Id := In_Tree.Name_Lists.Table (NL_Id).Next;
4609 if NL_Id = No_Name_List then
4610 Name_List_Table.Increment_Last (In_Tree.Name_Lists);
4612 if Data.Languages = No_Name_List then
4614 Name_List_Table.Last (In_Tree.Name_Lists);
4617 NL_Id := Data.Languages;
4618 while In_Tree.Name_Lists.Table (NL_Id).Next /=
4621 NL_Id := In_Tree.Name_Lists.Table (NL_Id).Next;
4624 In_Tree.Name_Lists.Table (NL_Id).Next :=
4625 Name_List_Table.Last (In_Tree.Name_Lists);
4628 NL_Id := Name_List_Table.Last (In_Tree.Name_Lists);
4629 In_Tree.Name_Lists.Table (NL_Id) :=
4630 (Lang_Name, No_Name_List);
4632 if Get_Mode = Ada_Only then
4633 -- Check for language Ada
4635 if Lang_Name = Name_Ada then
4636 Data.Ada_Sources_Present := True;
4639 Data.Other_Sources_Present := True;
4643 Language_Data_Table.Increment_Last
4644 (In_Tree.Languages_Data);
4646 Language_Data_Table.Last (In_Tree.Languages_Data);
4647 Lang_Data.Name := Lang_Name;
4648 Lang_Data.Display_Name := Element.Value;
4649 Lang_Data.Next := Data.First_Language_Processing;
4651 if Lang_Name = Name_Ada then
4652 Lang_Data.Config.Kind := Unit_Based;
4653 Lang_Data.Config.Dependency_Kind := ALI_File;
4655 Lang_Data.Config.Kind := File_Based;
4656 Lang_Data.Config.Dependency_Kind := None;
4659 In_Tree.Languages_Data.Table (Index) := Lang_Data;
4660 Data.First_Language_Processing := Index;
4664 Current := Element.Next;
4670 end Check_Programming_Languages;
4676 function Check_Project
4678 Root_Project : Project_Id;
4679 In_Tree : Project_Tree_Ref;
4680 Extending : Boolean) return Boolean
4683 if P = Root_Project then
4686 elsif Extending then
4688 Data : Project_Data;
4691 Data := In_Tree.Projects.Table (Root_Project);
4692 while Data.Extends /= No_Project loop
4693 if P = Data.Extends then
4697 Data := In_Tree.Projects.Table (Data.Extends);
4705 -------------------------------
4706 -- Check_Stand_Alone_Library --
4707 -------------------------------
4709 procedure Check_Stand_Alone_Library
4710 (Project : Project_Id;
4711 In_Tree : Project_Tree_Ref;
4712 Data : in out Project_Data;
4713 Current_Dir : String;
4714 Extending : Boolean)
4716 Lib_Interfaces : constant Prj.Variable_Value :=
4718 (Snames.Name_Library_Interface,
4719 Data.Decl.Attributes,
4722 Lib_Auto_Init : constant Prj.Variable_Value :=
4724 (Snames.Name_Library_Auto_Init,
4725 Data.Decl.Attributes,
4728 Lib_Src_Dir : constant Prj.Variable_Value :=
4730 (Snames.Name_Library_Src_Dir,
4731 Data.Decl.Attributes,
4734 Lib_Symbol_File : constant Prj.Variable_Value :=
4736 (Snames.Name_Library_Symbol_File,
4737 Data.Decl.Attributes,
4740 Lib_Symbol_Policy : constant Prj.Variable_Value :=
4742 (Snames.Name_Library_Symbol_Policy,
4743 Data.Decl.Attributes,
4746 Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
4748 (Snames.Name_Library_Reference_Symbol_File,
4749 Data.Decl.Attributes,
4752 Auto_Init_Supported : Boolean;
4753 OK : Boolean := True;
4755 Next_Proj : Project_Id;
4758 if Get_Mode = Multi_Language then
4759 Auto_Init_Supported := Data.Config.Auto_Init_Supported;
4761 Auto_Init_Supported :=
4762 MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported;
4765 pragma Assert (Lib_Interfaces.Kind = List);
4767 -- It is a stand-alone library project file if attribute
4768 -- Library_Interface is defined.
4770 if not Lib_Interfaces.Default then
4771 SAL_Library : declare
4772 Interfaces : String_List_Id := Lib_Interfaces.Values;
4773 Interface_ALIs : String_List_Id := Nil_String;
4775 The_Unit_Id : Unit_Index;
4776 The_Unit_Data : Unit_Data;
4778 procedure Add_ALI_For (Source : File_Name_Type);
4779 -- Add an ALI file name to the list of Interface ALIs
4785 procedure Add_ALI_For (Source : File_Name_Type) is
4787 Get_Name_String (Source);
4790 ALI : constant String :=
4791 ALI_File_Name (Name_Buffer (1 .. Name_Len));
4792 ALI_Name_Id : Name_Id;
4795 Name_Len := ALI'Length;
4796 Name_Buffer (1 .. Name_Len) := ALI;
4797 ALI_Name_Id := Name_Find;
4799 String_Element_Table.Increment_Last
4800 (In_Tree.String_Elements);
4801 In_Tree.String_Elements.Table
4802 (String_Element_Table.Last
4803 (In_Tree.String_Elements)) :=
4804 (Value => ALI_Name_Id,
4806 Display_Value => ALI_Name_Id,
4808 In_Tree.String_Elements.Table
4809 (Interfaces).Location,
4811 Next => Interface_ALIs);
4812 Interface_ALIs := String_Element_Table.Last
4813 (In_Tree.String_Elements);
4817 -- Start of processing for SAL_Library
4820 Data.Standalone_Library := True;
4822 -- Library_Interface cannot be an empty list
4824 if Interfaces = Nil_String then
4827 "Library_Interface cannot be an empty list",
4828 Lib_Interfaces.Location);
4831 -- Process each unit name specified in the attribute
4832 -- Library_Interface.
4834 while Interfaces /= Nil_String loop
4836 (In_Tree.String_Elements.Table (Interfaces).Value);
4837 To_Lower (Name_Buffer (1 .. Name_Len));
4839 if Name_Len = 0 then
4842 "an interface cannot be an empty string",
4843 In_Tree.String_Elements.Table (Interfaces).Location);
4847 Error_Msg_Name_1 := Unit;
4849 if Get_Mode = Ada_Only then
4851 Units_Htable.Get (In_Tree.Units_HT, Unit);
4853 if The_Unit_Id = No_Unit_Index then
4857 In_Tree.String_Elements.Table
4858 (Interfaces).Location);
4861 -- Check that the unit is part of the project
4864 In_Tree.Units.Table (The_Unit_Id);
4866 if The_Unit_Data.File_Names (Body_Part).Name /= No_File
4867 and then The_Unit_Data.File_Names
4868 (Body_Part).Path.Name /= Slash
4871 (The_Unit_Data.File_Names (Body_Part).Project,
4872 Project, In_Tree, Extending)
4874 -- There is a body for this unit.
4875 -- If there is no spec, we need to check
4876 -- that it is not a subunit.
4878 if The_Unit_Data.File_Names
4879 (Specification).Name = No_File
4882 Src_Ind : Source_File_Index;
4885 Src_Ind := Sinput.P.Load_Project_File
4887 (The_Unit_Data.File_Names
4888 (Body_Part).Path.Name));
4890 if Sinput.P.Source_File_Is_Subunit
4895 "%% is a subunit; " &
4896 "it cannot be an interface",
4898 String_Elements.Table
4899 (Interfaces).Location);
4904 -- The unit is not a subunit, so we add
4905 -- to the Interface ALIs the ALI file
4906 -- corresponding to the body.
4909 (The_Unit_Data.File_Names (Body_Part).Name);
4914 "%% is not an unit of this project",
4915 In_Tree.String_Elements.Table
4916 (Interfaces).Location);
4919 elsif The_Unit_Data.File_Names
4920 (Specification).Name /= No_File
4921 and then The_Unit_Data.File_Names
4922 (Specification).Path.Name /= Slash
4923 and then Check_Project
4924 (The_Unit_Data.File_Names
4925 (Specification).Project,
4926 Project, In_Tree, Extending)
4929 -- The unit is part of the project, it has
4930 -- a spec, but no body. We add to the Interface
4931 -- ALIs the ALI file corresponding to the spec.
4934 (The_Unit_Data.File_Names (Specification).Name);
4939 "%% is not an unit of this project",
4940 In_Tree.String_Elements.Table
4941 (Interfaces).Location);
4946 -- Multi_Language mode
4948 Next_Proj := Data.Extends;
4949 Source := Data.First_Source;
4952 while Source /= No_Source and then
4953 In_Tree.Sources.Table (Source).Unit /= Unit
4956 In_Tree.Sources.Table (Source).Next_In_Project;
4959 exit when Source /= No_Source or else
4960 Next_Proj = No_Project;
4963 In_Tree.Projects.Table (Next_Proj).First_Source;
4965 In_Tree.Projects.Table (Next_Proj).Extends;
4968 if Source /= No_Source then
4969 if In_Tree.Sources.Table (Source).Kind = Sep then
4970 Source := No_Source;
4972 elsif In_Tree.Sources.Table (Source).Kind = Spec
4974 In_Tree.Sources.Table (Source).Other_Part /=
4977 Source := In_Tree.Sources.Table (Source).Other_Part;
4981 if Source /= No_Source then
4982 if In_Tree.Sources.Table (Source).Project /= Project
4986 In_Tree.Sources.Table (Source).Project,
4989 Source := No_Source;
4993 if Source = No_Source then
4996 "%% is not an unit of this project",
4997 In_Tree.String_Elements.Table
4998 (Interfaces).Location);
5001 if In_Tree.Sources.Table (Source).Kind = Spec and then
5002 In_Tree.Sources.Table (Source).Other_Part /=
5005 Source := In_Tree.Sources.Table (Source).Other_Part;
5008 String_Element_Table.Increment_Last
5009 (In_Tree.String_Elements);
5010 In_Tree.String_Elements.Table
5011 (String_Element_Table.Last
5012 (In_Tree.String_Elements)) :=
5014 Name_Id (In_Tree.Sources.Table (Source).Dep_Name),
5017 Name_Id (In_Tree.Sources.Table (Source).Dep_Name),
5019 In_Tree.String_Elements.Table
5020 (Interfaces).Location,
5022 Next => Interface_ALIs);
5023 Interface_ALIs := String_Element_Table.Last
5024 (In_Tree.String_Elements);
5032 In_Tree.String_Elements.Table (Interfaces).Next;
5035 -- Put the list of Interface ALIs in the project data
5037 Data.Lib_Interface_ALIs := Interface_ALIs;
5039 -- Check value of attribute Library_Auto_Init and set
5040 -- Lib_Auto_Init accordingly.
5042 if Lib_Auto_Init.Default then
5044 -- If no attribute Library_Auto_Init is declared, then set auto
5045 -- init only if it is supported.
5047 Data.Lib_Auto_Init := Auto_Init_Supported;
5050 Get_Name_String (Lib_Auto_Init.Value);
5051 To_Lower (Name_Buffer (1 .. Name_Len));
5053 if Name_Buffer (1 .. Name_Len) = "false" then
5054 Data.Lib_Auto_Init := False;
5056 elsif Name_Buffer (1 .. Name_Len) = "true" then
5057 if Auto_Init_Supported then
5058 Data.Lib_Auto_Init := True;
5061 -- Library_Auto_Init cannot be "true" if auto init is not
5066 "library auto init not supported " &
5068 Lib_Auto_Init.Location);
5074 "invalid value for attribute Library_Auto_Init",
5075 Lib_Auto_Init.Location);
5080 -- If attribute Library_Src_Dir is defined and not the empty string,
5081 -- check if the directory exist and is not the object directory or
5082 -- one of the source directories. This is the directory where copies
5083 -- of the interface sources will be copied. Note that this directory
5084 -- may be the library directory.
5086 if Lib_Src_Dir.Value /= Empty_String then
5088 Dir_Id : constant File_Name_Type :=
5089 File_Name_Type (Lib_Src_Dir.Value);
5096 Data.Directory.Display_Name,
5097 Data.Library_Src_Dir.Name,
5098 Data.Library_Src_Dir.Display_Name,
5099 Create => "library source copy",
5100 Current_Dir => Current_Dir,
5101 Location => Lib_Src_Dir.Location,
5102 Externally_Built => Data.Externally_Built);
5104 -- If directory does not exist, report an error
5106 if Data.Library_Src_Dir = No_Path_Information then
5108 -- Get the absolute name of the library directory that does
5109 -- not exist, to report an error.
5112 Dir_Name : constant String :=
5113 Get_Name_String (Dir_Id);
5116 if Is_Absolute_Path (Dir_Name) then
5117 Err_Vars.Error_Msg_File_1 := Dir_Id;
5120 Get_Name_String (Data.Directory.Name);
5122 if Name_Buffer (Name_Len) /=
5125 Name_Len := Name_Len + 1;
5126 Name_Buffer (Name_Len) :=
5127 Directory_Separator;
5132 Name_Len + Dir_Name'Length) :=
5134 Name_Len := Name_Len + Dir_Name'Length;
5135 Err_Vars.Error_Msg_Name_1 := Name_Find;
5140 Error_Msg_File_1 := Dir_Id;
5143 "Directory { does not exist",
5144 Lib_Src_Dir.Location);
5147 -- Report error if it is the same as the object directory
5149 elsif Data.Library_Src_Dir = Data.Object_Directory then
5152 "directory to copy interfaces cannot be " &
5153 "the object directory",
5154 Lib_Src_Dir.Location);
5155 Data.Library_Src_Dir := No_Path_Information;
5159 Src_Dirs : String_List_Id;
5160 Src_Dir : String_Element;
5163 -- Interface copy directory cannot be one of the source
5164 -- directory of the current project.
5166 Src_Dirs := Data.Source_Dirs;
5167 while Src_Dirs /= Nil_String loop
5168 Src_Dir := In_Tree.String_Elements.Table (Src_Dirs);
5170 -- Report error if it is one of the source directories
5172 if Data.Library_Src_Dir.Name =
5173 Path_Name_Type (Src_Dir.Value)
5177 "directory to copy interfaces cannot " &
5178 "be one of the source directories",
5179 Lib_Src_Dir.Location);
5180 Data.Library_Src_Dir := No_Path_Information;
5184 Src_Dirs := Src_Dir.Next;
5187 if Data.Library_Src_Dir /= No_Path_Information then
5189 -- It cannot be a source directory of any other
5192 Project_Loop : for Pid in 1 ..
5193 Project_Table.Last (In_Tree.Projects)
5196 In_Tree.Projects.Table (Pid).Source_Dirs;
5197 Dir_Loop : while Src_Dirs /= Nil_String loop
5199 In_Tree.String_Elements.Table (Src_Dirs);
5201 -- Report error if it is one of the source
5204 if Data.Library_Src_Dir.Name =
5205 Path_Name_Type (Src_Dir.Value)
5208 File_Name_Type (Src_Dir.Value);
5210 In_Tree.Projects.Table (Pid).Name;
5213 "directory to copy interfaces cannot " &
5214 "be the same as source directory { of " &
5216 Lib_Src_Dir.Location);
5217 Data.Library_Src_Dir := No_Path_Information;
5221 Src_Dirs := Src_Dir.Next;
5223 end loop Project_Loop;
5227 -- In high verbosity, if there is a valid Library_Src_Dir,
5228 -- display its path name.
5230 if Data.Library_Src_Dir /= No_Path_Information
5231 and then Current_Verbosity = High
5234 ("Directory to copy interfaces",
5235 Get_Name_String (Data.Library_Src_Dir.Name));
5241 -- Check the symbol related attributes
5243 -- First, the symbol policy
5245 if not Lib_Symbol_Policy.Default then
5247 Value : constant String :=
5249 (Get_Name_String (Lib_Symbol_Policy.Value));
5252 -- Symbol policy must hove one of a limited number of values
5254 if Value = "autonomous" or else Value = "default" then
5255 Data.Symbol_Data.Symbol_Policy := Autonomous;
5257 elsif Value = "compliant" then
5258 Data.Symbol_Data.Symbol_Policy := Compliant;
5260 elsif Value = "controlled" then
5261 Data.Symbol_Data.Symbol_Policy := Controlled;
5263 elsif Value = "restricted" then
5264 Data.Symbol_Data.Symbol_Policy := Restricted;
5266 elsif Value = "direct" then
5267 Data.Symbol_Data.Symbol_Policy := Direct;
5272 "illegal value for Library_Symbol_Policy",
5273 Lib_Symbol_Policy.Location);
5278 -- If attribute Library_Symbol_File is not specified, symbol policy
5279 -- cannot be Restricted.
5281 if Lib_Symbol_File.Default then
5282 if Data.Symbol_Data.Symbol_Policy = Restricted then
5285 "Library_Symbol_File needs to be defined when " &
5286 "symbol policy is Restricted",
5287 Lib_Symbol_Policy.Location);
5291 -- Library_Symbol_File is defined
5293 Data.Symbol_Data.Symbol_File :=
5294 Path_Name_Type (Lib_Symbol_File.Value);
5296 Get_Name_String (Lib_Symbol_File.Value);
5298 if Name_Len = 0 then
5301 "symbol file name cannot be an empty string",
5302 Lib_Symbol_File.Location);
5305 OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
5308 for J in 1 .. Name_Len loop
5309 if Name_Buffer (J) = '/'
5310 or else Name_Buffer (J) = Directory_Separator
5319 Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
5322 "symbol file name { is illegal. " &
5323 "Name cannot include directory info.",
5324 Lib_Symbol_File.Location);
5329 -- If attribute Library_Reference_Symbol_File is not defined,
5330 -- symbol policy cannot be Compliant or Controlled.
5332 if Lib_Ref_Symbol_File.Default then
5333 if Data.Symbol_Data.Symbol_Policy = Compliant
5334 or else Data.Symbol_Data.Symbol_Policy = Controlled
5338 "a reference symbol file needs to be defined",
5339 Lib_Symbol_Policy.Location);
5343 -- Library_Reference_Symbol_File is defined, check file exists
5345 Data.Symbol_Data.Reference :=
5346 Path_Name_Type (Lib_Ref_Symbol_File.Value);
5348 Get_Name_String (Lib_Ref_Symbol_File.Value);
5350 if Name_Len = 0 then
5353 "reference symbol file name cannot be an empty string",
5354 Lib_Symbol_File.Location);
5357 if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
5359 Add_Str_To_Name_Buffer
5360 (Get_Name_String (Data.Directory.Name));
5361 Add_Char_To_Name_Buffer (Directory_Separator);
5362 Add_Str_To_Name_Buffer
5363 (Get_Name_String (Lib_Ref_Symbol_File.Value));
5364 Data.Symbol_Data.Reference := Name_Find;
5367 if not Is_Regular_File
5368 (Get_Name_String (Data.Symbol_Data.Reference))
5371 File_Name_Type (Lib_Ref_Symbol_File.Value);
5373 -- For controlled and direct symbol policies, it is an error
5374 -- if the reference symbol file does not exist. For other
5375 -- symbol policies, this is just a warning
5378 Data.Symbol_Data.Symbol_Policy /= Controlled
5379 and then Data.Symbol_Data.Symbol_Policy /= Direct;
5383 "<library reference symbol file { does not exist",
5384 Lib_Ref_Symbol_File.Location);
5386 -- In addition in the non-controlled case, if symbol policy
5387 -- is Compliant, it is changed to Autonomous, because there
5388 -- is no reference to check against, and we don't want to
5389 -- fail in this case.
5391 if Data.Symbol_Data.Symbol_Policy /= Controlled then
5392 if Data.Symbol_Data.Symbol_Policy = Compliant then
5393 Data.Symbol_Data.Symbol_Policy := Autonomous;
5398 -- If both the reference symbol file and the symbol file are
5399 -- defined, then check that they are not the same file.
5401 if Data.Symbol_Data.Symbol_File /= No_Path then
5402 Get_Name_String (Data.Symbol_Data.Symbol_File);
5404 if Name_Len > 0 then
5406 Symb_Path : constant String :=
5409 (Data.Object_Directory.Name) &
5410 Directory_Separator &
5411 Name_Buffer (1 .. Name_Len),
5412 Directory => Current_Dir,
5414 Opt.Follow_Links_For_Files);
5415 Ref_Path : constant String :=
5418 (Data.Symbol_Data.Reference),
5419 Directory => Current_Dir,
5421 Opt.Follow_Links_For_Files);
5423 if Symb_Path = Ref_Path then
5426 "library reference symbol file and library" &
5427 " symbol file cannot be the same file",
5428 Lib_Ref_Symbol_File.Location);
5436 end Check_Stand_Alone_Library;
5438 ----------------------------
5439 -- Compute_Directory_Last --
5440 ----------------------------
5442 function Compute_Directory_Last (Dir : String) return Natural is
5445 and then (Dir (Dir'Last - 1) = Directory_Separator
5446 or else Dir (Dir'Last - 1) = '/')
5448 return Dir'Last - 1;
5452 end Compute_Directory_Last;
5459 (Project : Project_Id;
5460 In_Tree : Project_Tree_Ref;
5462 Flag_Location : Source_Ptr)
5464 Real_Location : Source_Ptr := Flag_Location;
5465 Error_Buffer : String (1 .. 5_000);
5466 Error_Last : Natural := 0;
5467 Name_Number : Natural := 0;
5468 File_Number : Natural := 0;
5469 First : Positive := Msg'First;
5472 procedure Add (C : Character);
5473 -- Add a character to the buffer
5475 procedure Add (S : String);
5476 -- Add a string to the buffer
5479 -- Add a name to the buffer
5482 -- Add a file name to the buffer
5488 procedure Add (C : Character) is
5490 Error_Last := Error_Last + 1;
5491 Error_Buffer (Error_Last) := C;
5494 procedure Add (S : String) is
5496 Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S;
5497 Error_Last := Error_Last + S'Length;
5504 procedure Add_File is
5505 File : File_Name_Type;
5509 File_Number := File_Number + 1;
5513 File := Err_Vars.Error_Msg_File_1;
5515 File := Err_Vars.Error_Msg_File_2;
5517 File := Err_Vars.Error_Msg_File_3;
5522 Get_Name_String (File);
5523 Add (Name_Buffer (1 .. Name_Len));
5531 procedure Add_Name is
5536 Name_Number := Name_Number + 1;
5540 Name := Err_Vars.Error_Msg_Name_1;
5542 Name := Err_Vars.Error_Msg_Name_2;
5544 Name := Err_Vars.Error_Msg_Name_3;
5549 Get_Name_String (Name);
5550 Add (Name_Buffer (1 .. Name_Len));
5554 -- Start of processing for Error_Msg
5557 -- If location of error is unknown, use the location of the project
5559 if Real_Location = No_Location then
5560 Real_Location := In_Tree.Projects.Table (Project).Location;
5563 if Error_Report = null then
5564 Prj.Err.Error_Msg (Msg, Real_Location);
5568 -- Ignore continuation character
5570 if Msg (First) = '\' then
5574 -- Warning character is always the first one in this package
5575 -- this is an undocumented kludge???
5577 if Msg (First) = '?' then
5581 elsif Msg (First) = '<' then
5584 if Err_Vars.Error_Msg_Warn then
5590 while Index <= Msg'Last loop
5591 if Msg (Index) = '{' then
5594 elsif Msg (Index) = '%' then
5595 if Index < Msg'Last and then Msg (Index + 1) = '%' then
5607 Error_Report (Error_Buffer (1 .. Error_Last), Project, In_Tree);
5610 ----------------------
5611 -- Find_Ada_Sources --
5612 ----------------------
5614 procedure Find_Ada_Sources
5615 (Project : Project_Id;
5616 In_Tree : Project_Tree_Ref;
5617 Data : in out Project_Data;
5618 Current_Dir : String)
5620 Source_Dir : String_List_Id := Data.Source_Dirs;
5621 Element : String_Element;
5623 Current_Source : String_List_Id := Nil_String;
5624 Source_Recorded : Boolean := False;
5627 if Current_Verbosity = High then
5628 Write_Line ("Looking for sources:");
5631 -- For each subdirectory
5633 while Source_Dir /= Nil_String loop
5635 Source_Recorded := False;
5636 Element := In_Tree.String_Elements.Table (Source_Dir);
5637 if Element.Value /= No_Name then
5638 Get_Name_String (Element.Display_Value);
5641 Source_Directory : constant String :=
5642 Name_Buffer (1 .. Name_Len) & Directory_Separator;
5643 Dir_Last : constant Natural :=
5644 Compute_Directory_Last (Source_Directory);
5647 if Current_Verbosity = High then
5648 Write_Attr ("Source_Dir", Source_Directory);
5651 -- We look at every entry in the source directory
5654 Source_Directory (Source_Directory'First .. Dir_Last));
5657 Read (Dir, Name_Buffer, Name_Len);
5659 if Current_Verbosity = High then
5660 Write_Str (" Checking ");
5661 Write_Line (Name_Buffer (1 .. Name_Len));
5664 exit when Name_Len = 0;
5667 File_Name : constant File_Name_Type := Name_Find;
5669 -- ??? We could probably optimize the following call:
5670 -- we need to resolve links only once for the
5671 -- directory itself, and then do a single call to
5672 -- readlink() for each file. Unfortunately that would
5673 -- require a change in Normalize_Pathname so that it
5674 -- has the option of not resolving links for its
5675 -- Directory parameter, only for Name.
5677 Path : constant String :=
5679 (Name => Name_Buffer (1 .. Name_Len),
5682 (Source_Directory'First .. Dir_Last),
5684 Opt.Follow_Links_For_Files,
5685 Case_Sensitive => True);
5687 Path_Name : Path_Name_Type;
5690 Name_Len := Path'Length;
5691 Name_Buffer (1 .. Name_Len) := Path;
5692 Path_Name := Name_Find;
5694 -- We attempt to register it as a source. However,
5695 -- there is no error if the file does not contain a
5696 -- valid source. But there is an error if we have a
5697 -- duplicate unit name.
5700 (File_Name => File_Name,
5701 Path_Name => Path_Name,
5705 Location => No_Location,
5706 Current_Source => Current_Source,
5707 Source_Recorded => Source_Recorded,
5708 Current_Dir => Current_Dir);
5717 when Directory_Error =>
5721 if Source_Recorded then
5722 In_Tree.String_Elements.Table (Source_Dir).Flag :=
5726 Source_Dir := Element.Next;
5729 if Current_Verbosity = High then
5730 Write_Line ("end Looking for sources.");
5733 end Find_Ada_Sources;
5735 --------------------------------
5736 -- Free_Ada_Naming_Exceptions --
5737 --------------------------------
5739 procedure Free_Ada_Naming_Exceptions is
5741 Ada_Naming_Exception_Table.Set_Last (0);
5742 Ada_Naming_Exceptions.Reset;
5743 Reverse_Ada_Naming_Exceptions.Reset;
5744 end Free_Ada_Naming_Exceptions;
5746 ---------------------
5747 -- Get_Directories --
5748 ---------------------
5750 procedure Get_Directories
5751 (Project : Project_Id;
5752 In_Tree : Project_Tree_Ref;
5753 Current_Dir : String;
5754 Data : in out Project_Data)
5756 Object_Dir : constant Variable_Value :=
5758 (Name_Object_Dir, Data.Decl.Attributes, In_Tree);
5760 Exec_Dir : constant Variable_Value :=
5762 (Name_Exec_Dir, Data.Decl.Attributes, In_Tree);
5764 Source_Dirs : constant Variable_Value :=
5766 (Name_Source_Dirs, Data.Decl.Attributes, In_Tree);
5768 Excluded_Source_Dirs : constant Variable_Value :=
5770 (Name_Excluded_Source_Dirs,
5771 Data.Decl.Attributes,
5774 Source_Files : constant Variable_Value :=
5776 (Name_Source_Files, Data.Decl.Attributes, In_Tree);
5778 Last_Source_Dir : String_List_Id := Nil_String;
5780 Languages : constant Variable_Value :=
5782 (Name_Languages, Data.Decl.Attributes, In_Tree);
5784 procedure Find_Source_Dirs
5785 (From : File_Name_Type;
5786 Location : Source_Ptr;
5787 Removed : Boolean := False);
5788 -- Find one or several source directories, and add (or remove, if
5789 -- Removed is True) them to list of source directories of the project.
5791 ----------------------
5792 -- Find_Source_Dirs --
5793 ----------------------
5795 procedure Find_Source_Dirs
5796 (From : File_Name_Type;
5797 Location : Source_Ptr;
5798 Removed : Boolean := False)
5800 Directory : constant String := Get_Name_String (From);
5801 Element : String_Element;
5803 procedure Recursive_Find_Dirs (Path : Name_Id);
5804 -- Find all the subdirectories (recursively) of Path and add them
5805 -- to the list of source directories of the project.
5807 -------------------------
5808 -- Recursive_Find_Dirs --
5809 -------------------------
5811 procedure Recursive_Find_Dirs (Path : Name_Id) is
5813 Name : String (1 .. 250);
5815 List : String_List_Id;
5816 Prev : String_List_Id;
5817 Element : String_Element;
5818 Found : Boolean := False;
5820 Non_Canonical_Path : Name_Id := No_Name;
5821 Canonical_Path : Name_Id := No_Name;
5823 The_Path : constant String :=
5825 (Get_Name_String (Path),
5826 Directory => Current_Dir,
5827 Resolve_Links => Opt.Follow_Links_For_Dirs) &
5828 Directory_Separator;
5830 The_Path_Last : constant Natural :=
5831 Compute_Directory_Last (The_Path);
5834 Name_Len := The_Path_Last - The_Path'First + 1;
5835 Name_Buffer (1 .. Name_Len) :=
5836 The_Path (The_Path'First .. The_Path_Last);
5837 Non_Canonical_Path := Name_Find;
5839 Name_Id (Canonical_Case_File_Name (Non_Canonical_Path));
5841 -- To avoid processing the same directory several times, check
5842 -- if the directory is already in Recursive_Dirs. If it is, then
5843 -- there is nothing to do, just return. If it is not, put it there
5844 -- and continue recursive processing.
5847 if Recursive_Dirs.Get (Canonical_Path) then
5850 Recursive_Dirs.Set (Canonical_Path, True);
5854 -- Check if directory is already in list
5856 List := Data.Source_Dirs;
5858 while List /= Nil_String loop
5859 Element := In_Tree.String_Elements.Table (List);
5861 if Element.Value /= No_Name then
5862 Found := Element.Value = Canonical_Path;
5867 List := Element.Next;
5870 -- If directory is not already in list, put it there
5872 if (not Removed) and (not Found) then
5873 if Current_Verbosity = High then
5875 Write_Line (The_Path (The_Path'First .. The_Path_Last));
5878 String_Element_Table.Increment_Last
5879 (In_Tree.String_Elements);
5881 (Value => Canonical_Path,
5882 Display_Value => Non_Canonical_Path,
5883 Location => No_Location,
5888 -- Case of first source directory
5890 if Last_Source_Dir = Nil_String then
5891 Data.Source_Dirs := String_Element_Table.Last
5892 (In_Tree.String_Elements);
5894 -- Here we already have source directories
5897 -- Link the previous last to the new one
5899 In_Tree.String_Elements.Table
5900 (Last_Source_Dir).Next :=
5901 String_Element_Table.Last
5902 (In_Tree.String_Elements);
5905 -- And register this source directory as the new last
5907 Last_Source_Dir := String_Element_Table.Last
5908 (In_Tree.String_Elements);
5909 In_Tree.String_Elements.Table (Last_Source_Dir) :=
5912 elsif Removed and Found then
5913 if Prev = Nil_String then
5915 In_Tree.String_Elements.Table (List).Next;
5917 In_Tree.String_Elements.Table (Prev).Next :=
5918 In_Tree.String_Elements.Table (List).Next;
5922 -- Now look for subdirectories. We do that even when this
5923 -- directory is already in the list, because some of its
5924 -- subdirectories may not be in the list yet.
5926 Open (Dir, The_Path (The_Path'First .. The_Path_Last));
5929 Read (Dir, Name, Last);
5932 if Name (1 .. Last) /= "."
5933 and then Name (1 .. Last) /= ".."
5935 -- Avoid . and .. directories
5937 if Current_Verbosity = High then
5938 Write_Str (" Checking ");
5939 Write_Line (Name (1 .. Last));
5943 Path_Name : constant String :=
5945 (Name => Name (1 .. Last),
5947 The_Path (The_Path'First .. The_Path_Last),
5948 Resolve_Links => Opt.Follow_Links_For_Dirs,
5949 Case_Sensitive => True);
5952 if Is_Directory (Path_Name) then
5953 -- We have found a new subdirectory, call self
5955 Name_Len := Path_Name'Length;
5956 Name_Buffer (1 .. Name_Len) := Path_Name;
5957 Recursive_Find_Dirs (Name_Find);
5966 when Directory_Error =>
5968 end Recursive_Find_Dirs;
5970 -- Start of processing for Find_Source_Dirs
5973 if Current_Verbosity = High and then not Removed then
5974 Write_Str ("Find_Source_Dirs (""");
5975 Write_Str (Directory);
5979 -- First, check if we are looking for a directory tree, indicated
5980 -- by "/**" at the end.
5982 if Directory'Length >= 3
5983 and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
5984 and then (Directory (Directory'Last - 2) = '/'
5986 Directory (Directory'Last - 2) = Directory_Separator)
5989 Data.Known_Order_Of_Source_Dirs := False;
5992 Name_Len := Directory'Length - 3;
5994 if Name_Len = 0 then
5996 -- Case of "/**": all directories in file system
5999 Name_Buffer (1) := Directory (Directory'First);
6002 Name_Buffer (1 .. Name_Len) :=
6003 Directory (Directory'First .. Directory'Last - 3);
6006 if Current_Verbosity = High then
6007 Write_Str ("Looking for all subdirectories of """);
6008 Write_Str (Name_Buffer (1 .. Name_Len));
6013 Base_Dir : constant File_Name_Type := Name_Find;
6014 Root_Dir : constant String :=
6016 (Name => Get_Name_String (Base_Dir),
6018 Get_Name_String (Data.Directory.Display_Name),
6019 Resolve_Links => False,
6020 Case_Sensitive => True);
6023 if Root_Dir'Length = 0 then
6024 Err_Vars.Error_Msg_File_1 := Base_Dir;
6026 if Location = No_Location then
6029 "{ is not a valid directory.",
6034 "{ is not a valid directory.",
6039 -- We have an existing directory, we register it and all of
6040 -- its subdirectories.
6042 if Current_Verbosity = High then
6043 Write_Line ("Looking for source directories:");
6046 Name_Len := Root_Dir'Length;
6047 Name_Buffer (1 .. Name_Len) := Root_Dir;
6048 Recursive_Find_Dirs (Name_Find);
6050 if Current_Verbosity = High then
6051 Write_Line ("End of looking for source directories.");
6056 -- We have a single directory
6060 Path_Name : Path_Name_Type;
6061 Display_Path_Name : Path_Name_Type;
6062 List : String_List_Id;
6063 Prev : String_List_Id;
6067 (Project => Project,
6070 Parent => Data.Directory.Display_Name,
6072 Display => Display_Path_Name,
6073 Current_Dir => Current_Dir);
6075 if Path_Name = No_Path then
6076 Err_Vars.Error_Msg_File_1 := From;
6078 if Location = No_Location then
6081 "{ is not a valid directory",
6086 "{ is not a valid directory",
6092 Path : constant String :=
6093 Get_Name_String (Path_Name) &
6094 Directory_Separator;
6095 Last_Path : constant Natural :=
6096 Compute_Directory_Last (Path);
6098 Display_Path : constant String :=
6100 (Display_Path_Name) &
6101 Directory_Separator;
6102 Last_Display_Path : constant Natural :=
6103 Compute_Directory_Last
6105 Display_Path_Id : Name_Id;
6109 Add_Str_To_Name_Buffer (Path (Path'First .. Last_Path));
6110 Path_Id := Name_Find;
6112 Add_Str_To_Name_Buffer
6114 (Display_Path'First .. Last_Display_Path));
6115 Display_Path_Id := Name_Find;
6119 -- As it is an existing directory, we add it to the
6120 -- list of directories.
6122 String_Element_Table.Increment_Last
6123 (In_Tree.String_Elements);
6127 Display_Value => Display_Path_Id,
6128 Location => No_Location,
6130 Next => Nil_String);
6132 if Last_Source_Dir = Nil_String then
6134 -- This is the first source directory
6136 Data.Source_Dirs := String_Element_Table.Last
6137 (In_Tree.String_Elements);
6140 -- We already have source directories, link the
6141 -- previous last to the new one.
6143 In_Tree.String_Elements.Table
6144 (Last_Source_Dir).Next :=
6145 String_Element_Table.Last
6146 (In_Tree.String_Elements);
6149 -- And register this source directory as the new last
6151 Last_Source_Dir := String_Element_Table.Last
6152 (In_Tree.String_Elements);
6153 In_Tree.String_Elements.Table
6154 (Last_Source_Dir) := Element;
6157 -- Remove source dir, if present
6159 List := Data.Source_Dirs;
6162 -- Look for source dir in current list
6164 while List /= Nil_String loop
6165 Element := In_Tree.String_Elements.Table (List);
6166 exit when Element.Value = Path_Id;
6168 List := Element.Next;
6171 if List /= Nil_String then
6172 -- Source dir was found, remove it from the list
6174 if Prev = Nil_String then
6176 In_Tree.String_Elements.Table (List).Next;
6179 In_Tree.String_Elements.Table (Prev).Next :=
6180 In_Tree.String_Elements.Table (List).Next;
6188 end Find_Source_Dirs;
6190 -- Start of processing for Get_Directories
6193 if Current_Verbosity = High then
6194 Write_Line ("Starting to look for directories");
6197 -- Set the object directory to its default which may be nil, if there
6198 -- is no sources in the project.
6200 if (((not Source_Files.Default)
6201 and then Source_Files.Values = Nil_String)
6203 ((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String)
6205 ((not Languages.Default) and then Languages.Values = Nil_String))
6206 and then Data.Extends = No_Project
6208 Data.Object_Directory := No_Path_Information;
6211 Data.Object_Directory := Data.Directory;
6214 -- Check the object directory
6216 if Object_Dir.Value /= Empty_String then
6217 Get_Name_String (Object_Dir.Value);
6219 if Name_Len = 0 then
6222 "Object_Dir cannot be empty",
6223 Object_Dir.Location);
6226 -- We check that the specified object directory does exist
6231 File_Name_Type (Object_Dir.Value),
6232 Data.Directory.Display_Name,
6233 Data.Object_Directory.Name,
6234 Data.Object_Directory.Display_Name,
6236 Location => Object_Dir.Location,
6237 Current_Dir => Current_Dir,
6238 Externally_Built => Data.Externally_Built);
6240 if Data.Object_Directory = No_Path_Information then
6242 -- The object directory does not exist, report an error if the
6243 -- project is not externally built.
6245 if not Data.Externally_Built then
6246 Err_Vars.Error_Msg_File_1 :=
6247 File_Name_Type (Object_Dir.Value);
6250 "the object directory { cannot be found",
6254 -- Do not keep a nil Object_Directory. Set it to the specified
6255 -- (relative or absolute) path. This is for the benefit of
6256 -- tools that recover from errors; for example, these tools
6257 -- could create the non existent directory.
6259 Data.Object_Directory.Display_Name :=
6260 Path_Name_Type (Object_Dir.Value);
6261 Data.Object_Directory.Name :=
6262 Path_Name_Type (Canonical_Case_File_Name (Object_Dir.Value));
6266 elsif Data.Object_Directory /= No_Path_Information and then
6270 Name_Buffer (1) := '.';
6275 Data.Directory.Display_Name,
6276 Data.Object_Directory.Name,
6277 Data.Object_Directory.Display_Name,
6279 Location => Object_Dir.Location,
6280 Current_Dir => Current_Dir,
6281 Externally_Built => Data.Externally_Built);
6284 if Current_Verbosity = High then
6285 if Data.Object_Directory = No_Path_Information then
6286 Write_Line ("No object directory");
6289 ("Object directory",
6290 Get_Name_String (Data.Object_Directory.Display_Name));
6294 -- Check the exec directory
6296 -- We set the object directory to its default
6298 Data.Exec_Directory := Data.Object_Directory;
6300 if Exec_Dir.Value /= Empty_String then
6301 Get_Name_String (Exec_Dir.Value);
6303 if Name_Len = 0 then
6306 "Exec_Dir cannot be empty",
6310 -- We check that the specified exec directory does exist
6315 File_Name_Type (Exec_Dir.Value),
6316 Data.Directory.Display_Name,
6317 Data.Exec_Directory.Name,
6318 Data.Exec_Directory.Display_Name,
6320 Location => Exec_Dir.Location,
6321 Current_Dir => Current_Dir,
6322 Externally_Built => Data.Externally_Built);
6324 if Data.Exec_Directory = No_Path_Information then
6325 Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
6328 "the exec directory { cannot be found",
6334 if Current_Verbosity = High then
6335 if Data.Exec_Directory = No_Path_Information then
6336 Write_Line ("No exec directory");
6338 Write_Str ("Exec directory: """);
6339 Write_Str (Get_Name_String (Data.Exec_Directory.Display_Name));
6344 -- Look for the source directories
6346 if Current_Verbosity = High then
6347 Write_Line ("Starting to look for source directories");
6350 pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
6352 if (not Source_Files.Default) and then
6353 Source_Files.Values = Nil_String
6355 Data.Source_Dirs := Nil_String;
6357 if Data.Qualifier = Standard then
6361 "a standard project cannot have no sources",
6362 Source_Files.Location);
6365 elsif Source_Dirs.Default then
6367 -- No Source_Dirs specified: the single source directory is the one
6368 -- containing the project file
6370 String_Element_Table.Increment_Last
6371 (In_Tree.String_Elements);
6372 Data.Source_Dirs := String_Element_Table.Last
6373 (In_Tree.String_Elements);
6374 In_Tree.String_Elements.Table (Data.Source_Dirs) :=
6375 (Value => Name_Id (Data.Directory.Name),
6376 Display_Value => Name_Id (Data.Directory.Display_Name),
6377 Location => No_Location,
6382 if Current_Verbosity = High then
6384 ("Single source directory",
6385 Get_Name_String (Data.Directory.Display_Name));
6388 elsif Source_Dirs.Values = Nil_String then
6389 if Data.Qualifier = Standard then
6393 "a standard project cannot have no source directories",
6394 Source_Dirs.Location);
6397 Data.Source_Dirs := Nil_String;
6401 Source_Dir : String_List_Id;
6402 Element : String_Element;
6405 -- Process the source directories for each element of the list
6407 Source_Dir := Source_Dirs.Values;
6408 while Source_Dir /= Nil_String loop
6409 Element := In_Tree.String_Elements.Table (Source_Dir);
6411 (File_Name_Type (Element.Value), Element.Location);
6412 Source_Dir := Element.Next;
6417 if not Excluded_Source_Dirs.Default
6418 and then Excluded_Source_Dirs.Values /= Nil_String
6421 Source_Dir : String_List_Id;
6422 Element : String_Element;
6425 -- Process the source directories for each element of the list
6427 Source_Dir := Excluded_Source_Dirs.Values;
6428 while Source_Dir /= Nil_String loop
6429 Element := In_Tree.String_Elements.Table (Source_Dir);
6431 (File_Name_Type (Element.Value),
6434 Source_Dir := Element.Next;
6439 if Current_Verbosity = High then
6440 Write_Line ("Putting source directories in canonical cases");
6444 Current : String_List_Id := Data.Source_Dirs;
6445 Element : String_Element;
6448 while Current /= Nil_String loop
6449 Element := In_Tree.String_Elements.Table (Current);
6450 if Element.Value /= No_Name then
6452 Name_Id (Canonical_Case_File_Name (Name_Id (Element.Value)));
6453 In_Tree.String_Elements.Table (Current) := Element;
6456 Current := Element.Next;
6459 end Get_Directories;
6466 (Project : Project_Id;
6467 In_Tree : Project_Tree_Ref;
6468 Data : in out Project_Data)
6470 Mains : constant Variable_Value :=
6471 Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes, In_Tree);
6472 List : String_List_Id;
6473 Elem : String_Element;
6476 Data.Mains := Mains.Values;
6478 -- If no Mains were specified, and if we are an extending project,
6479 -- inherit the Mains from the project we are extending.
6481 if Mains.Default then
6482 if not Data.Library and then Data.Extends /= No_Project then
6484 In_Tree.Projects.Table (Data.Extends).Mains;
6487 -- In a library project file, Main cannot be specified
6489 elsif Data.Library then
6492 "a library project file cannot have Main specified",
6496 List := Mains.Values;
6497 while List /= Nil_String loop
6498 Elem := In_Tree.String_Elements.Table (List);
6500 if Length_Of_Name (Elem.Value) = 0 then
6503 "?a main cannot have an empty name",
6513 ---------------------------
6514 -- Get_Sources_From_File --
6515 ---------------------------
6517 procedure Get_Sources_From_File
6519 Location : Source_Ptr;
6520 Project : Project_Id;
6521 In_Tree : Project_Tree_Ref)
6523 File : Prj.Util.Text_File;
6524 Line : String (1 .. 250);
6526 Source_Name : File_Name_Type;
6527 Name_Loc : Name_Location;
6530 if Get_Mode = Ada_Only then
6534 if Current_Verbosity = High then
6535 Write_Str ("Opening """);
6542 Prj.Util.Open (File, Path);
6544 if not Prj.Util.Is_Valid (File) then
6545 Error_Msg (Project, In_Tree, "file does not exist", Location);
6548 -- Read the lines one by one
6550 while not Prj.Util.End_Of_File (File) loop
6551 Prj.Util.Get_Line (File, Line, Last);
6553 -- A non empty, non comment line should contain a file name
6556 and then (Last = 1 or else Line (1 .. 2) /= "--")
6559 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6560 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6561 Source_Name := Name_Find;
6563 -- Check that there is no directory information
6565 for J in 1 .. Last loop
6566 if Line (J) = '/' or else Line (J) = Directory_Separator then
6567 Error_Msg_File_1 := Source_Name;
6571 "file name cannot include directory information ({)",
6577 Name_Loc := Source_Names.Get (Source_Name);
6579 if Name_Loc = No_Name_Location then
6581 (Name => Source_Name,
6582 Location => Location,
6583 Source => No_Source,
6588 Source_Names.Set (Source_Name, Name_Loc);
6592 Prj.Util.Close (File);
6595 end Get_Sources_From_File;
6597 -----------------------
6598 -- Compute_Unit_Name --
6599 -----------------------
6601 procedure Compute_Unit_Name
6602 (File_Name : File_Name_Type;
6603 Dot_Replacement : File_Name_Type;
6604 Separate_Suffix : File_Name_Type;
6605 Body_Suffix : File_Name_Type;
6606 Spec_Suffix : File_Name_Type;
6607 Casing : Casing_Type;
6608 Kind : out Source_Kind;
6611 Filename : constant String := Get_Name_String (File_Name);
6612 Last : Integer := Filename'Last;
6613 Sep_Len : constant Integer :=
6614 Integer (Length_Of_Name (Separate_Suffix));
6615 Body_Len : constant Integer :=
6616 Integer (Length_Of_Name (Body_Suffix));
6617 Spec_Len : constant Integer :=
6618 Integer (Length_Of_Name (Spec_Suffix));
6620 Standard_GNAT : constant Boolean :=
6621 Spec_Suffix = Default_Ada_Spec_Suffix
6623 Body_Suffix = Default_Ada_Body_Suffix;
6625 Unit_Except : Unit_Exception;
6626 Masked : Boolean := False;
6631 if Dot_Replacement = No_File then
6632 if Current_Verbosity = High then
6633 Write_Line (" No dot_replacement specified");
6638 -- Choose the longest suffix that matches. If there are several matches,
6639 -- give priority to specs, then bodies, then separates.
6641 if Separate_Suffix /= Body_Suffix
6642 and then Suffix_Matches (Filename, Separate_Suffix)
6644 Last := Filename'Last - Sep_Len;
6648 if Filename'Last - Body_Len <= Last
6649 and then Suffix_Matches (Filename, Body_Suffix)
6651 Last := Natural'Min (Last, Filename'Last - Body_Len);
6655 if Filename'Last - Spec_Len <= Last
6656 and then Suffix_Matches (Filename, Spec_Suffix)
6658 Last := Natural'Min (Last, Filename'Last - Spec_Len);
6662 if Last = Filename'Last then
6663 if Current_Verbosity = High then
6664 Write_Line (" No matching suffix");
6669 -- Check that the casing matches
6671 if File_Names_Case_Sensitive then
6673 when All_Lower_Case =>
6674 for J in Filename'First .. Last loop
6675 if Is_Letter (Filename (J))
6676 and then not Is_Lower (Filename (J))
6678 if Current_Verbosity = High then
6679 Write_Line (" Invalid casing");
6685 when All_Upper_Case =>
6686 for J in Filename'First .. Last loop
6687 if Is_Letter (Filename (J))
6688 and then not Is_Upper (Filename (J))
6690 if Current_Verbosity = High then
6691 Write_Line (" Invalid casing");
6697 when Mixed_Case | Unknown =>
6702 -- If Dot_Replacement is not a single dot, then there should not
6703 -- be any dot in the name.
6706 Dot_Repl : constant String := Get_Name_String (Dot_Replacement);
6709 if Dot_Repl /= "." then
6710 for Index in Filename'First .. Last loop
6711 if Filename (Index) = '.' then
6712 if Current_Verbosity = High then
6713 Write_Line (" Invalid name, contains dot");
6719 Replace_Into_Name_Buffer
6720 (Filename (Filename'First .. Last), Dot_Repl, '.');
6722 Name_Len := Last - Filename'First + 1;
6723 Name_Buffer (1 .. Name_Len) := Filename (Filename'First .. Last);
6725 (Source => Name_Buffer (1 .. Name_Len),
6726 Mapping => Lower_Case_Map);
6730 -- In the standard GNAT naming scheme, check for special cases: children
6731 -- or separates of A, G, I or S, and run time sources.
6733 if Standard_GNAT and then Name_Len >= 3 then
6735 S1 : constant Character := Name_Buffer (1);
6736 S2 : constant Character := Name_Buffer (2);
6737 S3 : constant Character := Name_Buffer (3);
6745 -- Children or separates of packages A, G, I or S. These names
6746 -- are x__ ... or x~... (where x is a, g, i, or s). Both
6747 -- versions (x__... and x~...) are allowed in all platforms,
6748 -- because it is not possible to know the platform before
6749 -- processing of the project files.
6751 if S2 = '_' and then S3 = '_' then
6752 Name_Buffer (2) := '.';
6753 Name_Buffer (3 .. Name_Len - 1) :=
6754 Name_Buffer (4 .. Name_Len);
6755 Name_Len := Name_Len - 1;
6758 Name_Buffer (2) := '.';
6762 -- If it is potentially a run time source, disable filling
6763 -- of the mapping file to avoid warnings.
6765 Set_Mapping_File_Initial_State_To_Empty;
6771 -- Name_Buffer contains the name of the the unit in lower-cases. Check
6772 -- that this is a valid unit name
6774 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
6776 -- If there is a naming exception for the same unit, the file is not
6777 -- a source for the unit. Currently, this only applies in multi_lang
6778 -- mode, since Unit_Exceptions is no set in ada_only mode.
6780 if Unit /= No_Name then
6781 Unit_Except := Unit_Exceptions.Get (Unit);
6784 Masked := Unit_Except.Spec /= No_File
6786 Unit_Except.Spec /= File_Name;
6788 Masked := Unit_Except.Impl /= No_File
6790 Unit_Except.Impl /= File_Name;
6794 if Current_Verbosity = High then
6795 Write_Str (" """ & Filename & """ contains the ");
6798 Write_Str ("spec of a unit found in """);
6799 Write_Str (Get_Name_String (Unit_Except.Spec));
6801 Write_Str ("body of a unit found in """);
6802 Write_Str (Get_Name_String (Unit_Except.Impl));
6805 Write_Line (""" (ignored)");
6813 and then Current_Verbosity = High
6816 when Spec => Write_Str (" spec of ");
6817 when Impl => Write_Str (" body of ");
6818 when Sep => Write_Str (" sep of ");
6821 Write_Line (Get_Name_String (Unit));
6823 end Compute_Unit_Name;
6830 (In_Tree : Project_Tree_Ref;
6831 Canonical_File_Name : File_Name_Type;
6832 Naming : Naming_Data;
6833 Exception_Id : out Ada_Naming_Exception_Id;
6834 Unit_Name : out Name_Id;
6835 Unit_Kind : out Spec_Or_Body;
6836 Needs_Pragma : out Boolean)
6838 Info_Id : Ada_Naming_Exception_Id :=
6839 Ada_Naming_Exceptions.Get (Canonical_File_Name);
6840 VMS_Name : File_Name_Type;
6844 if Info_Id = No_Ada_Naming_Exception
6845 and then Hostparm.OpenVMS
6847 VMS_Name := Canonical_File_Name;
6848 Get_Name_String (VMS_Name);
6850 if Name_Buffer (Name_Len) = '.' then
6851 Name_Len := Name_Len - 1;
6852 VMS_Name := Name_Find;
6855 Info_Id := Ada_Naming_Exceptions.Get (VMS_Name);
6858 if Info_Id /= No_Ada_Naming_Exception then
6859 Exception_Id := Info_Id;
6860 Unit_Name := No_Name;
6861 Unit_Kind := Specification;
6862 Needs_Pragma := True;
6864 Needs_Pragma := False;
6865 Exception_Id := No_Ada_Naming_Exception;
6867 (File_Name => Canonical_File_Name,
6868 Dot_Replacement => Naming.Dot_Replacement,
6869 Separate_Suffix => Naming.Separate_Suffix,
6870 Body_Suffix => Body_Suffix_Id_Of (In_Tree, Name_Ada, Naming),
6871 Spec_Suffix => Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming),
6872 Casing => Naming.Casing,
6877 when Spec => Unit_Kind := Specification;
6878 when Impl | Sep => Unit_Kind := Body_Part;
6887 function Hash (Unit : Unit_Info) return Header_Num is
6889 return Header_Num (Unit.Unit mod 2048);
6892 -----------------------
6893 -- Is_Illegal_Suffix --
6894 -----------------------
6896 function Is_Illegal_Suffix
6897 (Suffix : File_Name_Type;
6898 Dot_Replacement : File_Name_Type) return Boolean
6900 Suffix_Str : constant String := Get_Name_String (Suffix);
6903 if Suffix_Str'Length = 0 or else Index (Suffix_Str, ".") = 0 then
6907 -- If dot replacement is a single dot, and first character of suffix is
6910 if Get_Name_String (Dot_Replacement) = "."
6911 and then Suffix_Str (Suffix_Str'First) = '.'
6913 for Index in Suffix_Str'First + 1 .. Suffix_Str'Last loop
6915 -- If there is another dot
6917 if Suffix_Str (Index) = '.' then
6919 -- It is illegal to have a letter following the initial dot
6921 return Is_Letter (Suffix_Str (Suffix_Str'First + 1));
6927 end Is_Illegal_Suffix;
6929 ----------------------
6930 -- Locate_Directory --
6931 ----------------------
6933 procedure Locate_Directory
6934 (Project : Project_Id;
6935 In_Tree : Project_Tree_Ref;
6936 Name : File_Name_Type;
6937 Parent : Path_Name_Type;
6938 Dir : out Path_Name_Type;
6939 Display : out Path_Name_Type;
6940 Create : String := "";
6941 Current_Dir : String;
6942 Location : Source_Ptr := No_Location;
6943 Externally_Built : Boolean := False)
6945 The_Parent : constant String :=
6946 Get_Name_String (Parent) & Directory_Separator;
6948 The_Parent_Last : constant Natural :=
6949 Compute_Directory_Last (The_Parent);
6951 Full_Name : File_Name_Type;
6953 The_Name : File_Name_Type;
6956 Get_Name_String (Name);
6958 -- Add Subdirs.all if it is a directory that may be created and
6959 -- Subdirs is not null;
6961 if Create /= "" and then Subdirs /= null then
6962 if Name_Buffer (Name_Len) /= Directory_Separator then
6963 Add_Char_To_Name_Buffer (Directory_Separator);
6966 Add_Str_To_Name_Buffer (Subdirs.all);
6969 -- Convert '/' to directory separator (for Windows)
6971 for J in 1 .. Name_Len loop
6972 if Name_Buffer (J) = '/' then
6973 Name_Buffer (J) := Directory_Separator;
6977 The_Name := Name_Find;
6979 if Current_Verbosity = High then
6980 Write_Str ("Locate_Directory (""");
6981 Write_Str (Get_Name_String (The_Name));
6982 Write_Str (""", """);
6983 Write_Str (The_Parent);
6990 if Is_Absolute_Path (Get_Name_String (The_Name)) then
6991 Full_Name := The_Name;
6995 Add_Str_To_Name_Buffer
6996 (The_Parent (The_Parent'First .. The_Parent_Last));
6997 Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
6998 Full_Name := Name_Find;
7002 Full_Path_Name : String_Access :=
7003 new String'(Get_Name_String (Full_Name));
7006 if (Setup_Projects or else Subdirs /= null)
7007 and then Create'Length > 0
7009 if not Is_Directory (Full_Path_Name.all) then
7010 -- If project is externally built, do not create a subdir,
7011 -- use the specified directory, without the subdir.
7013 if Externally_Built then
7014 if Is_Absolute_Path (Get_Name_String (Name)) then
7015 Get_Name_String (Name);
7019 Add_Str_To_Name_Buffer
7020 (The_Parent (The_Parent'First .. The_Parent_Last));
7021 Add_Str_To_Name_Buffer (Get_Name_String (Name));
7024 Full_Path_Name := new String'(Name_Buffer (1 .. Name_Len));
7028 Create_Path (Full_Path_Name.all);
7030 if not Quiet_Output then
7032 Write_Str (" directory """);
7033 Write_Str (Full_Path_Name.all);
7034 Write_Line (""" created");
7041 "could not create " & Create &
7042 " directory " & Full_Path_Name.all,
7049 if Is_Directory (Full_Path_Name.all) then
7051 Normed : constant String :=
7053 (Full_Path_Name.all,
7054 Directory => Current_Dir,
7055 Resolve_Links => False,
7056 Case_Sensitive => True);
7058 Canonical_Path : constant String :=
7061 Directory => Current_Dir,
7063 Opt.Follow_Links_For_Dirs,
7064 Case_Sensitive => False);
7067 Name_Len := Normed'Length;
7068 Name_Buffer (1 .. Name_Len) := Normed;
7069 Display := Name_Find;
7071 Name_Len := Canonical_Path'Length;
7072 Name_Buffer (1 .. Name_Len) := Canonical_Path;
7077 Free (Full_Path_Name);
7079 end Locate_Directory;
7081 ---------------------------
7082 -- Find_Excluded_Sources --
7083 ---------------------------
7085 procedure Find_Excluded_Sources
7086 (Project : Project_Id;
7087 In_Tree : Project_Tree_Ref;
7088 Data : Project_Data)
7090 Excluded_Source_List_File : constant Variable_Value :=
7092 (Name_Excluded_Source_List_File,
7093 Data.Decl.Attributes,
7096 Excluded_Sources : Variable_Value := Util.Value_Of
7097 (Name_Excluded_Source_Files,
7098 Data.Decl.Attributes,
7101 Current : String_List_Id;
7102 Element : String_Element;
7103 Location : Source_Ptr;
7104 Name : File_Name_Type;
7105 File : Prj.Util.Text_File;
7106 Line : String (1 .. 300);
7108 Locally_Removed : Boolean := False;
7111 -- If Excluded_Source_Files is not declared, check
7112 -- Locally_Removed_Files.
7114 if Excluded_Sources.Default then
7115 Locally_Removed := True;
7118 (Name_Locally_Removed_Files, Data.Decl.Attributes, In_Tree);
7121 Excluded_Sources_Htable.Reset;
7123 -- If there are excluded sources, put them in the table
7125 if not Excluded_Sources.Default then
7126 if not Excluded_Source_List_File.Default then
7127 if Locally_Removed then
7130 "?both attributes Locally_Removed_Files and " &
7131 "Excluded_Source_List_File are present",
7132 Excluded_Source_List_File.Location);
7136 "?both attributes Excluded_Source_Files and " &
7137 "Excluded_Source_List_File are present",
7138 Excluded_Source_List_File.Location);
7142 Current := Excluded_Sources.Values;
7143 while Current /= Nil_String loop
7144 Element := In_Tree.String_Elements.Table (Current);
7145 Name := Canonical_Case_File_Name (Element.Value);
7147 -- If the element has no location, then use the location
7148 -- of Excluded_Sources to report possible errors.
7150 if Element.Location = No_Location then
7151 Location := Excluded_Sources.Location;
7153 Location := Element.Location;
7156 Excluded_Sources_Htable.Set (Name, (Name, False, Location));
7157 Current := Element.Next;
7160 elsif not Excluded_Source_List_File.Default then
7161 Location := Excluded_Source_List_File.Location;
7164 Source_File_Path_Name : constant String :=
7167 (Excluded_Source_List_File.Value),
7168 Data.Directory.Name);
7171 if Source_File_Path_Name'Length = 0 then
7172 Err_Vars.Error_Msg_File_1 :=
7173 File_Name_Type (Excluded_Source_List_File.Value);
7176 "file with excluded sources { does not exist",
7177 Excluded_Source_List_File.Location);
7182 Prj.Util.Open (File, Source_File_Path_Name);
7184 if not Prj.Util.Is_Valid (File) then
7186 (Project, In_Tree, "file does not exist", Location);
7188 -- Read the lines one by one
7190 while not Prj.Util.End_Of_File (File) loop
7191 Prj.Util.Get_Line (File, Line, Last);
7193 -- A non empty, non comment line should contain a file
7197 and then (Last = 1 or else Line (1 .. 2) /= "--")
7200 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
7201 Canonical_Case_File_Name
7202 (Name_Buffer (1 .. Name_Len));
7205 -- Check that there is no directory information
7207 for J in 1 .. Last loop
7209 or else Line (J) = Directory_Separator
7211 Error_Msg_File_1 := Name;
7215 "file name cannot include " &
7216 "directory information ({)",
7222 Excluded_Sources_Htable.Set
7223 (Name, (Name, False, Location));
7227 Prj.Util.Close (File);
7232 end Find_Excluded_Sources;
7234 ---------------------------
7235 -- Find_Explicit_Sources --
7236 ---------------------------
7238 procedure Find_Explicit_Sources
7239 (Current_Dir : String;
7240 Project : Project_Id;
7241 In_Tree : Project_Tree_Ref;
7242 Data : in out Project_Data)
7244 Sources : constant Variable_Value :=
7247 Data.Decl.Attributes,
7249 Source_List_File : constant Variable_Value :=
7251 (Name_Source_List_File,
7252 Data.Decl.Attributes,
7254 Name_Loc : Name_Location;
7257 pragma Assert (Sources.Kind = List, "Source_Files is not a list");
7259 (Source_List_File.Kind = Single,
7260 "Source_List_File is not a single string");
7262 -- If the user has specified a Sources attribute
7264 if not Sources.Default then
7265 if not Source_List_File.Default then
7268 "?both attributes source_files and " &
7269 "source_list_file are present",
7270 Source_List_File.Location);
7273 -- Sources is a list of file names
7276 Current : String_List_Id := Sources.Values;
7277 Element : String_Element;
7278 Location : Source_Ptr;
7279 Name : File_Name_Type;
7282 if Get_Mode = Ada_Only then
7283 Data.Ada_Sources_Present := Current /= Nil_String;
7286 if Get_Mode = Multi_Language then
7287 if Current = Nil_String then
7288 Data.First_Language_Processing := No_Language_Index;
7290 -- This project contains no source. For projects that
7291 -- don't extend other projects, this also means that
7292 -- there is no need for an object directory, if not
7295 if Data.Extends = No_Project
7296 and then Data.Object_Directory = Data.Directory
7298 Data.Object_Directory := No_Path_Information;
7303 while Current /= Nil_String loop
7304 Element := In_Tree.String_Elements.Table (Current);
7305 Name := Canonical_Case_File_Name (Element.Value);
7306 Get_Name_String (Element.Value);
7308 -- If the element has no location, then use the
7309 -- location of Sources to report possible errors.
7311 if Element.Location = No_Location then
7312 Location := Sources.Location;
7314 Location := Element.Location;
7317 -- Check that there is no directory information
7319 for J in 1 .. Name_Len loop
7320 if Name_Buffer (J) = '/'
7321 or else Name_Buffer (J) = Directory_Separator
7323 Error_Msg_File_1 := Name;
7327 "file name cannot include directory " &
7334 -- In Multi_Language mode, check whether the file is
7335 -- already there: the same file name may be in the list; if
7336 -- the source is missing, the error will be on the first
7337 -- mention of the source file name.
7341 Name_Loc := No_Name_Location;
7342 when Multi_Language =>
7343 Name_Loc := Source_Names.Get (Name);
7346 if Name_Loc = No_Name_Location then
7349 Location => Location,
7350 Source => No_Source,
7353 Source_Names.Set (Name, Name_Loc);
7356 Current := Element.Next;
7359 if Get_Mode = Ada_Only then
7360 Get_Path_Names_And_Record_Ada_Sources
7361 (Project, In_Tree, Data, Current_Dir);
7365 -- If we have no Source_Files attribute, check the Source_List_File
7368 elsif not Source_List_File.Default then
7370 -- Source_List_File is the name of the file
7371 -- that contains the source file names
7374 Source_File_Path_Name : constant String :=
7376 (File_Name_Type (Source_List_File.Value), Data.Directory.Name);
7379 if Source_File_Path_Name'Length = 0 then
7380 Err_Vars.Error_Msg_File_1 :=
7381 File_Name_Type (Source_List_File.Value);
7384 "file with sources { does not exist",
7385 Source_List_File.Location);
7388 Get_Sources_From_File
7389 (Source_File_Path_Name, Source_List_File.Location,
7392 if Get_Mode = Ada_Only then
7393 -- Look in the source directories to find those sources
7395 Get_Path_Names_And_Record_Ada_Sources
7396 (Project, In_Tree, Data, Current_Dir);
7402 -- Neither Source_Files nor Source_List_File has been
7403 -- specified. Find all the files that satisfy the naming
7404 -- scheme in all the source directories.
7406 if Get_Mode = Ada_Only then
7407 Find_Ada_Sources (Project, In_Tree, Data, Current_Dir);
7411 if Get_Mode = Multi_Language then
7413 (Project, In_Tree, Data,
7415 Sources.Default and then Source_List_File.Default);
7417 -- Check if all exceptions have been found.
7418 -- For Ada, it is an error if an exception is not found.
7419 -- For other language, the source is simply removed.
7425 Source := Data.First_Source;
7426 while Source /= No_Source loop
7428 Src_Data : Source_Data renames
7429 In_Tree.Sources.Table (Source);
7432 if Src_Data.Naming_Exception
7433 and then Src_Data.Path = No_Path_Information
7435 if Src_Data.Unit /= No_Name then
7436 Error_Msg_Name_1 := Name_Id (Src_Data.Display_File);
7437 Error_Msg_Name_2 := Name_Id (Src_Data.Unit);
7440 "source file %% for unit %% not found",
7444 Remove_Source (Source, No_Source, Project, Data, In_Tree);
7447 Source := Src_Data.Next_In_Project;
7452 -- Check that all sources in Source_Files or the file
7453 -- Source_List_File has been found.
7456 Name_Loc : Name_Location;
7459 Name_Loc := Source_Names.Get_First;
7460 while Name_Loc /= No_Name_Location loop
7461 if (not Name_Loc.Except) and then (not Name_Loc.Found) then
7462 Error_Msg_Name_1 := Name_Id (Name_Loc.Name);
7466 "file %% not found",
7470 Name_Loc := Source_Names.Get_Next;
7475 if Get_Mode = Ada_Only
7476 and then Data.Extends = No_Project
7478 -- We should have found at least one source, if not report an error
7480 if Data.Ada_Sources = Nil_String then
7482 (Project, "Ada", In_Tree, Source_List_File.Location);
7486 end Find_Explicit_Sources;
7488 -------------------------------------------
7489 -- Get_Path_Names_And_Record_Ada_Sources --
7490 -------------------------------------------
7492 procedure Get_Path_Names_And_Record_Ada_Sources
7493 (Project : Project_Id;
7494 In_Tree : Project_Tree_Ref;
7495 Data : in out Project_Data;
7496 Current_Dir : String)
7498 Source_Dir : String_List_Id;
7499 Element : String_Element;
7500 Path : Path_Name_Type;
7502 Name : File_Name_Type;
7503 Canonical_Name : File_Name_Type;
7504 Name_Str : String (1 .. 1_024);
7505 Last : Natural := 0;
7507 Current_Source : String_List_Id := Nil_String;
7508 First_Error : Boolean := True;
7509 Source_Recorded : Boolean := False;
7512 -- We look in all source directories for the file names in the hash
7513 -- table Source_Names.
7515 Source_Dir := Data.Source_Dirs;
7516 while Source_Dir /= Nil_String loop
7517 Source_Recorded := False;
7518 Element := In_Tree.String_Elements.Table (Source_Dir);
7521 Dir_Path : constant String :=
7522 Get_Name_String (Element.Display_Value);
7524 if Current_Verbosity = High then
7525 Write_Str ("checking directory """);
7526 Write_Str (Dir_Path);
7530 Open (Dir, Dir_Path);
7533 Read (Dir, Name_Str, Last);
7537 Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
7540 if Osint.File_Names_Case_Sensitive then
7541 Canonical_Name := Name;
7543 Canonical_Case_File_Name (Name_Str (1 .. Last));
7544 Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
7545 Canonical_Name := Name_Find;
7548 NL := Source_Names.Get (Canonical_Name);
7550 if NL /= No_Name_Location and then not NL.Found then
7552 Source_Names.Set (Canonical_Name, NL);
7553 Name_Len := Dir_Path'Length;
7554 Name_Buffer (1 .. Name_Len) := Dir_Path;
7556 if Name_Buffer (Name_Len) /= Directory_Separator then
7557 Add_Char_To_Name_Buffer (Directory_Separator);
7560 Add_Str_To_Name_Buffer (Name_Str (1 .. Last));
7563 if Current_Verbosity = High then
7564 Write_Str (" found ");
7565 Write_Line (Get_Name_String (Name));
7568 -- Register the source if it is an Ada compilation unit
7576 Location => NL.Location,
7577 Current_Source => Current_Source,
7578 Source_Recorded => Source_Recorded,
7579 Current_Dir => Current_Dir);
7586 if Source_Recorded then
7587 In_Tree.String_Elements.Table (Source_Dir).Flag :=
7591 Source_Dir := Element.Next;
7594 -- It is an error if a source file name in a source list or
7595 -- in a source list file is not found.
7597 NL := Source_Names.Get_First;
7598 while NL /= No_Name_Location loop
7599 if not NL.Found then
7600 Err_Vars.Error_Msg_File_1 := NL.Name;
7605 "source file { cannot be found",
7607 First_Error := False;
7612 "\source file { cannot be found",
7617 NL := Source_Names.Get_Next;
7619 end Get_Path_Names_And_Record_Ada_Sources;
7621 ---------------------------------------
7622 -- Get_Language_Processing_From_Lang --
7623 ---------------------------------------
7625 function Get_Language_Processing_From_Lang
7626 (In_Tree : Project_Tree_Ref;
7627 Data : Project_Data;
7628 Lang : Name_List_Index) return Language_Index
7630 Name : constant Name_Id := In_Tree.Name_Lists.Table (Lang).Name;
7631 Language : Language_Index;
7634 Language := Data.First_Language_Processing;
7635 while Language /= No_Language_Index loop
7636 if In_Tree.Languages_Data.Table (Language).Name = Name then
7640 Language := In_Tree.Languages_Data.Table (Language).Next;
7643 return No_Language_Index;
7644 end Get_Language_Processing_From_Lang;
7646 -------------------------------
7647 -- Check_File_Naming_Schemes --
7648 -------------------------------
7650 procedure Check_File_Naming_Schemes
7651 (In_Tree : Project_Tree_Ref;
7652 Data : in out Project_Data;
7653 File_Name : File_Name_Type;
7654 Alternate_Languages : out Alternate_Language_Id;
7655 Language : out Language_Index;
7656 Language_Name : out Name_Id;
7657 Display_Language_Name : out Name_Id;
7659 Lang_Kind : out Language_Kind;
7660 Kind : out Source_Kind)
7662 Filename : constant String := Get_Name_String (File_Name);
7663 Config : Language_Config;
7664 Lang : Name_List_Index;
7665 Tmp_Lang : Language_Index;
7667 Header_File : Boolean := False;
7668 -- True if we found at least one language for which the file is a header
7669 -- In such a case, we search for all possible languages where this is
7670 -- also a header (C and C++ for instance), since the file might be used
7671 -- for several such languages.
7673 procedure Check_File_Based_Lang;
7674 -- Does the naming scheme test for file-based languages. For those,
7675 -- there is no Unit. Just check if the file name has the implementation
7676 -- or, if it is specified, the template suffix of the language.
7678 -- Returns True if the file belongs to the current language and we
7679 -- should stop searching for matching languages. Not that a given header
7680 -- file could belong to several languages (C and C++ for instance). Thus
7681 -- if we found a header we'll check whether it matches other languages
7683 ---------------------------
7684 -- Check_File_Based_Lang --
7685 ---------------------------
7687 procedure Check_File_Based_Lang is
7690 and then Suffix_Matches (Filename, Config.Naming_Data.Body_Suffix)
7694 Language := Tmp_Lang;
7696 if Current_Verbosity = High then
7697 Write_Str (" implementation of language ");
7698 Write_Line (Get_Name_String (Display_Language_Name));
7701 elsif Suffix_Matches (Filename, Config.Naming_Data.Spec_Suffix) then
7702 if Current_Verbosity = High then
7703 Write_Str (" header of language ");
7704 Write_Line (Get_Name_String (Display_Language_Name));
7708 Alternate_Language_Table.Increment_Last (In_Tree.Alt_Langs);
7709 In_Tree.Alt_Langs.Table
7710 (Alternate_Language_Table.Last (In_Tree.Alt_Langs)) :=
7711 (Language => Language,
7712 Next => Alternate_Languages);
7713 Alternate_Languages :=
7714 Alternate_Language_Table.Last (In_Tree.Alt_Langs);
7717 Header_File := True;
7720 Language := Tmp_Lang;
7723 end Check_File_Based_Lang;
7725 -- Start of processing for Check_File_Naming_Schemes
7728 Language := No_Language_Index;
7729 Alternate_Languages := No_Alternate_Language;
7730 Display_Language_Name := No_Name;
7732 Lang_Kind := File_Based;
7735 Lang := Data.Languages;
7736 while Lang /= No_Name_List loop
7737 Language_Name := In_Tree.Name_Lists.Table (Lang).Name;
7738 Tmp_Lang := Get_Language_Processing_From_Lang (In_Tree, Data, Lang);
7740 if Current_Verbosity = High then
7742 (" Testing language "
7743 & Get_Name_String (Language_Name)
7744 & " Header_File=" & Header_File'Img);
7747 if Tmp_Lang /= No_Language_Index then
7748 Display_Language_Name :=
7749 In_Tree.Languages_Data.Table (Tmp_Lang).Display_Name;
7750 Config := In_Tree.Languages_Data.Table (Tmp_Lang).Config;
7751 Lang_Kind := Config.Kind;
7755 Check_File_Based_Lang;
7756 exit when Kind = Impl;
7760 -- We know it belongs to a least a file_based language, no
7761 -- need to check unit-based ones.
7763 if not Header_File then
7765 (File_Name => File_Name,
7766 Dot_Replacement => Config.Naming_Data.Dot_Replacement,
7767 Separate_Suffix => Config.Naming_Data.Separate_Suffix,
7768 Body_Suffix => Config.Naming_Data.Body_Suffix,
7769 Spec_Suffix => Config.Naming_Data.Spec_Suffix,
7770 Casing => Config.Naming_Data.Casing,
7774 if Unit /= No_Name then
7775 Language := Tmp_Lang;
7782 Lang := In_Tree.Name_Lists.Table (Lang).Next;
7785 if Language = No_Language_Index
7786 and then Current_Verbosity = High
7788 Write_Line (" not a source of any language");
7790 end Check_File_Naming_Schemes;
7796 procedure Check_File
7797 (Project : Project_Id;
7798 In_Tree : Project_Tree_Ref;
7799 Data : in out Project_Data;
7801 File_Name : File_Name_Type;
7802 Display_File_Name : File_Name_Type;
7803 Source_Directory : String;
7804 For_All_Sources : Boolean)
7806 Display_Path : constant String :=
7809 Directory => Source_Directory,
7810 Resolve_Links => Opt.Follow_Links_For_Files,
7811 Case_Sensitive => True);
7813 Name_Loc : Name_Location := Source_Names.Get (File_Name);
7814 Path_Id : Path_Name_Type;
7815 Display_Path_Id : Path_Name_Type;
7816 Check_Name : Boolean := False;
7817 Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
7818 Language : Language_Index;
7820 Other_Part : Source_Id;
7822 Src_Ind : Source_File_Index;
7824 Source_To_Replace : Source_Id := No_Source;
7826 Language_Name : Name_Id;
7827 Display_Language_Name : Name_Id;
7828 Lang_Kind : Language_Kind;
7829 Kind : Source_Kind := Spec;
7832 Name_Len := Display_Path'Length;
7833 Name_Buffer (1 .. Name_Len) := Display_Path;
7834 Display_Path_Id := Name_Find;
7836 if Osint.File_Names_Case_Sensitive then
7837 Path_Id := Display_Path_Id;
7839 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7840 Path_Id := Name_Find;
7843 if Name_Loc = No_Name_Location then
7844 Check_Name := For_All_Sources;
7847 if Name_Loc.Found then
7849 -- Check if it is OK to have the same file name in several
7850 -- source directories.
7852 if not Data.Known_Order_Of_Source_Dirs then
7853 Error_Msg_File_1 := File_Name;
7856 "{ is found in several source directories",
7861 Name_Loc.Found := True;
7863 Source_Names.Set (File_Name, Name_Loc);
7865 if Name_Loc.Source = No_Source then
7869 In_Tree.Sources.Table (Name_Loc.Source).Path :=
7870 (Path_Id, Display_Path_Id);
7872 Source_Paths_Htable.Set
7873 (In_Tree.Source_Paths_HT,
7877 -- Check if this is a subunit
7879 if In_Tree.Sources.Table (Name_Loc.Source).Unit /= No_Name
7881 In_Tree.Sources.Table (Name_Loc.Source).Kind = Impl
7883 Src_Ind := Sinput.P.Load_Project_File
7884 (Get_Name_String (Path_Id));
7886 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
7887 In_Tree.Sources.Table (Name_Loc.Source).Kind := Sep;
7895 Other_Part := No_Source;
7897 Check_File_Naming_Schemes
7898 (In_Tree => In_Tree,
7900 File_Name => File_Name,
7901 Alternate_Languages => Alternate_Languages,
7902 Language => Language,
7903 Language_Name => Language_Name,
7904 Display_Language_Name => Display_Language_Name,
7906 Lang_Kind => Lang_Kind,
7909 if Language = No_Language_Index then
7911 -- A file name in a list must be a source of a language
7913 if Name_Loc.Found then
7914 Error_Msg_File_1 := File_Name;
7918 "language unknown for {",
7923 -- Check if the same file name or unit is used in the prj tree
7925 Source := In_Tree.First_Source;
7927 while Source /= No_Source loop
7929 Src_Data : Source_Data renames
7930 In_Tree.Sources.Table (Source);
7934 and then Src_Data.Unit = Unit
7936 ((Src_Data.Kind = Spec and then Kind = Impl)
7938 (Src_Data.Kind = Impl and then Kind = Spec))
7940 Other_Part := Source;
7942 elsif (Unit /= No_Name
7943 and then Src_Data.Unit = Unit
7945 (Src_Data.Kind = Kind
7947 (Src_Data.Kind = Sep and then Kind = Impl)
7949 (Src_Data.Kind = Impl and then Kind = Sep)))
7951 (Unit = No_Name and then Src_Data.File = File_Name)
7953 -- Duplication of file/unit in same project is only
7954 -- allowed if order of source directories is known.
7956 if Project = Src_Data.Project then
7957 if Data.Known_Order_Of_Source_Dirs then
7960 elsif Unit /= No_Name then
7961 Error_Msg_Name_1 := Unit;
7963 (Project, In_Tree, "duplicate unit %%",
7968 Error_Msg_File_1 := File_Name;
7970 (Project, In_Tree, "duplicate source file name {",
7975 -- Do not allow the same unit name in different
7976 -- projects, except if one is extending the other.
7978 -- For a file based language, the same file name
7979 -- replaces a file in a project being extended, but
7980 -- it is allowed to have the same file name in
7981 -- unrelated projects.
7984 (Project, Src_Data.Project, In_Tree)
7986 Source_To_Replace := Source;
7988 elsif Unit /= No_Name
7989 and then not Src_Data.Locally_Removed
7991 Error_Msg_Name_1 := Unit;
7994 "unit %% cannot belong to several projects",
7998 In_Tree.Projects.Table (Project).Name;
7999 Error_Msg_Name_2 := Name_Id (Display_Path_Id);
8001 (Project, In_Tree, "\ project %%, %%", No_Location);
8004 In_Tree.Projects.Table (Src_Data.Project).Name;
8006 Name_Id (Src_Data.Path.Display_Name);
8008 (Project, In_Tree, "\ project %%, %%", No_Location);
8014 Source := Src_Data.Next_In_Sources;
8024 Lang => Language_Name,
8025 Lang_Id => Language,
8026 Lang_Kind => Lang_Kind,
8028 Alternate_Languages => Alternate_Languages,
8029 File_Name => File_Name,
8030 Display_File => Display_File_Name,
8031 Other_Part => Other_Part,
8034 Display_Path => Display_Path_Id,
8035 Source_To_Replace => Source_To_Replace);
8041 ------------------------
8042 -- Search_Directories --
8043 ------------------------
8045 procedure Search_Directories
8046 (Project : Project_Id;
8047 In_Tree : Project_Tree_Ref;
8048 Data : in out Project_Data;
8049 For_All_Sources : Boolean)
8051 Source_Dir : String_List_Id;
8052 Element : String_Element;
8054 Name : String (1 .. 1_000);
8056 File_Name : File_Name_Type;
8057 Display_File_Name : File_Name_Type;
8060 if Current_Verbosity = High then
8061 Write_Line ("Looking for sources:");
8064 -- Loop through subdirectories
8066 Source_Dir := Data.Source_Dirs;
8067 while Source_Dir /= Nil_String loop
8069 Element := In_Tree.String_Elements.Table (Source_Dir);
8070 if Element.Value /= No_Name then
8071 Get_Name_String (Element.Display_Value);
8074 Source_Directory : constant String :=
8075 Name_Buffer (1 .. Name_Len) &
8076 Directory_Separator;
8078 Dir_Last : constant Natural :=
8079 Compute_Directory_Last
8083 if Current_Verbosity = High then
8084 Write_Attr ("Source_Dir", Source_Directory);
8087 -- We look to every entry in the source directory
8089 Open (Dir, Source_Directory);
8092 Read (Dir, Name, Last);
8096 -- ??? Duplicate system call here, we just did a
8097 -- a similar one. Maybe Ada.Directories would be more
8101 (Source_Directory & Name (1 .. Last))
8103 if Current_Verbosity = High then
8104 Write_Str (" Checking ");
8105 Write_Line (Name (1 .. Last));
8109 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
8110 Display_File_Name := Name_Find;
8112 if Osint.File_Names_Case_Sensitive then
8113 File_Name := Display_File_Name;
8115 Canonical_Case_File_Name
8116 (Name_Buffer (1 .. Name_Len));
8117 File_Name := Name_Find;
8122 Excluded_Sources_Htable.Get (File_Name);
8125 if FF /= No_File_Found then
8126 if not FF.Found then
8128 Excluded_Sources_Htable.Set
8131 if Current_Verbosity = High then
8132 Write_Str (" excluded source """);
8133 Write_Str (Get_Name_String (File_Name));
8140 (Project => Project,
8143 Name => Name (1 .. Last),
8144 File_Name => File_Name,
8145 Display_File_Name => Display_File_Name,
8146 Source_Directory => Source_Directory
8147 (Source_Directory'First .. Dir_Last),
8148 For_All_Sources => For_All_Sources);
8159 when Directory_Error =>
8163 Source_Dir := Element.Next;
8166 if Current_Verbosity = High then
8167 Write_Line ("end Looking for sources.");
8169 end Search_Directories;
8171 ----------------------------
8172 -- Load_Naming_Exceptions --
8173 ----------------------------
8175 procedure Load_Naming_Exceptions
8176 (Project : Project_Id;
8177 In_Tree : Project_Tree_Ref;
8178 Data : in out Project_Data)
8181 File : File_Name_Type;
8185 Unit_Exceptions.Reset;
8187 Source := Data.First_Source;
8188 while Source /= No_Source loop
8189 File := In_Tree.Sources.Table (Source).File;
8190 Unit := In_Tree.Sources.Table (Source).Unit;
8192 -- An excluded file cannot also be an exception file name
8194 if Excluded_Sources_Htable.Get (File) /= No_File_Found then
8195 Error_Msg_File_1 := File;
8198 "{ cannot be both excluded and an exception file name",
8202 if Current_Verbosity = High then
8203 Write_Str ("Naming exception: Putting source #");
8204 Write_Str (Source'Img);
8205 Write_Str (", file ");
8206 Write_Str (Get_Name_String (File));
8207 Write_Line (" in Source_Names");
8214 Location => No_Location,
8216 Except => Unit /= No_Name,
8219 -- If this is an Ada exception, record in table Unit_Exceptions
8221 if Unit /= No_Name then
8223 Unit_Except : Unit_Exception := Unit_Exceptions.Get (Unit);
8226 Unit_Except.Name := Unit;
8228 if In_Tree.Sources.Table (Source).Kind = Spec then
8229 Unit_Except.Spec := File;
8231 Unit_Except.Impl := File;
8234 Unit_Exceptions.Set (Unit, Unit_Except);
8238 Source := In_Tree.Sources.Table (Source).Next_In_Project;
8240 end Load_Naming_Exceptions;
8242 ----------------------
8243 -- Look_For_Sources --
8244 ----------------------
8246 procedure Look_For_Sources
8247 (Project : Project_Id;
8248 In_Tree : Project_Tree_Ref;
8249 Data : in out Project_Data;
8250 Current_Dir : String)
8252 procedure Process_Sources_In_Multi_Language_Mode;
8253 -- Find all source files when in multi language mode
8255 procedure Mark_Excluded_Sources;
8256 -- Mark as such the sources that are declared as excluded
8258 ---------------------------
8259 -- Mark_Excluded_Sources --
8260 ---------------------------
8262 procedure Mark_Excluded_Sources is
8263 Source : Source_Id := No_Source;
8266 Excluded : File_Found := Excluded_Sources_Htable.Get_First;
8269 (Extended : Project_Id;
8271 Kind : Spec_Or_Body);
8272 -- If the current file (Excluded) belongs to the current project or
8273 -- one that the current project extends, then mark this file/unit as
8274 -- excluded. It is an error to locally remove a file from another
8282 (Extended : Project_Id;
8284 Kind : Spec_Or_Body)
8287 if Extended = Project
8288 or else Is_Extending (Project, Extended, In_Tree)
8292 if Index /= No_Unit_Index then
8293 Unit.File_Names (Kind).Path.Name := Slash;
8294 Unit.File_Names (Kind).Needs_Pragma := False;
8295 In_Tree.Units.Table (Index) := Unit;
8298 if Source /= No_Source then
8299 In_Tree.Sources.Table (Source).Locally_Removed := True;
8300 In_Tree.Sources.Table (Source).In_Interfaces := False;
8303 if Current_Verbosity = High then
8304 Write_Str ("Removing file ");
8305 Write_Line (Get_Name_String (Excluded.File));
8308 Add_Forbidden_File_Name (Excluded.File);
8313 "cannot remove a source from another project",
8318 -- Start of processing for Mark_Excluded_Sources
8321 while Excluded /= No_File_Found loop
8327 -- ??? This loop could be the same as for Multi_Language if
8328 -- we were setting In_Tree.First_Source when we search for
8329 -- Ada sources (basically once we have removed the use of
8330 -- Data.Ada_Sources).
8333 for Index in Unit_Table.First ..
8334 Unit_Table.Last (In_Tree.Units)
8336 Unit := In_Tree.Units.Table (Index);
8338 for Kind in Spec_Or_Body'Range loop
8339 if Unit.File_Names (Kind).Name = Excluded.File then
8340 Exclude (Unit.File_Names (Kind).Project, Index, Kind);
8344 end loop For_Each_Unit;
8346 when Multi_Language =>
8347 Source := In_Tree.First_Source;
8348 while Source /= No_Source loop
8349 if In_Tree.Sources.Table (Source).File = Excluded.File then
8351 (In_Tree.Sources.Table (Source).Project,
8352 No_Unit_Index, Specification);
8356 Source := In_Tree.Sources.Table (Source).Next_In_Sources;
8359 OK := OK or Excluded.Found;
8363 Err_Vars.Error_Msg_File_1 := Excluded.File;
8365 (Project, In_Tree, "unknown file {", Excluded.Location);
8368 Excluded := Excluded_Sources_Htable.Get_Next;
8370 end Mark_Excluded_Sources;
8372 --------------------------------------------
8373 -- Process_Sources_In_Multi_Language_Mode --
8374 --------------------------------------------
8376 procedure Process_Sources_In_Multi_Language_Mode is
8378 -- Check that two sources of this project do not have the same object
8381 Check_Object_File_Names : declare
8383 Source_Name : File_Name_Type;
8385 procedure Check_Object (Src_Data : Source_Data);
8386 -- Check if object file name of the current source is already in
8387 -- hash table Object_File_Names. If it is, report an error. If it
8388 -- is not, put it there with the file name of the current source.
8394 procedure Check_Object (Src_Data : Source_Data) is
8396 Source_Name := Object_File_Names.Get (Src_Data.Object);
8398 if Source_Name /= No_File then
8399 Error_Msg_File_1 := Src_Data.File;
8400 Error_Msg_File_2 := Source_Name;
8404 "{ and { have the same object file name",
8408 Object_File_Names.Set (Src_Data.Object, Src_Data.File);
8412 -- Start of processing for Check_Object_File_Names
8415 Object_File_Names.Reset;
8416 Src_Id := In_Tree.First_Source;
8417 while Src_Id /= No_Source loop
8419 Src_Data : Source_Data renames
8420 In_Tree.Sources.Table (Src_Id);
8423 if Src_Data.Compiled and then Src_Data.Object_Exists
8424 and then Is_Extending (Project, Src_Data.Project, In_Tree)
8426 if Src_Data.Unit = No_Name then
8427 if Src_Data.Kind = Impl then
8428 Check_Object (Src_Data);
8432 case Src_Data.Kind is
8434 if Src_Data.Other_Part = No_Source then
8435 Check_Object (Src_Data);
8442 if Src_Data.Other_Part /= No_Source then
8443 Check_Object (Src_Data);
8446 -- Check if it is a subunit
8449 Src_Ind : constant Source_File_Index :=
8450 Sinput.P.Load_Project_File
8452 (Src_Data.Path.Name));
8454 if Sinput.P.Source_File_Is_Subunit
8457 In_Tree.Sources.Table (Src_Id).Kind :=
8460 Check_Object (Src_Data);
8468 Src_Id := Src_Data.Next_In_Sources;
8471 end Check_Object_File_Names;
8472 end Process_Sources_In_Multi_Language_Mode;
8474 -- Start of processing for Look_For_Sources
8478 Find_Excluded_Sources (Project, In_Tree, Data);
8480 if (Get_Mode = Ada_Only and then Is_A_Language (In_Tree, Data, Name_Ada))
8481 or else (Get_Mode = Multi_Language
8482 and then Data.First_Language_Processing /= No_Language_Index)
8484 if Get_Mode = Multi_Language then
8485 Load_Naming_Exceptions (Project, In_Tree, Data);
8488 Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data);
8489 Mark_Excluded_Sources;
8491 if Get_Mode = Multi_Language then
8492 Process_Sources_In_Multi_Language_Mode;
8495 end Look_For_Sources;
8501 function Path_Name_Of
8502 (File_Name : File_Name_Type;
8503 Directory : Path_Name_Type) return String
8505 Result : String_Access;
8506 The_Directory : constant String := Get_Name_String (Directory);
8509 Get_Name_String (File_Name);
8512 (File_Name => Name_Buffer (1 .. Name_Len),
8513 Path => The_Directory);
8515 if Result = null then
8519 R : String := Result.all;
8522 Canonical_Case_File_Name (R);
8528 -----------------------------------
8529 -- Prepare_Ada_Naming_Exceptions --
8530 -----------------------------------
8532 procedure Prepare_Ada_Naming_Exceptions
8533 (List : Array_Element_Id;
8534 In_Tree : Project_Tree_Ref;
8535 Kind : Spec_Or_Body)
8537 Current : Array_Element_Id;
8538 Element : Array_Element;
8542 -- Traverse the list
8545 while Current /= No_Array_Element loop
8546 Element := In_Tree.Array_Elements.Table (Current);
8548 if Element.Index /= No_Name then
8551 Unit => Element.Index,
8552 Next => No_Ada_Naming_Exception);
8553 Reverse_Ada_Naming_Exceptions.Set
8554 (Unit, (Element.Value.Value, Element.Value.Index));
8556 Ada_Naming_Exceptions.Get (File_Name_Type (Element.Value.Value));
8557 Ada_Naming_Exception_Table.Increment_Last;
8558 Ada_Naming_Exception_Table.Table
8559 (Ada_Naming_Exception_Table.Last) := Unit;
8560 Ada_Naming_Exceptions.Set
8561 (File_Name_Type (Element.Value.Value),
8562 Ada_Naming_Exception_Table.Last);
8565 Current := Element.Next;
8567 end Prepare_Ada_Naming_Exceptions;
8569 -----------------------
8570 -- Record_Ada_Source --
8571 -----------------------
8573 procedure Record_Ada_Source
8574 (File_Name : File_Name_Type;
8575 Path_Name : Path_Name_Type;
8576 Project : Project_Id;
8577 In_Tree : Project_Tree_Ref;
8578 Data : in out Project_Data;
8579 Location : Source_Ptr;
8580 Current_Source : in out String_List_Id;
8581 Source_Recorded : in out Boolean;
8582 Current_Dir : String)
8584 Canonical_File_Name : File_Name_Type;
8585 Canonical_Path_Name : Path_Name_Type;
8587 Exception_Id : Ada_Naming_Exception_Id;
8588 Unit_Name : Name_Id;
8589 Unit_Kind : Spec_Or_Body;
8590 Unit_Ind : Int := 0;
8592 Name_Index : Name_And_Index;
8593 Needs_Pragma : Boolean;
8595 The_Location : Source_Ptr := Location;
8596 Previous_Source : constant String_List_Id := Current_Source;
8597 Except_Name : Name_And_Index := No_Name_And_Index;
8599 Unit_Prj : Unit_Project;
8601 File_Name_Recorded : Boolean := False;
8604 Canonical_File_Name := Canonical_Case_File_Name (Name_Id (File_Name));
8606 if Osint.File_Names_Case_Sensitive then
8607 Canonical_Path_Name := Path_Name;
8610 Canonical_Path : constant String :=
8612 (Get_Name_String (Path_Name),
8613 Directory => Current_Dir,
8614 Resolve_Links => Opt.Follow_Links_For_Files,
8615 Case_Sensitive => False);
8618 Add_Str_To_Name_Buffer (Canonical_Path);
8619 Canonical_Path_Name := Name_Find;
8623 -- Find out the unit name, the unit kind and if it needs
8624 -- a specific SFN pragma.
8627 (In_Tree => In_Tree,
8628 Canonical_File_Name => Canonical_File_Name,
8629 Naming => Data.Naming,
8630 Exception_Id => Exception_Id,
8631 Unit_Name => Unit_Name,
8632 Unit_Kind => Unit_Kind,
8633 Needs_Pragma => Needs_Pragma);
8635 if Exception_Id = No_Ada_Naming_Exception
8636 and then Unit_Name = No_Name
8638 if Current_Verbosity = High then
8640 Write_Str (Get_Name_String (Canonical_File_Name));
8641 Write_Line (""" is not a valid source file name (ignored).");
8645 -- Check to see if the source has been hidden by an exception,
8646 -- but only if it is not an exception.
8648 if not Needs_Pragma then
8650 Reverse_Ada_Naming_Exceptions.Get
8651 ((Unit_Kind, Unit_Name, No_Ada_Naming_Exception));
8653 if Except_Name /= No_Name_And_Index then
8654 if Current_Verbosity = High then
8656 Write_Str (Get_Name_String (Canonical_File_Name));
8657 Write_Str (""" contains a unit that is found in """);
8658 Write_Str (Get_Name_String (Except_Name.Name));
8659 Write_Line (""" (ignored).");
8662 -- The file is not included in the source of the project since
8663 -- it is hidden by the exception. So, nothing else to do.
8670 if Exception_Id /= No_Ada_Naming_Exception then
8671 Info := Ada_Naming_Exception_Table.Table (Exception_Id);
8672 Exception_Id := Info.Next;
8673 Info.Next := No_Ada_Naming_Exception;
8674 Name_Index := Reverse_Ada_Naming_Exceptions.Get (Info);
8676 Unit_Name := Info.Unit;
8677 Unit_Ind := Name_Index.Index;
8678 Unit_Kind := Info.Kind;
8681 -- Put the file name in the list of sources of the project
8683 String_Element_Table.Increment_Last (In_Tree.String_Elements);
8684 In_Tree.String_Elements.Table
8685 (String_Element_Table.Last (In_Tree.String_Elements)) :=
8686 (Value => Name_Id (Canonical_File_Name),
8687 Display_Value => Name_Id (File_Name),
8688 Location => No_Location,
8693 if Current_Source = Nil_String then
8695 String_Element_Table.Last (In_Tree.String_Elements);
8697 In_Tree.String_Elements.Table (Current_Source).Next :=
8698 String_Element_Table.Last (In_Tree.String_Elements);
8702 String_Element_Table.Last (In_Tree.String_Elements);
8704 -- Put the unit in unit list
8707 The_Unit : Unit_Index :=
8708 Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
8710 The_Unit_Data : Unit_Data;
8713 if Current_Verbosity = High then
8714 Write_Str ("Putting ");
8715 Write_Str (Get_Name_String (Unit_Name));
8716 Write_Line (" in the unit list.");
8719 -- The unit is already in the list, but may be it is
8720 -- only the other unit kind (spec or body), or what is
8721 -- in the unit list is a unit of a project we are extending.
8723 if The_Unit /= No_Unit_Index then
8724 The_Unit_Data := In_Tree.Units.Table (The_Unit);
8726 if (The_Unit_Data.File_Names (Unit_Kind).Name =
8729 The_Unit_Data.File_Names
8730 (Unit_Kind).Path.Name = Slash)
8731 or else The_Unit_Data.File_Names (Unit_Kind).Name = No_File
8732 or else Is_Extending
8734 The_Unit_Data.File_Names (Unit_Kind).Project,
8738 The_Unit_Data.File_Names (Unit_Kind).Path.Name = Slash
8740 Remove_Forbidden_File_Name
8741 (The_Unit_Data.File_Names (Unit_Kind).Name);
8744 -- Record the file name in the hash table Files_Htable
8746 Unit_Prj := (Unit => The_Unit, Project => Project);
8749 Canonical_File_Name,
8752 The_Unit_Data.File_Names (Unit_Kind) :=
8753 (Name => Canonical_File_Name,
8755 Display_Name => File_Name,
8756 Path => (Canonical_Path_Name, Path_Name),
8758 Needs_Pragma => Needs_Pragma);
8759 In_Tree.Units.Table (The_Unit) := The_Unit_Data;
8760 Source_Recorded := True;
8762 elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project
8763 and then (Data.Known_Order_Of_Source_Dirs
8765 The_Unit_Data.File_Names
8766 (Unit_Kind).Path.Name = Canonical_Path_Name)
8768 if Previous_Source = Nil_String then
8769 Data.Ada_Sources := Nil_String;
8771 In_Tree.String_Elements.Table (Previous_Source).Next :=
8773 String_Element_Table.Decrement_Last
8774 (In_Tree.String_Elements);
8777 Current_Source := Previous_Source;
8780 -- It is an error to have two units with the same name
8781 -- and the same kind (spec or body).
8783 if The_Location = No_Location then
8785 In_Tree.Projects.Table (Project).Location;
8788 Err_Vars.Error_Msg_Name_1 := Unit_Name;
8790 (Project, In_Tree, "duplicate unit %%", The_Location);
8792 Err_Vars.Error_Msg_Name_1 :=
8793 In_Tree.Projects.Table
8794 (The_Unit_Data.File_Names (Unit_Kind).Project).Name;
8795 Err_Vars.Error_Msg_File_1 :=
8797 (The_Unit_Data.File_Names (Unit_Kind).Path.Name);
8800 "\ project file %%, {", The_Location);
8802 Err_Vars.Error_Msg_Name_1 :=
8803 In_Tree.Projects.Table (Project).Name;
8804 Err_Vars.Error_Msg_File_1 :=
8805 File_Name_Type (Canonical_Path_Name);
8808 "\ project file %%, {", The_Location);
8811 -- It is a new unit, create a new record
8814 -- First, check if there is no other unit with this file
8815 -- name in another project. If it is, report error but note
8816 -- we do that only for the first unit in the source file.
8819 Files_Htable.Get (In_Tree.Files_HT, Canonical_File_Name);
8821 if not File_Name_Recorded and then
8822 Unit_Prj /= No_Unit_Project
8824 Error_Msg_File_1 := File_Name;
8826 In_Tree.Projects.Table (Unit_Prj.Project).Name;
8829 "{ is already a source of project %%",
8833 Unit_Table.Increment_Last (In_Tree.Units);
8834 The_Unit := Unit_Table.Last (In_Tree.Units);
8836 (In_Tree.Units_HT, Unit_Name, The_Unit);
8837 Unit_Prj := (Unit => The_Unit, Project => Project);
8840 Canonical_File_Name,
8842 The_Unit_Data.Name := Unit_Name;
8843 The_Unit_Data.File_Names (Unit_Kind) :=
8844 (Name => Canonical_File_Name,
8846 Display_Name => File_Name,
8847 Path => (Canonical_Path_Name, Path_Name),
8849 Needs_Pragma => Needs_Pragma);
8850 In_Tree.Units.Table (The_Unit) := The_Unit_Data;
8851 Source_Recorded := True;
8856 exit when Exception_Id = No_Ada_Naming_Exception;
8857 File_Name_Recorded := True;
8860 end Record_Ada_Source;
8866 procedure Remove_Source
8868 Replaced_By : Source_Id;
8869 Project : Project_Id;
8870 Data : in out Project_Data;
8871 In_Tree : Project_Tree_Ref)
8873 Src_Data : constant Source_Data := In_Tree.Sources.Table (Id);
8877 if Current_Verbosity = High then
8878 Write_Str ("Removing source #");
8879 Write_Line (Id'Img);
8882 if Replaced_By /= No_Source then
8883 In_Tree.Sources.Table (Id).Replaced_By := Replaced_By;
8884 In_Tree.Sources.Table (Replaced_By).Declared_In_Interfaces :=
8885 In_Tree.Sources.Table (Id).Declared_In_Interfaces;
8888 -- Remove the source from the global source list
8890 Source := In_Tree.First_Source;
8893 In_Tree.First_Source := Src_Data.Next_In_Sources;
8896 while In_Tree.Sources.Table (Source).Next_In_Sources /= Id loop
8897 Source := In_Tree.Sources.Table (Source).Next_In_Sources;
8900 In_Tree.Sources.Table (Source).Next_In_Sources :=
8901 Src_Data.Next_In_Sources;
8904 -- Remove the source from the project list
8906 if Src_Data.Project = Project then
8907 Source := Data.First_Source;
8910 Data.First_Source := Src_Data.Next_In_Project;
8912 if Src_Data.Next_In_Project = No_Source then
8913 Data.Last_Source := No_Source;
8917 while In_Tree.Sources.Table (Source).Next_In_Project /= Id loop
8918 Source := In_Tree.Sources.Table (Source).Next_In_Project;
8921 In_Tree.Sources.Table (Source).Next_In_Project :=
8922 Src_Data.Next_In_Project;
8924 if Src_Data.Next_In_Project = No_Source then
8925 In_Tree.Projects.Table (Src_Data.Project).Last_Source := Source;
8930 Source := In_Tree.Projects.Table (Src_Data.Project).First_Source;
8933 In_Tree.Projects.Table (Src_Data.Project).First_Source :=
8934 Src_Data.Next_In_Project;
8936 if Src_Data.Next_In_Project = No_Source then
8937 In_Tree.Projects.Table (Src_Data.Project).Last_Source :=
8942 while In_Tree.Sources.Table (Source).Next_In_Project /= Id loop
8943 Source := In_Tree.Sources.Table (Source).Next_In_Project;
8946 In_Tree.Sources.Table (Source).Next_In_Project :=
8947 Src_Data.Next_In_Project;
8949 if Src_Data.Next_In_Project = No_Source then
8950 In_Tree.Projects.Table (Src_Data.Project).Last_Source := Source;
8955 -- Remove source from the language list
8957 Source := In_Tree.Languages_Data.Table (Src_Data.Language).First_Source;
8960 In_Tree.Languages_Data.Table (Src_Data.Language).First_Source :=
8961 Src_Data.Next_In_Lang;
8964 while In_Tree.Sources.Table (Source).Next_In_Lang /= Id loop
8965 Source := In_Tree.Sources.Table (Source).Next_In_Lang;
8968 In_Tree.Sources.Table (Source).Next_In_Lang :=
8969 Src_Data.Next_In_Lang;
8973 -----------------------
8974 -- Report_No_Sources --
8975 -----------------------
8977 procedure Report_No_Sources
8978 (Project : Project_Id;
8980 In_Tree : Project_Tree_Ref;
8981 Location : Source_Ptr;
8982 Continuation : Boolean := False)
8985 case When_No_Sources is
8989 when Warning | Error =>
8991 Msg : constant String :=
8994 " sources in this project";
8997 Error_Msg_Warn := When_No_Sources = Warning;
8999 if Continuation then
9001 (Project, In_Tree, "\" & Msg, Location);
9005 (Project, In_Tree, Msg, Location);
9009 end Report_No_Sources;
9011 ----------------------
9012 -- Show_Source_Dirs --
9013 ----------------------
9015 procedure Show_Source_Dirs
9016 (Data : Project_Data;
9017 In_Tree : Project_Tree_Ref)
9019 Current : String_List_Id;
9020 Element : String_Element;
9023 Write_Line ("Source_Dirs:");
9025 Current := Data.Source_Dirs;
9026 while Current /= Nil_String loop
9027 Element := In_Tree.String_Elements.Table (Current);
9029 Write_Line (Get_Name_String (Element.Value));
9030 Current := Element.Next;
9033 Write_Line ("end Source_Dirs.");
9034 end Show_Source_Dirs;
9036 -------------------------
9037 -- Warn_If_Not_Sources --
9038 -------------------------
9040 -- comments needed in this body ???
9042 procedure Warn_If_Not_Sources
9043 (Project : Project_Id;
9044 In_Tree : Project_Tree_Ref;
9045 Conventions : Array_Element_Id;
9047 Extending : Boolean)
9049 Conv : Array_Element_Id;
9051 The_Unit_Id : Unit_Index;
9052 The_Unit_Data : Unit_Data;
9053 Location : Source_Ptr;
9056 Conv := Conventions;
9057 while Conv /= No_Array_Element loop
9058 Unit := In_Tree.Array_Elements.Table (Conv).Index;
9059 Error_Msg_Name_1 := Unit;
9060 Get_Name_String (Unit);
9061 To_Lower (Name_Buffer (1 .. Name_Len));
9063 The_Unit_Id := Units_Htable.Get (In_Tree.Units_HT, Unit);
9064 Location := In_Tree.Array_Elements.Table (Conv).Value.Location;
9066 if The_Unit_Id = No_Unit_Index then
9067 Error_Msg (Project, In_Tree, "?unknown unit %%", Location);
9070 The_Unit_Data := In_Tree.Units.Table (The_Unit_Id);
9072 In_Tree.Array_Elements.Table (Conv).Value.Value;
9075 if not Check_Project
9076 (The_Unit_Data.File_Names (Specification).Project,
9077 Project, In_Tree, Extending)
9081 "?source of spec of unit %% (%%)" &
9082 " cannot be found in this project",
9087 if not Check_Project
9088 (The_Unit_Data.File_Names (Body_Part).Project,
9089 Project, In_Tree, Extending)
9093 "?source of body of unit %% (%%)" &
9094 " cannot be found in this project",
9100 Conv := In_Tree.Array_Elements.Table (Conv).Next;
9102 end Warn_If_Not_Sources;