1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2000-2007, 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 Object_Suffix : constant String := Get_Target_Object_Suffix.all;
69 -- File suffix for object files
71 type Name_Location is record
72 Name : File_Name_Type;
73 Location : Source_Ptr;
74 Source : Source_Id := No_Source;
75 Except : Boolean := False;
76 Found : Boolean := False;
78 -- Information about file names found in string list attribute
79 -- Source_Files or in a source list file, stored in hash table
80 -- Source_Names, used by procedure Get_Path_Names_And_Record_Sources.
82 No_Name_Location : constant Name_Location :=
84 Location => No_Location,
89 package Source_Names is new GNAT.HTable.Simple_HTable
90 (Header_Num => Header_Num,
91 Element => Name_Location,
92 No_Element => No_Name_Location,
93 Key => File_Name_Type,
96 -- Hash table to store file names found in string list attribute
97 -- Source_Files or in a source list file, stored in hash table
98 -- Source_Names, used by procedure Get_Path_Names_And_Record_Sources.
100 package Recursive_Dirs is new GNAT.HTable.Simple_HTable
101 (Header_Num => Header_Num,
107 -- Hash table to store recursive source directories, to avoid looking
108 -- several times, and to avoid cycles that may be introduced by symbolic
111 type Ada_Naming_Exception_Id is new Nat;
112 No_Ada_Naming_Exception : constant Ada_Naming_Exception_Id := 0;
114 type Unit_Info is record
117 Next : Ada_Naming_Exception_Id := No_Ada_Naming_Exception;
119 -- No_Unit : constant Unit_Info :=
120 -- (Specification, No_Name, No_Ada_Naming_Exception);
122 package Ada_Naming_Exception_Table is new Table.Table
123 (Table_Component_Type => Unit_Info,
124 Table_Index_Type => Ada_Naming_Exception_Id,
125 Table_Low_Bound => 1,
127 Table_Increment => 100,
128 Table_Name => "Prj
.Nmsc
.Ada_Naming_Exception_Table
");
130 package Ada_Naming_Exceptions is new GNAT.HTable.Simple_HTable
131 (Header_Num => Header_Num,
132 Element => Ada_Naming_Exception_Id,
133 No_Element => No_Ada_Naming_Exception,
134 Key => File_Name_Type,
137 -- A hash table to store naming exceptions for Ada. For each file name
138 -- there is one or several unit in table Ada_Naming_Exception_Table.
140 function Hash (Unit : Unit_Info) return Header_Num;
142 type Name_And_Index is record
143 Name : Name_Id := No_Name;
146 No_Name_And_Index : constant Name_And_Index :=
147 (Name => No_Name, Index => 0);
149 package Reverse_Ada_Naming_Exceptions is new GNAT.HTable.Simple_HTable
150 (Header_Num => Header_Num,
151 Element => Name_And_Index,
152 No_Element => No_Name_And_Index,
156 -- A table to check if a unit with an exceptional name will hide
157 -- a source with a file name following the naming convention.
161 Data : in out Project_Data;
162 In_Tree : Project_Tree_Ref);
163 -- Add a new source to the different lists: list of all sources in the
164 -- project tree, list of source of a project and list of sources of a
167 function ALI_File_Name (Source : String) return String;
168 -- Return the ALI file name corresponding to a source
170 procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
171 -- Check that a name is a valid Ada unit name
173 procedure Check_Naming_Schemes
174 (Data : in out Project_Data;
175 Project : Project_Id;
176 In_Tree : Project_Tree_Ref);
177 -- Check the naming scheme part of Data
179 procedure Check_Ada_Naming_Scheme_Validity
180 (Project : Project_Id;
181 In_Tree : Project_Tree_Ref;
182 Naming : Naming_Data);
183 -- Check that the package Naming is correct
185 procedure Check_Configuration
186 (Project : Project_Id;
187 In_Tree : Project_Tree_Ref;
188 Data : in out Project_Data);
189 -- Check the configuration attributes for the project
191 procedure Check_For_Source
192 (File_Name : File_Name_Type;
193 Path_Name : Path_Name_Type;
194 Project : Project_Id;
195 In_Tree : Project_Tree_Ref;
196 Data : in out Project_Data;
197 Location : Source_Ptr;
198 Language : Language_Index;
200 Naming_Exception : Boolean);
201 -- Check if a file, with name File_Name and path Path_Name, in a source
202 -- directory is a source for language Language in project Project of
203 -- project tree In_Tree. ???
205 procedure Check_If_Externally_Built
206 (Project : Project_Id;
207 In_Tree : Project_Tree_Ref;
208 Data : in out Project_Data);
209 -- Check attribute Externally_Built of project Project in project tree
210 -- In_Tree and modify its data Data if it has the value "true".
212 procedure Check_Library_Attributes
213 (Project : Project_Id;
214 In_Tree : Project_Tree_Ref;
215 Data : in out Project_Data);
216 -- Check the library attributes of project Project in project tree In_Tree
217 -- and modify its data Data accordingly.
219 procedure Check_Package_Naming
220 (Project : Project_Id;
221 In_Tree : Project_Tree_Ref;
222 Data : in out Project_Data);
223 -- Check package Naming of project Project in project tree In_Tree and
224 -- modify its data Data accordingly.
226 procedure Check_Programming_Languages
227 (In_Tree : Project_Tree_Ref;
228 Project : Project_Id;
229 Data : in out Project_Data);
230 -- Check attribute Languages for the project with data Data in project
231 -- tree In_Tree and set the components of Data for all the programming
232 -- languages indicated in attribute Languages, if any.
234 function Check_Project
236 Root_Project : Project_Id;
237 In_Tree : Project_Tree_Ref;
238 Extending : Boolean) return Boolean;
239 -- Returns True if P is Root_Project or, if Extending is True, a project
240 -- extended by Root_Project.
242 procedure Check_Stand_Alone_Library
243 (Project : Project_Id;
244 In_Tree : Project_Tree_Ref;
245 Data : in out Project_Data;
246 Extending : Boolean);
247 -- Check if project Project in project tree In_Tree is a Stand-Alone
248 -- Library project, and modify its data Data accordingly if it is one.
250 function Compute_Directory_Last (Dir : String) return Natural;
251 -- Return the index of the last significant character in Dir. This is used
252 -- to avoid duplicates '/' at the end of directory names
255 (Project : Project_Id;
256 In_Tree : Project_Tree_Ref;
258 Flag_Location : Source_Ptr);
259 -- Output an error message. If Error_Report is null, simply call
260 -- Prj.Err.Error_Msg. Otherwise, disregard Flag_Location and use
263 procedure Find_Ada_Sources
264 (Project : Project_Id;
265 In_Tree : Project_Tree_Ref;
266 Data : in out Project_Data;
267 Follow_Links : Boolean := False);
268 -- Find all the Ada sources in all of the source directories of a project
270 procedure Find_Sources
271 (Project : Project_Id;
272 In_Tree : Project_Tree_Ref;
273 Data : in out Project_Data;
274 For_Language : Language_Index;
275 Follow_Links : Boolean := False);
276 -- Find all the sources in all of the source directories of a project for
277 -- a specified language.
279 procedure Free_Ada_Naming_Exceptions;
280 -- Free the internal hash tables used for checking naming exceptions
282 procedure Get_Directories
283 (Project : Project_Id;
284 In_Tree : Project_Tree_Ref;
285 Data : in out Project_Data);
286 -- Get the object directory, the exec directory and the source directories
290 (Project : Project_Id;
291 In_Tree : Project_Tree_Ref;
292 Data : in out Project_Data);
293 -- Get the mains of a project from attribute Main, if it exists, and put
294 -- them in the project data.
296 procedure Get_Sources_From_File
298 Location : Source_Ptr;
299 Project : Project_Id;
300 In_Tree : Project_Tree_Ref);
301 -- Get the list of sources from a text file and put them in hash table
305 (In_Tree : Project_Tree_Ref;
306 Canonical_File_Name : File_Name_Type;
307 Naming : Naming_Data;
308 Exception_Id : out Ada_Naming_Exception_Id;
309 Unit_Name : out Name_Id;
310 Unit_Kind : out Spec_Or_Body;
311 Needs_Pragma : out Boolean);
312 -- Find out, from a file name, the unit name, the unit kind and if a
313 -- specific SFN pragma is needed. If the file name corresponds to no
314 -- unit, then Unit_Name will be No_Name. If the file is a multi-unit source
315 -- or an exception to the naming scheme, then Exception_Id is set to
316 -- the unit or units that the source contains.
318 function Is_Illegal_Suffix
320 Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean;
321 -- Returns True if the string Suffix cannot be used as
322 -- a spec suffix, a body suffix or a separate suffix.
324 procedure Locate_Directory
325 (Project : Project_Id;
326 In_Tree : Project_Tree_Ref;
327 Name : File_Name_Type;
328 Parent : Path_Name_Type;
329 Dir : out Path_Name_Type;
330 Display : out Path_Name_Type;
331 Create : String := "";
332 Location : Source_Ptr := No_Location);
333 -- Locate a directory. Name is the directory name. Parent is the root
334 -- directory, if Name a relative path name. Dir is set to the canonical
335 -- case path name of the directory, and Display is the directory path name
336 -- for display purposes. If the directory does not exist and Project_Setup
337 -- is True and Create is a non null string, an attempt is made to create
338 -- the directory. If the directory does not exist and Project_Setup is
339 -- false, then Dir and Display are set to No_Name.
341 procedure Look_For_Sources
342 (Project : Project_Id;
343 In_Tree : Project_Tree_Ref;
344 Data : in out Project_Data;
345 Follow_Links : Boolean);
346 -- Find all the sources of project Project in project tree In_Tree and
347 -- update its Data accordingly. Resolve symbolic links in the path names
348 -- if Follow_Links is True.
350 function Path_Name_Of
351 (File_Name : File_Name_Type;
352 Directory : Path_Name_Type) return String;
353 -- Returns the path name of a (non project) file.
354 -- Returns an empty string if file cannot be found.
356 procedure Prepare_Ada_Naming_Exceptions
357 (List : Array_Element_Id;
358 In_Tree : Project_Tree_Ref;
359 Kind : Spec_Or_Body);
360 -- Prepare the internal hash tables used for checking naming exceptions
361 -- for Ada. Insert all elements of List in the tables.
363 function Project_Extends
364 (Extending : Project_Id;
365 Extended : Project_Id;
366 In_Tree : Project_Tree_Ref) return Boolean;
367 -- Returns True if Extending is extending Extended either directly or
370 procedure Record_Ada_Source
371 (File_Name : File_Name_Type;
372 Path_Name : Path_Name_Type;
373 Project : Project_Id;
374 In_Tree : Project_Tree_Ref;
375 Data : in out Project_Data;
376 Location : Source_Ptr;
377 Current_Source : in out String_List_Id;
378 Source_Recorded : in out Boolean;
379 Follow_Links : Boolean);
380 -- Put a unit in the list of units of a project, if the file name
381 -- corresponds to a valid unit name.
383 procedure Record_Other_Sources
384 (Project : Project_Id;
385 In_Tree : Project_Tree_Ref;
386 Data : in out Project_Data;
387 Language : Language_Index;
388 Naming_Exceptions : Boolean);
389 -- Record the sources of a language in a project.
390 -- When Naming_Exceptions is True, mark the found sources as such, to
391 -- later remove those that are not named in a list of sources.
393 procedure Remove_Source
395 Replaced_By : Source_Id;
396 Project : Project_Id;
397 Data : in out Project_Data;
398 In_Tree : Project_Tree_Ref);
400 procedure Report_No_Sources
401 (Project : Project_Id;
403 In_Tree : Project_Tree_Ref;
404 Location : Source_Ptr);
405 -- Report an error or a warning depending on the value of When_No_Sources
406 -- when there are no sources for language Lang_Name.
408 procedure Show_Source_Dirs
409 (Data : Project_Data; In_Tree : Project_Tree_Ref);
410 -- List all the source directories of a project
413 (Language : Language_Index;
414 Naming : Naming_Data;
415 In_Tree : Project_Tree_Ref) return File_Name_Type;
416 -- Get the suffix for the source of a language from a package naming.
417 -- If not specified, return the default for the language.
419 procedure Warn_If_Not_Sources
420 (Project : Project_Id;
421 In_Tree : Project_Tree_Ref;
422 Conventions : Array_Element_Id;
424 Extending : Boolean);
425 -- Check that individual naming conventions apply to immediate
426 -- sources of the project; if not, issue a warning.
434 Data : in out Project_Data;
435 In_Tree : Project_Tree_Ref)
437 Language : constant Language_Index :=
438 In_Tree.Sources.Table (Id).Language;
443 -- Add the source to the global list
445 In_Tree.Sources.Table (Id).Next_In_Sources := In_Tree.First_Source;
446 In_Tree.First_Source := Id;
448 -- Add the source to the project list
450 Source := Data.Last_Source;
452 if Source = No_Source then
453 Data.First_Source := Id;
455 In_Tree.Sources.Table (Source).Next_In_Project := Id;
458 Data.Last_Source := Id;
460 -- Add the source to the language list
462 In_Tree.Sources.Table (Id).Next_In_Lang :=
463 In_Tree.Languages_Data.Table (Language).First_Source;
464 In_Tree.Languages_Data.Table (Language).First_Source := Id;
471 function ALI_File_Name (Source : String) return String is
473 -- If the source name has an extension, then replace it with
476 for Index in reverse Source'First + 1 .. Source'Last loop
477 if Source (Index) = '.' then
478 return Source (Source'First .. Index - 1) & ALI_Suffix;
482 -- If there is no dot, or if it is the first character, just add the
485 return Source & ALI_Suffix;
493 (Project : Project_Id;
494 In_Tree : Project_Tree_Ref;
495 Report_Error : Put_Line_Access;
496 Follow_Links : Boolean;
497 When_No_Sources : Error_Warning)
499 Data : Project_Data := In_Tree.Projects.Table (Project);
500 Extending : Boolean := False;
502 Lang_Proc_Pkg : Package_Id;
503 Linker_Name : Variable_Value;
506 Nmsc.When_No_Sources := When_No_Sources;
507 Error_Report := Report_Error;
509 Recursive_Dirs.Reset;
511 Check_If_Externally_Built (Project, In_Tree, Data);
513 -- Object, exec and source directories
515 Get_Directories (Project, In_Tree, Data);
517 -- Get the programming languages
519 Check_Programming_Languages (In_Tree, Project, Data);
521 -- Check configuration in multi language mode
523 if Get_Mode = Multi_Language then
524 Check_Configuration (Project, In_Tree, Data);
527 -- Library attributes
529 Check_Library_Attributes (Project, In_Tree, Data);
531 if Current_Verbosity = High then
532 Show_Source_Dirs (Data, In_Tree);
535 Check_Package_Naming (Project, In_Tree, Data);
537 Extending := Data.Extends /= No_Project;
539 Check_Naming_Schemes (Data, Project, In_Tree);
541 if Get_Mode = Ada_Only then
542 Prepare_Ada_Naming_Exceptions
543 (Data.Naming.Bodies, In_Tree, Body_Part);
544 Prepare_Ada_Naming_Exceptions
545 (Data.Naming.Specs, In_Tree, Specification);
550 if Data.Source_Dirs /= Nil_String then
551 Look_For_Sources (Project, In_Tree, Data, Follow_Links);
553 if Get_Mode = Ada_Only then
555 -- Check that all individual naming conventions apply to sources
556 -- of this project file.
559 (Project, In_Tree, Data.Naming.Bodies,
561 Extending => Extending);
563 (Project, In_Tree, Data.Naming.Specs,
565 Extending => Extending);
567 elsif Get_Mode = Multi_Language and then
568 (not Data.Externally_Built) and then
572 Language : Language_Index;
574 Src_Data : Source_Data;
575 Alt_Lang : Alternate_Language_Id;
576 Alt_Lang_Data : Alternate_Language_Data;
579 Language := Data.First_Language_Processing;
580 while Language /= No_Language_Index loop
581 Source := Data.First_Source;
582 Source_Loop : while Source /= No_Source loop
583 Src_Data := In_Tree.Sources.Table (Source);
585 exit Source_Loop when Src_Data.Language = Language;
587 Alt_Lang := Src_Data.Alternate_Languages;
590 while Alt_Lang /= No_Alternate_Language loop
592 In_Tree.Alt_Langs.Table (Alt_Lang);
594 when Alt_Lang_Data.Language = Language;
595 Alt_Lang := Alt_Lang_Data.Next;
596 end loop Alternate_Loop;
598 Source := Src_Data.Next_In_Project;
599 end loop Source_Loop;
601 if Source = No_Source then
605 (In_Tree.Languages_Data.Table
606 (Language).Display_Name),
611 Language := In_Tree.Languages_Data.Table (Language).Next;
617 -- If it is a library project file, check if it is a standalone library
620 Check_Stand_Alone_Library (Project, In_Tree, Data, Extending);
623 -- Put the list of Mains, if any, in the project data
625 Get_Mains (Project, In_Tree, Data);
627 -- In multi-language mode, check if there is a linker specified
629 if Get_Mode = Multi_Language then
631 Value_Of (Name_Language_Processing, Data.Decl.Packages, In_Tree);
633 if Lang_Proc_Pkg /= No_Package then
636 (Variable_Name => Name_Linker,
638 In_Tree.Packages.Table (Lang_Proc_Pkg).Decl.Attributes,
641 if Linker_Name /= Nil_Variable_Value then
642 Get_Name_String (Linker_Name.Value);
645 -- A non empty linker name was specified
647 Data.Linker_Name := File_Name_Type (Linker_Name.Value);
654 -- Update the project data in the Projects table
656 In_Tree.Projects.Table (Project) := Data;
658 Free_Ada_Naming_Exceptions;
665 procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is
666 The_Name : String := Name;
668 Need_Letter : Boolean := True;
669 Last_Underscore : Boolean := False;
670 OK : Boolean := The_Name'Length > 0;
673 function Is_Reserved (S : String) return Boolean;
674 -- Check that the given name is not an Ada 95 reserved word. The
675 -- reason for the Ada 95 here is that we do not want to exclude the case
676 -- of an Ada 95 unit called Interface (for example). In Ada 2005, such
677 -- a unit name would be rejected anyway by the compiler, so there is no
678 -- requirement that the project file parser reject this.
684 function Is_Reserved (S : String) return Boolean is
689 Add_Str_To_Name_Buffer (S);
692 if Get_Name_Table_Byte (Name) /= 0
693 and then Name /= Name_Project
694 and then Name /= Name_Extends
695 and then Name /= Name_External
696 and then Name not in Ada_2005_Reserved_Words
700 if Current_Verbosity = High then
701 Write_Str (The_Name);
702 Write_Line (" is an Ada reserved word
.");
712 -- Start of processing for Check_Ada_Name
717 Name_Len := The_Name'Length;
718 Name_Buffer (1 .. Name_Len) := The_Name;
720 -- Special cases of children of packages A, G, I and S on VMS
723 and then Name_Len > 3
724 and then Name_Buffer (2 .. 3) = "__
"
726 ((Name_Buffer (1) = 'a') or else
727 (Name_Buffer (1) = 'g') or else
728 (Name_Buffer (1) = 'i') or else
729 (Name_Buffer (1) = 's'))
731 Name_Buffer (2) := '.';
732 Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
733 Name_Len := Name_Len - 1;
736 Real_Name := Name_Find;
738 if Is_Reserved (Name_Buffer (1 .. Name_Len)) then
742 First := The_Name'First;
744 for Index in The_Name'Range loop
747 -- We need a letter (at the beginning, and following a dot),
748 -- but we don't have one.
750 if Is_Letter (The_Name (Index)) then
751 Need_Letter := False;
756 if Current_Verbosity = High then
757 Write_Int (Types.Int (Index));
759 Write_Char (The_Name (Index));
760 Write_Line ("' is not a letter
.");
766 elsif Last_Underscore
767 and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
769 -- Two underscores are illegal, and a dot cannot follow
774 if Current_Verbosity = High then
775 Write_Int (Types.Int (Index));
777 Write_Char (The_Name (Index));
778 Write_Line ("' is illegal here
.");
783 elsif The_Name (Index) = '.' then
785 -- First, check if the name before the dot is not a reserved word
786 if Is_Reserved (The_Name (First .. Index - 1)) then
792 -- We need a letter after a dot
796 elsif The_Name (Index) = '_' then
797 Last_Underscore := True;
800 -- We need an letter or a digit
802 Last_Underscore := False;
804 if not Is_Alphanumeric (The_Name (Index)) then
807 if Current_Verbosity = High then
808 Write_Int (Types.Int (Index));
810 Write_Char (The_Name (Index));
811 Write_Line ("' is not alphanumeric
.");
819 -- Cannot end with an underscore or a dot
821 OK := OK and then not Need_Letter and then not Last_Underscore;
824 if First /= Name'First and then
825 Is_Reserved (The_Name (First .. The_Name'Last))
833 -- Signal a problem with No_Name
839 --------------------------------------
840 -- Check_Ada_Naming_Scheme_Validity --
841 --------------------------------------
843 procedure Check_Ada_Naming_Scheme_Validity
844 (Project : Project_Id;
845 In_Tree : Project_Tree_Ref;
846 Naming : Naming_Data)
849 -- Only check if we are not using the Default naming scheme
851 if Naming /= In_Tree.Private_Part.Default_Naming then
853 Dot_Replacement : constant String :=
855 (Naming.Dot_Replacement);
857 Spec_Suffix : constant String :=
858 Spec_Suffix_Of (In_Tree, "ada
", Naming);
860 Body_Suffix : constant String :=
861 Body_Suffix_Of (In_Tree, "ada
", Naming);
863 Separate_Suffix : constant String :=
865 (Naming.Separate_Suffix);
868 -- Dot_Replacement cannot
871 -- - start or end with an alphanumeric
873 -- - start with an '_' followed by an alphanumeric
874 -- - contain a '.' except if it is "."
876 if Dot_Replacement'Length = 0
877 or else Is_Alphanumeric
878 (Dot_Replacement (Dot_Replacement'First))
879 or else Is_Alphanumeric
880 (Dot_Replacement (Dot_Replacement'Last))
881 or else (Dot_Replacement (Dot_Replacement'First) = '_'
883 (Dot_Replacement'Length = 1
886 (Dot_Replacement (Dot_Replacement'First + 1))))
887 or else (Dot_Replacement'Length > 1
889 Index (Source => Dot_Replacement,
890 Pattern => ".") /= 0)
894 '"' & Dot_Replacement &
895 """ is illegal for Dot_Replacement.",
896 Naming.Dot_Repl_Loc);
903 (Spec_Suffix, Dot_Replacement = ".")
905 Err_Vars.Error_Msg_File_1 :=
906 Spec_Suffix_Id_Of (In_Tree, "ada", Naming);
909 "{ is illegal for Spec_Suffix",
910 Naming.Ada_Spec_Suffix_Loc);
914 (Body_Suffix, Dot_Replacement = ".")
916 Err_Vars.Error_Msg_File_1 :=
917 Body_Suffix_Id_Of (In_Tree, "ada", Naming);
920 "{ is illegal for Body_Suffix",
921 Naming.Ada_Body_Suffix_Loc);
924 if Body_Suffix /= Separate_Suffix then
926 (Separate_Suffix, Dot_Replacement = ".")
928 Err_Vars.Error_Msg_File_1 := Naming.Separate_Suffix;
931 "{ is illegal for Separate_Suffix",
932 Naming.Sep_Suffix_Loc);
936 -- Spec_Suffix cannot have the same termination as
937 -- Body_Suffix or Separate_Suffix
939 if Spec_Suffix'Length <= Body_Suffix'Length
941 Body_Suffix (Body_Suffix'Last -
942 Spec_Suffix'Length + 1 ..
943 Body_Suffix'Last) = Spec_Suffix
949 """) cannot end with" &
951 Spec_Suffix & """).",
952 Naming.Ada_Body_Suffix_Loc);
955 if Body_Suffix /= Separate_Suffix
956 and then Spec_Suffix'Length <= Separate_Suffix'Length
959 (Separate_Suffix'Last - Spec_Suffix'Length + 1
961 Separate_Suffix'Last) = Spec_Suffix
965 "Separate_Suffix (""" &
967 """) cannot end with" &
969 Spec_Suffix & """).",
970 Naming.Sep_Suffix_Loc);
974 end Check_Ada_Naming_Scheme_Validity;
976 -------------------------
977 -- Check_Configuration --
978 -------------------------
980 procedure Check_Configuration
981 (Project : Project_Id;
982 In_Tree : Project_Tree_Ref;
983 Data : in out Project_Data)
985 Dot_Replacement : File_Name_Type := No_File;
986 Casing : Casing_Type := All_Lower_Case;
987 Separate_Suffix : File_Name_Type := No_File;
989 Lang_Index : Language_Index := No_Language_Index;
990 -- The index of the language data being checked
992 Current_Language : Name_Id := No_Name;
993 -- The name of the language
995 Lang_Data : Language_Data;
996 -- The data of the language being checked
998 procedure Get_Language_Index_Of (Language : Name_Id);
999 -- Get the language index of Language, if Language is one of the
1000 -- languages of the project.
1002 procedure Process_Project_Level_Simple_Attributes;
1003 -- Process the simple attributes at the project level
1005 procedure Process_Project_Level_Array_Attributes;
1006 -- Process the associate array attributes at the project level
1008 procedure Process_Packages;
1009 -- Read the packages of the project
1011 ---------------------------
1012 -- Get_Language_Index_Of --
1013 ---------------------------
1015 procedure Get_Language_Index_Of (Language : Name_Id) is
1016 Real_Language : Name_Id;
1019 Get_Name_String (Language);
1020 To_Lower (Name_Buffer (1 .. Name_Len));
1021 Real_Language := Name_Find;
1023 -- Nothing to do if the language is the same as the current language
1025 if Current_Language /= Real_Language then
1026 Lang_Index := Data.First_Language_Processing;
1027 while Lang_Index /= No_Language_Index loop
1028 exit when In_Tree.Languages_Data.Table (Lang_Index).Name =
1031 In_Tree.Languages_Data.Table (Lang_Index).Next;
1034 if Lang_Index = No_Language_Index then
1035 Current_Language := No_Name;
1037 Current_Language := Real_Language;
1040 end Get_Language_Index_Of;
1042 ----------------------
1043 -- Process_Packages --
1044 ----------------------
1046 procedure Process_Packages is
1047 Packages : Package_Id;
1048 Element : Package_Element;
1050 procedure Process_Binder (Arrays : Array_Id);
1051 -- Process the associate array attributes of package Binder
1053 procedure Process_Builder (Attributes : Variable_Id);
1054 -- Process the simple attributes of package Builder
1056 procedure Process_Compiler (Arrays : Array_Id);
1057 -- Process the associate array attributes of package Compiler
1059 procedure Process_Naming (Attributes : Variable_Id);
1060 -- Process the simple attributes of package Naming
1062 procedure Process_Naming (Arrays : Array_Id);
1063 -- Process the associate array attributes of package Naming
1065 procedure Process_Linker (Attributes : Variable_Id);
1066 -- Process the simple attributes of package Linker of a
1067 -- configuration project.
1069 --------------------
1070 -- Process_Binder --
1071 --------------------
1073 procedure Process_Binder (Arrays : Array_Id) is
1074 Current_Array_Id : Array_Id;
1075 Current_Array : Array_Data;
1076 Element_Id : Array_Element_Id;
1077 Element : Array_Element;
1080 -- Process the associative array attribute of package Binder
1082 Current_Array_Id := Arrays;
1083 while Current_Array_Id /= No_Array loop
1084 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1086 Element_Id := Current_Array.Value;
1087 while Element_Id /= No_Array_Element loop
1088 Element := In_Tree.Array_Elements.Table (Element_Id);
1090 -- Get the name of the language
1092 Get_Language_Index_Of (Element.Index);
1094 if Lang_Index /= No_Language_Index then
1095 case Current_Array.Name is
1098 -- Attribute Driver (<language>)
1100 In_Tree.Languages_Data.Table
1101 (Lang_Index).Config.Binder_Driver :=
1102 File_Name_Type (Element.Value.Value);
1104 when Name_Required_Switches =>
1106 In_Tree.Languages_Data.Table
1107 (Lang_Index).Config.Binder_Required_Switches,
1108 From_List => Element.Value.Values,
1109 In_Tree => In_Tree);
1113 -- Attribute Prefix (<language>)
1115 In_Tree.Languages_Data.Table
1116 (Lang_Index).Config.Binder_Prefix :=
1117 Element.Value.Value;
1119 when Name_Objects_Path =>
1121 -- Attribute Objects_Path (<language>)
1123 In_Tree.Languages_Data.Table
1124 (Lang_Index).Config.Objects_Path :=
1125 Element.Value.Value;
1127 when Name_Objects_Path_File =>
1129 -- Attribute Objects_Path (<language>)
1131 In_Tree.Languages_Data.Table
1132 (Lang_Index).Config.Objects_Path_File :=
1133 Element.Value.Value;
1140 Element_Id := Element.Next;
1143 Current_Array_Id := Current_Array.Next;
1147 ---------------------
1148 -- Process_Builder --
1149 ---------------------
1151 procedure Process_Builder (Attributes : Variable_Id) is
1152 Attribute_Id : Variable_Id;
1153 Attribute : Variable;
1156 -- Process non associated array attribute from package Builder
1158 Attribute_Id := Attributes;
1159 while Attribute_Id /= No_Variable loop
1161 In_Tree.Variable_Elements.Table (Attribute_Id);
1163 if not Attribute.Value.Default then
1164 if Attribute.Name = Name_Executable_Suffix then
1166 -- Attribute Executable_Suffix: the suffix of the
1169 Data.Config.Executable_Suffix :=
1170 Attribute.Value.Value;
1174 Attribute_Id := Attribute.Next;
1176 end Process_Builder;
1178 ----------------------
1179 -- Process_Compiler --
1180 ----------------------
1182 procedure Process_Compiler (Arrays : Array_Id) is
1183 Current_Array_Id : Array_Id;
1184 Current_Array : Array_Data;
1185 Element_Id : Array_Element_Id;
1186 Element : Array_Element;
1187 List : String_List_Id;
1190 -- Process the associative array attribute of package Compiler
1192 Current_Array_Id := Arrays;
1193 while Current_Array_Id /= No_Array loop
1194 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1196 Element_Id := Current_Array.Value;
1197 while Element_Id /= No_Array_Element loop
1198 Element := In_Tree.Array_Elements.Table (Element_Id);
1200 -- Get the name of the language
1202 Get_Language_Index_Of (Element.Index);
1204 if Lang_Index /= No_Language_Index then
1205 case Current_Array.Name is
1206 when Name_Dependency_Switches =>
1208 -- Attribute Dependency_Switches (<language>)
1210 List := Element.Value.Values;
1212 if List = Nil_String then
1216 "dependency option cannot be null",
1217 Element.Value.Location);
1221 In_Tree.Languages_Data.Table
1222 (Lang_Index).Config.Dependency_Option,
1224 In_Tree => In_Tree);
1226 when Name_Dependency_Driver =>
1228 -- Attribute Dependency_Driver (<language>)
1230 List := Element.Value.Values;
1232 if List = Nil_String then
1236 "compute dependency cannot be null",
1237 Element.Value.Location);
1241 In_Tree.Languages_Data.Table
1242 (Lang_Index).Config.Compute_Dependency,
1244 In_Tree => In_Tree);
1246 when Name_Include_Switches =>
1248 -- Attribute Include_Switches (<language>)
1250 List := Element.Value.Values;
1252 if List = Nil_String then
1256 "include option cannot be null",
1257 Element.Value.Location);
1261 In_Tree.Languages_Data.Table
1262 (Lang_Index).Config.Include_Option,
1264 In_Tree => In_Tree);
1266 when Name_Include_Path =>
1268 -- Attribute Include_Path (<language>)
1270 In_Tree.Languages_Data.Table
1271 (Lang_Index).Config.Include_Path :=
1272 Element.Value.Value;
1274 when Name_Include_Path_File =>
1276 -- Attribute Include_Path_File (<language>)
1278 In_Tree.Languages_Data.Table
1279 (Lang_Index).Config.Include_Path_File :=
1280 Element.Value.Value;
1284 -- Attribute Driver (<language>)
1286 Get_Name_String (Element.Value.Value);
1288 if Name_Len = 0 then
1292 "compiler driver name cannot be empty",
1293 Element.Value.Location);
1296 In_Tree.Languages_Data.Table
1297 (Lang_Index).Config.Compiler_Driver :=
1298 File_Name_Type (Element.Value.Value);
1300 when Name_Required_Switches =>
1302 In_Tree.Languages_Data.Table
1303 (Lang_Index).Config.
1304 Compiler_Required_Switches,
1305 From_List => Element.Value.Values,
1306 In_Tree => In_Tree);
1308 when Name_Pic_Option =>
1310 -- Attribute Compiler_Pic_Option (<language>)
1312 List := Element.Value.Values;
1314 if List = Nil_String then
1318 "compiler PIC option cannot be null",
1319 Element.Value.Location);
1323 In_Tree.Languages_Data.Table
1324 (Lang_Index).Config.Compilation_PIC_Option,
1326 In_Tree => In_Tree);
1328 when Name_Mapping_File_Switches =>
1330 -- Attribute Mapping_File_Switches (<language>)
1332 List := Element.Value.Values;
1334 if List = Nil_String then
1338 "mapping file switches cannot be null",
1339 Element.Value.Location);
1343 In_Tree.Languages_Data.Table
1344 (Lang_Index).Config.Mapping_File_Switches,
1346 In_Tree => In_Tree);
1348 when Name_Mapping_Spec_Suffix =>
1350 -- Attribute Mapping_Spec_Suffix (<language>)
1352 In_Tree.Languages_Data.Table
1353 (Lang_Index).Config.Mapping_Spec_Suffix :=
1354 File_Name_Type (Element.Value.Value);
1356 when Name_Mapping_Body_Suffix =>
1358 -- Attribute Mapping_Body_Suffix (<language>)
1360 In_Tree.Languages_Data.Table
1361 (Lang_Index).Config.Mapping_Body_Suffix :=
1362 File_Name_Type (Element.Value.Value);
1364 when Name_Config_File_Switches =>
1366 -- Attribute Config_File_Switches (<language>)
1368 List := Element.Value.Values;
1370 if List = Nil_String then
1374 "config file switches cannot be null",
1375 Element.Value.Location);
1379 In_Tree.Languages_Data.Table
1380 (Lang_Index).Config.Config_File_Switches,
1382 In_Tree => In_Tree);
1384 when Name_Objects_Path =>
1386 -- Attribute Objects_Path (<language>)
1388 In_Tree.Languages_Data.Table
1389 (Lang_Index).Config.Objects_Path :=
1390 Element.Value.Value;
1392 when Name_Objects_Path_File =>
1394 -- Attribute Objects_Path_File (<language>)
1396 In_Tree.Languages_Data.Table
1397 (Lang_Index).Config.Objects_Path_File :=
1398 Element.Value.Value;
1400 when Name_Config_Body_File_Name =>
1402 -- Attribute Config_Body_File_Name (<language>)
1404 In_Tree.Languages_Data.Table
1405 (Lang_Index).Config.Config_Body :=
1406 Element.Value.Value;
1408 when Name_Config_Body_File_Name_Pattern =>
1410 -- Attribute Config_Body_File_Name_Pattern
1413 In_Tree.Languages_Data.Table
1414 (Lang_Index).Config.Config_Body_Pattern :=
1415 Element.Value.Value;
1417 when Name_Config_Spec_File_Name =>
1419 -- Attribute Config_Spec_File_Name (<language>)
1421 In_Tree.Languages_Data.Table
1422 (Lang_Index).Config.Config_Spec :=
1423 Element.Value.Value;
1425 when Name_Config_Spec_File_Name_Pattern =>
1427 -- Attribute Config_Spec_File_Name_Pattern
1430 In_Tree.Languages_Data.Table
1431 (Lang_Index).Config.Config_Spec_Pattern :=
1432 Element.Value.Value;
1434 when Name_Config_File_Unique =>
1436 -- Attribute Config_File_Unique (<language>)
1439 In_Tree.Languages_Data.Table
1440 (Lang_Index).Config.Config_File_Unique :=
1442 (Get_Name_String (Element.Value.Value));
1444 when Constraint_Error =>
1448 "illegal value for Config_File_Unique",
1449 Element.Value.Location);
1457 Element_Id := Element.Next;
1460 Current_Array_Id := Current_Array.Next;
1462 end Process_Compiler;
1464 --------------------
1465 -- Process_Naming --
1466 --------------------
1468 procedure Process_Naming (Attributes : Variable_Id) is
1469 Attribute_Id : Variable_Id;
1470 Attribute : Variable;
1473 -- Process non associated array attribute from package Naming
1475 Attribute_Id := Attributes;
1476 while Attribute_Id /= No_Variable loop
1478 In_Tree.Variable_Elements.Table (Attribute_Id);
1480 if not Attribute.Value.Default then
1481 if Attribute.Name = Name_Separate_Suffix then
1483 -- Attribute Separate_Suffix
1485 Separate_Suffix := File_Name_Type (Attribute.Value.Value);
1487 elsif Attribute.Name = Name_Casing then
1493 Value (Get_Name_String (Attribute.Value.Value));
1496 when Constraint_Error =>
1500 "invalid value for Casing",
1501 Attribute.Value.Location);
1504 elsif Attribute.Name = Name_Dot_Replacement then
1506 -- Attribute Dot_Replacement
1508 Dot_Replacement := File_Name_Type (Attribute.Value.Value);
1513 Attribute_Id := Attribute.Next;
1517 procedure Process_Naming (Arrays : Array_Id) is
1518 Current_Array_Id : Array_Id;
1519 Current_Array : Array_Data;
1520 Element_Id : Array_Element_Id;
1521 Element : Array_Element;
1523 -- Process the associative array attribute of package Naming
1525 Current_Array_Id := Arrays;
1526 while Current_Array_Id /= No_Array loop
1527 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1529 Element_Id := Current_Array.Value;
1530 while Element_Id /= No_Array_Element loop
1531 Element := In_Tree.Array_Elements.Table (Element_Id);
1533 -- Get the name of the language
1535 Get_Language_Index_Of (Element.Index);
1537 if Lang_Index /= No_Language_Index then
1538 case Current_Array.Name is
1539 when Name_Specification_Suffix | Name_Spec_Suffix =>
1541 -- Attribute Spec_Suffix (<language>)
1543 In_Tree.Languages_Data.Table
1544 (Lang_Index).Config.Naming_Data.Spec_Suffix :=
1545 File_Name_Type (Element.Value.Value);
1547 when Name_Implementation_Suffix | Name_Body_Suffix =>
1549 -- Attribute Body_Suffix (<language>)
1551 In_Tree.Languages_Data.Table
1552 (Lang_Index).Config.Naming_Data.Body_Suffix :=
1553 File_Name_Type (Element.Value.Value);
1555 In_Tree.Languages_Data.Table
1556 (Lang_Index).Config.Naming_Data.Separate_Suffix :=
1557 File_Name_Type (Element.Value.Value);
1564 Element_Id := Element.Next;
1567 Current_Array_Id := Current_Array.Next;
1571 --------------------
1572 -- Process_Linker --
1573 --------------------
1575 procedure Process_Linker (Attributes : Variable_Id) is
1576 Attribute_Id : Variable_Id;
1577 Attribute : Variable;
1580 -- Process non associated array attribute from package Linker
1582 Attribute_Id := Attributes;
1583 while Attribute_Id /= No_Variable loop
1585 In_Tree.Variable_Elements.Table (Attribute_Id);
1587 if not Attribute.Value.Default then
1588 if Attribute.Name = Name_Driver then
1590 -- Attribute Linker'Driver: the default linker to use
1592 Data.Config.Linker :=
1593 Path_Name_Type (Attribute.Value.Value);
1596 Attribute.Name = Name_Required_Switches
1599 -- Attribute Required_Switches: the minimum
1600 -- options to use when invoking the linker
1603 Data.Config.Minimum_Linker_Options,
1604 From_List => Attribute.Value.Values,
1605 In_Tree => In_Tree);
1610 Attribute_Id := Attribute.Next;
1614 -- Start of processing for Process_Packages
1617 Packages := Data.Decl.Packages;
1618 while Packages /= No_Package loop
1619 Element := In_Tree.Packages.Table (Packages);
1621 case Element.Name is
1624 -- Process attributes of package Binder
1626 Process_Binder (Element.Decl.Arrays);
1628 when Name_Builder =>
1630 -- Process attributes of package Builder
1632 Process_Builder (Element.Decl.Attributes);
1634 when Name_Compiler =>
1636 -- Process attributes of package Compiler
1638 Process_Compiler (Element.Decl.Arrays);
1642 -- Process attributes of package Linker
1644 Process_Linker (Element.Decl.Attributes);
1648 -- Process attributes of package Naming
1650 Process_Naming (Element.Decl.Attributes);
1651 Process_Naming (Element.Decl.Arrays);
1657 Packages := Element.Next;
1659 end Process_Packages;
1661 ---------------------------------------------
1662 -- Process_Project_Level_Simple_Attributes --
1663 ---------------------------------------------
1665 procedure Process_Project_Level_Simple_Attributes is
1666 Attribute_Id : Variable_Id;
1667 Attribute : Variable;
1668 List : String_List_Id;
1671 -- Process non associated array attribute at project level
1673 Attribute_Id := Data.Decl.Attributes;
1674 while Attribute_Id /= No_Variable loop
1676 In_Tree.Variable_Elements.Table (Attribute_Id);
1678 if not Attribute.Value.Default then
1679 if Attribute.Name = Name_Library_Builder then
1681 -- Attribute Library_Builder: the application to invoke
1682 -- to build libraries.
1684 Data.Config.Library_Builder :=
1685 Path_Name_Type (Attribute.Value.Value);
1687 elsif Attribute.Name = Name_Archive_Builder then
1689 -- Attribute Archive_Builder: the archive builder
1690 -- (usually "ar") and its minimum options (usually "cr").
1692 List := Attribute.Value.Values;
1694 if List = Nil_String then
1698 "archive builder cannot be null",
1699 Attribute.Value.Location);
1702 Put (Into_List => Data.Config.Archive_Builder,
1704 In_Tree => In_Tree);
1706 elsif Attribute.Name = Name_Archive_Indexer then
1708 -- Attribute Archive_Indexer: the optional archive
1709 -- indexer (usually "ranlib") with its minimum options
1712 List := Attribute.Value.Values;
1714 if List = Nil_String then
1718 "archive indexer cannot be null",
1719 Attribute.Value.Location);
1722 Put (Into_List => Data.Config.Archive_Indexer,
1724 In_Tree => In_Tree);
1726 elsif Attribute.Name = Name_Library_Partial_Linker then
1728 -- Attribute Library_Partial_Linker: the optional linker
1729 -- driver with its minimum options, to partially link
1732 List := Attribute.Value.Values;
1734 if List = Nil_String then
1738 "partial linker cannot be null",
1739 Attribute.Value.Location);
1742 Put (Into_List => Data.Config.Lib_Partial_Linker,
1744 In_Tree => In_Tree);
1746 elsif Attribute.Name = Name_Archive_Suffix then
1747 Data.Config.Archive_Suffix :=
1748 File_Name_Type (Attribute.Value.Value);
1750 elsif Attribute.Name = Name_Linker_Executable_Option then
1752 -- Attribute Linker_Executable_Option: optional options
1753 -- to specify an executable name. Defaults to "-o".
1755 List := Attribute.Value.Values;
1757 if List = Nil_String then
1761 "linker executable option cannot be null",
1762 Attribute.Value.Location);
1765 Put (Into_List => Data.Config.Linker_Executable_Option,
1767 In_Tree => In_Tree);
1769 elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
1771 -- Attribute Linker_Lib_Dir_Option: optional options
1772 -- to specify a library search directory. Defaults to
1775 Get_Name_String (Attribute.Value.Value);
1777 if Name_Len = 0 then
1781 "linker library directory option cannot be empty",
1782 Attribute.Value.Location);
1785 Data.Config.Linker_Lib_Dir_Option := Attribute.Value.Value;
1787 elsif Attribute.Name = Name_Linker_Lib_Name_Option then
1789 -- Attribute Linker_Lib_Name_Option: optional options
1790 -- to specify the name of a library to be linked in.
1791 -- Defaults to "-l".
1793 Get_Name_String (Attribute.Value.Value);
1795 if Name_Len = 0 then
1799 "linker library name option cannot be empty",
1800 Attribute.Value.Location);
1803 Data.Config.Linker_Lib_Name_Option := Attribute.Value.Value;
1805 elsif Attribute.Name = Name_Run_Path_Option then
1807 -- Attribute Run_Path_Option: optional options to
1808 -- specify a path for libraries.
1810 List := Attribute.Value.Values;
1812 if List /= Nil_String then
1813 Put (Into_List => Data.Config.Run_Path_Option,
1815 In_Tree => In_Tree);
1818 elsif Attribute.Name = Name_Library_Support then
1820 pragma Unsuppress (All_Checks);
1822 Data.Config.Lib_Support :=
1823 Library_Support'Value (Get_Name_String
1824 (Attribute.Value.Value));
1826 when Constraint_Error =>
1830 "invalid value """ &
1831 Get_Name_String (Attribute.Value.Value) &
1832 """ for Library_Support",
1833 Attribute.Value.Location);
1836 elsif Attribute.Name = Name_Shared_Library_Prefix then
1837 Data.Config.Shared_Lib_Prefix :=
1838 File_Name_Type (Attribute.Value.Value);
1840 elsif Attribute.Name = Name_Shared_Library_Suffix then
1841 Data.Config.Shared_Lib_Suffix :=
1842 File_Name_Type (Attribute.Value.Value);
1844 elsif Attribute.Name = Name_Symbolic_Link_Supported then
1846 pragma Unsuppress (All_Checks);
1848 Data.Config.Symbolic_Link_Supported :=
1849 Boolean'Value (Get_Name_String
1850 (Attribute.Value.Value));
1852 when Constraint_Error =>
1856 "invalid value """ &
1857 Get_Name_String (Attribute.Value.Value) &
1858 """ for Symbolic_Link_Supported",
1859 Attribute.Value.Location);
1863 Attribute.Name = Name_Library_Major_Minor_Id_Supported
1866 pragma Unsuppress (All_Checks);
1868 Data.Config.Lib_Maj_Min_Id_Supported :=
1869 Boolean'Value (Get_Name_String
1870 (Attribute.Value.Value));
1872 when Constraint_Error =>
1876 "invalid value """ &
1877 Get_Name_String (Attribute.Value.Value) &
1878 """ for Library_Major_Minor_Id_Supported",
1879 Attribute.Value.Location);
1883 Attribute.Name = Name_Library_Auto_Init_Supported
1886 pragma Unsuppress (All_Checks);
1888 Data.Config.Auto_Init_Supported :=
1889 Boolean'Value (Get_Name_String
1890 (Attribute.Value.Value));
1892 when Constraint_Error =>
1896 "invalid value """ &
1897 Get_Name_String (Attribute.Value.Value) &
1898 """ for Library_Auto_Init_Supported",
1899 Attribute.Value.Location);
1903 Attribute.Name = Name_Shared_Library_Minimum_Switches
1905 List := Attribute.Value.Values;
1907 if List /= Nil_String then
1908 Put (Into_List => Data.Config.Shared_Lib_Min_Options,
1910 In_Tree => In_Tree);
1914 Attribute.Name = Name_Library_Version_Switches
1916 List := Attribute.Value.Values;
1918 if List /= Nil_String then
1919 Put (Into_List => Data.Config.Lib_Version_Options,
1921 In_Tree => In_Tree);
1926 Attribute_Id := Attribute.Next;
1928 end Process_Project_Level_Simple_Attributes;
1930 --------------------------------------------
1931 -- Process_Project_Level_Array_Attributes --
1932 --------------------------------------------
1934 procedure Process_Project_Level_Array_Attributes is
1935 Current_Array_Id : Array_Id;
1936 Current_Array : Array_Data;
1937 Element_Id : Array_Element_Id;
1938 Element : Array_Element;
1941 -- Process the associative array attributes at project level
1943 Current_Array_Id := Data.Decl.Arrays;
1944 while Current_Array_Id /= No_Array loop
1945 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1947 Element_Id := Current_Array.Value;
1948 while Element_Id /= No_Array_Element loop
1949 Element := In_Tree.Array_Elements.Table (Element_Id);
1951 -- Get the name of the language
1953 Get_Language_Index_Of (Element.Index);
1955 if Lang_Index /= No_Language_Index then
1956 case Current_Array.Name is
1957 when Name_Toolchain_Description =>
1959 -- Attribute Toolchain_Description (<language>)
1961 In_Tree.Languages_Data.Table
1962 (Lang_Index).Config.Toolchain_Description :=
1963 Element.Value.Value;
1965 when Name_Toolchain_Version =>
1967 -- Attribute Toolchain_Version (<language>)
1969 In_Tree.Languages_Data.Table
1970 (Lang_Index).Config.Toolchain_Version :=
1971 Element.Value.Value;
1973 when Name_Runtime_Library_Dir =>
1975 -- Attribute Runtime_Library_Dir (<language>)
1977 In_Tree.Languages_Data.Table
1978 (Lang_Index).Config.Runtime_Library_Dir :=
1979 Element.Value.Value;
1986 Element_Id := Element.Next;
1989 Current_Array_Id := Current_Array.Next;
1991 end Process_Project_Level_Array_Attributes;
1994 Process_Project_Level_Simple_Attributes;
1995 Process_Project_Level_Array_Attributes;
1998 -- For unit based languages, set Casing, Dot_Replacement and
1999 -- Separate_Suffix in Naming_Data.
2001 Lang_Index := Data.First_Language_Processing;
2002 while Lang_Index /= No_Language_Index loop
2003 if In_Tree.Languages_Data.Table
2004 (Lang_Index).Name = Name_Ada
2006 In_Tree.Languages_Data.Table
2007 (Lang_Index).Config.Naming_Data.Casing := Casing;
2008 In_Tree.Languages_Data.Table
2009 (Lang_Index).Config.Naming_Data.Dot_Replacement :=
2012 if Separate_Suffix /= No_File then
2013 In_Tree.Languages_Data.Table
2014 (Lang_Index).Config.Naming_Data.Separate_Suffix :=
2021 Lang_Index := In_Tree.Languages_Data.Table (Lang_Index).Next;
2024 -- Give empty names to various prefixes/suffixes, if they have not
2025 -- been specified in the configuration.
2027 if Data.Config.Archive_Suffix = No_File then
2028 Data.Config.Archive_Suffix := Empty_File;
2031 if Data.Config.Shared_Lib_Prefix = No_File then
2032 Data.Config.Shared_Lib_Prefix := Empty_File;
2035 if Data.Config.Shared_Lib_Suffix = No_File then
2036 Data.Config.Shared_Lib_Suffix := Empty_File;
2039 Lang_Index := Data.First_Language_Processing;
2040 while Lang_Index /= No_Language_Index loop
2041 Lang_Data := In_Tree.Languages_Data.Table (Lang_Index);
2043 Current_Language := Lang_Data.Display_Name;
2045 if Lang_Data.Name = Name_Ada then
2047 -- For unit based languages, Dot_Replacement, Spec_Suffix and
2048 -- Body_Suffix need to be specified.
2050 if Lang_Data.Config.Naming_Data.Dot_Replacement = No_File then
2054 "Dot_Replacement not specified for Ada",
2058 if Lang_Data.Config.Naming_Data.Spec_Suffix = No_File then
2062 "Spec_Suffix not specified for Ada",
2066 if Lang_Data.Config.Naming_Data.Body_Suffix = No_File then
2070 "Body_Suffix not specified for Ada",
2075 -- For file based languages, either Spec_Suffix or Body_Suffix
2076 -- need to be specified.
2078 if Lang_Data.Config.Naming_Data.Spec_Suffix = No_File and then
2079 Lang_Data.Config.Naming_Data.Body_Suffix = No_File
2084 "no suffixes specified for " &
2085 Get_Name_String (Current_Language),
2090 -- For all languages, Compiler_Driver needs to be specified
2092 if Lang_Data.Config.Compiler_Driver = No_File then
2096 "no compiler specified for " &
2097 Get_Name_String (Current_Language),
2101 Lang_Index := Lang_Data.Next;
2103 end Check_Configuration;
2105 ----------------------
2106 -- Check_For_Source --
2107 ----------------------
2109 procedure Check_For_Source
2110 (File_Name : File_Name_Type;
2111 Path_Name : Path_Name_Type;
2112 Project : Project_Id;
2113 In_Tree : Project_Tree_Ref;
2114 Data : in out Project_Data;
2115 Location : Source_Ptr;
2116 Language : Language_Index;
2118 Naming_Exception : Boolean)
2120 Name : String := Get_Name_String (File_Name);
2121 Real_Location : Source_Ptr := Location;
2124 Canonical_Case_File_Name (Name);
2126 -- A file is a source of a language if Naming_Exception is True (case
2127 -- of naming exceptions) or if its file name ends with the suffix.
2131 (Name'Length > Suffix'Length
2133 Name (Name'Last - Suffix'Length + 1 .. Name'Last) = Suffix)
2135 if Real_Location = No_Location then
2136 Real_Location := Data.Location;
2140 Path : constant String := Get_Name_String (Path_Name);
2141 C_Path : String := Path;
2143 Path_Id : Path_Name_Type;
2144 C_Path_Id : Path_Name_Type;
2145 -- The path name id (in canonical case)
2147 File_Id : File_Name_Type;
2148 -- The file name id (in canonical case)
2150 Obj_Id : File_Name_Type;
2151 -- The object file name
2153 Obj_Path_Id : Path_Name_Type;
2154 -- The object path name
2156 Dep_Id : File_Name_Type;
2157 -- The dependency file name
2159 Dep_Path_Id : Path_Name_Type;
2160 -- The dependency path name
2162 Dot_Pos : Natural := 0;
2163 -- Position of the last dot in Name
2165 Source : Other_Source;
2166 Source_Id : Other_Source_Id := Data.First_Other_Source;
2169 Canonical_Case_File_Name (C_Path);
2171 -- Get the file name id
2173 Name_Len := Name'Length;
2174 Name_Buffer (1 .. Name_Len) := Name;
2175 File_Id := Name_Find;
2177 -- Get the path name id
2179 Name_Len := Path'Length;
2180 Name_Buffer (1 .. Name_Len) := Path;
2181 Path_Id := Name_Find;
2183 Name_Len := C_Path'Length;
2184 Name_Buffer (1 .. Name_Len) := C_Path;
2185 C_Path_Id := Name_Find;
2187 -- Find the position of the last dot
2189 for J in reverse Name'Range loop
2190 if Name (J) = '.' then
2196 if Dot_Pos <= Name'First then
2197 Dot_Pos := Name'Last + 1;
2200 -- Compute the object file name
2202 Get_Name_String (File_Id);
2203 Name_Len := Dot_Pos - Name'First;
2205 for J in Object_Suffix'Range loop
2206 Name_Len := Name_Len + 1;
2207 Name_Buffer (Name_Len) := Object_Suffix (J);
2210 Obj_Id := Name_Find;
2212 -- Compute the object path name
2214 Get_Name_String (Data.Display_Object_Dir);
2216 if Name_Buffer (Name_Len) /= Directory_Separator
2217 and then Name_Buffer (Name_Len) /= '/'
2219 Name_Len := Name_Len + 1;
2220 Name_Buffer (Name_Len) := Directory_Separator;
2223 Add_Str_To_Name_Buffer (Get_Name_String (Obj_Id));
2224 Obj_Path_Id := Name_Find;
2226 -- Compute the dependency file name
2228 Get_Name_String (File_Id);
2229 Name_Len := Dot_Pos - Name'First + 1;
2230 Name_Buffer (Name_Len) := '.';
2231 Name_Len := Name_Len + 1;
2232 Name_Buffer (Name_Len) := 'd
';
2233 Dep_Id := Name_Find;
2235 -- Compute the dependency path name
2237 Get_Name_String (Data.Display_Object_Dir);
2239 if Name_Buffer (Name_Len) /= Directory_Separator
2240 and then Name_Buffer (Name_Len) /= '/'
2242 Name_Len := Name_Len + 1;
2243 Name_Buffer (Name_Len) := Directory_Separator;
2246 Add_Str_To_Name_Buffer (Get_Name_String (Dep_Id));
2247 Dep_Path_Id := Name_Find;
2249 -- Check if source is already in the list of source for this
2250 -- project: it may have already been specified as a naming
2251 -- exception for the same language or an other language, or
2252 -- they may be two identical file names in different source
2255 while Source_Id /= No_Other_Source loop
2256 Source := In_Tree.Other_Sources.Table (Source_Id);
2258 if Source.File_Name = File_Id then
2260 -- Two sources of different languages cannot have the same
2263 if Source.Language /= Language then
2264 Error_Msg_File_1 := File_Name;
2267 "{ cannot be a source of several languages",
2271 -- No problem if a file has already been specified as
2272 -- a naming exception of this language.
2274 elsif Source.Path_Name = C_Path_Id then
2276 -- Reset the naming exception flag, if this is not a
2277 -- naming exception.
2279 if not Naming_Exception then
2280 In_Tree.Other_Sources.Table
2281 (Source_Id).Naming_Exception := False;
2286 -- There are several files with the same names, but the
2287 -- order of the source directories is known (no /**):
2288 -- only the first one encountered is kept, the other ones
2291 elsif Data.Known_Order_Of_Source_Dirs then
2294 -- But it is an error if the order of the source directories
2298 Error_Msg_File_1 := File_Name;
2301 "{ is found in several source directories",
2306 -- Two sources with different file names cannot have the same
2307 -- object file name.
2309 elsif Source.Object_Name = Obj_Id then
2310 Error_Msg_File_1 := File_Id;
2311 Error_Msg_File_2 := Source.File_Name;
2312 Error_Msg_File_3 := Obj_Id;
2315 "{ and { have the same object file {",
2320 Source_Id := Source.Next;
2323 if Current_Verbosity = High then
2324 Write_Str (" found ");
2325 Display_Language_Name (Language);
2326 Write_Str (" source """);
2327 Write_Str (Get_Name_String (File_Name));
2329 Write_Str (" object path = ");
2330 Write_Line (Get_Name_String (Obj_Path_Id));
2333 -- Create the Other_Source record
2336 (Language => Language,
2337 File_Name => File_Id,
2338 Path_Name => Path_Id,
2339 Source_TS => File_Stamp (Path_Id),
2340 Object_Name => Obj_Id,
2341 Object_Path => Obj_Path_Id,
2342 Object_TS => File_Stamp (Obj_Path_Id),
2344 Dep_Path => Dep_Path_Id,
2345 Dep_TS => File_Stamp (Dep_Path_Id),
2346 Naming_Exception => Naming_Exception,
2347 Next => No_Other_Source);
2349 -- And add it to the Other_Sources table
2351 Other_Source_Table.Increment_Last (In_Tree.Other_Sources);
2352 In_Tree.Other_Sources.Table
2353 (Other_Source_Table.Last (In_Tree.Other_Sources)) := Source;
2355 -- There are sources of languages other than Ada in this project
2357 Data.Other_Sources_Present := True;
2359 -- And there are sources of this language in this project
2361 Set (Language, True, Data, In_Tree);
2363 -- Add this source to the list of sources of languages other than
2364 -- Ada of the project.
2366 if Data.First_Other_Source = No_Other_Source then
2367 Data.First_Other_Source :=
2368 Other_Source_Table.Last (In_Tree.Other_Sources);
2371 In_Tree.Other_Sources.Table (Data.Last_Other_Source).Next :=
2372 Other_Source_Table.Last (In_Tree.Other_Sources);
2375 Data.Last_Other_Source :=
2376 Other_Source_Table.Last (In_Tree.Other_Sources);
2379 end Check_For_Source;
2381 -------------------------------
2382 -- Check_If_Externally_Built --
2383 -------------------------------
2385 procedure Check_If_Externally_Built
2386 (Project : Project_Id;
2387 In_Tree : Project_Tree_Ref;
2388 Data : in out Project_Data)
2390 Externally_Built : constant Variable_Value :=
2392 (Name_Externally_Built,
2393 Data.Decl.Attributes, In_Tree);
2396 if not Externally_Built.Default then
2397 Get_Name_String (Externally_Built.Value);
2398 To_Lower (Name_Buffer (1 .. Name_Len));
2400 if Name_Buffer (1 .. Name_Len) = "true" then
2401 Data.Externally_Built := True;
2403 elsif Name_Buffer (1 .. Name_Len) /= "false" then
2404 Error_Msg (Project, In_Tree,
2405 "Externally_Built may only be true or false",
2406 Externally_Built.Location);
2410 if Current_Verbosity = High then
2411 Write_Str ("Project is ");
2413 if not Data.Externally_Built then
2417 Write_Line ("externally built.");
2419 end Check_If_Externally_Built;
2421 -----------------------------
2422 -- Check_Naming_Schemes --
2423 -----------------------------
2425 procedure Check_Naming_Schemes
2426 (Data : in out Project_Data;
2427 Project : Project_Id;
2428 In_Tree : Project_Tree_Ref)
2430 Naming_Id : constant Package_Id :=
2431 Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
2432 Naming : Package_Element;
2434 procedure Check_Unit_Names (List : Array_Element_Id);
2435 -- Check that a list of unit names contains only valid names
2437 procedure Get_Exceptions (Kind : Source_Kind);
2439 procedure Get_Unit_Exceptions (Kind : Source_Kind);
2441 ----------------------
2442 -- Check_Unit_Names --
2443 ----------------------
2445 procedure Check_Unit_Names (List : Array_Element_Id) is
2446 Current : Array_Element_Id;
2447 Element : Array_Element;
2448 Unit_Name : Name_Id;
2451 -- Loop through elements of the string list
2454 while Current /= No_Array_Element loop
2455 Element := In_Tree.Array_Elements.Table (Current);
2457 -- Put file name in canonical case
2459 Get_Name_String (Element.Value.Value);
2460 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2461 Element.Value.Value := Name_Find;
2463 -- Check that it contains a valid unit name
2465 Get_Name_String (Element.Index);
2466 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name);
2468 if Unit_Name = No_Name then
2469 Err_Vars.Error_Msg_Name_1 := Element.Index;
2472 "%% is not a valid unit name.",
2473 Element.Value.Location);
2476 if Current_Verbosity = High then
2477 Write_Str (" Unit (""");
2478 Write_Str (Get_Name_String (Unit_Name));
2482 Element.Index := Unit_Name;
2483 In_Tree.Array_Elements.Table (Current) := Element;
2486 Current := Element.Next;
2488 end Check_Unit_Names;
2490 --------------------
2491 -- Get_Exceptions --
2492 --------------------
2494 procedure Get_Exceptions (Kind : Source_Kind) is
2495 Exceptions : Array_Element_Id;
2496 Exception_List : Variable_Value;
2497 Element_Id : String_List_Id;
2498 Element : String_Element;
2499 File_Name : File_Name_Type;
2500 Lang_Id : Language_Index;
2508 (Name_Implementation_Exceptions,
2509 In_Arrays => Naming.Decl.Arrays,
2510 In_Tree => In_Tree);
2515 (Name_Specification_Exceptions,
2516 In_Arrays => Naming.Decl.Arrays,
2517 In_Tree => In_Tree);
2520 Lang_Id := Data.First_Language_Processing;
2521 while Lang_Id /= No_Language_Index loop
2522 if In_Tree.Languages_Data.Table (Lang_Id).Config.Kind =
2525 Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
2527 Exception_List := Value_Of
2529 In_Array => Exceptions,
2530 In_Tree => In_Tree);
2532 if Exception_List /= Nil_Variable_Value then
2533 Element_Id := Exception_List.Values;
2535 while Element_Id /= Nil_String loop
2537 In_Tree.String_Elements.Table (Element_Id);
2538 Get_Name_String (Element.Value);
2539 Canonical_Case_File_Name
2540 (Name_Buffer (1 .. Name_Len));
2541 File_Name := Name_Find;
2543 Source := Data.First_Source;
2544 while Source /= No_Source
2546 In_Tree.Sources.Table (Source).File /= File_Name
2549 In_Tree.Sources.Table (Source).Next_In_Project;
2552 if Source = No_Source then
2554 -- This is a new source. Create an entry for it
2555 -- in the Sources table.
2557 Source_Data_Table.Increment_Last (In_Tree.Sources);
2558 Source := Source_Data_Table.Last (In_Tree.Sources);
2560 if Current_Verbosity = High then
2561 Write_Str ("Adding source #");
2562 Write_Str (Source'Img);
2563 Write_Str (", File : ");
2564 Write_Line (Get_Name_String (File_Name));
2568 Src_Data : Source_Data := No_Source_Data;
2570 Src_Data.Project := Project;
2571 Src_Data.Language_Name := Lang;
2572 Src_Data.Language := Lang_Id;
2573 Src_Data.Kind := Kind;
2574 Src_Data.File := File_Name;
2575 Src_Data.Display_File :=
2576 File_Name_Type (Element.Value);
2577 Src_Data.Object := Object_Name (File_Name);
2578 Src_Data.Dependency :=
2579 In_Tree.Languages_Data.Table
2580 (Lang_Id).Config.Dependency_Kind;
2581 Src_Data.Dep_Name :=
2582 Dependency_Name (File_Name, Src_Data.Dependency);
2583 Src_Data.Switches := Switches_Name (File_Name);
2584 Src_Data.Naming_Exception := True;
2585 In_Tree.Sources.Table (Source) := Src_Data;
2588 Add_Source (Source, Data, In_Tree);
2591 -- Check if the file name is already recorded for
2592 -- another language or another kind.
2595 In_Tree.Sources.Table (Source).Language /= Lang_Id
2600 "the same file cannot be a source " &
2604 elsif In_Tree.Sources.Table (Source).Kind /= Kind then
2608 "the same file cannot be a source " &
2613 -- If the file is already recorded for the same
2614 -- language and the same kind, it means that the file
2615 -- name appears several times in the *_Exceptions
2616 -- attribute; so there is nothing to do.
2620 Element_Id := Element.Next;
2625 Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next;
2629 -------------------------
2630 -- Get_Unit_Exceptions --
2631 -------------------------
2633 procedure Get_Unit_Exceptions (Kind : Source_Kind) is
2634 Exceptions : Array_Element_Id;
2635 Element : Array_Element;
2638 File_Name : File_Name_Type;
2639 Lang_Id : constant Language_Index :=
2640 Data.Unit_Based_Language_Index;
2641 Lang : constant Name_Id :=
2642 Data.Unit_Based_Language_Name;
2645 Source_To_Replace : Source_Id := No_Source;
2647 Other_Project : Project_Id;
2648 Other_Part : Source_Id;
2651 if Lang_Id = No_Language_Index or else Lang = No_Name then
2656 Exceptions := Value_Of
2658 In_Arrays => Naming.Decl.Arrays,
2659 In_Tree => In_Tree);
2661 if Exceptions = No_Array_Element then
2664 (Name_Implementation,
2665 In_Arrays => Naming.Decl.Arrays,
2666 In_Tree => In_Tree);
2673 In_Arrays => Naming.Decl.Arrays,
2674 In_Tree => In_Tree);
2676 if Exceptions = No_Array_Element then
2677 Exceptions := Value_Of
2678 (Name_Specification,
2679 In_Arrays => Naming.Decl.Arrays,
2680 In_Tree => In_Tree);
2685 while Exceptions /= No_Array_Element loop
2686 Element := In_Tree.Array_Elements.Table (Exceptions);
2688 Get_Name_String (Element.Value.Value);
2689 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2690 File_Name := Name_Find;
2692 Get_Name_String (Element.Index);
2693 To_Lower (Name_Buffer (1 .. Name_Len));
2696 Index := Element.Value.Index;
2698 -- For Ada, check if it is a valid unit name
2700 if Lang = Name_Ada then
2701 Get_Name_String (Element.Index);
2702 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
2704 if Unit = No_Name then
2705 Err_Vars.Error_Msg_Name_1 := Element.Index;
2708 "%% is not a valid unit name.",
2709 Element.Value.Location);
2713 if Unit /= No_Name then
2715 -- Check if the source already exists
2717 Source := In_Tree.First_Source;
2718 Source_To_Replace := No_Source;
2720 while Source /= No_Source and then
2721 (In_Tree.Sources.Table (Source).Unit /= Unit or else
2722 In_Tree.Sources.Table (Source).Index /= Index)
2724 Source := In_Tree.Sources.Table (Source).Next_In_Sources;
2727 if Source /= No_Source then
2728 if In_Tree.Sources.Table (Source).Kind /= Kind then
2729 Other_Part := Source;
2733 In_Tree.Sources.Table (Source).Next_In_Sources;
2735 exit when Source = No_Source or else
2736 (In_Tree.Sources.Table (Source).Unit = Unit
2738 In_Tree.Sources.Table (Source).Index = Index);
2742 if Source /= No_Source then
2743 Other_Project := In_Tree.Sources.Table (Source).Project;
2745 if Is_Extending (Project, Other_Project, In_Tree) then
2747 In_Tree.Sources.Table (Source).Other_Part;
2749 -- Record the source to be removed
2751 Source_To_Replace := Source;
2752 Source := No_Source;
2755 Error_Msg_Name_1 := Unit;
2760 "unit%% cannot belong to two projects " &
2762 Element.Value.Location);
2767 if Source = No_Source then
2768 Source_Data_Table.Increment_Last (In_Tree.Sources);
2769 Source := Source_Data_Table.Last (In_Tree.Sources);
2771 if Current_Verbosity = High then
2772 Write_Str ("Adding source #");
2773 Write_Str (Source'Img);
2774 Write_Str (", File : ");
2775 Write_Str (Get_Name_String (File_Name));
2776 Write_Str (", Unit : ");
2777 Write_Line (Get_Name_String (Unit));
2781 Src_Data : Source_Data := No_Source_Data;
2784 Src_Data.Project := Project;
2785 Src_Data.Language_Name := Lang;
2786 Src_Data.Language := Lang_Id;
2787 Src_Data.Kind := Kind;
2788 Src_Data.Other_Part := Other_Part;
2789 Src_Data.Unit := Unit;
2790 Src_Data.Index := Index;
2791 Src_Data.File := File_Name;
2792 Src_Data.Object := Object_Name (File_Name);
2793 Src_Data.Display_File :=
2794 File_Name_Type (Element.Value.Value);
2795 Src_Data.Dependency := In_Tree.Languages_Data.Table
2796 (Lang_Id).Config.Dependency_Kind;
2797 Src_Data.Dep_Name :=
2798 Dependency_Name (File_Name, Src_Data.Dependency);
2799 Src_Data.Switches := Switches_Name (File_Name);
2800 Src_Data.Naming_Exception := True;
2801 In_Tree.Sources.Table (Source) := Src_Data;
2804 Add_Source (Source, Data, In_Tree);
2806 if Source_To_Replace /= No_Source then
2808 (Source_To_Replace, Source, Project, Data, In_Tree);
2813 Exceptions := Element.Next;
2816 end Get_Unit_Exceptions;
2818 -- Start of processing for Check_Naming_Schemes
2821 if Get_Mode = Ada_Only then
2823 -- If there is a package Naming, we will put in Data.Naming what is
2824 -- in this package Naming.
2826 if Naming_Id /= No_Package then
2827 Naming := In_Tree.Packages.Table (Naming_Id);
2829 if Current_Verbosity = High then
2830 Write_Line ("Checking ""Naming"" for Ada.");
2834 Bodies : constant Array_Element_Id :=
2836 (Name_Body, Naming.Decl.Arrays, In_Tree);
2838 Specs : constant Array_Element_Id :=
2840 (Name_Spec, Naming.Decl.Arrays, In_Tree);
2843 if Bodies /= No_Array_Element then
2845 -- We have elements in the array Body_Part
2847 if Current_Verbosity = High then
2848 Write_Line ("Found Bodies.");
2851 Data.Naming.Bodies := Bodies;
2852 Check_Unit_Names (Bodies);
2855 if Current_Verbosity = High then
2856 Write_Line ("No Bodies.");
2860 if Specs /= No_Array_Element then
2862 -- We have elements in the array Specs
2864 if Current_Verbosity = High then
2865 Write_Line ("Found Specs.");
2868 Data.Naming.Specs := Specs;
2869 Check_Unit_Names (Specs);
2872 if Current_Verbosity = High then
2873 Write_Line ("No Specs.");
2878 -- We are now checking if variables Dot_Replacement, Casing,
2879 -- Spec_Suffix, Body_Suffix and/or Separate_Suffix exist.
2881 -- For each variable, if it does not exist, we do nothing,
2882 -- because we already have the default.
2884 -- Check Dot_Replacement
2887 Dot_Replacement : constant Variable_Value :=
2889 (Name_Dot_Replacement,
2890 Naming.Decl.Attributes, In_Tree);
2893 pragma Assert (Dot_Replacement.Kind = Single,
2894 "Dot_Replacement is not a single string");
2896 if not Dot_Replacement.Default then
2897 Get_Name_String (Dot_Replacement.Value);
2899 if Name_Len = 0 then
2902 "Dot_Replacement cannot be empty",
2903 Dot_Replacement.Location);
2906 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2907 Data.Naming.Dot_Replacement := Name_Find;
2908 Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
2913 if Current_Verbosity = High then
2914 Write_Str (" Dot_Replacement = """);
2915 Write_Str (Get_Name_String (Data.Naming.Dot_Replacement));
2923 Casing_String : constant Variable_Value :=
2926 Naming.Decl.Attributes,
2930 pragma Assert (Casing_String.Kind = Single,
2931 "Casing
is not a single
string");
2933 if not Casing_String.Default then
2935 Casing_Image : constant String :=
2936 Get_Name_String (Casing_String.Value);
2939 Casing_Value : constant Casing_Type :=
2940 Value (Casing_Image);
2942 Data.Naming.Casing := Casing_Value;
2946 when Constraint_Error =>
2947 if Casing_Image'Length = 0 then
2950 "Casing cannot be an empty
string",
2951 Casing_String.Location);
2954 Name_Len := Casing_Image'Length;
2955 Name_Buffer (1 .. Name_Len) := Casing_Image;
2956 Err_Vars.Error_Msg_Name_1 := Name_Find;
2959 "%% is not a correct Casing
",
2960 Casing_String.Location);
2966 if Current_Verbosity = High then
2967 Write_Str (" Casing
= ");
2968 Write_Str (Image (Data.Naming.Casing));
2973 -- Check Spec_Suffix
2976 Ada_Spec_Suffix : constant Variable_Value :=
2980 In_Array => Data.Naming.Spec_Suffix,
2981 In_Tree => In_Tree);
2984 if Ada_Spec_Suffix.Kind = Single
2985 and then Get_Name_String (Ada_Spec_Suffix.Value) /= ""
2987 Get_Name_String (Ada_Spec_Suffix.Value);
2988 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2989 Set_Spec_Suffix (In_Tree, "ada
", Data.Naming, Name_Find);
2990 Data.Naming.Ada_Spec_Suffix_Loc := Ada_Spec_Suffix.Location;
2997 Default_Ada_Spec_Suffix);
3001 if Current_Verbosity = High then
3002 Write_Str (" Spec_Suffix
= """);
3003 Write_Str (Spec_Suffix_Of (In_Tree, "ada
", Data.Naming));
3008 -- Check Body_Suffix
3011 Ada_Body_Suffix : constant Variable_Value :=
3015 In_Array => Data.Naming.Body_Suffix,
3016 In_Tree => In_Tree);
3019 if Ada_Body_Suffix.Kind = Single
3020 and then Get_Name_String (Ada_Body_Suffix.Value) /= ""
3022 Get_Name_String (Ada_Body_Suffix.Value);
3023 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3024 Set_Body_Suffix (In_Tree, "ada", Data.Naming, Name_Find);
3025 Data.Naming.Ada_Body_Suffix_Loc := Ada_Body_Suffix.Location;
3032 Default_Ada_Body_Suffix);
3036 if Current_Verbosity = High then
3037 Write_Str (" Body_Suffix = """);
3038 Write_Str (Body_Suffix_Of (In_Tree, "ada", Data.Naming));
3043 -- Check Separate_Suffix
3046 Ada_Sep_Suffix : constant Variable_Value :=
3048 (Variable_Name => Name_Separate_Suffix,
3049 In_Variables => Naming.Decl.Attributes,
3050 In_Tree => In_Tree);
3053 if Ada_Sep_Suffix.Default then
3054 Data.Naming.Separate_Suffix :=
3055 Body_Suffix_Id_Of (In_Tree, "ada
", Data.Naming);
3058 Get_Name_String (Ada_Sep_Suffix.Value);
3060 if Name_Len = 0 then
3063 "Separate_Suffix cannot be empty
",
3064 Ada_Sep_Suffix.Location);
3067 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3068 Data.Naming.Separate_Suffix := Name_Find;
3069 Data.Naming.Sep_Suffix_Loc := Ada_Sep_Suffix.Location;
3074 if Current_Verbosity = High then
3075 Write_Str (" Separate_Suffix
= """);
3076 Write_Str (Get_Name_String (Data.Naming.Separate_Suffix));
3081 -- Check if Data.Naming is valid
3083 Check_Ada_Naming_Scheme_Validity (Project, In_Tree, Data.Naming);
3086 elsif not In_Configuration then
3088 -- Look into package Naming, if there is one
3090 if Naming_Id /= No_Package then
3091 Naming := In_Tree.Packages.Table (Naming_Id);
3093 if Current_Verbosity = High then
3094 Write_Line ("Checking package Naming.");
3097 -- We are now checking if attribute Dot_Replacement, Casing,
3098 -- and/or Separate_Suffix exist.
3100 -- For each attribute, if it does not exist, we do nothing,
3101 -- because we already have the default.
3102 -- Otherwise, for all unit-based languages, we put the declared
3103 -- value in the language config.
3106 Dot_Repl : constant Variable_Value :=
3108 (Name_Dot_Replacement,
3109 Naming.Decl.Attributes, In_Tree);
3110 Dot_Replacement : File_Name_Type := No_File;
3112 Casing_String : constant Variable_Value :=
3115 Naming.Decl.Attributes,
3117 Casing : Casing_Type;
3118 Casing_Defined : Boolean := False;
3120 Sep_Suffix : constant Variable_Value :=
3122 (Variable_Name => Name_Separate_Suffix,
3123 In_Variables => Naming.Decl.Attributes,
3124 In_Tree => In_Tree);
3125 Separate_Suffix : File_Name_Type := No_File;
3127 Lang_Id : Language_Index;
3129 -- Check attribute Dot_Replacement
3131 if not Dot_Repl.Default then
3132 Get_Name_String (Dot_Repl.Value);
3134 if Name_Len = 0 then
3137 "Dot_Replacement cannot be empty",
3141 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3142 Dot_Replacement := Name_Find;
3144 if Current_Verbosity = High then
3145 Write_Str (" Dot_Replacement = """);
3146 Write_Str (Get_Name_String (Dot_Replacement));
3153 -- Check attribute Casing
3155 if not Casing_String.Default then
3157 Casing_Image : constant String :=
3158 Get_Name_String (Casing_String.Value);
3161 Casing_Value : constant Casing_Type :=
3162 Value (Casing_Image);
3164 Casing := Casing_Value;
3165 Casing_Defined := True;
3167 if Current_Verbosity = High then
3168 Write_Str (" Casing
= ");
3169 Write_Str (Image (Casing));
3176 when Constraint_Error =>
3177 if Casing_Image'Length = 0 then
3180 "Casing cannot be an empty
string",
3181 Casing_String.Location);
3184 Name_Len := Casing_Image'Length;
3185 Name_Buffer (1 .. Name_Len) := Casing_Image;
3186 Err_Vars.Error_Msg_Name_1 := Name_Find;
3189 "%% is not a correct Casing
",
3190 Casing_String.Location);
3195 if not Sep_Suffix.Default then
3196 Get_Name_String (Sep_Suffix.Value);
3198 if Name_Len = 0 then
3201 "Separate_Suffix cannot be empty
",
3202 Sep_Suffix.Location);
3205 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3206 Separate_Suffix := Name_Find;
3208 if Current_Verbosity = High then
3209 Write_Str (" Separate_Suffix
= """);
3211 (Get_Name_String (Data.Naming.Separate_Suffix));
3218 -- For all unit based languages, if any, set the specified
3219 -- value of Dot_Replacement, Casing and/or Separate_Suffix.
3221 if Dot_Replacement /= No_File
3222 or else Casing_Defined
3223 or else Separate_Suffix /= No_File
3225 Lang_Id := Data.First_Language_Processing;
3226 while Lang_Id /= No_Language_Index loop
3227 if In_Tree.Languages_Data.Table
3228 (Lang_Id).Config.Kind = Unit_Based
3230 if Dot_Replacement /= No_File then
3231 In_Tree.Languages_Data.Table
3232 (Lang_Id).Config.Naming_Data.Dot_Replacement :=
3236 if Casing_Defined then
3237 In_Tree.Languages_Data.Table
3238 (Lang_Id).Config.Naming_Data.Casing := Casing;
3241 if Separate_Suffix /= No_File then
3242 In_Tree.Languages_Data.Table
3243 (Lang_Id).Config.Naming_Data.Separate_Suffix :=
3249 In_Tree.Languages_Data.Table (Lang_Id).Next;
3254 -- Next, get the spec and body suffixes
3257 Suffix : Variable_Value;
3258 Lang_Id : Language_Index;
3262 Lang_Id := Data.First_Language_Processing;
3263 while Lang_Id /= No_Language_Index loop
3264 Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
3270 Attribute_Or_Array_Name => Name_Spec_Suffix,
3271 In_Package => Naming_Id,
3272 In_Tree => In_Tree);
3274 if Suffix = Nil_Variable_Value then
3277 Attribute_Or_Array_Name => Name_Specification_Suffix,
3278 In_Package => Naming_Id,
3279 In_Tree => In_Tree);
3282 if Suffix /= Nil_Variable_Value then
3283 In_Tree.Languages_Data.Table (Lang_Id).
3284 Config.Naming_Data.Spec_Suffix :=
3285 File_Name_Type (Suffix.Value);
3292 Attribute_Or_Array_Name => Name_Body_Suffix,
3293 In_Package => Naming_Id,
3294 In_Tree => In_Tree);
3296 if Suffix = Nil_Variable_Value then
3299 Attribute_Or_Array_Name => Name_Implementation_Suffix,
3300 In_Package => Naming_Id,
3301 In_Tree => In_Tree);
3304 if Suffix /= Nil_Variable_Value then
3305 In_Tree.Languages_Data.Table (Lang_Id).
3306 Config.Naming_Data.Body_Suffix :=
3307 File_Name_Type (Suffix.Value);
3310 Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next;
3314 -- Get the exceptions for file based languages
3316 Get_Exceptions (Spec);
3317 Get_Exceptions (Impl);
3319 -- Get the exceptions for unit based languages
3321 Get_Unit_Exceptions (Spec);
3322 Get_Unit_Exceptions (Impl);
3326 end Check_Naming_Schemes;
3328 ------------------------------
3329 -- Check_Library_Attributes --
3330 ------------------------------
3332 procedure Check_Library_Attributes
3333 (Project : Project_Id;
3334 In_Tree : Project_Tree_Ref;
3335 Data : in out Project_Data)
3337 Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
3339 Lib_Dir : constant Prj.Variable_Value :=
3341 (Snames.Name_Library_Dir, Attributes, In_Tree);
3343 Lib_Name : constant Prj.Variable_Value :=
3345 (Snames.Name_Library_Name, Attributes, In_Tree);
3347 Lib_Version : constant Prj.Variable_Value :=
3349 (Snames.Name_Library_Version, Attributes, In_Tree);
3351 Lib_ALI_Dir : constant Prj.Variable_Value :=
3353 (Snames.Name_Library_Ali_Dir, Attributes, In_Tree);
3355 The_Lib_Kind : constant Prj.Variable_Value :=
3357 (Snames.Name_Library_Kind, Attributes, In_Tree);
3359 Imported_Project_List : Project_List := Empty_Project_List;
3361 Continuation : String_Access := No_Continuation_String'Access;
3363 Support_For_Libraries : Library_Support;
3365 procedure Check_Library (Proj : Project_Id; Extends : Boolean);
3366 -- Check if an imported or extended project if also a library project
3372 procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
3373 Proj_Data : Project_Data;
3376 if Proj /= No_Project then
3377 Proj_Data := In_Tree.Projects.Table (Proj);
3379 if not Proj_Data.Library then
3380 -- The only not library projects that are OK are those that
3383 if Proj_Data.Source_Dirs /= Nil_String then
3385 Error_Msg_Name_1 := Data.Name;
3386 Error_Msg_Name_2 := Proj_Data.Name;
3392 "library project %% cannot extend project %% " &
3393 "that is not a library project",
3400 "library project %% cannot import project %% " &
3401 "that is not a library project",
3405 Continuation := Continuation_String'Access;
3408 elsif Data.Library_Kind /= Static and then
3409 Proj_Data.Library_Kind = Static
3411 Error_Msg_Name_1 := Data.Name;
3412 Error_Msg_Name_2 := Proj_Data.Name;
3418 "shared library project %% cannot extend static " &
3419 "library project %%",
3426 "shared library project %% cannot import static " &
3427 "library project %%",
3431 Continuation := Continuation_String'Access;
3436 -- Start of processing for Check_Library_Attributes
3439 -- Special case of extending project
3441 if Data.Extends /= No_Project then
3443 Extended_Data : constant Project_Data :=
3444 In_Tree.Projects.Table (Data.Extends);
3447 -- If the project extended is a library project, we inherit the
3448 -- library name, if it is not redefined; we check that the library
3449 -- directory is specified.
3451 if Extended_Data.Library then
3452 if Lib_Name.Default then
3453 Data.Library_Name := Extended_Data.Library_Name;
3456 if Lib_Dir.Default then
3457 if not Data.Virtual then
3460 "a project extending a library project must " &
3461 "specify an attribute Library_Dir",
3469 pragma Assert (Lib_Dir.Kind = Single);
3471 if Lib_Dir.Value = Empty_String then
3472 if Current_Verbosity = High then
3473 Write_Line ("No library directory");
3477 -- Find path name, check that it is a directory
3482 File_Name_Type (Lib_Dir.Value),
3483 Data.Display_Directory,
3485 Data.Display_Library_Dir,
3486 Create => "library",
3487 Location => Lib_Dir.Location);
3489 if Data.Library_Dir = No_Path then
3491 -- Get the absolute name of the library directory that
3492 -- does not exist, to report an error.
3495 Dir_Name : constant String := Get_Name_String (Lib_Dir.Value);
3498 if Is_Absolute_Path (Dir_Name) then
3499 Err_Vars.Error_Msg_File_1 := File_Name_Type (Lib_Dir.Value);
3502 Get_Name_String (Data.Display_Directory);
3504 if Name_Buffer (Name_Len) /= Directory_Separator then
3505 Name_Len := Name_Len + 1;
3506 Name_Buffer (Name_Len) := Directory_Separator;
3510 (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
3512 Name_Len := Name_Len + Dir_Name'Length;
3513 Err_Vars.Error_Msg_File_1 := Name_Find;
3520 "library directory { does not exist",
3524 -- The library directory cannot be the same as the Object directory
3526 elsif Data.Library_Dir = Data.Object_Directory then
3529 "library directory cannot be the same " &
3530 "as object directory",
3532 Data.Library_Dir := No_Path;
3533 Data.Display_Library_Dir := No_Path;
3537 OK : Boolean := True;
3538 Dirs_Id : String_List_Id;
3539 Dir_Elem : String_Element;
3542 -- The library directory cannot be the same as a source
3543 -- directory of the current project.
3545 Dirs_Id := Data.Source_Dirs;
3546 while Dirs_Id /= Nil_String loop
3547 Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
3548 Dirs_Id := Dir_Elem.Next;
3550 if Data.Library_Dir = Path_Name_Type (Dir_Elem.Value) then
3551 Err_Vars.Error_Msg_File_1 :=
3552 File_Name_Type (Dir_Elem.Value);
3555 "library directory cannot be the same " &
3556 "as source directory {",
3565 -- The library directory cannot be the same as a source
3566 -- directory of another project either.
3569 for Pid in 1 .. Project_Table.Last (In_Tree.Projects) loop
3570 if Pid /= Project then
3571 Dirs_Id := In_Tree.Projects.Table (Pid).Source_Dirs;
3573 Dir_Loop : while Dirs_Id /= Nil_String loop
3574 Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
3575 Dirs_Id := Dir_Elem.Next;
3577 if Data.Library_Dir =
3578 Path_Name_Type (Dir_Elem.Value)
3580 Err_Vars.Error_Msg_File_1 :=
3581 File_Name_Type (Dir_Elem.Value);
3582 Err_Vars.Error_Msg_Name_1 :=
3583 In_Tree.Projects.Table (Pid).Name;
3587 "library directory cannot be the same " &
3588 "as source directory { of project %%",
3595 end loop Project_Loop;
3599 Data.Library_Dir := No_Path;
3600 Data.Display_Library_Dir := No_Path;
3602 elsif Current_Verbosity = High then
3604 -- Display the Library directory in high verbosity
3606 Write_Str ("Library directory =""");
3607 Write_Str (Get_Name_String (Data.Display_Library_Dir));
3614 pragma Assert (Lib_Name.Kind = Single);
3616 if Lib_Name.Value = Empty_String then
3617 if Current_Verbosity = High
3618 and then Data.Library_Name = No_Name
3620 Write_Line ("No library name");
3624 -- There is no restriction on the syntax of library names
3626 Data.Library_Name := Lib_Name.Value;
3629 if Data.Library_Name /= No_Name
3630 and then Current_Verbosity = High
3632 Write_Str ("Library name = """);
3633 Write_Str (Get_Name_String (Data.Library_Name));
3638 Data.Library_Dir /= No_Path
3640 Data.Library_Name /= No_Name;
3642 if Data.Library then
3643 if Get_Mode = Multi_Language then
3644 Support_For_Libraries := Data.Config.Lib_Support;
3647 Support_For_Libraries := MLib.Tgt.Support_For_Libraries;
3650 if Support_For_Libraries = Prj.None then
3653 "?libraries are not supported on this platform",
3655 Data.Library := False;
3658 if Lib_ALI_Dir.Value = Empty_String then
3659 if Current_Verbosity = High then
3660 Write_Line ("No library ALI directory specified");
3662 Data.Library_ALI_Dir := Data.Library_Dir;
3663 Data.Display_Library_ALI_Dir := Data.Display_Library_Dir;
3666 -- Find path name, check that it is a directory
3671 File_Name_Type (Lib_ALI_Dir.Value),
3672 Data.Display_Directory,
3673 Data.Library_ALI_Dir,
3674 Data.Display_Library_ALI_Dir,
3675 Create => "library ALI",
3676 Location => Lib_ALI_Dir.Location);
3678 if Data.Library_ALI_Dir = No_Path then
3680 -- Get the absolute name of the library ALI directory that
3681 -- does not exist, to report an error.
3684 Dir_Name : constant String :=
3685 Get_Name_String (Lib_ALI_Dir.Value);
3688 if Is_Absolute_Path (Dir_Name) then
3689 Err_Vars.Error_Msg_File_1 :=
3690 File_Name_Type (Lib_Dir.Value);
3693 Get_Name_String (Data.Display_Directory);
3695 if Name_Buffer (Name_Len) /= Directory_Separator then
3696 Name_Len := Name_Len + 1;
3697 Name_Buffer (Name_Len) := Directory_Separator;
3701 (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
3703 Name_Len := Name_Len + Dir_Name'Length;
3704 Err_Vars.Error_Msg_File_1 := Name_Find;
3711 "library 'A
'L'I directory { does not exist",
3712 Lib_ALI_Dir.Location);
3716 if Data.Library_ALI_Dir /= Data.Library_Dir then
3718 -- The library ALI directory cannot be the same as the
3719 -- Object directory.
3721 if Data.Library_ALI_Dir = Data.Object_Directory then
3724 "library 'A
'L'I directory cannot be the same " &
3725 "as object directory",
3726 Lib_ALI_Dir.Location);
3727 Data.Library_ALI_Dir := No_Path;
3728 Data.Display_Library_ALI_Dir := No_Path;
3732 OK : Boolean := True;
3733 Dirs_Id : String_List_Id;
3734 Dir_Elem : String_Element;
3737 -- The library ALI directory cannot be the same as
3738 -- a source directory of the current project.
3740 Dirs_Id := Data.Source_Dirs;
3741 while Dirs_Id /= Nil_String loop
3742 Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
3743 Dirs_Id := Dir_Elem.Next;
3745 if Data.Library_ALI_Dir =
3746 Path_Name_Type (Dir_Elem.Value)
3748 Err_Vars.Error_Msg_File_1 :=
3749 File_Name_Type (Dir_Elem.Value);
3752 "library 'A
'L'I directory cannot be " &
3753 "the same as source directory {",
3754 Lib_ALI_Dir.Location);
3762 -- The library ALI directory cannot be the same as
3763 -- a source directory of another project either.
3767 Pid in 1 .. Project_Table.Last (In_Tree.Projects)
3769 if Pid /= Project then
3771 In_Tree.Projects.Table (Pid).Source_Dirs;
3774 while Dirs_Id /= Nil_String loop
3776 In_Tree.String_Elements.Table (Dirs_Id);
3777 Dirs_Id := Dir_Elem.Next;
3779 if Data.Library_ALI_Dir =
3780 Path_Name_Type (Dir_Elem.Value)
3782 Err_Vars.Error_Msg_File_1 :=
3783 File_Name_Type (Dir_Elem.Value);
3784 Err_Vars.Error_Msg_Name_1 :=
3785 In_Tree.Projects.Table (Pid).Name;
3789 "library 'A
'L'I directory cannot " &
3790 "be the same as source directory " &
3792 Lib_ALI_Dir.Location);
3794 exit ALI_Project_Loop;
3796 end loop ALI_Dir_Loop;
3798 end loop ALI_Project_Loop;
3802 Data.Library_ALI_Dir := No_Path;
3803 Data.Display_Library_ALI_Dir := No_Path;
3805 elsif Current_Verbosity = High then
3807 -- Display the Library ALI directory in high
3810 Write_Str ("Library ALI directory =""");
3812 (Get_Name_String (Data.Display_Library_ALI_Dir));
3820 pragma Assert (Lib_Version.Kind = Single);
3822 if Lib_Version.Value = Empty_String then
3823 if Current_Verbosity = High then
3824 Write_Line ("No library version specified");
3828 Data.Lib_Internal_Name := Lib_Version.Value;
3831 pragma Assert (The_Lib_Kind.Kind = Single);
3833 if The_Lib_Kind.Value = Empty_String then
3834 if Current_Verbosity = High then
3835 Write_Line ("No library kind specified");
3839 Get_Name_String (The_Lib_Kind.Value);
3842 Kind_Name : constant String :=
3843 To_Lower (Name_Buffer (1 .. Name_Len));
3845 OK : Boolean := True;
3848 if Kind_Name = "static" then
3849 Data.Library_Kind := Static;
3851 elsif Kind_Name = "dynamic" then
3852 Data.Library_Kind := Dynamic;
3854 elsif Kind_Name = "relocatable" then
3855 Data.Library_Kind := Relocatable;
3860 "illegal value for Library_Kind",
3861 The_Lib_Kind.Location);
3865 if Current_Verbosity = High and then OK then
3866 Write_Str ("Library kind = ");
3867 Write_Line (Kind_Name);
3870 if Data.Library_Kind /= Static and then
3871 Support_For_Libraries = Prj.Static_Only
3875 "only static libraries are supported " &
3877 The_Lib_Kind.Location);
3878 Data.Library := False;
3883 if Data.Library then
3884 if Current_Verbosity = High then
3885 Write_Line ("This is a library project file");
3888 if Get_Mode = Multi_Language then
3889 Check_Library (Data.Extends, Extends => True);
3891 Imported_Project_List := Data.Imported_Projects;
3892 while Imported_Project_List /= Empty_Project_List loop
3894 (In_Tree.Project_Lists.Table
3895 (Imported_Project_List).Project,
3897 Imported_Project_List :=
3898 In_Tree.Project_Lists.Table
3899 (Imported_Project_List).Next;
3907 if Data.Extends /= No_Project then
3908 In_Tree.Projects.Table (Data.Extends).Library := False;
3910 end Check_Library_Attributes;
3912 --------------------------
3913 -- Check_Package_Naming --
3914 --------------------------
3916 procedure Check_Package_Naming
3917 (Project : Project_Id;
3918 In_Tree : Project_Tree_Ref;
3919 Data : in out Project_Data)
3921 Naming_Id : constant Package_Id :=
3922 Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
3924 Naming : Package_Element;
3927 -- If there is a package Naming, we will put in Data.Naming
3928 -- what is in this package Naming.
3930 if Naming_Id /= No_Package then
3931 Naming := In_Tree.Packages.Table (Naming_Id);
3933 if Current_Verbosity = High then
3934 Write_Line ("Checking ""Naming"".");
3937 -- Check Spec_Suffix
3940 Spec_Suffixs : Array_Element_Id :=
3946 Suffix : Array_Element_Id;
3947 Element : Array_Element;
3948 Suffix2 : Array_Element_Id;
3951 -- If some suffixs have been specified, we make sure that
3952 -- for each language for which a default suffix has been
3953 -- specified, there is a suffix specified, either the one
3954 -- in the project file or if there were none, the default.
3956 if Spec_Suffixs /= No_Array_Element then
3957 Suffix := Data.Naming.Spec_Suffix;
3959 while Suffix /= No_Array_Element loop
3961 In_Tree.Array_Elements.Table (Suffix);
3962 Suffix2 := Spec_Suffixs;
3964 while Suffix2 /= No_Array_Element loop
3965 exit when In_Tree.Array_Elements.Table
3966 (Suffix2).Index = Element.Index;
3967 Suffix2 := In_Tree.Array_Elements.Table
3971 -- There is a registered default suffix, but no
3972 -- suffix specified in the project file.
3973 -- Add the default to the array.
3975 if Suffix2 = No_Array_Element then
3976 Array_Element_Table.Increment_Last
3977 (In_Tree.Array_Elements);
3978 In_Tree.Array_Elements.Table
3979 (Array_Element_Table.Last
3980 (In_Tree.Array_Elements)) :=
3981 (Index => Element.Index,
3982 Src_Index => Element.Src_Index,
3983 Index_Case_Sensitive => False,
3984 Value => Element.Value,
3985 Next => Spec_Suffixs);
3986 Spec_Suffixs := Array_Element_Table.Last
3987 (In_Tree.Array_Elements);
3990 Suffix := Element.Next;
3993 -- Put the resulting array as the specification suffixs
3995 Data.Naming.Spec_Suffix := Spec_Suffixs;
4000 Current : Array_Element_Id;
4001 Element : Array_Element;
4004 Current := Data.Naming.Spec_Suffix;
4005 while Current /= No_Array_Element loop
4006 Element := In_Tree.Array_Elements.Table (Current);
4007 Get_Name_String (Element.Value.Value);
4009 if Name_Len = 0 then
4012 "Spec_Suffix cannot be empty",
4013 Element.Value.Location);
4016 In_Tree.Array_Elements.Table (Current) := Element;
4017 Current := Element.Next;
4021 -- Check Body_Suffix
4024 Impl_Suffixs : Array_Element_Id :=
4030 Suffix : Array_Element_Id;
4031 Element : Array_Element;
4032 Suffix2 : Array_Element_Id;
4035 -- If some suffixes have been specified, we make sure that
4036 -- for each language for which a default suffix has been
4037 -- specified, there is a suffix specified, either the one
4038 -- in the project file or if there were none, the default.
4040 if Impl_Suffixs /= No_Array_Element then
4041 Suffix := Data.Naming.Body_Suffix;
4042 while Suffix /= No_Array_Element loop
4044 In_Tree.Array_Elements.Table (Suffix);
4046 Suffix2 := Impl_Suffixs;
4047 while Suffix2 /= No_Array_Element loop
4048 exit when In_Tree.Array_Elements.Table
4049 (Suffix2).Index = Element.Index;
4050 Suffix2 := In_Tree.Array_Elements.Table
4054 -- There is a registered default suffix, but no suffix was
4055 -- specified in the project file. Add default to the array.
4057 if Suffix2 = No_Array_Element then
4058 Array_Element_Table.Increment_Last
4059 (In_Tree.Array_Elements);
4060 In_Tree.Array_Elements.Table
4061 (Array_Element_Table.Last
4062 (In_Tree.Array_Elements)) :=
4063 (Index => Element.Index,
4064 Src_Index => Element.Src_Index,
4065 Index_Case_Sensitive => False,
4066 Value => Element.Value,
4067 Next => Impl_Suffixs);
4068 Impl_Suffixs := Array_Element_Table.Last
4069 (In_Tree.Array_Elements);
4072 Suffix := Element.Next;
4075 -- Put the resulting array as the implementation suffixs
4077 Data.Naming.Body_Suffix := Impl_Suffixs;
4082 Current : Array_Element_Id;
4083 Element : Array_Element;
4086 Current := Data.Naming.Body_Suffix;
4087 while Current /= No_Array_Element loop
4088 Element := In_Tree.Array_Elements.Table (Current);
4089 Get_Name_String (Element.Value.Value);
4091 if Name_Len = 0 then
4094 "Body_Suffix cannot be empty",
4095 Element.Value.Location);
4098 In_Tree.Array_Elements.Table (Current) := Element;
4099 Current := Element.Next;
4103 -- Get the exceptions, if any
4105 Data.Naming.Specification_Exceptions :=
4107 (Name_Specification_Exceptions,
4108 In_Arrays => Naming.Decl.Arrays,
4109 In_Tree => In_Tree);
4111 Data.Naming.Implementation_Exceptions :=
4113 (Name_Implementation_Exceptions,
4114 In_Arrays => Naming.Decl.Arrays,
4115 In_Tree => In_Tree);
4117 end Check_Package_Naming;
4119 ---------------------------------
4120 -- Check_Programming_Languages --
4121 ---------------------------------
4123 procedure Check_Programming_Languages
4124 (In_Tree : Project_Tree_Ref;
4125 Project : Project_Id;
4126 Data : in out Project_Data)
4128 Languages : Variable_Value := Nil_Variable_Value;
4129 Def_Lang : Variable_Value := Nil_Variable_Value;
4130 Def_Lang_Id : Name_Id;
4133 Data.First_Language_Processing := No_Language_Index;
4135 Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes, In_Tree);
4138 (Name_Default_Language, Data.Decl.Attributes, In_Tree);
4139 Data.Ada_Sources_Present := Data.Source_Dirs /= Nil_String;
4140 Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String;
4142 if Data.Source_Dirs /= Nil_String then
4144 -- Check if languages are specified in this project
4146 if Languages.Default then
4148 -- Attribute Languages is not specified. So, it defaults to
4149 -- a project of the default language only.
4151 Name_List_Table.Increment_Last (In_Tree.Name_Lists);
4152 Data.Languages := Name_List_Table.Last (In_Tree.Name_Lists);
4154 -- In Ada_Only mode, the default language is Ada
4156 if Get_Mode = Ada_Only then
4157 In_Tree.Name_Lists.Table (Data.Languages) :=
4158 (Name => Name_Ada, Next => No_Name_List);
4160 -- Attribute Languages is not specified. So, it defaults to
4161 -- a project of language Ada only.
4163 Data.Langs (Ada_Language_Index) := True;
4165 -- No sources of languages other than Ada
4167 Data.Other_Sources_Present := False;
4169 elsif Def_Lang.Default then
4173 "no languages defined for this project",
4177 Get_Name_String (Def_Lang.Value);
4178 To_Lower (Name_Buffer (1 .. Name_Len));
4179 Def_Lang_Id := Name_Find;
4180 In_Tree.Name_Lists.Table (Data.Languages) :=
4181 (Name => Def_Lang_Id, Next => No_Name_List);
4182 Language_Data_Table.Increment_Last (In_Tree.Languages_Data);
4183 Data.First_Language_Processing :=
4184 Language_Data_Table.Last (In_Tree.Languages_Data);
4185 In_Tree.Languages_Data.Table
4186 (Data.First_Language_Processing) := No_Language_Data;
4187 In_Tree.Languages_Data.Table
4188 (Data.First_Language_Processing).Name := Def_Lang_Id;
4189 Get_Name_String (Def_Lang_Id);
4190 Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
4191 In_Tree.Languages_Data.Table
4192 (Data.First_Language_Processing).Display_Name := Name_Find;
4194 if Def_Lang_Id = Name_Ada then
4195 In_Tree.Languages_Data.Table
4196 (Data.First_Language_Processing).Config.Kind := Unit_Based;
4197 In_Tree.Languages_Data.Table
4198 (Data.First_Language_Processing).Config.Dependency_Kind :=
4200 Data.Unit_Based_Language_Name := Name_Ada;
4201 Data.Unit_Based_Language_Index :=
4202 Data.First_Language_Processing;
4204 In_Tree.Languages_Data.Table
4205 (Data.First_Language_Processing).Config.Kind := File_Based;
4206 In_Tree.Languages_Data.Table
4207 (Data.First_Language_Processing).Config.Dependency_Kind :=
4215 Current : String_List_Id := Languages.Values;
4216 Element : String_Element;
4217 Lang_Name : Name_Id;
4218 Index : Language_Index;
4219 Lang_Data : Language_Data;
4220 NL_Id : Name_List_Index := No_Name_List;
4223 if Get_Mode = Ada_Only then
4225 -- Assume that there is no language specified yet
4227 Data.Other_Sources_Present := False;
4228 Data.Ada_Sources_Present := False;
4231 -- If there are no languages declared, there are no sources
4233 if Current = Nil_String then
4234 Data.Source_Dirs := Nil_String;
4237 -- Look through all the languages specified in attribute
4240 while Current /= Nil_String loop
4242 In_Tree.String_Elements.Table (Current);
4243 Get_Name_String (Element.Value);
4244 To_Lower (Name_Buffer (1 .. Name_Len));
4245 Lang_Name := Name_Find;
4247 NL_Id := Data.Languages;
4248 while NL_Id /= No_Name_List loop
4250 Lang_Name = In_Tree.Name_Lists.Table (NL_Id).Name;
4251 NL_Id := In_Tree.Name_Lists.Table (NL_Id).Next;
4254 if NL_Id = No_Name_List then
4255 Name_List_Table.Increment_Last (In_Tree.Name_Lists);
4257 if Data.Languages = No_Name_List then
4259 Name_List_Table.Last (In_Tree.Name_Lists);
4262 NL_Id := Data.Languages;
4263 while In_Tree.Name_Lists.Table (NL_Id).Next /=
4266 NL_Id := In_Tree.Name_Lists.Table (NL_Id).Next;
4269 In_Tree.Name_Lists.Table (NL_Id).Next :=
4270 Name_List_Table.Last (In_Tree.Name_Lists);
4273 NL_Id := Name_List_Table.Last (In_Tree.Name_Lists);
4274 In_Tree.Name_Lists.Table (NL_Id) :=
4275 (Lang_Name, No_Name_List);
4277 if Get_Mode = Ada_Only then
4278 Index := Language_Indexes.Get (Lang_Name);
4280 if Index = No_Language_Index then
4281 Add_Language_Name (Lang_Name);
4282 Index := Last_Language_Index;
4285 Set (Index, True, Data, In_Tree);
4286 Set (Language_Processing =>
4287 Default_Language_Processing_Data,
4288 For_Language => Index,
4290 In_Tree => In_Tree);
4292 if Index = Ada_Language_Index then
4293 Data.Ada_Sources_Present := True;
4296 Data.Other_Sources_Present := True;
4300 Language_Data_Table.Increment_Last
4301 (In_Tree.Languages_Data);
4303 Language_Data_Table.Last (In_Tree.Languages_Data);
4304 Lang_Data.Name := Lang_Name;
4305 Lang_Data.Display_Name := Element.Value;
4306 Lang_Data.Next := Data.First_Language_Processing;
4308 if Lang_Name = Name_Ada then
4309 Lang_Data.Config.Kind := Unit_Based;
4310 Lang_Data.Config.Dependency_Kind := ALI_File;
4311 Data.Unit_Based_Language_Name := Name_Ada;
4312 Data.Unit_Based_Language_Index := Index;
4315 Lang_Data.Config.Kind := File_Based;
4316 Lang_Data.Config.Dependency_Kind := Makefile;
4319 In_Tree.Languages_Data.Table (Index) := Lang_Data;
4320 Data.First_Language_Processing := Index;
4324 Current := Element.Next;
4330 end Check_Programming_Languages;
4336 function Check_Project
4338 Root_Project : Project_Id;
4339 In_Tree : Project_Tree_Ref;
4340 Extending : Boolean) return Boolean
4343 if P = Root_Project then
4346 elsif Extending then
4348 Data : Project_Data := In_Tree.Projects.Table (Root_Project);
4351 while Data.Extends /= No_Project loop
4352 if P = Data.Extends then
4356 Data := In_Tree.Projects.Table (Data.Extends);
4364 -------------------------------
4365 -- Check_Stand_Alone_Library --
4366 -------------------------------
4368 procedure Check_Stand_Alone_Library
4369 (Project : Project_Id;
4370 In_Tree : Project_Tree_Ref;
4371 Data : in out Project_Data;
4372 Extending : Boolean)
4374 Lib_Interfaces : constant Prj.Variable_Value :=
4376 (Snames.Name_Library_Interface,
4377 Data.Decl.Attributes,
4380 Lib_Auto_Init : constant Prj.Variable_Value :=
4382 (Snames.Name_Library_Auto_Init,
4383 Data.Decl.Attributes,
4386 Lib_Src_Dir : constant Prj.Variable_Value :=
4388 (Snames.Name_Library_Src_Dir,
4389 Data.Decl.Attributes,
4392 Lib_Symbol_File : constant Prj.Variable_Value :=
4394 (Snames.Name_Library_Symbol_File,
4395 Data.Decl.Attributes,
4398 Lib_Symbol_Policy : constant Prj.Variable_Value :=
4400 (Snames.Name_Library_Symbol_Policy,
4401 Data.Decl.Attributes,
4404 Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
4406 (Snames.Name_Library_Reference_Symbol_File,
4407 Data.Decl.Attributes,
4410 Auto_Init_Supported : Boolean;
4411 OK : Boolean := True;
4413 Next_Proj : Project_Id;
4416 if Get_Mode = Multi_Language then
4417 Auto_Init_Supported := Data.Config.Auto_Init_Supported;
4419 Auto_Init_Supported :=
4420 MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported;
4423 pragma Assert (Lib_Interfaces.Kind = List);
4425 -- It is a stand-alone library project file if attribute
4426 -- Library_Interface is defined.
4428 if not Lib_Interfaces.Default then
4429 SAL_Library : declare
4430 Interfaces : String_List_Id := Lib_Interfaces.Values;
4431 Interface_ALIs : String_List_Id := Nil_String;
4433 The_Unit_Id : Unit_Index;
4434 The_Unit_Data : Unit_Data;
4436 procedure Add_ALI_For (Source : File_Name_Type);
4437 -- Add an ALI file name to the list of Interface ALIs
4443 procedure Add_ALI_For (Source : File_Name_Type) is
4445 Get_Name_String (Source);
4448 ALI : constant String :=
4449 ALI_File_Name (Name_Buffer (1 .. Name_Len));
4450 ALI_Name_Id : Name_Id;
4453 Name_Len := ALI'Length;
4454 Name_Buffer (1 .. Name_Len) := ALI;
4455 ALI_Name_Id := Name_Find;
4457 String_Element_Table.Increment_Last
4458 (In_Tree.String_Elements);
4459 In_Tree.String_Elements.Table
4460 (String_Element_Table.Last
4461 (In_Tree.String_Elements)) :=
4462 (Value => ALI_Name_Id,
4464 Display_Value => ALI_Name_Id,
4466 In_Tree.String_Elements.Table
4467 (Interfaces).Location,
4469 Next => Interface_ALIs);
4470 Interface_ALIs := String_Element_Table.Last
4471 (In_Tree.String_Elements);
4475 -- Start of processing for SAL_Library
4478 Data.Standalone_Library := True;
4480 -- Library_Interface cannot be an empty list
4482 if Interfaces = Nil_String then
4485 "Library_Interface cannot be an empty list",
4486 Lib_Interfaces.Location);
4489 -- Process each unit name specified in the attribute
4490 -- Library_Interface.
4492 while Interfaces /= Nil_String loop
4494 (In_Tree.String_Elements.Table (Interfaces).Value);
4495 To_Lower (Name_Buffer (1 .. Name_Len));
4497 if Name_Len = 0 then
4500 "an interface cannot be an empty string",
4501 In_Tree.String_Elements.Table (Interfaces).Location);
4505 Error_Msg_Name_1 := Unit;
4507 if Get_Mode = Ada_Only then
4509 Units_Htable.Get (In_Tree.Units_HT, Unit);
4511 if The_Unit_Id = No_Unit_Index then
4515 In_Tree.String_Elements.Table
4516 (Interfaces).Location);
4519 -- Check that the unit is part of the project
4522 In_Tree.Units.Table (The_Unit_Id);
4524 if The_Unit_Data.File_Names (Body_Part).Name /= No_File
4525 and then The_Unit_Data.File_Names (Body_Part).Path /=
4529 (The_Unit_Data.File_Names (Body_Part).Project,
4530 Project, In_Tree, Extending)
4532 -- There is a body for this unit.
4533 -- If there is no spec, we need to check
4534 -- that it is not a subunit.
4536 if The_Unit_Data.File_Names
4537 (Specification).Name = No_File
4540 Src_Ind : Source_File_Index;
4543 Src_Ind := Sinput.P.Load_Project_File
4545 (The_Unit_Data.File_Names
4548 if Sinput.P.Source_File_Is_Subunit
4553 "%% is a subunit; " &
4554 "it cannot be an interface",
4556 String_Elements.Table
4557 (Interfaces).Location);
4562 -- The unit is not a subunit, so we add
4563 -- to the Interface ALIs the ALI file
4564 -- corresponding to the body.
4567 (The_Unit_Data.File_Names (Body_Part).Name);
4572 "%% is not an unit of this project",
4573 In_Tree.String_Elements.Table
4574 (Interfaces).Location);
4577 elsif The_Unit_Data.File_Names
4578 (Specification).Name /= No_File
4579 and then The_Unit_Data.File_Names
4580 (Specification).Path /= Slash
4581 and then Check_Project
4582 (The_Unit_Data.File_Names
4583 (Specification).Project,
4584 Project, In_Tree, Extending)
4587 -- The unit is part of the project, it has
4588 -- a spec, but no body. We add to the Interface
4589 -- ALIs the ALI file corresponding to the spec.
4592 (The_Unit_Data.File_Names (Specification).Name);
4597 "%% is not an unit of this project",
4598 In_Tree.String_Elements.Table
4599 (Interfaces).Location);
4604 -- Multi_Language mode
4606 Next_Proj := Data.Extends;
4607 Source := Data.First_Source;
4610 while Source /= No_Source and then
4611 In_Tree.Sources.Table (Source).Unit /= Unit
4614 In_Tree.Sources.Table (Source).Next_In_Project;
4617 exit when Source /= No_Source or else
4618 Next_Proj = No_Project;
4621 In_Tree.Projects.Table (Next_Proj).First_Source;
4623 In_Tree.Projects.Table (Next_Proj).Extends;
4626 if Source /= No_Source then
4627 if In_Tree.Sources.Table (Source).Kind = Sep then
4628 Source := No_Source;
4630 elsif In_Tree.Sources.Table (Source).Kind = Spec
4632 In_Tree.Sources.Table (Source).Other_Part /=
4635 Source := In_Tree.Sources.Table (Source).Other_Part;
4639 if Source /= No_Source then
4640 if In_Tree.Sources.Table (Source).Project /= Project
4644 In_Tree.Sources.Table (Source).Project,
4647 Source := No_Source;
4651 if Source = No_Source then
4654 "%% is not an unit of this project",
4655 In_Tree.String_Elements.Table
4656 (Interfaces).Location);
4659 if In_Tree.Sources.Table (Source).Kind = Spec and then
4660 In_Tree.Sources.Table (Source).Other_Part /=
4664 In_Tree.Sources.Table (Source).Other_Part;
4667 String_Element_Table.Increment_Last
4668 (In_Tree.String_Elements);
4669 In_Tree.String_Elements.Table
4670 (String_Element_Table.Last
4671 (In_Tree.String_Elements)) :=
4673 Name_Id (In_Tree.Sources.Table (Source).Dep_Name),
4676 Name_Id (In_Tree.Sources.Table (Source).Dep_Name),
4678 In_Tree.String_Elements.Table
4679 (Interfaces).Location,
4681 Next => Interface_ALIs);
4682 Interface_ALIs := String_Element_Table.Last
4683 (In_Tree.String_Elements);
4691 In_Tree.String_Elements.Table (Interfaces).Next;
4694 -- Put the list of Interface ALIs in the project data
4696 Data.Lib_Interface_ALIs := Interface_ALIs;
4698 -- Check value of attribute Library_Auto_Init and set
4699 -- Lib_Auto_Init accordingly.
4701 if Lib_Auto_Init.Default then
4703 -- If no attribute Library_Auto_Init is declared, then set auto
4704 -- init only if it is supported.
4706 Data.Lib_Auto_Init := Auto_Init_Supported;
4709 Get_Name_String (Lib_Auto_Init.Value);
4710 To_Lower (Name_Buffer (1 .. Name_Len));
4712 if Name_Buffer (1 .. Name_Len) = "false" then
4713 Data.Lib_Auto_Init := False;
4715 elsif Name_Buffer (1 .. Name_Len) = "true" then
4716 if Auto_Init_Supported then
4717 Data.Lib_Auto_Init := True;
4720 -- Library_Auto_Init cannot be "true" if auto init is not
4725 "library auto init not supported " &
4727 Lib_Auto_Init.Location);
4733 "invalid value for attribute Library_Auto_Init",
4734 Lib_Auto_Init.Location);
4739 -- If attribute Library_Src_Dir is defined and not the empty string,
4740 -- check if the directory exist and is not the object directory or
4741 -- one of the source directories. This is the directory where copies
4742 -- of the interface sources will be copied. Note that this directory
4743 -- may be the library directory.
4745 if Lib_Src_Dir.Value /= Empty_String then
4747 Dir_Id : constant File_Name_Type :=
4748 File_Name_Type (Lib_Src_Dir.Value);
4755 Data.Display_Directory,
4756 Data.Library_Src_Dir,
4757 Data.Display_Library_Src_Dir,
4758 Create => "library source copy",
4759 Location => Lib_Src_Dir.Location);
4761 -- If directory does not exist, report an error
4763 if Data.Library_Src_Dir = No_Path then
4765 -- Get the absolute name of the library directory that does
4766 -- not exist, to report an error.
4769 Dir_Name : constant String :=
4770 Get_Name_String (Dir_Id);
4773 if Is_Absolute_Path (Dir_Name) then
4774 Err_Vars.Error_Msg_File_1 := Dir_Id;
4777 Get_Name_String (Data.Directory);
4779 if Name_Buffer (Name_Len) /=
4782 Name_Len := Name_Len + 1;
4783 Name_Buffer (Name_Len) :=
4784 Directory_Separator;
4789 Name_Len + Dir_Name'Length) :=
4791 Name_Len := Name_Len + Dir_Name'Length;
4792 Err_Vars.Error_Msg_Name_1 := Name_Find;
4799 "Directory { does not exist",
4800 Lib_Src_Dir.Location);
4803 -- Report error if it is the same as the object directory
4805 elsif Data.Library_Src_Dir = Data.Object_Directory then
4808 "directory to copy interfaces cannot be " &
4809 "the object directory",
4810 Lib_Src_Dir.Location);
4811 Data.Library_Src_Dir := No_Path;
4815 Src_Dirs : String_List_Id;
4816 Src_Dir : String_Element;
4819 -- Interface copy directory cannot be one of the source
4820 -- directory of the current project.
4822 Src_Dirs := Data.Source_Dirs;
4823 while Src_Dirs /= Nil_String loop
4824 Src_Dir := In_Tree.String_Elements.Table (Src_Dirs);
4826 -- Report error if it is one of the source directories
4828 if Data.Library_Src_Dir =
4829 Path_Name_Type (Src_Dir.Value)
4833 "directory to copy interfaces cannot " &
4834 "be one of the source directories",
4835 Lib_Src_Dir.Location);
4836 Data.Library_Src_Dir := No_Path;
4840 Src_Dirs := Src_Dir.Next;
4843 if Data.Library_Src_Dir /= No_Path then
4845 -- It cannot be a source directory of any other
4848 Project_Loop : for Pid in 1 ..
4849 Project_Table.Last (In_Tree.Projects)
4852 In_Tree.Projects.Table (Pid).Source_Dirs;
4853 Dir_Loop : while Src_Dirs /= Nil_String loop
4855 In_Tree.String_Elements.Table (Src_Dirs);
4857 -- Report error if it is one of the source
4860 if Data.Library_Src_Dir =
4861 Path_Name_Type (Src_Dir.Value)
4864 File_Name_Type (Src_Dir.Value);
4866 In_Tree.Projects.Table (Pid).Name;
4869 "directory to copy interfaces cannot " &
4870 "be the same as source directory { of " &
4872 Lib_Src_Dir.Location);
4873 Data.Library_Src_Dir := No_Path;
4877 Src_Dirs := Src_Dir.Next;
4879 end loop Project_Loop;
4883 -- In high verbosity, if there is a valid Library_Src_Dir,
4884 -- display its path name.
4886 if Data.Library_Src_Dir /= No_Path
4887 and then Current_Verbosity = High
4889 Write_Str ("Directory to copy interfaces =""");
4890 Write_Str (Get_Name_String (Data.Library_Src_Dir));
4897 -- Check the symbol related attributes
4899 -- First, the symbol policy
4901 if not Lib_Symbol_Policy.Default then
4903 Value : constant String :=
4905 (Get_Name_String (Lib_Symbol_Policy.Value));
4908 -- Symbol policy must hove one of a limited number of values
4910 if Value = "autonomous" or else Value = "default" then
4911 Data.Symbol_Data.Symbol_Policy := Autonomous;
4913 elsif Value = "compliant" then
4914 Data.Symbol_Data.Symbol_Policy := Compliant;
4916 elsif Value = "controlled" then
4917 Data.Symbol_Data.Symbol_Policy := Controlled;
4919 elsif Value = "restricted" then
4920 Data.Symbol_Data.Symbol_Policy := Restricted;
4922 elsif Value = "direct" then
4923 Data.Symbol_Data.Symbol_Policy := Direct;
4928 "illegal value for Library_Symbol_Policy",
4929 Lib_Symbol_Policy.Location);
4934 -- If attribute Library_Symbol_File is not specified, symbol policy
4935 -- cannot be Restricted.
4937 if Lib_Symbol_File.Default then
4938 if Data.Symbol_Data.Symbol_Policy = Restricted then
4941 "Library_Symbol_File needs to be defined when " &
4942 "symbol policy is Restricted",
4943 Lib_Symbol_Policy.Location);
4947 -- Library_Symbol_File is defined.
4949 Data.Symbol_Data.Symbol_File :=
4950 Path_Name_Type (Lib_Symbol_File.Value);
4952 Get_Name_String (Lib_Symbol_File.Value);
4954 if Name_Len = 0 then
4957 "symbol file name cannot be an empty string",
4958 Lib_Symbol_File.Location);
4961 OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
4964 for J in 1 .. Name_Len loop
4965 if Name_Buffer (J) = '/'
4966 or else Name_Buffer (J) = Directory_Separator
4975 Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
4978 "symbol file name { is illegal. " &
4979 "Name canot include directory info.",
4980 Lib_Symbol_File.Location);
4985 -- If attribute Library_Reference_Symbol_File is not defined,
4986 -- symbol policy cannot be Compilant or Controlled.
4988 if Lib_Ref_Symbol_File.Default then
4989 if Data.Symbol_Data.Symbol_Policy = Compliant
4990 or else Data.Symbol_Data.Symbol_Policy = Controlled
4994 "a reference symbol file need to be defined",
4995 Lib_Symbol_Policy.Location);
4999 -- Library_Reference_Symbol_File is defined, check file exists
5001 Data.Symbol_Data.Reference :=
5002 Path_Name_Type (Lib_Ref_Symbol_File.Value);
5004 Get_Name_String (Lib_Ref_Symbol_File.Value);
5006 if Name_Len = 0 then
5009 "reference symbol file name cannot be an empty string",
5010 Lib_Symbol_File.Location);
5013 if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
5015 Add_Str_To_Name_Buffer (Get_Name_String (Data.Directory));
5016 Add_Char_To_Name_Buffer (Directory_Separator);
5017 Add_Str_To_Name_Buffer
5018 (Get_Name_String (Lib_Ref_Symbol_File.Value));
5019 Data.Symbol_Data.Reference := Name_Find;
5022 if not Is_Regular_File
5023 (Get_Name_String (Data.Symbol_Data.Reference))
5026 File_Name_Type (Lib_Ref_Symbol_File.Value);
5028 -- For controlled and direct symbol policies, it is an error
5029 -- if the reference symbol file does not exist. For other
5030 -- symbol policies, this is just a warning
5033 Data.Symbol_Data.Symbol_Policy /= Controlled
5034 and then Data.Symbol_Data.Symbol_Policy /= Direct;
5038 "<library reference symbol file { does not exist",
5039 Lib_Ref_Symbol_File.Location);
5041 -- In addition in the non-controlled case, if symbol policy
5042 -- is Compliant, it is changed to Autonomous, because there
5043 -- is no reference to check against, and we don't want to
5044 -- fail in this case.
5046 if Data.Symbol_Data.Symbol_Policy /= Controlled then
5047 if Data.Symbol_Data.Symbol_Policy = Compliant then
5048 Data.Symbol_Data.Symbol_Policy := Autonomous;
5053 -- If both the reference symbol file and the symbol file are
5054 -- defined, then check that they are not the same file.
5056 if Data.Symbol_Data.Symbol_File /= No_Path then
5057 Get_Name_String (Data.Symbol_Data.Symbol_File);
5059 if Name_Len > 0 then
5061 Symb_Path : constant String :=
5064 (Data.Object_Directory) &
5065 Directory_Separator &
5066 Name_Buffer (1 .. Name_Len));
5067 Ref_Path : constant String :=
5070 (Data.Symbol_Data.Reference));
5072 if Symb_Path = Ref_Path then
5075 "library reference symbol file and library" &
5076 " symbol file cannot be the same file",
5077 Lib_Ref_Symbol_File.Location);
5085 end Check_Stand_Alone_Library;
5087 ----------------------------
5088 -- Compute_Directory_Last --
5089 ----------------------------
5091 function Compute_Directory_Last (Dir : String) return Natural is
5094 and then (Dir (Dir'Last - 1) = Directory_Separator
5095 or else Dir (Dir'Last - 1) = '/')
5097 return Dir'Last - 1;
5101 end Compute_Directory_Last;
5108 (Project : Project_Id;
5109 In_Tree : Project_Tree_Ref;
5111 Flag_Location : Source_Ptr)
5113 Real_Location : Source_Ptr := Flag_Location;
5114 Error_Buffer : String (1 .. 5_000);
5115 Error_Last : Natural := 0;
5116 Name_Number : Natural := 0;
5117 File_Number : Natural := 0;
5118 First : Positive := Msg'First;
5121 procedure Add (C : Character);
5122 -- Add a character to the buffer
5124 procedure Add (S : String);
5125 -- Add a string to the buffer
5128 -- Add a name to the buffer
5131 -- Add a file name to the buffer
5137 procedure Add (C : Character) is
5139 Error_Last := Error_Last + 1;
5140 Error_Buffer (Error_Last) := C;
5143 procedure Add (S : String) is
5145 Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S;
5146 Error_Last := Error_Last + S'Length;
5153 procedure Add_File is
5154 File : File_Name_Type;
5158 File_Number := File_Number + 1;
5162 File := Err_Vars.Error_Msg_File_1;
5164 File := Err_Vars.Error_Msg_File_2;
5166 File := Err_Vars.Error_Msg_File_3;
5171 Get_Name_String (File);
5172 Add (Name_Buffer (1 .. Name_Len));
5180 procedure Add_Name is
5185 Name_Number := Name_Number + 1;
5189 Name := Err_Vars.Error_Msg_Name_1;
5191 Name := Err_Vars.Error_Msg_Name_2;
5193 Name := Err_Vars.Error_Msg_Name_3;
5198 Get_Name_String (Name);
5199 Add (Name_Buffer (1 .. Name_Len));
5203 -- Start of processing for Error_Msg
5206 -- If location of error is unknown, use the location of the project
5208 if Real_Location = No_Location then
5209 Real_Location := In_Tree.Projects.Table (Project).Location;
5212 if Error_Report = null then
5213 Prj.Err.Error_Msg (Msg, Real_Location);
5217 -- Ignore continuation character
5219 if Msg (First) = '\
' then
5222 -- Warning character is always the first one in this package
5223 -- this is an undocumented kludge???
5225 elsif Msg (First) = '?
' then
5229 elsif Msg (First) = '<' then
5232 if Err_Vars.Error_Msg_Warn then
5238 while Index <= Msg'Last loop
5239 if Msg (Index) = '{' then
5242 elsif Msg (Index) = '%' then
5243 if Index < Msg'Last and then Msg (Index + 1) = '%' then
5255 Error_Report (Error_Buffer (1 .. Error_Last), Project, In_Tree);
5258 ----------------------
5259 -- Find_Ada_Sources --
5260 ----------------------
5262 procedure Find_Ada_Sources
5263 (Project : Project_Id;
5264 In_Tree : Project_Tree_Ref;
5265 Data : in out Project_Data;
5266 Follow_Links : Boolean := False)
5268 Source_Dir : String_List_Id := Data.Source_Dirs;
5269 Element : String_Element;
5271 Current_Source : String_List_Id := Nil_String;
5272 Source_Recorded : Boolean := False;
5275 if Current_Verbosity = High then
5276 Write_Line ("Looking for sources:");
5279 -- For each subdirectory
5281 while Source_Dir /= Nil_String loop
5283 Source_Recorded := False;
5284 Element := In_Tree.String_Elements.Table (Source_Dir);
5285 if Element.Value /= No_Name then
5286 Get_Name_String (Element.Display_Value);
5289 Source_Directory : constant String :=
5290 Name_Buffer (1 .. Name_Len) & Directory_Separator;
5291 Dir_Last : constant Natural :=
5292 Compute_Directory_Last (Source_Directory);
5295 if Current_Verbosity = High then
5296 Write_Str ("Source_Dir = ");
5297 Write_Line (Source_Directory);
5300 -- We look at every entry in the source directory
5302 Open (Dir, Source_Directory
5303 (Source_Directory'First .. Dir_Last));
5306 Read (Dir, Name_Buffer, Name_Len);
5308 if Current_Verbosity = High then
5309 Write_Str (" Checking ");
5310 Write_Line (Name_Buffer (1 .. Name_Len));
5313 exit when Name_Len = 0;
5316 File_Name : constant File_Name_Type := Name_Find;
5317 Path : constant String :=
5319 (Name => Name_Buffer (1 .. Name_Len),
5320 Directory => Source_Directory
5321 (Source_Directory'First .. Dir_Last),
5322 Resolve_Links => Follow_Links,
5323 Case_Sensitive => True);
5324 Path_Name : Path_Name_Type;
5327 Name_Len := Path'Length;
5328 Name_Buffer (1 .. Name_Len) := Path;
5329 Path_Name := Name_Find;
5331 -- We attempt to register it as a source. However,
5332 -- there is no error if the file does not contain
5333 -- a valid source. But there is an error if we have
5334 -- a duplicate unit name.
5337 (File_Name => File_Name,
5338 Path_Name => Path_Name,
5342 Location => No_Location,
5343 Current_Source => Current_Source,
5344 Source_Recorded => Source_Recorded,
5345 Follow_Links => Follow_Links);
5354 when Directory_Error =>
5358 if Source_Recorded then
5359 In_Tree.String_Elements.Table (Source_Dir).Flag :=
5363 Source_Dir := Element.Next;
5366 if Current_Verbosity = High then
5367 Write_Line ("end Looking for sources.");
5370 -- If we have looked for sources and found none, then it is an error,
5371 -- except if it is an extending project. If a non extending project is
5372 -- not supposed to contain any source, then never call Find_Ada_Sources.
5374 if Current_Source = Nil_String and then
5375 Data.Extends = No_Project
5377 Report_No_Sources (Project, "Ada", In_Tree, Data.Location);
5379 end Find_Ada_Sources;
5385 procedure Find_Sources
5386 (Project : Project_Id;
5387 In_Tree : Project_Tree_Ref;
5388 Data : in out Project_Data;
5389 For_Language : Language_Index;
5390 Follow_Links : Boolean := False)
5392 Source_Dir : String_List_Id;
5393 Element : String_Element;
5395 Current_Source : String_List_Id := Nil_String;
5396 Source_Recorded : Boolean := False;
5399 if Current_Verbosity = High then
5400 Write_Line ("Looking for sources:");
5403 -- Loop through subdirectories
5405 Source_Dir := Data.Source_Dirs;
5406 while Source_Dir /= Nil_String loop
5408 Source_Recorded := False;
5409 Element := In_Tree.String_Elements.Table (Source_Dir);
5411 if Element.Value /= No_Name then
5412 Get_Name_String (Element.Display_Value);
5415 Source_Directory : constant String :=
5416 Name_Buffer (1 .. Name_Len) &
5417 Directory_Separator;
5419 Dir_Last : constant Natural :=
5420 Compute_Directory_Last (Source_Directory);
5423 if Current_Verbosity = High then
5424 Write_Str ("Source_Dir = ");
5425 Write_Line (Source_Directory);
5428 -- We look to every entry in the source directory
5430 Open (Dir, Source_Directory
5431 (Source_Directory'First .. Dir_Last));
5434 Read (Dir, Name_Buffer, Name_Len);
5436 if Current_Verbosity = High then
5437 Write_Str (" Checking ");
5438 Write_Line (Name_Buffer (1 .. Name_Len));
5441 exit when Name_Len = 0;
5444 File_Name : constant File_Name_Type := Name_Find;
5445 Path : constant String :=
5447 (Name => Name_Buffer (1 .. Name_Len),
5448 Directory => Source_Directory
5449 (Source_Directory'First .. Dir_Last),
5450 Resolve_Links => Follow_Links,
5451 Case_Sensitive => True);
5452 Path_Name : Path_Name_Type;
5455 Name_Len := Path'Length;
5456 Name_Buffer (1 .. Name_Len) := Path;
5457 Path_Name := Name_Find;
5459 if For_Language = Ada_Language_Index then
5461 -- We attempt to register it as a source. However,
5462 -- there is no error if the file does not contain
5463 -- a valid source. But there is an error if we have
5464 -- a duplicate unit name.
5467 (File_Name => File_Name,
5468 Path_Name => Path_Name,
5472 Location => No_Location,
5473 Current_Source => Current_Source,
5474 Source_Recorded => Source_Recorded,
5475 Follow_Links => Follow_Links);
5479 (File_Name => File_Name,
5480 Path_Name => Path_Name,
5484 Location => No_Location,
5485 Language => For_Language,
5487 Body_Suffix_Of (For_Language, Data, In_Tree),
5488 Naming_Exception => False);
5498 when Directory_Error =>
5502 if Source_Recorded then
5503 In_Tree.String_Elements.Table (Source_Dir).Flag :=
5507 Source_Dir := Element.Next;
5510 if Current_Verbosity = High then
5511 Write_Line ("end Looking for sources.");
5514 if For_Language = Ada_Language_Index then
5516 -- If we have looked for sources and found none, then it is an error,
5517 -- except if it is an extending project. If a non extending project
5518 -- is not supposed to contain any source files, then never call
5521 if Current_Source /= Nil_String then
5522 Data.Ada_Sources_Present := True;
5524 elsif Data.Extends = No_Project then
5525 Report_No_Sources (Project, "Ada", In_Tree, Data.Location);
5530 --------------------------------
5531 -- Free_Ada_Naming_Exceptions --
5532 --------------------------------
5534 procedure Free_Ada_Naming_Exceptions is
5536 Ada_Naming_Exception_Table.Set_Last (0);
5537 Ada_Naming_Exceptions.Reset;
5538 Reverse_Ada_Naming_Exceptions.Reset;
5539 end Free_Ada_Naming_Exceptions;
5541 ---------------------
5542 -- Get_Directories --
5543 ---------------------
5545 procedure Get_Directories
5546 (Project : Project_Id;
5547 In_Tree : Project_Tree_Ref;
5548 Data : in out Project_Data)
5550 Object_Dir : constant Variable_Value :=
5552 (Name_Object_Dir, Data.Decl.Attributes, In_Tree);
5554 Exec_Dir : constant Variable_Value :=
5556 (Name_Exec_Dir, Data.Decl.Attributes, In_Tree);
5558 Source_Dirs : constant Variable_Value :=
5560 (Name_Source_Dirs, Data.Decl.Attributes, In_Tree);
5562 Excluded_Source_Dirs : constant Variable_Value :=
5564 (Name_Excluded_Source_Dirs,
5565 Data.Decl.Attributes,
5568 Source_Files : constant Variable_Value :=
5570 (Name_Source_Files, Data.Decl.Attributes, In_Tree);
5572 Last_Source_Dir : String_List_Id := Nil_String;
5574 procedure Find_Source_Dirs
5575 (From : File_Name_Type;
5576 Location : Source_Ptr;
5577 Removed : Boolean := False);
5578 -- Find one or several source directories, and add (or remove, if
5579 -- Removed is True) them to list of source directories of the project.
5581 ----------------------
5582 -- Find_Source_Dirs --
5583 ----------------------
5585 procedure Find_Source_Dirs
5586 (From : File_Name_Type;
5587 Location : Source_Ptr;
5588 Removed : Boolean := False)
5590 Directory : constant String := Get_Name_String (From);
5591 Element : String_Element;
5593 procedure Recursive_Find_Dirs (Path : Name_Id);
5594 -- Find all the subdirectories (recursively) of Path and add them
5595 -- to the list of source directories of the project.
5597 -------------------------
5598 -- Recursive_Find_Dirs --
5599 -------------------------
5601 procedure Recursive_Find_Dirs (Path : Name_Id) is
5603 Name : String (1 .. 250);
5605 List : String_List_Id;
5606 Prev : String_List_Id;
5607 Element : String_Element;
5608 Found : Boolean := False;
5610 Non_Canonical_Path : Name_Id := No_Name;
5611 Canonical_Path : Name_Id := No_Name;
5613 The_Path : constant String :=
5614 Normalize_Pathname (Get_Name_String (Path)) &
5615 Directory_Separator;
5617 The_Path_Last : constant Natural :=
5618 Compute_Directory_Last (The_Path);
5621 Name_Len := The_Path_Last - The_Path'First + 1;
5622 Name_Buffer (1 .. Name_Len) :=
5623 The_Path (The_Path'First .. The_Path_Last);
5624 Non_Canonical_Path := Name_Find;
5625 Get_Name_String (Non_Canonical_Path);
5626 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
5627 Canonical_Path := Name_Find;
5629 -- To avoid processing the same directory several times, check
5630 -- if the directory is already in Recursive_Dirs. If it is, then
5631 -- there is nothing to do, just return. If it is not, put it there
5632 -- and continue recursive processing.
5635 if Recursive_Dirs.Get (Canonical_Path) then
5638 Recursive_Dirs.Set (Canonical_Path, True);
5642 -- Check if directory is already in list
5644 List := Data.Source_Dirs;
5646 while List /= Nil_String loop
5647 Element := In_Tree.String_Elements.Table (List);
5649 if Element.Value /= No_Name then
5650 Found := Element.Value = Canonical_Path;
5655 List := Element.Next;
5658 -- If directory is not already in list, put it there
5660 if (not Removed) and (not Found) then
5661 if Current_Verbosity = High then
5663 Write_Line (The_Path (The_Path'First .. The_Path_Last));
5666 String_Element_Table.Increment_Last
5667 (In_Tree.String_Elements);
5669 (Value => Canonical_Path,
5670 Display_Value => Non_Canonical_Path,
5671 Location => No_Location,
5676 -- Case of first source directory
5678 if Last_Source_Dir = Nil_String then
5679 Data.Source_Dirs := String_Element_Table.Last
5680 (In_Tree.String_Elements);
5682 -- Here we already have source directories
5685 -- Link the previous last to the new one
5687 In_Tree.String_Elements.Table
5688 (Last_Source_Dir).Next :=
5689 String_Element_Table.Last
5690 (In_Tree.String_Elements);
5693 -- And register this source directory as the new last
5695 Last_Source_Dir := String_Element_Table.Last
5696 (In_Tree.String_Elements);
5697 In_Tree.String_Elements.Table (Last_Source_Dir) :=
5700 elsif Removed and Found then
5701 if Prev = Nil_String then
5703 In_Tree.String_Elements.Table (List).Next;
5705 In_Tree.String_Elements.Table (Prev).Next :=
5706 In_Tree.String_Elements.Table (List).Next;
5710 -- Now look for subdirectories. We do that even when this
5711 -- directory is already in the list, because some of its
5712 -- subdirectories may not be in the list yet.
5714 Open (Dir, The_Path (The_Path'First .. The_Path_Last));
5717 Read (Dir, Name, Last);
5720 if Name (1 .. Last) /= "."
5721 and then Name (1 .. Last) /= ".."
5723 -- Avoid . and .. directories
5725 if Current_Verbosity = High then
5726 Write_Str (" Checking ");
5727 Write_Line (Name (1 .. Last));
5731 Path_Name : constant String :=
5733 (Name => Name (1 .. Last),
5736 (The_Path'First .. The_Path_Last),
5737 Resolve_Links => False,
5738 Case_Sensitive => True);
5741 if Is_Directory (Path_Name) then
5743 -- We have found a new subdirectory, call self
5745 Name_Len := Path_Name'Length;
5746 Name_Buffer (1 .. Name_Len) := Path_Name;
5747 Recursive_Find_Dirs (Name_Find);
5756 when Directory_Error =>
5758 end Recursive_Find_Dirs;
5760 -- Start of processing for Find_Source_Dirs
5763 if Current_Verbosity = High and then not Removed then
5764 Write_Str ("Find_Source_Dirs (""");
5765 Write_Str (Directory);
5769 -- First, check if we are looking for a directory tree, indicated
5770 -- by "/**" at the end.
5772 if Directory'Length >= 3
5773 and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
5774 and then (Directory (Directory'Last - 2) = '/'
5776 Directory (Directory'Last - 2) = Directory_Separator)
5779 Data.Known_Order_Of_Source_Dirs := False;
5782 Name_Len := Directory'Length - 3;
5784 if Name_Len = 0 then
5786 -- Case of "/**": all directories in file system
5789 Name_Buffer (1) := Directory (Directory'First);
5792 Name_Buffer (1 .. Name_Len) :=
5793 Directory (Directory'First .. Directory'Last - 3);
5796 if Current_Verbosity = High then
5797 Write_Str ("Looking for all subdirectories of """);
5798 Write_Str (Name_Buffer (1 .. Name_Len));
5803 Base_Dir : constant File_Name_Type := Name_Find;
5804 Root_Dir : constant String :=
5806 (Name => Get_Name_String (Base_Dir),
5808 Get_Name_String (Data.Display_Directory),
5809 Resolve_Links => False,
5810 Case_Sensitive => True);
5813 if Root_Dir'Length = 0 then
5814 Err_Vars.Error_Msg_File_1 := Base_Dir;
5816 if Location = No_Location then
5819 "{ is not a valid directory.",
5824 "{ is not a valid directory.",
5829 -- We have an existing directory, we register it and all of
5830 -- its subdirectories.
5832 if Current_Verbosity = High then
5833 Write_Line ("Looking for source directories:");
5836 Name_Len := Root_Dir'Length;
5837 Name_Buffer (1 .. Name_Len) := Root_Dir;
5838 Recursive_Find_Dirs (Name_Find);
5840 if Current_Verbosity = High then
5841 Write_Line ("End of looking for source directories.");
5846 -- We have a single directory
5850 Path_Name : Path_Name_Type;
5851 Display_Path_Name : Path_Name_Type;
5852 List : String_List_Id;
5853 Prev : String_List_Id;
5860 Data.Display_Directory,
5864 if Path_Name = No_Path then
5865 Err_Vars.Error_Msg_File_1 := From;
5867 if Location = No_Location then
5870 "{ is not a valid directory",
5875 "{ is not a valid directory",
5881 Path : constant String :=
5882 Get_Name_String (Path_Name) &
5883 Directory_Separator;
5884 Last_Path : constant Natural :=
5885 Compute_Directory_Last (Path);
5887 Display_Path : constant String :=
5889 (Display_Path_Name) &
5890 Directory_Separator;
5891 Last_Display_Path : constant Natural :=
5892 Compute_Directory_Last
5894 Display_Path_Id : Name_Id;
5898 Add_Str_To_Name_Buffer (Path (Path'First .. Last_Path));
5899 Path_Id := Name_Find;
5901 Add_Str_To_Name_Buffer
5903 (Display_Path'First .. Last_Display_Path));
5904 Display_Path_Id := Name_Find;
5908 -- As it is an existing directory, we add it to the
5909 -- list of directories.
5911 String_Element_Table.Increment_Last
5912 (In_Tree.String_Elements);
5916 Display_Value => Display_Path_Id,
5917 Location => No_Location,
5919 Next => Nil_String);
5921 if Last_Source_Dir = Nil_String then
5923 -- This is the first source directory
5925 Data.Source_Dirs := String_Element_Table.Last
5926 (In_Tree.String_Elements);
5929 -- We already have source directories, link the
5930 -- previous last to the new one.
5932 In_Tree.String_Elements.Table
5933 (Last_Source_Dir).Next :=
5934 String_Element_Table.Last
5935 (In_Tree.String_Elements);
5938 -- And register this source directory as the new last
5940 Last_Source_Dir := String_Element_Table.Last
5941 (In_Tree.String_Elements);
5942 In_Tree.String_Elements.Table
5943 (Last_Source_Dir) := Element;
5946 -- Remove source dir, if present
5948 List := Data.Source_Dirs;
5951 -- Look for source dir in current list
5953 while List /= Nil_String loop
5954 Element := In_Tree.String_Elements.Table (List);
5955 exit when Element.Value = Path_Id;
5957 List := Element.Next;
5960 if List /= Nil_String then
5961 -- Source dir was found, remove it from the list
5963 if Prev = Nil_String then
5965 In_Tree.String_Elements.Table (List).Next;
5968 In_Tree.String_Elements.Table (Prev).Next :=
5969 In_Tree.String_Elements.Table (List).Next;
5977 end Find_Source_Dirs;
5979 -- Start of processing for Get_Directories
5982 if Current_Verbosity = High then
5983 Write_Line ("Starting to look for directories");
5986 -- Check the object directory
5988 pragma Assert (Object_Dir.Kind = Single,
5989 "Object_Dir is not a single string");
5991 -- We set the object directory to its default
5993 Data.Object_Directory := Data.Directory;
5994 Data.Display_Object_Dir := Data.Display_Directory;
5996 if Object_Dir.Value /= Empty_String then
5997 Get_Name_String (Object_Dir.Value);
5999 if Name_Len = 0 then
6002 "Object_Dir cannot be empty",
6003 Object_Dir.Location);
6006 -- We check that the specified object directory does exist
6011 File_Name_Type (Object_Dir.Value),
6012 Data.Display_Directory,
6013 Data.Object_Directory,
6014 Data.Display_Object_Dir,
6016 Location => Object_Dir.Location);
6018 if Data.Object_Directory = No_Path then
6020 -- The object directory does not exist, report an error if the
6021 -- project is not externally built.
6023 if not Data.Externally_Built then
6024 Err_Vars.Error_Msg_File_1 :=
6025 File_Name_Type (Object_Dir.Value);
6028 "the object directory { cannot be found",
6032 -- Do not keep a nil Object_Directory. Set it to the specified
6033 -- (relative or absolute) path. This is for the benefit of
6034 -- tools that recover from errors; for example, these tools
6035 -- could create the non existent directory.
6037 Data.Display_Object_Dir := Path_Name_Type (Object_Dir.Value);
6038 Get_Name_String (Object_Dir.Value);
6039 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6040 Data.Object_Directory := Name_Find;
6045 if Current_Verbosity = High then
6046 if Data.Object_Directory = No_Path then
6047 Write_Line ("No object directory");
6049 Write_Str ("Object directory: """);
6050 Write_Str (Get_Name_String (Data.Display_Object_Dir));
6055 -- Check the exec directory
6057 pragma Assert (Exec_Dir.Kind = Single,
6058 "Exec_Dir is not a single string");
6060 -- We set the object directory to its default
6062 Data.Exec_Directory := Data.Object_Directory;
6063 Data.Display_Exec_Dir := Data.Display_Object_Dir;
6065 if Exec_Dir.Value /= Empty_String then
6066 Get_Name_String (Exec_Dir.Value);
6068 if Name_Len = 0 then
6071 "Exec_Dir cannot be empty",
6075 -- We check that the specified object directory does exist
6080 File_Name_Type (Exec_Dir.Value),
6081 Data.Display_Directory,
6082 Data.Exec_Directory,
6083 Data.Display_Exec_Dir,
6085 Location => Exec_Dir.Location);
6087 if Data.Exec_Directory = No_Path then
6088 Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
6091 "the exec directory { cannot be found",
6097 if Current_Verbosity = High then
6098 if Data.Exec_Directory = No_Path then
6099 Write_Line ("No exec directory");
6101 Write_Str ("Exec directory: """);
6102 Write_Str (Get_Name_String (Data.Display_Exec_Dir));
6107 -- Look for the source directories
6109 if Current_Verbosity = High then
6110 Write_Line ("Starting to look for source directories");
6113 pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
6115 if (not Source_Files.Default) and then
6116 Source_Files.Values = Nil_String
6118 Data.Source_Dirs := Nil_String;
6120 if Data.Extends = No_Project
6121 and then Data.Object_Directory = Data.Directory
6123 Data.Object_Directory := No_Path;
6126 elsif Source_Dirs.Default then
6128 -- No Source_Dirs specified: the single source directory is the one
6129 -- containing the project file
6131 String_Element_Table.Increment_Last
6132 (In_Tree.String_Elements);
6133 Data.Source_Dirs := String_Element_Table.Last
6134 (In_Tree.String_Elements);
6135 In_Tree.String_Elements.Table (Data.Source_Dirs) :=
6136 (Value => Name_Id (Data.Directory),
6137 Display_Value => Name_Id (Data.Display_Directory),
6138 Location => No_Location,
6143 if Current_Verbosity = High then
6144 Write_Line ("Single source directory:");
6146 Write_Str (Get_Name_String (Data.Display_Directory));
6150 elsif Source_Dirs.Values = Nil_String then
6152 -- If Source_Dirs is an empty string list, this means that this
6153 -- project contains no source. For projects that don't extend other
6154 -- projects, this also means that there is no need for an object
6155 -- directory, if not specified.
6157 if Data.Extends = No_Project
6158 and then Data.Object_Directory = Data.Directory
6160 Data.Object_Directory := No_Path;
6163 Data.Source_Dirs := Nil_String;
6167 Source_Dir : String_List_Id;
6168 Element : String_Element;
6171 -- Process the source directories for each element of the list
6173 Source_Dir := Source_Dirs.Values;
6174 while Source_Dir /= Nil_String loop
6176 In_Tree.String_Elements.Table (Source_Dir);
6178 (File_Name_Type (Element.Value), Element.Location);
6179 Source_Dir := Element.Next;
6184 if not Excluded_Source_Dirs.Default
6185 and then Excluded_Source_Dirs.Values /= Nil_String
6188 Source_Dir : String_List_Id;
6189 Element : String_Element;
6192 -- Process the source directories for each element of the list
6194 Source_Dir := Excluded_Source_Dirs.Values;
6195 while Source_Dir /= Nil_String loop
6197 In_Tree.String_Elements.Table (Source_Dir);
6199 (File_Name_Type (Element.Value),
6202 Source_Dir := Element.Next;
6207 if Current_Verbosity = High then
6208 Write_Line ("Putting source directories in canonical cases");
6212 Current : String_List_Id := Data.Source_Dirs;
6213 Element : String_Element;
6216 while Current /= Nil_String loop
6217 Element := In_Tree.String_Elements.Table (Current);
6218 if Element.Value /= No_Name then
6219 Get_Name_String (Element.Value);
6220 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6221 Element.Value := Name_Find;
6222 In_Tree.String_Elements.Table (Current) := Element;
6225 Current := Element.Next;
6229 end Get_Directories;
6236 (Project : Project_Id;
6237 In_Tree : Project_Tree_Ref;
6238 Data : in out Project_Data)
6240 Mains : constant Variable_Value :=
6241 Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes, In_Tree);
6244 Data.Mains := Mains.Values;
6246 -- If no Mains were specified, and if we are an extending project,
6247 -- inherit the Mains from the project we are extending.
6249 if Mains.Default then
6250 if Data.Extends /= No_Project then
6252 In_Tree.Projects.Table (Data.Extends).Mains;
6255 -- In a library project file, Main cannot be specified
6257 elsif Data.Library then
6260 "a library project file cannot have Main specified",
6265 ---------------------------
6266 -- Get_Sources_From_File --
6267 ---------------------------
6269 procedure Get_Sources_From_File
6271 Location : Source_Ptr;
6272 Project : Project_Id;
6273 In_Tree : Project_Tree_Ref)
6275 File : Prj.Util.Text_File;
6276 Line : String (1 .. 250);
6278 Source_Name : File_Name_Type;
6279 Name_Loc : Name_Location;
6282 if Get_Mode = Ada_Only then
6286 if Current_Verbosity = High then
6287 Write_Str ("Opening """);
6294 Prj.Util.Open (File, Path);
6296 if not Prj.Util.Is_Valid (File) then
6297 Error_Msg (Project, In_Tree, "file does not exist", Location);
6299 -- Read the lines one by one
6301 while not Prj.Util.End_Of_File (File) loop
6302 Prj.Util.Get_Line (File, Line, Last);
6304 -- A non empty, non comment line should contain a file name
6307 and then (Last = 1 or else Line (1 .. 2) /= "--")
6309 -- ??? we should check that there is no directory information
6312 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6313 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6314 Source_Name := Name_Find;
6315 Name_Loc := Source_Names.Get (Source_Name);
6317 if Name_Loc = No_Name_Location then
6319 (Name => Source_Name,
6320 Location => Location,
6321 Source => No_Source,
6326 Source_Names.Set (Source_Name, Name_Loc);
6330 Prj.Util.Close (File);
6333 end Get_Sources_From_File;
6340 (In_Tree : Project_Tree_Ref;
6341 Canonical_File_Name : File_Name_Type;
6342 Naming : Naming_Data;
6343 Exception_Id : out Ada_Naming_Exception_Id;
6344 Unit_Name : out Name_Id;
6345 Unit_Kind : out Spec_Or_Body;
6346 Needs_Pragma : out Boolean)
6348 Info_Id : Ada_Naming_Exception_Id :=
6349 Ada_Naming_Exceptions.Get (Canonical_File_Name);
6350 VMS_Name : File_Name_Type;
6353 if Info_Id = No_Ada_Naming_Exception then
6354 if Hostparm.OpenVMS then
6355 VMS_Name := Canonical_File_Name;
6356 Get_Name_String (VMS_Name);
6358 if Name_Buffer (Name_Len) = '.' then
6359 Name_Len := Name_Len - 1;
6360 VMS_Name := Name_Find;
6363 Info_Id := Ada_Naming_Exceptions.Get (VMS_Name);
6368 if Info_Id /= No_Ada_Naming_Exception then
6369 Exception_Id := Info_Id;
6370 Unit_Name := No_Name;
6371 Unit_Kind := Specification;
6372 Needs_Pragma := True;
6376 Needs_Pragma := False;
6377 Exception_Id := No_Ada_Naming_Exception;
6379 Get_Name_String (Canonical_File_Name);
6382 File : String := Name_Buffer (1 .. Name_Len);
6383 First : constant Positive := File'First;
6384 Last : Natural := File'Last;
6385 Standard_GNAT : Boolean;
6389 Spec_Suffix_Id_Of (In_Tree, "ada", Naming) = Default_Ada_Spec_Suffix
6391 Body_Suffix_Id_Of (In_Tree, "ada", Naming) = Default_Ada_Body_Suffix;
6393 -- Check if the end of the file name is Specification_Append
6395 Get_Name_String (Spec_Suffix_Id_Of (In_Tree, "ada", Naming));
6397 if File'Length > Name_Len
6398 and then File (Last - Name_Len + 1 .. Last) =
6399 Name_Buffer (1 .. Name_Len)
6403 Unit_Kind := Specification;
6404 Last := Last - Name_Len;
6406 if Current_Verbosity = High then
6407 Write_Str (" Specification: ");
6408 Write_Line (File (First .. Last));
6412 Get_Name_String (Body_Suffix_Id_Of (In_Tree, "ada", Naming));
6414 -- Check if the end of the file name is Body_Append
6416 if File'Length > Name_Len
6417 and then File (Last - Name_Len + 1 .. Last) =
6418 Name_Buffer (1 .. Name_Len)
6422 Unit_Kind := Body_Part;
6423 Last := Last - Name_Len;
6425 if Current_Verbosity = High then
6426 Write_Str (" Body: ");
6427 Write_Line (File (First .. Last));
6430 elsif Naming.Separate_Suffix /=
6431 Body_Suffix_Id_Of (In_Tree, "ada", Naming)
6433 Get_Name_String (Naming.Separate_Suffix);
6435 -- Check if the end of the file name is Separate_Append
6437 if File'Length > Name_Len
6438 and then File (Last - Name_Len + 1 .. Last) =
6439 Name_Buffer (1 .. Name_Len)
6441 -- We have a separate (a body)
6443 Unit_Kind := Body_Part;
6444 Last := Last - Name_Len;
6446 if Current_Verbosity = High then
6447 Write_Str (" Separate: ");
6448 Write_Line (File (First .. Last));
6462 -- This is not a source file
6464 Unit_Name := No_Name;
6465 Unit_Kind := Specification;
6467 if Current_Verbosity = High then
6468 Write_Line (" Not a valid file name.");
6474 Get_Name_String (Naming.Dot_Replacement);
6476 Standard_GNAT and then Name_Buffer (1 .. Name_Len) = "-";
6478 if Name_Buffer (1 .. Name_Len) /= "." then
6480 -- If Dot_Replacement is not a single dot, then there should not
6481 -- be any dot in the name.
6483 for Index in First .. Last loop
6484 if File (Index) = '.' then
6485 if Current_Verbosity = High then
6487 (" Not a valid file name (some dot not replaced).");
6490 Unit_Name := No_Name;
6496 -- Replace the substring Dot_Replacement with dots
6499 Index : Positive := First;
6502 while Index <= Last - Name_Len + 1 loop
6504 if File (Index .. Index + Name_Len - 1) =
6505 Name_Buffer (1 .. Name_Len)
6507 File (Index) := '.';
6509 if Name_Len > 1 and then Index < Last then
6510 File (Index + 1 .. Last - Name_Len + 1) :=
6511 File (Index + Name_Len .. Last);
6514 Last := Last - Name_Len + 1;
6522 -- Check if the casing is right
6525 Src : String := File (First .. Last);
6526 Src_Last : Positive := Last;
6529 case Naming.Casing is
6530 when All_Lower_Case =>
6533 Mapping => Lower_Case_Map);
6535 when All_Upper_Case =>
6538 Mapping => Upper_Case_Map);
6540 when Mixed_Case | Unknown =>
6544 if Src /= File (First .. Last) then
6545 if Current_Verbosity = High then
6546 Write_Line (" Not a valid file name (casing).");
6549 Unit_Name := No_Name;
6553 -- We put the name in lower case
6557 Mapping => Lower_Case_Map);
6559 -- In the standard GNAT naming scheme, check for special cases:
6560 -- children or separates of A, G, I or S, and run time sources.
6562 if Standard_GNAT and then Src'Length >= 3 then
6564 S1 : constant Character := Src (Src'First);
6565 S2 : constant Character := Src (Src'First + 1);
6566 S3 : constant Character := Src (Src'First + 2);
6574 -- Children or separates of packages A, G, I or S. These
6575 -- names are x__ ... or x~... (where x is a, g, i, or s).
6576 -- Both versions (x__... and x~...) are allowed in all
6577 -- platforms, because it is not possible to know the
6578 -- platform before processing of the project files.
6580 if S2 = '_
' and then S3 = '_
' then
6581 Src (Src'First + 1) := '.';
6582 Src_Last := Src_Last - 1;
6583 Src (Src'First + 2 .. Src_Last) :=
6584 Src (Src'First + 3 .. Src_Last + 1);
6587 Src (Src'First + 1) := '.';
6589 -- If it is potentially a run time source, disable
6590 -- filling of the mapping file to avoid warnings.
6593 Set_Mapping_File_Initial_State_To_Empty;
6599 if Current_Verbosity = High then
6601 Write_Line (Src (Src'First .. Src_Last));
6604 -- Now, we check if this name is a valid unit name
6607 (Name => Src (Src'First .. Src_Last), Unit => Unit_Name);
6617 function Hash (Unit : Unit_Info) return Header_Num is
6619 return Header_Num (Unit.Unit mod 2048);
6622 -----------------------
6623 -- Is_Illegal_Suffix --
6624 -----------------------
6626 function Is_Illegal_Suffix
6628 Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean
6631 if Suffix'Length = 0 or else Index (Suffix, ".") = 0 then
6635 -- If dot replacement is a single dot, and first character of suffix is
6638 if Dot_Replacement_Is_A_Single_Dot
6639 and then Suffix (Suffix'First) = '.'
6641 for Index in Suffix'First + 1 .. Suffix'Last loop
6643 -- If there is another dot
6645 if Suffix (Index) = '.' then
6647 -- It is illegal to have a letter following the initial dot
6649 return Is_Letter (Suffix (Suffix'First + 1));
6657 end Is_Illegal_Suffix;
6659 ----------------------
6660 -- Locate_Directory --
6661 ----------------------
6663 procedure Locate_Directory
6664 (Project : Project_Id;
6665 In_Tree : Project_Tree_Ref;
6666 Name : File_Name_Type;
6667 Parent : Path_Name_Type;
6668 Dir : out Path_Name_Type;
6669 Display : out Path_Name_Type;
6670 Create : String := "";
6671 Location : Source_Ptr := No_Location)
6673 The_Name : String := Get_Name_String (Name);
6675 The_Parent : constant String :=
6676 Get_Name_String (Parent) & Directory_Separator;
6678 The_Parent_Last : constant Natural :=
6679 Compute_Directory_Last (The_Parent);
6681 Full_Name : File_Name_Type;
6684 -- Convert '/' to directory separator (for Windows)
6686 for J in The_Name'Range loop
6687 if The_Name (J) = '/' then
6688 The_Name (J) := Directory_Separator;
6692 if Current_Verbosity = High then
6693 Write_Str ("Locate_Directory (""");
6694 Write_Str (The_Name);
6695 Write_Str (""", """);
6696 Write_Str (The_Parent);
6703 if Is_Absolute_Path (The_Name) then
6708 Add_Str_To_Name_Buffer
6709 (The_Parent (The_Parent'First .. The_Parent_Last));
6710 Add_Str_To_Name_Buffer (The_Name);
6711 Full_Name := Name_Find;
6715 Full_Path_Name : constant String := Get_Name_String (Full_Name);
6718 if Setup_Projects and then Create'Length > 0
6719 and then not Is_Directory (Full_Path_Name)
6722 Create_Path (Full_Path_Name);
6724 if not Quiet_Output then
6726 Write_Str (" directory """);
6727 Write_Str (Full_Path_Name);
6728 Write_Line (""" created");
6735 "could not create " & Create &
6736 " directory " & Full_Path_Name,
6741 if Is_Directory (Full_Path_Name) then
6743 Normed : constant String :=
6746 Resolve_Links => False,
6747 Case_Sensitive => True);
6749 Canonical_Path : constant String :=
6752 Resolve_Links => True,
6753 Case_Sensitive => False);
6756 Name_Len := Normed'Length;
6757 Name_Buffer (1 .. Name_Len) := Normed;
6758 Display := Name_Find;
6760 Name_Len := Canonical_Path'Length;
6761 Name_Buffer (1 .. Name_Len) := Canonical_Path;
6766 end Locate_Directory;
6768 ----------------------
6769 -- Look_For_Sources --
6770 ----------------------
6772 procedure Look_For_Sources
6773 (Project : Project_Id;
6774 In_Tree : Project_Tree_Ref;
6775 Data : in out Project_Data;
6776 Follow_Links : Boolean)
6778 procedure Get_Path_Names_And_Record_Sources (Follow_Links : Boolean);
6779 -- Find the path names of the source files in the Source_Names table
6780 -- in the source directories and record those that are Ada sources.
6782 procedure Get_Sources_From_File
6784 Location : Source_Ptr);
6785 -- Get the sources of a project from a text file
6787 procedure Search_Directories (For_All_Sources : Boolean);
6788 -- Search the source directories to find the sources.
6789 -- If For_All_Sources is True, check each regular file name against
6790 -- the naming schemes of the different languages. Otherwise consider
6791 -- only the file names in the hash table Source_Names.
6793 ---------------------------------------
6794 -- Get_Path_Names_And_Record_Sources --
6795 ---------------------------------------
6797 procedure Get_Path_Names_And_Record_Sources (Follow_Links : Boolean) is
6798 Source_Dir : String_List_Id := Data.Source_Dirs;
6799 Element : String_Element;
6800 Path : Path_Name_Type;
6803 Name : File_Name_Type;
6804 Canonical_Name : File_Name_Type;
6805 Name_Str : String (1 .. 1_024);
6806 Last : Natural := 0;
6808 Current_Source : String_List_Id := Nil_String;
6809 First_Error : Boolean := True;
6810 Source_Recorded : Boolean := False;
6813 -- We look in all source directories for the file names in the
6814 -- hash table Source_Names
6816 while Source_Dir /= Nil_String loop
6817 Source_Recorded := False;
6818 Element := In_Tree.String_Elements.Table (Source_Dir);
6821 Dir_Path : constant String :=
6822 Get_Name_String (Element.Display_Value);
6824 if Current_Verbosity = High then
6825 Write_Str ("checking directory """);
6826 Write_Str (Dir_Path);
6830 Open (Dir, Dir_Path);
6833 Read (Dir, Name_Str, Last);
6837 Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
6840 Canonical_Case_File_Name (Name_Str (1 .. Last));
6841 Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
6842 Canonical_Name := Name_Find;
6844 NL := Source_Names.Get (Canonical_Name);
6846 if NL /= No_Name_Location and then not NL.Found then
6848 Source_Names.Set (Canonical_Name, NL);
6849 Name_Len := Dir_Path'Length;
6850 Name_Buffer (1 .. Name_Len) := Dir_Path;
6852 if Name_Buffer (Name_Len) /= Directory_Separator then
6853 Add_Char_To_Name_Buffer (Directory_Separator);
6856 Add_Str_To_Name_Buffer (Name_Str (1 .. Last));
6859 if Current_Verbosity = High then
6860 Write_Str (" found ");
6861 Write_Line (Get_Name_String (Name));
6864 -- Register the source if it is an Ada compilation unit
6872 Location => NL.Location,
6873 Current_Source => Current_Source,
6874 Source_Recorded => Source_Recorded,
6875 Follow_Links => Follow_Links);
6882 if Source_Recorded then
6883 In_Tree.String_Elements.Table (Source_Dir).Flag :=
6887 Source_Dir := Element.Next;
6890 -- It is an error if a source file name in a source list or
6891 -- in a source list file is not found.
6893 NL := Source_Names.Get_First;
6894 while NL /= No_Name_Location loop
6895 if not NL.Found then
6896 Err_Vars.Error_Msg_File_1 := NL.Name;
6901 "source file { cannot be found",
6903 First_Error := False;
6908 "\source file { cannot be found",
6913 NL := Source_Names.Get_Next;
6915 end Get_Path_Names_And_Record_Sources;
6917 ---------------------------
6918 -- Get_Sources_From_File --
6919 ---------------------------
6921 procedure Get_Sources_From_File
6923 Location : Source_Ptr)
6926 -- Get the list of sources from the file and put them in hash table
6929 Get_Sources_From_File (Path, Location, Project, In_Tree);
6931 if Get_Mode = Ada_Only then
6932 -- Look in the source directories to find those sources
6934 Get_Path_Names_And_Record_Sources (Follow_Links);
6936 -- We should have found at least one source.
6937 -- If not, report an error.
6939 if Data.Ada_Sources = Nil_String then
6940 Report_No_Sources (Project, "Ada", In_Tree, Location);
6946 end Get_Sources_From_File;
6948 ------------------------
6949 -- Search_Directories --
6950 ------------------------
6952 procedure Search_Directories (For_All_Sources : Boolean) is
6953 Source_Dir : String_List_Id;
6954 Element : String_Element;
6956 Name : String (1 .. 1_000);
6959 File_Name : File_Name_Type;
6960 Display_File_Name : File_Name_Type;
6962 Source_To_Replace : Source_Id := No_Source;
6963 Src_Data : Source_Data;
6965 Name_Loc : Name_Location;
6966 Check_Name : Boolean;
6968 Language : Language_Index;
6969 Language_Name : Name_Id;
6970 Display_Language_Name : Name_Id;
6972 Kind : Source_Kind := Spec;
6973 Alternate_Languages : Alternate_Language_Id :=
6974 No_Alternate_Language;
6978 procedure Check_Naming_Schemes;
6979 -- Check if the file name File_Name conforms to one of the naming
6980 -- schemes of the project. If it does, set the global variables
6981 -- Language, Language_Name, Display_Language_Name, Unit and Kind
6982 -- appropriately. If it does not, set Language to No_Language_Index.
6984 --------------------------
6985 -- Check_Naming_Schemes --
6986 --------------------------
6988 procedure Check_Naming_Schemes is
6989 Filename : constant String := Get_Name_String (File_Name);
6990 Last : Positive := Filename'Last;
6991 Config : Language_Config;
6992 Lang : Name_List_Index;
6994 Header_File : Boolean := False;
6995 First_Language : Language_Index;
7000 Lang := Data.Languages;
7001 while Lang /= No_Name_List loop
7002 Language_Name := In_Tree.Name_Lists.Table (Lang).Name;
7004 Language := Data.First_Language_Processing;
7005 while Language /= No_Language_Index loop
7006 if In_Tree.Languages_Data.Table (Language).Name =
7009 Display_Language_Name :=
7010 In_Tree.Languages_Data.Table (Language).Display_Name;
7011 Config := In_Tree.Languages_Data.Table (Language).Config;
7013 if Config.Kind = File_Based then
7015 -- For file based languages, there is no Unit. Just
7016 -- check if the file name has the implementation or,
7017 -- if it is specified, the template suffix of the
7022 if not Header_File and then
7023 Config.Naming_Data.Body_Suffix /= No_File
7026 Impl_Suffix : constant String :=
7028 (Config.Naming_Data.Body_Suffix);
7031 if Filename'Length > Impl_Suffix'Length
7034 (Last - Impl_Suffix'Length + 1 .. Last) =
7039 if Current_Verbosity = High then
7040 Write_Str (" source of language ");
7043 (Display_Language_Name));
7051 if Config.Naming_Data.Spec_Suffix /= No_File then
7053 Spec_Suffix : constant String :=
7055 (Config.Naming_Data.Spec_Suffix);
7058 if Filename'Length > Spec_Suffix'Length
7061 (Last - Spec_Suffix'Length + 1 .. Last) =
7066 if Current_Verbosity = High then
7068 (" header file of language ");
7071 (Display_Language_Name));
7075 Alternate_Language_Table.Increment_Last
7076 (In_Tree.Alt_Langs);
7077 In_Tree.Alt_Langs.Table
7078 (Alternate_Language_Table.Last
7079 (In_Tree.Alt_Langs)) :=
7080 (Language => Language,
7081 Next => Alternate_Languages);
7082 Alternate_Languages :=
7083 Alternate_Language_Table.Last
7084 (In_Tree.Alt_Langs);
7086 Header_File := True;
7087 First_Language := Language;
7093 elsif not Header_File then
7095 -- Unit based language
7097 OK := Config.Naming_Data.Dot_Replacement /= No_File;
7103 case Config.Naming_Data.Casing is
7104 when All_Lower_Case =>
7105 for J in Filename'Range loop
7106 if Is_Letter (Filename (J)) then
7107 if not Is_Lower (Filename (J)) then
7114 when All_Upper_Case =>
7115 for J in Filename'Range loop
7116 if Is_Letter (Filename (J)) then
7117 if not Is_Upper (Filename (J)) then
7132 if Config.Naming_Data.Separate_Suffix /= No_File
7134 Config.Naming_Data.Separate_Suffix /=
7135 Config.Naming_Data.Body_Suffix
7138 Suffix : constant String :=
7140 (Config.Naming_Data.Separate_Suffix);
7142 if Filename'Length > Suffix'Length
7145 (Last - Suffix'Length + 1 .. Last) =
7149 Last := Last - Suffix'Length;
7156 Config.Naming_Data.Body_Suffix /= No_File
7159 Suffix : constant String :=
7161 (Config.Naming_Data.Body_Suffix);
7163 if Filename'Length > Suffix'Length
7166 (Last - Suffix'Length + 1 .. Last) =
7170 Last := Last - Suffix'Length;
7177 Config.Naming_Data.Spec_Suffix /= No_File
7180 Suffix : constant String :=
7182 (Config.Naming_Data.Spec_Suffix);
7184 if Filename'Length > Suffix'Length
7187 (Last - Suffix'Length + 1 .. Last) =
7191 Last := Last - Suffix'Length;
7200 -- Replace dot replacements with dots
7205 J : Positive := Filename'First;
7207 Dot_Replacement : constant String :=
7209 (Config.Naming_Data.
7212 Max : constant Positive :=
7213 Last - Dot_Replacement'Length + 1;
7217 Name_Len := Name_Len + 1;
7219 if J <= Max and then
7221 (J .. J + Dot_Replacement'Length - 1) =
7224 Name_Buffer (Name_Len) := '.';
7225 J := J + Dot_Replacement'Length;
7228 if Filename (J) = '.' then
7233 Name_Buffer (Name_Len) :=
7234 GNAT.Case_Util.To_Lower (Filename (J));
7245 -- The name buffer should contain the name of the
7246 -- the unit, if it is one.
7248 -- Check that this is a valid unit name
7250 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
7252 if Unit /= No_Name then
7254 if Current_Verbosity = High then
7256 Write_Str (" spec of ");
7259 Write_Str (" body of ");
7262 Write_Str (Get_Name_String (Unit));
7263 Write_Str (" (language ");
7265 (Get_Name_String (Display_Language_Name));
7275 Language := In_Tree.Languages_Data.Table (Language).Next;
7278 Lang := In_Tree.Name_Lists.Table (Lang).Next;
7282 Language := First_Language;
7285 Language := No_Language_Index;
7287 if Current_Verbosity = High then
7288 Write_Line (" not a source of any language");
7291 end Check_Naming_Schemes;
7293 -- Start of processing for Search_Directories
7296 if Current_Verbosity = High then
7297 Write_Line ("Looking for sources:");
7300 -- Loop through subdirectories
7302 Source_Dir := Data.Source_Dirs;
7303 while Source_Dir /= Nil_String loop
7305 Element := In_Tree.String_Elements.Table (Source_Dir);
7306 if Element.Value /= No_Name then
7307 Get_Name_String (Element.Display_Value);
7310 Source_Directory : constant String :=
7311 Name_Buffer (1 .. Name_Len) &
7312 Directory_Separator;
7313 Dir_Last : constant Natural :=
7314 Compute_Directory_Last
7318 if Current_Verbosity = High then
7319 Write_Str ("Source_Dir = ");
7320 Write_Line (Source_Directory);
7323 -- We look to every entry in the source directory
7325 Open (Dir, Source_Directory
7326 (Source_Directory'First .. Dir_Last));
7329 Read (Dir, Name, Last);
7334 (Source_Directory & Name (1 .. Last))
7336 if Current_Verbosity = High then
7337 Write_Str (" Checking ");
7338 Write_Line (Name (1 .. Last));
7341 Source_To_Replace := No_Source;
7344 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
7345 Display_File_Name := Name_Find;
7346 Canonical_Case_File_Name
7347 (Name_Buffer (1 .. Name_Len));
7348 File_Name := Name_Find;
7351 Display_Path : constant String :=
7357 (Source_Directory'First ..
7361 Case_Sensitive => True);
7362 Path : String := Display_Path;
7363 Path_Id : Path_Name_Type;
7364 Display_Path_Id : Path_Name_Type;
7367 Canonical_Case_File_Name (Path);
7368 Name_Len := Path'Length;
7369 Name_Buffer (1 .. Name_Len) := Path;
7370 Path_Id := Name_Find;
7372 Name_Len := Display_Path'Length;
7373 Name_Buffer (1 .. Name_Len) := Display_Path;
7374 Display_Path_Id := Name_Find;
7376 Name_Loc := Source_Names.Get (File_Name);
7377 Check_Name := False;
7379 if Name_Loc = No_Name_Location then
7380 Check_Name := For_All_Sources;
7383 if Name_Loc.Found then
7385 -- Check if it is OK to have the same file
7386 -- name in several source directories.
7389 not Data.Known_Order_Of_Source_Dirs
7391 Error_Msg_File_1 := File_Name;
7394 "{ is found in several " &
7395 "source directories",
7400 Name_Loc.Found := True;
7402 if Name_Loc.Source = No_Source then
7406 In_Tree.Sources.Table
7407 (Name_Loc.Source).Path := Path_Id;
7409 Source_Paths_Htable.Set
7410 (In_Tree.Source_Paths_HT,
7414 In_Tree.Sources.Table
7415 (Name_Loc.Source).Display_Path :=
7418 -- Check if this is a subunit
7420 if In_Tree.Sources.Table
7421 (Name_Loc.Source).Unit /= No_Name
7423 In_Tree.Sources.Table
7424 (Name_Loc.Source).Kind = Impl
7427 Src_Ind : Source_File_Index;
7431 Sinput.P.Load_Project_File
7432 (Get_Name_String (Path_Id));
7434 if Sinput.P.Source_File_Is_Subunit
7437 In_Tree.Sources.Table
7438 (Name_Loc.Source).Kind :=
7448 Alternate_Languages := No_Alternate_Language;
7449 Check_Naming_Schemes;
7451 if Language = No_Language_Index then
7452 if Name_Loc.Found then
7454 -- A file name in a list must be
7455 -- a source of a language.
7457 Error_Msg_File_1 := File_Name;
7460 "language unknown for {",
7465 -- Check if the same file name or unit
7466 -- is used in the project tree.
7468 Source := In_Tree.First_Source;
7471 while Source /= No_Source loop
7473 In_Tree.Sources.Table (Source);
7475 if (Unit /= No_Name and then
7476 Src_Data.Unit = Unit and then
7477 Src_Data.Kind = Kind)
7479 (Unit = No_Name and then
7480 Src_Data.File = File_Name)
7482 -- Duplication of file/unit in the
7483 -- same project is only allowed if
7484 -- the order of source directories
7487 if Project = Src_Data.Project then
7489 Data.Known_Order_Of_Source_Dirs
7493 elsif Unit /= No_Name then
7494 Error_Msg_Name_1 := Unit;
7497 "duplicate unit %%",
7502 Error_Msg_File_1 := File_Name;
7505 "duplicate source file " &
7511 -- Do not allow the same unit name
7512 -- in different projects, except if
7513 -- one is extending the other.
7515 -- For a file based language,
7516 -- the same file name replaces
7517 -- a file in a project being
7518 -- extended, but it is allowed
7519 -- to have the same file name in
7520 -- unrelated projects.
7527 Source_To_Replace := Source;
7529 elsif Unit /= No_Name then
7530 Error_Msg_Name_1 := Unit;
7533 "unit %% cannot belong to " &
7540 Source := Src_Data.Next_In_Sources;
7544 Source_Data_Table.Increment_Last
7546 Source := Source_Data_Table.Last
7552 Data.Project := Project;
7553 Data.Language_Name := Language_Name;
7554 Data.Language := Language;
7555 Data.Alternate_Languages :=
7556 Alternate_Languages;
7559 Data.File := File_Name;
7561 Object_Name (File_Name);
7563 In_Tree.Languages_Data.Table
7564 (Language).Config.Dependency_Kind;
7567 (File_Name, Data.Dependency);
7569 Switches_Name (File_Name);
7570 Data.Display_File :=
7572 Data.Path := Path_Id;
7573 Data.Display_Path :=
7575 In_Tree.Sources.Table (Source) :=
7579 Add_Source (Source, Data, In_Tree);
7581 Source_Paths_Htable.Set
7582 (In_Tree.Source_Paths_HT,
7586 if Source_To_Replace /= No_Source then
7606 when Directory_Error =>
7609 Source_Dir := Element.Next;
7612 if Current_Verbosity = High then
7613 Write_Line ("end Looking for sources.");
7615 end Search_Directories;
7617 Excluded_Sources : Variable_Value :=
7619 (Name_Excluded_Source_Files,
7620 Data.Decl.Attributes,
7623 -- Start of processing for Look_For_Sources
7626 -- If Excluded_Source_Files is not declared, check
7627 -- Locally_Removed_Files.
7629 if Excluded_Sources.Default then
7632 (Name_Locally_Removed_Files,
7633 Data.Decl.Attributes,
7637 if Get_Mode = Ada_Only and then
7638 Is_A_Language (In_Tree, Data, "ada")
7641 Sources : constant Variable_Value :=
7644 Data.Decl.Attributes,
7647 Source_List_File : constant Variable_Value :=
7649 (Name_Source_List_File,
7650 Data.Decl.Attributes,
7655 (Sources.Kind = List,
7656 "Source_Files is not a list");
7659 (Source_List_File.Kind = Single,
7660 "Source_List_File is not a single string");
7662 if not Sources.Default then
7663 if not Source_List_File.Default then
7666 "?both variables source_files and " &
7667 "source_list_file are present",
7668 Source_List_File.Location);
7671 -- Sources is a list of file names
7674 Current : String_List_Id := Sources.Values;
7675 Element : String_Element;
7676 Location : Source_Ptr;
7677 Name : File_Name_Type;
7682 Data.Ada_Sources_Present := Current /= Nil_String;
7684 if Current = Nil_String then
7685 Data.Source_Dirs := Nil_String;
7687 -- This project contains no source. For projects that
7688 -- don't extend other projects, this also means that
7689 -- there is no need for an object directory, if not
7692 if Data.Extends = No_Project
7693 and then Data.Object_Directory = Data.Directory
7695 Data.Object_Directory := No_Path;
7699 while Current /= Nil_String loop
7701 In_Tree.String_Elements.Table (Current);
7702 Get_Name_String (Element.Value);
7703 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7706 -- If the element has no location, then use the
7707 -- location of Sources to report possible errors.
7709 if Element.Location = No_Location then
7710 Location := Sources.Location;
7712 Location := Element.Location;
7719 Location => Location,
7720 Source => No_Source,
7724 Current := Element.Next;
7727 Get_Path_Names_And_Record_Sources (Follow_Links);
7731 -- No source_files specified
7733 -- We check Source_List_File has been specified
7735 elsif not Source_List_File.Default then
7737 -- Source_List_File is the name of the file
7738 -- that contains the source file names
7741 Source_File_Path_Name : constant String :=
7744 (Source_List_File.Value),
7748 if Source_File_Path_Name'Length = 0 then
7749 Err_Vars.Error_Msg_File_1 :=
7750 File_Name_Type (Source_List_File.Value);
7753 "file with sources { does not exist",
7754 Source_List_File.Location);
7757 Get_Sources_From_File
7758 (Source_File_Path_Name,
7759 Source_List_File.Location);
7764 -- Neither Source_Files nor Source_List_File has been
7765 -- specified. Find all the files that satisfy the naming
7766 -- scheme in all the source directories.
7769 (Project, In_Tree, Data, Follow_Links);
7772 -- If there are sources that are locally removed, mark them as
7773 -- such in the Units table.
7775 if not Excluded_Sources.Default then
7778 Current : String_List_Id := Excluded_Sources.Values;
7779 Element : String_Element;
7780 Location : Source_Ptr;
7783 Name : File_Name_Type;
7784 Extended : Project_Id;
7787 while Current /= Nil_String loop
7788 Element := In_Tree.String_Elements.Table (Current);
7789 Get_Name_String (Element.Value);
7790 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7793 -- If the element has no location, then use the location
7794 -- of Excluded_Sources to report possible errors.
7796 if Element.Location = No_Location then
7797 Location := Excluded_Sources.Location;
7799 Location := Element.Location;
7804 for Index in Unit_Table.First ..
7805 Unit_Table.Last (In_Tree.Units)
7807 Unit := In_Tree.Units.Table (Index);
7809 if Unit.File_Names (Specification).Name = Name then
7812 -- Check that this is from the current project or
7813 -- that the current project extends.
7815 Extended := Unit.File_Names
7816 (Specification).Project;
7818 if Extended = Project or else
7819 Project_Extends (Project, Extended, In_Tree)
7822 (Specification).Path := Slash;
7824 (Specification).Needs_Pragma := False;
7825 In_Tree.Units.Table (Index) := Unit;
7826 Add_Forbidden_File_Name
7827 (Unit.File_Names (Specification).Name);
7833 "cannot remove a source from " &
7839 Unit.File_Names (Body_Part).Name = Name
7843 -- Check that this is from the current project or
7844 -- that the current project extends.
7846 Extended := Unit.File_Names
7847 (Body_Part).Project;
7849 if Extended = Project or else
7850 Project_Extends (Project, Extended, In_Tree)
7852 Unit.File_Names (Body_Part).Path := Slash;
7853 Unit.File_Names (Body_Part).Needs_Pragma
7855 In_Tree.Units.Table (Index) := Unit;
7856 Add_Forbidden_File_Name
7857 (Unit.File_Names (Body_Part).Name);
7865 Err_Vars.Error_Msg_File_1 := Name;
7867 (Project, In_Tree, "unknown file {", Location);
7870 Current := Element.Next;
7877 if Get_Mode = Ada_Only and then Data.Other_Sources_Present then
7879 -- Set Source_Present to False. It will be set back to True
7880 -- whenever a source is found.
7882 Data.Other_Sources_Present := False;
7883 for Lang in Ada_Language_Index + 1 .. Last_Language_Index loop
7885 -- For each language (other than Ada) in the project file
7887 if Is_Present (Lang, Data, In_Tree) then
7889 -- Reset the indication that there are sources of this
7890 -- language. It will be set back to True whenever we find
7891 -- a source of the language.
7893 Set (Lang, False, Data, In_Tree);
7895 -- First, get the source suffix for the language
7897 Set (Suffix => Suffix_For (Lang, Data.Naming, In_Tree),
7898 For_Language => Lang,
7900 In_Tree => In_Tree);
7902 -- Then, deal with the naming exceptions, if any
7907 Naming_Exceptions : constant Variable_Value :=
7909 (Index => Language_Names.Table (Lang),
7911 In_Array => Data.Naming.Implementation_Exceptions,
7912 In_Tree => In_Tree);
7913 Element_Id : String_List_Id;
7914 Element : String_Element;
7915 File_Id : File_Name_Type;
7916 Source_Found : Boolean := False;
7919 -- If there are naming exceptions, look through them one
7922 if Naming_Exceptions /= Nil_Variable_Value then
7923 Element_Id := Naming_Exceptions.Values;
7925 while Element_Id /= Nil_String loop
7926 Element := In_Tree.String_Elements.Table
7928 Get_Name_String (Element.Value);
7929 Canonical_Case_File_Name
7930 (Name_Buffer (1 .. Name_Len));
7931 File_Id := Name_Find;
7933 -- Put each naming exception in the Source_Names
7934 -- hash table, but if there are repetition, don't
7935 -- bother after the first instance.
7938 Source_Names.Get (File_Id) = No_Name_Location
7940 Source_Found := True;
7944 Location => Element.Location,
7945 Source => No_Source,
7950 Element_Id := Element.Next;
7953 -- If there is at least one naming exception, record
7954 -- those that are found in the source directories.
7956 if Source_Found then
7957 Record_Other_Sources
7958 (Project => Project,
7962 Naming_Exceptions => True);
7968 -- Now, check if a list of sources is declared either through
7969 -- a string list (attribute Source_Files) or a text file
7970 -- (attribute Source_List_File). If a source list is declared,
7971 -- we will consider only those naming exceptions that are
7975 Sources : constant Variable_Value :=
7978 Data.Decl.Attributes,
7981 Source_List_File : constant Variable_Value :=
7983 (Name_Source_List_File,
7984 Data.Decl.Attributes,
7989 (Sources.Kind = List,
7990 "Source_Files is not a list");
7993 (Source_List_File.Kind = Single,
7994 "Source_List_File is not a single string");
7996 if not Sources.Default then
7997 if not Source_List_File.Default then
8000 "?both variables source_files and " &
8001 "source_list_file are present",
8002 Source_List_File.Location);
8005 -- Sources is a list of file names
8008 Current : String_List_Id := Sources.Values;
8009 Element : String_Element;
8010 Location : Source_Ptr;
8011 Name : File_Name_Type;
8016 -- Put all the sources in the Source_Names hash table
8018 while Current /= Nil_String loop
8020 In_Tree.String_Elements.Table
8022 Get_Name_String (Element.Value);
8023 Canonical_Case_File_Name
8024 (Name_Buffer (1 .. Name_Len));
8027 -- If the element has no location, then use the
8028 -- location of Sources to report possible errors.
8030 if Element.Location = No_Location then
8031 Location := Sources.Location;
8033 Location := Element.Location;
8040 Location => Location,
8041 Source => No_Source,
8045 Current := Element.Next;
8048 -- And look for their directories
8050 Record_Other_Sources
8051 (Project => Project,
8055 Naming_Exceptions => False);
8058 -- No source_files specified
8060 -- We check if Source_List_File has been specified
8062 elsif not Source_List_File.Default then
8064 -- Source_List_File is the name of the file
8065 -- that contains the source file names
8068 Source_File_Path_Name : constant String :=
8070 (File_Name_Type (Source_List_File.Value),
8074 if Source_File_Path_Name'Length = 0 then
8075 Err_Vars.Error_Msg_File_1 :=
8076 File_Name_Type (Source_List_File.Value);
8080 "file with sources { does not exist",
8081 Source_List_File.Location);
8084 -- Read the file, putting each source in the
8085 -- Source_Names hash table.
8087 Get_Sources_From_File
8088 (Source_File_Path_Name,
8089 Source_List_File.Location,
8092 -- And look for their directories
8094 Record_Other_Sources
8095 (Project => Project,
8099 Naming_Exceptions => False);
8103 -- Neither Source_Files nor Source_List_File was specified
8106 -- Find all the files that satisfy the naming scheme in
8107 -- all the source directories. All the naming exceptions
8108 -- that effectively exist are also part of the source
8109 -- of this language.
8111 Find_Sources (Project, In_Tree, Data, Lang);
8118 if Get_Mode = Multi_Language and then
8119 Data.First_Language_Processing /= No_Language_Index
8121 -- First, put all the naming exceptions, if any, in the Source_Names
8128 Src_Data : Source_Data;
8129 Name_Loc : Name_Location;
8132 Source := Data.First_Source;
8134 while Source /= No_Source loop
8135 Src_Data := In_Tree.Sources.Table (Source);
8136 Name_Loc := (Name => Src_Data.File,
8137 Location => No_Location,
8139 Except => Src_Data.Unit /= No_Name,
8142 if Current_Verbosity = High then
8143 Write_Str ("Putting source #");
8144 Write_Str (Source'Img);
8145 Write_Str (", file ");
8146 Write_Str (Get_Name_String (Src_Data.File));
8147 Write_Line (" in Source_Names");
8151 (K => Src_Data.File,
8154 Source := Src_Data.Next_In_Project;
8158 -- Now check attributes Sources and Source_List_File
8161 Sources : constant Variable_Value :=
8164 Data.Decl.Attributes,
8167 Source_List_File : constant Variable_Value :=
8169 (Name_Source_List_File,
8170 Data.Decl.Attributes,
8173 Name_Loc : Name_Location;
8176 if not Sources.Default then
8177 if not Source_List_File.Default then
8180 "?both variables source_files and " &
8181 "source_list_file are present",
8182 Source_List_File.Location);
8185 -- Sources is a list of file names
8188 Current : String_List_Id := Sources.Values;
8189 Element : String_Element;
8190 Location : Source_Ptr;
8191 Name : File_Name_Type;
8194 if Current = Nil_String then
8195 Data.First_Language_Processing := No_Language_Index;
8197 -- This project contains no source. For projects that
8198 -- don't extend other projects, this also means that
8199 -- there is no need for an object directory, if not
8202 if Data.Extends = No_Project
8203 and then Data.Object_Directory = Data.Directory
8205 Data.Object_Directory := No_Path;
8209 while Current /= Nil_String loop
8211 In_Tree.String_Elements.Table (Current);
8212 Get_Name_String (Element.Value);
8213 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
8216 -- If the element has no location, then use the
8217 -- location of Sources to report possible errors.
8219 if Element.Location = No_Location then
8220 Location := Sources.Location;
8222 Location := Element.Location;
8225 Name_Loc := Source_Names.Get (Name);
8227 if Name_Loc = No_Name_Location then
8230 Location => Location,
8231 Source => No_Source,
8234 Source_Names.Set (Name, Name_Loc);
8237 Current := Element.Next;
8241 elsif not Source_List_File.Default then
8243 -- Source_List_File is the name of the file
8244 -- that contains the source file names
8247 Source_File_Path_Name : constant String :=
8250 (Source_List_File.Value),
8254 if Source_File_Path_Name'Length = 0 then
8255 Err_Vars.Error_Msg_File_1 :=
8256 File_Name_Type (Source_List_File.Value);
8259 "file with sources { does not exist",
8260 Source_List_File.Location);
8263 Get_Sources_From_File
8264 (Source_File_Path_Name,
8265 Source_List_File.Location);
8272 Sources.Default and then Source_List_File.Default);
8274 -- If there are locally removed sources, mark them as such
8276 if not Excluded_Sources.Default then
8278 Current : String_List_Id;
8279 Element : String_Element;
8280 Location : Source_Ptr;
8282 Name : File_Name_Type;
8284 Src_Data : Source_Data;
8287 Current := Excluded_Sources.Values;
8288 while Current /= Nil_String loop
8290 In_Tree.String_Elements.Table (Current);
8291 Get_Name_String (Element.Value);
8292 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
8295 -- If the element has no location, then use the location
8296 -- of Excluded_Sources to report possible errors.
8298 if Element.Location = No_Location then
8299 Location := Excluded_Sources.Location;
8301 Location := Element.Location;
8306 Source := In_Tree.First_Source;
8308 while Source /= No_Source loop
8309 Src_Data := In_Tree.Sources.Table (Source);
8311 if Src_Data.File = Name then
8313 -- Check that this is from this project or a
8314 -- project that the current project extends.
8316 if Src_Data.Project = Project or else
8318 (Project, Src_Data.Project, In_Tree)
8320 Src_Data.Locally_Removed := True;
8321 In_Tree.Sources.Table (Source) := Src_Data;
8322 Add_Forbidden_File_Name (Name);
8328 Source := Src_Data.Next_In_Sources;
8332 Err_Vars.Error_Msg_File_1 := Name;
8334 (Project, In_Tree, "unknown file {", Location);
8337 Current := Element.Next;
8343 end Look_For_Sources;
8349 function Path_Name_Of
8350 (File_Name : File_Name_Type;
8351 Directory : Path_Name_Type) return String
8353 Result : String_Access;
8355 The_Directory : constant String := Get_Name_String (Directory);
8358 Get_Name_String (File_Name);
8359 Result := Locate_Regular_File
8360 (File_Name => Name_Buffer (1 .. Name_Len),
8361 Path => The_Directory);
8363 if Result = null then
8366 Canonical_Case_File_Name (Result.all);
8371 -------------------------------
8372 -- Prepare_Ada_Naming_Exceptions --
8373 -------------------------------
8375 procedure Prepare_Ada_Naming_Exceptions
8376 (List : Array_Element_Id;
8377 In_Tree : Project_Tree_Ref;
8378 Kind : Spec_Or_Body)
8380 Current : Array_Element_Id;
8381 Element : Array_Element;
8385 -- Traverse the list
8388 while Current /= No_Array_Element loop
8389 Element := In_Tree.Array_Elements.Table (Current);
8391 if Element.Index /= No_Name then
8394 Unit => Element.Index,
8395 Next => No_Ada_Naming_Exception);
8396 Reverse_Ada_Naming_Exceptions.Set
8397 (Unit, (Element.Value.Value, Element.Value.Index));
8399 Ada_Naming_Exceptions.Get (File_Name_Type (Element.Value.Value));
8400 Ada_Naming_Exception_Table.Increment_Last;
8401 Ada_Naming_Exception_Table.Table
8402 (Ada_Naming_Exception_Table.Last) := Unit;
8403 Ada_Naming_Exceptions.Set
8404 (File_Name_Type (Element.Value.Value),
8405 Ada_Naming_Exception_Table.Last);
8408 Current := Element.Next;
8410 end Prepare_Ada_Naming_Exceptions;
8412 ---------------------
8413 -- Project_Extends --
8414 ---------------------
8416 function Project_Extends
8417 (Extending : Project_Id;
8418 Extended : Project_Id;
8419 In_Tree : Project_Tree_Ref) return Boolean
8421 Current : Project_Id := Extending;
8424 if Current = No_Project then
8427 elsif Current = Extended then
8431 Current := In_Tree.Projects.Table (Current).Extends;
8433 end Project_Extends;
8435 -----------------------
8436 -- Record_Ada_Source --
8437 -----------------------
8439 procedure Record_Ada_Source
8440 (File_Name : File_Name_Type;
8441 Path_Name : Path_Name_Type;
8442 Project : Project_Id;
8443 In_Tree : Project_Tree_Ref;
8444 Data : in out Project_Data;
8445 Location : Source_Ptr;
8446 Current_Source : in out String_List_Id;
8447 Source_Recorded : in out Boolean;
8448 Follow_Links : Boolean)
8450 Canonical_File_Name : File_Name_Type;
8451 Canonical_Path_Name : Path_Name_Type;
8453 Exception_Id : Ada_Naming_Exception_Id;
8454 Unit_Name : Name_Id;
8455 Unit_Kind : Spec_Or_Body;
8456 Unit_Ind : Int := 0;
8458 Name_Index : Name_And_Index;
8459 Needs_Pragma : Boolean;
8461 The_Location : Source_Ptr := Location;
8462 Previous_Source : constant String_List_Id := Current_Source;
8463 Except_Name : Name_And_Index := No_Name_And_Index;
8465 Unit_Prj : Unit_Project;
8467 File_Name_Recorded : Boolean := False;
8470 Get_Name_String (File_Name);
8471 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
8472 Canonical_File_Name := Name_Find;
8475 Canonical_Path : constant String :=
8477 (Get_Name_String (Path_Name),
8478 Resolve_Links => Follow_Links,
8479 Case_Sensitive => False);
8482 Add_Str_To_Name_Buffer (Canonical_Path);
8483 Canonical_Path_Name := Name_Find;
8486 -- Find out the unit name, the unit kind and if it needs
8487 -- a specific SFN pragma.
8490 (In_Tree => In_Tree,
8491 Canonical_File_Name => Canonical_File_Name,
8492 Naming => Data.Naming,
8493 Exception_Id => Exception_Id,
8494 Unit_Name => Unit_Name,
8495 Unit_Kind => Unit_Kind,
8496 Needs_Pragma => Needs_Pragma);
8498 if Exception_Id = No_Ada_Naming_Exception and then
8501 if Current_Verbosity = High then
8503 Write_Str (Get_Name_String (Canonical_File_Name));
8504 Write_Line (""" is not a valid source file name (ignored).");
8508 -- Check to see if the source has been hidden by an exception,
8509 -- but only if it is not an exception.
8511 if not Needs_Pragma then
8513 Reverse_Ada_Naming_Exceptions.Get
8514 ((Unit_Kind, Unit_Name, No_Ada_Naming_Exception));
8516 if Except_Name /= No_Name_And_Index then
8517 if Current_Verbosity = High then
8519 Write_Str (Get_Name_String (Canonical_File_Name));
8520 Write_Str (""" contains a unit that is found in """);
8521 Write_Str (Get_Name_String (Except_Name.Name));
8522 Write_Line (""" (ignored).");
8525 -- The file is not included in the source of the project since
8526 -- it is hidden by the exception. So, nothing else to do.
8533 if Exception_Id /= No_Ada_Naming_Exception then
8534 Info := Ada_Naming_Exception_Table.Table (Exception_Id);
8535 Exception_Id := Info.Next;
8536 Info.Next := No_Ada_Naming_Exception;
8537 Name_Index := Reverse_Ada_Naming_Exceptions.Get (Info);
8539 Unit_Name := Info.Unit;
8540 Unit_Ind := Name_Index.Index;
8541 Unit_Kind := Info.Kind;
8544 -- Put the file name in the list of sources of the project
8546 String_Element_Table.Increment_Last
8547 (In_Tree.String_Elements);
8548 In_Tree.String_Elements.Table
8549 (String_Element_Table.Last
8550 (In_Tree.String_Elements)) :=
8551 (Value => Name_Id (Canonical_File_Name),
8552 Display_Value => Name_Id (File_Name),
8553 Location => No_Location,
8558 if Current_Source = Nil_String then
8559 Data.Ada_Sources := String_Element_Table.Last
8560 (In_Tree.String_Elements);
8561 Data.Sources := Data.Ada_Sources;
8563 In_Tree.String_Elements.Table
8564 (Current_Source).Next :=
8565 String_Element_Table.Last
8566 (In_Tree.String_Elements);
8569 Current_Source := String_Element_Table.Last
8570 (In_Tree.String_Elements);
8572 -- Put the unit in unit list
8575 The_Unit : Unit_Index :=
8576 Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
8578 The_Unit_Data : Unit_Data;
8581 if Current_Verbosity = High then
8582 Write_Str ("Putting ");
8583 Write_Str (Get_Name_String (Unit_Name));
8584 Write_Line (" in the unit list.");
8587 -- The unit is already in the list, but may be it is
8588 -- only the other unit kind (spec or body), or what is
8589 -- in the unit list is a unit of a project we are extending.
8591 if The_Unit /= No_Unit_Index then
8592 The_Unit_Data := In_Tree.Units.Table (The_Unit);
8594 if (The_Unit_Data.File_Names (Unit_Kind).Name =
8597 The_Unit_Data.File_Names (Unit_Kind).Path = Slash)
8598 or else The_Unit_Data.File_Names (Unit_Kind).Name = No_File
8599 or else Project_Extends
8601 The_Unit_Data.File_Names (Unit_Kind).Project,
8604 if The_Unit_Data.File_Names (Unit_Kind).Path = Slash then
8605 Remove_Forbidden_File_Name
8606 (The_Unit_Data.File_Names (Unit_Kind).Name);
8609 -- Record the file name in the hash table Files_Htable
8611 Unit_Prj := (Unit => The_Unit, Project => Project);
8614 Canonical_File_Name,
8617 The_Unit_Data.File_Names (Unit_Kind) :=
8618 (Name => Canonical_File_Name,
8620 Display_Name => File_Name,
8621 Path => Canonical_Path_Name,
8622 Display_Path => Path_Name,
8624 Needs_Pragma => Needs_Pragma);
8625 In_Tree.Units.Table (The_Unit) :=
8627 Source_Recorded := True;
8629 elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project
8630 and then (Data.Known_Order_Of_Source_Dirs or else
8631 The_Unit_Data.File_Names (Unit_Kind).Path =
8632 Canonical_Path_Name)
8634 if Previous_Source = Nil_String then
8635 Data.Ada_Sources := Nil_String;
8636 Data.Sources := Nil_String;
8638 In_Tree.String_Elements.Table
8639 (Previous_Source).Next := Nil_String;
8640 String_Element_Table.Decrement_Last
8641 (In_Tree.String_Elements);
8644 Current_Source := Previous_Source;
8647 -- It is an error to have two units with the same name
8648 -- and the same kind (spec or body).
8650 if The_Location = No_Location then
8652 In_Tree.Projects.Table
8656 Err_Vars.Error_Msg_Name_1 := Unit_Name;
8658 (Project, In_Tree, "duplicate source %%", The_Location);
8660 Err_Vars.Error_Msg_Name_1 :=
8661 In_Tree.Projects.Table
8662 (The_Unit_Data.File_Names (Unit_Kind).Project).Name;
8663 Err_Vars.Error_Msg_File_1 :=
8665 (The_Unit_Data.File_Names (Unit_Kind).Path);
8668 "\ project file %%, {", The_Location);
8670 Err_Vars.Error_Msg_Name_1 :=
8671 In_Tree.Projects.Table (Project).Name;
8672 Err_Vars.Error_Msg_File_1 :=
8673 File_Name_Type (Canonical_Path_Name);
8676 "\ project file %%, {", The_Location);
8679 -- It is a new unit, create a new record
8682 -- First, check if there is no other unit with this file
8683 -- name in another project. If it is, report an error.
8684 -- Of course, we do that only for the first unit in the
8687 Unit_Prj := Files_Htable.Get
8688 (In_Tree.Files_HT, Canonical_File_Name);
8690 if not File_Name_Recorded and then
8691 Unit_Prj /= No_Unit_Project
8693 Error_Msg_File_1 := File_Name;
8695 In_Tree.Projects.Table
8696 (Unit_Prj.Project).Name;
8699 "{ is already a source of project %%",
8703 Unit_Table.Increment_Last (In_Tree.Units);
8704 The_Unit := Unit_Table.Last (In_Tree.Units);
8706 (In_Tree.Units_HT, Unit_Name, The_Unit);
8707 Unit_Prj := (Unit => The_Unit, Project => Project);
8710 Canonical_File_Name,
8712 The_Unit_Data.Name := Unit_Name;
8713 The_Unit_Data.File_Names (Unit_Kind) :=
8714 (Name => Canonical_File_Name,
8716 Display_Name => File_Name,
8717 Path => Canonical_Path_Name,
8718 Display_Path => Path_Name,
8720 Needs_Pragma => Needs_Pragma);
8721 In_Tree.Units.Table (The_Unit) :=
8723 Source_Recorded := True;
8728 exit when Exception_Id = No_Ada_Naming_Exception;
8729 File_Name_Recorded := True;
8732 end Record_Ada_Source;
8734 --------------------------
8735 -- Record_Other_Sources --
8736 --------------------------
8738 procedure Record_Other_Sources
8739 (Project : Project_Id;
8740 In_Tree : Project_Tree_Ref;
8741 Data : in out Project_Data;
8742 Language : Language_Index;
8743 Naming_Exceptions : Boolean)
8745 Source_Dir : String_List_Id;
8746 Element : String_Element;
8747 Path : Path_Name_Type;
8749 Canonical_Name : File_Name_Type;
8750 Name_Str : String (1 .. 1_024);
8751 Last : Natural := 0;
8753 First_Error : Boolean := True;
8754 Suffix : constant String :=
8755 Body_Suffix_Of (Language, Data, In_Tree);
8758 Source_Dir := Data.Source_Dirs;
8759 while Source_Dir /= Nil_String loop
8760 Element := In_Tree.String_Elements.Table (Source_Dir);
8763 Dir_Path : constant String :=
8764 Get_Name_String (Element.Display_Value);
8766 if Current_Verbosity = High then
8767 Write_Str ("checking directory """);
8768 Write_Str (Dir_Path);
8769 Write_Str (""" for ");
8771 if Naming_Exceptions then
8772 Write_Str ("naming exceptions");
8775 Write_Str ("sources");
8778 Write_Str (" of Language ");
8779 Display_Language_Name (Language);
8782 Open (Dir, Dir_Path);
8785 Read (Dir, Name_Str, Last);
8789 (Dir_Path & Directory_Separator & Name_Str (1 .. Last))
8792 Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
8793 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
8794 Canonical_Name := Name_Find;
8795 NL := Source_Names.Get (Canonical_Name);
8797 if NL /= No_Name_Location then
8799 if not Data.Known_Order_Of_Source_Dirs then
8800 Error_Msg_File_1 := Canonical_Name;
8803 "{ is found in several source directories",
8809 Source_Names.Set (Canonical_Name, NL);
8810 Name_Len := Dir_Path'Length;
8811 Name_Buffer (1 .. Name_Len) := Dir_Path;
8812 Add_Char_To_Name_Buffer (Directory_Separator);
8813 Add_Str_To_Name_Buffer (Name_Str (1 .. Last));
8817 (File_Name => Canonical_Name,
8822 Location => NL.Location,
8823 Language => Language,
8825 Naming_Exception => Naming_Exceptions);
8834 Source_Dir := Element.Next;
8837 if not Naming_Exceptions then
8838 NL := Source_Names.Get_First;
8840 -- It is an error if a source file name in a source list or
8841 -- in a source list file is not found.
8843 while NL /= No_Name_Location loop
8844 if not NL.Found then
8845 Err_Vars.Error_Msg_File_1 := NL.Name;
8850 "source file { cannot be found",
8852 First_Error := False;
8857 "\source file { cannot be found",
8862 NL := Source_Names.Get_Next;
8865 -- Any naming exception of this language that is not in a list
8866 -- of sources must be removed.
8869 Source_Id : Other_Source_Id := Data.First_Other_Source;
8870 Prev_Id : Other_Source_Id := No_Other_Source;
8871 Source : Other_Source;
8874 while Source_Id /= No_Other_Source loop
8875 Source := In_Tree.Other_Sources.Table (Source_Id);
8877 if Source.Language = Language
8878 and then Source.Naming_Exception
8880 if Current_Verbosity = High then
8881 Write_Str ("Naming exception """);
8882 Write_Str (Get_Name_String (Source.File_Name));
8883 Write_Str (""" is not in the list of sources,");
8884 Write_Line (" so it is removed.");
8887 if Prev_Id = No_Other_Source then
8888 Data.First_Other_Source := Source.Next;
8891 In_Tree.Other_Sources.Table
8892 (Prev_Id).Next := Source.Next;
8895 Source_Id := Source.Next;
8897 if Source_Id = No_Other_Source then
8898 Data.Last_Other_Source := Prev_Id;
8902 Prev_Id := Source_Id;
8903 Source_Id := Source.Next;
8908 end Record_Other_Sources;
8914 procedure Remove_Source
8916 Replaced_By : Source_Id;
8917 Project : Project_Id;
8918 Data : in out Project_Data;
8919 In_Tree : Project_Tree_Ref)
8921 Src_Data : constant Source_Data := In_Tree.Sources.Table (Id);
8926 if Current_Verbosity = High then
8927 Write_Str ("Removing source #");
8928 Write_Line (Id'Img);
8931 In_Tree.Sources.Table (Id).Replaced_By := Replaced_By;
8933 -- Remove the source from the global source list
8935 Source := In_Tree.First_Source;
8938 In_Tree.First_Source := Src_Data.Next_In_Sources;
8941 while In_Tree.Sources.Table (Source).Next_In_Sources /= Id loop
8942 Source := In_Tree.Sources.Table (Source).Next_In_Sources;
8945 In_Tree.Sources.Table (Source).Next_In_Sources :=
8946 Src_Data.Next_In_Sources;
8949 -- Remove the source from the project list
8951 if Src_Data.Project = Project then
8952 Source := Data.First_Source;
8955 Data.First_Source := Src_Data.Next_In_Project;
8957 if Src_Data.Next_In_Project = No_Source then
8958 Data.Last_Source := No_Source;
8962 while In_Tree.Sources.Table (Source).Next_In_Project /= Id loop
8963 Source := In_Tree.Sources.Table (Source).Next_In_Project;
8966 In_Tree.Sources.Table (Source).Next_In_Project :=
8967 Src_Data.Next_In_Project;
8969 if Src_Data.Next_In_Project = No_Source then
8970 In_Tree.Projects.Table (Src_Data.Project).Last_Source := Source;
8975 Source := In_Tree.Projects.Table (Src_Data.Project).First_Source;
8978 In_Tree.Projects.Table (Src_Data.Project).First_Source :=
8979 Src_Data.Next_In_Project;
8981 if Src_Data.Next_In_Project = No_Source then
8982 In_Tree.Projects.Table (Src_Data.Project).Last_Source :=
8987 while In_Tree.Sources.Table (Source).Next_In_Project /= Id loop
8988 Source := In_Tree.Sources.Table (Source).Next_In_Project;
8991 In_Tree.Sources.Table (Source).Next_In_Project :=
8992 Src_Data.Next_In_Project;
8994 if Src_Data.Next_In_Project = No_Source then
8995 In_Tree.Projects.Table (Src_Data.Project).Last_Source := Source;
9000 -- Remove source from the language list
9002 Source := In_Tree.Languages_Data.Table (Src_Data.Language).First_Source;
9005 In_Tree.Languages_Data.Table (Src_Data.Language).First_Source :=
9006 Src_Data.Next_In_Lang;
9009 while In_Tree.Sources.Table (Source).Next_In_Lang /= Id loop
9010 Source := In_Tree.Sources.Table (Source).Next_In_Lang;
9013 In_Tree.Sources.Table (Source).Next_In_Lang :=
9014 Src_Data.Next_In_Lang;
9018 -----------------------
9019 -- Report_No_Sources --
9020 -----------------------
9022 procedure Report_No_Sources
9023 (Project : Project_Id;
9025 In_Tree : Project_Tree_Ref;
9026 Location : Source_Ptr)
9029 case When_No_Sources is
9033 when Warning | Error =>
9034 Error_Msg_Warn := When_No_Sources = Warning;
9037 "<there are no " & Lang_Name & " sources in this project",
9040 end Report_No_Sources;
9042 ----------------------
9043 -- Show_Source_Dirs --
9044 ----------------------
9046 procedure Show_Source_Dirs
9047 (Data : Project_Data;
9048 In_Tree : Project_Tree_Ref)
9050 Current : String_List_Id;
9051 Element : String_Element;
9054 Write_Line ("Source_Dirs:");
9056 Current := Data.Source_Dirs;
9057 while Current /= Nil_String loop
9058 Element := In_Tree.String_Elements.Table (Current);
9060 Write_Line (Get_Name_String (Element.Value));
9061 Current := Element.Next;
9064 Write_Line ("end Source_Dirs.");
9065 end Show_Source_Dirs;
9072 (Language : Language_Index;
9073 Naming : Naming_Data;
9074 In_Tree : Project_Tree_Ref) return File_Name_Type
9076 Suffix : constant Variable_Value :=
9078 (Index => Language_Names.Table (Language),
9080 In_Array => Naming.Body_Suffix,
9081 In_Tree => In_Tree);
9083 -- If no suffix for this language in package Naming, use the default
9085 if Suffix = Nil_Variable_Value then
9089 when Ada_Language_Index =>
9090 Add_Str_To_Name_Buffer (".adb");
9092 when C_Language_Index =>
9093 Add_Str_To_Name_Buffer (".c");
9095 when C_Plus_Plus_Language_Index =>
9096 Add_Str_To_Name_Buffer (".cpp");
9102 -- Otherwise use the one specified
9105 Get_Name_String (Suffix.Value);
9108 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
9112 -------------------------
9113 -- Warn_If_Not_Sources --
9114 -------------------------
9116 -- comments needed in this body ???
9118 procedure Warn_If_Not_Sources
9119 (Project : Project_Id;
9120 In_Tree : Project_Tree_Ref;
9121 Conventions : Array_Element_Id;
9123 Extending : Boolean)
9125 Conv : Array_Element_Id := Conventions;
9127 The_Unit_Id : Unit_Index;
9128 The_Unit_Data : Unit_Data;
9129 Location : Source_Ptr;
9132 while Conv /= No_Array_Element loop
9133 Unit := In_Tree.Array_Elements.Table (Conv).Index;
9134 Error_Msg_Name_1 := Unit;
9135 Get_Name_String (Unit);
9136 To_Lower (Name_Buffer (1 .. Name_Len));
9138 The_Unit_Id := Units_Htable.Get
9139 (In_Tree.Units_HT, Unit);
9140 Location := In_Tree.Array_Elements.Table
9141 (Conv).Value.Location;
9143 if The_Unit_Id = No_Unit_Index then
9150 The_Unit_Data := In_Tree.Units.Table (The_Unit_Id);
9152 In_Tree.Array_Elements.Table (Conv).Value.Value;
9155 if not Check_Project
9156 (The_Unit_Data.File_Names (Specification).Project,
9157 Project, In_Tree, Extending)
9161 "?source of spec of unit %% (%%)" &
9162 " cannot be found in this project",
9167 if not Check_Project
9168 (The_Unit_Data.File_Names (Body_Part).Project,
9169 Project, In_Tree, Extending)
9173 "?source of body of unit %% (%%)" &
9174 " cannot be found in this project",
9180 Conv := In_Tree.Array_Elements.Table (Conv).Next;
9182 end Warn_If_Not_Sources;