1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2000-2008, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with GNAT.Case_Util; use GNAT.Case_Util;
27 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
30 with Err_Vars; use Err_Vars;
35 with Osint; use Osint;
36 with Output; use Output;
37 with Prj.Env; use Prj.Env;
39 with Prj.Util; use Prj.Util;
41 with Snames; use Snames;
42 with Table; use Table;
43 with Targparm; use Targparm;
45 with Ada.Characters.Handling; use Ada.Characters.Handling;
46 with Ada.Directories; use Ada.Directories;
47 with Ada.Strings; use Ada.Strings;
48 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
49 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
51 package body Prj.Nmsc is
53 No_Continuation_String : aliased String := "";
54 Continuation_String : aliased String := "\";
55 -- Used in Check_Library for continuation error messages at the same
58 Error_Report : Put_Line_Access := null;
59 -- Set to point to error reporting procedure
61 When_No_Sources : Error_Warning := Error;
62 -- Indicates what should be done when there is no Ada sources in a non
63 -- extending Ada project.
65 ALI_Suffix : constant String := ".ali";
66 -- File suffix for ali files
68 type Name_Location is record
69 Name : File_Name_Type;
70 Location : Source_Ptr;
71 Source : Source_Id := No_Source;
72 Except : Boolean := False;
73 Found : Boolean := False;
75 -- Information about file names found in string list attribute
76 -- Source_Files or in a source list file, stored in hash table
77 -- Source_Names, used by procedure Get_Path_Names_And_Record_Sources.
79 No_Name_Location : constant Name_Location :=
81 Location => No_Location,
86 package Source_Names is new GNAT.HTable.Simple_HTable
87 (Header_Num => Header_Num,
88 Element => Name_Location,
89 No_Element => No_Name_Location,
90 Key => File_Name_Type,
93 -- Hash table to store file names found in string list attribute
94 -- Source_Files or in a source list file, stored in hash table
95 -- Source_Names, used by procedure Get_Path_Names_And_Record_Sources.
97 -- More documentation needed on what unit exceptions are about ???
99 type Unit_Exception is record
101 Spec : File_Name_Type;
102 Impl : File_Name_Type;
105 No_Unit_Exception : constant Unit_Exception :=
110 package Unit_Exceptions is new GNAT.HTable.Simple_HTable
111 (Header_Num => Header_Num,
112 Element => Unit_Exception,
113 No_Element => No_Unit_Exception,
117 -- Hash table to store the unit exceptions
119 package Recursive_Dirs is new GNAT.HTable.Simple_HTable
120 (Header_Num => Header_Num,
126 -- Hash table to store recursive source directories, to avoid looking
127 -- several times, and to avoid cycles that may be introduced by symbolic
130 type Ada_Naming_Exception_Id is new Nat;
131 No_Ada_Naming_Exception : constant Ada_Naming_Exception_Id := 0;
133 type Unit_Info is record
136 Next : Ada_Naming_Exception_Id := No_Ada_Naming_Exception;
140 -- Why is the following commented out ???
141 -- No_Unit : constant Unit_Info :=
142 -- (Specification, No_Name, No_Ada_Naming_Exception);
144 package Ada_Naming_Exception_Table is new Table.Table
145 (Table_Component_Type => Unit_Info,
146 Table_Index_Type => Ada_Naming_Exception_Id,
147 Table_Low_Bound => 1,
149 Table_Increment => 100,
150 Table_Name => "Prj.Nmsc.Ada_Naming_Exception_Table");
152 package Ada_Naming_Exceptions is new GNAT.HTable.Simple_HTable
153 (Header_Num => Header_Num,
154 Element => Ada_Naming_Exception_Id,
155 No_Element => No_Ada_Naming_Exception,
156 Key => File_Name_Type,
159 -- A hash table to store naming exceptions for Ada. For each file name
160 -- there is one or several unit in table Ada_Naming_Exception_Table.
162 package Object_File_Names is new GNAT.HTable.Simple_HTable
163 (Header_Num => Header_Num,
164 Element => File_Name_Type,
165 No_Element => No_File,
166 Key => File_Name_Type,
169 -- A hash table to store the object file names for a project, to check that
170 -- two different sources have different object file names.
172 type File_Found is record
173 File : File_Name_Type := No_File;
174 Found : Boolean := False;
175 Location : Source_Ptr := No_Location;
177 No_File_Found : constant File_Found := (No_File, False, No_Location);
178 -- Comments needed ???
180 package Excluded_Sources_Htable is new GNAT.HTable.Simple_HTable
181 (Header_Num => Header_Num,
182 Element => File_Found,
183 No_Element => No_File_Found,
184 Key => File_Name_Type,
187 -- A hash table to store the excluded files, if any. This is filled by
188 -- Find_Excluded_Sources below.
190 procedure Find_Excluded_Sources
191 (Project : Project_Id;
192 In_Tree : Project_Tree_Ref;
193 Data : Project_Data);
194 -- Find the list of files that should not be considered as source files
195 -- for this project. Sets the list in the Excluded_Sources_Htable.
197 function Hash (Unit : Unit_Info) return Header_Num;
199 type Name_And_Index is record
200 Name : Name_Id := No_Name;
203 No_Name_And_Index : constant Name_And_Index :=
204 (Name => No_Name, Index => 0);
206 package Reverse_Ada_Naming_Exceptions is new GNAT.HTable.Simple_HTable
207 (Header_Num => Header_Num,
208 Element => Name_And_Index,
209 No_Element => No_Name_And_Index,
213 -- A table to check if a unit with an exceptional name will hide a source
214 -- with a file name following the naming convention.
218 Data : in out Project_Data;
219 In_Tree : Project_Tree_Ref;
220 Project : Project_Id;
222 Lang_Id : Language_Index;
224 File_Name : File_Name_Type;
225 Display_File : File_Name_Type;
226 Lang_Kind : Language_Kind;
227 Naming_Exception : Boolean := False;
228 Path : Path_Name_Type := No_Path;
229 Display_Path : Path_Name_Type := No_Path;
230 Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
231 Other_Part : Source_Id := No_Source;
232 Unit : Name_Id := No_Name;
234 Source_To_Replace : Source_Id := No_Source);
235 -- Add a new source to the different lists: list of all sources in the
236 -- project tree, list of source of a project and list of sources of a
239 -- If Path is specified, the file is also added to Source_Paths_HT.
240 -- If Source_To_Replace is specified, it points to the source in the
241 -- extended project that the new file is overriding.
243 function ALI_File_Name (Source : String) return String;
244 -- Return the ALI file name corresponding to a source
246 procedure Check_Ada_Name (Name : String; Unit : out Name_Id);
247 -- Check that a name is a valid Ada unit name
249 procedure Check_Naming_Schemes
250 (Data : in out Project_Data;
251 Project : Project_Id;
252 In_Tree : Project_Tree_Ref);
253 -- Check the naming scheme part of Data
255 procedure Check_Ada_Naming_Scheme_Validity
256 (Project : Project_Id;
257 In_Tree : Project_Tree_Ref;
258 Naming : Naming_Data);
259 -- Check that the package Naming is correct
261 procedure Check_Configuration
262 (Project : Project_Id;
263 In_Tree : Project_Tree_Ref;
264 Data : in out Project_Data);
265 -- Check the configuration attributes for the project
267 procedure Check_If_Externally_Built
268 (Project : Project_Id;
269 In_Tree : Project_Tree_Ref;
270 Data : in out Project_Data);
271 -- Check attribute Externally_Built of project Project in project tree
272 -- In_Tree and modify its data Data if it has the value "true".
274 procedure Check_Interfaces
275 (Project : Project_Id;
276 In_Tree : Project_Tree_Ref;
277 Data : in out Project_Data);
278 -- If a list of sources is specified in attribute Interfaces, set
279 -- In_Interfaces only for the sources specified in the list.
281 procedure Check_Library_Attributes
282 (Project : Project_Id;
283 In_Tree : Project_Tree_Ref;
284 Current_Dir : String;
285 Data : in out Project_Data);
286 -- Check the library attributes of project Project in project tree In_Tree
287 -- and modify its data Data accordingly.
288 -- Current_Dir should represent the current directory, and is passed for
289 -- efficiency to avoid system calls to recompute it.
291 procedure Check_Package_Naming
292 (Project : Project_Id;
293 In_Tree : Project_Tree_Ref;
294 Data : in out Project_Data);
295 -- Check package Naming of project Project in project tree In_Tree and
296 -- modify its data Data accordingly.
298 procedure Check_Programming_Languages
299 (In_Tree : Project_Tree_Ref;
300 Project : Project_Id;
301 Data : in out Project_Data);
302 -- Check attribute Languages for the project with data Data in project
303 -- tree In_Tree and set the components of Data for all the programming
304 -- languages indicated in attribute Languages, if any.
306 function Check_Project
308 Root_Project : Project_Id;
309 In_Tree : Project_Tree_Ref;
310 Extending : Boolean) return Boolean;
311 -- Returns True if P is Root_Project or, if Extending is True, a project
312 -- extended by Root_Project.
314 procedure Check_Stand_Alone_Library
315 (Project : Project_Id;
316 In_Tree : Project_Tree_Ref;
317 Data : in out Project_Data;
318 Current_Dir : String;
319 Extending : Boolean);
320 -- Check if project Project in project tree In_Tree is a Stand-Alone
321 -- Library project, and modify its data Data accordingly if it is one.
322 -- Current_Dir should represent the current directory, and is passed for
323 -- efficiency to avoid system calls to recompute it.
325 procedure Get_Path_Names_And_Record_Ada_Sources
326 (Project : Project_Id;
327 In_Tree : Project_Tree_Ref;
328 Data : in out Project_Data;
329 Current_Dir : String);
330 -- Find the path names of the source files in the Source_Names table
331 -- in the source directories and record those that are Ada sources.
333 function Compute_Directory_Last (Dir : String) return Natural;
334 -- Return the index of the last significant character in Dir. This is used
335 -- to avoid duplicate '/' (slash) characters at the end of directory names.
338 (Project : Project_Id;
339 In_Tree : Project_Tree_Ref;
341 Flag_Location : Source_Ptr);
342 -- Output an error message. If Error_Report is null, simply call
343 -- Prj.Err.Error_Msg. Otherwise, disregard Flag_Location and use
346 procedure Find_Ada_Sources
347 (Project : Project_Id;
348 In_Tree : Project_Tree_Ref;
349 Data : in out Project_Data;
350 Current_Dir : String);
351 -- Find all the Ada sources in all of the source directories of a project
352 -- Current_Dir should represent the current directory, and is passed for
353 -- efficiency to avoid system calls to recompute it.
355 procedure Search_Directories
356 (Project : Project_Id;
357 In_Tree : Project_Tree_Ref;
358 Data : in out Project_Data;
359 For_All_Sources : Boolean);
360 -- Search the source directories to find the sources.
361 -- If For_All_Sources is True, check each regular file name against the
362 -- naming schemes of the different languages. Otherwise consider only the
363 -- file names in the hash table Source_Names.
366 (Project : Project_Id;
367 In_Tree : Project_Tree_Ref;
368 Data : in out Project_Data;
370 File_Name : File_Name_Type;
371 Display_File_Name : File_Name_Type;
372 Source_Directory : String;
373 For_All_Sources : Boolean);
374 -- Check if file File_Name is a valid source of the project. This is used
375 -- in multi-language mode only.
376 -- When the file matches one of the naming schemes, it is added to
377 -- various htables through Add_Source and to Source_Paths_Htable.
379 -- Name is the name of the candidate file. It hasn't been normalized yet
380 -- and is the direct result of readdir().
382 -- File_Name is the same as Name, but has been normalized.
383 -- Display_File_Name, however, has not been normalized.
385 -- Source_Directory is the directory in which the file
386 -- was found. It hasn't been normalized (nor has had links resolved).
387 -- It should not end with a directory separator, to avoid duplicates
390 -- If For_All_Sources is True, then all possible file names are analyzed
391 -- otherwise only those currently set in the Source_Names htable.
393 procedure Check_Naming_Schemes
394 (In_Tree : Project_Tree_Ref;
395 Data : in out Project_Data;
397 File_Name : File_Name_Type;
398 Alternate_Languages : out Alternate_Language_Id;
399 Language : out Language_Index;
400 Language_Name : out Name_Id;
401 Display_Language_Name : out Name_Id;
403 Lang_Kind : out Language_Kind;
404 Kind : out Source_Kind);
405 -- Check if the file name File_Name conforms to one of the naming
406 -- schemes of the project.
408 -- If the file does not match one of the naming schemes, set Language
409 -- to No_Language_Index.
411 -- Filename is the name of the file being investigated. It has been
412 -- normalized (case-folded). File_Name is the same value.
414 procedure Free_Ada_Naming_Exceptions;
415 -- Free the internal hash tables used for checking naming exceptions
417 procedure Get_Directories
418 (Project : Project_Id;
419 In_Tree : Project_Tree_Ref;
420 Current_Dir : String;
421 Data : in out Project_Data);
422 -- Get the object directory, the exec directory and the source directories
425 -- Current_Dir should represent the current directory, and is passed for
426 -- efficiency to avoid system calls to recompute it.
429 (Project : Project_Id;
430 In_Tree : Project_Tree_Ref;
431 Data : in out Project_Data);
432 -- Get the mains of a project from attribute Main, if it exists, and put
433 -- them in the project data.
435 procedure Get_Sources_From_File
437 Location : Source_Ptr;
438 Project : Project_Id;
439 In_Tree : Project_Tree_Ref);
440 -- Get the list of sources from a text file and put them in hash table
443 procedure Find_Explicit_Sources
444 (Current_Dir : String;
445 Project : Project_Id;
446 In_Tree : Project_Tree_Ref;
447 Data : in out Project_Data);
448 -- Process the Source_Files and Source_List_File attributes, and store
449 -- the list of source files into the Source_Names htable.
451 -- Lang indicates which language is being processed when in Ada_Only mode
452 -- (all languages are processed anyway when in Multi_Language mode).
455 (In_Tree : Project_Tree_Ref;
456 Canonical_File_Name : File_Name_Type;
457 Naming : Naming_Data;
458 Exception_Id : out Ada_Naming_Exception_Id;
459 Unit_Name : out Name_Id;
460 Unit_Kind : out Spec_Or_Body;
461 Needs_Pragma : out Boolean);
462 -- Find out, from a file name, the unit name, the unit kind and if a
463 -- specific SFN pragma is needed. If the file name corresponds to no unit,
464 -- then Unit_Name will be No_Name. If the file is a multi-unit source or an
465 -- exception to the naming scheme, then Exception_Id is set to the unit or
466 -- units that the source contains.
468 function Is_Illegal_Suffix
470 Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean;
471 -- Returns True if the string Suffix cannot be used as a spec suffix, a
472 -- body suffix or a separate suffix.
474 procedure Locate_Directory
475 (Project : Project_Id;
476 In_Tree : Project_Tree_Ref;
477 Name : File_Name_Type;
478 Parent : Path_Name_Type;
479 Dir : out Path_Name_Type;
480 Display : out Path_Name_Type;
481 Create : String := "";
482 Current_Dir : String;
483 Location : Source_Ptr := No_Location);
484 -- Locate a directory. Name is the directory name. Parent is the root
485 -- directory, if Name a relative path name. Dir is set to the canonical
486 -- case path name of the directory, and Display is the directory path name
487 -- for display purposes. If the directory does not exist and Project_Setup
488 -- is True and Create is a non null string, an attempt is made to create
489 -- the directory. If the directory does not exist and Project_Setup is
490 -- false, then Dir and Display are set to No_Name.
492 -- Current_Dir should represent the current directory, and is passed for
493 -- efficiency to avoid system calls to recompute it.
495 procedure Look_For_Sources
496 (Project : Project_Id;
497 In_Tree : Project_Tree_Ref;
498 Data : in out Project_Data;
499 Current_Dir : String);
500 -- Find all the sources of project Project in project tree In_Tree and
501 -- update its Data accordingly.
503 -- Current_Dir should represent the current directory, and is passed for
504 -- efficiency to avoid system calls to recompute it.
506 function Path_Name_Of
507 (File_Name : File_Name_Type;
508 Directory : Path_Name_Type) return String;
509 -- Returns the path name of a (non project) file. Returns an empty string
510 -- if file cannot be found.
512 procedure Prepare_Ada_Naming_Exceptions
513 (List : Array_Element_Id;
514 In_Tree : Project_Tree_Ref;
515 Kind : Spec_Or_Body);
516 -- Prepare the internal hash tables used for checking naming exceptions
517 -- for Ada. Insert all elements of List in the tables.
519 function Project_Extends
520 (Extending : Project_Id;
521 Extended : Project_Id;
522 In_Tree : Project_Tree_Ref) return Boolean;
523 -- Returns True if Extending is extending Extended either directly or
526 procedure Record_Ada_Source
527 (File_Name : File_Name_Type;
528 Path_Name : Path_Name_Type;
529 Project : Project_Id;
530 In_Tree : Project_Tree_Ref;
531 Data : in out Project_Data;
532 Location : Source_Ptr;
533 Current_Source : in out String_List_Id;
534 Source_Recorded : in out Boolean;
535 Current_Dir : String);
536 -- Put a unit in the list of units of a project, if the file name
537 -- corresponds to a valid unit name.
539 -- Current_Dir should represent the current directory, and is passed for
540 -- efficiency to avoid system calls to recompute it.
542 procedure Remove_Source
544 Replaced_By : Source_Id;
545 Project : Project_Id;
546 Data : in out Project_Data;
547 In_Tree : Project_Tree_Ref);
550 procedure Report_No_Sources
551 (Project : Project_Id;
553 In_Tree : Project_Tree_Ref;
554 Location : Source_Ptr;
555 Continuation : Boolean := False);
556 -- Report an error or a warning depending on the value of When_No_Sources
557 -- when there are no sources for language Lang_Name.
559 procedure Show_Source_Dirs
560 (Data : Project_Data; In_Tree : Project_Tree_Ref);
561 -- List all the source directories of a project
563 procedure Warn_If_Not_Sources
564 (Project : Project_Id;
565 In_Tree : Project_Tree_Ref;
566 Conventions : Array_Element_Id;
568 Extending : Boolean);
569 -- Check that individual naming conventions apply to immediate sources of
570 -- the project. If not, issue a warning.
578 Data : in out Project_Data;
579 In_Tree : Project_Tree_Ref;
580 Project : Project_Id;
582 Lang_Id : Language_Index;
584 File_Name : File_Name_Type;
585 Display_File : File_Name_Type;
586 Lang_Kind : Language_Kind;
587 Naming_Exception : Boolean := False;
588 Path : Path_Name_Type := No_Path;
589 Display_Path : Path_Name_Type := No_Path;
590 Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
591 Other_Part : Source_Id := No_Source;
592 Unit : Name_Id := No_Name;
594 Source_To_Replace : Source_Id := No_Source)
596 Source : constant Source_Id := Data.Last_Source;
597 Src_Data : Source_Data := No_Source_Data;
598 Config : constant Language_Config :=
599 In_Tree.Languages_Data.Table (Lang_Id).Config;
602 -- This is a new source so create an entry for it in the Sources table
604 Source_Data_Table.Increment_Last (In_Tree.Sources);
605 Id := Source_Data_Table.Last (In_Tree.Sources);
607 if Current_Verbosity = High then
608 Write_Str ("Adding source #");
610 Write_Str (", File : ");
611 Write_Str (Get_Name_String (File_Name));
613 if Lang_Kind = Unit_Based then
614 Write_Str (", Unit : ");
615 Write_Str (Get_Name_String (Unit));
621 Src_Data.Project := Project;
622 Src_Data.Language_Name := Lang;
623 Src_Data.Language := Lang_Id;
624 Src_Data.Lang_Kind := Lang_Kind;
625 Src_Data.Compiled := In_Tree.Languages_Data.Table
626 (Lang_Id).Config.Compiler_Driver /=
628 Src_Data.Kind := Kind;
629 Src_Data.Alternate_Languages := Alternate_Languages;
630 Src_Data.Other_Part := Other_Part;
632 Src_Data.Object_Exists := Config.Object_Generated;
633 Src_Data.Object_Linked := Config.Objects_Linked;
635 if Other_Part /= No_Source then
636 In_Tree.Sources.Table (Other_Part).Other_Part := Id;
639 Src_Data.Unit := Unit;
640 Src_Data.Index := Index;
641 Src_Data.File := File_Name;
642 Src_Data.Display_File := Display_File;
643 Src_Data.Dependency := In_Tree.Languages_Data.Table
644 (Lang_Id).Config.Dependency_Kind;
645 Src_Data.Naming_Exception := Naming_Exception;
647 if Src_Data.Compiled and then Src_Data.Object_Exists then
648 Src_Data.Object := Object_Name (File_Name);
650 Dependency_Name (File_Name, Src_Data.Dependency);
651 Src_Data.Switches := Switches_Name (File_Name);
654 if Path /= No_Path then
655 Src_Data.Path := (Path, Display_Path);
656 Source_Paths_Htable.Set (In_Tree.Source_Paths_HT, Path, Id);
659 -- Add the source id to the Unit_Sources_HT hash table, if the unit name
662 if Unit /= No_Name then
663 Unit_Sources_Htable.Set (In_Tree.Unit_Sources_HT, Unit, Id);
666 -- Add the source to the global list
668 Src_Data.Next_In_Sources := In_Tree.First_Source;
669 In_Tree.First_Source := Id;
671 -- Add the source to the project list
673 if Source = No_Source then
674 Data.First_Source := Id;
676 In_Tree.Sources.Table (Source).Next_In_Project := Id;
679 Data.Last_Source := Id;
681 -- Add the source to the language list
683 Src_Data.Next_In_Lang :=
684 In_Tree.Languages_Data.Table (Lang_Id).First_Source;
685 In_Tree.Languages_Data.Table (Lang_Id).First_Source := Id;
687 In_Tree.Sources.Table (Id) := Src_Data;
689 if Source_To_Replace /= No_Source then
690 Remove_Source (Source_To_Replace, Id, Project, Data, In_Tree);
698 function ALI_File_Name (Source : String) return String is
700 -- If the source name has an extension, then replace it with
703 for Index in reverse Source'First + 1 .. Source'Last loop
704 if Source (Index) = '.' then
705 return Source (Source'First .. Index - 1) & ALI_Suffix;
709 -- If there is no dot, or if it is the first character, just add the
712 return Source & ALI_Suffix;
720 (Project : Project_Id;
721 In_Tree : Project_Tree_Ref;
722 Report_Error : Put_Line_Access;
723 When_No_Sources : Error_Warning;
724 Current_Dir : String)
726 Data : Project_Data := In_Tree.Projects.Table (Project);
727 Extending : Boolean := False;
730 Nmsc.When_No_Sources := When_No_Sources;
731 Error_Report := Report_Error;
733 Recursive_Dirs.Reset;
735 Check_If_Externally_Built (Project, In_Tree, Data);
737 -- Object, exec and source directories
739 Get_Directories (Project, In_Tree, Current_Dir, Data);
741 -- Get the programming languages
743 Check_Programming_Languages (In_Tree, Project, Data);
745 if Data.Qualifier = Dry and then Data.Source_Dirs /= Nil_String then
748 "an abstract project need to have no language, no sources or no " &
749 "source directories",
753 -- Check configuration in multi language mode
755 if Must_Check_Configuration then
756 Check_Configuration (Project, In_Tree, Data);
759 -- Library attributes
761 Check_Library_Attributes (Project, In_Tree, Current_Dir, Data);
763 if Current_Verbosity = High then
764 Show_Source_Dirs (Data, In_Tree);
767 Check_Package_Naming (Project, In_Tree, Data);
769 Extending := Data.Extends /= No_Project;
771 Check_Naming_Schemes (Data, Project, In_Tree);
773 if Get_Mode = Ada_Only then
774 Prepare_Ada_Naming_Exceptions
775 (Data.Naming.Bodies, In_Tree, Body_Part);
776 Prepare_Ada_Naming_Exceptions
777 (Data.Naming.Specs, In_Tree, Specification);
782 if Data.Source_Dirs /= Nil_String then
783 Look_For_Sources (Project, In_Tree, Data, Current_Dir);
785 if Get_Mode = Ada_Only then
787 -- Check that all individual naming conventions apply to sources
788 -- of this project file.
791 (Project, In_Tree, Data.Naming.Bodies,
793 Extending => Extending);
795 (Project, In_Tree, Data.Naming.Specs,
797 Extending => Extending);
799 elsif Get_Mode = Multi_Language and then
800 (not Data.Externally_Built) and then
804 Language : Language_Index;
806 Alt_Lang : Alternate_Language_Id;
807 Alt_Lang_Data : Alternate_Language_Data;
808 Continuation : Boolean := False;
811 Language := Data.First_Language_Processing;
812 while Language /= No_Language_Index loop
813 Source := Data.First_Source;
814 Source_Loop : while Source /= No_Source loop
816 Src_Data : Source_Data renames
817 In_Tree.Sources.Table (Source);
820 exit Source_Loop when Src_Data.Language = Language;
822 Alt_Lang := Src_Data.Alternate_Languages;
825 while Alt_Lang /= No_Alternate_Language loop
827 In_Tree.Alt_Langs.Table (Alt_Lang);
829 when Alt_Lang_Data.Language = Language;
830 Alt_Lang := Alt_Lang_Data.Next;
831 end loop Alternate_Loop;
833 Source := Src_Data.Next_In_Project;
835 end loop Source_Loop;
837 if Source = No_Source then
841 (In_Tree.Languages_Data.Table
842 (Language).Display_Name),
846 Continuation := True;
849 Language := In_Tree.Languages_Data.Table (Language).Next;
855 if Get_Mode = Multi_Language then
857 -- If a list of sources is specified in attribute Interfaces, set
858 -- In_Interfaces only for the sources specified in the list.
860 Check_Interfaces (Project, In_Tree, Data);
863 -- If it is a library project file, check if it is a standalone library
866 Check_Stand_Alone_Library
867 (Project, In_Tree, Data, Current_Dir, Extending);
870 -- Put the list of Mains, if any, in the project data
872 Get_Mains (Project, In_Tree, Data);
874 -- Update the project data in the Projects table
876 In_Tree.Projects.Table (Project) := Data;
878 Free_Ada_Naming_Exceptions;
885 procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is
886 The_Name : String := Name;
888 Need_Letter : Boolean := True;
889 Last_Underscore : Boolean := False;
890 OK : Boolean := The_Name'Length > 0;
893 function Is_Reserved (Name : Name_Id) return Boolean;
894 function Is_Reserved (S : String) return Boolean;
895 -- Check that the given name is not an Ada 95 reserved word. The reason
896 -- for the Ada 95 here is that we do not want to exclude the case of an
897 -- Ada 95 unit called Interface (for example). In Ada 2005, such a unit
898 -- name would be rejected anyway by the compiler. That means there is no
899 -- requirement that the project file parser reject this.
905 function Is_Reserved (S : String) return Boolean is
908 Add_Str_To_Name_Buffer (S);
909 return Is_Reserved (Name_Find);
916 function Is_Reserved (Name : Name_Id) return Boolean is
918 if Get_Name_Table_Byte (Name) /= 0
919 and then Name /= Name_Project
920 and then Name /= Name_Extends
921 and then Name /= Name_External
922 and then Name not in Ada_2005_Reserved_Words
926 if Current_Verbosity = High then
927 Write_Str (The_Name);
928 Write_Line (" is an Ada reserved word.");
938 -- Start of processing for Check_Ada_Name
943 Name_Len := The_Name'Length;
944 Name_Buffer (1 .. Name_Len) := The_Name;
946 -- Special cases of children of packages A, G, I and S on VMS
949 and then Name_Len > 3
950 and then Name_Buffer (2 .. 3) = "__"
952 ((Name_Buffer (1) = 'a') or else
953 (Name_Buffer (1) = 'g') or else
954 (Name_Buffer (1) = 'i') or else
955 (Name_Buffer (1) = 's'))
957 Name_Buffer (2) := '.';
958 Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
959 Name_Len := Name_Len - 1;
962 Real_Name := Name_Find;
964 if Is_Reserved (Real_Name) then
968 First := The_Name'First;
970 for Index in The_Name'Range loop
973 -- We need a letter (at the beginning, and following a dot),
974 -- but we don't have one.
976 if Is_Letter (The_Name (Index)) then
977 Need_Letter := False;
982 if Current_Verbosity = High then
983 Write_Int (Types.Int (Index));
985 Write_Char (The_Name (Index));
986 Write_Line ("' is not a letter.");
992 elsif Last_Underscore
993 and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
995 -- Two underscores are illegal, and a dot cannot follow
1000 if Current_Verbosity = High then
1001 Write_Int (Types.Int (Index));
1003 Write_Char (The_Name (Index));
1004 Write_Line ("' is illegal here.");
1009 elsif The_Name (Index) = '.' then
1011 -- First, check if the name before the dot is not a reserved word
1012 if Is_Reserved (The_Name (First .. Index - 1)) then
1018 -- We need a letter after a dot
1020 Need_Letter := True;
1022 elsif The_Name (Index) = '_' then
1023 Last_Underscore := True;
1026 -- We need an letter or a digit
1028 Last_Underscore := False;
1030 if not Is_Alphanumeric (The_Name (Index)) then
1033 if Current_Verbosity = High then
1034 Write_Int (Types.Int (Index));
1036 Write_Char (The_Name (Index));
1037 Write_Line ("' is not alphanumeric.");
1045 -- Cannot end with an underscore or a dot
1047 OK := OK and then not Need_Letter and then not Last_Underscore;
1050 if First /= Name'First and then
1051 Is_Reserved (The_Name (First .. The_Name'Last))
1059 -- Signal a problem with No_Name
1065 --------------------------------------
1066 -- Check_Ada_Naming_Scheme_Validity --
1067 --------------------------------------
1069 procedure Check_Ada_Naming_Scheme_Validity
1070 (Project : Project_Id;
1071 In_Tree : Project_Tree_Ref;
1072 Naming : Naming_Data)
1075 -- Only check if we are not using the Default naming scheme
1077 if Naming /= In_Tree.Private_Part.Default_Naming then
1079 Dot_Replacement : constant String :=
1081 (Naming.Dot_Replacement);
1083 Spec_Suffix : constant String :=
1084 Spec_Suffix_Of (In_Tree, "ada", Naming);
1086 Body_Suffix : constant String :=
1087 Body_Suffix_Of (In_Tree, "ada", Naming);
1089 Separate_Suffix : constant String :=
1091 (Naming.Separate_Suffix);
1094 -- Dot_Replacement cannot
1097 -- - start or end with an alphanumeric
1098 -- - be a single '_'
1099 -- - start with an '_' followed by an alphanumeric
1100 -- - contain a '.' except if it is "."
1102 if Dot_Replacement'Length = 0
1103 or else Is_Alphanumeric
1104 (Dot_Replacement (Dot_Replacement'First))
1105 or else Is_Alphanumeric
1106 (Dot_Replacement (Dot_Replacement'Last))
1107 or else (Dot_Replacement (Dot_Replacement'First) = '_'
1109 (Dot_Replacement'Length = 1
1112 (Dot_Replacement (Dot_Replacement'First + 1))))
1113 or else (Dot_Replacement'Length > 1
1115 Index (Source => Dot_Replacement,
1116 Pattern => ".") /= 0)
1120 '"' & Dot_Replacement &
1121 """ is illegal for Dot_Replacement.",
1122 Naming.Dot_Repl_Loc);
1128 if Is_Illegal_Suffix
1129 (Spec_Suffix, Dot_Replacement = ".")
1131 Err_Vars.Error_Msg_File_1 :=
1132 Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
1135 "{ is illegal for Spec_Suffix",
1136 Naming.Ada_Spec_Suffix_Loc);
1139 if Is_Illegal_Suffix
1140 (Body_Suffix, Dot_Replacement = ".")
1142 Err_Vars.Error_Msg_File_1 :=
1143 Body_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
1146 "{ is illegal for Body_Suffix",
1147 Naming.Ada_Body_Suffix_Loc);
1150 if Body_Suffix /= Separate_Suffix then
1151 if Is_Illegal_Suffix
1152 (Separate_Suffix, Dot_Replacement = ".")
1154 Err_Vars.Error_Msg_File_1 := Naming.Separate_Suffix;
1157 "{ is illegal for Separate_Suffix",
1158 Naming.Sep_Suffix_Loc);
1162 -- Spec_Suffix cannot be equal to Body_Suffix Separate_Suffix,
1163 -- since that would cause a clear ambiguity. Note that we do
1164 -- allow a Spec_Suffix to have the same termination as one of
1165 -- these, which causes a potential ambiguity, but we resolve
1166 -- that my matching the longest possible suffix.
1168 if Spec_Suffix = Body_Suffix then
1173 """) cannot be the same as Spec_Suffix.",
1174 Naming.Ada_Body_Suffix_Loc);
1177 if Body_Suffix /= Separate_Suffix
1178 and then Spec_Suffix = Separate_Suffix
1182 "Separate_Suffix (""" &
1184 """) cannot be the same as Spec_Suffix.",
1185 Naming.Sep_Suffix_Loc);
1189 end Check_Ada_Naming_Scheme_Validity;
1191 -------------------------
1192 -- Check_Configuration --
1193 -------------------------
1195 procedure Check_Configuration
1196 (Project : Project_Id;
1197 In_Tree : Project_Tree_Ref;
1198 Data : in out Project_Data)
1200 Dot_Replacement : File_Name_Type := No_File;
1201 Casing : Casing_Type := All_Lower_Case;
1202 Separate_Suffix : File_Name_Type := No_File;
1204 Lang_Index : Language_Index := No_Language_Index;
1205 -- The index of the language data being checked
1207 Prev_Index : Language_Index := No_Language_Index;
1208 -- The index of the previous language
1210 Current_Language : Name_Id := No_Name;
1211 -- The name of the language
1213 Lang_Data : Language_Data;
1214 -- The data of the language being checked
1216 procedure Get_Language_Index_Of (Language : Name_Id);
1217 -- Get the language index of Language, if Language is one of the
1218 -- languages of the project.
1220 procedure Process_Project_Level_Simple_Attributes;
1221 -- Process the simple attributes at the project level
1223 procedure Process_Project_Level_Array_Attributes;
1224 -- Process the associate array attributes at the project level
1226 procedure Process_Packages;
1227 -- Read the packages of the project
1229 ---------------------------
1230 -- Get_Language_Index_Of --
1231 ---------------------------
1233 procedure Get_Language_Index_Of (Language : Name_Id) is
1234 Real_Language : Name_Id;
1237 Get_Name_String (Language);
1238 To_Lower (Name_Buffer (1 .. Name_Len));
1239 Real_Language := Name_Find;
1241 -- Nothing to do if the language is the same as the current language
1243 if Current_Language /= Real_Language then
1244 Lang_Index := Data.First_Language_Processing;
1245 while Lang_Index /= No_Language_Index loop
1246 exit when In_Tree.Languages_Data.Table (Lang_Index).Name =
1249 In_Tree.Languages_Data.Table (Lang_Index).Next;
1252 if Lang_Index = No_Language_Index then
1253 Current_Language := No_Name;
1255 Current_Language := Real_Language;
1258 end Get_Language_Index_Of;
1260 ----------------------
1261 -- Process_Packages --
1262 ----------------------
1264 procedure Process_Packages is
1265 Packages : Package_Id;
1266 Element : Package_Element;
1268 procedure Process_Binder (Arrays : Array_Id);
1269 -- Process the associate array attributes of package Binder
1271 procedure Process_Builder (Attributes : Variable_Id);
1272 -- Process the simple attributes of package Builder
1274 procedure Process_Compiler (Arrays : Array_Id);
1275 -- Process the associate array attributes of package Compiler
1277 procedure Process_Naming (Attributes : Variable_Id);
1278 -- Process the simple attributes of package Naming
1280 procedure Process_Naming (Arrays : Array_Id);
1281 -- Process the associate array attributes of package Naming
1283 procedure Process_Linker (Attributes : Variable_Id);
1284 -- Process the simple attributes of package Linker of a
1285 -- configuration project.
1287 --------------------
1288 -- Process_Binder --
1289 --------------------
1291 procedure Process_Binder (Arrays : Array_Id) is
1292 Current_Array_Id : Array_Id;
1293 Current_Array : Array_Data;
1294 Element_Id : Array_Element_Id;
1295 Element : Array_Element;
1298 -- Process the associative array attribute of package Binder
1300 Current_Array_Id := Arrays;
1301 while Current_Array_Id /= No_Array loop
1302 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1304 Element_Id := Current_Array.Value;
1305 while Element_Id /= No_Array_Element loop
1306 Element := In_Tree.Array_Elements.Table (Element_Id);
1308 if Element.Index /= All_Other_Names then
1310 -- Get the name of the language
1312 Get_Language_Index_Of (Element.Index);
1314 if Lang_Index /= No_Language_Index then
1315 case Current_Array.Name is
1318 -- Attribute Driver (<language>)
1320 In_Tree.Languages_Data.Table
1321 (Lang_Index).Config.Binder_Driver :=
1322 File_Name_Type (Element.Value.Value);
1324 when Name_Required_Switches =>
1326 In_Tree.Languages_Data.Table
1327 (Lang_Index).Config.Binder_Required_Switches,
1328 From_List => Element.Value.Values,
1329 In_Tree => In_Tree);
1333 -- Attribute Prefix (<language>)
1335 In_Tree.Languages_Data.Table
1336 (Lang_Index).Config.Binder_Prefix :=
1337 Element.Value.Value;
1339 when Name_Objects_Path =>
1341 -- Attribute Objects_Path (<language>)
1343 In_Tree.Languages_Data.Table
1344 (Lang_Index).Config.Objects_Path :=
1345 Element.Value.Value;
1347 when Name_Objects_Path_File =>
1349 -- Attribute Objects_Path (<language>)
1351 In_Tree.Languages_Data.Table
1352 (Lang_Index).Config.Objects_Path_File :=
1353 Element.Value.Value;
1361 Element_Id := Element.Next;
1364 Current_Array_Id := Current_Array.Next;
1368 ---------------------
1369 -- Process_Builder --
1370 ---------------------
1372 procedure Process_Builder (Attributes : Variable_Id) is
1373 Attribute_Id : Variable_Id;
1374 Attribute : Variable;
1377 -- Process non associated array attribute from package Builder
1379 Attribute_Id := Attributes;
1380 while Attribute_Id /= No_Variable loop
1382 In_Tree.Variable_Elements.Table (Attribute_Id);
1384 if not Attribute.Value.Default then
1385 if Attribute.Name = Name_Executable_Suffix then
1387 -- Attribute Executable_Suffix: the suffix of the
1390 Data.Config.Executable_Suffix :=
1391 Attribute.Value.Value;
1395 Attribute_Id := Attribute.Next;
1397 end Process_Builder;
1399 ----------------------
1400 -- Process_Compiler --
1401 ----------------------
1403 procedure Process_Compiler (Arrays : Array_Id) is
1404 Current_Array_Id : Array_Id;
1405 Current_Array : Array_Data;
1406 Element_Id : Array_Element_Id;
1407 Element : Array_Element;
1408 List : String_List_Id;
1411 -- Process the associative array attribute of package Compiler
1413 Current_Array_Id := Arrays;
1414 while Current_Array_Id /= No_Array loop
1415 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1417 Element_Id := Current_Array.Value;
1418 while Element_Id /= No_Array_Element loop
1419 Element := In_Tree.Array_Elements.Table (Element_Id);
1421 if Element.Index /= All_Other_Names then
1423 -- Get the name of the language
1425 Get_Language_Index_Of (Element.Index);
1427 if Lang_Index /= No_Language_Index then
1428 case Current_Array.Name is
1429 when Name_Dependency_Switches =>
1431 -- Attribute Dependency_Switches (<language>)
1433 if In_Tree.Languages_Data.Table
1434 (Lang_Index).Config.Dependency_Kind = None
1436 In_Tree.Languages_Data.Table
1437 (Lang_Index).Config.Dependency_Kind :=
1441 List := Element.Value.Values;
1443 if List /= Nil_String then
1445 In_Tree.Languages_Data.Table
1446 (Lang_Index).Config.Dependency_Option,
1448 In_Tree => In_Tree);
1451 when Name_Dependency_Driver =>
1453 -- Attribute Dependency_Driver (<language>)
1455 if In_Tree.Languages_Data.Table
1456 (Lang_Index).Config.Dependency_Kind = None
1458 In_Tree.Languages_Data.Table
1459 (Lang_Index).Config.Dependency_Kind :=
1463 List := Element.Value.Values;
1465 if List /= Nil_String then
1467 In_Tree.Languages_Data.Table
1468 (Lang_Index).Config.Compute_Dependency,
1470 In_Tree => In_Tree);
1473 when Name_Include_Switches =>
1475 -- Attribute Include_Switches (<language>)
1477 List := Element.Value.Values;
1479 if List = Nil_String then
1483 "include option cannot be null",
1484 Element.Value.Location);
1488 In_Tree.Languages_Data.Table
1489 (Lang_Index).Config.Include_Option,
1491 In_Tree => In_Tree);
1493 when Name_Include_Path =>
1495 -- Attribute Include_Path (<language>)
1497 In_Tree.Languages_Data.Table
1498 (Lang_Index).Config.Include_Path :=
1499 Element.Value.Value;
1501 when Name_Include_Path_File =>
1503 -- Attribute Include_Path_File (<language>)
1505 In_Tree.Languages_Data.Table
1506 (Lang_Index).Config.Include_Path_File :=
1507 Element.Value.Value;
1511 -- Attribute Driver (<language>)
1513 Get_Name_String (Element.Value.Value);
1515 In_Tree.Languages_Data.Table
1516 (Lang_Index).Config.Compiler_Driver :=
1517 File_Name_Type (Element.Value.Value);
1519 when Name_Required_Switches =>
1521 In_Tree.Languages_Data.Table
1522 (Lang_Index).Config.
1523 Compiler_Required_Switches,
1524 From_List => Element.Value.Values,
1525 In_Tree => In_Tree);
1527 when Name_Path_Syntax =>
1529 In_Tree.Languages_Data.Table
1530 (Lang_Index).Config.Path_Syntax :=
1531 Path_Syntax_Kind'Value
1532 (Get_Name_String (Element.Value.Value));
1535 when Constraint_Error =>
1539 "invalid value for Path_Syntax",
1540 Element.Value.Location);
1543 when Name_Pic_Option =>
1545 -- Attribute Compiler_Pic_Option (<language>)
1547 List := Element.Value.Values;
1549 if List = Nil_String then
1553 "compiler PIC option cannot be null",
1554 Element.Value.Location);
1558 In_Tree.Languages_Data.Table
1559 (Lang_Index).Config.Compilation_PIC_Option,
1561 In_Tree => In_Tree);
1563 when Name_Mapping_File_Switches =>
1565 -- Attribute Mapping_File_Switches (<language>)
1567 List := Element.Value.Values;
1569 if List = Nil_String then
1573 "mapping file switches cannot be null",
1574 Element.Value.Location);
1578 In_Tree.Languages_Data.Table
1579 (Lang_Index).Config.Mapping_File_Switches,
1581 In_Tree => In_Tree);
1583 when Name_Mapping_Spec_Suffix =>
1585 -- Attribute Mapping_Spec_Suffix (<language>)
1587 In_Tree.Languages_Data.Table
1588 (Lang_Index).Config.Mapping_Spec_Suffix :=
1589 File_Name_Type (Element.Value.Value);
1591 when Name_Mapping_Body_Suffix =>
1593 -- Attribute Mapping_Body_Suffix (<language>)
1595 In_Tree.Languages_Data.Table
1596 (Lang_Index).Config.Mapping_Body_Suffix :=
1597 File_Name_Type (Element.Value.Value);
1599 when Name_Config_File_Switches =>
1601 -- Attribute Config_File_Switches (<language>)
1603 List := Element.Value.Values;
1605 if List = Nil_String then
1609 "config file switches cannot be null",
1610 Element.Value.Location);
1614 In_Tree.Languages_Data.Table
1615 (Lang_Index).Config.Config_File_Switches,
1617 In_Tree => In_Tree);
1619 when Name_Objects_Path =>
1621 -- Attribute Objects_Path (<language>)
1623 In_Tree.Languages_Data.Table
1624 (Lang_Index).Config.Objects_Path :=
1625 Element.Value.Value;
1627 when Name_Objects_Path_File =>
1629 -- Attribute Objects_Path_File (<language>)
1631 In_Tree.Languages_Data.Table
1632 (Lang_Index).Config.Objects_Path_File :=
1633 Element.Value.Value;
1635 when Name_Config_Body_File_Name =>
1637 -- Attribute Config_Body_File_Name (<language>)
1639 In_Tree.Languages_Data.Table
1640 (Lang_Index).Config.Config_Body :=
1641 Element.Value.Value;
1643 when Name_Config_Body_File_Name_Pattern =>
1645 -- Attribute Config_Body_File_Name_Pattern
1648 In_Tree.Languages_Data.Table
1649 (Lang_Index).Config.Config_Body_Pattern :=
1650 Element.Value.Value;
1652 when Name_Config_Spec_File_Name =>
1654 -- Attribute Config_Spec_File_Name (<language>)
1656 In_Tree.Languages_Data.Table
1657 (Lang_Index).Config.Config_Spec :=
1658 Element.Value.Value;
1660 when Name_Config_Spec_File_Name_Pattern =>
1662 -- Attribute Config_Spec_File_Name_Pattern
1665 In_Tree.Languages_Data.Table
1666 (Lang_Index).Config.Config_Spec_Pattern :=
1667 Element.Value.Value;
1669 when Name_Config_File_Unique =>
1671 -- Attribute Config_File_Unique (<language>)
1674 In_Tree.Languages_Data.Table
1675 (Lang_Index).Config.Config_File_Unique :=
1677 (Get_Name_String (Element.Value.Value));
1679 when Constraint_Error =>
1683 "illegal value for Config_File_Unique",
1684 Element.Value.Location);
1693 Element_Id := Element.Next;
1696 Current_Array_Id := Current_Array.Next;
1698 end Process_Compiler;
1700 --------------------
1701 -- Process_Naming --
1702 --------------------
1704 procedure Process_Naming (Attributes : Variable_Id) is
1705 Attribute_Id : Variable_Id;
1706 Attribute : Variable;
1709 -- Process non associated array attribute from package Naming
1711 Attribute_Id := Attributes;
1712 while Attribute_Id /= No_Variable loop
1713 Attribute := In_Tree.Variable_Elements.Table (Attribute_Id);
1715 if not Attribute.Value.Default then
1716 if Attribute.Name = Name_Separate_Suffix then
1718 -- Attribute Separate_Suffix
1720 Separate_Suffix := File_Name_Type (Attribute.Value.Value);
1722 elsif Attribute.Name = Name_Casing then
1728 Value (Get_Name_String (Attribute.Value.Value));
1731 when Constraint_Error =>
1735 "invalid value for Casing",
1736 Attribute.Value.Location);
1739 elsif Attribute.Name = Name_Dot_Replacement then
1741 -- Attribute Dot_Replacement
1743 Dot_Replacement := File_Name_Type (Attribute.Value.Value);
1748 Attribute_Id := Attribute.Next;
1752 procedure Process_Naming (Arrays : Array_Id) is
1753 Current_Array_Id : Array_Id;
1754 Current_Array : Array_Data;
1755 Element_Id : Array_Element_Id;
1756 Element : Array_Element;
1758 -- Process the associative array attribute of package Naming
1760 Current_Array_Id := Arrays;
1761 while Current_Array_Id /= No_Array loop
1762 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1764 Element_Id := Current_Array.Value;
1765 while Element_Id /= No_Array_Element loop
1766 Element := In_Tree.Array_Elements.Table (Element_Id);
1768 -- Get the name of the language
1770 Get_Language_Index_Of (Element.Index);
1772 if Lang_Index /= No_Language_Index then
1773 case Current_Array.Name is
1774 when Name_Specification_Suffix | Name_Spec_Suffix =>
1776 -- Attribute Spec_Suffix (<language>)
1778 In_Tree.Languages_Data.Table
1779 (Lang_Index).Config.Naming_Data.Spec_Suffix :=
1780 File_Name_Type (Element.Value.Value);
1782 when Name_Implementation_Suffix | Name_Body_Suffix =>
1784 -- Attribute Body_Suffix (<language>)
1786 In_Tree.Languages_Data.Table
1787 (Lang_Index).Config.Naming_Data.Body_Suffix :=
1788 File_Name_Type (Element.Value.Value);
1790 In_Tree.Languages_Data.Table
1791 (Lang_Index).Config.Naming_Data.Separate_Suffix :=
1792 File_Name_Type (Element.Value.Value);
1799 Element_Id := Element.Next;
1802 Current_Array_Id := Current_Array.Next;
1806 --------------------
1807 -- Process_Linker --
1808 --------------------
1810 procedure Process_Linker (Attributes : Variable_Id) is
1811 Attribute_Id : Variable_Id;
1812 Attribute : Variable;
1815 -- Process non associated array attribute from package Linker
1817 Attribute_Id := Attributes;
1818 while Attribute_Id /= No_Variable loop
1820 In_Tree.Variable_Elements.Table (Attribute_Id);
1822 if not Attribute.Value.Default then
1823 if Attribute.Name = Name_Driver then
1825 -- Attribute Linker'Driver: the default linker to use
1827 Data.Config.Linker :=
1828 Path_Name_Type (Attribute.Value.Value);
1830 elsif Attribute.Name = Name_Required_Switches then
1832 -- Attribute Required_Switches: the minimum
1833 -- options to use when invoking the linker
1836 Data.Config.Minimum_Linker_Options,
1837 From_List => Attribute.Value.Values,
1838 In_Tree => In_Tree);
1840 elsif Attribute.Name = Name_Map_File_Option then
1841 Data.Config.Map_File_Option := Attribute.Value.Value;
1845 Attribute_Id := Attribute.Next;
1849 -- Start of processing for Process_Packages
1852 Packages := Data.Decl.Packages;
1853 while Packages /= No_Package loop
1854 Element := In_Tree.Packages.Table (Packages);
1856 case Element.Name is
1859 -- Process attributes of package Binder
1861 Process_Binder (Element.Decl.Arrays);
1863 when Name_Builder =>
1865 -- Process attributes of package Builder
1867 Process_Builder (Element.Decl.Attributes);
1869 when Name_Compiler =>
1871 -- Process attributes of package Compiler
1873 Process_Compiler (Element.Decl.Arrays);
1877 -- Process attributes of package Linker
1879 Process_Linker (Element.Decl.Attributes);
1883 -- Process attributes of package Naming
1885 Process_Naming (Element.Decl.Attributes);
1886 Process_Naming (Element.Decl.Arrays);
1892 Packages := Element.Next;
1894 end Process_Packages;
1896 ---------------------------------------------
1897 -- Process_Project_Level_Simple_Attributes --
1898 ---------------------------------------------
1900 procedure Process_Project_Level_Simple_Attributes is
1901 Attribute_Id : Variable_Id;
1902 Attribute : Variable;
1903 List : String_List_Id;
1906 -- Process non associated array attribute at project level
1908 Attribute_Id := Data.Decl.Attributes;
1909 while Attribute_Id /= No_Variable loop
1911 In_Tree.Variable_Elements.Table (Attribute_Id);
1913 if not Attribute.Value.Default then
1914 if Attribute.Name = Name_Library_Builder then
1916 -- Attribute Library_Builder: the application to invoke
1917 -- to build libraries.
1919 Data.Config.Library_Builder :=
1920 Path_Name_Type (Attribute.Value.Value);
1922 elsif Attribute.Name = Name_Archive_Builder then
1924 -- Attribute Archive_Builder: the archive builder
1925 -- (usually "ar") and its minimum options (usually "cr").
1927 List := Attribute.Value.Values;
1929 if List = Nil_String then
1933 "archive builder cannot be null",
1934 Attribute.Value.Location);
1937 Put (Into_List => Data.Config.Archive_Builder,
1939 In_Tree => In_Tree);
1941 elsif Attribute.Name = Name_Archive_Builder_Append_Option then
1943 -- Attribute Archive_Builder: the archive builder
1944 -- (usually "ar") and its minimum options (usually "cr").
1946 List := Attribute.Value.Values;
1948 if List /= Nil_String then
1950 (Into_List => Data.Config.Archive_Builder_Append_Option,
1952 In_Tree => In_Tree);
1955 elsif Attribute.Name = Name_Archive_Indexer then
1957 -- Attribute Archive_Indexer: the optional archive
1958 -- indexer (usually "ranlib") with its minimum options
1961 List := Attribute.Value.Values;
1963 if List = Nil_String then
1967 "archive indexer cannot be null",
1968 Attribute.Value.Location);
1971 Put (Into_List => Data.Config.Archive_Indexer,
1973 In_Tree => In_Tree);
1975 elsif Attribute.Name = Name_Library_Partial_Linker then
1977 -- Attribute Library_Partial_Linker: the optional linker
1978 -- driver with its minimum options, to partially link
1981 List := Attribute.Value.Values;
1983 if List = Nil_String then
1987 "partial linker cannot be null",
1988 Attribute.Value.Location);
1991 Put (Into_List => Data.Config.Lib_Partial_Linker,
1993 In_Tree => In_Tree);
1995 elsif Attribute.Name = Name_Library_GCC then
1996 Data.Config.Shared_Lib_Driver :=
1997 File_Name_Type (Attribute.Value.Value);
1999 elsif Attribute.Name = Name_Archive_Suffix then
2000 Data.Config.Archive_Suffix :=
2001 File_Name_Type (Attribute.Value.Value);
2003 elsif Attribute.Name = Name_Linker_Executable_Option then
2005 -- Attribute Linker_Executable_Option: optional options
2006 -- to specify an executable name. Defaults to "-o".
2008 List := Attribute.Value.Values;
2010 if List = Nil_String then
2014 "linker executable option cannot be null",
2015 Attribute.Value.Location);
2018 Put (Into_List => Data.Config.Linker_Executable_Option,
2020 In_Tree => In_Tree);
2022 elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
2024 -- Attribute Linker_Lib_Dir_Option: optional options
2025 -- to specify a library search directory. Defaults to
2028 Get_Name_String (Attribute.Value.Value);
2030 if Name_Len = 0 then
2034 "linker library directory option cannot be empty",
2035 Attribute.Value.Location);
2038 Data.Config.Linker_Lib_Dir_Option := Attribute.Value.Value;
2040 elsif Attribute.Name = Name_Linker_Lib_Name_Option then
2042 -- Attribute Linker_Lib_Name_Option: optional options
2043 -- to specify the name of a library to be linked in.
2044 -- Defaults to "-l".
2046 Get_Name_String (Attribute.Value.Value);
2048 if Name_Len = 0 then
2052 "linker library name option cannot be empty",
2053 Attribute.Value.Location);
2056 Data.Config.Linker_Lib_Name_Option := Attribute.Value.Value;
2058 elsif Attribute.Name = Name_Run_Path_Option then
2060 -- Attribute Run_Path_Option: optional options to
2061 -- specify a path for libraries.
2063 List := Attribute.Value.Values;
2065 if List /= Nil_String then
2066 Put (Into_List => Data.Config.Run_Path_Option,
2068 In_Tree => In_Tree);
2071 elsif Attribute.Name = Name_Library_Support then
2073 pragma Unsuppress (All_Checks);
2075 Data.Config.Lib_Support :=
2076 Library_Support'Value (Get_Name_String
2077 (Attribute.Value.Value));
2079 when Constraint_Error =>
2083 "invalid value """ &
2084 Get_Name_String (Attribute.Value.Value) &
2085 """ for Library_Support",
2086 Attribute.Value.Location);
2089 elsif Attribute.Name = Name_Shared_Library_Prefix then
2090 Data.Config.Shared_Lib_Prefix :=
2091 File_Name_Type (Attribute.Value.Value);
2093 elsif Attribute.Name = Name_Shared_Library_Suffix then
2094 Data.Config.Shared_Lib_Suffix :=
2095 File_Name_Type (Attribute.Value.Value);
2097 elsif Attribute.Name = Name_Symbolic_Link_Supported then
2099 pragma Unsuppress (All_Checks);
2101 Data.Config.Symbolic_Link_Supported :=
2102 Boolean'Value (Get_Name_String
2103 (Attribute.Value.Value));
2105 when Constraint_Error =>
2110 & Get_Name_String (Attribute.Value.Value)
2111 & """ for Symbolic_Link_Supported",
2112 Attribute.Value.Location);
2116 Attribute.Name = Name_Library_Major_Minor_Id_Supported
2119 pragma Unsuppress (All_Checks);
2121 Data.Config.Lib_Maj_Min_Id_Supported :=
2122 Boolean'Value (Get_Name_String
2123 (Attribute.Value.Value));
2125 when Constraint_Error =>
2129 "invalid value """ &
2130 Get_Name_String (Attribute.Value.Value) &
2131 """ for Library_Major_Minor_Id_Supported",
2132 Attribute.Value.Location);
2135 elsif Attribute.Name = Name_Library_Auto_Init_Supported then
2137 pragma Unsuppress (All_Checks);
2139 Data.Config.Auto_Init_Supported :=
2140 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2142 when Constraint_Error =>
2147 & Get_Name_String (Attribute.Value.Value)
2148 & """ for Library_Auto_Init_Supported",
2149 Attribute.Value.Location);
2152 elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
2153 List := Attribute.Value.Values;
2155 if List /= Nil_String then
2156 Put (Into_List => Data.Config.Shared_Lib_Min_Options,
2158 In_Tree => In_Tree);
2161 elsif Attribute.Name = Name_Library_Version_Switches then
2162 List := Attribute.Value.Values;
2164 if List /= Nil_String then
2165 Put (Into_List => Data.Config.Lib_Version_Options,
2167 In_Tree => In_Tree);
2172 Attribute_Id := Attribute.Next;
2174 end Process_Project_Level_Simple_Attributes;
2176 --------------------------------------------
2177 -- Process_Project_Level_Array_Attributes --
2178 --------------------------------------------
2180 procedure Process_Project_Level_Array_Attributes is
2181 Current_Array_Id : Array_Id;
2182 Current_Array : Array_Data;
2183 Element_Id : Array_Element_Id;
2184 Element : Array_Element;
2185 List : String_List_Id;
2188 -- Process the associative array attributes at project level
2190 Current_Array_Id := Data.Decl.Arrays;
2191 while Current_Array_Id /= No_Array loop
2192 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
2194 Element_Id := Current_Array.Value;
2195 while Element_Id /= No_Array_Element loop
2196 Element := In_Tree.Array_Elements.Table (Element_Id);
2198 -- Get the name of the language
2200 Get_Language_Index_Of (Element.Index);
2202 if Lang_Index /= No_Language_Index then
2203 case Current_Array.Name is
2204 when Name_Inherit_Source_Path =>
2205 List := Element.Value.Values;
2207 if List /= Nil_String then
2210 In_Tree.Languages_Data.Table (Lang_Index).
2211 Config.Include_Compatible_Languages,
2214 Lower_Case => True);
2217 when Name_Toolchain_Description =>
2219 -- Attribute Toolchain_Description (<language>)
2221 In_Tree.Languages_Data.Table
2222 (Lang_Index).Config.Toolchain_Description :=
2223 Element.Value.Value;
2225 when Name_Toolchain_Version =>
2227 -- Attribute Toolchain_Version (<language>)
2229 In_Tree.Languages_Data.Table
2230 (Lang_Index).Config.Toolchain_Version :=
2231 Element.Value.Value;
2233 when Name_Runtime_Library_Dir =>
2235 -- Attribute Runtime_Library_Dir (<language>)
2237 In_Tree.Languages_Data.Table
2238 (Lang_Index).Config.Runtime_Library_Dir :=
2239 Element.Value.Value;
2241 when Name_Object_Generated =>
2243 pragma Unsuppress (All_Checks);
2249 (Get_Name_String (Element.Value.Value));
2251 In_Tree.Languages_Data.Table
2252 (Lang_Index).Config.Object_Generated := Value;
2254 -- If no object is generated, no object may be
2258 In_Tree.Languages_Data.Table
2259 (Lang_Index).Config.Objects_Linked := False;
2263 when Constraint_Error =>
2268 & Get_Name_String (Element.Value.Value)
2269 & """ for Object_Generated",
2270 Element.Value.Location);
2273 when Name_Objects_Linked =>
2275 pragma Unsuppress (All_Checks);
2281 (Get_Name_String (Element.Value.Value));
2283 -- No change if Object_Generated is False, as this
2284 -- forces Objects_Linked to be False too.
2286 if In_Tree.Languages_Data.Table
2287 (Lang_Index).Config.Object_Generated
2289 In_Tree.Languages_Data.Table
2290 (Lang_Index).Config.Objects_Linked :=
2295 when Constraint_Error =>
2300 & Get_Name_String (Element.Value.Value)
2301 & """ for Objects_Linked",
2302 Element.Value.Location);
2309 Element_Id := Element.Next;
2312 Current_Array_Id := Current_Array.Next;
2314 end Process_Project_Level_Array_Attributes;
2317 Process_Project_Level_Simple_Attributes;
2318 Process_Project_Level_Array_Attributes;
2321 -- For unit based languages, set Casing, Dot_Replacement and
2322 -- Separate_Suffix in Naming_Data.
2324 Lang_Index := Data.First_Language_Processing;
2325 while Lang_Index /= No_Language_Index loop
2326 if In_Tree.Languages_Data.Table
2327 (Lang_Index).Name = Name_Ada
2329 In_Tree.Languages_Data.Table
2330 (Lang_Index).Config.Naming_Data.Casing := Casing;
2331 In_Tree.Languages_Data.Table
2332 (Lang_Index).Config.Naming_Data.Dot_Replacement :=
2335 if Separate_Suffix /= No_File then
2336 In_Tree.Languages_Data.Table
2337 (Lang_Index).Config.Naming_Data.Separate_Suffix :=
2344 Lang_Index := In_Tree.Languages_Data.Table (Lang_Index).Next;
2347 -- Give empty names to various prefixes/suffixes, if they have not
2348 -- been specified in the configuration.
2350 if Data.Config.Archive_Suffix = No_File then
2351 Data.Config.Archive_Suffix := Empty_File;
2354 if Data.Config.Shared_Lib_Prefix = No_File then
2355 Data.Config.Shared_Lib_Prefix := Empty_File;
2358 if Data.Config.Shared_Lib_Suffix = No_File then
2359 Data.Config.Shared_Lib_Suffix := Empty_File;
2362 Lang_Index := Data.First_Language_Processing;
2363 while Lang_Index /= No_Language_Index loop
2364 Lang_Data := In_Tree.Languages_Data.Table (Lang_Index);
2366 Current_Language := Lang_Data.Display_Name;
2368 -- For all languages, Compiler_Driver needs to be specified
2370 if Lang_Data.Config.Compiler_Driver = No_File then
2371 Error_Msg_Name_1 := Current_Language;
2375 "?no compiler specified for language %%" &
2376 ", ignoring all its sources",
2379 if Lang_Index = Data.First_Language_Processing then
2380 Data.First_Language_Processing :=
2383 In_Tree.Languages_Data.Table (Prev_Index).Next :=
2387 elsif Lang_Data.Name = Name_Ada then
2388 Prev_Index := Lang_Index;
2390 -- For unit based languages, Dot_Replacement, Spec_Suffix and
2391 -- Body_Suffix need to be specified.
2393 if Lang_Data.Config.Naming_Data.Dot_Replacement = No_File then
2397 "Dot_Replacement not specified for Ada",
2401 if Lang_Data.Config.Naming_Data.Spec_Suffix = No_File then
2405 "Spec_Suffix not specified for Ada",
2409 if Lang_Data.Config.Naming_Data.Body_Suffix = No_File then
2413 "Body_Suffix not specified for Ada",
2418 Prev_Index := Lang_Index;
2420 -- For file based languages, either Spec_Suffix or Body_Suffix
2421 -- need to be specified.
2423 if Lang_Data.Config.Naming_Data.Spec_Suffix = No_File and then
2424 Lang_Data.Config.Naming_Data.Body_Suffix = No_File
2426 Error_Msg_Name_1 := Current_Language;
2430 "no suffixes specified for %%",
2435 Lang_Index := Lang_Data.Next;
2437 end Check_Configuration;
2439 -------------------------------
2440 -- Check_If_Externally_Built --
2441 -------------------------------
2443 procedure Check_If_Externally_Built
2444 (Project : Project_Id;
2445 In_Tree : Project_Tree_Ref;
2446 Data : in out Project_Data)
2448 Externally_Built : constant Variable_Value :=
2450 (Name_Externally_Built,
2451 Data.Decl.Attributes, In_Tree);
2454 if not Externally_Built.Default then
2455 Get_Name_String (Externally_Built.Value);
2456 To_Lower (Name_Buffer (1 .. Name_Len));
2458 if Name_Buffer (1 .. Name_Len) = "true" then
2459 Data.Externally_Built := True;
2461 elsif Name_Buffer (1 .. Name_Len) /= "false" then
2462 Error_Msg (Project, In_Tree,
2463 "Externally_Built may only be true or false",
2464 Externally_Built.Location);
2468 -- A virtual project extending an externally built project is itself
2469 -- externally built.
2471 if Data.Virtual and then Data.Extends /= No_Project then
2472 Data.Externally_Built :=
2473 In_Tree.Projects.Table (Data.Extends).Externally_Built;
2476 if Current_Verbosity = High then
2477 Write_Str ("Project is ");
2479 if not Data.Externally_Built then
2483 Write_Line ("externally built.");
2485 end Check_If_Externally_Built;
2487 ----------------------
2488 -- Check_Interfaces --
2489 ----------------------
2491 procedure Check_Interfaces
2492 (Project : Project_Id;
2493 In_Tree : Project_Tree_Ref;
2494 Data : in out Project_Data)
2496 Interfaces : constant Prj.Variable_Value :=
2498 (Snames.Name_Interfaces,
2499 Data.Decl.Attributes,
2502 List : String_List_Id;
2503 Element : String_Element;
2504 Name : File_Name_Type;
2508 Project_2 : Project_Id;
2509 Data_2 : Project_Data;
2512 if not Interfaces.Default then
2514 -- Set In_Interfaces to False for all sources. It will be set to True
2515 -- later for the sources in the Interfaces list.
2517 Project_2 := Project;
2520 Source := Data_2.First_Source;
2521 while Source /= No_Source loop
2523 Src_Data : Source_Data renames
2524 In_Tree.Sources.Table (Source);
2526 Src_Data.In_Interfaces := False;
2527 Source := Src_Data.Next_In_Project;
2531 Project_2 := Data_2.Extends;
2533 exit when Project_2 = No_Project;
2535 Data_2 := In_Tree.Projects.Table (Project_2);
2538 List := Interfaces.Values;
2539 while List /= Nil_String loop
2540 Element := In_Tree.String_Elements.Table (List);
2541 Get_Name_String (Element.Value);
2542 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2545 Project_2 := Project;
2549 Source := Data_2.First_Source;
2550 while Source /= No_Source loop
2552 Src_Data : Source_Data renames
2553 In_Tree.Sources.Table (Source);
2556 if Src_Data.File = Name then
2557 if not Src_Data.Locally_Removed then
2558 Src_Data.In_Interfaces := True;
2559 Src_Data.Declared_In_Interfaces := True;
2561 if Src_Data.Other_Part /= No_Source then
2562 In_Tree.Sources.Table
2563 (Src_Data.Other_Part).In_Interfaces := True;
2564 In_Tree.Sources.Table
2565 (Src_Data.Other_Part).Declared_In_Interfaces :=
2569 if Current_Verbosity = High then
2570 Write_Str (" interface: ");
2572 (Get_Name_String (Src_Data.Path.Name));
2579 Source := Src_Data.Next_In_Project;
2583 Project_2 := Data_2.Extends;
2585 exit Big_Loop when Project_2 = No_Project;
2587 Data_2 := In_Tree.Projects.Table (Project_2);
2590 if Source = No_Source then
2591 Error_Msg_File_1 := File_Name_Type (Element.Value);
2592 Error_Msg_Name_1 := Data.Name;
2597 "{ cannot be an interface of project %% " &
2598 "as it is not one of its sources",
2602 List := Element.Next;
2605 Data.Interfaces_Defined := True;
2607 elsif Data.Extends /= No_Project then
2608 Data.Interfaces_Defined :=
2609 In_Tree.Projects.Table (Data.Extends).Interfaces_Defined;
2611 if Data.Interfaces_Defined then
2612 Source := Data.First_Source;
2613 while Source /= No_Source loop
2615 Src_Data : Source_Data renames
2616 In_Tree.Sources.Table (Source);
2619 if not Src_Data.Declared_In_Interfaces then
2620 Src_Data.In_Interfaces := False;
2623 Source := Src_Data.Next_In_Project;
2628 end Check_Interfaces;
2630 --------------------------
2631 -- Check_Naming_Schemes --
2632 --------------------------
2634 procedure Check_Naming_Schemes
2635 (Data : in out Project_Data;
2636 Project : Project_Id;
2637 In_Tree : Project_Tree_Ref)
2639 Naming_Id : constant Package_Id :=
2640 Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
2641 Naming : Package_Element;
2643 procedure Check_Unit_Names (List : Array_Element_Id);
2644 -- Check that a list of unit names contains only valid names
2646 procedure Get_Exceptions (Kind : Source_Kind);
2647 -- Comment required ???
2649 procedure Get_Unit_Exceptions (Kind : Source_Kind);
2650 -- Comment required ???
2652 ----------------------
2653 -- Check_Unit_Names --
2654 ----------------------
2656 procedure Check_Unit_Names (List : Array_Element_Id) is
2657 Current : Array_Element_Id;
2658 Element : Array_Element;
2659 Unit_Name : Name_Id;
2662 -- Loop through elements of the string list
2665 while Current /= No_Array_Element loop
2666 Element := In_Tree.Array_Elements.Table (Current);
2668 -- Put file name in canonical case
2670 if not Osint.File_Names_Case_Sensitive then
2671 Get_Name_String (Element.Value.Value);
2672 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2673 Element.Value.Value := Name_Find;
2676 -- Check that it contains a valid unit name
2678 Get_Name_String (Element.Index);
2679 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name);
2681 if Unit_Name = No_Name then
2682 Err_Vars.Error_Msg_Name_1 := Element.Index;
2685 "%% is not a valid unit name.",
2686 Element.Value.Location);
2689 if Current_Verbosity = High then
2690 Write_Str (" Unit (""");
2691 Write_Str (Get_Name_String (Unit_Name));
2695 Element.Index := Unit_Name;
2696 In_Tree.Array_Elements.Table (Current) := Element;
2699 Current := Element.Next;
2701 end Check_Unit_Names;
2703 --------------------
2704 -- Get_Exceptions --
2705 --------------------
2707 procedure Get_Exceptions (Kind : Source_Kind) is
2708 Exceptions : Array_Element_Id;
2709 Exception_List : Variable_Value;
2710 Element_Id : String_List_Id;
2711 Element : String_Element;
2712 File_Name : File_Name_Type;
2713 Lang_Id : Language_Index;
2715 Lang_Kind : Language_Kind;
2722 (Name_Implementation_Exceptions,
2723 In_Arrays => Naming.Decl.Arrays,
2724 In_Tree => In_Tree);
2729 (Name_Specification_Exceptions,
2730 In_Arrays => Naming.Decl.Arrays,
2731 In_Tree => In_Tree);
2734 Lang_Id := Data.First_Language_Processing;
2735 while Lang_Id /= No_Language_Index loop
2736 if In_Tree.Languages_Data.Table (Lang_Id).Config.Kind =
2739 Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
2741 In_Tree.Languages_Data.Table (Lang_Id).Config.Kind;
2743 Exception_List := Value_Of
2745 In_Array => Exceptions,
2746 In_Tree => In_Tree);
2748 if Exception_List /= Nil_Variable_Value then
2749 Element_Id := Exception_List.Values;
2750 while Element_Id /= Nil_String loop
2751 Element := In_Tree.String_Elements.Table (Element_Id);
2753 if Osint.File_Names_Case_Sensitive then
2754 File_Name := File_Name_Type (Element.Value);
2756 Get_Name_String (Element.Value);
2757 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2758 File_Name := Name_Find;
2761 Source := Data.First_Source;
2762 while Source /= No_Source
2764 In_Tree.Sources.Table (Source).File /= File_Name
2767 In_Tree.Sources.Table (Source).Next_In_Project;
2770 if Source = No_Source then
2779 File_Name => File_Name,
2780 Display_File => File_Name_Type (Element.Value),
2781 Naming_Exception => True,
2782 Lang_Kind => Lang_Kind);
2785 -- Check if the file name is already recorded for
2786 -- another language or another kind.
2789 In_Tree.Sources.Table (Source).Language /= Lang_Id
2794 "the same file cannot be a source " &
2798 elsif In_Tree.Sources.Table (Source).Kind /= Kind then
2802 "the same file cannot be a source " &
2807 -- If the file is already recorded for the same
2808 -- language and the same kind, it means that the file
2809 -- name appears several times in the *_Exceptions
2810 -- attribute; so there is nothing to do.
2814 Element_Id := Element.Next;
2819 Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next;
2823 -------------------------
2824 -- Get_Unit_Exceptions --
2825 -------------------------
2827 procedure Get_Unit_Exceptions (Kind : Source_Kind) is
2828 Exceptions : Array_Element_Id;
2829 Element : Array_Element;
2832 File_Name : File_Name_Type;
2833 Lang_Id : constant Language_Index :=
2834 Data.Unit_Based_Language_Index;
2835 Lang : constant Name_Id :=
2836 Data.Unit_Based_Language_Name;
2839 Source_To_Replace : Source_Id := No_Source;
2841 Other_Project : Project_Id;
2842 Other_Part : Source_Id := No_Source;
2845 if Lang_Id = No_Language_Index or else Lang = No_Name then
2850 Exceptions := Value_Of
2852 In_Arrays => Naming.Decl.Arrays,
2853 In_Tree => In_Tree);
2855 if Exceptions = No_Array_Element then
2858 (Name_Implementation,
2859 In_Arrays => Naming.Decl.Arrays,
2860 In_Tree => In_Tree);
2867 In_Arrays => Naming.Decl.Arrays,
2868 In_Tree => In_Tree);
2870 if Exceptions = No_Array_Element then
2871 Exceptions := Value_Of
2872 (Name_Specification,
2873 In_Arrays => Naming.Decl.Arrays,
2874 In_Tree => In_Tree);
2879 while Exceptions /= No_Array_Element loop
2880 Element := In_Tree.Array_Elements.Table (Exceptions);
2882 if Osint.File_Names_Case_Sensitive then
2883 File_Name := File_Name_Type (Element.Value.Value);
2885 Get_Name_String (Element.Value.Value);
2886 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2887 File_Name := Name_Find;
2890 Get_Name_String (Element.Index);
2891 To_Lower (Name_Buffer (1 .. Name_Len));
2894 Index := Element.Value.Index;
2896 -- For Ada, check if it is a valid unit name
2898 if Lang = Name_Ada then
2899 Get_Name_String (Element.Index);
2900 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
2902 if Unit = No_Name then
2903 Err_Vars.Error_Msg_Name_1 := Element.Index;
2906 "%% is not a valid unit name.",
2907 Element.Value.Location);
2911 if Unit /= No_Name then
2913 -- Check if the source already exists
2915 Source := In_Tree.First_Source;
2916 Source_To_Replace := No_Source;
2918 while Source /= No_Source and then
2919 (In_Tree.Sources.Table (Source).Unit /= Unit or else
2920 In_Tree.Sources.Table (Source).Index /= Index)
2922 Source := In_Tree.Sources.Table (Source).Next_In_Sources;
2925 if Source /= No_Source then
2926 if In_Tree.Sources.Table (Source).Kind /= Kind then
2927 Other_Part := Source;
2931 In_Tree.Sources.Table (Source).Next_In_Sources;
2933 exit when Source = No_Source or else
2934 (In_Tree.Sources.Table (Source).Unit = Unit
2936 In_Tree.Sources.Table (Source).Index = Index);
2940 if Source /= No_Source then
2941 Other_Project := In_Tree.Sources.Table (Source).Project;
2943 if Is_Extending (Project, Other_Project, In_Tree) then
2945 In_Tree.Sources.Table (Source).Other_Part;
2947 -- Record the source to be removed
2949 Source_To_Replace := Source;
2950 Source := No_Source;
2953 Error_Msg_Name_1 := Unit;
2955 In_Tree.Projects.Table (Other_Project).Name;
2959 "%% is already a source of project %%",
2960 Element.Value.Location);
2965 if Source = No_Source then
2974 File_Name => File_Name,
2975 Display_File => File_Name_Type (Element.Value.Value),
2976 Lang_Kind => Unit_Based,
2977 Other_Part => Other_Part,
2980 Naming_Exception => True,
2981 Source_To_Replace => Source_To_Replace);
2985 Exceptions := Element.Next;
2988 end Get_Unit_Exceptions;
2990 -- Start of processing for Check_Naming_Schemes
2993 if Get_Mode = Ada_Only then
2995 -- If there is a package Naming, we will put in Data.Naming what is
2996 -- in this package Naming.
2998 if Naming_Id /= No_Package then
2999 Naming := In_Tree.Packages.Table (Naming_Id);
3001 if Current_Verbosity = High then
3002 Write_Line ("Checking ""Naming"" for Ada.");
3006 Bodies : constant Array_Element_Id :=
3008 (Name_Body, Naming.Decl.Arrays, In_Tree);
3010 Specs : constant Array_Element_Id :=
3012 (Name_Spec, Naming.Decl.Arrays, In_Tree);
3015 if Bodies /= No_Array_Element then
3017 -- We have elements in the array Body_Part
3019 if Current_Verbosity = High then
3020 Write_Line ("Found Bodies.");
3023 Data.Naming.Bodies := Bodies;
3024 Check_Unit_Names (Bodies);
3027 if Current_Verbosity = High then
3028 Write_Line ("No Bodies.");
3032 if Specs /= No_Array_Element then
3034 -- We have elements in the array Specs
3036 if Current_Verbosity = High then
3037 Write_Line ("Found Specs.");
3040 Data.Naming.Specs := Specs;
3041 Check_Unit_Names (Specs);
3044 if Current_Verbosity = High then
3045 Write_Line ("No Specs.");
3050 -- We are now checking if variables Dot_Replacement, Casing,
3051 -- Spec_Suffix, Body_Suffix and/or Separate_Suffix exist.
3053 -- For each variable, if it does not exist, we do nothing,
3054 -- because we already have the default.
3056 -- Check Dot_Replacement
3059 Dot_Replacement : constant Variable_Value :=
3061 (Name_Dot_Replacement,
3062 Naming.Decl.Attributes, In_Tree);
3065 pragma Assert (Dot_Replacement.Kind = Single,
3066 "Dot_Replacement is not a single string");
3068 if not Dot_Replacement.Default then
3069 Get_Name_String (Dot_Replacement.Value);
3071 if Name_Len = 0 then
3074 "Dot_Replacement cannot be empty",
3075 Dot_Replacement.Location);
3078 if Osint.File_Names_Case_Sensitive then
3079 Data.Naming.Dot_Replacement :=
3080 File_Name_Type (Dot_Replacement.Value);
3082 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3083 Data.Naming.Dot_Replacement := Name_Find;
3085 Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
3090 if Current_Verbosity = High then
3091 Write_Str (" Dot_Replacement = """);
3092 Write_Str (Get_Name_String (Data.Naming.Dot_Replacement));
3100 Casing_String : constant Variable_Value :=
3103 Naming.Decl.Attributes,
3107 pragma Assert (Casing_String.Kind = Single,
3108 "Casing is not a single string");
3110 if not Casing_String.Default then
3112 Casing_Image : constant String :=
3113 Get_Name_String (Casing_String.Value);
3116 Casing_Value : constant Casing_Type :=
3117 Value (Casing_Image);
3119 Data.Naming.Casing := Casing_Value;
3123 when Constraint_Error =>
3124 if Casing_Image'Length = 0 then
3127 "Casing cannot be an empty string",
3128 Casing_String.Location);
3131 Name_Len := Casing_Image'Length;
3132 Name_Buffer (1 .. Name_Len) := Casing_Image;
3133 Err_Vars.Error_Msg_Name_1 := Name_Find;
3136 "%% is not a correct Casing",
3137 Casing_String.Location);
3143 if Current_Verbosity = High then
3144 Write_Str (" Casing = ");
3145 Write_Str (Image (Data.Naming.Casing));
3150 -- Check Spec_Suffix
3153 Ada_Spec_Suffix : constant Variable_Value :=
3157 In_Array => Data.Naming.Spec_Suffix,
3158 In_Tree => In_Tree);
3161 if Ada_Spec_Suffix.Kind = Single
3162 and then Get_Name_String (Ada_Spec_Suffix.Value) /= ""
3164 Get_Name_String (Ada_Spec_Suffix.Value);
3165 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3166 Set_Spec_Suffix (In_Tree, "ada", Data.Naming, Name_Find);
3167 Data.Naming.Ada_Spec_Suffix_Loc := Ada_Spec_Suffix.Location;
3174 Default_Ada_Spec_Suffix);
3178 if Current_Verbosity = High then
3179 Write_Str (" Spec_Suffix = """);
3180 Write_Str (Spec_Suffix_Of (In_Tree, "ada", Data.Naming));
3185 -- Check Body_Suffix
3188 Ada_Body_Suffix : constant Variable_Value :=
3192 In_Array => Data.Naming.Body_Suffix,
3193 In_Tree => In_Tree);
3196 if Ada_Body_Suffix.Kind = Single
3197 and then Get_Name_String (Ada_Body_Suffix.Value) /= ""
3199 Get_Name_String (Ada_Body_Suffix.Value);
3200 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3201 Set_Body_Suffix (In_Tree, "ada", Data.Naming, Name_Find);
3202 Data.Naming.Ada_Body_Suffix_Loc := Ada_Body_Suffix.Location;
3209 Default_Ada_Body_Suffix);
3213 if Current_Verbosity = High then
3214 Write_Str (" Body_Suffix = """);
3215 Write_Str (Body_Suffix_Of (In_Tree, "ada", Data.Naming));
3220 -- Check Separate_Suffix
3223 Ada_Sep_Suffix : constant Variable_Value :=
3225 (Variable_Name => Name_Separate_Suffix,
3226 In_Variables => Naming.Decl.Attributes,
3227 In_Tree => In_Tree);
3230 if Ada_Sep_Suffix.Default then
3231 Data.Naming.Separate_Suffix :=
3232 Body_Suffix_Id_Of (In_Tree, Name_Ada, Data.Naming);
3235 Get_Name_String (Ada_Sep_Suffix.Value);
3237 if Name_Len = 0 then
3240 "Separate_Suffix cannot be empty",
3241 Ada_Sep_Suffix.Location);
3244 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3245 Data.Naming.Separate_Suffix := Name_Find;
3246 Data.Naming.Sep_Suffix_Loc := Ada_Sep_Suffix.Location;
3251 if Current_Verbosity = High then
3252 Write_Str (" Separate_Suffix = """);
3253 Write_Str (Get_Name_String (Data.Naming.Separate_Suffix));
3258 -- Check if Data.Naming is valid
3260 Check_Ada_Naming_Scheme_Validity (Project, In_Tree, Data.Naming);
3263 elsif not In_Configuration then
3265 -- Look into package Naming, if there is one
3267 if Naming_Id /= No_Package then
3268 Naming := In_Tree.Packages.Table (Naming_Id);
3270 if Current_Verbosity = High then
3271 Write_Line ("Checking package Naming.");
3274 -- We are now checking if attribute Dot_Replacement, Casing,
3275 -- and/or Separate_Suffix exist.
3277 -- For each attribute, if it does not exist, we do nothing,
3278 -- because we already have the default.
3279 -- Otherwise, for all unit-based languages, we put the declared
3280 -- value in the language config.
3283 Dot_Repl : constant Variable_Value :=
3285 (Name_Dot_Replacement,
3286 Naming.Decl.Attributes, In_Tree);
3287 Dot_Replacement : File_Name_Type := No_File;
3289 Casing_String : constant Variable_Value :=
3292 Naming.Decl.Attributes,
3294 Casing : Casing_Type;
3295 Casing_Defined : Boolean := False;
3297 Sep_Suffix : constant Variable_Value :=
3299 (Variable_Name => Name_Separate_Suffix,
3300 In_Variables => Naming.Decl.Attributes,
3301 In_Tree => In_Tree);
3302 Separate_Suffix : File_Name_Type := No_File;
3304 Lang_Id : Language_Index;
3306 -- Check attribute Dot_Replacement
3308 if not Dot_Repl.Default then
3309 Get_Name_String (Dot_Repl.Value);
3311 if Name_Len = 0 then
3314 "Dot_Replacement cannot be empty",
3318 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3319 Dot_Replacement := Name_Find;
3321 if Current_Verbosity = High then
3322 Write_Str (" Dot_Replacement = """);
3323 Write_Str (Get_Name_String (Dot_Replacement));
3330 -- Check attribute Casing
3332 if not Casing_String.Default then
3334 Casing_Image : constant String :=
3335 Get_Name_String (Casing_String.Value);
3338 Casing_Value : constant Casing_Type :=
3339 Value (Casing_Image);
3341 Casing := Casing_Value;
3342 Casing_Defined := True;
3344 if Current_Verbosity = High then
3345 Write_Str (" Casing = ");
3346 Write_Str (Image (Casing));
3353 when Constraint_Error =>
3354 if Casing_Image'Length = 0 then
3357 "Casing cannot be an empty string",
3358 Casing_String.Location);
3361 Name_Len := Casing_Image'Length;
3362 Name_Buffer (1 .. Name_Len) := Casing_Image;
3363 Err_Vars.Error_Msg_Name_1 := Name_Find;
3366 "%% is not a correct Casing",
3367 Casing_String.Location);
3372 if not Sep_Suffix.Default then
3373 Get_Name_String (Sep_Suffix.Value);
3375 if Name_Len = 0 then
3378 "Separate_Suffix cannot be empty",
3379 Sep_Suffix.Location);
3382 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3383 Separate_Suffix := Name_Find;
3385 if Current_Verbosity = High then
3386 Write_Str (" Separate_Suffix = """);
3387 Write_Str (Get_Name_String (Separate_Suffix));
3394 -- For all unit based languages, if any, set the specified
3395 -- value of Dot_Replacement, Casing and/or Separate_Suffix.
3397 if Dot_Replacement /= No_File
3398 or else Casing_Defined
3399 or else Separate_Suffix /= No_File
3401 Lang_Id := Data.First_Language_Processing;
3402 while Lang_Id /= No_Language_Index loop
3403 if In_Tree.Languages_Data.Table
3404 (Lang_Id).Config.Kind = Unit_Based
3406 if Dot_Replacement /= No_File then
3407 In_Tree.Languages_Data.Table
3408 (Lang_Id).Config.Naming_Data.Dot_Replacement :=
3412 if Casing_Defined then
3413 In_Tree.Languages_Data.Table
3414 (Lang_Id).Config.Naming_Data.Casing := Casing;
3417 if Separate_Suffix /= No_File then
3418 In_Tree.Languages_Data.Table
3419 (Lang_Id).Config.Naming_Data.Separate_Suffix :=
3425 In_Tree.Languages_Data.Table (Lang_Id).Next;
3430 -- Next, get the spec and body suffixes
3433 Suffix : Variable_Value;
3434 Lang_Id : Language_Index;
3438 Lang_Id := Data.First_Language_Processing;
3439 while Lang_Id /= No_Language_Index loop
3440 Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
3446 Attribute_Or_Array_Name => Name_Spec_Suffix,
3447 In_Package => Naming_Id,
3448 In_Tree => In_Tree);
3450 if Suffix = Nil_Variable_Value then
3453 Attribute_Or_Array_Name => Name_Specification_Suffix,
3454 In_Package => Naming_Id,
3455 In_Tree => In_Tree);
3458 if Suffix /= Nil_Variable_Value then
3459 In_Tree.Languages_Data.Table (Lang_Id).
3460 Config.Naming_Data.Spec_Suffix :=
3461 File_Name_Type (Suffix.Value);
3468 Attribute_Or_Array_Name => Name_Body_Suffix,
3469 In_Package => Naming_Id,
3470 In_Tree => In_Tree);
3472 if Suffix = Nil_Variable_Value then
3475 Attribute_Or_Array_Name => Name_Implementation_Suffix,
3476 In_Package => Naming_Id,
3477 In_Tree => In_Tree);
3480 if Suffix /= Nil_Variable_Value then
3481 In_Tree.Languages_Data.Table (Lang_Id).
3482 Config.Naming_Data.Body_Suffix :=
3483 File_Name_Type (Suffix.Value);
3486 Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next;
3490 -- Get the exceptions for file based languages
3492 Get_Exceptions (Spec);
3493 Get_Exceptions (Impl);
3495 -- Get the exceptions for unit based languages
3497 Get_Unit_Exceptions (Spec);
3498 Get_Unit_Exceptions (Impl);
3502 end Check_Naming_Schemes;
3504 ------------------------------
3505 -- Check_Library_Attributes --
3506 ------------------------------
3508 procedure Check_Library_Attributes
3509 (Project : Project_Id;
3510 In_Tree : Project_Tree_Ref;
3511 Current_Dir : String;
3512 Data : in out Project_Data)
3514 Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
3516 Lib_Dir : constant Prj.Variable_Value :=
3518 (Snames.Name_Library_Dir, Attributes, In_Tree);
3520 Lib_Name : constant Prj.Variable_Value :=
3522 (Snames.Name_Library_Name, Attributes, In_Tree);
3524 Lib_Version : constant Prj.Variable_Value :=
3526 (Snames.Name_Library_Version, Attributes, In_Tree);
3528 Lib_ALI_Dir : constant Prj.Variable_Value :=
3530 (Snames.Name_Library_Ali_Dir, Attributes, In_Tree);
3532 The_Lib_Kind : constant Prj.Variable_Value :=
3534 (Snames.Name_Library_Kind, Attributes, In_Tree);
3536 Imported_Project_List : Project_List := Empty_Project_List;
3538 Continuation : String_Access := No_Continuation_String'Access;
3540 Support_For_Libraries : Library_Support;
3542 Library_Directory_Present : Boolean;
3544 procedure Check_Library (Proj : Project_Id; Extends : Boolean);
3545 -- Check if an imported or extended project if also a library project
3551 procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
3552 Proj_Data : Project_Data;
3556 if Proj /= No_Project then
3557 Proj_Data := In_Tree.Projects.Table (Proj);
3559 if not Proj_Data.Library then
3561 -- The only not library projects that are OK are those that
3562 -- have no sources. However, header files from non-Ada
3563 -- languages are OK, as there is nothing to compile.
3565 Src_Id := Proj_Data.First_Source;
3566 while Src_Id /= No_Source loop
3568 Src : Source_Data renames In_Tree.Sources.Table (Src_Id);
3570 exit when Src.Lang_Kind /= File_Based
3571 or else Src.Kind /= Spec;
3572 Src_Id := Src.Next_In_Project;
3576 if Src_Id /= No_Source then
3577 Error_Msg_Name_1 := Data.Name;
3578 Error_Msg_Name_2 := Proj_Data.Name;
3581 if Data.Library_Kind /= Static then
3585 "shared library project %% cannot extend " &
3586 "project %% that is not a library project",
3588 Continuation := Continuation_String'Access;
3591 elsif Data.Library_Kind /= Static then
3595 "shared library project %% cannot import project %% " &
3596 "that is not a shared library project",
3598 Continuation := Continuation_String'Access;
3602 elsif Data.Library_Kind /= Static and then
3603 Proj_Data.Library_Kind = Static
3605 Error_Msg_Name_1 := Data.Name;
3606 Error_Msg_Name_2 := Proj_Data.Name;
3612 "shared library project %% cannot extend static " &
3613 "library project %%",
3620 "shared library project %% cannot import static " &
3621 "library project %%",
3625 Continuation := Continuation_String'Access;
3630 -- Start of processing for Check_Library_Attributes
3633 Library_Directory_Present := Lib_Dir.Value /= Empty_String;
3635 -- Special case of extending project
3637 if Data.Extends /= No_Project then
3639 Extended_Data : constant Project_Data :=
3640 In_Tree.Projects.Table (Data.Extends);
3643 -- If the project extended is a library project, we inherit the
3644 -- library name, if it is not redefined; we check that the library
3645 -- directory is specified.
3647 if Extended_Data.Library then
3648 if Data.Qualifier = Standard then
3651 "a standard project cannot extend a library project",
3655 if Lib_Name.Default then
3656 Data.Library_Name := Extended_Data.Library_Name;
3659 if Lib_Dir.Default then
3660 if not Data.Virtual then
3663 "a project extending a library project must " &
3664 "specify an attribute Library_Dir",
3668 -- For a virtual project extending a library project,
3669 -- inherit library directory.
3671 Data.Library_Dir := Extended_Data.Library_Dir;
3672 Library_Directory_Present := True;
3680 pragma Assert (Lib_Name.Kind = Single);
3682 if Lib_Name.Value = Empty_String then
3683 if Current_Verbosity = High
3684 and then Data.Library_Name = No_Name
3686 Write_Line ("No library name");
3690 -- There is no restriction on the syntax of library names
3692 Data.Library_Name := Lib_Name.Value;
3695 if Data.Library_Name /= No_Name then
3696 if Current_Verbosity = High then
3697 Write_Str ("Library name = """);
3698 Write_Str (Get_Name_String (Data.Library_Name));
3702 pragma Assert (Lib_Dir.Kind = Single);
3704 if not Library_Directory_Present then
3705 if Current_Verbosity = High then
3706 Write_Line ("No library directory");
3710 -- Find path name (unless inherited), check that it is a directory
3712 if Data.Library_Dir = No_Path_Information then
3716 File_Name_Type (Lib_Dir.Value),
3717 Data.Directory.Display_Name,
3718 Data.Library_Dir.Name,
3719 Data.Library_Dir.Display_Name,
3720 Create => "library",
3721 Current_Dir => Current_Dir,
3722 Location => Lib_Dir.Location);
3725 if Data.Library_Dir = No_Path_Information then
3727 -- Get the absolute name of the library directory that
3728 -- does not exist, to report an error.
3731 Dir_Name : constant String :=
3732 Get_Name_String (Lib_Dir.Value);
3735 if Is_Absolute_Path (Dir_Name) then
3736 Err_Vars.Error_Msg_File_1 :=
3737 File_Name_Type (Lib_Dir.Value);
3740 Get_Name_String (Data.Directory.Display_Name);
3742 if Name_Buffer (Name_Len) /= Directory_Separator then
3743 Name_Len := Name_Len + 1;
3744 Name_Buffer (Name_Len) := Directory_Separator;
3748 (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
3750 Name_Len := Name_Len + Dir_Name'Length;
3751 Err_Vars.Error_Msg_File_1 := Name_Find;
3758 "library directory { does not exist",
3762 -- The library directory cannot be the same as the Object
3765 elsif Data.Library_Dir.Name = Data.Object_Directory.Name then
3768 "library directory cannot be the same " &
3769 "as object directory",
3771 Data.Library_Dir := No_Path_Information;
3775 OK : Boolean := True;
3776 Dirs_Id : String_List_Id;
3777 Dir_Elem : String_Element;
3780 -- The library directory cannot be the same as a source
3781 -- directory of the current project.
3783 Dirs_Id := Data.Source_Dirs;
3784 while Dirs_Id /= Nil_String loop
3785 Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
3786 Dirs_Id := Dir_Elem.Next;
3789 Data.Library_Dir.Name = Path_Name_Type (Dir_Elem.Value)
3791 Err_Vars.Error_Msg_File_1 :=
3792 File_Name_Type (Dir_Elem.Value);
3795 "library directory cannot be the same " &
3796 "as source directory {",
3805 -- The library directory cannot be the same as a source
3806 -- directory of another project either.
3809 for Pid in 1 .. Project_Table.Last (In_Tree.Projects) loop
3810 if Pid /= Project then
3811 Dirs_Id := In_Tree.Projects.Table (Pid).Source_Dirs;
3813 Dir_Loop : while Dirs_Id /= Nil_String loop
3815 In_Tree.String_Elements.Table (Dirs_Id);
3816 Dirs_Id := Dir_Elem.Next;
3818 if Data.Library_Dir.Name =
3819 Path_Name_Type (Dir_Elem.Value)
3821 Err_Vars.Error_Msg_File_1 :=
3822 File_Name_Type (Dir_Elem.Value);
3823 Err_Vars.Error_Msg_Name_1 :=
3824 In_Tree.Projects.Table (Pid).Name;
3828 "library directory cannot be the same " &
3829 "as source directory { of project %%",
3836 end loop Project_Loop;
3840 Data.Library_Dir := No_Path_Information;
3842 elsif Current_Verbosity = High then
3844 -- Display the Library directory in high verbosity
3846 Write_Str ("Library directory =""");
3848 (Get_Name_String (Data.Library_Dir.Display_Name));
3858 Data.Library_Dir /= No_Path_Information
3860 Data.Library_Name /= No_Name;
3862 if Data.Extends = No_Project then
3863 case Data.Qualifier is
3865 if Data.Library then
3868 "a standard project cannot be a library project",
3873 if not Data.Library then
3876 "not a library project",
3886 if Data.Library then
3887 if Get_Mode = Multi_Language then
3888 Support_For_Libraries := Data.Config.Lib_Support;
3891 Support_For_Libraries := MLib.Tgt.Support_For_Libraries;
3894 if Support_For_Libraries = Prj.None then
3897 "?libraries are not supported on this platform",
3899 Data.Library := False;
3902 if Lib_ALI_Dir.Value = Empty_String then
3903 if Current_Verbosity = High then
3904 Write_Line ("No library ALI directory specified");
3906 Data.Library_ALI_Dir := Data.Library_Dir;
3909 -- Find path name, check that it is a directory
3914 File_Name_Type (Lib_ALI_Dir.Value),
3915 Data.Directory.Display_Name,
3916 Data.Library_ALI_Dir.Name,
3917 Data.Library_ALI_Dir.Display_Name,
3918 Create => "library ALI",
3919 Current_Dir => Current_Dir,
3920 Location => Lib_ALI_Dir.Location);
3922 if Data.Library_ALI_Dir = No_Path_Information then
3924 -- Get the absolute name of the library ALI directory that
3925 -- does not exist, to report an error.
3928 Dir_Name : constant String :=
3929 Get_Name_String (Lib_ALI_Dir.Value);
3932 if Is_Absolute_Path (Dir_Name) then
3933 Err_Vars.Error_Msg_File_1 :=
3934 File_Name_Type (Lib_Dir.Value);
3937 Get_Name_String (Data.Directory.Display_Name);
3939 if Name_Buffer (Name_Len) /= Directory_Separator then
3940 Name_Len := Name_Len + 1;
3941 Name_Buffer (Name_Len) := Directory_Separator;
3945 (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
3947 Name_Len := Name_Len + Dir_Name'Length;
3948 Err_Vars.Error_Msg_File_1 := Name_Find;
3955 "library 'A'L'I directory { does not exist",
3956 Lib_ALI_Dir.Location);
3960 if Data.Library_ALI_Dir /= Data.Library_Dir then
3962 -- The library ALI directory cannot be the same as the
3963 -- Object directory.
3965 if Data.Library_ALI_Dir = Data.Object_Directory then
3968 "library 'A'L'I directory cannot be the same " &
3969 "as object directory",
3970 Lib_ALI_Dir.Location);
3971 Data.Library_ALI_Dir := No_Path_Information;
3975 OK : Boolean := True;
3976 Dirs_Id : String_List_Id;
3977 Dir_Elem : String_Element;
3980 -- The library ALI directory cannot be the same as
3981 -- a source directory of the current project.
3983 Dirs_Id := Data.Source_Dirs;
3984 while Dirs_Id /= Nil_String loop
3985 Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
3986 Dirs_Id := Dir_Elem.Next;
3988 if Data.Library_ALI_Dir.Name =
3989 Path_Name_Type (Dir_Elem.Value)
3991 Err_Vars.Error_Msg_File_1 :=
3992 File_Name_Type (Dir_Elem.Value);
3995 "library 'A'L'I directory cannot be " &
3996 "the same as source directory {",
3997 Lib_ALI_Dir.Location);
4005 -- The library ALI directory cannot be the same as
4006 -- a source directory of another project either.
4010 Pid in 1 .. Project_Table.Last (In_Tree.Projects)
4012 if Pid /= Project then
4014 In_Tree.Projects.Table (Pid).Source_Dirs;
4017 while Dirs_Id /= Nil_String loop
4019 In_Tree.String_Elements.Table (Dirs_Id);
4020 Dirs_Id := Dir_Elem.Next;
4022 if Data.Library_ALI_Dir.Name =
4023 Path_Name_Type (Dir_Elem.Value)
4025 Err_Vars.Error_Msg_File_1 :=
4026 File_Name_Type (Dir_Elem.Value);
4027 Err_Vars.Error_Msg_Name_1 :=
4028 In_Tree.Projects.Table (Pid).Name;
4032 "library 'A'L'I directory cannot " &
4033 "be the same as source directory " &
4035 Lib_ALI_Dir.Location);
4037 exit ALI_Project_Loop;
4039 end loop ALI_Dir_Loop;
4041 end loop ALI_Project_Loop;
4045 Data.Library_ALI_Dir := No_Path_Information;
4047 elsif Current_Verbosity = High then
4049 -- Display the Library ALI directory in high
4052 Write_Str ("Library ALI directory =""");
4055 (Data.Library_ALI_Dir.Display_Name));
4063 pragma Assert (Lib_Version.Kind = Single);
4065 if Lib_Version.Value = Empty_String then
4066 if Current_Verbosity = High then
4067 Write_Line ("No library version specified");
4071 Data.Lib_Internal_Name := Lib_Version.Value;
4074 pragma Assert (The_Lib_Kind.Kind = Single);
4076 if The_Lib_Kind.Value = Empty_String then
4077 if Current_Verbosity = High then
4078 Write_Line ("No library kind specified");
4082 Get_Name_String (The_Lib_Kind.Value);
4085 Kind_Name : constant String :=
4086 To_Lower (Name_Buffer (1 .. Name_Len));
4088 OK : Boolean := True;
4091 if Kind_Name = "static" then
4092 Data.Library_Kind := Static;
4094 elsif Kind_Name = "dynamic" then
4095 Data.Library_Kind := Dynamic;
4097 elsif Kind_Name = "relocatable" then
4098 Data.Library_Kind := Relocatable;
4103 "illegal value for Library_Kind",
4104 The_Lib_Kind.Location);
4108 if Current_Verbosity = High and then OK then
4109 Write_Str ("Library kind = ");
4110 Write_Line (Kind_Name);
4113 if Data.Library_Kind /= Static and then
4114 Support_For_Libraries = Prj.Static_Only
4118 "only static libraries are supported " &
4120 The_Lib_Kind.Location);
4121 Data.Library := False;
4126 if Data.Library then
4127 if Current_Verbosity = High then
4128 Write_Line ("This is a library project file");
4131 if Get_Mode = Multi_Language then
4132 Check_Library (Data.Extends, Extends => True);
4134 Imported_Project_List := Data.Imported_Projects;
4135 while Imported_Project_List /= Empty_Project_List loop
4137 (In_Tree.Project_Lists.Table
4138 (Imported_Project_List).Project,
4140 Imported_Project_List :=
4141 In_Tree.Project_Lists.Table
4142 (Imported_Project_List).Next;
4150 -- Check if Linker'Switches or Linker'Default_Switches are declared.
4151 -- Warn if they are declared, as it is a common error to think that
4152 -- library are "linked" with Linker switches.
4154 if Data.Library then
4156 Linker_Package_Id : constant Package_Id :=
4158 (Name_Linker, Data.Decl.Packages, In_Tree);
4159 Linker_Package : Package_Element;
4160 Switches : Array_Element_Id := No_Array_Element;
4163 if Linker_Package_Id /= No_Package then
4164 Linker_Package := In_Tree.Packages.Table (Linker_Package_Id);
4168 (Name => Name_Switches,
4169 In_Arrays => Linker_Package.Decl.Arrays,
4170 In_Tree => In_Tree);
4172 if Switches = No_Array_Element then
4175 (Name => Name_Default_Switches,
4176 In_Arrays => Linker_Package.Decl.Arrays,
4177 In_Tree => In_Tree);
4180 if Switches /= No_Array_Element then
4183 "?Linker switches not taken into account in library " &
4191 if Data.Extends /= No_Project then
4192 In_Tree.Projects.Table (Data.Extends).Library := False;
4194 end Check_Library_Attributes;
4196 --------------------------
4197 -- Check_Package_Naming --
4198 --------------------------
4200 procedure Check_Package_Naming
4201 (Project : Project_Id;
4202 In_Tree : Project_Tree_Ref;
4203 Data : in out Project_Data)
4205 Naming_Id : constant Package_Id :=
4206 Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
4208 Naming : Package_Element;
4211 -- If there is a package Naming, we will put in Data.Naming
4212 -- what is in this package Naming.
4214 if Naming_Id /= No_Package then
4215 Naming := In_Tree.Packages.Table (Naming_Id);
4217 if Current_Verbosity = High then
4218 Write_Line ("Checking ""Naming"".");
4221 -- Check Spec_Suffix
4224 Spec_Suffixs : Array_Element_Id :=
4230 Suffix : Array_Element_Id;
4231 Element : Array_Element;
4232 Suffix2 : Array_Element_Id;
4235 -- If some suffixes have been specified, we make sure that
4236 -- for each language for which a default suffix has been
4237 -- specified, there is a suffix specified, either the one
4238 -- in the project file or if there were none, the default.
4240 if Spec_Suffixs /= No_Array_Element then
4241 Suffix := Data.Naming.Spec_Suffix;
4243 while Suffix /= No_Array_Element loop
4245 In_Tree.Array_Elements.Table (Suffix);
4246 Suffix2 := Spec_Suffixs;
4248 while Suffix2 /= No_Array_Element loop
4249 exit when In_Tree.Array_Elements.Table
4250 (Suffix2).Index = Element.Index;
4251 Suffix2 := In_Tree.Array_Elements.Table
4255 -- There is a registered default suffix, but no
4256 -- suffix specified in the project file.
4257 -- Add the default to the array.
4259 if Suffix2 = No_Array_Element then
4260 Array_Element_Table.Increment_Last
4261 (In_Tree.Array_Elements);
4262 In_Tree.Array_Elements.Table
4263 (Array_Element_Table.Last
4264 (In_Tree.Array_Elements)) :=
4265 (Index => Element.Index,
4266 Src_Index => Element.Src_Index,
4267 Index_Case_Sensitive => False,
4268 Value => Element.Value,
4269 Next => Spec_Suffixs);
4270 Spec_Suffixs := Array_Element_Table.Last
4271 (In_Tree.Array_Elements);
4274 Suffix := Element.Next;
4277 -- Put the resulting array as the specification suffixes
4279 Data.Naming.Spec_Suffix := Spec_Suffixs;
4284 Current : Array_Element_Id;
4285 Element : Array_Element;
4288 Current := Data.Naming.Spec_Suffix;
4289 while Current /= No_Array_Element loop
4290 Element := In_Tree.Array_Elements.Table (Current);
4291 Get_Name_String (Element.Value.Value);
4293 if Name_Len = 0 then
4296 "Spec_Suffix cannot be empty",
4297 Element.Value.Location);
4300 In_Tree.Array_Elements.Table (Current) := Element;
4301 Current := Element.Next;
4305 -- Check Body_Suffix
4308 Impl_Suffixs : Array_Element_Id :=
4314 Suffix : Array_Element_Id;
4315 Element : Array_Element;
4316 Suffix2 : Array_Element_Id;
4319 -- If some suffixes have been specified, we make sure that
4320 -- for each language for which a default suffix has been
4321 -- specified, there is a suffix specified, either the one
4322 -- in the project file or if there were none, the default.
4324 if Impl_Suffixs /= No_Array_Element then
4325 Suffix := Data.Naming.Body_Suffix;
4326 while Suffix /= No_Array_Element loop
4328 In_Tree.Array_Elements.Table (Suffix);
4330 Suffix2 := Impl_Suffixs;
4331 while Suffix2 /= No_Array_Element loop
4332 exit when In_Tree.Array_Elements.Table
4333 (Suffix2).Index = Element.Index;
4334 Suffix2 := In_Tree.Array_Elements.Table
4338 -- There is a registered default suffix, but no suffix was
4339 -- specified in the project file. Add default to the array.
4341 if Suffix2 = No_Array_Element then
4342 Array_Element_Table.Increment_Last
4343 (In_Tree.Array_Elements);
4344 In_Tree.Array_Elements.Table
4345 (Array_Element_Table.Last
4346 (In_Tree.Array_Elements)) :=
4347 (Index => Element.Index,
4348 Src_Index => Element.Src_Index,
4349 Index_Case_Sensitive => False,
4350 Value => Element.Value,
4351 Next => Impl_Suffixs);
4352 Impl_Suffixs := Array_Element_Table.Last
4353 (In_Tree.Array_Elements);
4356 Suffix := Element.Next;
4359 -- Put the resulting array as the implementation suffixes
4361 Data.Naming.Body_Suffix := Impl_Suffixs;
4366 Current : Array_Element_Id;
4367 Element : Array_Element;
4370 Current := Data.Naming.Body_Suffix;
4371 while Current /= No_Array_Element loop
4372 Element := In_Tree.Array_Elements.Table (Current);
4373 Get_Name_String (Element.Value.Value);
4375 if Name_Len = 0 then
4378 "Body_Suffix cannot be empty",
4379 Element.Value.Location);
4382 In_Tree.Array_Elements.Table (Current) := Element;
4383 Current := Element.Next;
4387 -- Get the exceptions, if any
4389 Data.Naming.Specification_Exceptions :=
4391 (Name_Specification_Exceptions,
4392 In_Arrays => Naming.Decl.Arrays,
4393 In_Tree => In_Tree);
4395 Data.Naming.Implementation_Exceptions :=
4397 (Name_Implementation_Exceptions,
4398 In_Arrays => Naming.Decl.Arrays,
4399 In_Tree => In_Tree);
4401 end Check_Package_Naming;
4403 ---------------------------------
4404 -- Check_Programming_Languages --
4405 ---------------------------------
4407 procedure Check_Programming_Languages
4408 (In_Tree : Project_Tree_Ref;
4409 Project : Project_Id;
4410 Data : in out Project_Data)
4412 Languages : Variable_Value := Nil_Variable_Value;
4413 Def_Lang : Variable_Value := Nil_Variable_Value;
4414 Def_Lang_Id : Name_Id;
4417 Data.First_Language_Processing := No_Language_Index;
4419 Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes, In_Tree);
4422 (Name_Default_Language, Data.Decl.Attributes, In_Tree);
4423 Data.Ada_Sources_Present := Data.Source_Dirs /= Nil_String;
4424 Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String;
4426 if Data.Source_Dirs /= Nil_String then
4428 -- Check if languages are specified in this project
4430 if Languages.Default then
4432 -- Attribute Languages is not specified. So, it defaults to
4433 -- a project of the default language only.
4435 Name_List_Table.Increment_Last (In_Tree.Name_Lists);
4436 Data.Languages := Name_List_Table.Last (In_Tree.Name_Lists);
4438 -- In Ada_Only mode, the default language is Ada
4440 if Get_Mode = Ada_Only then
4441 In_Tree.Name_Lists.Table (Data.Languages) :=
4442 (Name => Name_Ada, Next => No_Name_List);
4444 -- Attribute Languages is not specified. So, it defaults to
4445 -- a project of language Ada only. No sources of languages
4448 Data.Other_Sources_Present := False;
4451 -- Fail if there is no default language defined
4453 if Def_Lang.Default then
4454 if not Default_Language_Is_Ada then
4458 "no languages defined for this project",
4460 Def_Lang_Id := No_Name;
4462 Def_Lang_Id := Name_Ada;
4466 Get_Name_String (Def_Lang.Value);
4467 To_Lower (Name_Buffer (1 .. Name_Len));
4468 Def_Lang_Id := Name_Find;
4471 if Def_Lang_Id /= No_Name then
4472 In_Tree.Name_Lists.Table (Data.Languages) :=
4473 (Name => Def_Lang_Id, Next => No_Name_List);
4475 Language_Data_Table.Increment_Last (In_Tree.Languages_Data);
4477 Data.First_Language_Processing :=
4478 Language_Data_Table.Last (In_Tree.Languages_Data);
4479 In_Tree.Languages_Data.Table
4480 (Data.First_Language_Processing) := No_Language_Data;
4481 In_Tree.Languages_Data.Table
4482 (Data.First_Language_Processing).Name := Def_Lang_Id;
4483 Get_Name_String (Def_Lang_Id);
4484 Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
4485 In_Tree.Languages_Data.Table
4486 (Data.First_Language_Processing).Display_Name := Name_Find;
4488 if Def_Lang_Id = Name_Ada then
4489 In_Tree.Languages_Data.Table
4490 (Data.First_Language_Processing).Config.Kind
4492 In_Tree.Languages_Data.Table
4493 (Data.First_Language_Processing).Config.Dependency_Kind
4495 Data.Unit_Based_Language_Name := Name_Ada;
4496 Data.Unit_Based_Language_Index :=
4497 Data.First_Language_Processing;
4499 In_Tree.Languages_Data.Table
4500 (Data.First_Language_Processing).Config.Kind
4508 Current : String_List_Id := Languages.Values;
4509 Element : String_Element;
4510 Lang_Name : Name_Id;
4511 Index : Language_Index;
4512 Lang_Data : Language_Data;
4513 NL_Id : Name_List_Index := No_Name_List;
4516 -- Assume there are no language declared
4518 Data.Ada_Sources_Present := False;
4519 Data.Other_Sources_Present := False;
4521 -- If there are no languages declared, there are no sources
4523 if Current = Nil_String then
4524 Data.Source_Dirs := Nil_String;
4526 if Data.Qualifier = Standard then
4530 "a standard project cannot have no language declared",
4531 Languages.Location);
4535 -- Look through all the languages specified in attribute
4538 while Current /= Nil_String loop
4540 In_Tree.String_Elements.Table (Current);
4541 Get_Name_String (Element.Value);
4542 To_Lower (Name_Buffer (1 .. Name_Len));
4543 Lang_Name := Name_Find;
4545 NL_Id := Data.Languages;
4546 while NL_Id /= No_Name_List loop
4548 Lang_Name = In_Tree.Name_Lists.Table (NL_Id).Name;
4549 NL_Id := In_Tree.Name_Lists.Table (NL_Id).Next;
4552 if NL_Id = No_Name_List then
4553 Name_List_Table.Increment_Last (In_Tree.Name_Lists);
4555 if Data.Languages = No_Name_List then
4557 Name_List_Table.Last (In_Tree.Name_Lists);
4560 NL_Id := Data.Languages;
4561 while In_Tree.Name_Lists.Table (NL_Id).Next /=
4564 NL_Id := In_Tree.Name_Lists.Table (NL_Id).Next;
4567 In_Tree.Name_Lists.Table (NL_Id).Next :=
4568 Name_List_Table.Last (In_Tree.Name_Lists);
4571 NL_Id := Name_List_Table.Last (In_Tree.Name_Lists);
4572 In_Tree.Name_Lists.Table (NL_Id) :=
4573 (Lang_Name, No_Name_List);
4575 if Get_Mode = Ada_Only then
4576 -- Check for language Ada
4578 if Lang_Name = Name_Ada then
4579 Data.Ada_Sources_Present := True;
4582 Data.Other_Sources_Present := True;
4586 Language_Data_Table.Increment_Last
4587 (In_Tree.Languages_Data);
4589 Language_Data_Table.Last (In_Tree.Languages_Data);
4590 Lang_Data.Name := Lang_Name;
4591 Lang_Data.Display_Name := Element.Value;
4592 Lang_Data.Next := Data.First_Language_Processing;
4594 if Lang_Name = Name_Ada then
4595 Lang_Data.Config.Kind := Unit_Based;
4596 Lang_Data.Config.Dependency_Kind := ALI_File;
4597 Data.Unit_Based_Language_Name := Name_Ada;
4598 Data.Unit_Based_Language_Index := Index;
4601 Lang_Data.Config.Kind := File_Based;
4602 Lang_Data.Config.Dependency_Kind := None;
4605 In_Tree.Languages_Data.Table (Index) := Lang_Data;
4606 Data.First_Language_Processing := Index;
4610 Current := Element.Next;
4616 end Check_Programming_Languages;
4622 function Check_Project
4624 Root_Project : Project_Id;
4625 In_Tree : Project_Tree_Ref;
4626 Extending : Boolean) return Boolean
4629 if P = Root_Project then
4632 elsif Extending then
4634 Data : Project_Data := In_Tree.Projects.Table (Root_Project);
4637 while Data.Extends /= No_Project loop
4638 if P = Data.Extends then
4642 Data := In_Tree.Projects.Table (Data.Extends);
4650 -------------------------------
4651 -- Check_Stand_Alone_Library --
4652 -------------------------------
4654 procedure Check_Stand_Alone_Library
4655 (Project : Project_Id;
4656 In_Tree : Project_Tree_Ref;
4657 Data : in out Project_Data;
4658 Current_Dir : String;
4659 Extending : Boolean)
4661 Lib_Interfaces : constant Prj.Variable_Value :=
4663 (Snames.Name_Library_Interface,
4664 Data.Decl.Attributes,
4667 Lib_Auto_Init : constant Prj.Variable_Value :=
4669 (Snames.Name_Library_Auto_Init,
4670 Data.Decl.Attributes,
4673 Lib_Src_Dir : constant Prj.Variable_Value :=
4675 (Snames.Name_Library_Src_Dir,
4676 Data.Decl.Attributes,
4679 Lib_Symbol_File : constant Prj.Variable_Value :=
4681 (Snames.Name_Library_Symbol_File,
4682 Data.Decl.Attributes,
4685 Lib_Symbol_Policy : constant Prj.Variable_Value :=
4687 (Snames.Name_Library_Symbol_Policy,
4688 Data.Decl.Attributes,
4691 Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
4693 (Snames.Name_Library_Reference_Symbol_File,
4694 Data.Decl.Attributes,
4697 Auto_Init_Supported : Boolean;
4698 OK : Boolean := True;
4700 Next_Proj : Project_Id;
4703 if Get_Mode = Multi_Language then
4704 Auto_Init_Supported := Data.Config.Auto_Init_Supported;
4706 Auto_Init_Supported :=
4707 MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported;
4710 pragma Assert (Lib_Interfaces.Kind = List);
4712 -- It is a stand-alone library project file if attribute
4713 -- Library_Interface is defined.
4715 if not Lib_Interfaces.Default then
4716 SAL_Library : declare
4717 Interfaces : String_List_Id := Lib_Interfaces.Values;
4718 Interface_ALIs : String_List_Id := Nil_String;
4720 The_Unit_Id : Unit_Index;
4721 The_Unit_Data : Unit_Data;
4723 procedure Add_ALI_For (Source : File_Name_Type);
4724 -- Add an ALI file name to the list of Interface ALIs
4730 procedure Add_ALI_For (Source : File_Name_Type) is
4732 Get_Name_String (Source);
4735 ALI : constant String :=
4736 ALI_File_Name (Name_Buffer (1 .. Name_Len));
4737 ALI_Name_Id : Name_Id;
4740 Name_Len := ALI'Length;
4741 Name_Buffer (1 .. Name_Len) := ALI;
4742 ALI_Name_Id := Name_Find;
4744 String_Element_Table.Increment_Last
4745 (In_Tree.String_Elements);
4746 In_Tree.String_Elements.Table
4747 (String_Element_Table.Last
4748 (In_Tree.String_Elements)) :=
4749 (Value => ALI_Name_Id,
4751 Display_Value => ALI_Name_Id,
4753 In_Tree.String_Elements.Table
4754 (Interfaces).Location,
4756 Next => Interface_ALIs);
4757 Interface_ALIs := String_Element_Table.Last
4758 (In_Tree.String_Elements);
4762 -- Start of processing for SAL_Library
4765 Data.Standalone_Library := True;
4767 -- Library_Interface cannot be an empty list
4769 if Interfaces = Nil_String then
4772 "Library_Interface cannot be an empty list",
4773 Lib_Interfaces.Location);
4776 -- Process each unit name specified in the attribute
4777 -- Library_Interface.
4779 while Interfaces /= Nil_String loop
4781 (In_Tree.String_Elements.Table (Interfaces).Value);
4782 To_Lower (Name_Buffer (1 .. Name_Len));
4784 if Name_Len = 0 then
4787 "an interface cannot be an empty string",
4788 In_Tree.String_Elements.Table (Interfaces).Location);
4792 Error_Msg_Name_1 := Unit;
4794 if Get_Mode = Ada_Only then
4796 Units_Htable.Get (In_Tree.Units_HT, Unit);
4798 if The_Unit_Id = No_Unit_Index then
4802 In_Tree.String_Elements.Table
4803 (Interfaces).Location);
4806 -- Check that the unit is part of the project
4809 In_Tree.Units.Table (The_Unit_Id);
4811 if The_Unit_Data.File_Names (Body_Part).Name /= No_File
4812 and then The_Unit_Data.File_Names
4813 (Body_Part).Path.Name /= Slash
4816 (The_Unit_Data.File_Names (Body_Part).Project,
4817 Project, In_Tree, Extending)
4819 -- There is a body for this unit.
4820 -- If there is no spec, we need to check
4821 -- that it is not a subunit.
4823 if The_Unit_Data.File_Names
4824 (Specification).Name = No_File
4827 Src_Ind : Source_File_Index;
4830 Src_Ind := Sinput.P.Load_Project_File
4832 (The_Unit_Data.File_Names
4833 (Body_Part).Path.Name));
4835 if Sinput.P.Source_File_Is_Subunit
4840 "%% is a subunit; " &
4841 "it cannot be an interface",
4843 String_Elements.Table
4844 (Interfaces).Location);
4849 -- The unit is not a subunit, so we add
4850 -- to the Interface ALIs the ALI file
4851 -- corresponding to the body.
4854 (The_Unit_Data.File_Names (Body_Part).Name);
4859 "%% is not an unit of this project",
4860 In_Tree.String_Elements.Table
4861 (Interfaces).Location);
4864 elsif The_Unit_Data.File_Names
4865 (Specification).Name /= No_File
4866 and then The_Unit_Data.File_Names
4867 (Specification).Path.Name /= Slash
4868 and then Check_Project
4869 (The_Unit_Data.File_Names
4870 (Specification).Project,
4871 Project, In_Tree, Extending)
4874 -- The unit is part of the project, it has
4875 -- a spec, but no body. We add to the Interface
4876 -- ALIs the ALI file corresponding to the spec.
4879 (The_Unit_Data.File_Names (Specification).Name);
4884 "%% is not an unit of this project",
4885 In_Tree.String_Elements.Table
4886 (Interfaces).Location);
4891 -- Multi_Language mode
4893 Next_Proj := Data.Extends;
4894 Source := Data.First_Source;
4897 while Source /= No_Source and then
4898 In_Tree.Sources.Table (Source).Unit /= Unit
4901 In_Tree.Sources.Table (Source).Next_In_Project;
4904 exit when Source /= No_Source or else
4905 Next_Proj = No_Project;
4908 In_Tree.Projects.Table (Next_Proj).First_Source;
4910 In_Tree.Projects.Table (Next_Proj).Extends;
4913 if Source /= No_Source then
4914 if In_Tree.Sources.Table (Source).Kind = Sep then
4915 Source := No_Source;
4917 elsif In_Tree.Sources.Table (Source).Kind = Spec
4919 In_Tree.Sources.Table (Source).Other_Part /=
4922 Source := In_Tree.Sources.Table (Source).Other_Part;
4926 if Source /= No_Source then
4927 if In_Tree.Sources.Table (Source).Project /= Project
4931 In_Tree.Sources.Table (Source).Project,
4934 Source := No_Source;
4938 if Source = No_Source then
4941 "%% is not an unit of this project",
4942 In_Tree.String_Elements.Table
4943 (Interfaces).Location);
4946 if In_Tree.Sources.Table (Source).Kind = Spec and then
4947 In_Tree.Sources.Table (Source).Other_Part /=
4950 Source := In_Tree.Sources.Table (Source).Other_Part;
4953 String_Element_Table.Increment_Last
4954 (In_Tree.String_Elements);
4955 In_Tree.String_Elements.Table
4956 (String_Element_Table.Last
4957 (In_Tree.String_Elements)) :=
4959 Name_Id (In_Tree.Sources.Table (Source).Dep_Name),
4962 Name_Id (In_Tree.Sources.Table (Source).Dep_Name),
4964 In_Tree.String_Elements.Table
4965 (Interfaces).Location,
4967 Next => Interface_ALIs);
4968 Interface_ALIs := String_Element_Table.Last
4969 (In_Tree.String_Elements);
4977 In_Tree.String_Elements.Table (Interfaces).Next;
4980 -- Put the list of Interface ALIs in the project data
4982 Data.Lib_Interface_ALIs := Interface_ALIs;
4984 -- Check value of attribute Library_Auto_Init and set
4985 -- Lib_Auto_Init accordingly.
4987 if Lib_Auto_Init.Default then
4989 -- If no attribute Library_Auto_Init is declared, then set auto
4990 -- init only if it is supported.
4992 Data.Lib_Auto_Init := Auto_Init_Supported;
4995 Get_Name_String (Lib_Auto_Init.Value);
4996 To_Lower (Name_Buffer (1 .. Name_Len));
4998 if Name_Buffer (1 .. Name_Len) = "false" then
4999 Data.Lib_Auto_Init := False;
5001 elsif Name_Buffer (1 .. Name_Len) = "true" then
5002 if Auto_Init_Supported then
5003 Data.Lib_Auto_Init := True;
5006 -- Library_Auto_Init cannot be "true" if auto init is not
5011 "library auto init not supported " &
5013 Lib_Auto_Init.Location);
5019 "invalid value for attribute Library_Auto_Init",
5020 Lib_Auto_Init.Location);
5025 -- If attribute Library_Src_Dir is defined and not the empty string,
5026 -- check if the directory exist and is not the object directory or
5027 -- one of the source directories. This is the directory where copies
5028 -- of the interface sources will be copied. Note that this directory
5029 -- may be the library directory.
5031 if Lib_Src_Dir.Value /= Empty_String then
5033 Dir_Id : constant File_Name_Type :=
5034 File_Name_Type (Lib_Src_Dir.Value);
5041 Data.Directory.Display_Name,
5042 Data.Library_Src_Dir.Name,
5043 Data.Library_Src_Dir.Display_Name,
5044 Create => "library source copy",
5045 Current_Dir => Current_Dir,
5046 Location => Lib_Src_Dir.Location);
5048 -- If directory does not exist, report an error
5050 if Data.Library_Src_Dir = No_Path_Information then
5052 -- Get the absolute name of the library directory that does
5053 -- not exist, to report an error.
5056 Dir_Name : constant String :=
5057 Get_Name_String (Dir_Id);
5060 if Is_Absolute_Path (Dir_Name) then
5061 Err_Vars.Error_Msg_File_1 := Dir_Id;
5064 Get_Name_String (Data.Directory.Name);
5066 if Name_Buffer (Name_Len) /=
5069 Name_Len := Name_Len + 1;
5070 Name_Buffer (Name_Len) :=
5071 Directory_Separator;
5076 Name_Len + Dir_Name'Length) :=
5078 Name_Len := Name_Len + Dir_Name'Length;
5079 Err_Vars.Error_Msg_Name_1 := Name_Find;
5084 Error_Msg_File_1 := Dir_Id;
5087 "Directory { does not exist",
5088 Lib_Src_Dir.Location);
5091 -- Report error if it is the same as the object directory
5093 elsif Data.Library_Src_Dir = Data.Object_Directory then
5096 "directory to copy interfaces cannot be " &
5097 "the object directory",
5098 Lib_Src_Dir.Location);
5099 Data.Library_Src_Dir := No_Path_Information;
5103 Src_Dirs : String_List_Id;
5104 Src_Dir : String_Element;
5107 -- Interface copy directory cannot be one of the source
5108 -- directory of the current project.
5110 Src_Dirs := Data.Source_Dirs;
5111 while Src_Dirs /= Nil_String loop
5112 Src_Dir := In_Tree.String_Elements.Table (Src_Dirs);
5114 -- Report error if it is one of the source directories
5116 if Data.Library_Src_Dir.Name =
5117 Path_Name_Type (Src_Dir.Value)
5121 "directory to copy interfaces cannot " &
5122 "be one of the source directories",
5123 Lib_Src_Dir.Location);
5124 Data.Library_Src_Dir := No_Path_Information;
5128 Src_Dirs := Src_Dir.Next;
5131 if Data.Library_Src_Dir /= No_Path_Information then
5133 -- It cannot be a source directory of any other
5136 Project_Loop : for Pid in 1 ..
5137 Project_Table.Last (In_Tree.Projects)
5140 In_Tree.Projects.Table (Pid).Source_Dirs;
5141 Dir_Loop : while Src_Dirs /= Nil_String loop
5143 In_Tree.String_Elements.Table (Src_Dirs);
5145 -- Report error if it is one of the source
5148 if Data.Library_Src_Dir.Name =
5149 Path_Name_Type (Src_Dir.Value)
5152 File_Name_Type (Src_Dir.Value);
5154 In_Tree.Projects.Table (Pid).Name;
5157 "directory to copy interfaces cannot " &
5158 "be the same as source directory { of " &
5160 Lib_Src_Dir.Location);
5161 Data.Library_Src_Dir := No_Path_Information;
5165 Src_Dirs := Src_Dir.Next;
5167 end loop Project_Loop;
5171 -- In high verbosity, if there is a valid Library_Src_Dir,
5172 -- display its path name.
5174 if Data.Library_Src_Dir /= No_Path_Information
5175 and then Current_Verbosity = High
5177 Write_Str ("Directory to copy interfaces =""");
5178 Write_Str (Get_Name_String (Data.Library_Src_Dir.Name));
5185 -- Check the symbol related attributes
5187 -- First, the symbol policy
5189 if not Lib_Symbol_Policy.Default then
5191 Value : constant String :=
5193 (Get_Name_String (Lib_Symbol_Policy.Value));
5196 -- Symbol policy must hove one of a limited number of values
5198 if Value = "autonomous" or else Value = "default" then
5199 Data.Symbol_Data.Symbol_Policy := Autonomous;
5201 elsif Value = "compliant" then
5202 Data.Symbol_Data.Symbol_Policy := Compliant;
5204 elsif Value = "controlled" then
5205 Data.Symbol_Data.Symbol_Policy := Controlled;
5207 elsif Value = "restricted" then
5208 Data.Symbol_Data.Symbol_Policy := Restricted;
5210 elsif Value = "direct" then
5211 Data.Symbol_Data.Symbol_Policy := Direct;
5216 "illegal value for Library_Symbol_Policy",
5217 Lib_Symbol_Policy.Location);
5222 -- If attribute Library_Symbol_File is not specified, symbol policy
5223 -- cannot be Restricted.
5225 if Lib_Symbol_File.Default then
5226 if Data.Symbol_Data.Symbol_Policy = Restricted then
5229 "Library_Symbol_File needs to be defined when " &
5230 "symbol policy is Restricted",
5231 Lib_Symbol_Policy.Location);
5235 -- Library_Symbol_File is defined
5237 Data.Symbol_Data.Symbol_File :=
5238 Path_Name_Type (Lib_Symbol_File.Value);
5240 Get_Name_String (Lib_Symbol_File.Value);
5242 if Name_Len = 0 then
5245 "symbol file name cannot be an empty string",
5246 Lib_Symbol_File.Location);
5249 OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
5252 for J in 1 .. Name_Len loop
5253 if Name_Buffer (J) = '/'
5254 or else Name_Buffer (J) = Directory_Separator
5263 Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
5266 "symbol file name { is illegal. " &
5267 "Name cannot include directory info.",
5268 Lib_Symbol_File.Location);
5273 -- If attribute Library_Reference_Symbol_File is not defined,
5274 -- symbol policy cannot be Compliant or Controlled.
5276 if Lib_Ref_Symbol_File.Default then
5277 if Data.Symbol_Data.Symbol_Policy = Compliant
5278 or else Data.Symbol_Data.Symbol_Policy = Controlled
5282 "a reference symbol file need to be defined",
5283 Lib_Symbol_Policy.Location);
5287 -- Library_Reference_Symbol_File is defined, check file exists
5289 Data.Symbol_Data.Reference :=
5290 Path_Name_Type (Lib_Ref_Symbol_File.Value);
5292 Get_Name_String (Lib_Ref_Symbol_File.Value);
5294 if Name_Len = 0 then
5297 "reference symbol file name cannot be an empty string",
5298 Lib_Symbol_File.Location);
5301 if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
5303 Add_Str_To_Name_Buffer
5304 (Get_Name_String (Data.Directory.Name));
5305 Add_Char_To_Name_Buffer (Directory_Separator);
5306 Add_Str_To_Name_Buffer
5307 (Get_Name_String (Lib_Ref_Symbol_File.Value));
5308 Data.Symbol_Data.Reference := Name_Find;
5311 if not Is_Regular_File
5312 (Get_Name_String (Data.Symbol_Data.Reference))
5315 File_Name_Type (Lib_Ref_Symbol_File.Value);
5317 -- For controlled and direct symbol policies, it is an error
5318 -- if the reference symbol file does not exist. For other
5319 -- symbol policies, this is just a warning
5322 Data.Symbol_Data.Symbol_Policy /= Controlled
5323 and then Data.Symbol_Data.Symbol_Policy /= Direct;
5327 "<library reference symbol file { does not exist",
5328 Lib_Ref_Symbol_File.Location);
5330 -- In addition in the non-controlled case, if symbol policy
5331 -- is Compliant, it is changed to Autonomous, because there
5332 -- is no reference to check against, and we don't want to
5333 -- fail in this case.
5335 if Data.Symbol_Data.Symbol_Policy /= Controlled then
5336 if Data.Symbol_Data.Symbol_Policy = Compliant then
5337 Data.Symbol_Data.Symbol_Policy := Autonomous;
5342 -- If both the reference symbol file and the symbol file are
5343 -- defined, then check that they are not the same file.
5345 if Data.Symbol_Data.Symbol_File /= No_Path then
5346 Get_Name_String (Data.Symbol_Data.Symbol_File);
5348 if Name_Len > 0 then
5350 Symb_Path : constant String :=
5353 (Data.Object_Directory.Name) &
5354 Directory_Separator &
5355 Name_Buffer (1 .. Name_Len),
5356 Directory => Current_Dir,
5358 Opt.Follow_Links_For_Files);
5359 Ref_Path : constant String :=
5362 (Data.Symbol_Data.Reference),
5363 Directory => Current_Dir,
5365 Opt.Follow_Links_For_Files);
5367 if Symb_Path = Ref_Path then
5370 "library reference symbol file and library" &
5371 " symbol file cannot be the same file",
5372 Lib_Ref_Symbol_File.Location);
5380 end Check_Stand_Alone_Library;
5382 ----------------------------
5383 -- Compute_Directory_Last --
5384 ----------------------------
5386 function Compute_Directory_Last (Dir : String) return Natural is
5389 and then (Dir (Dir'Last - 1) = Directory_Separator
5390 or else Dir (Dir'Last - 1) = '/')
5392 return Dir'Last - 1;
5396 end Compute_Directory_Last;
5403 (Project : Project_Id;
5404 In_Tree : Project_Tree_Ref;
5406 Flag_Location : Source_Ptr)
5408 Real_Location : Source_Ptr := Flag_Location;
5409 Error_Buffer : String (1 .. 5_000);
5410 Error_Last : Natural := 0;
5411 Name_Number : Natural := 0;
5412 File_Number : Natural := 0;
5413 First : Positive := Msg'First;
5416 procedure Add (C : Character);
5417 -- Add a character to the buffer
5419 procedure Add (S : String);
5420 -- Add a string to the buffer
5423 -- Add a name to the buffer
5426 -- Add a file name to the buffer
5432 procedure Add (C : Character) is
5434 Error_Last := Error_Last + 1;
5435 Error_Buffer (Error_Last) := C;
5438 procedure Add (S : String) is
5440 Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S;
5441 Error_Last := Error_Last + S'Length;
5448 procedure Add_File is
5449 File : File_Name_Type;
5453 File_Number := File_Number + 1;
5457 File := Err_Vars.Error_Msg_File_1;
5459 File := Err_Vars.Error_Msg_File_2;
5461 File := Err_Vars.Error_Msg_File_3;
5466 Get_Name_String (File);
5467 Add (Name_Buffer (1 .. Name_Len));
5475 procedure Add_Name is
5480 Name_Number := Name_Number + 1;
5484 Name := Err_Vars.Error_Msg_Name_1;
5486 Name := Err_Vars.Error_Msg_Name_2;
5488 Name := Err_Vars.Error_Msg_Name_3;
5493 Get_Name_String (Name);
5494 Add (Name_Buffer (1 .. Name_Len));
5498 -- Start of processing for Error_Msg
5501 -- If location of error is unknown, use the location of the project
5503 if Real_Location = No_Location then
5504 Real_Location := In_Tree.Projects.Table (Project).Location;
5507 if Error_Report = null then
5508 Prj.Err.Error_Msg (Msg, Real_Location);
5512 -- Ignore continuation character
5514 if Msg (First) = '\' then
5518 -- Warning character is always the first one in this package
5519 -- this is an undocumented kludge???
5521 if Msg (First) = '?' then
5525 elsif Msg (First) = '<' then
5528 if Err_Vars.Error_Msg_Warn then
5534 while Index <= Msg'Last loop
5535 if Msg (Index) = '{' then
5538 elsif Msg (Index) = '%' then
5539 if Index < Msg'Last and then Msg (Index + 1) = '%' then
5551 Error_Report (Error_Buffer (1 .. Error_Last), Project, In_Tree);
5554 ----------------------
5555 -- Find_Ada_Sources --
5556 ----------------------
5558 procedure Find_Ada_Sources
5559 (Project : Project_Id;
5560 In_Tree : Project_Tree_Ref;
5561 Data : in out Project_Data;
5562 Current_Dir : String)
5564 Source_Dir : String_List_Id := Data.Source_Dirs;
5565 Element : String_Element;
5567 Current_Source : String_List_Id := Nil_String;
5568 Source_Recorded : Boolean := False;
5571 if Current_Verbosity = High then
5572 Write_Line ("Looking for sources:");
5575 -- For each subdirectory
5577 while Source_Dir /= Nil_String loop
5579 Source_Recorded := False;
5580 Element := In_Tree.String_Elements.Table (Source_Dir);
5581 if Element.Value /= No_Name then
5582 Get_Name_String (Element.Display_Value);
5585 Source_Directory : constant String :=
5586 Name_Buffer (1 .. Name_Len) & Directory_Separator;
5587 Dir_Last : constant Natural :=
5588 Compute_Directory_Last (Source_Directory);
5591 if Current_Verbosity = High then
5592 Write_Str ("Source_Dir = ");
5593 Write_Line (Source_Directory);
5596 -- We look at every entry in the source directory
5599 Source_Directory (Source_Directory'First .. Dir_Last));
5602 Read (Dir, Name_Buffer, Name_Len);
5604 if Current_Verbosity = High then
5605 Write_Str (" Checking ");
5606 Write_Line (Name_Buffer (1 .. Name_Len));
5609 exit when Name_Len = 0;
5612 File_Name : constant File_Name_Type := Name_Find;
5614 -- ??? We could probably optimize the following call:
5615 -- we need to resolve links only once for the
5616 -- directory itself, and then do a single call to
5617 -- readlink() for each file. Unfortunately that would
5618 -- require a change in Normalize_Pathname so that it
5619 -- has the option of not resolving links for its
5620 -- Directory parameter, only for Name.
5622 Path : constant String :=
5624 (Name => Name_Buffer (1 .. Name_Len),
5627 (Source_Directory'First .. Dir_Last),
5629 Opt.Follow_Links_For_Files,
5630 Case_Sensitive => True);
5632 Path_Name : Path_Name_Type;
5635 Name_Len := Path'Length;
5636 Name_Buffer (1 .. Name_Len) := Path;
5637 Path_Name := Name_Find;
5639 -- We attempt to register it as a source. However,
5640 -- there is no error if the file does not contain a
5641 -- valid source. But there is an error if we have a
5642 -- duplicate unit name.
5645 (File_Name => File_Name,
5646 Path_Name => Path_Name,
5650 Location => No_Location,
5651 Current_Source => Current_Source,
5652 Source_Recorded => Source_Recorded,
5653 Current_Dir => Current_Dir);
5662 when Directory_Error =>
5666 if Source_Recorded then
5667 In_Tree.String_Elements.Table (Source_Dir).Flag :=
5671 Source_Dir := Element.Next;
5674 if Current_Verbosity = High then
5675 Write_Line ("end Looking for sources.");
5678 end Find_Ada_Sources;
5680 --------------------------------
5681 -- Free_Ada_Naming_Exceptions --
5682 --------------------------------
5684 procedure Free_Ada_Naming_Exceptions is
5686 Ada_Naming_Exception_Table.Set_Last (0);
5687 Ada_Naming_Exceptions.Reset;
5688 Reverse_Ada_Naming_Exceptions.Reset;
5689 end Free_Ada_Naming_Exceptions;
5691 ---------------------
5692 -- Get_Directories --
5693 ---------------------
5695 procedure Get_Directories
5696 (Project : Project_Id;
5697 In_Tree : Project_Tree_Ref;
5698 Current_Dir : String;
5699 Data : in out Project_Data)
5701 Object_Dir : constant Variable_Value :=
5703 (Name_Object_Dir, Data.Decl.Attributes, In_Tree);
5705 Exec_Dir : constant Variable_Value :=
5707 (Name_Exec_Dir, Data.Decl.Attributes, In_Tree);
5709 Source_Dirs : constant Variable_Value :=
5711 (Name_Source_Dirs, Data.Decl.Attributes, In_Tree);
5713 Excluded_Source_Dirs : constant Variable_Value :=
5715 (Name_Excluded_Source_Dirs,
5716 Data.Decl.Attributes,
5719 Source_Files : constant Variable_Value :=
5721 (Name_Source_Files, Data.Decl.Attributes, In_Tree);
5723 Last_Source_Dir : String_List_Id := Nil_String;
5725 procedure Find_Source_Dirs
5726 (From : File_Name_Type;
5727 Location : Source_Ptr;
5728 Removed : Boolean := False);
5729 -- Find one or several source directories, and add (or remove, if
5730 -- Removed is True) them to list of source directories of the project.
5732 ----------------------
5733 -- Find_Source_Dirs --
5734 ----------------------
5736 procedure Find_Source_Dirs
5737 (From : File_Name_Type;
5738 Location : Source_Ptr;
5739 Removed : Boolean := False)
5741 Directory : constant String := Get_Name_String (From);
5742 Element : String_Element;
5744 procedure Recursive_Find_Dirs (Path : Name_Id);
5745 -- Find all the subdirectories (recursively) of Path and add them
5746 -- to the list of source directories of the project.
5748 -------------------------
5749 -- Recursive_Find_Dirs --
5750 -------------------------
5752 procedure Recursive_Find_Dirs (Path : Name_Id) is
5754 Name : String (1 .. 250);
5756 List : String_List_Id;
5757 Prev : String_List_Id;
5758 Element : String_Element;
5759 Found : Boolean := False;
5761 Non_Canonical_Path : Name_Id := No_Name;
5762 Canonical_Path : Name_Id := No_Name;
5764 The_Path : constant String :=
5766 (Get_Name_String (Path),
5767 Directory => Current_Dir,
5768 Resolve_Links => Opt.Follow_Links_For_Dirs) &
5769 Directory_Separator;
5771 The_Path_Last : constant Natural :=
5772 Compute_Directory_Last (The_Path);
5775 Name_Len := The_Path_Last - The_Path'First + 1;
5776 Name_Buffer (1 .. Name_Len) :=
5777 The_Path (The_Path'First .. The_Path_Last);
5778 Non_Canonical_Path := Name_Find;
5780 if Osint.File_Names_Case_Sensitive then
5781 Canonical_Path := Non_Canonical_Path;
5783 Get_Name_String (Non_Canonical_Path);
5784 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
5785 Canonical_Path := Name_Find;
5788 -- To avoid processing the same directory several times, check
5789 -- if the directory is already in Recursive_Dirs. If it is, then
5790 -- there is nothing to do, just return. If it is not, put it there
5791 -- and continue recursive processing.
5794 if Recursive_Dirs.Get (Canonical_Path) then
5797 Recursive_Dirs.Set (Canonical_Path, True);
5801 -- Check if directory is already in list
5803 List := Data.Source_Dirs;
5805 while List /= Nil_String loop
5806 Element := In_Tree.String_Elements.Table (List);
5808 if Element.Value /= No_Name then
5809 Found := Element.Value = Canonical_Path;
5814 List := Element.Next;
5817 -- If directory is not already in list, put it there
5819 if (not Removed) and (not Found) then
5820 if Current_Verbosity = High then
5822 Write_Line (The_Path (The_Path'First .. The_Path_Last));
5825 String_Element_Table.Increment_Last
5826 (In_Tree.String_Elements);
5828 (Value => Canonical_Path,
5829 Display_Value => Non_Canonical_Path,
5830 Location => No_Location,
5835 -- Case of first source directory
5837 if Last_Source_Dir = Nil_String then
5838 Data.Source_Dirs := String_Element_Table.Last
5839 (In_Tree.String_Elements);
5841 -- Here we already have source directories
5844 -- Link the previous last to the new one
5846 In_Tree.String_Elements.Table
5847 (Last_Source_Dir).Next :=
5848 String_Element_Table.Last
5849 (In_Tree.String_Elements);
5852 -- And register this source directory as the new last
5854 Last_Source_Dir := String_Element_Table.Last
5855 (In_Tree.String_Elements);
5856 In_Tree.String_Elements.Table (Last_Source_Dir) :=
5859 elsif Removed and Found then
5860 if Prev = Nil_String then
5862 In_Tree.String_Elements.Table (List).Next;
5864 In_Tree.String_Elements.Table (Prev).Next :=
5865 In_Tree.String_Elements.Table (List).Next;
5869 -- Now look for subdirectories. We do that even when this
5870 -- directory is already in the list, because some of its
5871 -- subdirectories may not be in the list yet.
5873 Open (Dir, The_Path (The_Path'First .. The_Path_Last));
5876 Read (Dir, Name, Last);
5879 if Name (1 .. Last) /= "."
5880 and then Name (1 .. Last) /= ".."
5882 -- Avoid . and .. directories
5884 if Current_Verbosity = High then
5885 Write_Str (" Checking ");
5886 Write_Line (Name (1 .. Last));
5890 Path_Name : constant String :=
5892 (Name => Name (1 .. Last),
5894 The_Path (The_Path'First .. The_Path_Last),
5895 Resolve_Links => Opt.Follow_Links_For_Dirs,
5896 Case_Sensitive => True);
5899 if Is_Directory (Path_Name) then
5900 -- We have found a new subdirectory, call self
5902 Name_Len := Path_Name'Length;
5903 Name_Buffer (1 .. Name_Len) := Path_Name;
5904 Recursive_Find_Dirs (Name_Find);
5913 when Directory_Error =>
5915 end Recursive_Find_Dirs;
5917 -- Start of processing for Find_Source_Dirs
5920 if Current_Verbosity = High and then not Removed then
5921 Write_Str ("Find_Source_Dirs (""");
5922 Write_Str (Directory);
5926 -- First, check if we are looking for a directory tree, indicated
5927 -- by "/**" at the end.
5929 if Directory'Length >= 3
5930 and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
5931 and then (Directory (Directory'Last - 2) = '/'
5933 Directory (Directory'Last - 2) = Directory_Separator)
5936 Data.Known_Order_Of_Source_Dirs := False;
5939 Name_Len := Directory'Length - 3;
5941 if Name_Len = 0 then
5943 -- Case of "/**": all directories in file system
5946 Name_Buffer (1) := Directory (Directory'First);
5949 Name_Buffer (1 .. Name_Len) :=
5950 Directory (Directory'First .. Directory'Last - 3);
5953 if Current_Verbosity = High then
5954 Write_Str ("Looking for all subdirectories of """);
5955 Write_Str (Name_Buffer (1 .. Name_Len));
5960 Base_Dir : constant File_Name_Type := Name_Find;
5961 Root_Dir : constant String :=
5963 (Name => Get_Name_String (Base_Dir),
5965 Get_Name_String (Data.Directory.Display_Name),
5966 Resolve_Links => False,
5967 Case_Sensitive => True);
5970 if Root_Dir'Length = 0 then
5971 Err_Vars.Error_Msg_File_1 := Base_Dir;
5973 if Location = No_Location then
5976 "{ is not a valid directory.",
5981 "{ is not a valid directory.",
5986 -- We have an existing directory, we register it and all of
5987 -- its subdirectories.
5989 if Current_Verbosity = High then
5990 Write_Line ("Looking for source directories:");
5993 Name_Len := Root_Dir'Length;
5994 Name_Buffer (1 .. Name_Len) := Root_Dir;
5995 Recursive_Find_Dirs (Name_Find);
5997 if Current_Verbosity = High then
5998 Write_Line ("End of looking for source directories.");
6003 -- We have a single directory
6007 Path_Name : Path_Name_Type;
6008 Display_Path_Name : Path_Name_Type;
6009 List : String_List_Id;
6010 Prev : String_List_Id;
6014 (Project => Project,
6017 Parent => Data.Directory.Display_Name,
6019 Display => Display_Path_Name,
6020 Current_Dir => Current_Dir);
6022 if Path_Name = No_Path then
6023 Err_Vars.Error_Msg_File_1 := From;
6025 if Location = No_Location then
6028 "{ is not a valid directory",
6033 "{ is not a valid directory",
6039 Path : constant String :=
6040 Get_Name_String (Path_Name) &
6041 Directory_Separator;
6042 Last_Path : constant Natural :=
6043 Compute_Directory_Last (Path);
6045 Display_Path : constant String :=
6047 (Display_Path_Name) &
6048 Directory_Separator;
6049 Last_Display_Path : constant Natural :=
6050 Compute_Directory_Last
6052 Display_Path_Id : Name_Id;
6056 Add_Str_To_Name_Buffer (Path (Path'First .. Last_Path));
6057 Path_Id := Name_Find;
6059 Add_Str_To_Name_Buffer
6061 (Display_Path'First .. Last_Display_Path));
6062 Display_Path_Id := Name_Find;
6066 -- As it is an existing directory, we add it to the
6067 -- list of directories.
6069 String_Element_Table.Increment_Last
6070 (In_Tree.String_Elements);
6074 Display_Value => Display_Path_Id,
6075 Location => No_Location,
6077 Next => Nil_String);
6079 if Last_Source_Dir = Nil_String then
6081 -- This is the first source directory
6083 Data.Source_Dirs := String_Element_Table.Last
6084 (In_Tree.String_Elements);
6087 -- We already have source directories, link the
6088 -- previous last to the new one.
6090 In_Tree.String_Elements.Table
6091 (Last_Source_Dir).Next :=
6092 String_Element_Table.Last
6093 (In_Tree.String_Elements);
6096 -- And register this source directory as the new last
6098 Last_Source_Dir := String_Element_Table.Last
6099 (In_Tree.String_Elements);
6100 In_Tree.String_Elements.Table
6101 (Last_Source_Dir) := Element;
6104 -- Remove source dir, if present
6106 List := Data.Source_Dirs;
6109 -- Look for source dir in current list
6111 while List /= Nil_String loop
6112 Element := In_Tree.String_Elements.Table (List);
6113 exit when Element.Value = Path_Id;
6115 List := Element.Next;
6118 if List /= Nil_String then
6119 -- Source dir was found, remove it from the list
6121 if Prev = Nil_String then
6123 In_Tree.String_Elements.Table (List).Next;
6126 In_Tree.String_Elements.Table (Prev).Next :=
6127 In_Tree.String_Elements.Table (List).Next;
6135 end Find_Source_Dirs;
6137 -- Start of processing for Get_Directories
6140 if Current_Verbosity = High then
6141 Write_Line ("Starting to look for directories");
6144 -- Check the object directory
6146 pragma Assert (Object_Dir.Kind = Single,
6147 "Object_Dir is not a single string");
6149 -- We set the object directory to its default
6151 Data.Object_Directory := Data.Directory;
6153 if Object_Dir.Value /= Empty_String then
6154 Get_Name_String (Object_Dir.Value);
6156 if Name_Len = 0 then
6159 "Object_Dir cannot be empty",
6160 Object_Dir.Location);
6163 -- We check that the specified object directory does exist
6168 File_Name_Type (Object_Dir.Value),
6169 Data.Directory.Display_Name,
6170 Data.Object_Directory.Name,
6171 Data.Object_Directory.Display_Name,
6173 Location => Object_Dir.Location,
6174 Current_Dir => Current_Dir);
6176 if Data.Object_Directory = No_Path_Information then
6178 -- The object directory does not exist, report an error if the
6179 -- project is not externally built.
6181 if not Data.Externally_Built then
6182 Err_Vars.Error_Msg_File_1 :=
6183 File_Name_Type (Object_Dir.Value);
6186 "the object directory { cannot be found",
6190 -- Do not keep a nil Object_Directory. Set it to the specified
6191 -- (relative or absolute) path. This is for the benefit of
6192 -- tools that recover from errors; for example, these tools
6193 -- could create the non existent directory.
6195 Data.Object_Directory.Display_Name :=
6196 Path_Name_Type (Object_Dir.Value);
6198 if Osint.File_Names_Case_Sensitive then
6199 Data.Object_Directory.Name :=
6200 Path_Name_Type (Object_Dir.Value);
6202 Get_Name_String (Object_Dir.Value);
6203 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6204 Data.Object_Directory.Name := Name_Find;
6209 elsif Subdirs /= null then
6211 Name_Buffer (1) := '.';
6216 Data.Directory.Display_Name,
6217 Data.Object_Directory.Name,
6218 Data.Object_Directory.Display_Name,
6220 Location => Object_Dir.Location,
6221 Current_Dir => Current_Dir);
6224 if Current_Verbosity = High then
6225 if Data.Object_Directory = No_Path_Information then
6226 Write_Line ("No object directory");
6228 Write_Str ("Object directory: """);
6229 Write_Str (Get_Name_String (Data.Object_Directory.Display_Name));
6234 -- Check the exec directory
6236 pragma Assert (Exec_Dir.Kind = Single,
6237 "Exec_Dir is not a single string");
6239 -- We set the object directory to its default
6241 Data.Exec_Directory := Data.Object_Directory;
6243 if Exec_Dir.Value /= Empty_String then
6244 Get_Name_String (Exec_Dir.Value);
6246 if Name_Len = 0 then
6249 "Exec_Dir cannot be empty",
6253 -- We check that the specified exec directory does exist
6258 File_Name_Type (Exec_Dir.Value),
6259 Data.Directory.Display_Name,
6260 Data.Exec_Directory.Name,
6261 Data.Exec_Directory.Display_Name,
6263 Location => Exec_Dir.Location,
6264 Current_Dir => Current_Dir);
6266 if Data.Exec_Directory = No_Path_Information then
6267 Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
6270 "the exec directory { cannot be found",
6276 if Current_Verbosity = High then
6277 if Data.Exec_Directory = No_Path_Information then
6278 Write_Line ("No exec directory");
6280 Write_Str ("Exec directory: """);
6281 Write_Str (Get_Name_String (Data.Exec_Directory.Display_Name));
6286 -- Look for the source directories
6288 if Current_Verbosity = High then
6289 Write_Line ("Starting to look for source directories");
6292 pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
6294 if (not Source_Files.Default) and then
6295 Source_Files.Values = Nil_String
6297 Data.Source_Dirs := Nil_String;
6299 if Data.Qualifier = Standard then
6303 "a standard project cannot have no sources",
6304 Source_Files.Location);
6307 if Data.Extends = No_Project
6308 and then Data.Object_Directory = Data.Directory
6310 Data.Object_Directory := No_Path_Information;
6313 elsif Source_Dirs.Default then
6315 -- No Source_Dirs specified: the single source directory is the one
6316 -- containing the project file
6318 String_Element_Table.Increment_Last
6319 (In_Tree.String_Elements);
6320 Data.Source_Dirs := String_Element_Table.Last
6321 (In_Tree.String_Elements);
6322 In_Tree.String_Elements.Table (Data.Source_Dirs) :=
6323 (Value => Name_Id (Data.Directory.Name),
6324 Display_Value => Name_Id (Data.Directory.Display_Name),
6325 Location => No_Location,
6330 if Current_Verbosity = High then
6331 Write_Line ("Single source directory:");
6333 Write_Str (Get_Name_String (Data.Directory.Display_Name));
6337 elsif Source_Dirs.Values = Nil_String then
6338 if Data.Qualifier = Standard then
6342 "a standard project cannot have no source directories",
6343 Source_Dirs.Location);
6346 -- If Source_Dirs is an empty string list, this means that this
6347 -- project contains no source. For projects that don't extend other
6348 -- projects, this also means that there is no need for an object
6349 -- directory, if not specified.
6351 if Data.Extends = No_Project
6352 and then Data.Object_Directory = Data.Directory
6354 Data.Object_Directory := No_Path_Information;
6357 Data.Source_Dirs := Nil_String;
6361 Source_Dir : String_List_Id;
6362 Element : String_Element;
6365 -- Process the source directories for each element of the list
6367 Source_Dir := Source_Dirs.Values;
6368 while Source_Dir /= Nil_String loop
6369 Element := In_Tree.String_Elements.Table (Source_Dir);
6371 (File_Name_Type (Element.Value), Element.Location);
6372 Source_Dir := Element.Next;
6377 if not Excluded_Source_Dirs.Default
6378 and then Excluded_Source_Dirs.Values /= Nil_String
6381 Source_Dir : String_List_Id;
6382 Element : String_Element;
6385 -- Process the source directories for each element of the list
6387 Source_Dir := Excluded_Source_Dirs.Values;
6388 while Source_Dir /= Nil_String loop
6389 Element := In_Tree.String_Elements.Table (Source_Dir);
6391 (File_Name_Type (Element.Value),
6394 Source_Dir := Element.Next;
6399 if Current_Verbosity = High then
6400 Write_Line ("Putting source directories in canonical cases");
6404 Current : String_List_Id := Data.Source_Dirs;
6405 Element : String_Element;
6408 while Current /= Nil_String loop
6409 Element := In_Tree.String_Elements.Table (Current);
6410 if Element.Value /= No_Name then
6411 if not Osint.File_Names_Case_Sensitive then
6412 Get_Name_String (Element.Value);
6413 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6414 Element.Value := Name_Find;
6417 In_Tree.String_Elements.Table (Current) := Element;
6420 Current := Element.Next;
6424 end Get_Directories;
6431 (Project : Project_Id;
6432 In_Tree : Project_Tree_Ref;
6433 Data : in out Project_Data)
6435 Mains : constant Variable_Value :=
6436 Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes, In_Tree);
6437 List : String_List_Id;
6438 Elem : String_Element;
6441 Data.Mains := Mains.Values;
6443 -- If no Mains were specified, and if we are an extending project,
6444 -- inherit the Mains from the project we are extending.
6446 if Mains.Default then
6447 if not Data.Library and then Data.Extends /= No_Project then
6449 In_Tree.Projects.Table (Data.Extends).Mains;
6452 -- In a library project file, Main cannot be specified
6454 elsif Data.Library then
6457 "a library project file cannot have Main specified",
6461 List := Mains.Values;
6462 while List /= Nil_String loop
6463 Elem := In_Tree.String_Elements.Table (List);
6465 if Length_Of_Name (Elem.Value) = 0 then
6468 "?a main cannot have an empty name",
6478 ---------------------------
6479 -- Get_Sources_From_File --
6480 ---------------------------
6482 procedure Get_Sources_From_File
6484 Location : Source_Ptr;
6485 Project : Project_Id;
6486 In_Tree : Project_Tree_Ref)
6488 File : Prj.Util.Text_File;
6489 Line : String (1 .. 250);
6491 Source_Name : File_Name_Type;
6492 Name_Loc : Name_Location;
6495 if Get_Mode = Ada_Only then
6499 if Current_Verbosity = High then
6500 Write_Str ("Opening """);
6507 Prj.Util.Open (File, Path);
6509 if not Prj.Util.Is_Valid (File) then
6510 Error_Msg (Project, In_Tree, "file does not exist", Location);
6513 -- Read the lines one by one
6515 while not Prj.Util.End_Of_File (File) loop
6516 Prj.Util.Get_Line (File, Line, Last);
6518 -- A non empty, non comment line should contain a file name
6521 and then (Last = 1 or else Line (1 .. 2) /= "--")
6524 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6525 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6526 Source_Name := Name_Find;
6528 -- Check that there is no directory information
6530 for J in 1 .. Last loop
6531 if Line (J) = '/' or else Line (J) = Directory_Separator then
6532 Error_Msg_File_1 := Source_Name;
6536 "file name cannot include directory information ({)",
6542 Name_Loc := Source_Names.Get (Source_Name);
6544 if Name_Loc = No_Name_Location then
6546 (Name => Source_Name,
6547 Location => Location,
6548 Source => No_Source,
6553 Source_Names.Set (Source_Name, Name_Loc);
6557 Prj.Util.Close (File);
6560 end Get_Sources_From_File;
6567 (In_Tree : Project_Tree_Ref;
6568 Canonical_File_Name : File_Name_Type;
6569 Naming : Naming_Data;
6570 Exception_Id : out Ada_Naming_Exception_Id;
6571 Unit_Name : out Name_Id;
6572 Unit_Kind : out Spec_Or_Body;
6573 Needs_Pragma : out Boolean)
6575 Info_Id : Ada_Naming_Exception_Id :=
6576 Ada_Naming_Exceptions.Get (Canonical_File_Name);
6577 VMS_Name : File_Name_Type;
6580 if Info_Id = No_Ada_Naming_Exception then
6581 if Hostparm.OpenVMS then
6582 VMS_Name := Canonical_File_Name;
6583 Get_Name_String (VMS_Name);
6585 if Name_Buffer (Name_Len) = '.' then
6586 Name_Len := Name_Len - 1;
6587 VMS_Name := Name_Find;
6590 Info_Id := Ada_Naming_Exceptions.Get (VMS_Name);
6595 if Info_Id /= No_Ada_Naming_Exception then
6596 Exception_Id := Info_Id;
6597 Unit_Name := No_Name;
6598 Unit_Kind := Specification;
6599 Needs_Pragma := True;
6603 Needs_Pragma := False;
6604 Exception_Id := No_Ada_Naming_Exception;
6606 Get_Name_String (Canonical_File_Name);
6608 -- How about some comments and a name for this declare block ???
6609 -- In fact the whole code below needs more comments ???
6612 File : String := Name_Buffer (1 .. Name_Len);
6613 First : constant Positive := File'First;
6614 Last : Natural := File'Last;
6615 Standard_GNAT : Boolean;
6616 Spec : constant File_Name_Type :=
6617 Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
6618 Body_Suff : constant File_Name_Type :=
6619 Body_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
6622 Standard_GNAT := Spec = Default_Ada_Spec_Suffix
6623 and then Body_Suff = Default_Ada_Body_Suffix;
6626 Spec_Suffix : constant String := Get_Name_String (Spec);
6627 Body_Suffix : constant String := Get_Name_String (Body_Suff);
6628 Sep_Suffix : constant String :=
6629 Get_Name_String (Naming.Separate_Suffix);
6631 May_Be_Spec : Boolean;
6632 May_Be_Body : Boolean;
6633 May_Be_Sep : Boolean;
6637 File'Length > Spec_Suffix'Length
6639 File (Last - Spec_Suffix'Length + 1 .. Last) = Spec_Suffix;
6642 File'Length > Body_Suffix'Length
6644 File (Last - Body_Suffix'Length + 1 .. Last) = Body_Suffix;
6647 File'Length > Sep_Suffix'Length
6649 File (Last - Sep_Suffix'Length + 1 .. Last) = Sep_Suffix;
6651 -- If two May_Be_ booleans are True, always choose the longer one
6654 if May_Be_Body and then
6655 Spec_Suffix'Length < Body_Suffix'Length
6657 Unit_Kind := Body_Part;
6659 if May_Be_Sep and then
6660 Body_Suffix'Length < Sep_Suffix'Length
6662 Last := Last - Sep_Suffix'Length;
6663 May_Be_Body := False;
6666 Last := Last - Body_Suffix'Length;
6667 May_Be_Sep := False;
6670 elsif May_Be_Sep and then
6671 Spec_Suffix'Length < Sep_Suffix'Length
6673 Unit_Kind := Body_Part;
6674 Last := Last - Sep_Suffix'Length;
6677 Unit_Kind := Specification;
6678 Last := Last - Spec_Suffix'Length;
6681 elsif May_Be_Body then
6682 Unit_Kind := Body_Part;
6684 if May_Be_Sep and then
6685 Body_Suffix'Length < Sep_Suffix'Length
6687 Last := Last - Sep_Suffix'Length;
6688 May_Be_Body := False;
6690 Last := Last - Body_Suffix'Length;
6691 May_Be_Sep := False;
6694 elsif May_Be_Sep then
6695 Unit_Kind := Body_Part;
6696 Last := Last - Sep_Suffix'Length;
6704 -- This is not a source file
6706 Unit_Name := No_Name;
6707 Unit_Kind := Specification;
6709 if Current_Verbosity = High then
6710 Write_Line (" Not a valid file name.");
6715 elsif Current_Verbosity = High then
6717 when Specification =>
6718 Write_Str (" Specification: ");
6719 Write_Line (File (First .. Last + Spec_Suffix'Length));
6723 Write_Str (" Body: ");
6724 Write_Line (File (First .. Last + Body_Suffix'Length));
6727 Write_Str (" Separate: ");
6728 Write_Line (File (First .. Last + Sep_Suffix'Length));
6734 Get_Name_String (Naming.Dot_Replacement);
6736 Standard_GNAT and then Name_Buffer (1 .. Name_Len) = "-";
6738 if Name_Buffer (1 .. Name_Len) /= "." then
6740 -- If Dot_Replacement is not a single dot, then there should not
6741 -- be any dot in the name.
6743 for Index in First .. Last loop
6744 if File (Index) = '.' then
6745 if Current_Verbosity = High then
6747 (" Not a valid file name (some dot not replaced).");
6750 Unit_Name := No_Name;
6756 -- Replace the substring Dot_Replacement with dots
6759 Index : Positive := First;
6762 while Index <= Last - Name_Len + 1 loop
6764 if File (Index .. Index + Name_Len - 1) =
6765 Name_Buffer (1 .. Name_Len)
6767 File (Index) := '.';
6769 if Name_Len > 1 and then Index < Last then
6770 File (Index + 1 .. Last - Name_Len + 1) :=
6771 File (Index + Name_Len .. Last);
6774 Last := Last - Name_Len + 1;
6782 -- Check if the file casing is right
6785 Src : String := File (First .. Last);
6786 Src_Last : Positive := Last;
6789 -- If casing is significant, deal with upper/lower case translate
6791 if File_Names_Case_Sensitive then
6792 case Naming.Casing is
6793 when All_Lower_Case =>
6796 Mapping => Lower_Case_Map);
6798 when All_Upper_Case =>
6801 Mapping => Upper_Case_Map);
6803 when Mixed_Case | Unknown =>
6807 if Src /= File (First .. Last) then
6808 if Current_Verbosity = High then
6809 Write_Line (" Not a valid file name (casing).");
6812 Unit_Name := No_Name;
6817 -- Put the name in lower case
6821 Mapping => Lower_Case_Map);
6823 -- In the standard GNAT naming scheme, check for special cases:
6824 -- children or separates of A, G, I or S, and run time sources.
6826 if Standard_GNAT and then Src'Length >= 3 then
6828 S1 : constant Character := Src (Src'First);
6829 S2 : constant Character := Src (Src'First + 1);
6830 S3 : constant Character := Src (Src'First + 2);
6838 -- Children or separates of packages A, G, I or S. These
6839 -- names are x__ ... or x~... (where x is a, g, i, or s).
6840 -- Both versions (x__... and x~...) are allowed in all
6841 -- platforms, because it is not possible to know the
6842 -- platform before processing of the project files.
6844 if S2 = '_' and then S3 = '_' then
6845 Src (Src'First + 1) := '.';
6846 Src_Last := Src_Last - 1;
6847 Src (Src'First + 2 .. Src_Last) :=
6848 Src (Src'First + 3 .. Src_Last + 1);
6851 Src (Src'First + 1) := '.';
6853 -- If it is potentially a run time source, disable
6854 -- filling of the mapping file to avoid warnings.
6857 Set_Mapping_File_Initial_State_To_Empty;
6863 if Current_Verbosity = High then
6865 Write_Line (Src (Src'First .. Src_Last));
6868 -- Now, we check if this name is a valid unit name
6871 (Name => Src (Src'First .. Src_Last), Unit => Unit_Name);
6881 function Hash (Unit : Unit_Info) return Header_Num is
6883 return Header_Num (Unit.Unit mod 2048);
6886 -----------------------
6887 -- Is_Illegal_Suffix --
6888 -----------------------
6890 function Is_Illegal_Suffix
6892 Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean
6895 if Suffix'Length = 0 or else Index (Suffix, ".") = 0 then
6899 -- If dot replacement is a single dot, and first character of suffix is
6902 if Dot_Replacement_Is_A_Single_Dot
6903 and then Suffix (Suffix'First) = '.'
6905 for Index in Suffix'First + 1 .. Suffix'Last loop
6907 -- If there is another dot
6909 if Suffix (Index) = '.' then
6911 -- It is illegal to have a letter following the initial dot
6913 return Is_Letter (Suffix (Suffix'First + 1));
6921 end Is_Illegal_Suffix;
6923 ----------------------
6924 -- Locate_Directory --
6925 ----------------------
6927 procedure Locate_Directory
6928 (Project : Project_Id;
6929 In_Tree : Project_Tree_Ref;
6930 Name : File_Name_Type;
6931 Parent : Path_Name_Type;
6932 Dir : out Path_Name_Type;
6933 Display : out Path_Name_Type;
6934 Create : String := "";
6935 Current_Dir : String;
6936 Location : Source_Ptr := No_Location)
6938 The_Parent : constant String :=
6939 Get_Name_String (Parent) & Directory_Separator;
6941 The_Parent_Last : constant Natural :=
6942 Compute_Directory_Last (The_Parent);
6944 Full_Name : File_Name_Type;
6946 The_Name : File_Name_Type;
6949 Get_Name_String (Name);
6951 -- Add Subdirs.all if it is a directory that may be created and
6952 -- Subdirs is not null;
6954 if Create /= "" and then Subdirs /= null then
6955 if Name_Buffer (Name_Len) /= Directory_Separator then
6956 Add_Char_To_Name_Buffer (Directory_Separator);
6959 Add_Str_To_Name_Buffer (Subdirs.all);
6962 -- Convert '/' to directory separator (for Windows)
6964 for J in 1 .. Name_Len loop
6965 if Name_Buffer (J) = '/' then
6966 Name_Buffer (J) := Directory_Separator;
6970 The_Name := Name_Find;
6972 if Current_Verbosity = High then
6973 Write_Str ("Locate_Directory (""");
6974 Write_Str (Get_Name_String (The_Name));
6975 Write_Str (""", """);
6976 Write_Str (The_Parent);
6983 if Is_Absolute_Path (Get_Name_String (The_Name)) then
6984 Full_Name := The_Name;
6988 Add_Str_To_Name_Buffer
6989 (The_Parent (The_Parent'First .. The_Parent_Last));
6990 Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
6991 Full_Name := Name_Find;
6995 Full_Path_Name : constant String := Get_Name_String (Full_Name);
6998 if (Setup_Projects or else Subdirs /= null)
6999 and then Create'Length > 0
7000 and then not Is_Directory (Full_Path_Name)
7003 Create_Path (Full_Path_Name);
7005 if not Quiet_Output then
7007 Write_Str (" directory """);
7008 Write_Str (Full_Path_Name);
7009 Write_Line (""" created");
7016 "could not create " & Create &
7017 " directory " & Full_Path_Name,
7022 if Is_Directory (Full_Path_Name) then
7024 Normed : constant String :=
7027 Directory => Current_Dir,
7028 Resolve_Links => False,
7029 Case_Sensitive => True);
7031 Canonical_Path : constant String :=
7034 Directory => Current_Dir,
7036 Opt.Follow_Links_For_Dirs,
7037 Case_Sensitive => False);
7040 Name_Len := Normed'Length;
7041 Name_Buffer (1 .. Name_Len) := Normed;
7042 Display := Name_Find;
7044 Name_Len := Canonical_Path'Length;
7045 Name_Buffer (1 .. Name_Len) := Canonical_Path;
7050 end Locate_Directory;
7052 ---------------------------
7053 -- Find_Excluded_Sources --
7054 ---------------------------
7056 procedure Find_Excluded_Sources
7057 (Project : Project_Id;
7058 In_Tree : Project_Tree_Ref;
7059 Data : Project_Data)
7061 Excluded_Sources : Variable_Value;
7063 Excluded_Source_List_File : Variable_Value;
7065 Current : String_List_Id;
7067 Element : String_Element;
7069 Location : Source_Ptr;
7071 Name : File_Name_Type;
7073 File : Prj.Util.Text_File;
7074 Line : String (1 .. 300);
7077 Locally_Removed : Boolean := False;
7079 Excluded_Source_List_File :=
7081 (Name_Excluded_Source_List_File, Data.Decl.Attributes, In_Tree);
7085 (Name_Excluded_Source_Files, Data.Decl.Attributes, In_Tree);
7087 -- If Excluded_Source_Files is not declared, check
7088 -- Locally_Removed_Files.
7090 if Excluded_Sources.Default then
7091 Locally_Removed := True;
7094 (Name_Locally_Removed_Files, Data.Decl.Attributes, In_Tree);
7097 Excluded_Sources_Htable.Reset;
7099 -- If there are excluded sources, put them in the table
7101 if not Excluded_Sources.Default then
7102 if not Excluded_Source_List_File.Default then
7103 if Locally_Removed then
7106 "?both attributes Locally_Removed_Files and " &
7107 "Excluded_Source_List_File are present",
7108 Excluded_Source_List_File.Location);
7112 "?both attributes Excluded_Source_Files and " &
7113 "Excluded_Source_List_File are present",
7114 Excluded_Source_List_File.Location);
7118 Current := Excluded_Sources.Values;
7119 while Current /= Nil_String loop
7120 Element := In_Tree.String_Elements.Table (Current);
7122 if Osint.File_Names_Case_Sensitive then
7123 Name := File_Name_Type (Element.Value);
7125 Get_Name_String (Element.Value);
7126 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7130 -- If the element has no location, then use the location
7131 -- of Excluded_Sources to report possible errors.
7133 if Element.Location = No_Location then
7134 Location := Excluded_Sources.Location;
7136 Location := Element.Location;
7139 Excluded_Sources_Htable.Set (Name, (Name, False, Location));
7140 Current := Element.Next;
7143 elsif not Excluded_Source_List_File.Default then
7144 Location := Excluded_Source_List_File.Location;
7147 Source_File_Path_Name : constant String :=
7150 (Excluded_Source_List_File.Value),
7151 Data.Directory.Name);
7154 if Source_File_Path_Name'Length = 0 then
7155 Err_Vars.Error_Msg_File_1 :=
7156 File_Name_Type (Excluded_Source_List_File.Value);
7159 "file with excluded sources { does not exist",
7160 Excluded_Source_List_File.Location);
7165 Prj.Util.Open (File, Source_File_Path_Name);
7167 if not Prj.Util.Is_Valid (File) then
7169 (Project, In_Tree, "file does not exist", Location);
7171 -- Read the lines one by one
7173 while not Prj.Util.End_Of_File (File) loop
7174 Prj.Util.Get_Line (File, Line, Last);
7176 -- A non empty, non comment line should contain a file
7180 and then (Last = 1 or else Line (1 .. 2) /= "--")
7183 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
7184 Canonical_Case_File_Name
7185 (Name_Buffer (1 .. Name_Len));
7188 -- Check that there is no directory information
7190 for J in 1 .. Last loop
7192 or else Line (J) = Directory_Separator
7194 Error_Msg_File_1 := Name;
7198 "file name cannot include " &
7199 "directory information ({)",
7205 Excluded_Sources_Htable.Set
7206 (Name, (Name, False, Location));
7210 Prj.Util.Close (File);
7215 end Find_Excluded_Sources;
7217 ---------------------------
7218 -- Find_Explicit_Sources --
7219 ---------------------------
7221 procedure Find_Explicit_Sources
7222 (Current_Dir : String;
7223 Project : Project_Id;
7224 In_Tree : Project_Tree_Ref;
7225 Data : in out Project_Data)
7227 Sources : constant Variable_Value :=
7230 Data.Decl.Attributes,
7232 Source_List_File : constant Variable_Value :=
7234 (Name_Source_List_File,
7235 Data.Decl.Attributes,
7237 Name_Loc : Name_Location;
7240 pragma Assert (Sources.Kind = List, "Source_Files is not a list");
7242 (Source_List_File.Kind = Single,
7243 "Source_List_File is not a single string");
7245 -- If the user has specified a Sources attribute
7247 if not Sources.Default then
7248 if not Source_List_File.Default then
7251 "?both attributes source_files and " &
7252 "source_list_file are present",
7253 Source_List_File.Location);
7256 -- Sources is a list of file names
7259 Current : String_List_Id := Sources.Values;
7260 Element : String_Element;
7261 Location : Source_Ptr;
7262 Name : File_Name_Type;
7265 if Get_Mode = Ada_Only then
7266 Data.Ada_Sources_Present := Current /= Nil_String;
7269 if Get_Mode = Multi_Language then
7270 if Current = Nil_String then
7271 Data.First_Language_Processing := No_Language_Index;
7273 -- This project contains no source. For projects that
7274 -- don't extend other projects, this also means that
7275 -- there is no need for an object directory, if not
7278 if Data.Extends = No_Project
7279 and then Data.Object_Directory = Data.Directory
7281 Data.Object_Directory := No_Path_Information;
7286 while Current /= Nil_String loop
7287 Element := In_Tree.String_Elements.Table (Current);
7288 Get_Name_String (Element.Value);
7290 if Osint.File_Names_Case_Sensitive then
7291 Name := File_Name_Type (Element.Value);
7293 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7297 -- If the element has no location, then use the
7298 -- location of Sources to report possible errors.
7300 if Element.Location = No_Location then
7301 Location := Sources.Location;
7303 Location := Element.Location;
7306 -- Check that there is no directory information
7308 for J in 1 .. Name_Len loop
7309 if Name_Buffer (J) = '/'
7310 or else Name_Buffer (J) = Directory_Separator
7312 Error_Msg_File_1 := Name;
7316 "file name cannot include directory " &
7323 -- In Multi_Language mode, check whether the file is
7324 -- already there: the same file name may be in the list; if
7325 -- the source is missing, the error will be on the first
7326 -- mention of the source file name.
7330 Name_Loc := No_Name_Location;
7331 when Multi_Language =>
7332 Name_Loc := Source_Names.Get (Name);
7335 if Name_Loc = No_Name_Location then
7338 Location => Location,
7339 Source => No_Source,
7342 Source_Names.Set (Name, Name_Loc);
7345 Current := Element.Next;
7348 if Get_Mode = Ada_Only then
7349 Get_Path_Names_And_Record_Ada_Sources
7350 (Project, In_Tree, Data, Current_Dir);
7354 -- If we have no Source_Files attribute, check the Source_List_File
7357 elsif not Source_List_File.Default then
7359 -- Source_List_File is the name of the file
7360 -- that contains the source file names
7363 Source_File_Path_Name : constant String :=
7365 (File_Name_Type (Source_List_File.Value), Data.Directory.Name);
7368 if Source_File_Path_Name'Length = 0 then
7369 Err_Vars.Error_Msg_File_1 :=
7370 File_Name_Type (Source_List_File.Value);
7373 "file with sources { does not exist",
7374 Source_List_File.Location);
7377 Get_Sources_From_File
7378 (Source_File_Path_Name, Source_List_File.Location,
7381 if Get_Mode = Ada_Only then
7382 -- Look in the source directories to find those sources
7384 Get_Path_Names_And_Record_Ada_Sources
7385 (Project, In_Tree, Data, Current_Dir);
7391 -- Neither Source_Files nor Source_List_File has been
7392 -- specified. Find all the files that satisfy the naming
7393 -- scheme in all the source directories.
7395 if Get_Mode = Ada_Only then
7396 Find_Ada_Sources (Project, In_Tree, Data, Current_Dir);
7400 if Get_Mode = Multi_Language then
7402 (Project, In_Tree, Data,
7404 Sources.Default and then Source_List_File.Default);
7406 -- Check if all exceptions have been found.
7407 -- For Ada, it is an error if an exception is not found.
7408 -- For other language, the source is simply removed.
7414 Source := Data.First_Source;
7415 while Source /= No_Source loop
7417 Src_Data : Source_Data renames
7418 In_Tree.Sources.Table (Source);
7421 if Src_Data.Naming_Exception
7422 and then Src_Data.Path = No_Path_Information
7424 if Src_Data.Unit /= No_Name then
7425 Error_Msg_Name_1 := Name_Id (Src_Data.Display_File);
7426 Error_Msg_Name_2 := Name_Id (Src_Data.Unit);
7429 "source file %% for unit %% not found",
7433 Remove_Source (Source, No_Source, Project, Data, In_Tree);
7436 Source := Src_Data.Next_In_Project;
7441 -- Check that all sources in Source_Files or the file
7442 -- Source_List_File has been found.
7445 Name_Loc : Name_Location;
7448 Name_Loc := Source_Names.Get_First;
7449 while Name_Loc /= No_Name_Location loop
7450 if (not Name_Loc.Except) and then (not Name_Loc.Found) then
7451 Error_Msg_Name_1 := Name_Id (Name_Loc.Name);
7455 "file %% not found",
7459 Name_Loc := Source_Names.Get_Next;
7464 if Get_Mode = Ada_Only
7465 and then Data.Extends = No_Project
7467 -- We should have found at least one source, if not report an error
7469 if Data.Ada_Sources = Nil_String then
7471 (Project, "Ada", In_Tree, Source_List_File.Location);
7475 end Find_Explicit_Sources;
7477 -------------------------------------------
7478 -- Get_Path_Names_And_Record_Ada_Sources --
7479 -------------------------------------------
7481 procedure Get_Path_Names_And_Record_Ada_Sources
7482 (Project : Project_Id;
7483 In_Tree : Project_Tree_Ref;
7484 Data : in out Project_Data;
7485 Current_Dir : String)
7487 Source_Dir : String_List_Id;
7488 Element : String_Element;
7489 Path : Path_Name_Type;
7491 Name : File_Name_Type;
7492 Canonical_Name : File_Name_Type;
7493 Name_Str : String (1 .. 1_024);
7494 Last : Natural := 0;
7496 Current_Source : String_List_Id := Nil_String;
7497 First_Error : Boolean := True;
7498 Source_Recorded : Boolean := False;
7501 -- We look in all source directories for the file names in the hash
7502 -- table Source_Names.
7504 Source_Dir := Data.Source_Dirs;
7505 while Source_Dir /= Nil_String loop
7506 Source_Recorded := False;
7507 Element := In_Tree.String_Elements.Table (Source_Dir);
7510 Dir_Path : constant String :=
7511 Get_Name_String (Element.Display_Value);
7513 if Current_Verbosity = High then
7514 Write_Str ("checking directory """);
7515 Write_Str (Dir_Path);
7519 Open (Dir, Dir_Path);
7522 Read (Dir, Name_Str, Last);
7526 Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
7529 if Osint.File_Names_Case_Sensitive then
7530 Canonical_Name := Name;
7532 Canonical_Case_File_Name (Name_Str (1 .. Last));
7533 Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
7534 Canonical_Name := Name_Find;
7537 NL := Source_Names.Get (Canonical_Name);
7539 if NL /= No_Name_Location and then not NL.Found then
7541 Source_Names.Set (Canonical_Name, NL);
7542 Name_Len := Dir_Path'Length;
7543 Name_Buffer (1 .. Name_Len) := Dir_Path;
7545 if Name_Buffer (Name_Len) /= Directory_Separator then
7546 Add_Char_To_Name_Buffer (Directory_Separator);
7549 Add_Str_To_Name_Buffer (Name_Str (1 .. Last));
7552 if Current_Verbosity = High then
7553 Write_Str (" found ");
7554 Write_Line (Get_Name_String (Name));
7557 -- Register the source if it is an Ada compilation unit
7565 Location => NL.Location,
7566 Current_Source => Current_Source,
7567 Source_Recorded => Source_Recorded,
7568 Current_Dir => Current_Dir);
7575 if Source_Recorded then
7576 In_Tree.String_Elements.Table (Source_Dir).Flag :=
7580 Source_Dir := Element.Next;
7583 -- It is an error if a source file name in a source list or
7584 -- in a source list file is not found.
7586 NL := Source_Names.Get_First;
7587 while NL /= No_Name_Location loop
7588 if not NL.Found then
7589 Err_Vars.Error_Msg_File_1 := NL.Name;
7594 "source file { cannot be found",
7596 First_Error := False;
7601 "\source file { cannot be found",
7606 NL := Source_Names.Get_Next;
7608 end Get_Path_Names_And_Record_Ada_Sources;
7610 --------------------------
7611 -- Check_Naming_Schemes --
7612 --------------------------
7614 procedure Check_Naming_Schemes
7615 (In_Tree : Project_Tree_Ref;
7616 Data : in out Project_Data;
7618 File_Name : File_Name_Type;
7619 Alternate_Languages : out Alternate_Language_Id;
7620 Language : out Language_Index;
7621 Language_Name : out Name_Id;
7622 Display_Language_Name : out Name_Id;
7624 Lang_Kind : out Language_Kind;
7625 Kind : out Source_Kind)
7627 Last : Positive := Filename'Last;
7628 Config : Language_Config;
7629 Lang : Name_List_Index := Data.Languages;
7630 Header_File : Boolean := False;
7631 First_Language : Language_Index;
7634 Last_Spec : Natural;
7635 Last_Body : Natural;
7640 Alternate_Languages := No_Alternate_Language;
7642 while Lang /= No_Name_List loop
7643 Language_Name := In_Tree.Name_Lists.Table (Lang).Name;
7644 Language := Data.First_Language_Processing;
7646 if Current_Verbosity = High then
7648 (" Testing language "
7649 & Get_Name_String (Language_Name)
7650 & " Header_File=" & Header_File'Img);
7653 while Language /= No_Language_Index loop
7654 if In_Tree.Languages_Data.Table (Language).Name =
7657 Display_Language_Name :=
7658 In_Tree.Languages_Data.Table (Language).Display_Name;
7659 Config := In_Tree.Languages_Data.Table (Language).Config;
7660 Lang_Kind := Config.Kind;
7662 if Config.Kind = File_Based then
7664 -- For file based languages, there is no Unit. Just
7665 -- check if the file name has the implementation or,
7666 -- if it is specified, the template suffix of the
7672 and then Config.Naming_Data.Body_Suffix /= No_File
7675 Impl_Suffix : constant String :=
7676 Get_Name_String (Config.Naming_Data.Body_Suffix);
7679 if Filename'Length > Impl_Suffix'Length
7682 (Last - Impl_Suffix'Length + 1 .. Last) =
7687 if Current_Verbosity = High then
7688 Write_Str (" source of language ");
7690 (Get_Name_String (Display_Language_Name));
7698 if Config.Naming_Data.Spec_Suffix /= No_File then
7700 Spec_Suffix : constant String :=
7702 (Config.Naming_Data.Spec_Suffix);
7705 if Filename'Length > Spec_Suffix'Length
7708 (Last - Spec_Suffix'Length + 1 .. Last) =
7713 if Current_Verbosity = High then
7714 Write_Str (" header file of language ");
7716 (Get_Name_String (Display_Language_Name));
7720 Alternate_Language_Table.Increment_Last
7721 (In_Tree.Alt_Langs);
7722 In_Tree.Alt_Langs.Table
7723 (Alternate_Language_Table.Last
7724 (In_Tree.Alt_Langs)) :=
7725 (Language => Language,
7726 Next => Alternate_Languages);
7727 Alternate_Languages :=
7728 Alternate_Language_Table.Last
7729 (In_Tree.Alt_Langs);
7731 Header_File := True;
7732 First_Language := Language;
7738 elsif not Header_File then
7739 -- Unit based language
7741 OK := Config.Naming_Data.Dot_Replacement /= No_File;
7746 -- ??? Are we doing this once per file in the project ?
7747 -- It should be done only once per project.
7749 case Config.Naming_Data.Casing is
7750 when All_Lower_Case =>
7751 for J in Filename'Range loop
7752 if Is_Letter (Filename (J)) then
7753 if not Is_Lower (Filename (J)) then
7760 when All_Upper_Case =>
7761 for J in Filename'Range loop
7762 if Is_Letter (Filename (J)) then
7763 if not Is_Upper (Filename (J)) then
7779 Last_Spec := Natural'Last;
7780 Last_Body := Natural'Last;
7781 Last_Sep := Natural'Last;
7783 if Config.Naming_Data.Separate_Suffix /= No_File
7785 Config.Naming_Data.Separate_Suffix /=
7786 Config.Naming_Data.Body_Suffix
7789 Suffix : constant String :=
7791 (Config.Naming_Data.Separate_Suffix);
7793 if Filename'Length > Suffix'Length
7796 (Last - Suffix'Length + 1 .. Last) =
7799 Last_Sep := Last - Suffix'Length;
7804 if Config.Naming_Data.Body_Suffix /= No_File then
7806 Suffix : constant String :=
7808 (Config.Naming_Data.Body_Suffix);
7810 if Filename'Length > Suffix'Length
7813 (Last - Suffix'Length + 1 .. Last) =
7816 Last_Body := Last - Suffix'Length;
7821 if Config.Naming_Data.Spec_Suffix /= No_File then
7823 Suffix : constant String :=
7825 (Config.Naming_Data.Spec_Suffix);
7827 if Filename'Length > Suffix'Length
7830 (Last - Suffix'Length + 1 .. Last) =
7833 Last_Spec := Last - Suffix'Length;
7839 Last_Min : constant Natural :=
7840 Natural'Min (Natural'Min (Last_Spec,
7845 OK := Last_Min < Last;
7850 if Last_Min = Last_Spec then
7853 elsif Last_Min = Last_Body then
7865 -- Replace dot replacements with dots
7870 J : Positive := Filename'First;
7872 Dot_Replacement : constant String :=
7874 (Config.Naming_Data.
7877 Max : constant Positive :=
7878 Last - Dot_Replacement'Length + 1;
7882 Name_Len := Name_Len + 1;
7884 if J <= Max and then
7886 (J .. J + Dot_Replacement'Length - 1) =
7889 Name_Buffer (Name_Len) := '.';
7890 J := J + Dot_Replacement'Length;
7893 if Filename (J) = '.' then
7898 Name_Buffer (Name_Len) :=
7899 GNAT.Case_Util.To_Lower (Filename (J));
7910 -- The name buffer should contain the name of the
7911 -- the unit, if it is one.
7913 -- Check that this is a valid unit name
7915 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
7917 if Unit /= No_Name then
7919 if Current_Verbosity = High then
7921 Write_Str (" spec of ");
7923 Write_Str (" body of ");
7926 Write_Str (Get_Name_String (Unit));
7927 Write_Str (" (language ");
7929 (Get_Name_String (Display_Language_Name));
7933 -- Comments required, declare block should
7937 Unit_Except : constant Unit_Exception :=
7938 Unit_Exceptions.Get (Unit);
7940 procedure Masked_Unit (Spec : Boolean);
7941 -- Indicate that there is an exception for
7942 -- the same unit, so the file is not a
7943 -- source for the unit.
7949 procedure Masked_Unit (Spec : Boolean) is
7951 if Current_Verbosity = High then
7953 Write_Str (Filename);
7954 Write_Str (""" contains the ");
7963 (" of a unit that is found in """);
7968 (Unit_Except.Spec));
7972 (Unit_Except.Impl));
7975 Write_Line (""" (ignored)");
7978 Language := No_Language_Index;
7983 if Unit_Except.Spec /= No_File
7984 and then Unit_Except.Spec /= File_Name
7986 Masked_Unit (Spec => True);
7990 if Unit_Except.Impl /= No_File
7991 and then Unit_Except.Impl /= File_Name
7993 Masked_Unit (Spec => False);
8004 Language := In_Tree.Languages_Data.Table (Language).Next;
8007 Lang := In_Tree.Name_Lists.Table (Lang).Next;
8010 -- Comment needed here ???
8013 Language := First_Language;
8016 Language := No_Language_Index;
8018 if Current_Verbosity = High then
8019 Write_Line (" not a source of any language");
8022 end Check_Naming_Schemes;
8028 procedure Check_File
8029 (Project : Project_Id;
8030 In_Tree : Project_Tree_Ref;
8031 Data : in out Project_Data;
8033 File_Name : File_Name_Type;
8034 Display_File_Name : File_Name_Type;
8035 Source_Directory : String;
8036 For_All_Sources : Boolean)
8038 Display_Path : constant String :=
8041 Directory => Source_Directory,
8042 Resolve_Links => Opt.Follow_Links_For_Files,
8043 Case_Sensitive => True);
8045 Name_Loc : Name_Location := Source_Names.Get (File_Name);
8046 Path_Id : Path_Name_Type;
8047 Display_Path_Id : Path_Name_Type;
8048 Check_Name : Boolean := False;
8049 Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
8050 Language : Language_Index;
8052 Other_Part : Source_Id;
8054 Src_Ind : Source_File_Index;
8056 Source_To_Replace : Source_Id := No_Source;
8057 Language_Name : Name_Id;
8058 Display_Language_Name : Name_Id;
8059 Lang_Kind : Language_Kind;
8060 Kind : Source_Kind := Spec;
8063 Name_Len := Display_Path'Length;
8064 Name_Buffer (1 .. Name_Len) := Display_Path;
8065 Display_Path_Id := Name_Find;
8067 if Osint.File_Names_Case_Sensitive then
8068 Path_Id := Display_Path_Id;
8070 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
8071 Path_Id := Name_Find;
8074 if Name_Loc = No_Name_Location then
8075 Check_Name := For_All_Sources;
8078 if Name_Loc.Found then
8080 -- Check if it is OK to have the same file name in several
8081 -- source directories.
8083 if not Data.Known_Order_Of_Source_Dirs then
8084 Error_Msg_File_1 := File_Name;
8087 "{ is found in several source directories",
8092 Name_Loc.Found := True;
8094 Source_Names.Set (File_Name, Name_Loc);
8096 if Name_Loc.Source = No_Source then
8100 In_Tree.Sources.Table (Name_Loc.Source).Path :=
8101 (Path_Id, Display_Path_Id);
8103 Source_Paths_Htable.Set
8104 (In_Tree.Source_Paths_HT,
8108 -- Check if this is a subunit
8110 if In_Tree.Sources.Table (Name_Loc.Source).Unit /= No_Name
8112 In_Tree.Sources.Table (Name_Loc.Source).Kind = Impl
8114 Src_Ind := Sinput.P.Load_Project_File
8115 (Get_Name_String (Path_Id));
8117 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
8118 In_Tree.Sources.Table (Name_Loc.Source).Kind := Sep;
8126 Other_Part := No_Source;
8128 Check_Naming_Schemes
8129 (In_Tree => In_Tree,
8131 Filename => Get_Name_String (File_Name),
8132 File_Name => File_Name,
8133 Alternate_Languages => Alternate_Languages,
8134 Language => Language,
8135 Language_Name => Language_Name,
8136 Display_Language_Name => Display_Language_Name,
8138 Lang_Kind => Lang_Kind,
8141 if Language = No_Language_Index then
8143 -- A file name in a list must be a source of a language
8145 if Name_Loc.Found then
8146 Error_Msg_File_1 := File_Name;
8150 "language unknown for {",
8155 -- Check if the same file name or unit is used in the prj tree
8157 Source := In_Tree.First_Source;
8159 while Source /= No_Source loop
8161 Src_Data : Source_Data renames
8162 In_Tree.Sources.Table (Source);
8166 and then Src_Data.Unit = Unit
8168 ((Src_Data.Kind = Spec and then Kind = Impl)
8170 (Src_Data.Kind = Impl and then Kind = Spec))
8172 Other_Part := Source;
8174 elsif (Unit /= No_Name
8175 and then Src_Data.Unit = Unit
8177 (Src_Data.Kind = Kind
8179 (Src_Data.Kind = Sep and then Kind = Impl)
8181 (Src_Data.Kind = Impl and then Kind = Sep)))
8183 (Unit = No_Name and then Src_Data.File = File_Name)
8185 -- Duplication of file/unit in same project is only
8186 -- allowed if order of source directories is known.
8188 if Project = Src_Data.Project then
8189 if Data.Known_Order_Of_Source_Dirs then
8192 elsif Unit /= No_Name then
8193 Error_Msg_Name_1 := Unit;
8195 (Project, In_Tree, "duplicate unit %%",
8200 Error_Msg_File_1 := File_Name;
8202 (Project, In_Tree, "duplicate source file name {",
8207 -- Do not allow the same unit name in different
8208 -- projects, except if one is extending the other.
8210 -- For a file based language, the same file name
8211 -- replaces a file in a project being extended, but
8212 -- it is allowed to have the same file name in
8213 -- unrelated projects.
8216 (Project, Src_Data.Project, In_Tree)
8218 Source_To_Replace := Source;
8220 elsif Unit /= No_Name
8221 and then not Src_Data.Locally_Removed
8223 Error_Msg_Name_1 := Unit;
8226 "unit %% cannot belong to several projects",
8230 In_Tree.Projects.Table (Project).Name;
8231 Error_Msg_Name_2 := Name_Id (Display_Path_Id);
8233 (Project, In_Tree, "\ project %%, %%", No_Location);
8236 In_Tree.Projects.Table (Src_Data.Project).Name;
8238 Name_Id (Src_Data.Path.Display_Name);
8240 (Project, In_Tree, "\ project %%, %%", No_Location);
8246 Source := Src_Data.Next_In_Sources;
8256 Lang => Language_Name,
8257 Lang_Id => Language,
8258 Lang_Kind => Lang_Kind,
8260 Alternate_Languages => Alternate_Languages,
8261 File_Name => File_Name,
8262 Display_File => Display_File_Name,
8263 Other_Part => Other_Part,
8266 Display_Path => Display_Path_Id,
8267 Source_To_Replace => Source_To_Replace);
8273 ------------------------
8274 -- Search_Directories --
8275 ------------------------
8277 procedure Search_Directories
8278 (Project : Project_Id;
8279 In_Tree : Project_Tree_Ref;
8280 Data : in out Project_Data;
8281 For_All_Sources : Boolean)
8283 Source_Dir : String_List_Id;
8284 Element : String_Element;
8286 Name : String (1 .. 1_000);
8288 File_Name : File_Name_Type;
8289 Display_File_Name : File_Name_Type;
8292 if Current_Verbosity = High then
8293 Write_Line ("Looking for sources:");
8296 -- Loop through subdirectories
8298 Source_Dir := Data.Source_Dirs;
8299 while Source_Dir /= Nil_String loop
8301 Element := In_Tree.String_Elements.Table (Source_Dir);
8302 if Element.Value /= No_Name then
8303 Get_Name_String (Element.Display_Value);
8306 Source_Directory : constant String :=
8307 Name_Buffer (1 .. Name_Len) &
8308 Directory_Separator;
8310 Dir_Last : constant Natural :=
8311 Compute_Directory_Last
8315 if Current_Verbosity = High then
8316 Write_Str ("Source_Dir = ");
8317 Write_Line (Source_Directory);
8320 -- We look to every entry in the source directory
8322 Open (Dir, Source_Directory);
8325 Read (Dir, Name, Last);
8329 -- ??? Duplicate system call here, we just did a
8330 -- a similar one. Maybe Ada.Directories would be more
8334 (Source_Directory & Name (1 .. Last))
8336 if Current_Verbosity = High then
8337 Write_Str (" Checking ");
8338 Write_Line (Name (1 .. Last));
8342 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
8343 Display_File_Name := Name_Find;
8345 if Osint.File_Names_Case_Sensitive then
8346 File_Name := Display_File_Name;
8348 Canonical_Case_File_Name
8349 (Name_Buffer (1 .. Name_Len));
8350 File_Name := Name_Find;
8355 Excluded_Sources_Htable.Get (File_Name);
8358 if FF /= No_File_Found then
8359 if not FF.Found then
8361 Excluded_Sources_Htable.Set
8364 if Current_Verbosity = High then
8365 Write_Str (" excluded source """);
8366 Write_Str (Get_Name_String (File_Name));
8373 (Project => Project,
8376 Name => Name (1 .. Last),
8377 File_Name => File_Name,
8378 Display_File_Name => Display_File_Name,
8379 Source_Directory => Source_Directory
8380 (Source_Directory'First .. Dir_Last),
8381 For_All_Sources => For_All_Sources);
8392 when Directory_Error =>
8396 Source_Dir := Element.Next;
8399 if Current_Verbosity = High then
8400 Write_Line ("end Looking for sources.");
8402 end Search_Directories;
8404 ----------------------
8405 -- Look_For_Sources --
8406 ----------------------
8408 procedure Look_For_Sources
8409 (Project : Project_Id;
8410 In_Tree : Project_Tree_Ref;
8411 Data : in out Project_Data;
8412 Current_Dir : String)
8414 procedure Remove_Locally_Removed_Files_From_Units;
8415 -- Mark all locally removed sources as such in the Units table
8417 procedure Process_Sources_In_Multi_Language_Mode;
8418 -- Find all source files when in multi language mode
8420 ---------------------------------------------
8421 -- Remove_Locally_Removed_Files_From_Units --
8422 ---------------------------------------------
8424 procedure Remove_Locally_Removed_Files_From_Units is
8425 Excluded : File_Found;
8428 Extended : Project_Id;
8431 Excluded := Excluded_Sources_Htable.Get_First;
8432 while Excluded /= No_File_Found loop
8436 for Index in Unit_Table.First ..
8437 Unit_Table.Last (In_Tree.Units)
8439 Unit := In_Tree.Units.Table (Index);
8441 for Kind in Spec_Or_Body'Range loop
8442 if Unit.File_Names (Kind).Name = Excluded.File then
8445 -- Check that this is from the current project or
8446 -- that the current project extends.
8448 Extended := Unit.File_Names (Kind).Project;
8450 if Extended = Project
8451 or else Project_Extends (Project, Extended, In_Tree)
8453 Unit.File_Names (Kind).Path.Name := Slash;
8454 Unit.File_Names (Kind).Needs_Pragma := False;
8455 In_Tree.Units.Table (Index) := Unit;
8456 Add_Forbidden_File_Name
8457 (Unit.File_Names (Kind).Name);
8461 "cannot remove a source from " &
8468 end loop For_Each_Unit;
8471 Err_Vars.Error_Msg_File_1 := Excluded.File;
8473 (Project, In_Tree, "unknown file {", Excluded.Location);
8476 Excluded := Excluded_Sources_Htable.Get_Next;
8478 end Remove_Locally_Removed_Files_From_Units;
8480 --------------------------------------------
8481 -- Process_Sources_In_Multi_Language_Mode --
8482 --------------------------------------------
8484 procedure Process_Sources_In_Multi_Language_Mode is
8486 Name_Loc : Name_Location;
8491 -- First, put all naming exceptions if any, in the Source_Names table
8493 Unit_Exceptions.Reset;
8495 Source := Data.First_Source;
8496 while Source /= No_Source loop
8498 Src_Data : Source_Data renames In_Tree.Sources.Table (Source);
8501 -- An excluded file cannot also be an exception file name
8503 if Excluded_Sources_Htable.Get (Src_Data.File) /=
8506 Error_Msg_File_1 := Src_Data.File;
8509 "{ cannot be both excluded and an exception file name",
8513 Name_Loc := (Name => Src_Data.File,
8514 Location => No_Location,
8516 Except => Src_Data.Unit /= No_Name,
8519 if Current_Verbosity = High then
8520 Write_Str ("Putting source #");
8521 Write_Str (Source'Img);
8522 Write_Str (", file ");
8523 Write_Str (Get_Name_String (Src_Data.File));
8524 Write_Line (" in Source_Names");
8527 Source_Names.Set (K => Src_Data.File, E => Name_Loc);
8529 -- If this is an Ada exception, record in table Unit_Exceptions
8531 if Src_Data.Unit /= No_Name then
8533 Unit_Except : Unit_Exception :=
8534 Unit_Exceptions.Get (Src_Data.Unit);
8537 Unit_Except.Name := Src_Data.Unit;
8539 if Src_Data.Kind = Spec then
8540 Unit_Except.Spec := Src_Data.File;
8542 Unit_Except.Impl := Src_Data.File;
8545 Unit_Exceptions.Set (Src_Data.Unit, Unit_Except);
8549 Source := Src_Data.Next_In_Project;
8553 Find_Explicit_Sources
8554 (Current_Dir, Project, In_Tree, Data);
8556 -- Mark as such the sources that are declared as excluded
8558 FF := Excluded_Sources_Htable.Get_First;
8559 while FF /= No_File_Found loop
8561 Source := In_Tree.First_Source;
8562 while Source /= No_Source loop
8564 Src_Data : Source_Data renames
8565 In_Tree.Sources.Table (Source);
8568 if Src_Data.File = FF.File then
8570 -- Check that this is from this project or a project that
8571 -- the current project extends.
8573 if Src_Data.Project = Project or else
8574 Is_Extending (Project, Src_Data.Project, In_Tree)
8576 Src_Data.Locally_Removed := True;
8577 Src_Data.In_Interfaces := False;
8578 Add_Forbidden_File_Name (FF.File);
8584 Source := Src_Data.Next_In_Sources;
8588 if not FF.Found and not OK then
8589 Err_Vars.Error_Msg_File_1 := FF.File;
8590 Error_Msg (Project, In_Tree, "unknown file {", FF.Location);
8593 FF := Excluded_Sources_Htable.Get_Next;
8596 -- Check that two sources of this project do not have the same object
8599 Check_Object_File_Names : declare
8601 Source_Name : File_Name_Type;
8603 procedure Check_Object (Src_Data : Source_Data);
8604 -- Check if object file name of the current source is already in
8605 -- hash table Object_File_Names. If it is, report an error. If it
8606 -- is not, put it there with the file name of the current source.
8612 procedure Check_Object (Src_Data : Source_Data) is
8614 Source_Name := Object_File_Names.Get (Src_Data.Object);
8616 if Source_Name /= No_File then
8617 Error_Msg_File_1 := Src_Data.File;
8618 Error_Msg_File_2 := Source_Name;
8622 "{ and { have the same object file name",
8626 Object_File_Names.Set (Src_Data.Object, Src_Data.File);
8630 -- Start of processing for Check_Object_File_Names
8633 Object_File_Names.Reset;
8634 Src_Id := In_Tree.First_Source;
8635 while Src_Id /= No_Source loop
8637 Src_Data : Source_Data renames
8638 In_Tree.Sources.Table (Src_Id);
8641 if Src_Data.Compiled and then Src_Data.Object_Exists
8642 and then Project_Extends
8643 (Project, Src_Data.Project, In_Tree)
8645 if Src_Data.Unit = No_Name then
8646 if Src_Data.Kind = Impl then
8647 Check_Object (Src_Data);
8651 case Src_Data.Kind is
8653 if Src_Data.Other_Part = No_Source then
8654 Check_Object (Src_Data);
8661 if Src_Data.Other_Part /= No_Source then
8662 Check_Object (Src_Data);
8665 -- Check if it is a subunit
8668 Src_Ind : constant Source_File_Index :=
8669 Sinput.P.Load_Project_File
8671 (Src_Data.Path.Name));
8673 if Sinput.P.Source_File_Is_Subunit
8676 In_Tree.Sources.Table (Src_Id).Kind :=
8679 Check_Object (Src_Data);
8687 Src_Id := Src_Data.Next_In_Sources;
8690 end Check_Object_File_Names;
8691 end Process_Sources_In_Multi_Language_Mode;
8693 -- Start of processing for Look_For_Sources
8697 Find_Excluded_Sources (Project, In_Tree, Data);
8701 if Is_A_Language (In_Tree, Data, Name_Ada) then
8702 Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data);
8703 Remove_Locally_Removed_Files_From_Units;
8706 when Multi_Language =>
8707 if Data.First_Language_Processing /= No_Language_Index then
8708 Process_Sources_In_Multi_Language_Mode;
8711 end Look_For_Sources;
8717 function Path_Name_Of
8718 (File_Name : File_Name_Type;
8719 Directory : Path_Name_Type) return String
8721 Result : String_Access;
8722 The_Directory : constant String := Get_Name_String (Directory);
8725 Get_Name_String (File_Name);
8728 (File_Name => Name_Buffer (1 .. Name_Len),
8729 Path => The_Directory);
8731 if Result = null then
8734 Canonical_Case_File_Name (Result.all);
8739 -------------------------------
8740 -- Prepare_Ada_Naming_Exceptions --
8741 -------------------------------
8743 procedure Prepare_Ada_Naming_Exceptions
8744 (List : Array_Element_Id;
8745 In_Tree : Project_Tree_Ref;
8746 Kind : Spec_Or_Body)
8748 Current : Array_Element_Id;
8749 Element : Array_Element;
8753 -- Traverse the list
8756 while Current /= No_Array_Element loop
8757 Element := In_Tree.Array_Elements.Table (Current);
8759 if Element.Index /= No_Name then
8762 Unit => Element.Index,
8763 Next => No_Ada_Naming_Exception);
8764 Reverse_Ada_Naming_Exceptions.Set
8765 (Unit, (Element.Value.Value, Element.Value.Index));
8767 Ada_Naming_Exceptions.Get (File_Name_Type (Element.Value.Value));
8768 Ada_Naming_Exception_Table.Increment_Last;
8769 Ada_Naming_Exception_Table.Table
8770 (Ada_Naming_Exception_Table.Last) := Unit;
8771 Ada_Naming_Exceptions.Set
8772 (File_Name_Type (Element.Value.Value),
8773 Ada_Naming_Exception_Table.Last);
8776 Current := Element.Next;
8778 end Prepare_Ada_Naming_Exceptions;
8780 ---------------------
8781 -- Project_Extends --
8782 ---------------------
8784 function Project_Extends
8785 (Extending : Project_Id;
8786 Extended : Project_Id;
8787 In_Tree : Project_Tree_Ref) return Boolean
8789 Current : Project_Id := Extending;
8793 if Current = No_Project then
8796 elsif Current = Extended then
8800 Current := In_Tree.Projects.Table (Current).Extends;
8802 end Project_Extends;
8804 -----------------------
8805 -- Record_Ada_Source --
8806 -----------------------
8808 procedure Record_Ada_Source
8809 (File_Name : File_Name_Type;
8810 Path_Name : Path_Name_Type;
8811 Project : Project_Id;
8812 In_Tree : Project_Tree_Ref;
8813 Data : in out Project_Data;
8814 Location : Source_Ptr;
8815 Current_Source : in out String_List_Id;
8816 Source_Recorded : in out Boolean;
8817 Current_Dir : String)
8819 Canonical_File_Name : File_Name_Type;
8820 Canonical_Path_Name : Path_Name_Type;
8822 Exception_Id : Ada_Naming_Exception_Id;
8823 Unit_Name : Name_Id;
8824 Unit_Kind : Spec_Or_Body;
8825 Unit_Ind : Int := 0;
8827 Name_Index : Name_And_Index;
8828 Needs_Pragma : Boolean;
8830 The_Location : Source_Ptr := Location;
8831 Previous_Source : constant String_List_Id := Current_Source;
8832 Except_Name : Name_And_Index := No_Name_And_Index;
8834 Unit_Prj : Unit_Project;
8836 File_Name_Recorded : Boolean := False;
8839 if Osint.File_Names_Case_Sensitive then
8840 Canonical_File_Name := File_Name;
8841 Canonical_Path_Name := Path_Name;
8843 Get_Name_String (File_Name);
8844 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
8845 Canonical_File_Name := Name_Find;
8848 Canonical_Path : constant String :=
8850 (Get_Name_String (Path_Name),
8851 Directory => Current_Dir,
8852 Resolve_Links => Opt.Follow_Links_For_Files,
8853 Case_Sensitive => False);
8856 Add_Str_To_Name_Buffer (Canonical_Path);
8857 Canonical_Path_Name := Name_Find;
8861 -- Find out the unit name, the unit kind and if it needs
8862 -- a specific SFN pragma.
8865 (In_Tree => In_Tree,
8866 Canonical_File_Name => Canonical_File_Name,
8867 Naming => Data.Naming,
8868 Exception_Id => Exception_Id,
8869 Unit_Name => Unit_Name,
8870 Unit_Kind => Unit_Kind,
8871 Needs_Pragma => Needs_Pragma);
8873 if Exception_Id = No_Ada_Naming_Exception
8874 and then Unit_Name = No_Name
8876 if Current_Verbosity = High then
8878 Write_Str (Get_Name_String (Canonical_File_Name));
8879 Write_Line (""" is not a valid source file name (ignored).");
8883 -- Check to see if the source has been hidden by an exception,
8884 -- but only if it is not an exception.
8886 if not Needs_Pragma then
8888 Reverse_Ada_Naming_Exceptions.Get
8889 ((Unit_Kind, Unit_Name, No_Ada_Naming_Exception));
8891 if Except_Name /= No_Name_And_Index then
8892 if Current_Verbosity = High then
8894 Write_Str (Get_Name_String (Canonical_File_Name));
8895 Write_Str (""" contains a unit that is found in """);
8896 Write_Str (Get_Name_String (Except_Name.Name));
8897 Write_Line (""" (ignored).");
8900 -- The file is not included in the source of the project since
8901 -- it is hidden by the exception. So, nothing else to do.
8908 if Exception_Id /= No_Ada_Naming_Exception then
8909 Info := Ada_Naming_Exception_Table.Table (Exception_Id);
8910 Exception_Id := Info.Next;
8911 Info.Next := No_Ada_Naming_Exception;
8912 Name_Index := Reverse_Ada_Naming_Exceptions.Get (Info);
8914 Unit_Name := Info.Unit;
8915 Unit_Ind := Name_Index.Index;
8916 Unit_Kind := Info.Kind;
8919 -- Put the file name in the list of sources of the project
8921 String_Element_Table.Increment_Last (In_Tree.String_Elements);
8922 In_Tree.String_Elements.Table
8923 (String_Element_Table.Last (In_Tree.String_Elements)) :=
8924 (Value => Name_Id (Canonical_File_Name),
8925 Display_Value => Name_Id (File_Name),
8926 Location => No_Location,
8931 if Current_Source = Nil_String then
8933 String_Element_Table.Last (In_Tree.String_Elements);
8935 In_Tree.String_Elements.Table (Current_Source).Next :=
8936 String_Element_Table.Last (In_Tree.String_Elements);
8940 String_Element_Table.Last (In_Tree.String_Elements);
8942 -- Put the unit in unit list
8945 The_Unit : Unit_Index :=
8946 Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
8948 The_Unit_Data : Unit_Data;
8951 if Current_Verbosity = High then
8952 Write_Str ("Putting ");
8953 Write_Str (Get_Name_String (Unit_Name));
8954 Write_Line (" in the unit list.");
8957 -- The unit is already in the list, but may be it is
8958 -- only the other unit kind (spec or body), or what is
8959 -- in the unit list is a unit of a project we are extending.
8961 if The_Unit /= No_Unit_Index then
8962 The_Unit_Data := In_Tree.Units.Table (The_Unit);
8964 if (The_Unit_Data.File_Names (Unit_Kind).Name =
8967 The_Unit_Data.File_Names
8968 (Unit_Kind).Path.Name = Slash)
8969 or else The_Unit_Data.File_Names (Unit_Kind).Name = No_File
8970 or else Project_Extends
8972 The_Unit_Data.File_Names (Unit_Kind).Project,
8976 The_Unit_Data.File_Names (Unit_Kind).Path.Name = Slash
8978 Remove_Forbidden_File_Name
8979 (The_Unit_Data.File_Names (Unit_Kind).Name);
8982 -- Record the file name in the hash table Files_Htable
8984 Unit_Prj := (Unit => The_Unit, Project => Project);
8987 Canonical_File_Name,
8990 The_Unit_Data.File_Names (Unit_Kind) :=
8991 (Name => Canonical_File_Name,
8993 Display_Name => File_Name,
8994 Path => (Canonical_Path_Name, Path_Name),
8996 Needs_Pragma => Needs_Pragma);
8997 In_Tree.Units.Table (The_Unit) := The_Unit_Data;
8998 Source_Recorded := True;
9000 elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project
9001 and then (Data.Known_Order_Of_Source_Dirs
9003 The_Unit_Data.File_Names
9004 (Unit_Kind).Path.Name = Canonical_Path_Name)
9006 if Previous_Source = Nil_String then
9007 Data.Ada_Sources := Nil_String;
9009 In_Tree.String_Elements.Table (Previous_Source).Next :=
9011 String_Element_Table.Decrement_Last
9012 (In_Tree.String_Elements);
9015 Current_Source := Previous_Source;
9018 -- It is an error to have two units with the same name
9019 -- and the same kind (spec or body).
9021 if The_Location = No_Location then
9023 In_Tree.Projects.Table (Project).Location;
9026 Err_Vars.Error_Msg_Name_1 := Unit_Name;
9028 (Project, In_Tree, "duplicate unit %%", The_Location);
9030 Err_Vars.Error_Msg_Name_1 :=
9031 In_Tree.Projects.Table
9032 (The_Unit_Data.File_Names (Unit_Kind).Project).Name;
9033 Err_Vars.Error_Msg_File_1 :=
9035 (The_Unit_Data.File_Names (Unit_Kind).Path.Name);
9038 "\ project file %%, {", The_Location);
9040 Err_Vars.Error_Msg_Name_1 :=
9041 In_Tree.Projects.Table (Project).Name;
9042 Err_Vars.Error_Msg_File_1 :=
9043 File_Name_Type (Canonical_Path_Name);
9046 "\ project file %%, {", The_Location);
9049 -- It is a new unit, create a new record
9052 -- First, check if there is no other unit with this file
9053 -- name in another project. If it is, report error but note
9054 -- we do that only for the first unit in the source file.
9057 Files_Htable.Get (In_Tree.Files_HT, Canonical_File_Name);
9059 if not File_Name_Recorded and then
9060 Unit_Prj /= No_Unit_Project
9062 Error_Msg_File_1 := File_Name;
9064 In_Tree.Projects.Table (Unit_Prj.Project).Name;
9067 "{ is already a source of project %%",
9071 Unit_Table.Increment_Last (In_Tree.Units);
9072 The_Unit := Unit_Table.Last (In_Tree.Units);
9074 (In_Tree.Units_HT, Unit_Name, The_Unit);
9075 Unit_Prj := (Unit => The_Unit, Project => Project);
9078 Canonical_File_Name,
9080 The_Unit_Data.Name := Unit_Name;
9081 The_Unit_Data.File_Names (Unit_Kind) :=
9082 (Name => Canonical_File_Name,
9084 Display_Name => File_Name,
9085 Path => (Canonical_Path_Name, Path_Name),
9087 Needs_Pragma => Needs_Pragma);
9088 In_Tree.Units.Table (The_Unit) := The_Unit_Data;
9089 Source_Recorded := True;
9094 exit when Exception_Id = No_Ada_Naming_Exception;
9095 File_Name_Recorded := True;
9098 end Record_Ada_Source;
9104 procedure Remove_Source
9106 Replaced_By : Source_Id;
9107 Project : Project_Id;
9108 Data : in out Project_Data;
9109 In_Tree : Project_Tree_Ref)
9111 Src_Data : constant Source_Data := In_Tree.Sources.Table (Id);
9115 if Current_Verbosity = High then
9116 Write_Str ("Removing source #");
9117 Write_Line (Id'Img);
9120 if Replaced_By /= No_Source then
9121 In_Tree.Sources.Table (Id).Replaced_By := Replaced_By;
9122 In_Tree.Sources.Table (Replaced_By).Declared_In_Interfaces :=
9123 In_Tree.Sources.Table (Id).Declared_In_Interfaces;
9126 -- Remove the source from the global source list
9128 Source := In_Tree.First_Source;
9131 In_Tree.First_Source := Src_Data.Next_In_Sources;
9134 while In_Tree.Sources.Table (Source).Next_In_Sources /= Id loop
9135 Source := In_Tree.Sources.Table (Source).Next_In_Sources;
9138 In_Tree.Sources.Table (Source).Next_In_Sources :=
9139 Src_Data.Next_In_Sources;
9142 -- Remove the source from the project list
9144 if Src_Data.Project = Project then
9145 Source := Data.First_Source;
9148 Data.First_Source := Src_Data.Next_In_Project;
9150 if Src_Data.Next_In_Project = No_Source then
9151 Data.Last_Source := No_Source;
9155 while In_Tree.Sources.Table (Source).Next_In_Project /= Id loop
9156 Source := In_Tree.Sources.Table (Source).Next_In_Project;
9159 In_Tree.Sources.Table (Source).Next_In_Project :=
9160 Src_Data.Next_In_Project;
9162 if Src_Data.Next_In_Project = No_Source then
9163 In_Tree.Projects.Table (Src_Data.Project).Last_Source := Source;
9168 Source := In_Tree.Projects.Table (Src_Data.Project).First_Source;
9171 In_Tree.Projects.Table (Src_Data.Project).First_Source :=
9172 Src_Data.Next_In_Project;
9174 if Src_Data.Next_In_Project = No_Source then
9175 In_Tree.Projects.Table (Src_Data.Project).Last_Source :=
9180 while In_Tree.Sources.Table (Source).Next_In_Project /= Id loop
9181 Source := In_Tree.Sources.Table (Source).Next_In_Project;
9184 In_Tree.Sources.Table (Source).Next_In_Project :=
9185 Src_Data.Next_In_Project;
9187 if Src_Data.Next_In_Project = No_Source then
9188 In_Tree.Projects.Table (Src_Data.Project).Last_Source := Source;
9193 -- Remove source from the language list
9195 Source := In_Tree.Languages_Data.Table (Src_Data.Language).First_Source;
9198 In_Tree.Languages_Data.Table (Src_Data.Language).First_Source :=
9199 Src_Data.Next_In_Lang;
9202 while In_Tree.Sources.Table (Source).Next_In_Lang /= Id loop
9203 Source := In_Tree.Sources.Table (Source).Next_In_Lang;
9206 In_Tree.Sources.Table (Source).Next_In_Lang :=
9207 Src_Data.Next_In_Lang;
9211 -----------------------
9212 -- Report_No_Sources --
9213 -----------------------
9215 procedure Report_No_Sources
9216 (Project : Project_Id;
9218 In_Tree : Project_Tree_Ref;
9219 Location : Source_Ptr;
9220 Continuation : Boolean := False)
9223 case When_No_Sources is
9227 when Warning | Error =>
9229 Msg : constant String :=
9232 " sources in this project";
9235 Error_Msg_Warn := When_No_Sources = Warning;
9237 if Continuation then
9239 (Project, In_Tree, "\" & Msg, Location);
9243 (Project, In_Tree, Msg, Location);
9247 end Report_No_Sources;
9249 ----------------------
9250 -- Show_Source_Dirs --
9251 ----------------------
9253 procedure Show_Source_Dirs
9254 (Data : Project_Data;
9255 In_Tree : Project_Tree_Ref)
9257 Current : String_List_Id;
9258 Element : String_Element;
9261 Write_Line ("Source_Dirs:");
9263 Current := Data.Source_Dirs;
9264 while Current /= Nil_String loop
9265 Element := In_Tree.String_Elements.Table (Current);
9267 Write_Line (Get_Name_String (Element.Value));
9268 Current := Element.Next;
9271 Write_Line ("end Source_Dirs.");
9272 end Show_Source_Dirs;
9274 -------------------------
9275 -- Warn_If_Not_Sources --
9276 -------------------------
9278 -- comments needed in this body ???
9280 procedure Warn_If_Not_Sources
9281 (Project : Project_Id;
9282 In_Tree : Project_Tree_Ref;
9283 Conventions : Array_Element_Id;
9285 Extending : Boolean)
9287 Conv : Array_Element_Id;
9289 The_Unit_Id : Unit_Index;
9290 The_Unit_Data : Unit_Data;
9291 Location : Source_Ptr;
9294 Conv := Conventions;
9295 while Conv /= No_Array_Element loop
9296 Unit := In_Tree.Array_Elements.Table (Conv).Index;
9297 Error_Msg_Name_1 := Unit;
9298 Get_Name_String (Unit);
9299 To_Lower (Name_Buffer (1 .. Name_Len));
9301 The_Unit_Id := Units_Htable.Get (In_Tree.Units_HT, Unit);
9302 Location := In_Tree.Array_Elements.Table (Conv).Value.Location;
9304 if The_Unit_Id = No_Unit_Index then
9305 Error_Msg (Project, In_Tree, "?unknown unit %%", Location);
9308 The_Unit_Data := In_Tree.Units.Table (The_Unit_Id);
9310 In_Tree.Array_Elements.Table (Conv).Value.Value;
9313 if not Check_Project
9314 (The_Unit_Data.File_Names (Specification).Project,
9315 Project, In_Tree, Extending)
9319 "?source of spec of unit %% (%%)" &
9320 " cannot be found in this project",
9325 if not Check_Project
9326 (The_Unit_Data.File_Names (Body_Part).Project,
9327 Project, In_Tree, Extending)
9331 "?source of body of unit %% (%%)" &
9332 " cannot be found in this project",
9338 Conv := In_Tree.Array_Elements.Table (Conv).Next;
9340 end Warn_If_Not_Sources;