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 casing is right
6785 Src : String := File (First .. Last);
6786 Src_Last : Positive := Last;
6789 case Naming.Casing is
6790 when All_Lower_Case =>
6793 Mapping => Lower_Case_Map);
6795 when All_Upper_Case =>
6798 Mapping => Upper_Case_Map);
6800 when Mixed_Case | Unknown =>
6804 if Src /= File (First .. Last) then
6805 if Current_Verbosity = High then
6806 Write_Line (" Not a valid file name (casing).");
6809 Unit_Name := No_Name;
6813 -- We put the name in lower case
6817 Mapping => Lower_Case_Map);
6819 -- In the standard GNAT naming scheme, check for special cases:
6820 -- children or separates of A, G, I or S, and run time sources.
6822 if Standard_GNAT and then Src'Length >= 3 then
6824 S1 : constant Character := Src (Src'First);
6825 S2 : constant Character := Src (Src'First + 1);
6826 S3 : constant Character := Src (Src'First + 2);
6834 -- Children or separates of packages A, G, I or S. These
6835 -- names are x__ ... or x~... (where x is a, g, i, or s).
6836 -- Both versions (x__... and x~...) are allowed in all
6837 -- platforms, because it is not possible to know the
6838 -- platform before processing of the project files.
6840 if S2 = '_' and then S3 = '_' then
6841 Src (Src'First + 1) := '.';
6842 Src_Last := Src_Last - 1;
6843 Src (Src'First + 2 .. Src_Last) :=
6844 Src (Src'First + 3 .. Src_Last + 1);
6847 Src (Src'First + 1) := '.';
6849 -- If it is potentially a run time source, disable
6850 -- filling of the mapping file to avoid warnings.
6853 Set_Mapping_File_Initial_State_To_Empty;
6859 if Current_Verbosity = High then
6861 Write_Line (Src (Src'First .. Src_Last));
6864 -- Now, we check if this name is a valid unit name
6867 (Name => Src (Src'First .. Src_Last), Unit => Unit_Name);
6877 function Hash (Unit : Unit_Info) return Header_Num is
6879 return Header_Num (Unit.Unit mod 2048);
6882 -----------------------
6883 -- Is_Illegal_Suffix --
6884 -----------------------
6886 function Is_Illegal_Suffix
6888 Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean
6891 if Suffix'Length = 0 or else Index (Suffix, ".") = 0 then
6895 -- If dot replacement is a single dot, and first character of suffix is
6898 if Dot_Replacement_Is_A_Single_Dot
6899 and then Suffix (Suffix'First) = '.'
6901 for Index in Suffix'First + 1 .. Suffix'Last loop
6903 -- If there is another dot
6905 if Suffix (Index) = '.' then
6907 -- It is illegal to have a letter following the initial dot
6909 return Is_Letter (Suffix (Suffix'First + 1));
6917 end Is_Illegal_Suffix;
6919 ----------------------
6920 -- Locate_Directory --
6921 ----------------------
6923 procedure Locate_Directory
6924 (Project : Project_Id;
6925 In_Tree : Project_Tree_Ref;
6926 Name : File_Name_Type;
6927 Parent : Path_Name_Type;
6928 Dir : out Path_Name_Type;
6929 Display : out Path_Name_Type;
6930 Create : String := "";
6931 Current_Dir : String;
6932 Location : Source_Ptr := No_Location)
6934 The_Parent : constant String :=
6935 Get_Name_String (Parent) & Directory_Separator;
6937 The_Parent_Last : constant Natural :=
6938 Compute_Directory_Last (The_Parent);
6940 Full_Name : File_Name_Type;
6942 The_Name : File_Name_Type;
6945 Get_Name_String (Name);
6947 -- Add Subdirs.all if it is a directory that may be created and
6948 -- Subdirs is not null;
6950 if Create /= "" and then Subdirs /= null then
6951 if Name_Buffer (Name_Len) /= Directory_Separator then
6952 Add_Char_To_Name_Buffer (Directory_Separator);
6955 Add_Str_To_Name_Buffer (Subdirs.all);
6958 -- Convert '/' to directory separator (for Windows)
6960 for J in 1 .. Name_Len loop
6961 if Name_Buffer (J) = '/' then
6962 Name_Buffer (J) := Directory_Separator;
6966 The_Name := Name_Find;
6968 if Current_Verbosity = High then
6969 Write_Str ("Locate_Directory (""");
6970 Write_Str (Get_Name_String (The_Name));
6971 Write_Str (""", """);
6972 Write_Str (The_Parent);
6979 if Is_Absolute_Path (Get_Name_String (The_Name)) then
6980 Full_Name := The_Name;
6984 Add_Str_To_Name_Buffer
6985 (The_Parent (The_Parent'First .. The_Parent_Last));
6986 Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
6987 Full_Name := Name_Find;
6991 Full_Path_Name : constant String := Get_Name_String (Full_Name);
6994 if (Setup_Projects or else Subdirs /= null)
6995 and then Create'Length > 0
6996 and then not Is_Directory (Full_Path_Name)
6999 Create_Path (Full_Path_Name);
7001 if not Quiet_Output then
7003 Write_Str (" directory """);
7004 Write_Str (Full_Path_Name);
7005 Write_Line (""" created");
7012 "could not create " & Create &
7013 " directory " & Full_Path_Name,
7018 if Is_Directory (Full_Path_Name) then
7020 Normed : constant String :=
7023 Directory => Current_Dir,
7024 Resolve_Links => False,
7025 Case_Sensitive => True);
7027 Canonical_Path : constant String :=
7030 Directory => Current_Dir,
7032 Opt.Follow_Links_For_Dirs,
7033 Case_Sensitive => False);
7036 Name_Len := Normed'Length;
7037 Name_Buffer (1 .. Name_Len) := Normed;
7038 Display := Name_Find;
7040 Name_Len := Canonical_Path'Length;
7041 Name_Buffer (1 .. Name_Len) := Canonical_Path;
7046 end Locate_Directory;
7048 ---------------------------
7049 -- Find_Excluded_Sources --
7050 ---------------------------
7052 procedure Find_Excluded_Sources
7053 (Project : Project_Id;
7054 In_Tree : Project_Tree_Ref;
7055 Data : Project_Data)
7057 Excluded_Sources : Variable_Value;
7059 Excluded_Source_List_File : Variable_Value;
7061 Current : String_List_Id;
7063 Element : String_Element;
7065 Location : Source_Ptr;
7067 Name : File_Name_Type;
7069 File : Prj.Util.Text_File;
7070 Line : String (1 .. 300);
7073 Locally_Removed : Boolean := False;
7075 Excluded_Source_List_File :=
7077 (Name_Excluded_Source_List_File, Data.Decl.Attributes, In_Tree);
7081 (Name_Excluded_Source_Files, Data.Decl.Attributes, In_Tree);
7083 -- If Excluded_Source_Files is not declared, check
7084 -- Locally_Removed_Files.
7086 if Excluded_Sources.Default then
7087 Locally_Removed := True;
7090 (Name_Locally_Removed_Files, Data.Decl.Attributes, In_Tree);
7093 Excluded_Sources_Htable.Reset;
7095 -- If there are excluded sources, put them in the table
7097 if not Excluded_Sources.Default then
7098 if not Excluded_Source_List_File.Default then
7099 if Locally_Removed then
7102 "?both attributes Locally_Removed_Files and " &
7103 "Excluded_Source_List_File are present",
7104 Excluded_Source_List_File.Location);
7108 "?both attributes Excluded_Source_Files and " &
7109 "Excluded_Source_List_File are present",
7110 Excluded_Source_List_File.Location);
7114 Current := Excluded_Sources.Values;
7115 while Current /= Nil_String loop
7116 Element := In_Tree.String_Elements.Table (Current);
7118 if Osint.File_Names_Case_Sensitive then
7119 Name := File_Name_Type (Element.Value);
7121 Get_Name_String (Element.Value);
7122 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7126 -- If the element has no location, then use the location
7127 -- of Excluded_Sources to report possible errors.
7129 if Element.Location = No_Location then
7130 Location := Excluded_Sources.Location;
7132 Location := Element.Location;
7135 Excluded_Sources_Htable.Set (Name, (Name, False, Location));
7136 Current := Element.Next;
7139 elsif not Excluded_Source_List_File.Default then
7140 Location := Excluded_Source_List_File.Location;
7143 Source_File_Path_Name : constant String :=
7146 (Excluded_Source_List_File.Value),
7147 Data.Directory.Name);
7150 if Source_File_Path_Name'Length = 0 then
7151 Err_Vars.Error_Msg_File_1 :=
7152 File_Name_Type (Excluded_Source_List_File.Value);
7155 "file with excluded sources { does not exist",
7156 Excluded_Source_List_File.Location);
7161 Prj.Util.Open (File, Source_File_Path_Name);
7163 if not Prj.Util.Is_Valid (File) then
7165 (Project, In_Tree, "file does not exist", Location);
7167 -- Read the lines one by one
7169 while not Prj.Util.End_Of_File (File) loop
7170 Prj.Util.Get_Line (File, Line, Last);
7172 -- A non empty, non comment line should contain a file
7176 and then (Last = 1 or else Line (1 .. 2) /= "--")
7179 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
7180 Canonical_Case_File_Name
7181 (Name_Buffer (1 .. Name_Len));
7184 -- Check that there is no directory information
7186 for J in 1 .. Last loop
7188 or else Line (J) = Directory_Separator
7190 Error_Msg_File_1 := Name;
7194 "file name cannot include " &
7195 "directory information ({)",
7201 Excluded_Sources_Htable.Set
7202 (Name, (Name, False, Location));
7206 Prj.Util.Close (File);
7211 end Find_Excluded_Sources;
7213 ---------------------------
7214 -- Find_Explicit_Sources --
7215 ---------------------------
7217 procedure Find_Explicit_Sources
7218 (Current_Dir : String;
7219 Project : Project_Id;
7220 In_Tree : Project_Tree_Ref;
7221 Data : in out Project_Data)
7223 Sources : constant Variable_Value :=
7226 Data.Decl.Attributes,
7228 Source_List_File : constant Variable_Value :=
7230 (Name_Source_List_File,
7231 Data.Decl.Attributes,
7233 Name_Loc : Name_Location;
7236 pragma Assert (Sources.Kind = List, "Source_Files is not a list");
7238 (Source_List_File.Kind = Single,
7239 "Source_List_File is not a single string");
7241 -- If the user has specified a Sources attribute
7243 if not Sources.Default then
7244 if not Source_List_File.Default then
7247 "?both attributes source_files and " &
7248 "source_list_file are present",
7249 Source_List_File.Location);
7252 -- Sources is a list of file names
7255 Current : String_List_Id := Sources.Values;
7256 Element : String_Element;
7257 Location : Source_Ptr;
7258 Name : File_Name_Type;
7261 if Get_Mode = Ada_Only then
7262 Data.Ada_Sources_Present := Current /= Nil_String;
7265 if Get_Mode = Multi_Language then
7266 if Current = Nil_String then
7267 Data.First_Language_Processing := No_Language_Index;
7269 -- This project contains no source. For projects that
7270 -- don't extend other projects, this also means that
7271 -- there is no need for an object directory, if not
7274 if Data.Extends = No_Project
7275 and then Data.Object_Directory = Data.Directory
7277 Data.Object_Directory := No_Path_Information;
7282 while Current /= Nil_String loop
7283 Element := In_Tree.String_Elements.Table (Current);
7284 Get_Name_String (Element.Value);
7286 if Osint.File_Names_Case_Sensitive then
7287 Name := File_Name_Type (Element.Value);
7289 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7293 -- If the element has no location, then use the
7294 -- location of Sources to report possible errors.
7296 if Element.Location = No_Location then
7297 Location := Sources.Location;
7299 Location := Element.Location;
7302 -- Check that there is no directory information
7304 for J in 1 .. Name_Len loop
7305 if Name_Buffer (J) = '/'
7306 or else Name_Buffer (J) = Directory_Separator
7308 Error_Msg_File_1 := Name;
7312 "file name cannot include directory " &
7319 -- In Multi_Language mode, check whether the file is
7320 -- already there: the same file name may be in the list; if
7321 -- the source is missing, the error will be on the first
7322 -- mention of the source file name.
7326 Name_Loc := No_Name_Location;
7327 when Multi_Language =>
7328 Name_Loc := Source_Names.Get (Name);
7331 if Name_Loc = No_Name_Location then
7334 Location => Location,
7335 Source => No_Source,
7338 Source_Names.Set (Name, Name_Loc);
7341 Current := Element.Next;
7344 if Get_Mode = Ada_Only then
7345 Get_Path_Names_And_Record_Ada_Sources
7346 (Project, In_Tree, Data, Current_Dir);
7350 -- If we have no Source_Files attribute, check the Source_List_File
7353 elsif not Source_List_File.Default then
7355 -- Source_List_File is the name of the file
7356 -- that contains the source file names
7359 Source_File_Path_Name : constant String :=
7361 (File_Name_Type (Source_List_File.Value), Data.Directory.Name);
7364 if Source_File_Path_Name'Length = 0 then
7365 Err_Vars.Error_Msg_File_1 :=
7366 File_Name_Type (Source_List_File.Value);
7369 "file with sources { does not exist",
7370 Source_List_File.Location);
7373 Get_Sources_From_File
7374 (Source_File_Path_Name, Source_List_File.Location,
7377 if Get_Mode = Ada_Only then
7378 -- Look in the source directories to find those sources
7380 Get_Path_Names_And_Record_Ada_Sources
7381 (Project, In_Tree, Data, Current_Dir);
7387 -- Neither Source_Files nor Source_List_File has been
7388 -- specified. Find all the files that satisfy the naming
7389 -- scheme in all the source directories.
7391 if Get_Mode = Ada_Only then
7392 Find_Ada_Sources (Project, In_Tree, Data, Current_Dir);
7396 if Get_Mode = Multi_Language then
7398 (Project, In_Tree, Data,
7400 Sources.Default and then Source_List_File.Default);
7402 -- Check if all exceptions have been found.
7403 -- For Ada, it is an error if an exception is not found.
7404 -- For other language, the source is simply removed.
7410 Source := Data.First_Source;
7411 while Source /= No_Source loop
7413 Src_Data : Source_Data renames
7414 In_Tree.Sources.Table (Source);
7417 if Src_Data.Naming_Exception
7418 and then Src_Data.Path = No_Path_Information
7420 if Src_Data.Unit /= No_Name then
7421 Error_Msg_Name_1 := Name_Id (Src_Data.Display_File);
7422 Error_Msg_Name_2 := Name_Id (Src_Data.Unit);
7425 "source file %% for unit %% not found",
7429 Remove_Source (Source, No_Source, Project, Data, In_Tree);
7432 Source := Src_Data.Next_In_Project;
7437 -- Check that all sources in Source_Files or the file
7438 -- Source_List_File has been found.
7441 Name_Loc : Name_Location;
7444 Name_Loc := Source_Names.Get_First;
7445 while Name_Loc /= No_Name_Location loop
7446 if (not Name_Loc.Except) and then (not Name_Loc.Found) then
7447 Error_Msg_Name_1 := Name_Id (Name_Loc.Name);
7451 "file %% not found",
7455 Name_Loc := Source_Names.Get_Next;
7460 if Get_Mode = Ada_Only
7461 and then Data.Extends = No_Project
7463 -- We should have found at least one source, if not report an error
7465 if Data.Ada_Sources = Nil_String then
7467 (Project, "Ada", In_Tree, Source_List_File.Location);
7471 end Find_Explicit_Sources;
7473 -------------------------------------------
7474 -- Get_Path_Names_And_Record_Ada_Sources --
7475 -------------------------------------------
7477 procedure Get_Path_Names_And_Record_Ada_Sources
7478 (Project : Project_Id;
7479 In_Tree : Project_Tree_Ref;
7480 Data : in out Project_Data;
7481 Current_Dir : String)
7483 Source_Dir : String_List_Id;
7484 Element : String_Element;
7485 Path : Path_Name_Type;
7487 Name : File_Name_Type;
7488 Canonical_Name : File_Name_Type;
7489 Name_Str : String (1 .. 1_024);
7490 Last : Natural := 0;
7492 Current_Source : String_List_Id := Nil_String;
7493 First_Error : Boolean := True;
7494 Source_Recorded : Boolean := False;
7497 -- We look in all source directories for the file names in the hash
7498 -- table Source_Names.
7500 Source_Dir := Data.Source_Dirs;
7501 while Source_Dir /= Nil_String loop
7502 Source_Recorded := False;
7503 Element := In_Tree.String_Elements.Table (Source_Dir);
7506 Dir_Path : constant String :=
7507 Get_Name_String (Element.Display_Value);
7509 if Current_Verbosity = High then
7510 Write_Str ("checking directory """);
7511 Write_Str (Dir_Path);
7515 Open (Dir, Dir_Path);
7518 Read (Dir, Name_Str, Last);
7522 Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
7525 if Osint.File_Names_Case_Sensitive then
7526 Canonical_Name := Name;
7528 Canonical_Case_File_Name (Name_Str (1 .. Last));
7529 Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
7530 Canonical_Name := Name_Find;
7533 NL := Source_Names.Get (Canonical_Name);
7535 if NL /= No_Name_Location and then not NL.Found then
7537 Source_Names.Set (Canonical_Name, NL);
7538 Name_Len := Dir_Path'Length;
7539 Name_Buffer (1 .. Name_Len) := Dir_Path;
7541 if Name_Buffer (Name_Len) /= Directory_Separator then
7542 Add_Char_To_Name_Buffer (Directory_Separator);
7545 Add_Str_To_Name_Buffer (Name_Str (1 .. Last));
7548 if Current_Verbosity = High then
7549 Write_Str (" found ");
7550 Write_Line (Get_Name_String (Name));
7553 -- Register the source if it is an Ada compilation unit
7561 Location => NL.Location,
7562 Current_Source => Current_Source,
7563 Source_Recorded => Source_Recorded,
7564 Current_Dir => Current_Dir);
7571 if Source_Recorded then
7572 In_Tree.String_Elements.Table (Source_Dir).Flag :=
7576 Source_Dir := Element.Next;
7579 -- It is an error if a source file name in a source list or
7580 -- in a source list file is not found.
7582 NL := Source_Names.Get_First;
7583 while NL /= No_Name_Location loop
7584 if not NL.Found then
7585 Err_Vars.Error_Msg_File_1 := NL.Name;
7590 "source file { cannot be found",
7592 First_Error := False;
7597 "\source file { cannot be found",
7602 NL := Source_Names.Get_Next;
7604 end Get_Path_Names_And_Record_Ada_Sources;
7606 --------------------------
7607 -- Check_Naming_Schemes --
7608 --------------------------
7610 procedure Check_Naming_Schemes
7611 (In_Tree : Project_Tree_Ref;
7612 Data : in out Project_Data;
7614 File_Name : File_Name_Type;
7615 Alternate_Languages : out Alternate_Language_Id;
7616 Language : out Language_Index;
7617 Language_Name : out Name_Id;
7618 Display_Language_Name : out Name_Id;
7620 Lang_Kind : out Language_Kind;
7621 Kind : out Source_Kind)
7623 Last : Positive := Filename'Last;
7624 Config : Language_Config;
7625 Lang : Name_List_Index := Data.Languages;
7626 Header_File : Boolean := False;
7627 First_Language : Language_Index;
7630 Last_Spec : Natural;
7631 Last_Body : Natural;
7636 Alternate_Languages := No_Alternate_Language;
7638 while Lang /= No_Name_List loop
7639 Language_Name := In_Tree.Name_Lists.Table (Lang).Name;
7640 Language := Data.First_Language_Processing;
7642 if Current_Verbosity = High then
7644 (" Testing language "
7645 & Get_Name_String (Language_Name)
7646 & " Header_File=" & Header_File'Img);
7649 while Language /= No_Language_Index loop
7650 if In_Tree.Languages_Data.Table (Language).Name =
7653 Display_Language_Name :=
7654 In_Tree.Languages_Data.Table (Language).Display_Name;
7655 Config := In_Tree.Languages_Data.Table (Language).Config;
7656 Lang_Kind := Config.Kind;
7658 if Config.Kind = File_Based then
7660 -- For file based languages, there is no Unit. Just
7661 -- check if the file name has the implementation or,
7662 -- if it is specified, the template suffix of the
7668 and then Config.Naming_Data.Body_Suffix /= No_File
7671 Impl_Suffix : constant String :=
7672 Get_Name_String (Config.Naming_Data.Body_Suffix);
7675 if Filename'Length > Impl_Suffix'Length
7678 (Last - Impl_Suffix'Length + 1 .. Last) =
7683 if Current_Verbosity = High then
7684 Write_Str (" source of language ");
7686 (Get_Name_String (Display_Language_Name));
7694 if Config.Naming_Data.Spec_Suffix /= No_File then
7696 Spec_Suffix : constant String :=
7698 (Config.Naming_Data.Spec_Suffix);
7701 if Filename'Length > Spec_Suffix'Length
7704 (Last - Spec_Suffix'Length + 1 .. Last) =
7709 if Current_Verbosity = High then
7710 Write_Str (" header file of language ");
7712 (Get_Name_String (Display_Language_Name));
7716 Alternate_Language_Table.Increment_Last
7717 (In_Tree.Alt_Langs);
7718 In_Tree.Alt_Langs.Table
7719 (Alternate_Language_Table.Last
7720 (In_Tree.Alt_Langs)) :=
7721 (Language => Language,
7722 Next => Alternate_Languages);
7723 Alternate_Languages :=
7724 Alternate_Language_Table.Last
7725 (In_Tree.Alt_Langs);
7727 Header_File := True;
7728 First_Language := Language;
7734 elsif not Header_File then
7735 -- Unit based language
7737 OK := Config.Naming_Data.Dot_Replacement /= No_File;
7742 -- ??? Are we doing this once per file in the project ?
7743 -- It should be done only once per project.
7745 case Config.Naming_Data.Casing is
7746 when All_Lower_Case =>
7747 for J in Filename'Range loop
7748 if Is_Letter (Filename (J)) then
7749 if not Is_Lower (Filename (J)) then
7756 when All_Upper_Case =>
7757 for J in Filename'Range loop
7758 if Is_Letter (Filename (J)) then
7759 if not Is_Upper (Filename (J)) then
7775 Last_Spec := Natural'Last;
7776 Last_Body := Natural'Last;
7777 Last_Sep := Natural'Last;
7779 if Config.Naming_Data.Separate_Suffix /= No_File
7781 Config.Naming_Data.Separate_Suffix /=
7782 Config.Naming_Data.Body_Suffix
7785 Suffix : constant String :=
7787 (Config.Naming_Data.Separate_Suffix);
7789 if Filename'Length > Suffix'Length
7792 (Last - Suffix'Length + 1 .. Last) =
7795 Last_Sep := Last - Suffix'Length;
7800 if Config.Naming_Data.Body_Suffix /= No_File then
7802 Suffix : constant String :=
7804 (Config.Naming_Data.Body_Suffix);
7806 if Filename'Length > Suffix'Length
7809 (Last - Suffix'Length + 1 .. Last) =
7812 Last_Body := Last - Suffix'Length;
7817 if Config.Naming_Data.Spec_Suffix /= No_File then
7819 Suffix : constant String :=
7821 (Config.Naming_Data.Spec_Suffix);
7823 if Filename'Length > Suffix'Length
7826 (Last - Suffix'Length + 1 .. Last) =
7829 Last_Spec := Last - Suffix'Length;
7835 Last_Min : constant Natural :=
7836 Natural'Min (Natural'Min (Last_Spec,
7841 OK := Last_Min < Last;
7846 if Last_Min = Last_Spec then
7849 elsif Last_Min = Last_Body then
7861 -- Replace dot replacements with dots
7866 J : Positive := Filename'First;
7868 Dot_Replacement : constant String :=
7870 (Config.Naming_Data.
7873 Max : constant Positive :=
7874 Last - Dot_Replacement'Length + 1;
7878 Name_Len := Name_Len + 1;
7880 if J <= Max and then
7882 (J .. J + Dot_Replacement'Length - 1) =
7885 Name_Buffer (Name_Len) := '.';
7886 J := J + Dot_Replacement'Length;
7889 if Filename (J) = '.' then
7894 Name_Buffer (Name_Len) :=
7895 GNAT.Case_Util.To_Lower (Filename (J));
7906 -- The name buffer should contain the name of the
7907 -- the unit, if it is one.
7909 -- Check that this is a valid unit name
7911 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
7913 if Unit /= No_Name then
7915 if Current_Verbosity = High then
7917 Write_Str (" spec of ");
7919 Write_Str (" body of ");
7922 Write_Str (Get_Name_String (Unit));
7923 Write_Str (" (language ");
7925 (Get_Name_String (Display_Language_Name));
7929 -- Comments required, declare block should
7933 Unit_Except : constant Unit_Exception :=
7934 Unit_Exceptions.Get (Unit);
7936 procedure Masked_Unit (Spec : Boolean);
7937 -- Indicate that there is an exception for
7938 -- the same unit, so the file is not a
7939 -- source for the unit.
7945 procedure Masked_Unit (Spec : Boolean) is
7947 if Current_Verbosity = High then
7949 Write_Str (Filename);
7950 Write_Str (""" contains the ");
7959 (" of a unit that is found in """);
7964 (Unit_Except.Spec));
7968 (Unit_Except.Impl));
7971 Write_Line (""" (ignored)");
7974 Language := No_Language_Index;
7979 if Unit_Except.Spec /= No_File
7980 and then Unit_Except.Spec /= File_Name
7982 Masked_Unit (Spec => True);
7986 if Unit_Except.Impl /= No_File
7987 and then Unit_Except.Impl /= File_Name
7989 Masked_Unit (Spec => False);
8000 Language := In_Tree.Languages_Data.Table (Language).Next;
8003 Lang := In_Tree.Name_Lists.Table (Lang).Next;
8006 -- Comment needed here ???
8009 Language := First_Language;
8012 Language := No_Language_Index;
8014 if Current_Verbosity = High then
8015 Write_Line (" not a source of any language");
8018 end Check_Naming_Schemes;
8024 procedure Check_File
8025 (Project : Project_Id;
8026 In_Tree : Project_Tree_Ref;
8027 Data : in out Project_Data;
8029 File_Name : File_Name_Type;
8030 Display_File_Name : File_Name_Type;
8031 Source_Directory : String;
8032 For_All_Sources : Boolean)
8034 Display_Path : constant String :=
8037 Directory => Source_Directory,
8038 Resolve_Links => Opt.Follow_Links_For_Files,
8039 Case_Sensitive => True);
8041 Name_Loc : Name_Location := Source_Names.Get (File_Name);
8042 Path_Id : Path_Name_Type;
8043 Display_Path_Id : Path_Name_Type;
8044 Check_Name : Boolean := False;
8045 Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
8046 Language : Language_Index;
8048 Other_Part : Source_Id;
8050 Src_Ind : Source_File_Index;
8052 Source_To_Replace : Source_Id := No_Source;
8053 Language_Name : Name_Id;
8054 Display_Language_Name : Name_Id;
8055 Lang_Kind : Language_Kind;
8056 Kind : Source_Kind := Spec;
8059 Name_Len := Display_Path'Length;
8060 Name_Buffer (1 .. Name_Len) := Display_Path;
8061 Display_Path_Id := Name_Find;
8063 if Osint.File_Names_Case_Sensitive then
8064 Path_Id := Display_Path_Id;
8066 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
8067 Path_Id := Name_Find;
8070 if Name_Loc = No_Name_Location then
8071 Check_Name := For_All_Sources;
8074 if Name_Loc.Found then
8076 -- Check if it is OK to have the same file name in several
8077 -- source directories.
8079 if not Data.Known_Order_Of_Source_Dirs then
8080 Error_Msg_File_1 := File_Name;
8083 "{ is found in several source directories",
8088 Name_Loc.Found := True;
8090 Source_Names.Set (File_Name, Name_Loc);
8092 if Name_Loc.Source = No_Source then
8096 In_Tree.Sources.Table (Name_Loc.Source).Path :=
8097 (Path_Id, Display_Path_Id);
8099 Source_Paths_Htable.Set
8100 (In_Tree.Source_Paths_HT,
8104 -- Check if this is a subunit
8106 if In_Tree.Sources.Table (Name_Loc.Source).Unit /= No_Name
8108 In_Tree.Sources.Table (Name_Loc.Source).Kind = Impl
8110 Src_Ind := Sinput.P.Load_Project_File
8111 (Get_Name_String (Path_Id));
8113 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
8114 In_Tree.Sources.Table (Name_Loc.Source).Kind := Sep;
8122 Other_Part := No_Source;
8124 Check_Naming_Schemes
8125 (In_Tree => In_Tree,
8127 Filename => Get_Name_String (File_Name),
8128 File_Name => File_Name,
8129 Alternate_Languages => Alternate_Languages,
8130 Language => Language,
8131 Language_Name => Language_Name,
8132 Display_Language_Name => Display_Language_Name,
8134 Lang_Kind => Lang_Kind,
8137 if Language = No_Language_Index then
8139 -- A file name in a list must be a source of a language
8141 if Name_Loc.Found then
8142 Error_Msg_File_1 := File_Name;
8146 "language unknown for {",
8151 -- Check if the same file name or unit is used in the prj tree
8153 Source := In_Tree.First_Source;
8155 while Source /= No_Source loop
8157 Src_Data : Source_Data renames
8158 In_Tree.Sources.Table (Source);
8162 and then Src_Data.Unit = Unit
8164 ((Src_Data.Kind = Spec and then Kind = Impl)
8166 (Src_Data.Kind = Impl and then Kind = Spec))
8168 Other_Part := Source;
8170 elsif (Unit /= No_Name
8171 and then Src_Data.Unit = Unit
8173 (Src_Data.Kind = Kind
8175 (Src_Data.Kind = Sep and then Kind = Impl)
8177 (Src_Data.Kind = Impl and then Kind = Sep)))
8179 (Unit = No_Name and then Src_Data.File = File_Name)
8181 -- Duplication of file/unit in same project is only
8182 -- allowed if order of source directories is known.
8184 if Project = Src_Data.Project then
8185 if Data.Known_Order_Of_Source_Dirs then
8188 elsif Unit /= No_Name then
8189 Error_Msg_Name_1 := Unit;
8191 (Project, In_Tree, "duplicate unit %%",
8196 Error_Msg_File_1 := File_Name;
8198 (Project, In_Tree, "duplicate source file name {",
8203 -- Do not allow the same unit name in different
8204 -- projects, except if one is extending the other.
8206 -- For a file based language, the same file name
8207 -- replaces a file in a project being extended, but
8208 -- it is allowed to have the same file name in
8209 -- unrelated projects.
8212 (Project, Src_Data.Project, In_Tree)
8214 Source_To_Replace := Source;
8216 elsif Unit /= No_Name
8217 and then not Src_Data.Locally_Removed
8219 Error_Msg_Name_1 := Unit;
8222 "unit %% cannot belong to several projects",
8226 In_Tree.Projects.Table (Project).Name;
8227 Error_Msg_Name_2 := Name_Id (Display_Path_Id);
8229 (Project, In_Tree, "\ project %%, %%", No_Location);
8232 In_Tree.Projects.Table (Src_Data.Project).Name;
8234 Name_Id (Src_Data.Path.Display_Name);
8236 (Project, In_Tree, "\ project %%, %%", No_Location);
8242 Source := Src_Data.Next_In_Sources;
8252 Lang => Language_Name,
8253 Lang_Id => Language,
8254 Lang_Kind => Lang_Kind,
8256 Alternate_Languages => Alternate_Languages,
8257 File_Name => File_Name,
8258 Display_File => Display_File_Name,
8259 Other_Part => Other_Part,
8262 Display_Path => Display_Path_Id,
8263 Source_To_Replace => Source_To_Replace);
8269 ------------------------
8270 -- Search_Directories --
8271 ------------------------
8273 procedure Search_Directories
8274 (Project : Project_Id;
8275 In_Tree : Project_Tree_Ref;
8276 Data : in out Project_Data;
8277 For_All_Sources : Boolean)
8279 Source_Dir : String_List_Id;
8280 Element : String_Element;
8282 Name : String (1 .. 1_000);
8284 File_Name : File_Name_Type;
8285 Display_File_Name : File_Name_Type;
8288 if Current_Verbosity = High then
8289 Write_Line ("Looking for sources:");
8292 -- Loop through subdirectories
8294 Source_Dir := Data.Source_Dirs;
8295 while Source_Dir /= Nil_String loop
8297 Element := In_Tree.String_Elements.Table (Source_Dir);
8298 if Element.Value /= No_Name then
8299 Get_Name_String (Element.Display_Value);
8302 Source_Directory : constant String :=
8303 Name_Buffer (1 .. Name_Len) &
8304 Directory_Separator;
8306 Dir_Last : constant Natural :=
8307 Compute_Directory_Last
8311 if Current_Verbosity = High then
8312 Write_Str ("Source_Dir = ");
8313 Write_Line (Source_Directory);
8316 -- We look to every entry in the source directory
8318 Open (Dir, Source_Directory);
8321 Read (Dir, Name, Last);
8325 -- ??? Duplicate system call here, we just did a
8326 -- a similar one. Maybe Ada.Directories would be more
8330 (Source_Directory & Name (1 .. Last))
8332 if Current_Verbosity = High then
8333 Write_Str (" Checking ");
8334 Write_Line (Name (1 .. Last));
8338 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
8339 Display_File_Name := Name_Find;
8341 if Osint.File_Names_Case_Sensitive then
8342 File_Name := Display_File_Name;
8344 Canonical_Case_File_Name
8345 (Name_Buffer (1 .. Name_Len));
8346 File_Name := Name_Find;
8351 Excluded_Sources_Htable.Get (File_Name);
8354 if FF /= No_File_Found then
8355 if not FF.Found then
8357 Excluded_Sources_Htable.Set
8360 if Current_Verbosity = High then
8361 Write_Str (" excluded source """);
8362 Write_Str (Get_Name_String (File_Name));
8369 (Project => Project,
8372 Name => Name (1 .. Last),
8373 File_Name => File_Name,
8374 Display_File_Name => Display_File_Name,
8375 Source_Directory => Source_Directory
8376 (Source_Directory'First .. Dir_Last),
8377 For_All_Sources => For_All_Sources);
8388 when Directory_Error =>
8392 Source_Dir := Element.Next;
8395 if Current_Verbosity = High then
8396 Write_Line ("end Looking for sources.");
8398 end Search_Directories;
8400 ----------------------
8401 -- Look_For_Sources --
8402 ----------------------
8404 procedure Look_For_Sources
8405 (Project : Project_Id;
8406 In_Tree : Project_Tree_Ref;
8407 Data : in out Project_Data;
8408 Current_Dir : String)
8410 procedure Remove_Locally_Removed_Files_From_Units;
8411 -- Mark all locally removed sources as such in the Units table
8413 procedure Process_Sources_In_Multi_Language_Mode;
8414 -- Find all source files when in multi language mode
8416 ---------------------------------------------
8417 -- Remove_Locally_Removed_Files_From_Units --
8418 ---------------------------------------------
8420 procedure Remove_Locally_Removed_Files_From_Units is
8421 Excluded : File_Found;
8424 Extended : Project_Id;
8427 Excluded := Excluded_Sources_Htable.Get_First;
8428 while Excluded /= No_File_Found loop
8432 for Index in Unit_Table.First ..
8433 Unit_Table.Last (In_Tree.Units)
8435 Unit := In_Tree.Units.Table (Index);
8437 for Kind in Spec_Or_Body'Range loop
8438 if Unit.File_Names (Kind).Name = Excluded.File then
8441 -- Check that this is from the current project or
8442 -- that the current project extends.
8444 Extended := Unit.File_Names (Kind).Project;
8446 if Extended = Project
8447 or else Project_Extends (Project, Extended, In_Tree)
8449 Unit.File_Names (Kind).Path.Name := Slash;
8450 Unit.File_Names (Kind).Needs_Pragma := False;
8451 In_Tree.Units.Table (Index) := Unit;
8452 Add_Forbidden_File_Name
8453 (Unit.File_Names (Kind).Name);
8457 "cannot remove a source from " &
8464 end loop For_Each_Unit;
8467 Err_Vars.Error_Msg_File_1 := Excluded.File;
8469 (Project, In_Tree, "unknown file {", Excluded.Location);
8472 Excluded := Excluded_Sources_Htable.Get_Next;
8474 end Remove_Locally_Removed_Files_From_Units;
8476 --------------------------------------------
8477 -- Process_Sources_In_Multi_Language_Mode --
8478 --------------------------------------------
8480 procedure Process_Sources_In_Multi_Language_Mode is
8482 Name_Loc : Name_Location;
8487 -- First, put all naming exceptions if any, in the Source_Names table
8489 Unit_Exceptions.Reset;
8491 Source := Data.First_Source;
8492 while Source /= No_Source loop
8494 Src_Data : Source_Data renames In_Tree.Sources.Table (Source);
8497 -- An excluded file cannot also be an exception file name
8499 if Excluded_Sources_Htable.Get (Src_Data.File) /=
8502 Error_Msg_File_1 := Src_Data.File;
8505 "{ cannot be both excluded and an exception file name",
8509 Name_Loc := (Name => Src_Data.File,
8510 Location => No_Location,
8512 Except => Src_Data.Unit /= No_Name,
8515 if Current_Verbosity = High then
8516 Write_Str ("Putting source #");
8517 Write_Str (Source'Img);
8518 Write_Str (", file ");
8519 Write_Str (Get_Name_String (Src_Data.File));
8520 Write_Line (" in Source_Names");
8523 Source_Names.Set (K => Src_Data.File, E => Name_Loc);
8525 -- If this is an Ada exception, record in table Unit_Exceptions
8527 if Src_Data.Unit /= No_Name then
8529 Unit_Except : Unit_Exception :=
8530 Unit_Exceptions.Get (Src_Data.Unit);
8533 Unit_Except.Name := Src_Data.Unit;
8535 if Src_Data.Kind = Spec then
8536 Unit_Except.Spec := Src_Data.File;
8538 Unit_Except.Impl := Src_Data.File;
8541 Unit_Exceptions.Set (Src_Data.Unit, Unit_Except);
8545 Source := Src_Data.Next_In_Project;
8549 Find_Explicit_Sources
8550 (Current_Dir, Project, In_Tree, Data);
8552 -- Mark as such the sources that are declared as excluded
8554 FF := Excluded_Sources_Htable.Get_First;
8555 while FF /= No_File_Found loop
8557 Source := In_Tree.First_Source;
8558 while Source /= No_Source loop
8560 Src_Data : Source_Data renames
8561 In_Tree.Sources.Table (Source);
8564 if Src_Data.File = FF.File then
8566 -- Check that this is from this project or a project that
8567 -- the current project extends.
8569 if Src_Data.Project = Project or else
8570 Is_Extending (Project, Src_Data.Project, In_Tree)
8572 Src_Data.Locally_Removed := True;
8573 Src_Data.In_Interfaces := False;
8574 Add_Forbidden_File_Name (FF.File);
8580 Source := Src_Data.Next_In_Sources;
8584 if not FF.Found and not OK then
8585 Err_Vars.Error_Msg_File_1 := FF.File;
8586 Error_Msg (Project, In_Tree, "unknown file {", FF.Location);
8589 FF := Excluded_Sources_Htable.Get_Next;
8592 -- Check that two sources of this project do not have the same object
8595 Check_Object_File_Names : declare
8597 Source_Name : File_Name_Type;
8599 procedure Check_Object (Src_Data : Source_Data);
8600 -- Check if object file name of the current source is already in
8601 -- hash table Object_File_Names. If it is, report an error. If it
8602 -- is not, put it there with the file name of the current source.
8608 procedure Check_Object (Src_Data : Source_Data) is
8610 Source_Name := Object_File_Names.Get (Src_Data.Object);
8612 if Source_Name /= No_File then
8613 Error_Msg_File_1 := Src_Data.File;
8614 Error_Msg_File_2 := Source_Name;
8618 "{ and { have the same object file name",
8622 Object_File_Names.Set (Src_Data.Object, Src_Data.File);
8626 -- Start of processing for Check_Object_File_Names
8629 Object_File_Names.Reset;
8630 Src_Id := In_Tree.First_Source;
8631 while Src_Id /= No_Source loop
8633 Src_Data : Source_Data renames
8634 In_Tree.Sources.Table (Src_Id);
8637 if Src_Data.Compiled and then Src_Data.Object_Exists
8638 and then Project_Extends
8639 (Project, Src_Data.Project, In_Tree)
8641 if Src_Data.Unit = No_Name then
8642 if Src_Data.Kind = Impl then
8643 Check_Object (Src_Data);
8647 case Src_Data.Kind is
8649 if Src_Data.Other_Part = No_Source then
8650 Check_Object (Src_Data);
8657 if Src_Data.Other_Part /= No_Source then
8658 Check_Object (Src_Data);
8661 -- Check if it is a subunit
8664 Src_Ind : constant Source_File_Index :=
8665 Sinput.P.Load_Project_File
8667 (Src_Data.Path.Name));
8669 if Sinput.P.Source_File_Is_Subunit
8672 In_Tree.Sources.Table (Src_Id).Kind :=
8675 Check_Object (Src_Data);
8683 Src_Id := Src_Data.Next_In_Sources;
8686 end Check_Object_File_Names;
8687 end Process_Sources_In_Multi_Language_Mode;
8689 -- Start of processing for Look_For_Sources
8693 Find_Excluded_Sources (Project, In_Tree, Data);
8697 if Is_A_Language (In_Tree, Data, Name_Ada) then
8698 Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data);
8699 Remove_Locally_Removed_Files_From_Units;
8702 when Multi_Language =>
8703 if Data.First_Language_Processing /= No_Language_Index then
8704 Process_Sources_In_Multi_Language_Mode;
8707 end Look_For_Sources;
8713 function Path_Name_Of
8714 (File_Name : File_Name_Type;
8715 Directory : Path_Name_Type) return String
8717 Result : String_Access;
8718 The_Directory : constant String := Get_Name_String (Directory);
8721 Get_Name_String (File_Name);
8724 (File_Name => Name_Buffer (1 .. Name_Len),
8725 Path => The_Directory);
8727 if Result = null then
8730 Canonical_Case_File_Name (Result.all);
8735 -------------------------------
8736 -- Prepare_Ada_Naming_Exceptions --
8737 -------------------------------
8739 procedure Prepare_Ada_Naming_Exceptions
8740 (List : Array_Element_Id;
8741 In_Tree : Project_Tree_Ref;
8742 Kind : Spec_Or_Body)
8744 Current : Array_Element_Id;
8745 Element : Array_Element;
8749 -- Traverse the list
8752 while Current /= No_Array_Element loop
8753 Element := In_Tree.Array_Elements.Table (Current);
8755 if Element.Index /= No_Name then
8758 Unit => Element.Index,
8759 Next => No_Ada_Naming_Exception);
8760 Reverse_Ada_Naming_Exceptions.Set
8761 (Unit, (Element.Value.Value, Element.Value.Index));
8763 Ada_Naming_Exceptions.Get (File_Name_Type (Element.Value.Value));
8764 Ada_Naming_Exception_Table.Increment_Last;
8765 Ada_Naming_Exception_Table.Table
8766 (Ada_Naming_Exception_Table.Last) := Unit;
8767 Ada_Naming_Exceptions.Set
8768 (File_Name_Type (Element.Value.Value),
8769 Ada_Naming_Exception_Table.Last);
8772 Current := Element.Next;
8774 end Prepare_Ada_Naming_Exceptions;
8776 ---------------------
8777 -- Project_Extends --
8778 ---------------------
8780 function Project_Extends
8781 (Extending : Project_Id;
8782 Extended : Project_Id;
8783 In_Tree : Project_Tree_Ref) return Boolean
8785 Current : Project_Id := Extending;
8789 if Current = No_Project then
8792 elsif Current = Extended then
8796 Current := In_Tree.Projects.Table (Current).Extends;
8798 end Project_Extends;
8800 -----------------------
8801 -- Record_Ada_Source --
8802 -----------------------
8804 procedure Record_Ada_Source
8805 (File_Name : File_Name_Type;
8806 Path_Name : Path_Name_Type;
8807 Project : Project_Id;
8808 In_Tree : Project_Tree_Ref;
8809 Data : in out Project_Data;
8810 Location : Source_Ptr;
8811 Current_Source : in out String_List_Id;
8812 Source_Recorded : in out Boolean;
8813 Current_Dir : String)
8815 Canonical_File_Name : File_Name_Type;
8816 Canonical_Path_Name : Path_Name_Type;
8818 Exception_Id : Ada_Naming_Exception_Id;
8819 Unit_Name : Name_Id;
8820 Unit_Kind : Spec_Or_Body;
8821 Unit_Ind : Int := 0;
8823 Name_Index : Name_And_Index;
8824 Needs_Pragma : Boolean;
8826 The_Location : Source_Ptr := Location;
8827 Previous_Source : constant String_List_Id := Current_Source;
8828 Except_Name : Name_And_Index := No_Name_And_Index;
8830 Unit_Prj : Unit_Project;
8832 File_Name_Recorded : Boolean := False;
8835 if Osint.File_Names_Case_Sensitive then
8836 Canonical_File_Name := File_Name;
8837 Canonical_Path_Name := Path_Name;
8839 Get_Name_String (File_Name);
8840 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
8841 Canonical_File_Name := Name_Find;
8844 Canonical_Path : constant String :=
8846 (Get_Name_String (Path_Name),
8847 Directory => Current_Dir,
8848 Resolve_Links => Opt.Follow_Links_For_Files,
8849 Case_Sensitive => False);
8852 Add_Str_To_Name_Buffer (Canonical_Path);
8853 Canonical_Path_Name := Name_Find;
8857 -- Find out the unit name, the unit kind and if it needs
8858 -- a specific SFN pragma.
8861 (In_Tree => In_Tree,
8862 Canonical_File_Name => Canonical_File_Name,
8863 Naming => Data.Naming,
8864 Exception_Id => Exception_Id,
8865 Unit_Name => Unit_Name,
8866 Unit_Kind => Unit_Kind,
8867 Needs_Pragma => Needs_Pragma);
8869 if Exception_Id = No_Ada_Naming_Exception
8870 and then Unit_Name = No_Name
8872 if Current_Verbosity = High then
8874 Write_Str (Get_Name_String (Canonical_File_Name));
8875 Write_Line (""" is not a valid source file name (ignored).");
8879 -- Check to see if the source has been hidden by an exception,
8880 -- but only if it is not an exception.
8882 if not Needs_Pragma then
8884 Reverse_Ada_Naming_Exceptions.Get
8885 ((Unit_Kind, Unit_Name, No_Ada_Naming_Exception));
8887 if Except_Name /= No_Name_And_Index then
8888 if Current_Verbosity = High then
8890 Write_Str (Get_Name_String (Canonical_File_Name));
8891 Write_Str (""" contains a unit that is found in """);
8892 Write_Str (Get_Name_String (Except_Name.Name));
8893 Write_Line (""" (ignored).");
8896 -- The file is not included in the source of the project since
8897 -- it is hidden by the exception. So, nothing else to do.
8904 if Exception_Id /= No_Ada_Naming_Exception then
8905 Info := Ada_Naming_Exception_Table.Table (Exception_Id);
8906 Exception_Id := Info.Next;
8907 Info.Next := No_Ada_Naming_Exception;
8908 Name_Index := Reverse_Ada_Naming_Exceptions.Get (Info);
8910 Unit_Name := Info.Unit;
8911 Unit_Ind := Name_Index.Index;
8912 Unit_Kind := Info.Kind;
8915 -- Put the file name in the list of sources of the project
8917 String_Element_Table.Increment_Last (In_Tree.String_Elements);
8918 In_Tree.String_Elements.Table
8919 (String_Element_Table.Last (In_Tree.String_Elements)) :=
8920 (Value => Name_Id (Canonical_File_Name),
8921 Display_Value => Name_Id (File_Name),
8922 Location => No_Location,
8927 if Current_Source = Nil_String then
8929 String_Element_Table.Last (In_Tree.String_Elements);
8931 In_Tree.String_Elements.Table (Current_Source).Next :=
8932 String_Element_Table.Last (In_Tree.String_Elements);
8936 String_Element_Table.Last (In_Tree.String_Elements);
8938 -- Put the unit in unit list
8941 The_Unit : Unit_Index :=
8942 Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
8944 The_Unit_Data : Unit_Data;
8947 if Current_Verbosity = High then
8948 Write_Str ("Putting ");
8949 Write_Str (Get_Name_String (Unit_Name));
8950 Write_Line (" in the unit list.");
8953 -- The unit is already in the list, but may be it is
8954 -- only the other unit kind (spec or body), or what is
8955 -- in the unit list is a unit of a project we are extending.
8957 if The_Unit /= No_Unit_Index then
8958 The_Unit_Data := In_Tree.Units.Table (The_Unit);
8960 if (The_Unit_Data.File_Names (Unit_Kind).Name =
8963 The_Unit_Data.File_Names
8964 (Unit_Kind).Path.Name = Slash)
8965 or else The_Unit_Data.File_Names (Unit_Kind).Name = No_File
8966 or else Project_Extends
8968 The_Unit_Data.File_Names (Unit_Kind).Project,
8972 The_Unit_Data.File_Names (Unit_Kind).Path.Name = Slash
8974 Remove_Forbidden_File_Name
8975 (The_Unit_Data.File_Names (Unit_Kind).Name);
8978 -- Record the file name in the hash table Files_Htable
8980 Unit_Prj := (Unit => The_Unit, Project => Project);
8983 Canonical_File_Name,
8986 The_Unit_Data.File_Names (Unit_Kind) :=
8987 (Name => Canonical_File_Name,
8989 Display_Name => File_Name,
8990 Path => (Canonical_Path_Name, Path_Name),
8992 Needs_Pragma => Needs_Pragma);
8993 In_Tree.Units.Table (The_Unit) := The_Unit_Data;
8994 Source_Recorded := True;
8996 elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project
8997 and then (Data.Known_Order_Of_Source_Dirs
8999 The_Unit_Data.File_Names
9000 (Unit_Kind).Path.Name = Canonical_Path_Name)
9002 if Previous_Source = Nil_String then
9003 Data.Ada_Sources := Nil_String;
9005 In_Tree.String_Elements.Table (Previous_Source).Next :=
9007 String_Element_Table.Decrement_Last
9008 (In_Tree.String_Elements);
9011 Current_Source := Previous_Source;
9014 -- It is an error to have two units with the same name
9015 -- and the same kind (spec or body).
9017 if The_Location = No_Location then
9019 In_Tree.Projects.Table (Project).Location;
9022 Err_Vars.Error_Msg_Name_1 := Unit_Name;
9024 (Project, In_Tree, "duplicate unit %%", The_Location);
9026 Err_Vars.Error_Msg_Name_1 :=
9027 In_Tree.Projects.Table
9028 (The_Unit_Data.File_Names (Unit_Kind).Project).Name;
9029 Err_Vars.Error_Msg_File_1 :=
9031 (The_Unit_Data.File_Names (Unit_Kind).Path.Name);
9034 "\ project file %%, {", The_Location);
9036 Err_Vars.Error_Msg_Name_1 :=
9037 In_Tree.Projects.Table (Project).Name;
9038 Err_Vars.Error_Msg_File_1 :=
9039 File_Name_Type (Canonical_Path_Name);
9042 "\ project file %%, {", The_Location);
9045 -- It is a new unit, create a new record
9048 -- First, check if there is no other unit with this file
9049 -- name in another project. If it is, report error but note
9050 -- we do that only for the first unit in the source file.
9053 Files_Htable.Get (In_Tree.Files_HT, Canonical_File_Name);
9055 if not File_Name_Recorded and then
9056 Unit_Prj /= No_Unit_Project
9058 Error_Msg_File_1 := File_Name;
9060 In_Tree.Projects.Table (Unit_Prj.Project).Name;
9063 "{ is already a source of project %%",
9067 Unit_Table.Increment_Last (In_Tree.Units);
9068 The_Unit := Unit_Table.Last (In_Tree.Units);
9070 (In_Tree.Units_HT, Unit_Name, The_Unit);
9071 Unit_Prj := (Unit => The_Unit, Project => Project);
9074 Canonical_File_Name,
9076 The_Unit_Data.Name := Unit_Name;
9077 The_Unit_Data.File_Names (Unit_Kind) :=
9078 (Name => Canonical_File_Name,
9080 Display_Name => File_Name,
9081 Path => (Canonical_Path_Name, Path_Name),
9083 Needs_Pragma => Needs_Pragma);
9084 In_Tree.Units.Table (The_Unit) := The_Unit_Data;
9085 Source_Recorded := True;
9090 exit when Exception_Id = No_Ada_Naming_Exception;
9091 File_Name_Recorded := True;
9094 end Record_Ada_Source;
9100 procedure Remove_Source
9102 Replaced_By : Source_Id;
9103 Project : Project_Id;
9104 Data : in out Project_Data;
9105 In_Tree : Project_Tree_Ref)
9107 Src_Data : constant Source_Data := In_Tree.Sources.Table (Id);
9111 if Current_Verbosity = High then
9112 Write_Str ("Removing source #");
9113 Write_Line (Id'Img);
9116 if Replaced_By /= No_Source then
9117 In_Tree.Sources.Table (Id).Replaced_By := Replaced_By;
9118 In_Tree.Sources.Table (Replaced_By).Declared_In_Interfaces :=
9119 In_Tree.Sources.Table (Id).Declared_In_Interfaces;
9122 -- Remove the source from the global source list
9124 Source := In_Tree.First_Source;
9127 In_Tree.First_Source := Src_Data.Next_In_Sources;
9130 while In_Tree.Sources.Table (Source).Next_In_Sources /= Id loop
9131 Source := In_Tree.Sources.Table (Source).Next_In_Sources;
9134 In_Tree.Sources.Table (Source).Next_In_Sources :=
9135 Src_Data.Next_In_Sources;
9138 -- Remove the source from the project list
9140 if Src_Data.Project = Project then
9141 Source := Data.First_Source;
9144 Data.First_Source := Src_Data.Next_In_Project;
9146 if Src_Data.Next_In_Project = No_Source then
9147 Data.Last_Source := No_Source;
9151 while In_Tree.Sources.Table (Source).Next_In_Project /= Id loop
9152 Source := In_Tree.Sources.Table (Source).Next_In_Project;
9155 In_Tree.Sources.Table (Source).Next_In_Project :=
9156 Src_Data.Next_In_Project;
9158 if Src_Data.Next_In_Project = No_Source then
9159 In_Tree.Projects.Table (Src_Data.Project).Last_Source := Source;
9164 Source := In_Tree.Projects.Table (Src_Data.Project).First_Source;
9167 In_Tree.Projects.Table (Src_Data.Project).First_Source :=
9168 Src_Data.Next_In_Project;
9170 if Src_Data.Next_In_Project = No_Source then
9171 In_Tree.Projects.Table (Src_Data.Project).Last_Source :=
9176 while In_Tree.Sources.Table (Source).Next_In_Project /= Id loop
9177 Source := In_Tree.Sources.Table (Source).Next_In_Project;
9180 In_Tree.Sources.Table (Source).Next_In_Project :=
9181 Src_Data.Next_In_Project;
9183 if Src_Data.Next_In_Project = No_Source then
9184 In_Tree.Projects.Table (Src_Data.Project).Last_Source := Source;
9189 -- Remove source from the language list
9191 Source := In_Tree.Languages_Data.Table (Src_Data.Language).First_Source;
9194 In_Tree.Languages_Data.Table (Src_Data.Language).First_Source :=
9195 Src_Data.Next_In_Lang;
9198 while In_Tree.Sources.Table (Source).Next_In_Lang /= Id loop
9199 Source := In_Tree.Sources.Table (Source).Next_In_Lang;
9202 In_Tree.Sources.Table (Source).Next_In_Lang :=
9203 Src_Data.Next_In_Lang;
9207 -----------------------
9208 -- Report_No_Sources --
9209 -----------------------
9211 procedure Report_No_Sources
9212 (Project : Project_Id;
9214 In_Tree : Project_Tree_Ref;
9215 Location : Source_Ptr;
9216 Continuation : Boolean := False)
9219 case When_No_Sources is
9223 when Warning | Error =>
9225 Msg : constant String :=
9228 " sources in this project";
9231 Error_Msg_Warn := When_No_Sources = Warning;
9233 if Continuation then
9235 (Project, In_Tree, "\" & Msg, Location);
9239 (Project, In_Tree, Msg, Location);
9243 end Report_No_Sources;
9245 ----------------------
9246 -- Show_Source_Dirs --
9247 ----------------------
9249 procedure Show_Source_Dirs
9250 (Data : Project_Data;
9251 In_Tree : Project_Tree_Ref)
9253 Current : String_List_Id;
9254 Element : String_Element;
9257 Write_Line ("Source_Dirs:");
9259 Current := Data.Source_Dirs;
9260 while Current /= Nil_String loop
9261 Element := In_Tree.String_Elements.Table (Current);
9263 Write_Line (Get_Name_String (Element.Value));
9264 Current := Element.Next;
9267 Write_Line ("end Source_Dirs.");
9268 end Show_Source_Dirs;
9270 -------------------------
9271 -- Warn_If_Not_Sources --
9272 -------------------------
9274 -- comments needed in this body ???
9276 procedure Warn_If_Not_Sources
9277 (Project : Project_Id;
9278 In_Tree : Project_Tree_Ref;
9279 Conventions : Array_Element_Id;
9281 Extending : Boolean)
9283 Conv : Array_Element_Id;
9285 The_Unit_Id : Unit_Index;
9286 The_Unit_Data : Unit_Data;
9287 Location : Source_Ptr;
9290 Conv := Conventions;
9291 while Conv /= No_Array_Element loop
9292 Unit := In_Tree.Array_Elements.Table (Conv).Index;
9293 Error_Msg_Name_1 := Unit;
9294 Get_Name_String (Unit);
9295 To_Lower (Name_Buffer (1 .. Name_Len));
9297 The_Unit_Id := Units_Htable.Get (In_Tree.Units_HT, Unit);
9298 Location := In_Tree.Array_Elements.Table (Conv).Value.Location;
9300 if The_Unit_Id = No_Unit_Index then
9301 Error_Msg (Project, In_Tree, "?unknown unit %%", Location);
9304 The_Unit_Data := In_Tree.Units.Table (The_Unit_Id);
9306 In_Tree.Array_Elements.Table (Conv).Value.Value;
9309 if not Check_Project
9310 (The_Unit_Data.File_Names (Specification).Project,
9311 Project, In_Tree, Extending)
9315 "?source of spec of unit %% (%%)" &
9316 " cannot be found in this project",
9321 if not Check_Project
9322 (The_Unit_Data.File_Names (Body_Part).Project,
9323 Project, In_Tree, Extending)
9327 "?source of body of unit %% (%%)" &
9328 " cannot be found in this project",
9334 Conv := In_Tree.Array_Elements.Table (Conv).Next;
9336 end Warn_If_Not_Sources;