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 Externally_Built : Boolean := False);
485 -- Locate a directory. Name is the directory name. Parent is the root
486 -- directory, if Name a relative path name. Dir is set to the canonical
487 -- case path name of the directory, and Display is the directory path name
488 -- for display purposes. If the directory does not exist and Setup_Projects
489 -- is True and Create is a non null string, an attempt is made to create
490 -- the directory. If the directory does not exist and Setup_Projects is
491 -- false, then Dir and Display are set to No_Name.
493 -- Current_Dir should represent the current directory, and is passed for
494 -- efficiency to avoid system calls to recompute it.
496 procedure Look_For_Sources
497 (Project : Project_Id;
498 In_Tree : Project_Tree_Ref;
499 Data : in out Project_Data;
500 Current_Dir : String);
501 -- Find all the sources of project Project in project tree In_Tree and
502 -- update its Data accordingly.
504 -- Current_Dir should represent the current directory, and is passed for
505 -- efficiency to avoid system calls to recompute it.
507 function Path_Name_Of
508 (File_Name : File_Name_Type;
509 Directory : Path_Name_Type) return String;
510 -- Returns the path name of a (non project) file. Returns an empty string
511 -- if file cannot be found.
513 procedure Prepare_Ada_Naming_Exceptions
514 (List : Array_Element_Id;
515 In_Tree : Project_Tree_Ref;
516 Kind : Spec_Or_Body);
517 -- Prepare the internal hash tables used for checking naming exceptions
518 -- for Ada. Insert all elements of List in the tables.
520 function Project_Extends
521 (Extending : Project_Id;
522 Extended : Project_Id;
523 In_Tree : Project_Tree_Ref) return Boolean;
524 -- Returns True if Extending is extending Extended either directly or
527 procedure Record_Ada_Source
528 (File_Name : File_Name_Type;
529 Path_Name : Path_Name_Type;
530 Project : Project_Id;
531 In_Tree : Project_Tree_Ref;
532 Data : in out Project_Data;
533 Location : Source_Ptr;
534 Current_Source : in out String_List_Id;
535 Source_Recorded : in out Boolean;
536 Current_Dir : String);
537 -- Put a unit in the list of units of a project, if the file name
538 -- corresponds to a valid unit name.
540 -- Current_Dir should represent the current directory, and is passed for
541 -- efficiency to avoid system calls to recompute it.
543 procedure Remove_Source
545 Replaced_By : Source_Id;
546 Project : Project_Id;
547 Data : in out Project_Data;
548 In_Tree : Project_Tree_Ref);
551 procedure Report_No_Sources
552 (Project : Project_Id;
554 In_Tree : Project_Tree_Ref;
555 Location : Source_Ptr;
556 Continuation : Boolean := False);
557 -- Report an error or a warning depending on the value of When_No_Sources
558 -- when there are no sources for language Lang_Name.
560 procedure Show_Source_Dirs
561 (Data : Project_Data; In_Tree : Project_Tree_Ref);
562 -- List all the source directories of a project
564 procedure Warn_If_Not_Sources
565 (Project : Project_Id;
566 In_Tree : Project_Tree_Ref;
567 Conventions : Array_Element_Id;
569 Extending : Boolean);
570 -- Check that individual naming conventions apply to immediate sources of
571 -- the project. If not, issue a warning.
579 Data : in out Project_Data;
580 In_Tree : Project_Tree_Ref;
581 Project : Project_Id;
583 Lang_Id : Language_Index;
585 File_Name : File_Name_Type;
586 Display_File : File_Name_Type;
587 Lang_Kind : Language_Kind;
588 Naming_Exception : Boolean := False;
589 Path : Path_Name_Type := No_Path;
590 Display_Path : Path_Name_Type := No_Path;
591 Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
592 Other_Part : Source_Id := No_Source;
593 Unit : Name_Id := No_Name;
595 Source_To_Replace : Source_Id := No_Source)
597 Source : constant Source_Id := Data.Last_Source;
598 Src_Data : Source_Data := No_Source_Data;
599 Config : constant Language_Config :=
600 In_Tree.Languages_Data.Table (Lang_Id).Config;
603 -- This is a new source so create an entry for it in the Sources table
605 Source_Data_Table.Increment_Last (In_Tree.Sources);
606 Id := Source_Data_Table.Last (In_Tree.Sources);
608 if Current_Verbosity = High then
609 Write_Str ("Adding source #");
611 Write_Str (", File : ");
612 Write_Str (Get_Name_String (File_Name));
614 if Lang_Kind = Unit_Based then
615 Write_Str (", Unit : ");
616 Write_Str (Get_Name_String (Unit));
622 Src_Data.Project := Project;
623 Src_Data.Language_Name := Lang;
624 Src_Data.Language := Lang_Id;
625 Src_Data.Lang_Kind := Lang_Kind;
626 Src_Data.Compiled := In_Tree.Languages_Data.Table
627 (Lang_Id).Config.Compiler_Driver /=
629 Src_Data.Kind := Kind;
630 Src_Data.Alternate_Languages := Alternate_Languages;
631 Src_Data.Other_Part := Other_Part;
633 Src_Data.Object_Exists := Config.Object_Generated;
634 Src_Data.Object_Linked := Config.Objects_Linked;
636 if Other_Part /= No_Source then
637 In_Tree.Sources.Table (Other_Part).Other_Part := Id;
640 Src_Data.Unit := Unit;
641 Src_Data.Index := Index;
642 Src_Data.File := File_Name;
643 Src_Data.Display_File := Display_File;
644 Src_Data.Dependency := In_Tree.Languages_Data.Table
645 (Lang_Id).Config.Dependency_Kind;
646 Src_Data.Naming_Exception := Naming_Exception;
648 if Src_Data.Compiled and then Src_Data.Object_Exists then
649 Src_Data.Object := Object_Name (File_Name);
651 Dependency_Name (File_Name, Src_Data.Dependency);
652 Src_Data.Switches := Switches_Name (File_Name);
655 if Path /= No_Path then
656 Src_Data.Path := (Path, Display_Path);
657 Source_Paths_Htable.Set (In_Tree.Source_Paths_HT, Path, Id);
660 -- Add the source id to the Unit_Sources_HT hash table, if the unit name
663 if Unit /= No_Name then
664 Unit_Sources_Htable.Set (In_Tree.Unit_Sources_HT, Unit, Id);
667 -- Add the source to the global list
669 Src_Data.Next_In_Sources := In_Tree.First_Source;
670 In_Tree.First_Source := Id;
672 -- Add the source to the project list
674 if Source = No_Source then
675 Data.First_Source := Id;
677 In_Tree.Sources.Table (Source).Next_In_Project := Id;
680 Data.Last_Source := Id;
682 -- Add the source to the language list
684 Src_Data.Next_In_Lang :=
685 In_Tree.Languages_Data.Table (Lang_Id).First_Source;
686 In_Tree.Languages_Data.Table (Lang_Id).First_Source := Id;
688 In_Tree.Sources.Table (Id) := Src_Data;
690 if Source_To_Replace /= No_Source then
691 Remove_Source (Source_To_Replace, Id, Project, Data, In_Tree);
699 function ALI_File_Name (Source : String) return String is
701 -- If the source name has an extension, then replace it with
704 for Index in reverse Source'First + 1 .. Source'Last loop
705 if Source (Index) = '.' then
706 return Source (Source'First .. Index - 1) & ALI_Suffix;
710 -- If there is no dot, or if it is the first character, just add the
713 return Source & ALI_Suffix;
721 (Project : Project_Id;
722 In_Tree : Project_Tree_Ref;
723 Report_Error : Put_Line_Access;
724 When_No_Sources : Error_Warning;
725 Current_Dir : String)
727 Data : Project_Data := In_Tree.Projects.Table (Project);
728 Extending : Boolean := False;
731 Nmsc.When_No_Sources := When_No_Sources;
732 Error_Report := Report_Error;
734 Recursive_Dirs.Reset;
736 Check_If_Externally_Built (Project, In_Tree, Data);
738 -- Object, exec and source directories
740 Get_Directories (Project, In_Tree, Current_Dir, Data);
742 -- Get the programming languages
744 Check_Programming_Languages (In_Tree, Project, Data);
746 if Data.Qualifier = Dry and then Data.Source_Dirs /= Nil_String then
749 "an abstract project needs to have no language, no sources " &
750 "or no source directories",
754 -- Check configuration in multi language mode
756 if Must_Check_Configuration then
757 Check_Configuration (Project, In_Tree, Data);
760 -- Library attributes
762 Check_Library_Attributes (Project, In_Tree, Current_Dir, Data);
764 if Current_Verbosity = High then
765 Show_Source_Dirs (Data, In_Tree);
768 Check_Package_Naming (Project, In_Tree, Data);
770 Extending := Data.Extends /= No_Project;
772 Check_Naming_Schemes (Data, Project, In_Tree);
774 if Get_Mode = Ada_Only then
775 Prepare_Ada_Naming_Exceptions
776 (Data.Naming.Bodies, In_Tree, Body_Part);
777 Prepare_Ada_Naming_Exceptions
778 (Data.Naming.Specs, In_Tree, Specification);
783 if Data.Source_Dirs /= Nil_String then
784 Look_For_Sources (Project, In_Tree, Data, Current_Dir);
786 if Get_Mode = Ada_Only then
788 -- Check that all individual naming conventions apply to sources
789 -- of this project file.
792 (Project, In_Tree, Data.Naming.Bodies,
794 Extending => Extending);
796 (Project, In_Tree, Data.Naming.Specs,
798 Extending => Extending);
800 elsif Get_Mode = Multi_Language and then
801 (not Data.Externally_Built) and then
805 Language : Language_Index;
807 Alt_Lang : Alternate_Language_Id;
808 Alt_Lang_Data : Alternate_Language_Data;
809 Continuation : Boolean := False;
812 Language := Data.First_Language_Processing;
813 while Language /= No_Language_Index loop
814 Source := Data.First_Source;
815 Source_Loop : while Source /= No_Source loop
817 Src_Data : Source_Data renames
818 In_Tree.Sources.Table (Source);
821 exit Source_Loop when Src_Data.Language = Language;
823 Alt_Lang := Src_Data.Alternate_Languages;
826 while Alt_Lang /= No_Alternate_Language loop
828 In_Tree.Alt_Langs.Table (Alt_Lang);
830 when Alt_Lang_Data.Language = Language;
831 Alt_Lang := Alt_Lang_Data.Next;
832 end loop Alternate_Loop;
834 Source := Src_Data.Next_In_Project;
836 end loop Source_Loop;
838 if Source = No_Source then
842 (In_Tree.Languages_Data.Table
843 (Language).Display_Name),
847 Continuation := True;
850 Language := In_Tree.Languages_Data.Table (Language).Next;
856 if Get_Mode = Multi_Language then
858 -- If a list of sources is specified in attribute Interfaces, set
859 -- In_Interfaces only for the sources specified in the list.
861 Check_Interfaces (Project, In_Tree, Data);
864 -- If it is a library project file, check if it is a standalone library
867 Check_Stand_Alone_Library
868 (Project, In_Tree, Data, Current_Dir, Extending);
871 -- Put the list of Mains, if any, in the project data
873 Get_Mains (Project, In_Tree, Data);
875 -- Update the project data in the Projects table
877 In_Tree.Projects.Table (Project) := Data;
879 Free_Ada_Naming_Exceptions;
886 procedure Check_Ada_Name (Name : String; Unit : out Name_Id) is
887 The_Name : String := Name;
889 Need_Letter : Boolean := True;
890 Last_Underscore : Boolean := False;
891 OK : Boolean := The_Name'Length > 0;
894 function Is_Reserved (Name : Name_Id) return Boolean;
895 function Is_Reserved (S : String) return Boolean;
896 -- Check that the given name is not an Ada 95 reserved word. The reason
897 -- for the Ada 95 here is that we do not want to exclude the case of an
898 -- Ada 95 unit called Interface (for example). In Ada 2005, such a unit
899 -- name would be rejected anyway by the compiler. That means there is no
900 -- requirement that the project file parser reject this.
906 function Is_Reserved (S : String) return Boolean is
909 Add_Str_To_Name_Buffer (S);
910 return Is_Reserved (Name_Find);
917 function Is_Reserved (Name : Name_Id) return Boolean is
919 if Get_Name_Table_Byte (Name) /= 0
920 and then Name /= Name_Project
921 and then Name /= Name_Extends
922 and then Name /= Name_External
923 and then Name not in Ada_2005_Reserved_Words
927 if Current_Verbosity = High then
928 Write_Str (The_Name);
929 Write_Line (" is an Ada reserved word.");
939 -- Start of processing for Check_Ada_Name
944 Name_Len := The_Name'Length;
945 Name_Buffer (1 .. Name_Len) := The_Name;
947 -- Special cases of children of packages A, G, I and S on VMS
950 and then Name_Len > 3
951 and then Name_Buffer (2 .. 3) = "__"
953 ((Name_Buffer (1) = 'a') or else
954 (Name_Buffer (1) = 'g') or else
955 (Name_Buffer (1) = 'i') or else
956 (Name_Buffer (1) = 's'))
958 Name_Buffer (2) := '.';
959 Name_Buffer (3 .. Name_Len - 1) := Name_Buffer (4 .. Name_Len);
960 Name_Len := Name_Len - 1;
963 Real_Name := Name_Find;
965 if Is_Reserved (Real_Name) then
969 First := The_Name'First;
971 for Index in The_Name'Range loop
974 -- We need a letter (at the beginning, and following a dot),
975 -- but we don't have one.
977 if Is_Letter (The_Name (Index)) then
978 Need_Letter := False;
983 if Current_Verbosity = High then
984 Write_Int (Types.Int (Index));
986 Write_Char (The_Name (Index));
987 Write_Line ("' is not a letter.");
993 elsif Last_Underscore
994 and then (The_Name (Index) = '_' or else The_Name (Index) = '.')
996 -- Two underscores are illegal, and a dot cannot follow
1001 if Current_Verbosity = High then
1002 Write_Int (Types.Int (Index));
1004 Write_Char (The_Name (Index));
1005 Write_Line ("' is illegal here.");
1010 elsif The_Name (Index) = '.' then
1012 -- First, check if the name before the dot is not a reserved word
1013 if Is_Reserved (The_Name (First .. Index - 1)) then
1019 -- We need a letter after a dot
1021 Need_Letter := True;
1023 elsif The_Name (Index) = '_' then
1024 Last_Underscore := True;
1027 -- We need an letter or a digit
1029 Last_Underscore := False;
1031 if not Is_Alphanumeric (The_Name (Index)) then
1034 if Current_Verbosity = High then
1035 Write_Int (Types.Int (Index));
1037 Write_Char (The_Name (Index));
1038 Write_Line ("' is not alphanumeric.");
1046 -- Cannot end with an underscore or a dot
1048 OK := OK and then not Need_Letter and then not Last_Underscore;
1051 if First /= Name'First and then
1052 Is_Reserved (The_Name (First .. The_Name'Last))
1060 -- Signal a problem with No_Name
1066 --------------------------------------
1067 -- Check_Ada_Naming_Scheme_Validity --
1068 --------------------------------------
1070 procedure Check_Ada_Naming_Scheme_Validity
1071 (Project : Project_Id;
1072 In_Tree : Project_Tree_Ref;
1073 Naming : Naming_Data)
1076 -- Only check if we are not using the Default naming scheme
1078 if Naming /= In_Tree.Private_Part.Default_Naming then
1080 Dot_Replacement : constant String :=
1082 (Naming.Dot_Replacement);
1084 Spec_Suffix : constant String :=
1085 Spec_Suffix_Of (In_Tree, "ada", Naming);
1087 Body_Suffix : constant String :=
1088 Body_Suffix_Of (In_Tree, "ada", Naming);
1090 Separate_Suffix : constant String :=
1092 (Naming.Separate_Suffix);
1095 -- Dot_Replacement cannot
1098 -- - start or end with an alphanumeric
1099 -- - be a single '_'
1100 -- - start with an '_' followed by an alphanumeric
1101 -- - contain a '.' except if it is "."
1103 if Dot_Replacement'Length = 0
1104 or else Is_Alphanumeric
1105 (Dot_Replacement (Dot_Replacement'First))
1106 or else Is_Alphanumeric
1107 (Dot_Replacement (Dot_Replacement'Last))
1108 or else (Dot_Replacement (Dot_Replacement'First) = '_'
1110 (Dot_Replacement'Length = 1
1113 (Dot_Replacement (Dot_Replacement'First + 1))))
1114 or else (Dot_Replacement'Length > 1
1116 Index (Source => Dot_Replacement,
1117 Pattern => ".") /= 0)
1121 '"' & Dot_Replacement &
1122 """ is illegal for Dot_Replacement.",
1123 Naming.Dot_Repl_Loc);
1129 if Is_Illegal_Suffix
1130 (Spec_Suffix, Dot_Replacement = ".")
1132 Err_Vars.Error_Msg_File_1 :=
1133 Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
1136 "{ is illegal for Spec_Suffix",
1137 Naming.Ada_Spec_Suffix_Loc);
1140 if Is_Illegal_Suffix
1141 (Body_Suffix, Dot_Replacement = ".")
1143 Err_Vars.Error_Msg_File_1 :=
1144 Body_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
1147 "{ is illegal for Body_Suffix",
1148 Naming.Ada_Body_Suffix_Loc);
1151 if Body_Suffix /= Separate_Suffix then
1152 if Is_Illegal_Suffix
1153 (Separate_Suffix, Dot_Replacement = ".")
1155 Err_Vars.Error_Msg_File_1 := Naming.Separate_Suffix;
1158 "{ is illegal for Separate_Suffix",
1159 Naming.Sep_Suffix_Loc);
1163 -- Spec_Suffix cannot be equal to Body_Suffix Separate_Suffix,
1164 -- since that would cause a clear ambiguity. Note that we do
1165 -- allow a Spec_Suffix to have the same termination as one of
1166 -- these, which causes a potential ambiguity, but we resolve
1167 -- that my matching the longest possible suffix.
1169 if Spec_Suffix = Body_Suffix then
1174 """) cannot be the same as Spec_Suffix.",
1175 Naming.Ada_Body_Suffix_Loc);
1178 if Body_Suffix /= Separate_Suffix
1179 and then Spec_Suffix = Separate_Suffix
1183 "Separate_Suffix (""" &
1185 """) cannot be the same as Spec_Suffix.",
1186 Naming.Sep_Suffix_Loc);
1190 end Check_Ada_Naming_Scheme_Validity;
1192 -------------------------
1193 -- Check_Configuration --
1194 -------------------------
1196 procedure Check_Configuration
1197 (Project : Project_Id;
1198 In_Tree : Project_Tree_Ref;
1199 Data : in out Project_Data)
1201 Dot_Replacement : File_Name_Type := No_File;
1202 Casing : Casing_Type := All_Lower_Case;
1203 Separate_Suffix : File_Name_Type := No_File;
1205 Lang_Index : Language_Index := No_Language_Index;
1206 -- The index of the language data being checked
1208 Prev_Index : Language_Index := No_Language_Index;
1209 -- The index of the previous language
1211 Current_Language : Name_Id := No_Name;
1212 -- The name of the language
1214 Lang_Data : Language_Data;
1215 -- The data of the language being checked
1217 procedure Get_Language_Index_Of (Language : Name_Id);
1218 -- Get the language index of Language, if Language is one of the
1219 -- languages of the project.
1221 procedure Process_Project_Level_Simple_Attributes;
1222 -- Process the simple attributes at the project level
1224 procedure Process_Project_Level_Array_Attributes;
1225 -- Process the associate array attributes at the project level
1227 procedure Process_Packages;
1228 -- Read the packages of the project
1230 ---------------------------
1231 -- Get_Language_Index_Of --
1232 ---------------------------
1234 procedure Get_Language_Index_Of (Language : Name_Id) is
1235 Real_Language : Name_Id;
1238 Get_Name_String (Language);
1239 To_Lower (Name_Buffer (1 .. Name_Len));
1240 Real_Language := Name_Find;
1242 -- Nothing to do if the language is the same as the current language
1244 if Current_Language /= Real_Language then
1245 Lang_Index := Data.First_Language_Processing;
1246 while Lang_Index /= No_Language_Index loop
1247 exit when In_Tree.Languages_Data.Table (Lang_Index).Name =
1250 In_Tree.Languages_Data.Table (Lang_Index).Next;
1253 if Lang_Index = No_Language_Index then
1254 Current_Language := No_Name;
1256 Current_Language := Real_Language;
1259 end Get_Language_Index_Of;
1261 ----------------------
1262 -- Process_Packages --
1263 ----------------------
1265 procedure Process_Packages is
1266 Packages : Package_Id;
1267 Element : Package_Element;
1269 procedure Process_Binder (Arrays : Array_Id);
1270 -- Process the associate array attributes of package Binder
1272 procedure Process_Builder (Attributes : Variable_Id);
1273 -- Process the simple attributes of package Builder
1275 procedure Process_Compiler (Arrays : Array_Id);
1276 -- Process the associate array attributes of package Compiler
1278 procedure Process_Naming (Attributes : Variable_Id);
1279 -- Process the simple attributes of package Naming
1281 procedure Process_Naming (Arrays : Array_Id);
1282 -- Process the associate array attributes of package Naming
1284 procedure Process_Linker (Attributes : Variable_Id);
1285 -- Process the simple attributes of package Linker of a
1286 -- configuration project.
1288 --------------------
1289 -- Process_Binder --
1290 --------------------
1292 procedure Process_Binder (Arrays : Array_Id) is
1293 Current_Array_Id : Array_Id;
1294 Current_Array : Array_Data;
1295 Element_Id : Array_Element_Id;
1296 Element : Array_Element;
1299 -- Process the associative array attribute of package Binder
1301 Current_Array_Id := Arrays;
1302 while Current_Array_Id /= No_Array loop
1303 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1305 Element_Id := Current_Array.Value;
1306 while Element_Id /= No_Array_Element loop
1307 Element := In_Tree.Array_Elements.Table (Element_Id);
1309 if Element.Index /= All_Other_Names then
1311 -- Get the name of the language
1313 Get_Language_Index_Of (Element.Index);
1315 if Lang_Index /= No_Language_Index then
1316 case Current_Array.Name is
1319 -- Attribute Driver (<language>)
1321 In_Tree.Languages_Data.Table
1322 (Lang_Index).Config.Binder_Driver :=
1323 File_Name_Type (Element.Value.Value);
1325 when Name_Required_Switches =>
1327 In_Tree.Languages_Data.Table
1328 (Lang_Index).Config.Binder_Required_Switches,
1329 From_List => Element.Value.Values,
1330 In_Tree => In_Tree);
1334 -- Attribute Prefix (<language>)
1336 In_Tree.Languages_Data.Table
1337 (Lang_Index).Config.Binder_Prefix :=
1338 Element.Value.Value;
1340 when Name_Objects_Path =>
1342 -- Attribute Objects_Path (<language>)
1344 In_Tree.Languages_Data.Table
1345 (Lang_Index).Config.Objects_Path :=
1346 Element.Value.Value;
1348 when Name_Objects_Path_File =>
1350 -- Attribute Objects_Path (<language>)
1352 In_Tree.Languages_Data.Table
1353 (Lang_Index).Config.Objects_Path_File :=
1354 Element.Value.Value;
1362 Element_Id := Element.Next;
1365 Current_Array_Id := Current_Array.Next;
1369 ---------------------
1370 -- Process_Builder --
1371 ---------------------
1373 procedure Process_Builder (Attributes : Variable_Id) is
1374 Attribute_Id : Variable_Id;
1375 Attribute : Variable;
1378 -- Process non associated array attribute from package Builder
1380 Attribute_Id := Attributes;
1381 while Attribute_Id /= No_Variable loop
1383 In_Tree.Variable_Elements.Table (Attribute_Id);
1385 if not Attribute.Value.Default then
1386 if Attribute.Name = Name_Executable_Suffix then
1388 -- Attribute Executable_Suffix: the suffix of the
1391 Data.Config.Executable_Suffix :=
1392 Attribute.Value.Value;
1396 Attribute_Id := Attribute.Next;
1398 end Process_Builder;
1400 ----------------------
1401 -- Process_Compiler --
1402 ----------------------
1404 procedure Process_Compiler (Arrays : Array_Id) is
1405 Current_Array_Id : Array_Id;
1406 Current_Array : Array_Data;
1407 Element_Id : Array_Element_Id;
1408 Element : Array_Element;
1409 List : String_List_Id;
1412 -- Process the associative array attribute of package Compiler
1414 Current_Array_Id := Arrays;
1415 while Current_Array_Id /= No_Array loop
1416 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1418 Element_Id := Current_Array.Value;
1419 while Element_Id /= No_Array_Element loop
1420 Element := In_Tree.Array_Elements.Table (Element_Id);
1422 if Element.Index /= All_Other_Names then
1424 -- Get the name of the language
1426 Get_Language_Index_Of (Element.Index);
1428 if Lang_Index /= No_Language_Index then
1429 case Current_Array.Name is
1430 when Name_Dependency_Switches =>
1432 -- Attribute Dependency_Switches (<language>)
1434 if In_Tree.Languages_Data.Table
1435 (Lang_Index).Config.Dependency_Kind = None
1437 In_Tree.Languages_Data.Table
1438 (Lang_Index).Config.Dependency_Kind :=
1442 List := Element.Value.Values;
1444 if List /= Nil_String then
1446 In_Tree.Languages_Data.Table
1447 (Lang_Index).Config.Dependency_Option,
1449 In_Tree => In_Tree);
1452 when Name_Dependency_Driver =>
1454 -- Attribute Dependency_Driver (<language>)
1456 if In_Tree.Languages_Data.Table
1457 (Lang_Index).Config.Dependency_Kind = None
1459 In_Tree.Languages_Data.Table
1460 (Lang_Index).Config.Dependency_Kind :=
1464 List := Element.Value.Values;
1466 if List /= Nil_String then
1468 In_Tree.Languages_Data.Table
1469 (Lang_Index).Config.Compute_Dependency,
1471 In_Tree => In_Tree);
1474 when Name_Include_Switches =>
1476 -- Attribute Include_Switches (<language>)
1478 List := Element.Value.Values;
1480 if List = Nil_String then
1484 "include option cannot be null",
1485 Element.Value.Location);
1489 In_Tree.Languages_Data.Table
1490 (Lang_Index).Config.Include_Option,
1492 In_Tree => In_Tree);
1494 when Name_Include_Path =>
1496 -- Attribute Include_Path (<language>)
1498 In_Tree.Languages_Data.Table
1499 (Lang_Index).Config.Include_Path :=
1500 Element.Value.Value;
1502 when Name_Include_Path_File =>
1504 -- Attribute Include_Path_File (<language>)
1506 In_Tree.Languages_Data.Table
1507 (Lang_Index).Config.Include_Path_File :=
1508 Element.Value.Value;
1512 -- Attribute Driver (<language>)
1514 Get_Name_String (Element.Value.Value);
1516 In_Tree.Languages_Data.Table
1517 (Lang_Index).Config.Compiler_Driver :=
1518 File_Name_Type (Element.Value.Value);
1520 when Name_Required_Switches =>
1522 In_Tree.Languages_Data.Table
1523 (Lang_Index).Config.
1524 Compiler_Required_Switches,
1525 From_List => Element.Value.Values,
1526 In_Tree => In_Tree);
1528 when Name_Path_Syntax =>
1530 In_Tree.Languages_Data.Table
1531 (Lang_Index).Config.Path_Syntax :=
1532 Path_Syntax_Kind'Value
1533 (Get_Name_String (Element.Value.Value));
1536 when Constraint_Error =>
1540 "invalid value for Path_Syntax",
1541 Element.Value.Location);
1544 when Name_Pic_Option =>
1546 -- Attribute Compiler_Pic_Option (<language>)
1548 List := Element.Value.Values;
1550 if List = Nil_String then
1554 "compiler PIC option cannot be null",
1555 Element.Value.Location);
1559 In_Tree.Languages_Data.Table
1560 (Lang_Index).Config.Compilation_PIC_Option,
1562 In_Tree => In_Tree);
1564 when Name_Mapping_File_Switches =>
1566 -- Attribute Mapping_File_Switches (<language>)
1568 List := Element.Value.Values;
1570 if List = Nil_String then
1574 "mapping file switches cannot be null",
1575 Element.Value.Location);
1579 In_Tree.Languages_Data.Table
1580 (Lang_Index).Config.Mapping_File_Switches,
1582 In_Tree => In_Tree);
1584 when Name_Mapping_Spec_Suffix =>
1586 -- Attribute Mapping_Spec_Suffix (<language>)
1588 In_Tree.Languages_Data.Table
1589 (Lang_Index).Config.Mapping_Spec_Suffix :=
1590 File_Name_Type (Element.Value.Value);
1592 when Name_Mapping_Body_Suffix =>
1594 -- Attribute Mapping_Body_Suffix (<language>)
1596 In_Tree.Languages_Data.Table
1597 (Lang_Index).Config.Mapping_Body_Suffix :=
1598 File_Name_Type (Element.Value.Value);
1600 when Name_Config_File_Switches =>
1602 -- Attribute Config_File_Switches (<language>)
1604 List := Element.Value.Values;
1606 if List = Nil_String then
1610 "config file switches cannot be null",
1611 Element.Value.Location);
1615 In_Tree.Languages_Data.Table
1616 (Lang_Index).Config.Config_File_Switches,
1618 In_Tree => In_Tree);
1620 when Name_Objects_Path =>
1622 -- Attribute Objects_Path (<language>)
1624 In_Tree.Languages_Data.Table
1625 (Lang_Index).Config.Objects_Path :=
1626 Element.Value.Value;
1628 when Name_Objects_Path_File =>
1630 -- Attribute Objects_Path_File (<language>)
1632 In_Tree.Languages_Data.Table
1633 (Lang_Index).Config.Objects_Path_File :=
1634 Element.Value.Value;
1636 when Name_Config_Body_File_Name =>
1638 -- Attribute Config_Body_File_Name (<language>)
1640 In_Tree.Languages_Data.Table
1641 (Lang_Index).Config.Config_Body :=
1642 Element.Value.Value;
1644 when Name_Config_Body_File_Name_Pattern =>
1646 -- Attribute Config_Body_File_Name_Pattern
1649 In_Tree.Languages_Data.Table
1650 (Lang_Index).Config.Config_Body_Pattern :=
1651 Element.Value.Value;
1653 when Name_Config_Spec_File_Name =>
1655 -- Attribute Config_Spec_File_Name (<language>)
1657 In_Tree.Languages_Data.Table
1658 (Lang_Index).Config.Config_Spec :=
1659 Element.Value.Value;
1661 when Name_Config_Spec_File_Name_Pattern =>
1663 -- Attribute Config_Spec_File_Name_Pattern
1666 In_Tree.Languages_Data.Table
1667 (Lang_Index).Config.Config_Spec_Pattern :=
1668 Element.Value.Value;
1670 when Name_Config_File_Unique =>
1672 -- Attribute Config_File_Unique (<language>)
1675 In_Tree.Languages_Data.Table
1676 (Lang_Index).Config.Config_File_Unique :=
1678 (Get_Name_String (Element.Value.Value));
1680 when Constraint_Error =>
1684 "illegal value for Config_File_Unique",
1685 Element.Value.Location);
1694 Element_Id := Element.Next;
1697 Current_Array_Id := Current_Array.Next;
1699 end Process_Compiler;
1701 --------------------
1702 -- Process_Naming --
1703 --------------------
1705 procedure Process_Naming (Attributes : Variable_Id) is
1706 Attribute_Id : Variable_Id;
1707 Attribute : Variable;
1710 -- Process non associated array attribute from package Naming
1712 Attribute_Id := Attributes;
1713 while Attribute_Id /= No_Variable loop
1714 Attribute := In_Tree.Variable_Elements.Table (Attribute_Id);
1716 if not Attribute.Value.Default then
1717 if Attribute.Name = Name_Separate_Suffix then
1719 -- Attribute Separate_Suffix
1721 Separate_Suffix := File_Name_Type (Attribute.Value.Value);
1723 elsif Attribute.Name = Name_Casing then
1729 Value (Get_Name_String (Attribute.Value.Value));
1732 when Constraint_Error =>
1736 "invalid value for Casing",
1737 Attribute.Value.Location);
1740 elsif Attribute.Name = Name_Dot_Replacement then
1742 -- Attribute Dot_Replacement
1744 Dot_Replacement := File_Name_Type (Attribute.Value.Value);
1749 Attribute_Id := Attribute.Next;
1753 procedure Process_Naming (Arrays : Array_Id) is
1754 Current_Array_Id : Array_Id;
1755 Current_Array : Array_Data;
1756 Element_Id : Array_Element_Id;
1757 Element : Array_Element;
1759 -- Process the associative array attribute of package Naming
1761 Current_Array_Id := Arrays;
1762 while Current_Array_Id /= No_Array loop
1763 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
1765 Element_Id := Current_Array.Value;
1766 while Element_Id /= No_Array_Element loop
1767 Element := In_Tree.Array_Elements.Table (Element_Id);
1769 -- Get the name of the language
1771 Get_Language_Index_Of (Element.Index);
1773 if Lang_Index /= No_Language_Index then
1774 case Current_Array.Name is
1775 when Name_Specification_Suffix | Name_Spec_Suffix =>
1777 -- Attribute Spec_Suffix (<language>)
1779 In_Tree.Languages_Data.Table
1780 (Lang_Index).Config.Naming_Data.Spec_Suffix :=
1781 File_Name_Type (Element.Value.Value);
1783 when Name_Implementation_Suffix | Name_Body_Suffix =>
1785 -- Attribute Body_Suffix (<language>)
1787 In_Tree.Languages_Data.Table
1788 (Lang_Index).Config.Naming_Data.Body_Suffix :=
1789 File_Name_Type (Element.Value.Value);
1791 In_Tree.Languages_Data.Table
1792 (Lang_Index).Config.Naming_Data.Separate_Suffix :=
1793 File_Name_Type (Element.Value.Value);
1800 Element_Id := Element.Next;
1803 Current_Array_Id := Current_Array.Next;
1807 --------------------
1808 -- Process_Linker --
1809 --------------------
1811 procedure Process_Linker (Attributes : Variable_Id) is
1812 Attribute_Id : Variable_Id;
1813 Attribute : Variable;
1816 -- Process non associated array attribute from package Linker
1818 Attribute_Id := Attributes;
1819 while Attribute_Id /= No_Variable loop
1821 In_Tree.Variable_Elements.Table (Attribute_Id);
1823 if not Attribute.Value.Default then
1824 if Attribute.Name = Name_Driver then
1826 -- Attribute Linker'Driver: the default linker to use
1828 Data.Config.Linker :=
1829 Path_Name_Type (Attribute.Value.Value);
1831 elsif Attribute.Name = Name_Required_Switches then
1833 -- Attribute Required_Switches: the minimum
1834 -- options to use when invoking the linker
1837 Data.Config.Minimum_Linker_Options,
1838 From_List => Attribute.Value.Values,
1839 In_Tree => In_Tree);
1841 elsif Attribute.Name = Name_Map_File_Option then
1842 Data.Config.Map_File_Option := Attribute.Value.Value;
1844 elsif Attribute.Name = Name_Max_Command_Line_Length then
1846 Data.Config.Max_Command_Line_Length :=
1847 Natural'Value (Get_Name_String
1848 (Attribute.Value.Value));
1851 when Constraint_Error =>
1855 "value must be positive or equal to 0",
1856 Attribute.Value.Location);
1859 elsif Attribute.Name = Name_Response_File_Format then
1864 Get_Name_String (Attribute.Value.Value);
1865 To_Lower (Name_Buffer (1 .. Name_Len));
1868 if Name = Name_None then
1869 Data.Config.Resp_File_Format := None;
1871 elsif Name = Name_Gnu then
1872 Data.Config.Resp_File_Format := GNU;
1874 elsif Name = Name_Object_List then
1875 Data.Config.Resp_File_Format := Object_List;
1877 elsif Name = Name_Option_List then
1878 Data.Config.Resp_File_Format := Option_List;
1884 "illegal response file format",
1885 Attribute.Value.Location);
1889 elsif Attribute.Name = Name_Response_File_Switches then
1891 Data.Config.Resp_File_Options,
1892 From_List => Attribute.Value.Values,
1893 In_Tree => In_Tree);
1897 Attribute_Id := Attribute.Next;
1901 -- Start of processing for Process_Packages
1904 Packages := Data.Decl.Packages;
1905 while Packages /= No_Package loop
1906 Element := In_Tree.Packages.Table (Packages);
1908 case Element.Name is
1911 -- Process attributes of package Binder
1913 Process_Binder (Element.Decl.Arrays);
1915 when Name_Builder =>
1917 -- Process attributes of package Builder
1919 Process_Builder (Element.Decl.Attributes);
1921 when Name_Compiler =>
1923 -- Process attributes of package Compiler
1925 Process_Compiler (Element.Decl.Arrays);
1929 -- Process attributes of package Linker
1931 Process_Linker (Element.Decl.Attributes);
1935 -- Process attributes of package Naming
1937 Process_Naming (Element.Decl.Attributes);
1938 Process_Naming (Element.Decl.Arrays);
1944 Packages := Element.Next;
1946 end Process_Packages;
1948 ---------------------------------------------
1949 -- Process_Project_Level_Simple_Attributes --
1950 ---------------------------------------------
1952 procedure Process_Project_Level_Simple_Attributes is
1953 Attribute_Id : Variable_Id;
1954 Attribute : Variable;
1955 List : String_List_Id;
1958 -- Process non associated array attribute at project level
1960 Attribute_Id := Data.Decl.Attributes;
1961 while Attribute_Id /= No_Variable loop
1963 In_Tree.Variable_Elements.Table (Attribute_Id);
1965 if not Attribute.Value.Default then
1966 if Attribute.Name = Name_Library_Builder then
1968 -- Attribute Library_Builder: the application to invoke
1969 -- to build libraries.
1971 Data.Config.Library_Builder :=
1972 Path_Name_Type (Attribute.Value.Value);
1974 elsif Attribute.Name = Name_Archive_Builder then
1976 -- Attribute Archive_Builder: the archive builder
1977 -- (usually "ar") and its minimum options (usually "cr").
1979 List := Attribute.Value.Values;
1981 if List = Nil_String then
1985 "archive builder cannot be null",
1986 Attribute.Value.Location);
1989 Put (Into_List => Data.Config.Archive_Builder,
1991 In_Tree => In_Tree);
1993 elsif Attribute.Name = Name_Archive_Builder_Append_Option then
1995 -- Attribute Archive_Builder: the archive builder
1996 -- (usually "ar") and its minimum options (usually "cr").
1998 List := Attribute.Value.Values;
2000 if List /= Nil_String then
2002 (Into_List => Data.Config.Archive_Builder_Append_Option,
2004 In_Tree => In_Tree);
2007 elsif Attribute.Name = Name_Archive_Indexer then
2009 -- Attribute Archive_Indexer: the optional archive
2010 -- indexer (usually "ranlib") with its minimum options
2013 List := Attribute.Value.Values;
2015 if List = Nil_String then
2019 "archive indexer cannot be null",
2020 Attribute.Value.Location);
2023 Put (Into_List => Data.Config.Archive_Indexer,
2025 In_Tree => In_Tree);
2027 elsif Attribute.Name = Name_Library_Partial_Linker then
2029 -- Attribute Library_Partial_Linker: the optional linker
2030 -- driver with its minimum options, to partially link
2033 List := Attribute.Value.Values;
2035 if List = Nil_String then
2039 "partial linker cannot be null",
2040 Attribute.Value.Location);
2043 Put (Into_List => Data.Config.Lib_Partial_Linker,
2045 In_Tree => In_Tree);
2047 elsif Attribute.Name = Name_Library_GCC then
2048 Data.Config.Shared_Lib_Driver :=
2049 File_Name_Type (Attribute.Value.Value);
2051 elsif Attribute.Name = Name_Archive_Suffix then
2052 Data.Config.Archive_Suffix :=
2053 File_Name_Type (Attribute.Value.Value);
2055 elsif Attribute.Name = Name_Linker_Executable_Option then
2057 -- Attribute Linker_Executable_Option: optional options
2058 -- to specify an executable name. Defaults to "-o".
2060 List := Attribute.Value.Values;
2062 if List = Nil_String then
2066 "linker executable option cannot be null",
2067 Attribute.Value.Location);
2070 Put (Into_List => Data.Config.Linker_Executable_Option,
2072 In_Tree => In_Tree);
2074 elsif Attribute.Name = Name_Linker_Lib_Dir_Option then
2076 -- Attribute Linker_Lib_Dir_Option: optional options
2077 -- to specify a library search directory. Defaults to
2080 Get_Name_String (Attribute.Value.Value);
2082 if Name_Len = 0 then
2086 "linker library directory option cannot be empty",
2087 Attribute.Value.Location);
2090 Data.Config.Linker_Lib_Dir_Option := Attribute.Value.Value;
2092 elsif Attribute.Name = Name_Linker_Lib_Name_Option then
2094 -- Attribute Linker_Lib_Name_Option: optional options
2095 -- to specify the name of a library to be linked in.
2096 -- Defaults to "-l".
2098 Get_Name_String (Attribute.Value.Value);
2100 if Name_Len = 0 then
2104 "linker library name option cannot be empty",
2105 Attribute.Value.Location);
2108 Data.Config.Linker_Lib_Name_Option := Attribute.Value.Value;
2110 elsif Attribute.Name = Name_Run_Path_Option then
2112 -- Attribute Run_Path_Option: optional options to
2113 -- specify a path for libraries.
2115 List := Attribute.Value.Values;
2117 if List /= Nil_String then
2118 Put (Into_List => Data.Config.Run_Path_Option,
2120 In_Tree => In_Tree);
2123 elsif Attribute.Name = Name_Library_Support then
2125 pragma Unsuppress (All_Checks);
2127 Data.Config.Lib_Support :=
2128 Library_Support'Value (Get_Name_String
2129 (Attribute.Value.Value));
2131 when Constraint_Error =>
2135 "invalid value """ &
2136 Get_Name_String (Attribute.Value.Value) &
2137 """ for Library_Support",
2138 Attribute.Value.Location);
2141 elsif Attribute.Name = Name_Shared_Library_Prefix then
2142 Data.Config.Shared_Lib_Prefix :=
2143 File_Name_Type (Attribute.Value.Value);
2145 elsif Attribute.Name = Name_Shared_Library_Suffix then
2146 Data.Config.Shared_Lib_Suffix :=
2147 File_Name_Type (Attribute.Value.Value);
2149 elsif Attribute.Name = Name_Symbolic_Link_Supported then
2151 pragma Unsuppress (All_Checks);
2153 Data.Config.Symbolic_Link_Supported :=
2154 Boolean'Value (Get_Name_String
2155 (Attribute.Value.Value));
2157 when Constraint_Error =>
2162 & Get_Name_String (Attribute.Value.Value)
2163 & """ for Symbolic_Link_Supported",
2164 Attribute.Value.Location);
2168 Attribute.Name = Name_Library_Major_Minor_Id_Supported
2171 pragma Unsuppress (All_Checks);
2173 Data.Config.Lib_Maj_Min_Id_Supported :=
2174 Boolean'Value (Get_Name_String
2175 (Attribute.Value.Value));
2177 when Constraint_Error =>
2181 "invalid value """ &
2182 Get_Name_String (Attribute.Value.Value) &
2183 """ for Library_Major_Minor_Id_Supported",
2184 Attribute.Value.Location);
2187 elsif Attribute.Name = Name_Library_Auto_Init_Supported then
2189 pragma Unsuppress (All_Checks);
2191 Data.Config.Auto_Init_Supported :=
2192 Boolean'Value (Get_Name_String (Attribute.Value.Value));
2194 when Constraint_Error =>
2199 & Get_Name_String (Attribute.Value.Value)
2200 & """ for Library_Auto_Init_Supported",
2201 Attribute.Value.Location);
2204 elsif Attribute.Name = Name_Shared_Library_Minimum_Switches then
2205 List := Attribute.Value.Values;
2207 if List /= Nil_String then
2208 Put (Into_List => Data.Config.Shared_Lib_Min_Options,
2210 In_Tree => In_Tree);
2213 elsif Attribute.Name = Name_Library_Version_Switches then
2214 List := Attribute.Value.Values;
2216 if List /= Nil_String then
2217 Put (Into_List => Data.Config.Lib_Version_Options,
2219 In_Tree => In_Tree);
2224 Attribute_Id := Attribute.Next;
2226 end Process_Project_Level_Simple_Attributes;
2228 --------------------------------------------
2229 -- Process_Project_Level_Array_Attributes --
2230 --------------------------------------------
2232 procedure Process_Project_Level_Array_Attributes is
2233 Current_Array_Id : Array_Id;
2234 Current_Array : Array_Data;
2235 Element_Id : Array_Element_Id;
2236 Element : Array_Element;
2237 List : String_List_Id;
2240 -- Process the associative array attributes at project level
2242 Current_Array_Id := Data.Decl.Arrays;
2243 while Current_Array_Id /= No_Array loop
2244 Current_Array := In_Tree.Arrays.Table (Current_Array_Id);
2246 Element_Id := Current_Array.Value;
2247 while Element_Id /= No_Array_Element loop
2248 Element := In_Tree.Array_Elements.Table (Element_Id);
2250 -- Get the name of the language
2252 Get_Language_Index_Of (Element.Index);
2254 if Lang_Index /= No_Language_Index then
2255 case Current_Array.Name is
2256 when Name_Inherit_Source_Path =>
2257 List := Element.Value.Values;
2259 if List /= Nil_String then
2262 In_Tree.Languages_Data.Table (Lang_Index).
2263 Config.Include_Compatible_Languages,
2266 Lower_Case => True);
2269 when Name_Toolchain_Description =>
2271 -- Attribute Toolchain_Description (<language>)
2273 In_Tree.Languages_Data.Table
2274 (Lang_Index).Config.Toolchain_Description :=
2275 Element.Value.Value;
2277 when Name_Toolchain_Version =>
2279 -- Attribute Toolchain_Version (<language>)
2281 In_Tree.Languages_Data.Table
2282 (Lang_Index).Config.Toolchain_Version :=
2283 Element.Value.Value;
2285 when Name_Runtime_Library_Dir =>
2287 -- Attribute Runtime_Library_Dir (<language>)
2289 In_Tree.Languages_Data.Table
2290 (Lang_Index).Config.Runtime_Library_Dir :=
2291 Element.Value.Value;
2293 when Name_Runtime_Source_Dir =>
2295 -- Attribute Runtime_Library_Dir (<language>)
2297 In_Tree.Languages_Data.Table
2298 (Lang_Index).Config.Runtime_Source_Dir :=
2299 Element.Value.Value;
2301 when Name_Object_Generated =>
2303 pragma Unsuppress (All_Checks);
2309 (Get_Name_String (Element.Value.Value));
2311 In_Tree.Languages_Data.Table
2312 (Lang_Index).Config.Object_Generated := Value;
2314 -- If no object is generated, no object may be
2318 In_Tree.Languages_Data.Table
2319 (Lang_Index).Config.Objects_Linked := False;
2323 when Constraint_Error =>
2328 & Get_Name_String (Element.Value.Value)
2329 & """ for Object_Generated",
2330 Element.Value.Location);
2333 when Name_Objects_Linked =>
2335 pragma Unsuppress (All_Checks);
2341 (Get_Name_String (Element.Value.Value));
2343 -- No change if Object_Generated is False, as this
2344 -- forces Objects_Linked to be False too.
2346 if In_Tree.Languages_Data.Table
2347 (Lang_Index).Config.Object_Generated
2349 In_Tree.Languages_Data.Table
2350 (Lang_Index).Config.Objects_Linked :=
2355 when Constraint_Error =>
2360 & Get_Name_String (Element.Value.Value)
2361 & """ for Objects_Linked",
2362 Element.Value.Location);
2369 Element_Id := Element.Next;
2372 Current_Array_Id := Current_Array.Next;
2374 end Process_Project_Level_Array_Attributes;
2377 Process_Project_Level_Simple_Attributes;
2378 Process_Project_Level_Array_Attributes;
2381 -- For unit based languages, set Casing, Dot_Replacement and
2382 -- Separate_Suffix in Naming_Data.
2384 Lang_Index := Data.First_Language_Processing;
2385 while Lang_Index /= No_Language_Index loop
2386 if In_Tree.Languages_Data.Table
2387 (Lang_Index).Name = Name_Ada
2389 In_Tree.Languages_Data.Table
2390 (Lang_Index).Config.Naming_Data.Casing := Casing;
2391 In_Tree.Languages_Data.Table
2392 (Lang_Index).Config.Naming_Data.Dot_Replacement :=
2395 if Separate_Suffix /= No_File then
2396 In_Tree.Languages_Data.Table
2397 (Lang_Index).Config.Naming_Data.Separate_Suffix :=
2404 Lang_Index := In_Tree.Languages_Data.Table (Lang_Index).Next;
2407 -- Give empty names to various prefixes/suffixes, if they have not
2408 -- been specified in the configuration.
2410 if Data.Config.Archive_Suffix = No_File then
2411 Data.Config.Archive_Suffix := Empty_File;
2414 if Data.Config.Shared_Lib_Prefix = No_File then
2415 Data.Config.Shared_Lib_Prefix := Empty_File;
2418 if Data.Config.Shared_Lib_Suffix = No_File then
2419 Data.Config.Shared_Lib_Suffix := Empty_File;
2422 Lang_Index := Data.First_Language_Processing;
2423 while Lang_Index /= No_Language_Index loop
2424 Lang_Data := In_Tree.Languages_Data.Table (Lang_Index);
2426 Current_Language := Lang_Data.Display_Name;
2428 -- For all languages, Compiler_Driver needs to be specified
2430 if Lang_Data.Config.Compiler_Driver = No_File then
2431 Error_Msg_Name_1 := Current_Language;
2435 "?no compiler specified for language %%" &
2436 ", ignoring all its sources",
2439 if Lang_Index = Data.First_Language_Processing then
2440 Data.First_Language_Processing :=
2443 In_Tree.Languages_Data.Table (Prev_Index).Next :=
2447 elsif Lang_Data.Name = Name_Ada then
2448 Prev_Index := Lang_Index;
2450 -- For unit based languages, Dot_Replacement, Spec_Suffix and
2451 -- Body_Suffix need to be specified.
2453 if Lang_Data.Config.Naming_Data.Dot_Replacement = No_File then
2457 "Dot_Replacement not specified for Ada",
2461 if Lang_Data.Config.Naming_Data.Spec_Suffix = No_File then
2465 "Spec_Suffix not specified for Ada",
2469 if Lang_Data.Config.Naming_Data.Body_Suffix = No_File then
2473 "Body_Suffix not specified for Ada",
2478 Prev_Index := Lang_Index;
2480 -- For file based languages, either Spec_Suffix or Body_Suffix
2481 -- need to be specified.
2483 if Lang_Data.Config.Naming_Data.Spec_Suffix = No_File and then
2484 Lang_Data.Config.Naming_Data.Body_Suffix = No_File
2486 Error_Msg_Name_1 := Current_Language;
2490 "no suffixes specified for %%",
2495 Lang_Index := Lang_Data.Next;
2497 end Check_Configuration;
2499 -------------------------------
2500 -- Check_If_Externally_Built --
2501 -------------------------------
2503 procedure Check_If_Externally_Built
2504 (Project : Project_Id;
2505 In_Tree : Project_Tree_Ref;
2506 Data : in out Project_Data)
2508 Externally_Built : constant Variable_Value :=
2510 (Name_Externally_Built,
2511 Data.Decl.Attributes, In_Tree);
2514 if not Externally_Built.Default then
2515 Get_Name_String (Externally_Built.Value);
2516 To_Lower (Name_Buffer (1 .. Name_Len));
2518 if Name_Buffer (1 .. Name_Len) = "true" then
2519 Data.Externally_Built := True;
2521 elsif Name_Buffer (1 .. Name_Len) /= "false" then
2522 Error_Msg (Project, In_Tree,
2523 "Externally_Built may only be true or false",
2524 Externally_Built.Location);
2528 -- A virtual project extending an externally built project is itself
2529 -- externally built.
2531 if Data.Virtual and then Data.Extends /= No_Project then
2532 Data.Externally_Built :=
2533 In_Tree.Projects.Table (Data.Extends).Externally_Built;
2536 if Current_Verbosity = High then
2537 Write_Str ("Project is ");
2539 if not Data.Externally_Built then
2543 Write_Line ("externally built.");
2545 end Check_If_Externally_Built;
2547 ----------------------
2548 -- Check_Interfaces --
2549 ----------------------
2551 procedure Check_Interfaces
2552 (Project : Project_Id;
2553 In_Tree : Project_Tree_Ref;
2554 Data : in out Project_Data)
2556 Interfaces : constant Prj.Variable_Value :=
2558 (Snames.Name_Interfaces,
2559 Data.Decl.Attributes,
2562 List : String_List_Id;
2563 Element : String_Element;
2564 Name : File_Name_Type;
2568 Project_2 : Project_Id;
2569 Data_2 : Project_Data;
2572 if not Interfaces.Default then
2574 -- Set In_Interfaces to False for all sources. It will be set to True
2575 -- later for the sources in the Interfaces list.
2577 Project_2 := Project;
2580 Source := Data_2.First_Source;
2581 while Source /= No_Source loop
2583 Src_Data : Source_Data renames
2584 In_Tree.Sources.Table (Source);
2586 Src_Data.In_Interfaces := False;
2587 Source := Src_Data.Next_In_Project;
2591 Project_2 := Data_2.Extends;
2593 exit when Project_2 = No_Project;
2595 Data_2 := In_Tree.Projects.Table (Project_2);
2598 List := Interfaces.Values;
2599 while List /= Nil_String loop
2600 Element := In_Tree.String_Elements.Table (List);
2601 Get_Name_String (Element.Value);
2602 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2605 Project_2 := Project;
2609 Source := Data_2.First_Source;
2610 while Source /= No_Source loop
2612 Src_Data : Source_Data renames
2613 In_Tree.Sources.Table (Source);
2616 if Src_Data.File = Name then
2617 if not Src_Data.Locally_Removed then
2618 Src_Data.In_Interfaces := True;
2619 Src_Data.Declared_In_Interfaces := True;
2621 if Src_Data.Other_Part /= No_Source then
2622 In_Tree.Sources.Table
2623 (Src_Data.Other_Part).In_Interfaces := True;
2624 In_Tree.Sources.Table
2625 (Src_Data.Other_Part).Declared_In_Interfaces :=
2629 if Current_Verbosity = High then
2630 Write_Str (" interface: ");
2632 (Get_Name_String (Src_Data.Path.Name));
2639 Source := Src_Data.Next_In_Project;
2643 Project_2 := Data_2.Extends;
2645 exit Big_Loop when Project_2 = No_Project;
2647 Data_2 := In_Tree.Projects.Table (Project_2);
2650 if Source = No_Source then
2651 Error_Msg_File_1 := File_Name_Type (Element.Value);
2652 Error_Msg_Name_1 := Data.Name;
2657 "{ cannot be an interface of project %% "
2658 & "as it is not one of its sources",
2662 List := Element.Next;
2665 Data.Interfaces_Defined := True;
2667 elsif Data.Extends /= No_Project then
2668 Data.Interfaces_Defined :=
2669 In_Tree.Projects.Table (Data.Extends).Interfaces_Defined;
2671 if Data.Interfaces_Defined then
2672 Source := Data.First_Source;
2673 while Source /= No_Source loop
2675 Src_Data : Source_Data renames
2676 In_Tree.Sources.Table (Source);
2679 if not Src_Data.Declared_In_Interfaces then
2680 Src_Data.In_Interfaces := False;
2683 Source := Src_Data.Next_In_Project;
2688 end Check_Interfaces;
2690 --------------------------
2691 -- Check_Naming_Schemes --
2692 --------------------------
2694 procedure Check_Naming_Schemes
2695 (Data : in out Project_Data;
2696 Project : Project_Id;
2697 In_Tree : Project_Tree_Ref)
2699 Naming_Id : constant Package_Id :=
2700 Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
2701 Naming : Package_Element;
2703 procedure Check_Unit_Names (List : Array_Element_Id);
2704 -- Check that a list of unit names contains only valid names
2706 procedure Get_Exceptions (Kind : Source_Kind);
2707 -- Comment required ???
2709 procedure Get_Unit_Exceptions (Kind : Source_Kind);
2710 -- Comment required ???
2712 ----------------------
2713 -- Check_Unit_Names --
2714 ----------------------
2716 procedure Check_Unit_Names (List : Array_Element_Id) is
2717 Current : Array_Element_Id;
2718 Element : Array_Element;
2719 Unit_Name : Name_Id;
2722 -- Loop through elements of the string list
2725 while Current /= No_Array_Element loop
2726 Element := In_Tree.Array_Elements.Table (Current);
2728 -- Put file name in canonical case
2730 if not Osint.File_Names_Case_Sensitive then
2731 Get_Name_String (Element.Value.Value);
2732 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2733 Element.Value.Value := Name_Find;
2736 -- Check that it contains a valid unit name
2738 Get_Name_String (Element.Index);
2739 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit_Name);
2741 if Unit_Name = No_Name then
2742 Err_Vars.Error_Msg_Name_1 := Element.Index;
2745 "%% is not a valid unit name.",
2746 Element.Value.Location);
2749 if Current_Verbosity = High then
2750 Write_Str (" Unit (""");
2751 Write_Str (Get_Name_String (Unit_Name));
2755 Element.Index := Unit_Name;
2756 In_Tree.Array_Elements.Table (Current) := Element;
2759 Current := Element.Next;
2761 end Check_Unit_Names;
2763 --------------------
2764 -- Get_Exceptions --
2765 --------------------
2767 procedure Get_Exceptions (Kind : Source_Kind) is
2768 Exceptions : Array_Element_Id;
2769 Exception_List : Variable_Value;
2770 Element_Id : String_List_Id;
2771 Element : String_Element;
2772 File_Name : File_Name_Type;
2773 Lang_Id : Language_Index;
2775 Lang_Kind : Language_Kind;
2782 (Name_Implementation_Exceptions,
2783 In_Arrays => Naming.Decl.Arrays,
2784 In_Tree => In_Tree);
2789 (Name_Specification_Exceptions,
2790 In_Arrays => Naming.Decl.Arrays,
2791 In_Tree => In_Tree);
2794 Lang_Id := Data.First_Language_Processing;
2795 while Lang_Id /= No_Language_Index loop
2796 if In_Tree.Languages_Data.Table (Lang_Id).Config.Kind =
2799 Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
2801 In_Tree.Languages_Data.Table (Lang_Id).Config.Kind;
2803 Exception_List := Value_Of
2805 In_Array => Exceptions,
2806 In_Tree => In_Tree);
2808 if Exception_List /= Nil_Variable_Value then
2809 Element_Id := Exception_List.Values;
2810 while Element_Id /= Nil_String loop
2811 Element := In_Tree.String_Elements.Table (Element_Id);
2813 if Osint.File_Names_Case_Sensitive then
2814 File_Name := File_Name_Type (Element.Value);
2816 Get_Name_String (Element.Value);
2817 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2818 File_Name := Name_Find;
2821 Source := Data.First_Source;
2822 while Source /= No_Source
2824 In_Tree.Sources.Table (Source).File /= File_Name
2827 In_Tree.Sources.Table (Source).Next_In_Project;
2830 if Source = No_Source then
2839 File_Name => File_Name,
2840 Display_File => File_Name_Type (Element.Value),
2841 Naming_Exception => True,
2842 Lang_Kind => Lang_Kind);
2845 -- Check if the file name is already recorded for
2846 -- another language or another kind.
2849 In_Tree.Sources.Table (Source).Language /= Lang_Id
2854 "the same file cannot be a source " &
2858 elsif In_Tree.Sources.Table (Source).Kind /= Kind then
2862 "the same file cannot be a source " &
2867 -- If the file is already recorded for the same
2868 -- language and the same kind, it means that the file
2869 -- name appears several times in the *_Exceptions
2870 -- attribute; so there is nothing to do.
2874 Element_Id := Element.Next;
2879 Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next;
2883 -------------------------
2884 -- Get_Unit_Exceptions --
2885 -------------------------
2887 procedure Get_Unit_Exceptions (Kind : Source_Kind) is
2888 Exceptions : Array_Element_Id;
2889 Element : Array_Element;
2892 File_Name : File_Name_Type;
2893 Lang_Id : constant Language_Index :=
2894 Data.Unit_Based_Language_Index;
2895 Lang : constant Name_Id :=
2896 Data.Unit_Based_Language_Name;
2899 Source_To_Replace : Source_Id := No_Source;
2901 Other_Project : Project_Id;
2902 Other_Part : Source_Id := No_Source;
2905 if Lang_Id = No_Language_Index or else Lang = No_Name then
2910 Exceptions := Value_Of
2912 In_Arrays => Naming.Decl.Arrays,
2913 In_Tree => In_Tree);
2915 if Exceptions = No_Array_Element then
2918 (Name_Implementation,
2919 In_Arrays => Naming.Decl.Arrays,
2920 In_Tree => In_Tree);
2927 In_Arrays => Naming.Decl.Arrays,
2928 In_Tree => In_Tree);
2930 if Exceptions = No_Array_Element then
2931 Exceptions := Value_Of
2932 (Name_Specification,
2933 In_Arrays => Naming.Decl.Arrays,
2934 In_Tree => In_Tree);
2939 while Exceptions /= No_Array_Element loop
2940 Element := In_Tree.Array_Elements.Table (Exceptions);
2942 if Osint.File_Names_Case_Sensitive then
2943 File_Name := File_Name_Type (Element.Value.Value);
2945 Get_Name_String (Element.Value.Value);
2946 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
2947 File_Name := Name_Find;
2950 Get_Name_String (Element.Index);
2951 To_Lower (Name_Buffer (1 .. Name_Len));
2954 Index := Element.Value.Index;
2956 -- For Ada, check if it is a valid unit name
2958 if Lang = Name_Ada then
2959 Get_Name_String (Element.Index);
2960 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
2962 if Unit = No_Name then
2963 Err_Vars.Error_Msg_Name_1 := Element.Index;
2966 "%% is not a valid unit name.",
2967 Element.Value.Location);
2971 if Unit /= No_Name then
2973 -- Check if the source already exists
2975 Source := In_Tree.First_Source;
2976 Source_To_Replace := No_Source;
2978 while Source /= No_Source and then
2979 (In_Tree.Sources.Table (Source).Unit /= Unit or else
2980 In_Tree.Sources.Table (Source).Index /= Index)
2982 Source := In_Tree.Sources.Table (Source).Next_In_Sources;
2985 if Source /= No_Source then
2986 if In_Tree.Sources.Table (Source).Kind /= Kind then
2987 Other_Part := Source;
2991 In_Tree.Sources.Table (Source).Next_In_Sources;
2993 exit when Source = No_Source or else
2994 (In_Tree.Sources.Table (Source).Unit = Unit
2996 In_Tree.Sources.Table (Source).Index = Index);
3000 if Source /= No_Source then
3001 Other_Project := In_Tree.Sources.Table (Source).Project;
3003 if Is_Extending (Project, Other_Project, In_Tree) then
3005 In_Tree.Sources.Table (Source).Other_Part;
3007 -- Record the source to be removed
3009 Source_To_Replace := Source;
3010 Source := No_Source;
3013 Error_Msg_Name_1 := Unit;
3015 In_Tree.Projects.Table (Other_Project).Name;
3019 "%% is already a source of project %%",
3020 Element.Value.Location);
3025 if Source = No_Source then
3034 File_Name => File_Name,
3035 Display_File => File_Name_Type (Element.Value.Value),
3036 Lang_Kind => Unit_Based,
3037 Other_Part => Other_Part,
3040 Naming_Exception => True,
3041 Source_To_Replace => Source_To_Replace);
3045 Exceptions := Element.Next;
3048 end Get_Unit_Exceptions;
3050 -- Start of processing for Check_Naming_Schemes
3053 if Get_Mode = Ada_Only then
3055 -- If there is a package Naming, we will put in Data.Naming what is
3056 -- in this package Naming.
3058 if Naming_Id /= No_Package then
3059 Naming := In_Tree.Packages.Table (Naming_Id);
3061 if Current_Verbosity = High then
3062 Write_Line ("Checking ""Naming"" for Ada.");
3066 Bodies : constant Array_Element_Id :=
3068 (Name_Body, Naming.Decl.Arrays, In_Tree);
3070 Specs : constant Array_Element_Id :=
3072 (Name_Spec, Naming.Decl.Arrays, In_Tree);
3075 if Bodies /= No_Array_Element then
3077 -- We have elements in the array Body_Part
3079 if Current_Verbosity = High then
3080 Write_Line ("Found Bodies.");
3083 Data.Naming.Bodies := Bodies;
3084 Check_Unit_Names (Bodies);
3087 if Current_Verbosity = High then
3088 Write_Line ("No Bodies.");
3092 if Specs /= No_Array_Element then
3094 -- We have elements in the array Specs
3096 if Current_Verbosity = High then
3097 Write_Line ("Found Specs.");
3100 Data.Naming.Specs := Specs;
3101 Check_Unit_Names (Specs);
3104 if Current_Verbosity = High then
3105 Write_Line ("No Specs.");
3110 -- We are now checking if variables Dot_Replacement, Casing,
3111 -- Spec_Suffix, Body_Suffix and/or Separate_Suffix exist.
3113 -- For each variable, if it does not exist, we do nothing,
3114 -- because we already have the default.
3116 -- Check Dot_Replacement
3119 Dot_Replacement : constant Variable_Value :=
3121 (Name_Dot_Replacement,
3122 Naming.Decl.Attributes, In_Tree);
3125 pragma Assert (Dot_Replacement.Kind = Single,
3126 "Dot_Replacement is not a single string");
3128 if not Dot_Replacement.Default then
3129 Get_Name_String (Dot_Replacement.Value);
3131 if Name_Len = 0 then
3134 "Dot_Replacement cannot be empty",
3135 Dot_Replacement.Location);
3138 if Osint.File_Names_Case_Sensitive then
3139 Data.Naming.Dot_Replacement :=
3140 File_Name_Type (Dot_Replacement.Value);
3142 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3143 Data.Naming.Dot_Replacement := Name_Find;
3145 Data.Naming.Dot_Repl_Loc := Dot_Replacement.Location;
3150 if Current_Verbosity = High then
3151 Write_Str (" Dot_Replacement = """);
3152 Write_Str (Get_Name_String (Data.Naming.Dot_Replacement));
3160 Casing_String : constant Variable_Value :=
3163 Naming.Decl.Attributes,
3167 pragma Assert (Casing_String.Kind = Single,
3168 "Casing is not a single string");
3170 if not Casing_String.Default then
3172 Casing_Image : constant String :=
3173 Get_Name_String (Casing_String.Value);
3176 Casing_Value : constant Casing_Type :=
3177 Value (Casing_Image);
3179 Data.Naming.Casing := Casing_Value;
3183 when Constraint_Error =>
3184 if Casing_Image'Length = 0 then
3187 "Casing cannot be an empty string",
3188 Casing_String.Location);
3191 Name_Len := Casing_Image'Length;
3192 Name_Buffer (1 .. Name_Len) := Casing_Image;
3193 Err_Vars.Error_Msg_Name_1 := Name_Find;
3196 "%% is not a correct Casing",
3197 Casing_String.Location);
3203 if Current_Verbosity = High then
3204 Write_Str (" Casing = ");
3205 Write_Str (Image (Data.Naming.Casing));
3210 -- Check Spec_Suffix
3213 Ada_Spec_Suffix : constant Variable_Value :=
3217 In_Array => Data.Naming.Spec_Suffix,
3218 In_Tree => In_Tree);
3221 if Ada_Spec_Suffix.Kind = Single
3222 and then Get_Name_String (Ada_Spec_Suffix.Value) /= ""
3224 Get_Name_String (Ada_Spec_Suffix.Value);
3225 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3226 Set_Spec_Suffix (In_Tree, "ada", Data.Naming, Name_Find);
3227 Data.Naming.Ada_Spec_Suffix_Loc := Ada_Spec_Suffix.Location;
3234 Default_Ada_Spec_Suffix);
3238 if Current_Verbosity = High then
3239 Write_Str (" Spec_Suffix = """);
3240 Write_Str (Spec_Suffix_Of (In_Tree, "ada", Data.Naming));
3245 -- Check Body_Suffix
3248 Ada_Body_Suffix : constant Variable_Value :=
3252 In_Array => Data.Naming.Body_Suffix,
3253 In_Tree => In_Tree);
3256 if Ada_Body_Suffix.Kind = Single
3257 and then Get_Name_String (Ada_Body_Suffix.Value) /= ""
3259 Get_Name_String (Ada_Body_Suffix.Value);
3260 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3261 Set_Body_Suffix (In_Tree, "ada", Data.Naming, Name_Find);
3262 Data.Naming.Ada_Body_Suffix_Loc := Ada_Body_Suffix.Location;
3269 Default_Ada_Body_Suffix);
3273 if Current_Verbosity = High then
3274 Write_Str (" Body_Suffix = """);
3275 Write_Str (Body_Suffix_Of (In_Tree, "ada", Data.Naming));
3280 -- Check Separate_Suffix
3283 Ada_Sep_Suffix : constant Variable_Value :=
3285 (Variable_Name => Name_Separate_Suffix,
3286 In_Variables => Naming.Decl.Attributes,
3287 In_Tree => In_Tree);
3290 if Ada_Sep_Suffix.Default then
3291 Data.Naming.Separate_Suffix :=
3292 Body_Suffix_Id_Of (In_Tree, Name_Ada, Data.Naming);
3295 Get_Name_String (Ada_Sep_Suffix.Value);
3297 if Name_Len = 0 then
3300 "Separate_Suffix cannot be empty",
3301 Ada_Sep_Suffix.Location);
3304 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3305 Data.Naming.Separate_Suffix := Name_Find;
3306 Data.Naming.Sep_Suffix_Loc := Ada_Sep_Suffix.Location;
3311 if Current_Verbosity = High then
3312 Write_Str (" Separate_Suffix = """);
3313 Write_Str (Get_Name_String (Data.Naming.Separate_Suffix));
3318 -- Check if Data.Naming is valid
3320 Check_Ada_Naming_Scheme_Validity (Project, In_Tree, Data.Naming);
3323 elsif not In_Configuration then
3325 -- Look into package Naming, if there is one
3327 if Naming_Id /= No_Package then
3328 Naming := In_Tree.Packages.Table (Naming_Id);
3330 if Current_Verbosity = High then
3331 Write_Line ("Checking package Naming.");
3334 -- We are now checking if attribute Dot_Replacement, Casing,
3335 -- and/or Separate_Suffix exist.
3337 -- For each attribute, if it does not exist, we do nothing,
3338 -- because we already have the default.
3339 -- Otherwise, for all unit-based languages, we put the declared
3340 -- value in the language config.
3343 Dot_Repl : constant Variable_Value :=
3345 (Name_Dot_Replacement,
3346 Naming.Decl.Attributes, In_Tree);
3347 Dot_Replacement : File_Name_Type := No_File;
3349 Casing_String : constant Variable_Value :=
3352 Naming.Decl.Attributes,
3355 Casing : Casing_Type := All_Lower_Case;
3356 -- Casing type (junk initialization to stop bad gcc warning)
3358 Casing_Defined : Boolean := False;
3360 Sep_Suffix : constant Variable_Value :=
3362 (Variable_Name => Name_Separate_Suffix,
3363 In_Variables => Naming.Decl.Attributes,
3364 In_Tree => In_Tree);
3366 Separate_Suffix : File_Name_Type := No_File;
3367 Lang_Id : Language_Index;
3370 -- Check attribute Dot_Replacement
3372 if not Dot_Repl.Default then
3373 Get_Name_String (Dot_Repl.Value);
3375 if Name_Len = 0 then
3378 "Dot_Replacement cannot be empty",
3382 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3383 Dot_Replacement := Name_Find;
3385 if Current_Verbosity = High then
3386 Write_Str (" Dot_Replacement = """);
3387 Write_Str (Get_Name_String (Dot_Replacement));
3394 -- Check attribute Casing
3396 if not Casing_String.Default then
3398 Casing_Image : constant String :=
3399 Get_Name_String (Casing_String.Value);
3402 Casing_Value : constant Casing_Type :=
3403 Value (Casing_Image);
3405 Casing := Casing_Value;
3406 Casing_Defined := True;
3408 if Current_Verbosity = High then
3409 Write_Str (" Casing = ");
3410 Write_Str (Image (Casing));
3417 when Constraint_Error =>
3418 if Casing_Image'Length = 0 then
3421 "Casing cannot be an empty string",
3422 Casing_String.Location);
3425 Name_Len := Casing_Image'Length;
3426 Name_Buffer (1 .. Name_Len) := Casing_Image;
3427 Err_Vars.Error_Msg_Name_1 := Name_Find;
3430 "%% is not a correct Casing",
3431 Casing_String.Location);
3436 if not Sep_Suffix.Default then
3437 Get_Name_String (Sep_Suffix.Value);
3439 if Name_Len = 0 then
3442 "Separate_Suffix cannot be empty",
3443 Sep_Suffix.Location);
3446 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
3447 Separate_Suffix := Name_Find;
3449 if Current_Verbosity = High then
3450 Write_Str (" Separate_Suffix = """);
3451 Write_Str (Get_Name_String (Separate_Suffix));
3458 -- For all unit based languages, if any, set the specified
3459 -- value of Dot_Replacement, Casing and/or Separate_Suffix.
3461 if Dot_Replacement /= No_File
3462 or else Casing_Defined
3463 or else Separate_Suffix /= No_File
3465 Lang_Id := Data.First_Language_Processing;
3466 while Lang_Id /= No_Language_Index loop
3467 if In_Tree.Languages_Data.Table
3468 (Lang_Id).Config.Kind = Unit_Based
3470 if Dot_Replacement /= No_File then
3471 In_Tree.Languages_Data.Table
3472 (Lang_Id).Config.Naming_Data.Dot_Replacement :=
3476 if Casing_Defined then
3477 In_Tree.Languages_Data.Table
3478 (Lang_Id).Config.Naming_Data.Casing := Casing;
3481 if Separate_Suffix /= No_File then
3482 In_Tree.Languages_Data.Table
3483 (Lang_Id).Config.Naming_Data.Separate_Suffix :=
3489 In_Tree.Languages_Data.Table (Lang_Id).Next;
3494 -- Next, get the spec and body suffixes
3497 Suffix : Variable_Value;
3498 Lang_Id : Language_Index;
3502 Lang_Id := Data.First_Language_Processing;
3503 while Lang_Id /= No_Language_Index loop
3504 Lang := In_Tree.Languages_Data.Table (Lang_Id).Name;
3510 Attribute_Or_Array_Name => Name_Spec_Suffix,
3511 In_Package => Naming_Id,
3512 In_Tree => In_Tree);
3514 if Suffix = Nil_Variable_Value then
3517 Attribute_Or_Array_Name => Name_Specification_Suffix,
3518 In_Package => Naming_Id,
3519 In_Tree => In_Tree);
3522 if Suffix /= Nil_Variable_Value then
3523 In_Tree.Languages_Data.Table (Lang_Id).
3524 Config.Naming_Data.Spec_Suffix :=
3525 File_Name_Type (Suffix.Value);
3532 Attribute_Or_Array_Name => Name_Body_Suffix,
3533 In_Package => Naming_Id,
3534 In_Tree => In_Tree);
3536 if Suffix = Nil_Variable_Value then
3539 Attribute_Or_Array_Name => Name_Implementation_Suffix,
3540 In_Package => Naming_Id,
3541 In_Tree => In_Tree);
3544 if Suffix /= Nil_Variable_Value then
3545 In_Tree.Languages_Data.Table (Lang_Id).
3546 Config.Naming_Data.Body_Suffix :=
3547 File_Name_Type (Suffix.Value);
3550 Lang_Id := In_Tree.Languages_Data.Table (Lang_Id).Next;
3554 -- Get the exceptions for file based languages
3556 Get_Exceptions (Spec);
3557 Get_Exceptions (Impl);
3559 -- Get the exceptions for unit based languages
3561 Get_Unit_Exceptions (Spec);
3562 Get_Unit_Exceptions (Impl);
3566 end Check_Naming_Schemes;
3568 ------------------------------
3569 -- Check_Library_Attributes --
3570 ------------------------------
3572 procedure Check_Library_Attributes
3573 (Project : Project_Id;
3574 In_Tree : Project_Tree_Ref;
3575 Current_Dir : String;
3576 Data : in out Project_Data)
3578 Attributes : constant Prj.Variable_Id := Data.Decl.Attributes;
3580 Lib_Dir : constant Prj.Variable_Value :=
3582 (Snames.Name_Library_Dir, Attributes, In_Tree);
3584 Lib_Name : constant Prj.Variable_Value :=
3586 (Snames.Name_Library_Name, Attributes, In_Tree);
3588 Lib_Version : constant Prj.Variable_Value :=
3590 (Snames.Name_Library_Version, Attributes, In_Tree);
3592 Lib_ALI_Dir : constant Prj.Variable_Value :=
3594 (Snames.Name_Library_Ali_Dir, Attributes, In_Tree);
3596 The_Lib_Kind : constant Prj.Variable_Value :=
3598 (Snames.Name_Library_Kind, Attributes, In_Tree);
3600 Imported_Project_List : Project_List := Empty_Project_List;
3602 Continuation : String_Access := No_Continuation_String'Access;
3604 Support_For_Libraries : Library_Support;
3606 Library_Directory_Present : Boolean;
3608 procedure Check_Library (Proj : Project_Id; Extends : Boolean);
3609 -- Check if an imported or extended project if also a library project
3615 procedure Check_Library (Proj : Project_Id; Extends : Boolean) is
3616 Proj_Data : Project_Data;
3620 if Proj /= No_Project then
3621 Proj_Data := In_Tree.Projects.Table (Proj);
3623 if not Proj_Data.Library then
3625 -- The only not library projects that are OK are those that
3626 -- have no sources. However, header files from non-Ada
3627 -- languages are OK, as there is nothing to compile.
3629 Src_Id := Proj_Data.First_Source;
3630 while Src_Id /= No_Source loop
3632 Src : Source_Data renames In_Tree.Sources.Table (Src_Id);
3634 exit when Src.Lang_Kind /= File_Based
3635 or else Src.Kind /= Spec;
3636 Src_Id := Src.Next_In_Project;
3640 if Src_Id /= No_Source then
3641 Error_Msg_Name_1 := Data.Name;
3642 Error_Msg_Name_2 := Proj_Data.Name;
3645 if Data.Library_Kind /= Static then
3649 "shared library project %% cannot extend " &
3650 "project %% that is not a library project",
3652 Continuation := Continuation_String'Access;
3655 elsif Data.Library_Kind /= Static then
3659 "shared library project %% cannot import project %% " &
3660 "that is not a shared library project",
3662 Continuation := Continuation_String'Access;
3666 elsif Data.Library_Kind /= Static and then
3667 Proj_Data.Library_Kind = Static
3669 Error_Msg_Name_1 := Data.Name;
3670 Error_Msg_Name_2 := Proj_Data.Name;
3676 "shared library project %% cannot extend static " &
3677 "library project %%",
3684 "shared library project %% cannot import static " &
3685 "library project %%",
3689 Continuation := Continuation_String'Access;
3694 -- Start of processing for Check_Library_Attributes
3697 Library_Directory_Present := Lib_Dir.Value /= Empty_String;
3699 -- Special case of extending project
3701 if Data.Extends /= No_Project then
3703 Extended_Data : constant Project_Data :=
3704 In_Tree.Projects.Table (Data.Extends);
3707 -- If the project extended is a library project, we inherit the
3708 -- library name, if it is not redefined; we check that the library
3709 -- directory is specified.
3711 if Extended_Data.Library then
3712 if Data.Qualifier = Standard then
3715 "a standard project cannot extend a library project",
3719 if Lib_Name.Default then
3720 Data.Library_Name := Extended_Data.Library_Name;
3723 if Lib_Dir.Default then
3724 if not Data.Virtual then
3727 "a project extending a library project must " &
3728 "specify an attribute Library_Dir",
3732 -- For a virtual project extending a library project,
3733 -- inherit library directory.
3735 Data.Library_Dir := Extended_Data.Library_Dir;
3736 Library_Directory_Present := True;
3744 pragma Assert (Lib_Name.Kind = Single);
3746 if Lib_Name.Value = Empty_String then
3747 if Current_Verbosity = High
3748 and then Data.Library_Name = No_Name
3750 Write_Line ("No library name");
3754 -- There is no restriction on the syntax of library names
3756 Data.Library_Name := Lib_Name.Value;
3759 if Data.Library_Name /= No_Name then
3760 if Current_Verbosity = High then
3761 Write_Str ("Library name = """);
3762 Write_Str (Get_Name_String (Data.Library_Name));
3766 pragma Assert (Lib_Dir.Kind = Single);
3768 if not Library_Directory_Present then
3769 if Current_Verbosity = High then
3770 Write_Line ("No library directory");
3774 -- Find path name (unless inherited), check that it is a directory
3776 if Data.Library_Dir = No_Path_Information then
3780 File_Name_Type (Lib_Dir.Value),
3781 Data.Directory.Display_Name,
3782 Data.Library_Dir.Name,
3783 Data.Library_Dir.Display_Name,
3784 Create => "library",
3785 Current_Dir => Current_Dir,
3786 Location => Lib_Dir.Location,
3787 Externally_Built => Data.Externally_Built);
3790 if Data.Library_Dir = No_Path_Information then
3792 -- Get the absolute name of the library directory that
3793 -- does not exist, to report an error.
3796 Dir_Name : constant String :=
3797 Get_Name_String (Lib_Dir.Value);
3800 if Is_Absolute_Path (Dir_Name) then
3801 Err_Vars.Error_Msg_File_1 :=
3802 File_Name_Type (Lib_Dir.Value);
3805 Get_Name_String (Data.Directory.Display_Name);
3807 if Name_Buffer (Name_Len) /= Directory_Separator then
3808 Name_Len := Name_Len + 1;
3809 Name_Buffer (Name_Len) := Directory_Separator;
3813 (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
3815 Name_Len := Name_Len + Dir_Name'Length;
3816 Err_Vars.Error_Msg_File_1 := Name_Find;
3823 "library directory { does not exist",
3827 -- The library directory cannot be the same as the Object
3830 elsif Data.Library_Dir.Name = Data.Object_Directory.Name then
3833 "library directory cannot be the same " &
3834 "as object directory",
3836 Data.Library_Dir := No_Path_Information;
3840 OK : Boolean := True;
3841 Dirs_Id : String_List_Id;
3842 Dir_Elem : String_Element;
3845 -- The library directory cannot be the same as a source
3846 -- directory of the current project.
3848 Dirs_Id := Data.Source_Dirs;
3849 while Dirs_Id /= Nil_String loop
3850 Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
3851 Dirs_Id := Dir_Elem.Next;
3854 Data.Library_Dir.Name = Path_Name_Type (Dir_Elem.Value)
3856 Err_Vars.Error_Msg_File_1 :=
3857 File_Name_Type (Dir_Elem.Value);
3860 "library directory cannot be the same " &
3861 "as source directory {",
3870 -- The library directory cannot be the same as a source
3871 -- directory of another project either.
3874 for Pid in 1 .. Project_Table.Last (In_Tree.Projects) loop
3875 if Pid /= Project then
3876 Dirs_Id := In_Tree.Projects.Table (Pid).Source_Dirs;
3878 Dir_Loop : while Dirs_Id /= Nil_String loop
3880 In_Tree.String_Elements.Table (Dirs_Id);
3881 Dirs_Id := Dir_Elem.Next;
3883 if Data.Library_Dir.Name =
3884 Path_Name_Type (Dir_Elem.Value)
3886 Err_Vars.Error_Msg_File_1 :=
3887 File_Name_Type (Dir_Elem.Value);
3888 Err_Vars.Error_Msg_Name_1 :=
3889 In_Tree.Projects.Table (Pid).Name;
3893 "library directory cannot be the same " &
3894 "as source directory { of project %%",
3901 end loop Project_Loop;
3905 Data.Library_Dir := No_Path_Information;
3907 elsif Current_Verbosity = High then
3909 -- Display the Library directory in high verbosity
3911 Write_Str ("Library directory =""");
3913 (Get_Name_String (Data.Library_Dir.Display_Name));
3923 Data.Library_Dir /= No_Path_Information
3925 Data.Library_Name /= No_Name;
3927 if Data.Extends = No_Project then
3928 case Data.Qualifier is
3930 if Data.Library then
3933 "a standard project cannot be a library project",
3938 if not Data.Library then
3939 if Data.Library_Dir = No_Path_Information then
3942 "\attribute Library_Dir not declared",
3946 if Data.Library_Name = No_Name then
3949 "\attribute Library_Name not declared",
3960 if Data.Library then
3961 if Get_Mode = Multi_Language then
3962 Support_For_Libraries := Data.Config.Lib_Support;
3965 Support_For_Libraries := MLib.Tgt.Support_For_Libraries;
3968 if Support_For_Libraries = Prj.None then
3971 "?libraries are not supported on this platform",
3973 Data.Library := False;
3976 if Lib_ALI_Dir.Value = Empty_String then
3977 if Current_Verbosity = High then
3978 Write_Line ("No library ALI directory specified");
3980 Data.Library_ALI_Dir := Data.Library_Dir;
3983 -- Find path name, check that it is a directory
3988 File_Name_Type (Lib_ALI_Dir.Value),
3989 Data.Directory.Display_Name,
3990 Data.Library_ALI_Dir.Name,
3991 Data.Library_ALI_Dir.Display_Name,
3992 Create => "library ALI",
3993 Current_Dir => Current_Dir,
3994 Location => Lib_ALI_Dir.Location,
3995 Externally_Built => Data.Externally_Built);
3997 if Data.Library_ALI_Dir = No_Path_Information then
3999 -- Get the absolute name of the library ALI directory that
4000 -- does not exist, to report an error.
4003 Dir_Name : constant String :=
4004 Get_Name_String (Lib_ALI_Dir.Value);
4007 if Is_Absolute_Path (Dir_Name) then
4008 Err_Vars.Error_Msg_File_1 :=
4009 File_Name_Type (Lib_Dir.Value);
4012 Get_Name_String (Data.Directory.Display_Name);
4014 if Name_Buffer (Name_Len) /= Directory_Separator then
4015 Name_Len := Name_Len + 1;
4016 Name_Buffer (Name_Len) := Directory_Separator;
4020 (Name_Len + 1 .. Name_Len + Dir_Name'Length) :=
4022 Name_Len := Name_Len + Dir_Name'Length;
4023 Err_Vars.Error_Msg_File_1 := Name_Find;
4030 "library 'A'L'I directory { does not exist",
4031 Lib_ALI_Dir.Location);
4035 if Data.Library_ALI_Dir /= Data.Library_Dir then
4037 -- The library ALI directory cannot be the same as the
4038 -- Object directory.
4040 if Data.Library_ALI_Dir = Data.Object_Directory then
4043 "library 'A'L'I directory cannot be the same " &
4044 "as object directory",
4045 Lib_ALI_Dir.Location);
4046 Data.Library_ALI_Dir := No_Path_Information;
4050 OK : Boolean := True;
4051 Dirs_Id : String_List_Id;
4052 Dir_Elem : String_Element;
4055 -- The library ALI directory cannot be the same as
4056 -- a source directory of the current project.
4058 Dirs_Id := Data.Source_Dirs;
4059 while Dirs_Id /= Nil_String loop
4060 Dir_Elem := In_Tree.String_Elements.Table (Dirs_Id);
4061 Dirs_Id := Dir_Elem.Next;
4063 if Data.Library_ALI_Dir.Name =
4064 Path_Name_Type (Dir_Elem.Value)
4066 Err_Vars.Error_Msg_File_1 :=
4067 File_Name_Type (Dir_Elem.Value);
4070 "library 'A'L'I directory cannot be " &
4071 "the same as source directory {",
4072 Lib_ALI_Dir.Location);
4080 -- The library ALI directory cannot be the same as
4081 -- a source directory of another project either.
4085 Pid in 1 .. Project_Table.Last (In_Tree.Projects)
4087 if Pid /= Project then
4089 In_Tree.Projects.Table (Pid).Source_Dirs;
4092 while Dirs_Id /= Nil_String loop
4094 In_Tree.String_Elements.Table (Dirs_Id);
4095 Dirs_Id := Dir_Elem.Next;
4097 if Data.Library_ALI_Dir.Name =
4098 Path_Name_Type (Dir_Elem.Value)
4100 Err_Vars.Error_Msg_File_1 :=
4101 File_Name_Type (Dir_Elem.Value);
4102 Err_Vars.Error_Msg_Name_1 :=
4103 In_Tree.Projects.Table (Pid).Name;
4107 "library 'A'L'I directory cannot " &
4108 "be the same as source directory " &
4110 Lib_ALI_Dir.Location);
4112 exit ALI_Project_Loop;
4114 end loop ALI_Dir_Loop;
4116 end loop ALI_Project_Loop;
4120 Data.Library_ALI_Dir := No_Path_Information;
4122 elsif Current_Verbosity = High then
4124 -- Display the Library ALI directory in high
4127 Write_Str ("Library ALI directory =""");
4130 (Data.Library_ALI_Dir.Display_Name));
4138 pragma Assert (Lib_Version.Kind = Single);
4140 if Lib_Version.Value = Empty_String then
4141 if Current_Verbosity = High then
4142 Write_Line ("No library version specified");
4146 Data.Lib_Internal_Name := Lib_Version.Value;
4149 pragma Assert (The_Lib_Kind.Kind = Single);
4151 if The_Lib_Kind.Value = Empty_String then
4152 if Current_Verbosity = High then
4153 Write_Line ("No library kind specified");
4157 Get_Name_String (The_Lib_Kind.Value);
4160 Kind_Name : constant String :=
4161 To_Lower (Name_Buffer (1 .. Name_Len));
4163 OK : Boolean := True;
4166 if Kind_Name = "static" then
4167 Data.Library_Kind := Static;
4169 elsif Kind_Name = "dynamic" then
4170 Data.Library_Kind := Dynamic;
4172 elsif Kind_Name = "relocatable" then
4173 Data.Library_Kind := Relocatable;
4178 "illegal value for Library_Kind",
4179 The_Lib_Kind.Location);
4183 if Current_Verbosity = High and then OK then
4184 Write_Str ("Library kind = ");
4185 Write_Line (Kind_Name);
4188 if Data.Library_Kind /= Static and then
4189 Support_For_Libraries = Prj.Static_Only
4193 "only static libraries are supported " &
4195 The_Lib_Kind.Location);
4196 Data.Library := False;
4201 if Data.Library then
4202 if Current_Verbosity = High then
4203 Write_Line ("This is a library project file");
4206 if Get_Mode = Multi_Language then
4207 Check_Library (Data.Extends, Extends => True);
4209 Imported_Project_List := Data.Imported_Projects;
4210 while Imported_Project_List /= Empty_Project_List loop
4212 (In_Tree.Project_Lists.Table
4213 (Imported_Project_List).Project,
4215 Imported_Project_List :=
4216 In_Tree.Project_Lists.Table
4217 (Imported_Project_List).Next;
4225 -- Check if Linker'Switches or Linker'Default_Switches are declared.
4226 -- Warn if they are declared, as it is a common error to think that
4227 -- library are "linked" with Linker switches.
4229 if Data.Library then
4231 Linker_Package_Id : constant Package_Id :=
4233 (Name_Linker, Data.Decl.Packages, In_Tree);
4234 Linker_Package : Package_Element;
4235 Switches : Array_Element_Id := No_Array_Element;
4238 if Linker_Package_Id /= No_Package then
4239 Linker_Package := In_Tree.Packages.Table (Linker_Package_Id);
4243 (Name => Name_Switches,
4244 In_Arrays => Linker_Package.Decl.Arrays,
4245 In_Tree => In_Tree);
4247 if Switches = No_Array_Element then
4250 (Name => Name_Default_Switches,
4251 In_Arrays => Linker_Package.Decl.Arrays,
4252 In_Tree => In_Tree);
4255 if Switches /= No_Array_Element then
4258 "?Linker switches not taken into account in library " &
4266 if Data.Extends /= No_Project then
4267 In_Tree.Projects.Table (Data.Extends).Library := False;
4269 end Check_Library_Attributes;
4271 --------------------------
4272 -- Check_Package_Naming --
4273 --------------------------
4275 procedure Check_Package_Naming
4276 (Project : Project_Id;
4277 In_Tree : Project_Tree_Ref;
4278 Data : in out Project_Data)
4280 Naming_Id : constant Package_Id :=
4281 Util.Value_Of (Name_Naming, Data.Decl.Packages, In_Tree);
4283 Naming : Package_Element;
4286 -- If there is a package Naming, we will put in Data.Naming
4287 -- what is in this package Naming.
4289 if Naming_Id /= No_Package then
4290 Naming := In_Tree.Packages.Table (Naming_Id);
4292 if Current_Verbosity = High then
4293 Write_Line ("Checking ""Naming"".");
4296 -- Check Spec_Suffix
4299 Spec_Suffixs : Array_Element_Id :=
4305 Suffix : Array_Element_Id;
4306 Element : Array_Element;
4307 Suffix2 : Array_Element_Id;
4310 -- If some suffixes have been specified, we make sure that
4311 -- for each language for which a default suffix has been
4312 -- specified, there is a suffix specified, either the one
4313 -- in the project file or if there were none, the default.
4315 if Spec_Suffixs /= No_Array_Element then
4316 Suffix := Data.Naming.Spec_Suffix;
4318 while Suffix /= No_Array_Element loop
4320 In_Tree.Array_Elements.Table (Suffix);
4321 Suffix2 := Spec_Suffixs;
4323 while Suffix2 /= No_Array_Element loop
4324 exit when In_Tree.Array_Elements.Table
4325 (Suffix2).Index = Element.Index;
4326 Suffix2 := In_Tree.Array_Elements.Table
4330 -- There is a registered default suffix, but no
4331 -- suffix specified in the project file.
4332 -- Add the default to the array.
4334 if Suffix2 = No_Array_Element then
4335 Array_Element_Table.Increment_Last
4336 (In_Tree.Array_Elements);
4337 In_Tree.Array_Elements.Table
4338 (Array_Element_Table.Last
4339 (In_Tree.Array_Elements)) :=
4340 (Index => Element.Index,
4341 Src_Index => Element.Src_Index,
4342 Index_Case_Sensitive => False,
4343 Value => Element.Value,
4344 Next => Spec_Suffixs);
4345 Spec_Suffixs := Array_Element_Table.Last
4346 (In_Tree.Array_Elements);
4349 Suffix := Element.Next;
4352 -- Put the resulting array as the specification suffixes
4354 Data.Naming.Spec_Suffix := Spec_Suffixs;
4359 Current : Array_Element_Id;
4360 Element : Array_Element;
4363 Current := Data.Naming.Spec_Suffix;
4364 while Current /= No_Array_Element loop
4365 Element := In_Tree.Array_Elements.Table (Current);
4366 Get_Name_String (Element.Value.Value);
4368 if Name_Len = 0 then
4371 "Spec_Suffix cannot be empty",
4372 Element.Value.Location);
4375 In_Tree.Array_Elements.Table (Current) := Element;
4376 Current := Element.Next;
4380 -- Check Body_Suffix
4383 Impl_Suffixs : Array_Element_Id :=
4389 Suffix : Array_Element_Id;
4390 Element : Array_Element;
4391 Suffix2 : Array_Element_Id;
4394 -- If some suffixes have been specified, we make sure that
4395 -- for each language for which a default suffix has been
4396 -- specified, there is a suffix specified, either the one
4397 -- in the project file or if there were none, the default.
4399 if Impl_Suffixs /= No_Array_Element then
4400 Suffix := Data.Naming.Body_Suffix;
4401 while Suffix /= No_Array_Element loop
4403 In_Tree.Array_Elements.Table (Suffix);
4405 Suffix2 := Impl_Suffixs;
4406 while Suffix2 /= No_Array_Element loop
4407 exit when In_Tree.Array_Elements.Table
4408 (Suffix2).Index = Element.Index;
4409 Suffix2 := In_Tree.Array_Elements.Table
4413 -- There is a registered default suffix, but no suffix was
4414 -- specified in the project file. Add default to the array.
4416 if Suffix2 = No_Array_Element then
4417 Array_Element_Table.Increment_Last
4418 (In_Tree.Array_Elements);
4419 In_Tree.Array_Elements.Table
4420 (Array_Element_Table.Last
4421 (In_Tree.Array_Elements)) :=
4422 (Index => Element.Index,
4423 Src_Index => Element.Src_Index,
4424 Index_Case_Sensitive => False,
4425 Value => Element.Value,
4426 Next => Impl_Suffixs);
4427 Impl_Suffixs := Array_Element_Table.Last
4428 (In_Tree.Array_Elements);
4431 Suffix := Element.Next;
4434 -- Put the resulting array as the implementation suffixes
4436 Data.Naming.Body_Suffix := Impl_Suffixs;
4441 Current : Array_Element_Id;
4442 Element : Array_Element;
4445 Current := Data.Naming.Body_Suffix;
4446 while Current /= No_Array_Element loop
4447 Element := In_Tree.Array_Elements.Table (Current);
4448 Get_Name_String (Element.Value.Value);
4450 if Name_Len = 0 then
4453 "Body_Suffix cannot be empty",
4454 Element.Value.Location);
4457 In_Tree.Array_Elements.Table (Current) := Element;
4458 Current := Element.Next;
4462 -- Get the exceptions, if any
4464 Data.Naming.Specification_Exceptions :=
4466 (Name_Specification_Exceptions,
4467 In_Arrays => Naming.Decl.Arrays,
4468 In_Tree => In_Tree);
4470 Data.Naming.Implementation_Exceptions :=
4472 (Name_Implementation_Exceptions,
4473 In_Arrays => Naming.Decl.Arrays,
4474 In_Tree => In_Tree);
4476 end Check_Package_Naming;
4478 ---------------------------------
4479 -- Check_Programming_Languages --
4480 ---------------------------------
4482 procedure Check_Programming_Languages
4483 (In_Tree : Project_Tree_Ref;
4484 Project : Project_Id;
4485 Data : in out Project_Data)
4487 Languages : Variable_Value := Nil_Variable_Value;
4488 Def_Lang : Variable_Value := Nil_Variable_Value;
4489 Def_Lang_Id : Name_Id;
4492 Data.First_Language_Processing := No_Language_Index;
4494 Prj.Util.Value_Of (Name_Languages, Data.Decl.Attributes, In_Tree);
4497 (Name_Default_Language, Data.Decl.Attributes, In_Tree);
4498 Data.Ada_Sources_Present := Data.Source_Dirs /= Nil_String;
4499 Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String;
4501 if Data.Source_Dirs /= Nil_String then
4503 -- Check if languages are specified in this project
4505 if Languages.Default then
4507 -- Attribute Languages is not specified. So, it defaults to
4508 -- a project of the default language only.
4510 Name_List_Table.Increment_Last (In_Tree.Name_Lists);
4511 Data.Languages := Name_List_Table.Last (In_Tree.Name_Lists);
4513 -- In Ada_Only mode, the default language is Ada
4515 if Get_Mode = Ada_Only then
4516 In_Tree.Name_Lists.Table (Data.Languages) :=
4517 (Name => Name_Ada, Next => No_Name_List);
4519 -- Attribute Languages is not specified. So, it defaults to
4520 -- a project of language Ada only. No sources of languages
4523 Data.Other_Sources_Present := False;
4526 -- Fail if there is no default language defined
4528 if Def_Lang.Default then
4529 if not Default_Language_Is_Ada then
4533 "no languages defined for this project",
4535 Def_Lang_Id := No_Name;
4537 Def_Lang_Id := Name_Ada;
4541 Get_Name_String (Def_Lang.Value);
4542 To_Lower (Name_Buffer (1 .. Name_Len));
4543 Def_Lang_Id := Name_Find;
4546 if Def_Lang_Id /= No_Name then
4547 In_Tree.Name_Lists.Table (Data.Languages) :=
4548 (Name => Def_Lang_Id, Next => No_Name_List);
4550 Language_Data_Table.Increment_Last (In_Tree.Languages_Data);
4552 Data.First_Language_Processing :=
4553 Language_Data_Table.Last (In_Tree.Languages_Data);
4554 In_Tree.Languages_Data.Table
4555 (Data.First_Language_Processing) := No_Language_Data;
4556 In_Tree.Languages_Data.Table
4557 (Data.First_Language_Processing).Name := Def_Lang_Id;
4558 Get_Name_String (Def_Lang_Id);
4559 Name_Buffer (1) := GNAT.Case_Util.To_Upper (Name_Buffer (1));
4560 In_Tree.Languages_Data.Table
4561 (Data.First_Language_Processing).Display_Name := Name_Find;
4563 if Def_Lang_Id = Name_Ada then
4564 In_Tree.Languages_Data.Table
4565 (Data.First_Language_Processing).Config.Kind
4567 In_Tree.Languages_Data.Table
4568 (Data.First_Language_Processing).Config.Dependency_Kind
4570 Data.Unit_Based_Language_Name := Name_Ada;
4571 Data.Unit_Based_Language_Index :=
4572 Data.First_Language_Processing;
4574 In_Tree.Languages_Data.Table
4575 (Data.First_Language_Processing).Config.Kind
4583 Current : String_List_Id := Languages.Values;
4584 Element : String_Element;
4585 Lang_Name : Name_Id;
4586 Index : Language_Index;
4587 Lang_Data : Language_Data;
4588 NL_Id : Name_List_Index := No_Name_List;
4591 -- Assume there are no language declared
4593 Data.Ada_Sources_Present := False;
4594 Data.Other_Sources_Present := False;
4596 -- If there are no languages declared, there are no sources
4598 if Current = Nil_String then
4599 Data.Source_Dirs := Nil_String;
4601 if Data.Qualifier = Standard then
4605 "a standard project cannot have no language declared",
4606 Languages.Location);
4610 -- Look through all the languages specified in attribute
4613 while Current /= Nil_String loop
4615 In_Tree.String_Elements.Table (Current);
4616 Get_Name_String (Element.Value);
4617 To_Lower (Name_Buffer (1 .. Name_Len));
4618 Lang_Name := Name_Find;
4620 NL_Id := Data.Languages;
4621 while NL_Id /= No_Name_List loop
4623 Lang_Name = In_Tree.Name_Lists.Table (NL_Id).Name;
4624 NL_Id := In_Tree.Name_Lists.Table (NL_Id).Next;
4627 if NL_Id = No_Name_List then
4628 Name_List_Table.Increment_Last (In_Tree.Name_Lists);
4630 if Data.Languages = No_Name_List then
4632 Name_List_Table.Last (In_Tree.Name_Lists);
4635 NL_Id := Data.Languages;
4636 while In_Tree.Name_Lists.Table (NL_Id).Next /=
4639 NL_Id := In_Tree.Name_Lists.Table (NL_Id).Next;
4642 In_Tree.Name_Lists.Table (NL_Id).Next :=
4643 Name_List_Table.Last (In_Tree.Name_Lists);
4646 NL_Id := Name_List_Table.Last (In_Tree.Name_Lists);
4647 In_Tree.Name_Lists.Table (NL_Id) :=
4648 (Lang_Name, No_Name_List);
4650 if Get_Mode = Ada_Only then
4651 -- Check for language Ada
4653 if Lang_Name = Name_Ada then
4654 Data.Ada_Sources_Present := True;
4657 Data.Other_Sources_Present := True;
4661 Language_Data_Table.Increment_Last
4662 (In_Tree.Languages_Data);
4664 Language_Data_Table.Last (In_Tree.Languages_Data);
4665 Lang_Data.Name := Lang_Name;
4666 Lang_Data.Display_Name := Element.Value;
4667 Lang_Data.Next := Data.First_Language_Processing;
4669 if Lang_Name = Name_Ada then
4670 Lang_Data.Config.Kind := Unit_Based;
4671 Lang_Data.Config.Dependency_Kind := ALI_File;
4672 Data.Unit_Based_Language_Name := Name_Ada;
4673 Data.Unit_Based_Language_Index := Index;
4676 Lang_Data.Config.Kind := File_Based;
4677 Lang_Data.Config.Dependency_Kind := None;
4680 In_Tree.Languages_Data.Table (Index) := Lang_Data;
4681 Data.First_Language_Processing := Index;
4685 Current := Element.Next;
4691 end Check_Programming_Languages;
4697 function Check_Project
4699 Root_Project : Project_Id;
4700 In_Tree : Project_Tree_Ref;
4701 Extending : Boolean) return Boolean
4704 if P = Root_Project then
4707 elsif Extending then
4709 Data : Project_Data := In_Tree.Projects.Table (Root_Project);
4712 while Data.Extends /= No_Project loop
4713 if P = Data.Extends then
4717 Data := In_Tree.Projects.Table (Data.Extends);
4725 -------------------------------
4726 -- Check_Stand_Alone_Library --
4727 -------------------------------
4729 procedure Check_Stand_Alone_Library
4730 (Project : Project_Id;
4731 In_Tree : Project_Tree_Ref;
4732 Data : in out Project_Data;
4733 Current_Dir : String;
4734 Extending : Boolean)
4736 Lib_Interfaces : constant Prj.Variable_Value :=
4738 (Snames.Name_Library_Interface,
4739 Data.Decl.Attributes,
4742 Lib_Auto_Init : constant Prj.Variable_Value :=
4744 (Snames.Name_Library_Auto_Init,
4745 Data.Decl.Attributes,
4748 Lib_Src_Dir : constant Prj.Variable_Value :=
4750 (Snames.Name_Library_Src_Dir,
4751 Data.Decl.Attributes,
4754 Lib_Symbol_File : constant Prj.Variable_Value :=
4756 (Snames.Name_Library_Symbol_File,
4757 Data.Decl.Attributes,
4760 Lib_Symbol_Policy : constant Prj.Variable_Value :=
4762 (Snames.Name_Library_Symbol_Policy,
4763 Data.Decl.Attributes,
4766 Lib_Ref_Symbol_File : constant Prj.Variable_Value :=
4768 (Snames.Name_Library_Reference_Symbol_File,
4769 Data.Decl.Attributes,
4772 Auto_Init_Supported : Boolean;
4773 OK : Boolean := True;
4775 Next_Proj : Project_Id;
4778 if Get_Mode = Multi_Language then
4779 Auto_Init_Supported := Data.Config.Auto_Init_Supported;
4781 Auto_Init_Supported :=
4782 MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported;
4785 pragma Assert (Lib_Interfaces.Kind = List);
4787 -- It is a stand-alone library project file if attribute
4788 -- Library_Interface is defined.
4790 if not Lib_Interfaces.Default then
4791 SAL_Library : declare
4792 Interfaces : String_List_Id := Lib_Interfaces.Values;
4793 Interface_ALIs : String_List_Id := Nil_String;
4795 The_Unit_Id : Unit_Index;
4796 The_Unit_Data : Unit_Data;
4798 procedure Add_ALI_For (Source : File_Name_Type);
4799 -- Add an ALI file name to the list of Interface ALIs
4805 procedure Add_ALI_For (Source : File_Name_Type) is
4807 Get_Name_String (Source);
4810 ALI : constant String :=
4811 ALI_File_Name (Name_Buffer (1 .. Name_Len));
4812 ALI_Name_Id : Name_Id;
4815 Name_Len := ALI'Length;
4816 Name_Buffer (1 .. Name_Len) := ALI;
4817 ALI_Name_Id := Name_Find;
4819 String_Element_Table.Increment_Last
4820 (In_Tree.String_Elements);
4821 In_Tree.String_Elements.Table
4822 (String_Element_Table.Last
4823 (In_Tree.String_Elements)) :=
4824 (Value => ALI_Name_Id,
4826 Display_Value => ALI_Name_Id,
4828 In_Tree.String_Elements.Table
4829 (Interfaces).Location,
4831 Next => Interface_ALIs);
4832 Interface_ALIs := String_Element_Table.Last
4833 (In_Tree.String_Elements);
4837 -- Start of processing for SAL_Library
4840 Data.Standalone_Library := True;
4842 -- Library_Interface cannot be an empty list
4844 if Interfaces = Nil_String then
4847 "Library_Interface cannot be an empty list",
4848 Lib_Interfaces.Location);
4851 -- Process each unit name specified in the attribute
4852 -- Library_Interface.
4854 while Interfaces /= Nil_String loop
4856 (In_Tree.String_Elements.Table (Interfaces).Value);
4857 To_Lower (Name_Buffer (1 .. Name_Len));
4859 if Name_Len = 0 then
4862 "an interface cannot be an empty string",
4863 In_Tree.String_Elements.Table (Interfaces).Location);
4867 Error_Msg_Name_1 := Unit;
4869 if Get_Mode = Ada_Only then
4871 Units_Htable.Get (In_Tree.Units_HT, Unit);
4873 if The_Unit_Id = No_Unit_Index then
4877 In_Tree.String_Elements.Table
4878 (Interfaces).Location);
4881 -- Check that the unit is part of the project
4884 In_Tree.Units.Table (The_Unit_Id);
4886 if The_Unit_Data.File_Names (Body_Part).Name /= No_File
4887 and then The_Unit_Data.File_Names
4888 (Body_Part).Path.Name /= Slash
4891 (The_Unit_Data.File_Names (Body_Part).Project,
4892 Project, In_Tree, Extending)
4894 -- There is a body for this unit.
4895 -- If there is no spec, we need to check
4896 -- that it is not a subunit.
4898 if The_Unit_Data.File_Names
4899 (Specification).Name = No_File
4902 Src_Ind : Source_File_Index;
4905 Src_Ind := Sinput.P.Load_Project_File
4907 (The_Unit_Data.File_Names
4908 (Body_Part).Path.Name));
4910 if Sinput.P.Source_File_Is_Subunit
4915 "%% is a subunit; " &
4916 "it cannot be an interface",
4918 String_Elements.Table
4919 (Interfaces).Location);
4924 -- The unit is not a subunit, so we add
4925 -- to the Interface ALIs the ALI file
4926 -- corresponding to the body.
4929 (The_Unit_Data.File_Names (Body_Part).Name);
4934 "%% is not an unit of this project",
4935 In_Tree.String_Elements.Table
4936 (Interfaces).Location);
4939 elsif The_Unit_Data.File_Names
4940 (Specification).Name /= No_File
4941 and then The_Unit_Data.File_Names
4942 (Specification).Path.Name /= Slash
4943 and then Check_Project
4944 (The_Unit_Data.File_Names
4945 (Specification).Project,
4946 Project, In_Tree, Extending)
4949 -- The unit is part of the project, it has
4950 -- a spec, but no body. We add to the Interface
4951 -- ALIs the ALI file corresponding to the spec.
4954 (The_Unit_Data.File_Names (Specification).Name);
4959 "%% is not an unit of this project",
4960 In_Tree.String_Elements.Table
4961 (Interfaces).Location);
4966 -- Multi_Language mode
4968 Next_Proj := Data.Extends;
4969 Source := Data.First_Source;
4972 while Source /= No_Source and then
4973 In_Tree.Sources.Table (Source).Unit /= Unit
4976 In_Tree.Sources.Table (Source).Next_In_Project;
4979 exit when Source /= No_Source or else
4980 Next_Proj = No_Project;
4983 In_Tree.Projects.Table (Next_Proj).First_Source;
4985 In_Tree.Projects.Table (Next_Proj).Extends;
4988 if Source /= No_Source then
4989 if In_Tree.Sources.Table (Source).Kind = Sep then
4990 Source := No_Source;
4992 elsif In_Tree.Sources.Table (Source).Kind = Spec
4994 In_Tree.Sources.Table (Source).Other_Part /=
4997 Source := In_Tree.Sources.Table (Source).Other_Part;
5001 if Source /= No_Source then
5002 if In_Tree.Sources.Table (Source).Project /= Project
5006 In_Tree.Sources.Table (Source).Project,
5009 Source := No_Source;
5013 if Source = No_Source then
5016 "%% is not an unit of this project",
5017 In_Tree.String_Elements.Table
5018 (Interfaces).Location);
5021 if In_Tree.Sources.Table (Source).Kind = Spec and then
5022 In_Tree.Sources.Table (Source).Other_Part /=
5025 Source := In_Tree.Sources.Table (Source).Other_Part;
5028 String_Element_Table.Increment_Last
5029 (In_Tree.String_Elements);
5030 In_Tree.String_Elements.Table
5031 (String_Element_Table.Last
5032 (In_Tree.String_Elements)) :=
5034 Name_Id (In_Tree.Sources.Table (Source).Dep_Name),
5037 Name_Id (In_Tree.Sources.Table (Source).Dep_Name),
5039 In_Tree.String_Elements.Table
5040 (Interfaces).Location,
5042 Next => Interface_ALIs);
5043 Interface_ALIs := String_Element_Table.Last
5044 (In_Tree.String_Elements);
5052 In_Tree.String_Elements.Table (Interfaces).Next;
5055 -- Put the list of Interface ALIs in the project data
5057 Data.Lib_Interface_ALIs := Interface_ALIs;
5059 -- Check value of attribute Library_Auto_Init and set
5060 -- Lib_Auto_Init accordingly.
5062 if Lib_Auto_Init.Default then
5064 -- If no attribute Library_Auto_Init is declared, then set auto
5065 -- init only if it is supported.
5067 Data.Lib_Auto_Init := Auto_Init_Supported;
5070 Get_Name_String (Lib_Auto_Init.Value);
5071 To_Lower (Name_Buffer (1 .. Name_Len));
5073 if Name_Buffer (1 .. Name_Len) = "false" then
5074 Data.Lib_Auto_Init := False;
5076 elsif Name_Buffer (1 .. Name_Len) = "true" then
5077 if Auto_Init_Supported then
5078 Data.Lib_Auto_Init := True;
5081 -- Library_Auto_Init cannot be "true" if auto init is not
5086 "library auto init not supported " &
5088 Lib_Auto_Init.Location);
5094 "invalid value for attribute Library_Auto_Init",
5095 Lib_Auto_Init.Location);
5100 -- If attribute Library_Src_Dir is defined and not the empty string,
5101 -- check if the directory exist and is not the object directory or
5102 -- one of the source directories. This is the directory where copies
5103 -- of the interface sources will be copied. Note that this directory
5104 -- may be the library directory.
5106 if Lib_Src_Dir.Value /= Empty_String then
5108 Dir_Id : constant File_Name_Type :=
5109 File_Name_Type (Lib_Src_Dir.Value);
5116 Data.Directory.Display_Name,
5117 Data.Library_Src_Dir.Name,
5118 Data.Library_Src_Dir.Display_Name,
5119 Create => "library source copy",
5120 Current_Dir => Current_Dir,
5121 Location => Lib_Src_Dir.Location,
5122 Externally_Built => Data.Externally_Built);
5124 -- If directory does not exist, report an error
5126 if Data.Library_Src_Dir = No_Path_Information then
5128 -- Get the absolute name of the library directory that does
5129 -- not exist, to report an error.
5132 Dir_Name : constant String :=
5133 Get_Name_String (Dir_Id);
5136 if Is_Absolute_Path (Dir_Name) then
5137 Err_Vars.Error_Msg_File_1 := Dir_Id;
5140 Get_Name_String (Data.Directory.Name);
5142 if Name_Buffer (Name_Len) /=
5145 Name_Len := Name_Len + 1;
5146 Name_Buffer (Name_Len) :=
5147 Directory_Separator;
5152 Name_Len + Dir_Name'Length) :=
5154 Name_Len := Name_Len + Dir_Name'Length;
5155 Err_Vars.Error_Msg_Name_1 := Name_Find;
5160 Error_Msg_File_1 := Dir_Id;
5163 "Directory { does not exist",
5164 Lib_Src_Dir.Location);
5167 -- Report error if it is the same as the object directory
5169 elsif Data.Library_Src_Dir = Data.Object_Directory then
5172 "directory to copy interfaces cannot be " &
5173 "the object directory",
5174 Lib_Src_Dir.Location);
5175 Data.Library_Src_Dir := No_Path_Information;
5179 Src_Dirs : String_List_Id;
5180 Src_Dir : String_Element;
5183 -- Interface copy directory cannot be one of the source
5184 -- directory of the current project.
5186 Src_Dirs := Data.Source_Dirs;
5187 while Src_Dirs /= Nil_String loop
5188 Src_Dir := In_Tree.String_Elements.Table (Src_Dirs);
5190 -- Report error if it is one of the source directories
5192 if Data.Library_Src_Dir.Name =
5193 Path_Name_Type (Src_Dir.Value)
5197 "directory to copy interfaces cannot " &
5198 "be one of the source directories",
5199 Lib_Src_Dir.Location);
5200 Data.Library_Src_Dir := No_Path_Information;
5204 Src_Dirs := Src_Dir.Next;
5207 if Data.Library_Src_Dir /= No_Path_Information then
5209 -- It cannot be a source directory of any other
5212 Project_Loop : for Pid in 1 ..
5213 Project_Table.Last (In_Tree.Projects)
5216 In_Tree.Projects.Table (Pid).Source_Dirs;
5217 Dir_Loop : while Src_Dirs /= Nil_String loop
5219 In_Tree.String_Elements.Table (Src_Dirs);
5221 -- Report error if it is one of the source
5224 if Data.Library_Src_Dir.Name =
5225 Path_Name_Type (Src_Dir.Value)
5228 File_Name_Type (Src_Dir.Value);
5230 In_Tree.Projects.Table (Pid).Name;
5233 "directory to copy interfaces cannot " &
5234 "be the same as source directory { of " &
5236 Lib_Src_Dir.Location);
5237 Data.Library_Src_Dir := No_Path_Information;
5241 Src_Dirs := Src_Dir.Next;
5243 end loop Project_Loop;
5247 -- In high verbosity, if there is a valid Library_Src_Dir,
5248 -- display its path name.
5250 if Data.Library_Src_Dir /= No_Path_Information
5251 and then Current_Verbosity = High
5253 Write_Str ("Directory to copy interfaces =""");
5254 Write_Str (Get_Name_String (Data.Library_Src_Dir.Name));
5261 -- Check the symbol related attributes
5263 -- First, the symbol policy
5265 if not Lib_Symbol_Policy.Default then
5267 Value : constant String :=
5269 (Get_Name_String (Lib_Symbol_Policy.Value));
5272 -- Symbol policy must hove one of a limited number of values
5274 if Value = "autonomous" or else Value = "default" then
5275 Data.Symbol_Data.Symbol_Policy := Autonomous;
5277 elsif Value = "compliant" then
5278 Data.Symbol_Data.Symbol_Policy := Compliant;
5280 elsif Value = "controlled" then
5281 Data.Symbol_Data.Symbol_Policy := Controlled;
5283 elsif Value = "restricted" then
5284 Data.Symbol_Data.Symbol_Policy := Restricted;
5286 elsif Value = "direct" then
5287 Data.Symbol_Data.Symbol_Policy := Direct;
5292 "illegal value for Library_Symbol_Policy",
5293 Lib_Symbol_Policy.Location);
5298 -- If attribute Library_Symbol_File is not specified, symbol policy
5299 -- cannot be Restricted.
5301 if Lib_Symbol_File.Default then
5302 if Data.Symbol_Data.Symbol_Policy = Restricted then
5305 "Library_Symbol_File needs to be defined when " &
5306 "symbol policy is Restricted",
5307 Lib_Symbol_Policy.Location);
5311 -- Library_Symbol_File is defined
5313 Data.Symbol_Data.Symbol_File :=
5314 Path_Name_Type (Lib_Symbol_File.Value);
5316 Get_Name_String (Lib_Symbol_File.Value);
5318 if Name_Len = 0 then
5321 "symbol file name cannot be an empty string",
5322 Lib_Symbol_File.Location);
5325 OK := not Is_Absolute_Path (Name_Buffer (1 .. Name_Len));
5328 for J in 1 .. Name_Len loop
5329 if Name_Buffer (J) = '/'
5330 or else Name_Buffer (J) = Directory_Separator
5339 Error_Msg_File_1 := File_Name_Type (Lib_Symbol_File.Value);
5342 "symbol file name { is illegal. " &
5343 "Name cannot include directory info.",
5344 Lib_Symbol_File.Location);
5349 -- If attribute Library_Reference_Symbol_File is not defined,
5350 -- symbol policy cannot be Compliant or Controlled.
5352 if Lib_Ref_Symbol_File.Default then
5353 if Data.Symbol_Data.Symbol_Policy = Compliant
5354 or else Data.Symbol_Data.Symbol_Policy = Controlled
5358 "a reference symbol file needs to be defined",
5359 Lib_Symbol_Policy.Location);
5363 -- Library_Reference_Symbol_File is defined, check file exists
5365 Data.Symbol_Data.Reference :=
5366 Path_Name_Type (Lib_Ref_Symbol_File.Value);
5368 Get_Name_String (Lib_Ref_Symbol_File.Value);
5370 if Name_Len = 0 then
5373 "reference symbol file name cannot be an empty string",
5374 Lib_Symbol_File.Location);
5377 if not Is_Absolute_Path (Name_Buffer (1 .. Name_Len)) then
5379 Add_Str_To_Name_Buffer
5380 (Get_Name_String (Data.Directory.Name));
5381 Add_Char_To_Name_Buffer (Directory_Separator);
5382 Add_Str_To_Name_Buffer
5383 (Get_Name_String (Lib_Ref_Symbol_File.Value));
5384 Data.Symbol_Data.Reference := Name_Find;
5387 if not Is_Regular_File
5388 (Get_Name_String (Data.Symbol_Data.Reference))
5391 File_Name_Type (Lib_Ref_Symbol_File.Value);
5393 -- For controlled and direct symbol policies, it is an error
5394 -- if the reference symbol file does not exist. For other
5395 -- symbol policies, this is just a warning
5398 Data.Symbol_Data.Symbol_Policy /= Controlled
5399 and then Data.Symbol_Data.Symbol_Policy /= Direct;
5403 "<library reference symbol file { does not exist",
5404 Lib_Ref_Symbol_File.Location);
5406 -- In addition in the non-controlled case, if symbol policy
5407 -- is Compliant, it is changed to Autonomous, because there
5408 -- is no reference to check against, and we don't want to
5409 -- fail in this case.
5411 if Data.Symbol_Data.Symbol_Policy /= Controlled then
5412 if Data.Symbol_Data.Symbol_Policy = Compliant then
5413 Data.Symbol_Data.Symbol_Policy := Autonomous;
5418 -- If both the reference symbol file and the symbol file are
5419 -- defined, then check that they are not the same file.
5421 if Data.Symbol_Data.Symbol_File /= No_Path then
5422 Get_Name_String (Data.Symbol_Data.Symbol_File);
5424 if Name_Len > 0 then
5426 Symb_Path : constant String :=
5429 (Data.Object_Directory.Name) &
5430 Directory_Separator &
5431 Name_Buffer (1 .. Name_Len),
5432 Directory => Current_Dir,
5434 Opt.Follow_Links_For_Files);
5435 Ref_Path : constant String :=
5438 (Data.Symbol_Data.Reference),
5439 Directory => Current_Dir,
5441 Opt.Follow_Links_For_Files);
5443 if Symb_Path = Ref_Path then
5446 "library reference symbol file and library" &
5447 " symbol file cannot be the same file",
5448 Lib_Ref_Symbol_File.Location);
5456 end Check_Stand_Alone_Library;
5458 ----------------------------
5459 -- Compute_Directory_Last --
5460 ----------------------------
5462 function Compute_Directory_Last (Dir : String) return Natural is
5465 and then (Dir (Dir'Last - 1) = Directory_Separator
5466 or else Dir (Dir'Last - 1) = '/')
5468 return Dir'Last - 1;
5472 end Compute_Directory_Last;
5479 (Project : Project_Id;
5480 In_Tree : Project_Tree_Ref;
5482 Flag_Location : Source_Ptr)
5484 Real_Location : Source_Ptr := Flag_Location;
5485 Error_Buffer : String (1 .. 5_000);
5486 Error_Last : Natural := 0;
5487 Name_Number : Natural := 0;
5488 File_Number : Natural := 0;
5489 First : Positive := Msg'First;
5492 procedure Add (C : Character);
5493 -- Add a character to the buffer
5495 procedure Add (S : String);
5496 -- Add a string to the buffer
5499 -- Add a name to the buffer
5502 -- Add a file name to the buffer
5508 procedure Add (C : Character) is
5510 Error_Last := Error_Last + 1;
5511 Error_Buffer (Error_Last) := C;
5514 procedure Add (S : String) is
5516 Error_Buffer (Error_Last + 1 .. Error_Last + S'Length) := S;
5517 Error_Last := Error_Last + S'Length;
5524 procedure Add_File is
5525 File : File_Name_Type;
5529 File_Number := File_Number + 1;
5533 File := Err_Vars.Error_Msg_File_1;
5535 File := Err_Vars.Error_Msg_File_2;
5537 File := Err_Vars.Error_Msg_File_3;
5542 Get_Name_String (File);
5543 Add (Name_Buffer (1 .. Name_Len));
5551 procedure Add_Name is
5556 Name_Number := Name_Number + 1;
5560 Name := Err_Vars.Error_Msg_Name_1;
5562 Name := Err_Vars.Error_Msg_Name_2;
5564 Name := Err_Vars.Error_Msg_Name_3;
5569 Get_Name_String (Name);
5570 Add (Name_Buffer (1 .. Name_Len));
5574 -- Start of processing for Error_Msg
5577 -- If location of error is unknown, use the location of the project
5579 if Real_Location = No_Location then
5580 Real_Location := In_Tree.Projects.Table (Project).Location;
5583 if Error_Report = null then
5584 Prj.Err.Error_Msg (Msg, Real_Location);
5588 -- Ignore continuation character
5590 if Msg (First) = '\' then
5594 -- Warning character is always the first one in this package
5595 -- this is an undocumented kludge???
5597 if Msg (First) = '?' then
5601 elsif Msg (First) = '<' then
5604 if Err_Vars.Error_Msg_Warn then
5610 while Index <= Msg'Last loop
5611 if Msg (Index) = '{' then
5614 elsif Msg (Index) = '%' then
5615 if Index < Msg'Last and then Msg (Index + 1) = '%' then
5627 Error_Report (Error_Buffer (1 .. Error_Last), Project, In_Tree);
5630 ----------------------
5631 -- Find_Ada_Sources --
5632 ----------------------
5634 procedure Find_Ada_Sources
5635 (Project : Project_Id;
5636 In_Tree : Project_Tree_Ref;
5637 Data : in out Project_Data;
5638 Current_Dir : String)
5640 Source_Dir : String_List_Id := Data.Source_Dirs;
5641 Element : String_Element;
5643 Current_Source : String_List_Id := Nil_String;
5644 Source_Recorded : Boolean := False;
5647 if Current_Verbosity = High then
5648 Write_Line ("Looking for sources:");
5651 -- For each subdirectory
5653 while Source_Dir /= Nil_String loop
5655 Source_Recorded := False;
5656 Element := In_Tree.String_Elements.Table (Source_Dir);
5657 if Element.Value /= No_Name then
5658 Get_Name_String (Element.Display_Value);
5661 Source_Directory : constant String :=
5662 Name_Buffer (1 .. Name_Len) & Directory_Separator;
5663 Dir_Last : constant Natural :=
5664 Compute_Directory_Last (Source_Directory);
5667 if Current_Verbosity = High then
5668 Write_Str ("Source_Dir = ");
5669 Write_Line (Source_Directory);
5672 -- We look at every entry in the source directory
5675 Source_Directory (Source_Directory'First .. Dir_Last));
5678 Read (Dir, Name_Buffer, Name_Len);
5680 if Current_Verbosity = High then
5681 Write_Str (" Checking ");
5682 Write_Line (Name_Buffer (1 .. Name_Len));
5685 exit when Name_Len = 0;
5688 File_Name : constant File_Name_Type := Name_Find;
5690 -- ??? We could probably optimize the following call:
5691 -- we need to resolve links only once for the
5692 -- directory itself, and then do a single call to
5693 -- readlink() for each file. Unfortunately that would
5694 -- require a change in Normalize_Pathname so that it
5695 -- has the option of not resolving links for its
5696 -- Directory parameter, only for Name.
5698 Path : constant String :=
5700 (Name => Name_Buffer (1 .. Name_Len),
5703 (Source_Directory'First .. Dir_Last),
5705 Opt.Follow_Links_For_Files,
5706 Case_Sensitive => True);
5708 Path_Name : Path_Name_Type;
5711 Name_Len := Path'Length;
5712 Name_Buffer (1 .. Name_Len) := Path;
5713 Path_Name := Name_Find;
5715 -- We attempt to register it as a source. However,
5716 -- there is no error if the file does not contain a
5717 -- valid source. But there is an error if we have a
5718 -- duplicate unit name.
5721 (File_Name => File_Name,
5722 Path_Name => Path_Name,
5726 Location => No_Location,
5727 Current_Source => Current_Source,
5728 Source_Recorded => Source_Recorded,
5729 Current_Dir => Current_Dir);
5738 when Directory_Error =>
5742 if Source_Recorded then
5743 In_Tree.String_Elements.Table (Source_Dir).Flag :=
5747 Source_Dir := Element.Next;
5750 if Current_Verbosity = High then
5751 Write_Line ("end Looking for sources.");
5754 end Find_Ada_Sources;
5756 --------------------------------
5757 -- Free_Ada_Naming_Exceptions --
5758 --------------------------------
5760 procedure Free_Ada_Naming_Exceptions is
5762 Ada_Naming_Exception_Table.Set_Last (0);
5763 Ada_Naming_Exceptions.Reset;
5764 Reverse_Ada_Naming_Exceptions.Reset;
5765 end Free_Ada_Naming_Exceptions;
5767 ---------------------
5768 -- Get_Directories --
5769 ---------------------
5771 procedure Get_Directories
5772 (Project : Project_Id;
5773 In_Tree : Project_Tree_Ref;
5774 Current_Dir : String;
5775 Data : in out Project_Data)
5777 Object_Dir : constant Variable_Value :=
5779 (Name_Object_Dir, Data.Decl.Attributes, In_Tree);
5781 Exec_Dir : constant Variable_Value :=
5783 (Name_Exec_Dir, Data.Decl.Attributes, In_Tree);
5785 Source_Dirs : constant Variable_Value :=
5787 (Name_Source_Dirs, Data.Decl.Attributes, In_Tree);
5789 Excluded_Source_Dirs : constant Variable_Value :=
5791 (Name_Excluded_Source_Dirs,
5792 Data.Decl.Attributes,
5795 Source_Files : constant Variable_Value :=
5797 (Name_Source_Files, Data.Decl.Attributes, In_Tree);
5799 Languages : constant Variable_Value :=
5801 (Name_Languages, Data.Decl.Attributes, In_Tree);
5803 Last_Source_Dir : String_List_Id := Nil_String;
5805 procedure Find_Source_Dirs
5806 (From : File_Name_Type;
5807 Location : Source_Ptr;
5808 Removed : Boolean := False);
5809 -- Find one or several source directories, and add (or remove, if
5810 -- Removed is True) them to list of source directories of the project.
5812 ----------------------
5813 -- Find_Source_Dirs --
5814 ----------------------
5816 procedure Find_Source_Dirs
5817 (From : File_Name_Type;
5818 Location : Source_Ptr;
5819 Removed : Boolean := False)
5821 Directory : constant String := Get_Name_String (From);
5822 Element : String_Element;
5824 procedure Recursive_Find_Dirs (Path : Name_Id);
5825 -- Find all the subdirectories (recursively) of Path and add them
5826 -- to the list of source directories of the project.
5828 -------------------------
5829 -- Recursive_Find_Dirs --
5830 -------------------------
5832 procedure Recursive_Find_Dirs (Path : Name_Id) is
5834 Name : String (1 .. 250);
5836 List : String_List_Id;
5837 Prev : String_List_Id;
5838 Element : String_Element;
5839 Found : Boolean := False;
5841 Non_Canonical_Path : Name_Id := No_Name;
5842 Canonical_Path : Name_Id := No_Name;
5844 The_Path : constant String :=
5846 (Get_Name_String (Path),
5847 Directory => Current_Dir,
5848 Resolve_Links => Opt.Follow_Links_For_Dirs) &
5849 Directory_Separator;
5851 The_Path_Last : constant Natural :=
5852 Compute_Directory_Last (The_Path);
5855 Name_Len := The_Path_Last - The_Path'First + 1;
5856 Name_Buffer (1 .. Name_Len) :=
5857 The_Path (The_Path'First .. The_Path_Last);
5858 Non_Canonical_Path := Name_Find;
5860 if Osint.File_Names_Case_Sensitive then
5861 Canonical_Path := Non_Canonical_Path;
5863 Get_Name_String (Non_Canonical_Path);
5864 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
5865 Canonical_Path := Name_Find;
5868 -- To avoid processing the same directory several times, check
5869 -- if the directory is already in Recursive_Dirs. If it is, then
5870 -- there is nothing to do, just return. If it is not, put it there
5871 -- and continue recursive processing.
5874 if Recursive_Dirs.Get (Canonical_Path) then
5877 Recursive_Dirs.Set (Canonical_Path, True);
5881 -- Check if directory is already in list
5883 List := Data.Source_Dirs;
5885 while List /= Nil_String loop
5886 Element := In_Tree.String_Elements.Table (List);
5888 if Element.Value /= No_Name then
5889 Found := Element.Value = Canonical_Path;
5894 List := Element.Next;
5897 -- If directory is not already in list, put it there
5899 if (not Removed) and (not Found) then
5900 if Current_Verbosity = High then
5902 Write_Line (The_Path (The_Path'First .. The_Path_Last));
5905 String_Element_Table.Increment_Last
5906 (In_Tree.String_Elements);
5908 (Value => Canonical_Path,
5909 Display_Value => Non_Canonical_Path,
5910 Location => No_Location,
5915 -- Case of first source directory
5917 if Last_Source_Dir = Nil_String then
5918 Data.Source_Dirs := String_Element_Table.Last
5919 (In_Tree.String_Elements);
5921 -- Here we already have source directories
5924 -- Link the previous last to the new one
5926 In_Tree.String_Elements.Table
5927 (Last_Source_Dir).Next :=
5928 String_Element_Table.Last
5929 (In_Tree.String_Elements);
5932 -- And register this source directory as the new last
5934 Last_Source_Dir := String_Element_Table.Last
5935 (In_Tree.String_Elements);
5936 In_Tree.String_Elements.Table (Last_Source_Dir) :=
5939 elsif Removed and Found then
5940 if Prev = Nil_String then
5942 In_Tree.String_Elements.Table (List).Next;
5944 In_Tree.String_Elements.Table (Prev).Next :=
5945 In_Tree.String_Elements.Table (List).Next;
5949 -- Now look for subdirectories. We do that even when this
5950 -- directory is already in the list, because some of its
5951 -- subdirectories may not be in the list yet.
5953 Open (Dir, The_Path (The_Path'First .. The_Path_Last));
5956 Read (Dir, Name, Last);
5959 if Name (1 .. Last) /= "."
5960 and then Name (1 .. Last) /= ".."
5962 -- Avoid . and .. directories
5964 if Current_Verbosity = High then
5965 Write_Str (" Checking ");
5966 Write_Line (Name (1 .. Last));
5970 Path_Name : constant String :=
5972 (Name => Name (1 .. Last),
5974 The_Path (The_Path'First .. The_Path_Last),
5975 Resolve_Links => Opt.Follow_Links_For_Dirs,
5976 Case_Sensitive => True);
5979 if Is_Directory (Path_Name) then
5980 -- We have found a new subdirectory, call self
5982 Name_Len := Path_Name'Length;
5983 Name_Buffer (1 .. Name_Len) := Path_Name;
5984 Recursive_Find_Dirs (Name_Find);
5993 when Directory_Error =>
5995 end Recursive_Find_Dirs;
5997 -- Start of processing for Find_Source_Dirs
6000 if Current_Verbosity = High and then not Removed then
6001 Write_Str ("Find_Source_Dirs (""");
6002 Write_Str (Directory);
6006 -- First, check if we are looking for a directory tree, indicated
6007 -- by "/**" at the end.
6009 if Directory'Length >= 3
6010 and then Directory (Directory'Last - 1 .. Directory'Last) = "**"
6011 and then (Directory (Directory'Last - 2) = '/'
6013 Directory (Directory'Last - 2) = Directory_Separator)
6016 Data.Known_Order_Of_Source_Dirs := False;
6019 Name_Len := Directory'Length - 3;
6021 if Name_Len = 0 then
6023 -- Case of "/**": all directories in file system
6026 Name_Buffer (1) := Directory (Directory'First);
6029 Name_Buffer (1 .. Name_Len) :=
6030 Directory (Directory'First .. Directory'Last - 3);
6033 if Current_Verbosity = High then
6034 Write_Str ("Looking for all subdirectories of """);
6035 Write_Str (Name_Buffer (1 .. Name_Len));
6040 Base_Dir : constant File_Name_Type := Name_Find;
6041 Root_Dir : constant String :=
6043 (Name => Get_Name_String (Base_Dir),
6045 Get_Name_String (Data.Directory.Display_Name),
6046 Resolve_Links => False,
6047 Case_Sensitive => True);
6050 if Root_Dir'Length = 0 then
6051 Err_Vars.Error_Msg_File_1 := Base_Dir;
6053 if Location = No_Location then
6056 "{ is not a valid directory.",
6061 "{ is not a valid directory.",
6066 -- We have an existing directory, we register it and all of
6067 -- its subdirectories.
6069 if Current_Verbosity = High then
6070 Write_Line ("Looking for source directories:");
6073 Name_Len := Root_Dir'Length;
6074 Name_Buffer (1 .. Name_Len) := Root_Dir;
6075 Recursive_Find_Dirs (Name_Find);
6077 if Current_Verbosity = High then
6078 Write_Line ("End of looking for source directories.");
6083 -- We have a single directory
6087 Path_Name : Path_Name_Type;
6088 Display_Path_Name : Path_Name_Type;
6089 List : String_List_Id;
6090 Prev : String_List_Id;
6094 (Project => Project,
6097 Parent => Data.Directory.Display_Name,
6099 Display => Display_Path_Name,
6100 Current_Dir => Current_Dir);
6102 if Path_Name = No_Path then
6103 Err_Vars.Error_Msg_File_1 := From;
6105 if Location = No_Location then
6108 "{ is not a valid directory",
6113 "{ is not a valid directory",
6119 Path : constant String :=
6120 Get_Name_String (Path_Name) &
6121 Directory_Separator;
6122 Last_Path : constant Natural :=
6123 Compute_Directory_Last (Path);
6125 Display_Path : constant String :=
6127 (Display_Path_Name) &
6128 Directory_Separator;
6129 Last_Display_Path : constant Natural :=
6130 Compute_Directory_Last
6132 Display_Path_Id : Name_Id;
6136 Add_Str_To_Name_Buffer (Path (Path'First .. Last_Path));
6137 Path_Id := Name_Find;
6139 Add_Str_To_Name_Buffer
6141 (Display_Path'First .. Last_Display_Path));
6142 Display_Path_Id := Name_Find;
6146 -- As it is an existing directory, we add it to the
6147 -- list of directories.
6149 String_Element_Table.Increment_Last
6150 (In_Tree.String_Elements);
6154 Display_Value => Display_Path_Id,
6155 Location => No_Location,
6157 Next => Nil_String);
6159 if Last_Source_Dir = Nil_String then
6161 -- This is the first source directory
6163 Data.Source_Dirs := String_Element_Table.Last
6164 (In_Tree.String_Elements);
6167 -- We already have source directories, link the
6168 -- previous last to the new one.
6170 In_Tree.String_Elements.Table
6171 (Last_Source_Dir).Next :=
6172 String_Element_Table.Last
6173 (In_Tree.String_Elements);
6176 -- And register this source directory as the new last
6178 Last_Source_Dir := String_Element_Table.Last
6179 (In_Tree.String_Elements);
6180 In_Tree.String_Elements.Table
6181 (Last_Source_Dir) := Element;
6184 -- Remove source dir, if present
6186 List := Data.Source_Dirs;
6189 -- Look for source dir in current list
6191 while List /= Nil_String loop
6192 Element := In_Tree.String_Elements.Table (List);
6193 exit when Element.Value = Path_Id;
6195 List := Element.Next;
6198 if List /= Nil_String then
6199 -- Source dir was found, remove it from the list
6201 if Prev = Nil_String then
6203 In_Tree.String_Elements.Table (List).Next;
6206 In_Tree.String_Elements.Table (Prev).Next :=
6207 In_Tree.String_Elements.Table (List).Next;
6215 end Find_Source_Dirs;
6217 -- Start of processing for Get_Directories
6220 if Current_Verbosity = High then
6221 Write_Line ("Starting to look for directories");
6224 -- Set the object directory to its default which may be nil, if there
6225 -- is no sources in the project.
6227 if (((not Source_Files.Default)
6228 and then Source_Files.Values = Nil_String)
6230 ((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String)
6232 ((not Languages.Default) and then Languages.Values = Nil_String))
6233 and then Data.Extends = No_Project
6235 Data.Object_Directory := No_Path_Information;
6238 Data.Object_Directory := Data.Directory;
6241 -- Check the object directory
6243 if Object_Dir.Value /= Empty_String then
6244 Get_Name_String (Object_Dir.Value);
6246 if Name_Len = 0 then
6249 "Object_Dir cannot be empty",
6250 Object_Dir.Location);
6253 -- We check that the specified object directory does exist
6258 File_Name_Type (Object_Dir.Value),
6259 Data.Directory.Display_Name,
6260 Data.Object_Directory.Name,
6261 Data.Object_Directory.Display_Name,
6263 Location => Object_Dir.Location,
6264 Current_Dir => Current_Dir,
6265 Externally_Built => Data.Externally_Built);
6267 if Data.Object_Directory = No_Path_Information then
6269 -- The object directory does not exist, report an error if the
6270 -- project is not externally built.
6272 if not Data.Externally_Built then
6273 Err_Vars.Error_Msg_File_1 :=
6274 File_Name_Type (Object_Dir.Value);
6277 "the object directory { cannot be found",
6281 -- Do not keep a nil Object_Directory. Set it to the specified
6282 -- (relative or absolute) path. This is for the benefit of
6283 -- tools that recover from errors; for example, these tools
6284 -- could create the non existent directory.
6286 Data.Object_Directory.Display_Name :=
6287 Path_Name_Type (Object_Dir.Value);
6289 if Osint.File_Names_Case_Sensitive then
6290 Data.Object_Directory.Name :=
6291 Path_Name_Type (Object_Dir.Value);
6293 Get_Name_String (Object_Dir.Value);
6294 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6295 Data.Object_Directory.Name := Name_Find;
6300 elsif Data.Object_Directory /= No_Path_Information and then
6304 Name_Buffer (1) := '.';
6309 Data.Directory.Display_Name,
6310 Data.Object_Directory.Name,
6311 Data.Object_Directory.Display_Name,
6313 Location => Object_Dir.Location,
6314 Current_Dir => Current_Dir,
6315 Externally_Built => Data.Externally_Built);
6318 if Current_Verbosity = High then
6319 if Data.Object_Directory = No_Path_Information then
6320 Write_Line ("No object directory");
6322 Write_Str ("Object directory: """);
6323 Write_Str (Get_Name_String (Data.Object_Directory.Display_Name));
6328 -- Check the exec directory
6330 -- We set the object directory to its default
6332 Data.Exec_Directory := Data.Object_Directory;
6334 if Exec_Dir.Value /= Empty_String then
6335 Get_Name_String (Exec_Dir.Value);
6337 if Name_Len = 0 then
6340 "Exec_Dir cannot be empty",
6344 -- We check that the specified exec directory does exist
6349 File_Name_Type (Exec_Dir.Value),
6350 Data.Directory.Display_Name,
6351 Data.Exec_Directory.Name,
6352 Data.Exec_Directory.Display_Name,
6354 Location => Exec_Dir.Location,
6355 Current_Dir => Current_Dir,
6356 Externally_Built => Data.Externally_Built);
6358 if Data.Exec_Directory = No_Path_Information then
6359 Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
6362 "the exec directory { cannot be found",
6368 if Current_Verbosity = High then
6369 if Data.Exec_Directory = No_Path_Information then
6370 Write_Line ("No exec directory");
6372 Write_Str ("Exec directory: """);
6373 Write_Str (Get_Name_String (Data.Exec_Directory.Display_Name));
6378 -- Look for the source directories
6380 if Current_Verbosity = High then
6381 Write_Line ("Starting to look for source directories");
6384 pragma Assert (Source_Dirs.Kind = List, "Source_Dirs is not a list");
6386 if (not Source_Files.Default) and then
6387 Source_Files.Values = Nil_String
6389 Data.Source_Dirs := Nil_String;
6391 if Data.Qualifier = Standard then
6395 "a standard project cannot have no sources",
6396 Source_Files.Location);
6399 elsif Source_Dirs.Default then
6401 -- No Source_Dirs specified: the single source directory is the one
6402 -- containing the project file
6404 String_Element_Table.Increment_Last
6405 (In_Tree.String_Elements);
6406 Data.Source_Dirs := String_Element_Table.Last
6407 (In_Tree.String_Elements);
6408 In_Tree.String_Elements.Table (Data.Source_Dirs) :=
6409 (Value => Name_Id (Data.Directory.Name),
6410 Display_Value => Name_Id (Data.Directory.Display_Name),
6411 Location => No_Location,
6416 if Current_Verbosity = High then
6417 Write_Line ("Single source directory:");
6419 Write_Str (Get_Name_String (Data.Directory.Display_Name));
6423 elsif Source_Dirs.Values = Nil_String then
6424 if Data.Qualifier = Standard then
6428 "a standard project cannot have no source directories",
6429 Source_Dirs.Location);
6432 Data.Source_Dirs := Nil_String;
6436 Source_Dir : String_List_Id;
6437 Element : String_Element;
6440 -- Process the source directories for each element of the list
6442 Source_Dir := Source_Dirs.Values;
6443 while Source_Dir /= Nil_String loop
6444 Element := In_Tree.String_Elements.Table (Source_Dir);
6446 (File_Name_Type (Element.Value), Element.Location);
6447 Source_Dir := Element.Next;
6452 if not Excluded_Source_Dirs.Default
6453 and then Excluded_Source_Dirs.Values /= Nil_String
6456 Source_Dir : String_List_Id;
6457 Element : String_Element;
6460 -- Process the source directories for each element of the list
6462 Source_Dir := Excluded_Source_Dirs.Values;
6463 while Source_Dir /= Nil_String loop
6464 Element := In_Tree.String_Elements.Table (Source_Dir);
6466 (File_Name_Type (Element.Value),
6469 Source_Dir := Element.Next;
6474 if Current_Verbosity = High then
6475 Write_Line ("Putting source directories in canonical cases");
6479 Current : String_List_Id := Data.Source_Dirs;
6480 Element : String_Element;
6483 while Current /= Nil_String loop
6484 Element := In_Tree.String_Elements.Table (Current);
6485 if Element.Value /= No_Name then
6486 if not Osint.File_Names_Case_Sensitive then
6487 Get_Name_String (Element.Value);
6488 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6489 Element.Value := Name_Find;
6492 In_Tree.String_Elements.Table (Current) := Element;
6495 Current := Element.Next;
6498 end Get_Directories;
6505 (Project : Project_Id;
6506 In_Tree : Project_Tree_Ref;
6507 Data : in out Project_Data)
6509 Mains : constant Variable_Value :=
6510 Prj.Util.Value_Of (Name_Main, Data.Decl.Attributes, In_Tree);
6511 List : String_List_Id;
6512 Elem : String_Element;
6515 Data.Mains := Mains.Values;
6517 -- If no Mains were specified, and if we are an extending project,
6518 -- inherit the Mains from the project we are extending.
6520 if Mains.Default then
6521 if not Data.Library and then Data.Extends /= No_Project then
6523 In_Tree.Projects.Table (Data.Extends).Mains;
6526 -- In a library project file, Main cannot be specified
6528 elsif Data.Library then
6531 "a library project file cannot have Main specified",
6535 List := Mains.Values;
6536 while List /= Nil_String loop
6537 Elem := In_Tree.String_Elements.Table (List);
6539 if Length_Of_Name (Elem.Value) = 0 then
6542 "?a main cannot have an empty name",
6552 ---------------------------
6553 -- Get_Sources_From_File --
6554 ---------------------------
6556 procedure Get_Sources_From_File
6558 Location : Source_Ptr;
6559 Project : Project_Id;
6560 In_Tree : Project_Tree_Ref)
6562 File : Prj.Util.Text_File;
6563 Line : String (1 .. 250);
6565 Source_Name : File_Name_Type;
6566 Name_Loc : Name_Location;
6569 if Get_Mode = Ada_Only then
6573 if Current_Verbosity = High then
6574 Write_Str ("Opening """);
6581 Prj.Util.Open (File, Path);
6583 if not Prj.Util.Is_Valid (File) then
6584 Error_Msg (Project, In_Tree, "file does not exist", Location);
6587 -- Read the lines one by one
6589 while not Prj.Util.End_Of_File (File) loop
6590 Prj.Util.Get_Line (File, Line, Last);
6592 -- A non empty, non comment line should contain a file name
6595 and then (Last = 1 or else Line (1 .. 2) /= "--")
6598 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
6599 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
6600 Source_Name := Name_Find;
6602 -- Check that there is no directory information
6604 for J in 1 .. Last loop
6605 if Line (J) = '/' or else Line (J) = Directory_Separator then
6606 Error_Msg_File_1 := Source_Name;
6610 "file name cannot include directory information ({)",
6616 Name_Loc := Source_Names.Get (Source_Name);
6618 if Name_Loc = No_Name_Location then
6620 (Name => Source_Name,
6621 Location => Location,
6622 Source => No_Source,
6627 Source_Names.Set (Source_Name, Name_Loc);
6631 Prj.Util.Close (File);
6634 end Get_Sources_From_File;
6641 (In_Tree : Project_Tree_Ref;
6642 Canonical_File_Name : File_Name_Type;
6643 Naming : Naming_Data;
6644 Exception_Id : out Ada_Naming_Exception_Id;
6645 Unit_Name : out Name_Id;
6646 Unit_Kind : out Spec_Or_Body;
6647 Needs_Pragma : out Boolean)
6649 Info_Id : Ada_Naming_Exception_Id :=
6650 Ada_Naming_Exceptions.Get (Canonical_File_Name);
6651 VMS_Name : File_Name_Type;
6654 if Info_Id = No_Ada_Naming_Exception then
6655 if Hostparm.OpenVMS then
6656 VMS_Name := Canonical_File_Name;
6657 Get_Name_String (VMS_Name);
6659 if Name_Buffer (Name_Len) = '.' then
6660 Name_Len := Name_Len - 1;
6661 VMS_Name := Name_Find;
6664 Info_Id := Ada_Naming_Exceptions.Get (VMS_Name);
6669 if Info_Id /= No_Ada_Naming_Exception then
6670 Exception_Id := Info_Id;
6671 Unit_Name := No_Name;
6672 Unit_Kind := Specification;
6673 Needs_Pragma := True;
6677 Needs_Pragma := False;
6678 Exception_Id := No_Ada_Naming_Exception;
6680 Get_Name_String (Canonical_File_Name);
6682 -- How about some comments and a name for this declare block ???
6683 -- In fact the whole code below needs more comments ???
6686 File : String := Name_Buffer (1 .. Name_Len);
6687 First : constant Positive := File'First;
6688 Last : Natural := File'Last;
6689 Standard_GNAT : Boolean;
6690 Spec : constant File_Name_Type :=
6691 Spec_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
6692 Body_Suff : constant File_Name_Type :=
6693 Body_Suffix_Id_Of (In_Tree, Name_Ada, Naming);
6696 Standard_GNAT := Spec = Default_Ada_Spec_Suffix
6697 and then Body_Suff = Default_Ada_Body_Suffix;
6700 Spec_Suffix : constant String := Get_Name_String (Spec);
6701 Body_Suffix : constant String := Get_Name_String (Body_Suff);
6702 Sep_Suffix : constant String :=
6703 Get_Name_String (Naming.Separate_Suffix);
6705 May_Be_Spec : Boolean;
6706 May_Be_Body : Boolean;
6707 May_Be_Sep : Boolean;
6711 File'Length > Spec_Suffix'Length
6713 File (Last - Spec_Suffix'Length + 1 .. Last) = Spec_Suffix;
6716 File'Length > Body_Suffix'Length
6718 File (Last - Body_Suffix'Length + 1 .. Last) = Body_Suffix;
6721 File'Length > Sep_Suffix'Length
6723 File (Last - Sep_Suffix'Length + 1 .. Last) = Sep_Suffix;
6725 -- If two May_Be_ booleans are True, always choose the longer one
6728 if May_Be_Body and then
6729 Spec_Suffix'Length < Body_Suffix'Length
6731 Unit_Kind := Body_Part;
6733 if May_Be_Sep and then
6734 Body_Suffix'Length < Sep_Suffix'Length
6736 Last := Last - Sep_Suffix'Length;
6737 May_Be_Body := False;
6740 Last := Last - Body_Suffix'Length;
6741 May_Be_Sep := False;
6744 elsif May_Be_Sep and then
6745 Spec_Suffix'Length < Sep_Suffix'Length
6747 Unit_Kind := Body_Part;
6748 Last := Last - Sep_Suffix'Length;
6751 Unit_Kind := Specification;
6752 Last := Last - Spec_Suffix'Length;
6755 elsif May_Be_Body then
6756 Unit_Kind := Body_Part;
6758 if May_Be_Sep and then
6759 Body_Suffix'Length < Sep_Suffix'Length
6761 Last := Last - Sep_Suffix'Length;
6762 May_Be_Body := False;
6764 Last := Last - Body_Suffix'Length;
6765 May_Be_Sep := False;
6768 elsif May_Be_Sep then
6769 Unit_Kind := Body_Part;
6770 Last := Last - Sep_Suffix'Length;
6778 -- This is not a source file
6780 Unit_Name := No_Name;
6781 Unit_Kind := Specification;
6783 if Current_Verbosity = High then
6784 Write_Line (" Not a valid file name.");
6789 elsif Current_Verbosity = High then
6791 when Specification =>
6792 Write_Str (" Specification: ");
6793 Write_Line (File (First .. Last + Spec_Suffix'Length));
6797 Write_Str (" Body: ");
6798 Write_Line (File (First .. Last + Body_Suffix'Length));
6801 Write_Str (" Separate: ");
6802 Write_Line (File (First .. Last + Sep_Suffix'Length));
6808 Get_Name_String (Naming.Dot_Replacement);
6810 Standard_GNAT and then Name_Buffer (1 .. Name_Len) = "-";
6812 if Name_Buffer (1 .. Name_Len) /= "." then
6814 -- If Dot_Replacement is not a single dot, then there should not
6815 -- be any dot in the name.
6817 for Index in First .. Last loop
6818 if File (Index) = '.' then
6819 if Current_Verbosity = High then
6821 (" Not a valid file name (some dot not replaced).");
6824 Unit_Name := No_Name;
6830 -- Replace the substring Dot_Replacement with dots
6833 Index : Positive := First;
6836 while Index <= Last - Name_Len + 1 loop
6838 if File (Index .. Index + Name_Len - 1) =
6839 Name_Buffer (1 .. Name_Len)
6841 File (Index) := '.';
6843 if Name_Len > 1 and then Index < Last then
6844 File (Index + 1 .. Last - Name_Len + 1) :=
6845 File (Index + Name_Len .. Last);
6848 Last := Last - Name_Len + 1;
6856 -- Check if the file casing is right
6859 Src : String := File (First .. Last);
6860 Src_Last : Positive := Last;
6863 -- If casing is significant, deal with upper/lower case translate
6865 if File_Names_Case_Sensitive then
6866 case Naming.Casing is
6867 when All_Lower_Case =>
6870 Mapping => Lower_Case_Map);
6872 when All_Upper_Case =>
6875 Mapping => Upper_Case_Map);
6877 when Mixed_Case | Unknown =>
6881 if Src /= File (First .. Last) then
6882 if Current_Verbosity = High then
6883 Write_Line (" Not a valid file name (casing).");
6886 Unit_Name := No_Name;
6891 -- Put the name in lower case
6895 Mapping => Lower_Case_Map);
6897 -- In the standard GNAT naming scheme, check for special cases:
6898 -- children or separates of A, G, I or S, and run time sources.
6900 if Standard_GNAT and then Src'Length >= 3 then
6902 S1 : constant Character := Src (Src'First);
6903 S2 : constant Character := Src (Src'First + 1);
6904 S3 : constant Character := Src (Src'First + 2);
6912 -- Children or separates of packages A, G, I or S. These
6913 -- names are x__ ... or x~... (where x is a, g, i, or s).
6914 -- Both versions (x__... and x~...) are allowed in all
6915 -- platforms, because it is not possible to know the
6916 -- platform before processing of the project files.
6918 if S2 = '_' and then S3 = '_' then
6919 Src (Src'First + 1) := '.';
6920 Src_Last := Src_Last - 1;
6921 Src (Src'First + 2 .. Src_Last) :=
6922 Src (Src'First + 3 .. Src_Last + 1);
6925 Src (Src'First + 1) := '.';
6927 -- If it is potentially a run time source, disable
6928 -- filling of the mapping file to avoid warnings.
6931 Set_Mapping_File_Initial_State_To_Empty;
6937 if Current_Verbosity = High then
6939 Write_Line (Src (Src'First .. Src_Last));
6942 -- Now, we check if this name is a valid unit name
6945 (Name => Src (Src'First .. Src_Last), Unit => Unit_Name);
6955 function Hash (Unit : Unit_Info) return Header_Num is
6957 return Header_Num (Unit.Unit mod 2048);
6960 -----------------------
6961 -- Is_Illegal_Suffix --
6962 -----------------------
6964 function Is_Illegal_Suffix
6966 Dot_Replacement_Is_A_Single_Dot : Boolean) return Boolean
6969 if Suffix'Length = 0 or else Index (Suffix, ".") = 0 then
6973 -- If dot replacement is a single dot, and first character of suffix is
6976 if Dot_Replacement_Is_A_Single_Dot
6977 and then Suffix (Suffix'First) = '.'
6979 for Index in Suffix'First + 1 .. Suffix'Last loop
6981 -- If there is another dot
6983 if Suffix (Index) = '.' then
6985 -- It is illegal to have a letter following the initial dot
6987 return Is_Letter (Suffix (Suffix'First + 1));
6995 end Is_Illegal_Suffix;
6997 ----------------------
6998 -- Locate_Directory --
6999 ----------------------
7001 procedure Locate_Directory
7002 (Project : Project_Id;
7003 In_Tree : Project_Tree_Ref;
7004 Name : File_Name_Type;
7005 Parent : Path_Name_Type;
7006 Dir : out Path_Name_Type;
7007 Display : out Path_Name_Type;
7008 Create : String := "";
7009 Current_Dir : String;
7010 Location : Source_Ptr := No_Location;
7011 Externally_Built : Boolean := False)
7013 The_Parent : constant String :=
7014 Get_Name_String (Parent) & Directory_Separator;
7016 The_Parent_Last : constant Natural :=
7017 Compute_Directory_Last (The_Parent);
7019 Full_Name : File_Name_Type;
7021 The_Name : File_Name_Type;
7024 Get_Name_String (Name);
7026 -- Add Subdirs.all if it is a directory that may be created and
7027 -- Subdirs is not null;
7029 if Create /= "" and then Subdirs /= null then
7030 if Name_Buffer (Name_Len) /= Directory_Separator then
7031 Add_Char_To_Name_Buffer (Directory_Separator);
7034 Add_Str_To_Name_Buffer (Subdirs.all);
7037 -- Convert '/' to directory separator (for Windows)
7039 for J in 1 .. Name_Len loop
7040 if Name_Buffer (J) = '/' then
7041 Name_Buffer (J) := Directory_Separator;
7045 The_Name := Name_Find;
7047 if Current_Verbosity = High then
7048 Write_Str ("Locate_Directory (""");
7049 Write_Str (Get_Name_String (The_Name));
7050 Write_Str (""", """);
7051 Write_Str (The_Parent);
7058 if Is_Absolute_Path (Get_Name_String (The_Name)) then
7059 Full_Name := The_Name;
7063 Add_Str_To_Name_Buffer
7064 (The_Parent (The_Parent'First .. The_Parent_Last));
7065 Add_Str_To_Name_Buffer (Get_Name_String (The_Name));
7066 Full_Name := Name_Find;
7070 Full_Path_Name : String_Access :=
7071 new String'(Get_Name_String (Full_Name));
7074 if (Setup_Projects or else Subdirs /= null)
7075 and then Create'Length > 0
7077 if not Is_Directory (Full_Path_Name.all) then
7078 -- If project is externally built, do not create a subdir,
7079 -- use the specified directory, without the subdir.
7081 if Externally_Built then
7082 if Is_Absolute_Path (Get_Name_String (Name)) then
7083 Get_Name_String (Name);
7087 Add_Str_To_Name_Buffer
7088 (The_Parent (The_Parent'First .. The_Parent_Last));
7089 Add_Str_To_Name_Buffer (Get_Name_String (Name));
7092 Full_Path_Name := new String'(Name_Buffer (1 .. Name_Len));
7096 Create_Path (Full_Path_Name.all);
7098 if not Quiet_Output then
7100 Write_Str (" directory """);
7101 Write_Str (Full_Path_Name.all);
7102 Write_Line (""" created");
7109 "could not create " & Create &
7110 " directory " & Full_Path_Name.all,
7117 if Is_Directory (Full_Path_Name.all) then
7119 Normed : constant String :=
7121 (Full_Path_Name.all,
7122 Directory => Current_Dir,
7123 Resolve_Links => False,
7124 Case_Sensitive => True);
7126 Canonical_Path : constant String :=
7129 Directory => Current_Dir,
7131 Opt.Follow_Links_For_Dirs,
7132 Case_Sensitive => False);
7135 Name_Len := Normed'Length;
7136 Name_Buffer (1 .. Name_Len) := Normed;
7137 Display := Name_Find;
7139 Name_Len := Canonical_Path'Length;
7140 Name_Buffer (1 .. Name_Len) := Canonical_Path;
7145 Free (Full_Path_Name);
7147 end Locate_Directory;
7149 ---------------------------
7150 -- Find_Excluded_Sources --
7151 ---------------------------
7153 procedure Find_Excluded_Sources
7154 (Project : Project_Id;
7155 In_Tree : Project_Tree_Ref;
7156 Data : Project_Data)
7158 Excluded_Sources : Variable_Value;
7160 Excluded_Source_List_File : Variable_Value;
7162 Current : String_List_Id;
7164 Element : String_Element;
7166 Location : Source_Ptr;
7168 Name : File_Name_Type;
7170 File : Prj.Util.Text_File;
7171 Line : String (1 .. 300);
7174 Locally_Removed : Boolean := False;
7176 Excluded_Source_List_File :=
7178 (Name_Excluded_Source_List_File, Data.Decl.Attributes, In_Tree);
7182 (Name_Excluded_Source_Files, Data.Decl.Attributes, In_Tree);
7184 -- If Excluded_Source_Files is not declared, check
7185 -- Locally_Removed_Files.
7187 if Excluded_Sources.Default then
7188 Locally_Removed := True;
7191 (Name_Locally_Removed_Files, Data.Decl.Attributes, In_Tree);
7194 Excluded_Sources_Htable.Reset;
7196 -- If there are excluded sources, put them in the table
7198 if not Excluded_Sources.Default then
7199 if not Excluded_Source_List_File.Default then
7200 if Locally_Removed then
7203 "?both attributes Locally_Removed_Files and " &
7204 "Excluded_Source_List_File are present",
7205 Excluded_Source_List_File.Location);
7209 "?both attributes Excluded_Source_Files and " &
7210 "Excluded_Source_List_File are present",
7211 Excluded_Source_List_File.Location);
7215 Current := Excluded_Sources.Values;
7216 while Current /= Nil_String loop
7217 Element := In_Tree.String_Elements.Table (Current);
7219 if Osint.File_Names_Case_Sensitive then
7220 Name := File_Name_Type (Element.Value);
7222 Get_Name_String (Element.Value);
7223 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7227 -- If the element has no location, then use the location
7228 -- of Excluded_Sources to report possible errors.
7230 if Element.Location = No_Location then
7231 Location := Excluded_Sources.Location;
7233 Location := Element.Location;
7236 Excluded_Sources_Htable.Set (Name, (Name, False, Location));
7237 Current := Element.Next;
7240 elsif not Excluded_Source_List_File.Default then
7241 Location := Excluded_Source_List_File.Location;
7244 Source_File_Path_Name : constant String :=
7247 (Excluded_Source_List_File.Value),
7248 Data.Directory.Name);
7251 if Source_File_Path_Name'Length = 0 then
7252 Err_Vars.Error_Msg_File_1 :=
7253 File_Name_Type (Excluded_Source_List_File.Value);
7256 "file with excluded sources { does not exist",
7257 Excluded_Source_List_File.Location);
7262 Prj.Util.Open (File, Source_File_Path_Name);
7264 if not Prj.Util.Is_Valid (File) then
7266 (Project, In_Tree, "file does not exist", Location);
7268 -- Read the lines one by one
7270 while not Prj.Util.End_Of_File (File) loop
7271 Prj.Util.Get_Line (File, Line, Last);
7273 -- A non empty, non comment line should contain a file
7277 and then (Last = 1 or else Line (1 .. 2) /= "--")
7280 Name_Buffer (1 .. Name_Len) := Line (1 .. Last);
7281 Canonical_Case_File_Name
7282 (Name_Buffer (1 .. Name_Len));
7285 -- Check that there is no directory information
7287 for J in 1 .. Last loop
7289 or else Line (J) = Directory_Separator
7291 Error_Msg_File_1 := Name;
7295 "file name cannot include " &
7296 "directory information ({)",
7302 Excluded_Sources_Htable.Set
7303 (Name, (Name, False, Location));
7307 Prj.Util.Close (File);
7312 end Find_Excluded_Sources;
7314 ---------------------------
7315 -- Find_Explicit_Sources --
7316 ---------------------------
7318 procedure Find_Explicit_Sources
7319 (Current_Dir : String;
7320 Project : Project_Id;
7321 In_Tree : Project_Tree_Ref;
7322 Data : in out Project_Data)
7324 Sources : constant Variable_Value :=
7327 Data.Decl.Attributes,
7329 Source_List_File : constant Variable_Value :=
7331 (Name_Source_List_File,
7332 Data.Decl.Attributes,
7334 Name_Loc : Name_Location;
7337 pragma Assert (Sources.Kind = List, "Source_Files is not a list");
7339 (Source_List_File.Kind = Single,
7340 "Source_List_File is not a single string");
7342 -- If the user has specified a Sources attribute
7344 if not Sources.Default then
7345 if not Source_List_File.Default then
7348 "?both attributes source_files and " &
7349 "source_list_file are present",
7350 Source_List_File.Location);
7353 -- Sources is a list of file names
7356 Current : String_List_Id := Sources.Values;
7357 Element : String_Element;
7358 Location : Source_Ptr;
7359 Name : File_Name_Type;
7362 if Get_Mode = Ada_Only then
7363 Data.Ada_Sources_Present := Current /= Nil_String;
7366 if Get_Mode = Multi_Language then
7367 if Current = Nil_String then
7368 Data.First_Language_Processing := No_Language_Index;
7370 -- This project contains no source. For projects that
7371 -- don't extend other projects, this also means that
7372 -- there is no need for an object directory, if not
7375 if Data.Extends = No_Project
7376 and then Data.Object_Directory = Data.Directory
7378 Data.Object_Directory := No_Path_Information;
7383 while Current /= Nil_String loop
7384 Element := In_Tree.String_Elements.Table (Current);
7385 Get_Name_String (Element.Value);
7387 if Osint.File_Names_Case_Sensitive then
7388 Name := File_Name_Type (Element.Value);
7390 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
7394 -- If the element has no location, then use the
7395 -- location of Sources to report possible errors.
7397 if Element.Location = No_Location then
7398 Location := Sources.Location;
7400 Location := Element.Location;
7403 -- Check that there is no directory information
7405 for J in 1 .. Name_Len loop
7406 if Name_Buffer (J) = '/'
7407 or else Name_Buffer (J) = Directory_Separator
7409 Error_Msg_File_1 := Name;
7413 "file name cannot include directory " &
7420 -- In Multi_Language mode, check whether the file is
7421 -- already there: the same file name may be in the list; if
7422 -- the source is missing, the error will be on the first
7423 -- mention of the source file name.
7427 Name_Loc := No_Name_Location;
7428 when Multi_Language =>
7429 Name_Loc := Source_Names.Get (Name);
7432 if Name_Loc = No_Name_Location then
7435 Location => Location,
7436 Source => No_Source,
7439 Source_Names.Set (Name, Name_Loc);
7442 Current := Element.Next;
7445 if Get_Mode = Ada_Only then
7446 Get_Path_Names_And_Record_Ada_Sources
7447 (Project, In_Tree, Data, Current_Dir);
7451 -- If we have no Source_Files attribute, check the Source_List_File
7454 elsif not Source_List_File.Default then
7456 -- Source_List_File is the name of the file
7457 -- that contains the source file names
7460 Source_File_Path_Name : constant String :=
7462 (File_Name_Type (Source_List_File.Value), Data.Directory.Name);
7465 if Source_File_Path_Name'Length = 0 then
7466 Err_Vars.Error_Msg_File_1 :=
7467 File_Name_Type (Source_List_File.Value);
7470 "file with sources { does not exist",
7471 Source_List_File.Location);
7474 Get_Sources_From_File
7475 (Source_File_Path_Name, Source_List_File.Location,
7478 if Get_Mode = Ada_Only then
7479 -- Look in the source directories to find those sources
7481 Get_Path_Names_And_Record_Ada_Sources
7482 (Project, In_Tree, Data, Current_Dir);
7488 -- Neither Source_Files nor Source_List_File has been
7489 -- specified. Find all the files that satisfy the naming
7490 -- scheme in all the source directories.
7492 if Get_Mode = Ada_Only then
7493 Find_Ada_Sources (Project, In_Tree, Data, Current_Dir);
7497 if Get_Mode = Multi_Language then
7499 (Project, In_Tree, Data,
7501 Sources.Default and then Source_List_File.Default);
7503 -- Check if all exceptions have been found.
7504 -- For Ada, it is an error if an exception is not found.
7505 -- For other language, the source is simply removed.
7511 Source := Data.First_Source;
7512 while Source /= No_Source loop
7514 Src_Data : Source_Data renames
7515 In_Tree.Sources.Table (Source);
7518 if Src_Data.Naming_Exception
7519 and then Src_Data.Path = No_Path_Information
7521 if Src_Data.Unit /= No_Name then
7522 Error_Msg_Name_1 := Name_Id (Src_Data.Display_File);
7523 Error_Msg_Name_2 := Name_Id (Src_Data.Unit);
7526 "source file %% for unit %% not found",
7530 Remove_Source (Source, No_Source, Project, Data, In_Tree);
7533 Source := Src_Data.Next_In_Project;
7538 -- Check that all sources in Source_Files or the file
7539 -- Source_List_File has been found.
7542 Name_Loc : Name_Location;
7545 Name_Loc := Source_Names.Get_First;
7546 while Name_Loc /= No_Name_Location loop
7547 if (not Name_Loc.Except) and then (not Name_Loc.Found) then
7548 Error_Msg_Name_1 := Name_Id (Name_Loc.Name);
7552 "file %% not found",
7556 Name_Loc := Source_Names.Get_Next;
7561 if Get_Mode = Ada_Only
7562 and then Data.Extends = No_Project
7564 -- We should have found at least one source, if not report an error
7566 if Data.Ada_Sources = Nil_String then
7568 (Project, "Ada", In_Tree, Source_List_File.Location);
7572 end Find_Explicit_Sources;
7574 -------------------------------------------
7575 -- Get_Path_Names_And_Record_Ada_Sources --
7576 -------------------------------------------
7578 procedure Get_Path_Names_And_Record_Ada_Sources
7579 (Project : Project_Id;
7580 In_Tree : Project_Tree_Ref;
7581 Data : in out Project_Data;
7582 Current_Dir : String)
7584 Source_Dir : String_List_Id;
7585 Element : String_Element;
7586 Path : Path_Name_Type;
7588 Name : File_Name_Type;
7589 Canonical_Name : File_Name_Type;
7590 Name_Str : String (1 .. 1_024);
7591 Last : Natural := 0;
7593 Current_Source : String_List_Id := Nil_String;
7594 First_Error : Boolean := True;
7595 Source_Recorded : Boolean := False;
7598 -- We look in all source directories for the file names in the hash
7599 -- table Source_Names.
7601 Source_Dir := Data.Source_Dirs;
7602 while Source_Dir /= Nil_String loop
7603 Source_Recorded := False;
7604 Element := In_Tree.String_Elements.Table (Source_Dir);
7607 Dir_Path : constant String :=
7608 Get_Name_String (Element.Display_Value);
7610 if Current_Verbosity = High then
7611 Write_Str ("checking directory """);
7612 Write_Str (Dir_Path);
7616 Open (Dir, Dir_Path);
7619 Read (Dir, Name_Str, Last);
7623 Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
7626 if Osint.File_Names_Case_Sensitive then
7627 Canonical_Name := Name;
7629 Canonical_Case_File_Name (Name_Str (1 .. Last));
7630 Name_Buffer (1 .. Name_Len) := Name_Str (1 .. Last);
7631 Canonical_Name := Name_Find;
7634 NL := Source_Names.Get (Canonical_Name);
7636 if NL /= No_Name_Location and then not NL.Found then
7638 Source_Names.Set (Canonical_Name, NL);
7639 Name_Len := Dir_Path'Length;
7640 Name_Buffer (1 .. Name_Len) := Dir_Path;
7642 if Name_Buffer (Name_Len) /= Directory_Separator then
7643 Add_Char_To_Name_Buffer (Directory_Separator);
7646 Add_Str_To_Name_Buffer (Name_Str (1 .. Last));
7649 if Current_Verbosity = High then
7650 Write_Str (" found ");
7651 Write_Line (Get_Name_String (Name));
7654 -- Register the source if it is an Ada compilation unit
7662 Location => NL.Location,
7663 Current_Source => Current_Source,
7664 Source_Recorded => Source_Recorded,
7665 Current_Dir => Current_Dir);
7672 if Source_Recorded then
7673 In_Tree.String_Elements.Table (Source_Dir).Flag :=
7677 Source_Dir := Element.Next;
7680 -- It is an error if a source file name in a source list or
7681 -- in a source list file is not found.
7683 NL := Source_Names.Get_First;
7684 while NL /= No_Name_Location loop
7685 if not NL.Found then
7686 Err_Vars.Error_Msg_File_1 := NL.Name;
7691 "source file { cannot be found",
7693 First_Error := False;
7698 "\source file { cannot be found",
7703 NL := Source_Names.Get_Next;
7705 end Get_Path_Names_And_Record_Ada_Sources;
7707 --------------------------
7708 -- Check_Naming_Schemes --
7709 --------------------------
7711 procedure Check_Naming_Schemes
7712 (In_Tree : Project_Tree_Ref;
7713 Data : in out Project_Data;
7715 File_Name : File_Name_Type;
7716 Alternate_Languages : out Alternate_Language_Id;
7717 Language : out Language_Index;
7718 Language_Name : out Name_Id;
7719 Display_Language_Name : out Name_Id;
7721 Lang_Kind : out Language_Kind;
7722 Kind : out Source_Kind)
7724 Last : Positive := Filename'Last;
7725 Config : Language_Config;
7726 Lang : Name_List_Index := Data.Languages;
7727 Header_File : Boolean := False;
7728 First_Language : Language_Index := No_Language_Index;
7731 Last_Spec : Natural;
7732 Last_Body : Natural;
7738 Alternate_Languages := No_Alternate_Language;
7739 Language := No_Language_Index;
7740 Language_Name := No_Name;
7741 Display_Language_Name := No_Name;
7743 Lang_Kind := File_Based;
7746 while Lang /= No_Name_List loop
7747 Language_Name := In_Tree.Name_Lists.Table (Lang).Name;
7748 Language := Data.First_Language_Processing;
7750 if Current_Verbosity = High then
7752 (" Testing language "
7753 & Get_Name_String (Language_Name)
7754 & " Header_File=" & Header_File'Img);
7757 while Language /= No_Language_Index loop
7758 if In_Tree.Languages_Data.Table (Language).Name =
7761 Display_Language_Name :=
7762 In_Tree.Languages_Data.Table (Language).Display_Name;
7763 Config := In_Tree.Languages_Data.Table (Language).Config;
7764 Lang_Kind := Config.Kind;
7766 if Config.Kind = File_Based then
7768 -- For file based languages, there is no Unit. Just
7769 -- check if the file name has the implementation or,
7770 -- if it is specified, the template suffix of the
7776 and then Config.Naming_Data.Body_Suffix /= No_File
7779 Impl_Suffix : constant String :=
7780 Get_Name_String (Config.Naming_Data.Body_Suffix);
7783 if Filename'Length > Impl_Suffix'Length
7786 (Last - Impl_Suffix'Length + 1 .. Last) =
7791 if Current_Verbosity = High then
7792 Write_Str (" source of language ");
7794 (Get_Name_String (Display_Language_Name));
7802 if Config.Naming_Data.Spec_Suffix /= No_File then
7804 Spec_Suffix : constant String :=
7806 (Config.Naming_Data.Spec_Suffix);
7809 if Filename'Length > Spec_Suffix'Length
7812 (Last - Spec_Suffix'Length + 1 .. Last) =
7817 if Current_Verbosity = High then
7818 Write_Str (" header file of language ");
7820 (Get_Name_String (Display_Language_Name));
7824 Alternate_Language_Table.Increment_Last
7825 (In_Tree.Alt_Langs);
7826 In_Tree.Alt_Langs.Table
7827 (Alternate_Language_Table.Last
7828 (In_Tree.Alt_Langs)) :=
7829 (Language => Language,
7830 Next => Alternate_Languages);
7831 Alternate_Languages :=
7832 Alternate_Language_Table.Last
7833 (In_Tree.Alt_Langs);
7835 Header_File := True;
7836 First_Language := Language;
7842 elsif not Header_File then
7843 -- Unit based language
7845 OK := Config.Naming_Data.Dot_Replacement /= No_File;
7850 -- ??? Are we doing this once per file in the project ?
7851 -- It should be done only once per project.
7853 case Config.Naming_Data.Casing is
7854 when All_Lower_Case =>
7855 for J in Filename'Range loop
7856 if Is_Letter (Filename (J)) then
7857 if not Is_Lower (Filename (J)) then
7864 when All_Upper_Case =>
7865 for J in Filename'Range loop
7866 if Is_Letter (Filename (J)) then
7867 if not Is_Upper (Filename (J)) then
7883 Last_Spec := Natural'Last;
7884 Last_Body := Natural'Last;
7885 Last_Sep := Natural'Last;
7887 if Config.Naming_Data.Separate_Suffix /= No_File
7889 Config.Naming_Data.Separate_Suffix /=
7890 Config.Naming_Data.Body_Suffix
7893 Suffix : constant String :=
7895 (Config.Naming_Data.Separate_Suffix);
7897 if Filename'Length > Suffix'Length
7900 (Last - Suffix'Length + 1 .. Last) =
7903 Last_Sep := Last - Suffix'Length;
7908 if Config.Naming_Data.Body_Suffix /= No_File then
7910 Suffix : constant String :=
7912 (Config.Naming_Data.Body_Suffix);
7914 if Filename'Length > Suffix'Length
7917 (Last - Suffix'Length + 1 .. Last) =
7920 Last_Body := Last - Suffix'Length;
7925 if Config.Naming_Data.Spec_Suffix /= No_File then
7927 Suffix : constant String :=
7929 (Config.Naming_Data.Spec_Suffix);
7931 if Filename'Length > Suffix'Length
7934 (Last - Suffix'Length + 1 .. Last) =
7937 Last_Spec := Last - Suffix'Length;
7943 Last_Min : constant Natural :=
7944 Natural'Min (Natural'Min (Last_Spec,
7949 OK := Last_Min < Last;
7954 if Last_Min = Last_Spec then
7957 elsif Last_Min = Last_Body then
7969 -- Replace dot replacements with dots
7974 J : Positive := Filename'First;
7976 Dot_Replacement : constant String :=
7978 (Config.Naming_Data.
7981 Max : constant Positive :=
7982 Last - Dot_Replacement'Length + 1;
7986 Name_Len := Name_Len + 1;
7988 if J <= Max and then
7990 (J .. J + Dot_Replacement'Length - 1) =
7993 Name_Buffer (Name_Len) := '.';
7994 J := J + Dot_Replacement'Length;
7997 if Filename (J) = '.' then
8002 Name_Buffer (Name_Len) :=
8003 GNAT.Case_Util.To_Lower (Filename (J));
8014 -- The name buffer should contain the name of the
8015 -- the unit, if it is one.
8017 -- Check that this is a valid unit name
8019 Check_Ada_Name (Name_Buffer (1 .. Name_Len), Unit);
8021 if Unit /= No_Name then
8023 if Current_Verbosity = High then
8025 Write_Str (" spec of ");
8027 Write_Str (" body of ");
8030 Write_Str (Get_Name_String (Unit));
8031 Write_Str (" (language ");
8033 (Get_Name_String (Display_Language_Name));
8037 -- Comments required, declare block should
8041 Unit_Except : constant Unit_Exception :=
8042 Unit_Exceptions.Get (Unit);
8044 procedure Masked_Unit (Spec : Boolean);
8045 -- Indicate that there is an exception for
8046 -- the same unit, so the file is not a
8047 -- source for the unit.
8053 procedure Masked_Unit (Spec : Boolean) is
8055 if Current_Verbosity = High then
8057 Write_Str (Filename);
8058 Write_Str (""" contains the ");
8067 (" of a unit that is found in """);
8072 (Unit_Except.Spec));
8076 (Unit_Except.Impl));
8079 Write_Line (""" (ignored)");
8082 Language := No_Language_Index;
8087 if Unit_Except.Spec /= No_File
8088 and then Unit_Except.Spec /= File_Name
8090 Masked_Unit (Spec => True);
8094 if Unit_Except.Impl /= No_File
8095 and then Unit_Except.Impl /= File_Name
8097 Masked_Unit (Spec => False);
8108 Language := In_Tree.Languages_Data.Table (Language).Next;
8111 Lang := In_Tree.Name_Lists.Table (Lang).Next;
8114 -- Comment needed here ???
8117 Language := First_Language;
8120 Language := No_Language_Index;
8122 if Current_Verbosity = High then
8123 Write_Line (" not a source of any language");
8126 end Check_Naming_Schemes;
8132 procedure Check_File
8133 (Project : Project_Id;
8134 In_Tree : Project_Tree_Ref;
8135 Data : in out Project_Data;
8137 File_Name : File_Name_Type;
8138 Display_File_Name : File_Name_Type;
8139 Source_Directory : String;
8140 For_All_Sources : Boolean)
8142 Display_Path : constant String :=
8145 Directory => Source_Directory,
8146 Resolve_Links => Opt.Follow_Links_For_Files,
8147 Case_Sensitive => True);
8149 Name_Loc : Name_Location := Source_Names.Get (File_Name);
8150 Path_Id : Path_Name_Type;
8151 Display_Path_Id : Path_Name_Type;
8152 Check_Name : Boolean := False;
8153 Alternate_Languages : Alternate_Language_Id := No_Alternate_Language;
8154 Language : Language_Index;
8156 Other_Part : Source_Id;
8158 Src_Ind : Source_File_Index;
8160 Source_To_Replace : Source_Id := No_Source;
8161 Language_Name : Name_Id;
8162 Display_Language_Name : Name_Id;
8163 Lang_Kind : Language_Kind;
8164 Kind : Source_Kind := Spec;
8167 Name_Len := Display_Path'Length;
8168 Name_Buffer (1 .. Name_Len) := Display_Path;
8169 Display_Path_Id := Name_Find;
8171 if Osint.File_Names_Case_Sensitive then
8172 Path_Id := Display_Path_Id;
8174 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
8175 Path_Id := Name_Find;
8178 if Name_Loc = No_Name_Location then
8179 Check_Name := For_All_Sources;
8182 if Name_Loc.Found then
8184 -- Check if it is OK to have the same file name in several
8185 -- source directories.
8187 if not Data.Known_Order_Of_Source_Dirs then
8188 Error_Msg_File_1 := File_Name;
8191 "{ is found in several source directories",
8196 Name_Loc.Found := True;
8198 Source_Names.Set (File_Name, Name_Loc);
8200 if Name_Loc.Source = No_Source then
8204 In_Tree.Sources.Table (Name_Loc.Source).Path :=
8205 (Path_Id, Display_Path_Id);
8207 Source_Paths_Htable.Set
8208 (In_Tree.Source_Paths_HT,
8212 -- Check if this is a subunit
8214 if In_Tree.Sources.Table (Name_Loc.Source).Unit /= No_Name
8216 In_Tree.Sources.Table (Name_Loc.Source).Kind = Impl
8218 Src_Ind := Sinput.P.Load_Project_File
8219 (Get_Name_String (Path_Id));
8221 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
8222 In_Tree.Sources.Table (Name_Loc.Source).Kind := Sep;
8230 Other_Part := No_Source;
8232 Check_Naming_Schemes
8233 (In_Tree => In_Tree,
8235 Filename => Get_Name_String (File_Name),
8236 File_Name => File_Name,
8237 Alternate_Languages => Alternate_Languages,
8238 Language => Language,
8239 Language_Name => Language_Name,
8240 Display_Language_Name => Display_Language_Name,
8242 Lang_Kind => Lang_Kind,
8245 if Language = No_Language_Index then
8247 -- A file name in a list must be a source of a language
8249 if Name_Loc.Found then
8250 Error_Msg_File_1 := File_Name;
8254 "language unknown for {",
8259 -- Check if the same file name or unit is used in the prj tree
8261 Source := In_Tree.First_Source;
8263 while Source /= No_Source loop
8265 Src_Data : Source_Data renames
8266 In_Tree.Sources.Table (Source);
8270 and then Src_Data.Unit = Unit
8272 ((Src_Data.Kind = Spec and then Kind = Impl)
8274 (Src_Data.Kind = Impl and then Kind = Spec))
8276 Other_Part := Source;
8278 elsif (Unit /= No_Name
8279 and then Src_Data.Unit = Unit
8281 (Src_Data.Kind = Kind
8283 (Src_Data.Kind = Sep and then Kind = Impl)
8285 (Src_Data.Kind = Impl and then Kind = Sep)))
8287 (Unit = No_Name and then Src_Data.File = File_Name)
8289 -- Duplication of file/unit in same project is only
8290 -- allowed if order of source directories is known.
8292 if Project = Src_Data.Project then
8293 if Data.Known_Order_Of_Source_Dirs then
8296 elsif Unit /= No_Name then
8297 Error_Msg_Name_1 := Unit;
8299 (Project, In_Tree, "duplicate unit %%",
8304 Error_Msg_File_1 := File_Name;
8306 (Project, In_Tree, "duplicate source file name {",
8311 -- Do not allow the same unit name in different
8312 -- projects, except if one is extending the other.
8314 -- For a file based language, the same file name
8315 -- replaces a file in a project being extended, but
8316 -- it is allowed to have the same file name in
8317 -- unrelated projects.
8320 (Project, Src_Data.Project, In_Tree)
8322 Source_To_Replace := Source;
8324 elsif Unit /= No_Name
8325 and then not Src_Data.Locally_Removed
8327 Error_Msg_Name_1 := Unit;
8330 "unit %% cannot belong to several projects",
8334 In_Tree.Projects.Table (Project).Name;
8335 Error_Msg_Name_2 := Name_Id (Display_Path_Id);
8337 (Project, In_Tree, "\ project %%, %%", No_Location);
8340 In_Tree.Projects.Table (Src_Data.Project).Name;
8342 Name_Id (Src_Data.Path.Display_Name);
8344 (Project, In_Tree, "\ project %%, %%", No_Location);
8350 Source := Src_Data.Next_In_Sources;
8360 Lang => Language_Name,
8361 Lang_Id => Language,
8362 Lang_Kind => Lang_Kind,
8364 Alternate_Languages => Alternate_Languages,
8365 File_Name => File_Name,
8366 Display_File => Display_File_Name,
8367 Other_Part => Other_Part,
8370 Display_Path => Display_Path_Id,
8371 Source_To_Replace => Source_To_Replace);
8377 ------------------------
8378 -- Search_Directories --
8379 ------------------------
8381 procedure Search_Directories
8382 (Project : Project_Id;
8383 In_Tree : Project_Tree_Ref;
8384 Data : in out Project_Data;
8385 For_All_Sources : Boolean)
8387 Source_Dir : String_List_Id;
8388 Element : String_Element;
8390 Name : String (1 .. 1_000);
8392 File_Name : File_Name_Type;
8393 Display_File_Name : File_Name_Type;
8396 if Current_Verbosity = High then
8397 Write_Line ("Looking for sources:");
8400 -- Loop through subdirectories
8402 Source_Dir := Data.Source_Dirs;
8403 while Source_Dir /= Nil_String loop
8405 Element := In_Tree.String_Elements.Table (Source_Dir);
8406 if Element.Value /= No_Name then
8407 Get_Name_String (Element.Display_Value);
8410 Source_Directory : constant String :=
8411 Name_Buffer (1 .. Name_Len) &
8412 Directory_Separator;
8414 Dir_Last : constant Natural :=
8415 Compute_Directory_Last
8419 if Current_Verbosity = High then
8420 Write_Str ("Source_Dir = ");
8421 Write_Line (Source_Directory);
8424 -- We look to every entry in the source directory
8426 Open (Dir, Source_Directory);
8429 Read (Dir, Name, Last);
8433 -- ??? Duplicate system call here, we just did a
8434 -- a similar one. Maybe Ada.Directories would be more
8438 (Source_Directory & Name (1 .. Last))
8440 if Current_Verbosity = High then
8441 Write_Str (" Checking ");
8442 Write_Line (Name (1 .. Last));
8446 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
8447 Display_File_Name := Name_Find;
8449 if Osint.File_Names_Case_Sensitive then
8450 File_Name := Display_File_Name;
8452 Canonical_Case_File_Name
8453 (Name_Buffer (1 .. Name_Len));
8454 File_Name := Name_Find;
8459 Excluded_Sources_Htable.Get (File_Name);
8462 if FF /= No_File_Found then
8463 if not FF.Found then
8465 Excluded_Sources_Htable.Set
8468 if Current_Verbosity = High then
8469 Write_Str (" excluded source """);
8470 Write_Str (Get_Name_String (File_Name));
8477 (Project => Project,
8480 Name => Name (1 .. Last),
8481 File_Name => File_Name,
8482 Display_File_Name => Display_File_Name,
8483 Source_Directory => Source_Directory
8484 (Source_Directory'First .. Dir_Last),
8485 For_All_Sources => For_All_Sources);
8496 when Directory_Error =>
8500 Source_Dir := Element.Next;
8503 if Current_Verbosity = High then
8504 Write_Line ("end Looking for sources.");
8506 end Search_Directories;
8508 ----------------------
8509 -- Look_For_Sources --
8510 ----------------------
8512 procedure Look_For_Sources
8513 (Project : Project_Id;
8514 In_Tree : Project_Tree_Ref;
8515 Data : in out Project_Data;
8516 Current_Dir : String)
8518 procedure Remove_Locally_Removed_Files_From_Units;
8519 -- Mark all locally removed sources as such in the Units table
8521 procedure Process_Sources_In_Multi_Language_Mode;
8522 -- Find all source files when in multi language mode
8524 ---------------------------------------------
8525 -- Remove_Locally_Removed_Files_From_Units --
8526 ---------------------------------------------
8528 procedure Remove_Locally_Removed_Files_From_Units is
8529 Excluded : File_Found;
8532 Extended : Project_Id;
8535 Excluded := Excluded_Sources_Htable.Get_First;
8536 while Excluded /= No_File_Found loop
8540 for Index in Unit_Table.First ..
8541 Unit_Table.Last (In_Tree.Units)
8543 Unit := In_Tree.Units.Table (Index);
8545 for Kind in Spec_Or_Body'Range loop
8546 if Unit.File_Names (Kind).Name = Excluded.File then
8549 -- Check that this is from the current project or
8550 -- that the current project extends.
8552 Extended := Unit.File_Names (Kind).Project;
8554 if Extended = Project
8555 or else Project_Extends (Project, Extended, In_Tree)
8557 Unit.File_Names (Kind).Path.Name := Slash;
8558 Unit.File_Names (Kind).Needs_Pragma := False;
8559 In_Tree.Units.Table (Index) := Unit;
8560 Add_Forbidden_File_Name
8561 (Unit.File_Names (Kind).Name);
8565 "cannot remove a source from " &
8572 end loop For_Each_Unit;
8575 Err_Vars.Error_Msg_File_1 := Excluded.File;
8577 (Project, In_Tree, "unknown file {", Excluded.Location);
8580 Excluded := Excluded_Sources_Htable.Get_Next;
8582 end Remove_Locally_Removed_Files_From_Units;
8584 --------------------------------------------
8585 -- Process_Sources_In_Multi_Language_Mode --
8586 --------------------------------------------
8588 procedure Process_Sources_In_Multi_Language_Mode is
8590 Name_Loc : Name_Location;
8595 -- First, put all naming exceptions if any, in the Source_Names table
8597 Unit_Exceptions.Reset;
8599 Source := Data.First_Source;
8600 while Source /= No_Source loop
8602 Src_Data : Source_Data renames In_Tree.Sources.Table (Source);
8605 -- An excluded file cannot also be an exception file name
8607 if Excluded_Sources_Htable.Get (Src_Data.File) /=
8610 Error_Msg_File_1 := Src_Data.File;
8613 "{ cannot be both excluded and an exception file name",
8617 Name_Loc := (Name => Src_Data.File,
8618 Location => No_Location,
8620 Except => Src_Data.Unit /= No_Name,
8623 if Current_Verbosity = High then
8624 Write_Str ("Putting source #");
8625 Write_Str (Source'Img);
8626 Write_Str (", file ");
8627 Write_Str (Get_Name_String (Src_Data.File));
8628 Write_Line (" in Source_Names");
8631 Source_Names.Set (K => Src_Data.File, E => Name_Loc);
8633 -- If this is an Ada exception, record in table Unit_Exceptions
8635 if Src_Data.Unit /= No_Name then
8637 Unit_Except : Unit_Exception :=
8638 Unit_Exceptions.Get (Src_Data.Unit);
8641 Unit_Except.Name := Src_Data.Unit;
8643 if Src_Data.Kind = Spec then
8644 Unit_Except.Spec := Src_Data.File;
8646 Unit_Except.Impl := Src_Data.File;
8649 Unit_Exceptions.Set (Src_Data.Unit, Unit_Except);
8653 Source := Src_Data.Next_In_Project;
8657 Find_Explicit_Sources
8658 (Current_Dir, Project, In_Tree, Data);
8660 -- Mark as such the sources that are declared as excluded
8662 FF := Excluded_Sources_Htable.Get_First;
8663 while FF /= No_File_Found loop
8665 Source := In_Tree.First_Source;
8666 while Source /= No_Source loop
8668 Src_Data : Source_Data renames
8669 In_Tree.Sources.Table (Source);
8672 if Src_Data.File = FF.File then
8674 -- Check that this is from this project or a project that
8675 -- the current project extends.
8677 if Src_Data.Project = Project or else
8678 Is_Extending (Project, Src_Data.Project, In_Tree)
8680 Src_Data.Locally_Removed := True;
8681 Src_Data.In_Interfaces := False;
8682 Add_Forbidden_File_Name (FF.File);
8688 Source := Src_Data.Next_In_Sources;
8692 if not FF.Found and not OK then
8693 Err_Vars.Error_Msg_File_1 := FF.File;
8694 Error_Msg (Project, In_Tree, "unknown file {", FF.Location);
8697 FF := Excluded_Sources_Htable.Get_Next;
8700 -- Check that two sources of this project do not have the same object
8703 Check_Object_File_Names : declare
8705 Source_Name : File_Name_Type;
8707 procedure Check_Object (Src_Data : Source_Data);
8708 -- Check if object file name of the current source is already in
8709 -- hash table Object_File_Names. If it is, report an error. If it
8710 -- is not, put it there with the file name of the current source.
8716 procedure Check_Object (Src_Data : Source_Data) is
8718 Source_Name := Object_File_Names.Get (Src_Data.Object);
8720 if Source_Name /= No_File then
8721 Error_Msg_File_1 := Src_Data.File;
8722 Error_Msg_File_2 := Source_Name;
8726 "{ and { have the same object file name",
8730 Object_File_Names.Set (Src_Data.Object, Src_Data.File);
8734 -- Start of processing for Check_Object_File_Names
8737 Object_File_Names.Reset;
8738 Src_Id := In_Tree.First_Source;
8739 while Src_Id /= No_Source loop
8741 Src_Data : Source_Data renames
8742 In_Tree.Sources.Table (Src_Id);
8745 if Src_Data.Compiled and then Src_Data.Object_Exists
8746 and then Project_Extends
8747 (Project, Src_Data.Project, In_Tree)
8749 if Src_Data.Unit = No_Name then
8750 if Src_Data.Kind = Impl then
8751 Check_Object (Src_Data);
8755 case Src_Data.Kind is
8757 if Src_Data.Other_Part = No_Source then
8758 Check_Object (Src_Data);
8765 if Src_Data.Other_Part /= No_Source then
8766 Check_Object (Src_Data);
8769 -- Check if it is a subunit
8772 Src_Ind : constant Source_File_Index :=
8773 Sinput.P.Load_Project_File
8775 (Src_Data.Path.Name));
8777 if Sinput.P.Source_File_Is_Subunit
8780 In_Tree.Sources.Table (Src_Id).Kind :=
8783 Check_Object (Src_Data);
8791 Src_Id := Src_Data.Next_In_Sources;
8794 end Check_Object_File_Names;
8795 end Process_Sources_In_Multi_Language_Mode;
8797 -- Start of processing for Look_For_Sources
8801 Find_Excluded_Sources (Project, In_Tree, Data);
8805 if Is_A_Language (In_Tree, Data, Name_Ada) then
8806 Find_Explicit_Sources (Current_Dir, Project, In_Tree, Data);
8807 Remove_Locally_Removed_Files_From_Units;
8810 when Multi_Language =>
8811 if Data.First_Language_Processing /= No_Language_Index then
8812 Process_Sources_In_Multi_Language_Mode;
8815 end Look_For_Sources;
8821 function Path_Name_Of
8822 (File_Name : File_Name_Type;
8823 Directory : Path_Name_Type) return String
8825 Result : String_Access;
8826 The_Directory : constant String := Get_Name_String (Directory);
8829 Get_Name_String (File_Name);
8832 (File_Name => Name_Buffer (1 .. Name_Len),
8833 Path => The_Directory);
8835 if Result = null then
8839 R : String := Result.all;
8842 Canonical_Case_File_Name (R);
8848 -------------------------------
8849 -- Prepare_Ada_Naming_Exceptions --
8850 -------------------------------
8852 procedure Prepare_Ada_Naming_Exceptions
8853 (List : Array_Element_Id;
8854 In_Tree : Project_Tree_Ref;
8855 Kind : Spec_Or_Body)
8857 Current : Array_Element_Id;
8858 Element : Array_Element;
8862 -- Traverse the list
8865 while Current /= No_Array_Element loop
8866 Element := In_Tree.Array_Elements.Table (Current);
8868 if Element.Index /= No_Name then
8871 Unit => Element.Index,
8872 Next => No_Ada_Naming_Exception);
8873 Reverse_Ada_Naming_Exceptions.Set
8874 (Unit, (Element.Value.Value, Element.Value.Index));
8876 Ada_Naming_Exceptions.Get (File_Name_Type (Element.Value.Value));
8877 Ada_Naming_Exception_Table.Increment_Last;
8878 Ada_Naming_Exception_Table.Table
8879 (Ada_Naming_Exception_Table.Last) := Unit;
8880 Ada_Naming_Exceptions.Set
8881 (File_Name_Type (Element.Value.Value),
8882 Ada_Naming_Exception_Table.Last);
8885 Current := Element.Next;
8887 end Prepare_Ada_Naming_Exceptions;
8889 ---------------------
8890 -- Project_Extends --
8891 ---------------------
8893 function Project_Extends
8894 (Extending : Project_Id;
8895 Extended : Project_Id;
8896 In_Tree : Project_Tree_Ref) return Boolean
8898 Current : Project_Id := Extending;
8902 if Current = No_Project then
8905 elsif Current = Extended then
8909 Current := In_Tree.Projects.Table (Current).Extends;
8911 end Project_Extends;
8913 -----------------------
8914 -- Record_Ada_Source --
8915 -----------------------
8917 procedure Record_Ada_Source
8918 (File_Name : File_Name_Type;
8919 Path_Name : Path_Name_Type;
8920 Project : Project_Id;
8921 In_Tree : Project_Tree_Ref;
8922 Data : in out Project_Data;
8923 Location : Source_Ptr;
8924 Current_Source : in out String_List_Id;
8925 Source_Recorded : in out Boolean;
8926 Current_Dir : String)
8928 Canonical_File_Name : File_Name_Type;
8929 Canonical_Path_Name : Path_Name_Type;
8931 Exception_Id : Ada_Naming_Exception_Id;
8932 Unit_Name : Name_Id;
8933 Unit_Kind : Spec_Or_Body;
8934 Unit_Ind : Int := 0;
8936 Name_Index : Name_And_Index;
8937 Needs_Pragma : Boolean;
8939 The_Location : Source_Ptr := Location;
8940 Previous_Source : constant String_List_Id := Current_Source;
8941 Except_Name : Name_And_Index := No_Name_And_Index;
8943 Unit_Prj : Unit_Project;
8945 File_Name_Recorded : Boolean := False;
8948 if Osint.File_Names_Case_Sensitive then
8949 Canonical_File_Name := File_Name;
8950 Canonical_Path_Name := Path_Name;
8952 Get_Name_String (File_Name);
8953 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
8954 Canonical_File_Name := Name_Find;
8957 Canonical_Path : constant String :=
8959 (Get_Name_String (Path_Name),
8960 Directory => Current_Dir,
8961 Resolve_Links => Opt.Follow_Links_For_Files,
8962 Case_Sensitive => False);
8965 Add_Str_To_Name_Buffer (Canonical_Path);
8966 Canonical_Path_Name := Name_Find;
8970 -- Find out the unit name, the unit kind and if it needs
8971 -- a specific SFN pragma.
8974 (In_Tree => In_Tree,
8975 Canonical_File_Name => Canonical_File_Name,
8976 Naming => Data.Naming,
8977 Exception_Id => Exception_Id,
8978 Unit_Name => Unit_Name,
8979 Unit_Kind => Unit_Kind,
8980 Needs_Pragma => Needs_Pragma);
8982 if Exception_Id = No_Ada_Naming_Exception
8983 and then Unit_Name = No_Name
8985 if Current_Verbosity = High then
8987 Write_Str (Get_Name_String (Canonical_File_Name));
8988 Write_Line (""" is not a valid source file name (ignored).");
8992 -- Check to see if the source has been hidden by an exception,
8993 -- but only if it is not an exception.
8995 if not Needs_Pragma then
8997 Reverse_Ada_Naming_Exceptions.Get
8998 ((Unit_Kind, Unit_Name, No_Ada_Naming_Exception));
9000 if Except_Name /= No_Name_And_Index then
9001 if Current_Verbosity = High then
9003 Write_Str (Get_Name_String (Canonical_File_Name));
9004 Write_Str (""" contains a unit that is found in """);
9005 Write_Str (Get_Name_String (Except_Name.Name));
9006 Write_Line (""" (ignored).");
9009 -- The file is not included in the source of the project since
9010 -- it is hidden by the exception. So, nothing else to do.
9017 if Exception_Id /= No_Ada_Naming_Exception then
9018 Info := Ada_Naming_Exception_Table.Table (Exception_Id);
9019 Exception_Id := Info.Next;
9020 Info.Next := No_Ada_Naming_Exception;
9021 Name_Index := Reverse_Ada_Naming_Exceptions.Get (Info);
9023 Unit_Name := Info.Unit;
9024 Unit_Ind := Name_Index.Index;
9025 Unit_Kind := Info.Kind;
9028 -- Put the file name in the list of sources of the project
9030 String_Element_Table.Increment_Last (In_Tree.String_Elements);
9031 In_Tree.String_Elements.Table
9032 (String_Element_Table.Last (In_Tree.String_Elements)) :=
9033 (Value => Name_Id (Canonical_File_Name),
9034 Display_Value => Name_Id (File_Name),
9035 Location => No_Location,
9040 if Current_Source = Nil_String then
9042 String_Element_Table.Last (In_Tree.String_Elements);
9044 In_Tree.String_Elements.Table (Current_Source).Next :=
9045 String_Element_Table.Last (In_Tree.String_Elements);
9049 String_Element_Table.Last (In_Tree.String_Elements);
9051 -- Put the unit in unit list
9054 The_Unit : Unit_Index :=
9055 Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
9057 The_Unit_Data : Unit_Data;
9060 if Current_Verbosity = High then
9061 Write_Str ("Putting ");
9062 Write_Str (Get_Name_String (Unit_Name));
9063 Write_Line (" in the unit list.");
9066 -- The unit is already in the list, but may be it is
9067 -- only the other unit kind (spec or body), or what is
9068 -- in the unit list is a unit of a project we are extending.
9070 if The_Unit /= No_Unit_Index then
9071 The_Unit_Data := In_Tree.Units.Table (The_Unit);
9073 if (The_Unit_Data.File_Names (Unit_Kind).Name =
9076 The_Unit_Data.File_Names
9077 (Unit_Kind).Path.Name = Slash)
9078 or else The_Unit_Data.File_Names (Unit_Kind).Name = No_File
9079 or else Project_Extends
9081 The_Unit_Data.File_Names (Unit_Kind).Project,
9085 The_Unit_Data.File_Names (Unit_Kind).Path.Name = Slash
9087 Remove_Forbidden_File_Name
9088 (The_Unit_Data.File_Names (Unit_Kind).Name);
9091 -- Record the file name in the hash table Files_Htable
9093 Unit_Prj := (Unit => The_Unit, Project => Project);
9096 Canonical_File_Name,
9099 The_Unit_Data.File_Names (Unit_Kind) :=
9100 (Name => Canonical_File_Name,
9102 Display_Name => File_Name,
9103 Path => (Canonical_Path_Name, Path_Name),
9105 Needs_Pragma => Needs_Pragma);
9106 In_Tree.Units.Table (The_Unit) := The_Unit_Data;
9107 Source_Recorded := True;
9109 elsif The_Unit_Data.File_Names (Unit_Kind).Project = Project
9110 and then (Data.Known_Order_Of_Source_Dirs
9112 The_Unit_Data.File_Names
9113 (Unit_Kind).Path.Name = Canonical_Path_Name)
9115 if Previous_Source = Nil_String then
9116 Data.Ada_Sources := Nil_String;
9118 In_Tree.String_Elements.Table (Previous_Source).Next :=
9120 String_Element_Table.Decrement_Last
9121 (In_Tree.String_Elements);
9124 Current_Source := Previous_Source;
9127 -- It is an error to have two units with the same name
9128 -- and the same kind (spec or body).
9130 if The_Location = No_Location then
9132 In_Tree.Projects.Table (Project).Location;
9135 Err_Vars.Error_Msg_Name_1 := Unit_Name;
9137 (Project, In_Tree, "duplicate unit %%", The_Location);
9139 Err_Vars.Error_Msg_Name_1 :=
9140 In_Tree.Projects.Table
9141 (The_Unit_Data.File_Names (Unit_Kind).Project).Name;
9142 Err_Vars.Error_Msg_File_1 :=
9144 (The_Unit_Data.File_Names (Unit_Kind).Path.Name);
9147 "\ project file %%, {", The_Location);
9149 Err_Vars.Error_Msg_Name_1 :=
9150 In_Tree.Projects.Table (Project).Name;
9151 Err_Vars.Error_Msg_File_1 :=
9152 File_Name_Type (Canonical_Path_Name);
9155 "\ project file %%, {", The_Location);
9158 -- It is a new unit, create a new record
9161 -- First, check if there is no other unit with this file
9162 -- name in another project. If it is, report error but note
9163 -- we do that only for the first unit in the source file.
9166 Files_Htable.Get (In_Tree.Files_HT, Canonical_File_Name);
9168 if not File_Name_Recorded and then
9169 Unit_Prj /= No_Unit_Project
9171 Error_Msg_File_1 := File_Name;
9173 In_Tree.Projects.Table (Unit_Prj.Project).Name;
9176 "{ is already a source of project %%",
9180 Unit_Table.Increment_Last (In_Tree.Units);
9181 The_Unit := Unit_Table.Last (In_Tree.Units);
9183 (In_Tree.Units_HT, Unit_Name, The_Unit);
9184 Unit_Prj := (Unit => The_Unit, Project => Project);
9187 Canonical_File_Name,
9189 The_Unit_Data.Name := Unit_Name;
9190 The_Unit_Data.File_Names (Unit_Kind) :=
9191 (Name => Canonical_File_Name,
9193 Display_Name => File_Name,
9194 Path => (Canonical_Path_Name, Path_Name),
9196 Needs_Pragma => Needs_Pragma);
9197 In_Tree.Units.Table (The_Unit) := The_Unit_Data;
9198 Source_Recorded := True;
9203 exit when Exception_Id = No_Ada_Naming_Exception;
9204 File_Name_Recorded := True;
9207 end Record_Ada_Source;
9213 procedure Remove_Source
9215 Replaced_By : Source_Id;
9216 Project : Project_Id;
9217 Data : in out Project_Data;
9218 In_Tree : Project_Tree_Ref)
9220 Src_Data : constant Source_Data := In_Tree.Sources.Table (Id);
9224 if Current_Verbosity = High then
9225 Write_Str ("Removing source #");
9226 Write_Line (Id'Img);
9229 if Replaced_By /= No_Source then
9230 In_Tree.Sources.Table (Id).Replaced_By := Replaced_By;
9231 In_Tree.Sources.Table (Replaced_By).Declared_In_Interfaces :=
9232 In_Tree.Sources.Table (Id).Declared_In_Interfaces;
9235 -- Remove the source from the global source list
9237 Source := In_Tree.First_Source;
9240 In_Tree.First_Source := Src_Data.Next_In_Sources;
9243 while In_Tree.Sources.Table (Source).Next_In_Sources /= Id loop
9244 Source := In_Tree.Sources.Table (Source).Next_In_Sources;
9247 In_Tree.Sources.Table (Source).Next_In_Sources :=
9248 Src_Data.Next_In_Sources;
9251 -- Remove the source from the project list
9253 if Src_Data.Project = Project then
9254 Source := Data.First_Source;
9257 Data.First_Source := Src_Data.Next_In_Project;
9259 if Src_Data.Next_In_Project = No_Source then
9260 Data.Last_Source := No_Source;
9264 while In_Tree.Sources.Table (Source).Next_In_Project /= Id loop
9265 Source := In_Tree.Sources.Table (Source).Next_In_Project;
9268 In_Tree.Sources.Table (Source).Next_In_Project :=
9269 Src_Data.Next_In_Project;
9271 if Src_Data.Next_In_Project = No_Source then
9272 In_Tree.Projects.Table (Src_Data.Project).Last_Source := Source;
9277 Source := In_Tree.Projects.Table (Src_Data.Project).First_Source;
9280 In_Tree.Projects.Table (Src_Data.Project).First_Source :=
9281 Src_Data.Next_In_Project;
9283 if Src_Data.Next_In_Project = No_Source then
9284 In_Tree.Projects.Table (Src_Data.Project).Last_Source :=
9289 while In_Tree.Sources.Table (Source).Next_In_Project /= Id loop
9290 Source := In_Tree.Sources.Table (Source).Next_In_Project;
9293 In_Tree.Sources.Table (Source).Next_In_Project :=
9294 Src_Data.Next_In_Project;
9296 if Src_Data.Next_In_Project = No_Source then
9297 In_Tree.Projects.Table (Src_Data.Project).Last_Source := Source;
9302 -- Remove source from the language list
9304 Source := In_Tree.Languages_Data.Table (Src_Data.Language).First_Source;
9307 In_Tree.Languages_Data.Table (Src_Data.Language).First_Source :=
9308 Src_Data.Next_In_Lang;
9311 while In_Tree.Sources.Table (Source).Next_In_Lang /= Id loop
9312 Source := In_Tree.Sources.Table (Source).Next_In_Lang;
9315 In_Tree.Sources.Table (Source).Next_In_Lang :=
9316 Src_Data.Next_In_Lang;
9320 -----------------------
9321 -- Report_No_Sources --
9322 -----------------------
9324 procedure Report_No_Sources
9325 (Project : Project_Id;
9327 In_Tree : Project_Tree_Ref;
9328 Location : Source_Ptr;
9329 Continuation : Boolean := False)
9332 case When_No_Sources is
9336 when Warning | Error =>
9338 Msg : constant String :=
9341 " sources in this project";
9344 Error_Msg_Warn := When_No_Sources = Warning;
9346 if Continuation then
9348 (Project, In_Tree, "\" & Msg, Location);
9352 (Project, In_Tree, Msg, Location);
9356 end Report_No_Sources;
9358 ----------------------
9359 -- Show_Source_Dirs --
9360 ----------------------
9362 procedure Show_Source_Dirs
9363 (Data : Project_Data;
9364 In_Tree : Project_Tree_Ref)
9366 Current : String_List_Id;
9367 Element : String_Element;
9370 Write_Line ("Source_Dirs:");
9372 Current := Data.Source_Dirs;
9373 while Current /= Nil_String loop
9374 Element := In_Tree.String_Elements.Table (Current);
9376 Write_Line (Get_Name_String (Element.Value));
9377 Current := Element.Next;
9380 Write_Line ("end Source_Dirs.");
9381 end Show_Source_Dirs;
9383 -------------------------
9384 -- Warn_If_Not_Sources --
9385 -------------------------
9387 -- comments needed in this body ???
9389 procedure Warn_If_Not_Sources
9390 (Project : Project_Id;
9391 In_Tree : Project_Tree_Ref;
9392 Conventions : Array_Element_Id;
9394 Extending : Boolean)
9396 Conv : Array_Element_Id;
9398 The_Unit_Id : Unit_Index;
9399 The_Unit_Data : Unit_Data;
9400 Location : Source_Ptr;
9403 Conv := Conventions;
9404 while Conv /= No_Array_Element loop
9405 Unit := In_Tree.Array_Elements.Table (Conv).Index;
9406 Error_Msg_Name_1 := Unit;
9407 Get_Name_String (Unit);
9408 To_Lower (Name_Buffer (1 .. Name_Len));
9410 The_Unit_Id := Units_Htable.Get (In_Tree.Units_HT, Unit);
9411 Location := In_Tree.Array_Elements.Table (Conv).Value.Location;
9413 if The_Unit_Id = No_Unit_Index then
9414 Error_Msg (Project, In_Tree, "?unknown unit %%", Location);
9417 The_Unit_Data := In_Tree.Units.Table (The_Unit_Id);
9419 In_Tree.Array_Elements.Table (Conv).Value.Value;
9422 if not Check_Project
9423 (The_Unit_Data.File_Names (Specification).Project,
9424 Project, In_Tree, Extending)
9428 "?source of spec of unit %% (%%)" &
9429 " cannot be found in this project",
9434 if not Check_Project
9435 (The_Unit_Data.File_Names (Body_Part).Project,
9436 Project, In_Tree, Extending)
9440 "?source of body of unit %% (%%)" &
9441 " cannot be found in this project",
9447 Conv := In_Tree.Array_Elements.Table (Conv).Next;
9449 end Warn_If_Not_Sources;