1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Ada.Characters.Handling; use Ada.Characters.Handling;
29 with Output; use Output;
30 with Osint; use Osint;
33 with Prj.Err; use Prj.Err;
34 with Snames; use Snames;
35 with Uintp; use Uintp;
37 with GNAT.Case_Util; use GNAT.Case_Util;
41 Initial_Buffer_Size : constant := 100;
42 -- Initial size for extensible buffer used in Add_To_Buffer
44 The_Empty_String : Name_Id;
46 Name_C_Plus_Plus : Name_Id;
48 Default_Ada_Spec_Suffix_Id : File_Name_Type;
49 Default_Ada_Body_Suffix_Id : File_Name_Type;
50 Slash_Id : File_Name_Type;
51 -- Initialized in Prj.Initialized, then never modified
53 subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
55 The_Casing_Images : constant array (Known_Casing) of String_Access :=
56 (All_Lower_Case => new String'("lowercase"),
57 All_Upper_Case => new String'("UPPERCASE"),
58 Mixed_Case => new String'("MixedCase"));
60 Initialized : Boolean := False;
62 Standard_Dot_Replacement : constant File_Name_Type :=
64 (First_Name_Id + Character'Pos ('-'));
66 Std_Naming_Data : Naming_Data :=
67 (Dot_Replacement => Standard_Dot_Replacement,
68 Dot_Repl_Loc => No_Location,
69 Casing => All_Lower_Case,
70 Spec_Suffix => No_Array_Element,
71 Ada_Spec_Suffix => No_File,
72 Spec_Suffix_Loc => No_Location,
73 Impl_Suffixes => No_Impl_Suffixes,
74 Supp_Suffixes => No_Supp_Language_Index,
75 Body_Suffix => No_Array_Element,
76 Ada_Body_Suffix => No_File,
77 Body_Suffix_Loc => No_Location,
78 Separate_Suffix => No_File,
79 Sep_Suffix_Loc => No_Location,
80 Specs => No_Array_Element,
81 Bodies => No_Array_Element,
82 Specification_Exceptions => No_Array_Element,
83 Implementation_Exceptions => No_Array_Element);
85 Project_Empty : Project_Data :=
86 (Externally_Built => False,
87 Languages => No_Languages,
88 Supp_Languages => No_Supp_Language_Index,
89 First_Referred_By => No_Project,
91 Display_Name => No_Name,
93 Display_Path_Name => No_Path,
95 Location => No_Location,
98 Display_Directory => No_Path,
101 Library_Dir => No_Path,
102 Display_Library_Dir => No_Path,
103 Library_Src_Dir => No_Path,
104 Display_Library_Src_Dir => No_Path,
105 Library_ALI_Dir => No_Path,
106 Display_Library_ALI_Dir => No_Path,
107 Library_Name => No_File,
108 Library_Kind => Static,
109 Lib_Internal_Name => No_File,
110 Standalone_Library => False,
111 Lib_Interface_ALIs => Nil_String,
112 Lib_Auto_Init => False,
113 Libgnarl_Needed => Unknown,
114 Symbol_Data => No_Symbols,
115 Ada_Sources_Present => True,
116 Other_Sources_Present => True,
117 Sources => Nil_String,
118 First_Other_Source => No_Other_Source,
119 Last_Other_Source => No_Other_Source,
120 Imported_Directories_Switches => null,
121 Include_Path => null,
122 Include_Data_Set => False,
123 Source_Dirs => Nil_String,
124 Known_Order_Of_Source_Dirs => True,
125 Object_Directory => No_Path,
126 Display_Object_Dir => No_Path,
127 Library_TS => Empty_Time_Stamp,
128 Exec_Directory => No_Path,
129 Display_Exec_Dir => No_Path,
130 Extends => No_Project,
131 Extended_By => No_Project,
132 Naming => Std_Naming_Data,
133 First_Language_Processing => Default_First_Language_Processing_Data,
134 Supp_Language_Processing => No_Supp_Language_Index,
135 Default_Linker => No_File,
136 Default_Linker_Path => No_Path,
137 Decl => No_Declarations,
138 Imported_Projects => Empty_Project_List,
139 All_Imported_Projects => Empty_Project_List,
140 Ada_Include_Path => null,
141 Ada_Objects_Path => null,
142 Include_Path_File => No_Path,
143 Objects_Path_File_With_Libs => No_Path,
144 Objects_Path_File_Without_Libs => No_Path,
145 Config_File_Name => No_Path,
146 Config_File_Temp => False,
147 Config_Checked => False,
148 Language_Independent_Checked => False,
151 Need_To_Build_Lib => False,
153 Unkept_Comments => False);
155 -----------------------
156 -- Add_Language_Name --
157 -----------------------
159 procedure Add_Language_Name (Name : Name_Id) is
161 Last_Language_Index := Last_Language_Index + 1;
162 Language_Indexes.Set (Name, Last_Language_Index);
163 Language_Names.Increment_Last;
164 Language_Names.Table (Last_Language_Index) := Name;
165 end Add_Language_Name;
171 procedure Add_To_Buffer
173 To : in out String_Access;
174 Last : in out Natural)
178 To := new String (1 .. Initial_Buffer_Size);
182 -- If Buffer is too small, double its size
184 while Last + S'Length > To'Last loop
186 New_Buffer : constant String_Access := new String (1 .. 2 * Last);
189 New_Buffer (1 .. Last) := To (1 .. Last);
195 To (Last + 1 .. Last + S'Length) := S;
196 Last := Last + S'Length;
199 -----------------------------
200 -- Default_Ada_Body_Suffix --
201 -----------------------------
203 function Default_Ada_Body_Suffix return File_Name_Type is
205 return Default_Ada_Body_Suffix_Id;
206 end Default_Ada_Body_Suffix;
208 -----------------------------
209 -- Default_Ada_Spec_Suffix --
210 -----------------------------
212 function Default_Ada_Spec_Suffix return File_Name_Type is
214 return Default_Ada_Spec_Suffix_Id;
215 end Default_Ada_Spec_Suffix;
217 ---------------------------
218 -- Display_Language_Name --
219 ---------------------------
221 procedure Display_Language_Name (Language : Language_Index) is
223 Get_Name_String (Language_Names.Table (Language));
224 To_Upper (Name_Buffer (1 .. 1));
225 Write_Str (Name_Buffer (1 .. Name_Len));
226 end Display_Language_Name;
232 function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
233 Value : Project_Data;
235 Prj.Initialize (Tree => No_Project_Tree);
236 Value := Project_Empty;
237 Value.Naming := Tree.Private_Part.Default_Naming;
245 function Empty_String return Name_Id is
247 return The_Empty_String;
254 procedure Expect (The_Token : Token_Type; Token_Image : String) is
256 if Token /= The_Token then
257 Error_Msg (Token_Image & " expected", Token_Ptr);
261 --------------------------------
262 -- For_Every_Project_Imported --
263 --------------------------------
265 procedure For_Every_Project_Imported
267 In_Tree : Project_Tree_Ref;
268 With_State : in out State)
271 procedure Recursive_Check (Project : Project_Id);
272 -- Check if a project has already been seen. If not seen, mark it as
273 -- Seen, Call Action, and check all its imported projects.
275 ---------------------
276 -- Recursive_Check --
277 ---------------------
279 procedure Recursive_Check (Project : Project_Id) is
283 if not In_Tree.Projects.Table (Project).Seen then
284 In_Tree.Projects.Table (Project).Seen := True;
285 Action (Project, With_State);
288 In_Tree.Projects.Table (Project).Imported_Projects;
289 while List /= Empty_Project_List loop
290 Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
291 List := In_Tree.Project_Lists.Table (List).Next;
296 -- Start of processing for For_Every_Project_Imported
299 for Project in Project_Table.First ..
300 Project_Table.Last (In_Tree.Projects)
302 In_Tree.Projects.Table (Project).Seen := False;
305 Recursive_Check (Project => By);
306 end For_Every_Project_Imported;
312 function Hash (Name : Name_Id) return Header_Num is
314 return Hash (Get_Name_String (Name));
317 function Hash (Name : File_Name_Type) return Header_Num is
319 return Hash (Get_Name_String (Name));
326 function Image (Casing : Casing_Type) return String is
328 return The_Casing_Images (Casing).all;
335 procedure Initialize (Tree : Project_Tree_Ref) is
337 if not Initialized then
341 The_Empty_String := Name_Find;
342 Empty_Name := The_Empty_String;
344 Name_Buffer (1 .. 4) := ".ads";
345 Default_Ada_Spec_Suffix_Id := Name_Find;
347 Name_Buffer (1 .. 4) := ".adb";
348 Default_Ada_Body_Suffix_Id := Name_Find;
350 Name_Buffer (1) := '/';
351 Slash_Id := Name_Find;
353 Name_Buffer (1 .. 3) := "c++";
354 Name_C_Plus_Plus := Name_Find;
356 Std_Naming_Data.Ada_Spec_Suffix := Default_Ada_Spec_Suffix;
357 Std_Naming_Data.Ada_Body_Suffix := Default_Ada_Body_Suffix;
358 Std_Naming_Data.Separate_Suffix := Default_Ada_Body_Suffix;
359 Project_Empty.Naming := Std_Naming_Data;
362 Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
363 Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
364 Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
366 Language_Indexes.Reset;
367 Last_Language_Index := No_Language_Index;
369 Add_Language_Name (Name_Ada);
370 Add_Language_Name (Name_C);
371 Add_Language_Name (Name_C_Plus_Plus);
374 if Tree /= No_Project_Tree then
384 (Language : Language_Index;
385 In_Project : Project_Data;
386 In_Tree : Project_Tree_Ref) return Boolean
390 when No_Language_Index =>
393 when First_Language_Indexes =>
394 return In_Project.Languages (Language);
398 Supp : Supp_Language;
399 Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
402 while Supp_Index /= No_Supp_Language_Index loop
403 Supp := In_Tree.Present_Languages.Table (Supp_Index);
405 if Supp.Index = Language then
409 Supp_Index := Supp.Next;
417 ---------------------------------
418 -- Language_Processing_Data_Of --
419 ---------------------------------
421 function Language_Processing_Data_Of
422 (Language : Language_Index;
423 In_Project : Project_Data;
424 In_Tree : Project_Tree_Ref) return Language_Processing_Data
428 when No_Language_Index =>
429 return Default_Language_Processing_Data;
431 when First_Language_Indexes =>
432 return In_Project.First_Language_Processing (Language);
436 Supp : Supp_Language_Data;
437 Supp_Index : Supp_Language_Index :=
438 In_Project.Supp_Language_Processing;
441 while Supp_Index /= No_Supp_Language_Index loop
442 Supp := In_Tree.Supp_Languages.Table (Supp_Index);
444 if Supp.Index = Language then
448 Supp_Index := Supp.Next;
451 return Default_Language_Processing_Data;
454 end Language_Processing_Data_Of;
456 ------------------------------------
457 -- Register_Default_Naming_Scheme --
458 ------------------------------------
460 procedure Register_Default_Naming_Scheme
462 Default_Spec_Suffix : File_Name_Type;
463 Default_Body_Suffix : File_Name_Type;
464 In_Tree : Project_Tree_Ref)
467 Suffix : Array_Element_Id;
468 Found : Boolean := False;
469 Element : Array_Element;
472 -- Get the language name in small letters
474 Get_Name_String (Language);
475 Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
478 Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
481 -- Look for an element of the spec sufix array indexed by the language
482 -- name. If one is found, put the default value.
484 while Suffix /= No_Array_Element and then not Found loop
485 Element := In_Tree.Array_Elements.Table (Suffix);
487 if Element.Index = Lang then
489 Element.Value.Value := Name_Id (Default_Spec_Suffix);
490 In_Tree.Array_Elements.Table (Suffix) := Element;
493 Suffix := Element.Next;
497 -- If none can be found, create a new one
503 Index_Case_Sensitive => False,
504 Value => (Project => No_Project,
506 Location => No_Location,
508 Value => Name_Id (Default_Spec_Suffix),
510 Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
512 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
514 In_Tree.Array_Elements.Table
515 (Array_Element_Table.Last (In_Tree.Array_Elements)) := Element;
517 In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
518 Array_Element_Table.Last (In_Tree.Array_Elements);
521 Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
524 -- Look for an element of the body sufix array indexed by the language
525 -- name. If one is found, put the default value.
527 while Suffix /= No_Array_Element and then not Found loop
528 Element := In_Tree.Array_Elements.Table (Suffix);
530 if Element.Index = Lang then
532 Element.Value.Value := Name_Id (Default_Body_Suffix);
533 In_Tree.Array_Elements.Table (Suffix) := Element;
536 Suffix := Element.Next;
540 -- If none can be found, create a new one
546 Index_Case_Sensitive => False,
547 Value => (Project => No_Project,
549 Location => No_Location,
551 Value => Name_Id (Default_Body_Suffix),
553 Next => In_Tree.Private_Part.Default_Naming.Body_Suffix);
554 Array_Element_Table.Increment_Last
555 (In_Tree.Array_Elements);
556 In_Tree.Array_Elements.Table
557 (Array_Element_Table.Last (In_Tree.Array_Elements))
559 In_Tree.Private_Part.Default_Naming.Body_Suffix :=
560 Array_Element_Table.Last (In_Tree.Array_Elements);
562 end Register_Default_Naming_Scheme;
568 procedure Reset (Tree : Project_Tree_Ref) is
571 Present_Language_Table.Init (Tree.Present_Languages);
572 Supp_Suffix_Table.Init (Tree.Supp_Suffixes);
573 Name_List_Table.Init (Tree.Name_Lists);
574 Supp_Language_Table.Init (Tree.Supp_Languages);
575 Other_Source_Table.Init (Tree.Other_Sources);
576 String_Element_Table.Init (Tree.String_Elements);
577 Variable_Element_Table.Init (Tree.Variable_Elements);
578 Array_Element_Table.Init (Tree.Array_Elements);
579 Array_Table.Init (Tree.Arrays);
580 Package_Table.Init (Tree.Packages);
581 Project_List_Table.Init (Tree.Project_Lists);
582 Project_Table.Init (Tree.Projects);
583 Unit_Table.Init (Tree.Units);
584 Units_Htable.Reset (Tree.Units_HT);
585 Files_Htable.Reset (Tree.Files_HT);
586 Naming_Table.Init (Tree.Private_Part.Namings);
587 Naming_Table.Increment_Last (Tree.Private_Part.Namings);
588 Tree.Private_Part.Namings.Table
589 (Naming_Table.Last (Tree.Private_Part.Namings)) := Std_Naming_Data;
590 Path_File_Table.Init (Tree.Private_Part.Path_Files);
591 Source_Path_Table.Init (Tree.Private_Part.Source_Paths);
592 Object_Path_Table.Init (Tree.Private_Part.Object_Paths);
593 Tree.Private_Part.Default_Naming := Std_Naming_Data;
594 Register_Default_Naming_Scheme
595 (Language => Name_Ada,
596 Default_Spec_Suffix => Default_Ada_Spec_Suffix,
597 Default_Body_Suffix => Default_Ada_Body_Suffix,
601 ------------------------
602 -- Same_Naming_Scheme --
603 ------------------------
605 function Same_Naming_Scheme
606 (Left, Right : Naming_Data) return Boolean
609 return Left.Dot_Replacement = Right.Dot_Replacement
610 and then Left.Casing = Right.Casing
611 and then Left.Ada_Spec_Suffix = Right.Ada_Spec_Suffix
612 and then Left.Ada_Body_Suffix = Right.Ada_Body_Suffix
613 and then Left.Separate_Suffix = Right.Separate_Suffix;
614 end Same_Naming_Scheme;
621 (Language : Language_Index;
623 In_Project : in out Project_Data;
624 In_Tree : Project_Tree_Ref)
628 when No_Language_Index =>
631 when First_Language_Indexes =>
632 In_Project.Languages (Language) := Present;
636 Supp : Supp_Language;
637 Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
640 while Supp_Index /= No_Supp_Language_Index loop
641 Supp := In_Tree.Present_Languages.Table
644 if Supp.Index = Language then
645 In_Tree.Present_Languages.Table
646 (Supp_Index).Present := Present;
650 Supp_Index := Supp.Next;
653 Supp := (Index => Language, Present => Present,
654 Next => In_Project.Supp_Languages);
655 Present_Language_Table.Increment_Last
656 (In_Tree.Present_Languages);
657 Supp_Index := Present_Language_Table.Last
658 (In_Tree.Present_Languages);
659 In_Tree.Present_Languages.Table (Supp_Index) :=
661 In_Project.Supp_Languages := Supp_Index;
667 (Language_Processing : Language_Processing_Data;
668 For_Language : Language_Index;
669 In_Project : in out Project_Data;
670 In_Tree : Project_Tree_Ref)
674 when No_Language_Index =>
677 when First_Language_Indexes =>
678 In_Project.First_Language_Processing (For_Language) :=
683 Supp : Supp_Language_Data;
684 Supp_Index : Supp_Language_Index :=
685 In_Project.Supp_Language_Processing;
688 while Supp_Index /= No_Supp_Language_Index loop
689 Supp := In_Tree.Supp_Languages.Table (Supp_Index);
691 if Supp.Index = For_Language then
692 In_Tree.Supp_Languages.Table
693 (Supp_Index).Data := Language_Processing;
697 Supp_Index := Supp.Next;
700 Supp := (Index => For_Language, Data => Language_Processing,
701 Next => In_Project.Supp_Language_Processing);
702 Supp_Language_Table.Increment_Last
703 (In_Tree.Supp_Languages);
704 Supp_Index := Supp_Language_Table.Last
705 (In_Tree.Supp_Languages);
706 In_Tree.Supp_Languages.Table (Supp_Index) := Supp;
707 In_Project.Supp_Language_Processing := Supp_Index;
713 (Suffix : File_Name_Type;
714 For_Language : Language_Index;
715 In_Project : in out Project_Data;
716 In_Tree : Project_Tree_Ref)
720 when No_Language_Index =>
723 when First_Language_Indexes =>
724 In_Project.Naming.Impl_Suffixes (For_Language) := Suffix;
729 Supp_Index : Supp_Language_Index :=
730 In_Project.Naming.Supp_Suffixes;
733 while Supp_Index /= No_Supp_Language_Index loop
734 Supp := In_Tree.Supp_Suffixes.Table
737 if Supp.Index = For_Language then
738 In_Tree.Supp_Suffixes.Table
739 (Supp_Index).Suffix := Suffix;
743 Supp_Index := Supp.Next;
746 Supp := (Index => For_Language, Suffix => Suffix,
747 Next => In_Project.Naming.Supp_Suffixes);
748 Supp_Suffix_Table.Increment_Last
749 (In_Tree.Supp_Suffixes);
750 Supp_Index := Supp_Suffix_Table.Last
751 (In_Tree.Supp_Suffixes);
752 In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
753 In_Project.Naming.Supp_Suffixes := Supp_Index;
762 function Slash return File_Name_Type is
767 --------------------------
768 -- Standard_Naming_Data --
769 --------------------------
771 function Standard_Naming_Data
772 (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
775 if Tree = No_Project_Tree then
776 Prj.Initialize (Tree => No_Project_Tree);
777 return Std_Naming_Data;
780 return Tree.Private_Part.Default_Naming;
782 end Standard_Naming_Data;
789 (Language : Language_Index;
790 In_Project : Project_Data;
791 In_Tree : Project_Tree_Ref) return File_Name_Type
795 when No_Language_Index =>
798 when First_Language_Indexes =>
799 return In_Project.Naming.Impl_Suffixes (Language);
804 Supp_Index : Supp_Language_Index :=
805 In_Project.Naming.Supp_Suffixes;
808 while Supp_Index /= No_Supp_Language_Index loop
809 Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
811 if Supp.Index = Language then
815 Supp_Index := Supp.Next;
827 function Value (Image : String) return Casing_Type is
829 for Casing in The_Casing_Images'Range loop
830 if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
835 raise Constraint_Error;
839 -- Make sure that the standard project file extension is compatible
840 -- with canonical case file naming.
842 Canonical_Case_File_Name (Project_File_Extension);