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 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 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 System.Case_Util; use System.Case_Util;
41 Object_Suffix : constant String := Get_Target_Object_Suffix.all;
42 -- File suffix for object files
44 Initial_Buffer_Size : constant := 100;
45 -- Initial size for extensible buffer used in Add_To_Buffer
47 Current_Mode : Mode := Ada_Only;
49 Configuration_Mode : Boolean := False;
51 The_Empty_String : Name_Id;
53 Name_C_Plus_Plus : Name_Id;
55 Default_Ada_Spec_Suffix_Id : File_Name_Type;
56 Default_Ada_Body_Suffix_Id : File_Name_Type;
57 Slash_Id : Path_Name_Type;
58 -- Initialized in Prj.Initialize, then never modified
60 subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
62 The_Casing_Images : constant array (Known_Casing) of String_Access :=
63 (All_Lower_Case => new String'("lowercase"),
64 All_Upper_Case => new String'("UPPERCASE"),
65 Mixed_Case => new String'("MixedCase"));
67 Initialized : Boolean := False;
69 Standard_Dot_Replacement : constant File_Name_Type :=
71 (First_Name_Id + Character'Pos ('-'));
73 Std_Naming_Data : constant Naming_Data :=
74 (Dot_Replacement => Standard_Dot_Replacement,
75 Dot_Repl_Loc => No_Location,
76 Casing => All_Lower_Case,
77 Spec_Suffix => No_Array_Element,
78 Ada_Spec_Suffix_Loc => No_Location,
79 Body_Suffix => No_Array_Element,
80 Ada_Body_Suffix_Loc => No_Location,
81 Separate_Suffix => No_File,
82 Sep_Suffix_Loc => No_Location,
83 Specs => No_Array_Element,
84 Bodies => No_Array_Element,
85 Specification_Exceptions => No_Array_Element,
86 Implementation_Exceptions => No_Array_Element,
87 Impl_Suffixes => No_Impl_Suffixes,
88 Supp_Suffixes => No_Supp_Language_Index);
90 Project_Empty : constant Project_Data :=
91 (Externally_Built => False,
92 Config => Default_Project_Config,
93 Languages => No_Name_List,
94 First_Referred_By => No_Project,
96 Display_Name => No_Name,
98 Display_Path_Name => No_Path,
100 Location => No_Location,
102 Directory => No_Path,
103 Display_Directory => No_Path,
106 Library_Dir => No_Path,
107 Display_Library_Dir => No_Path,
108 Library_Src_Dir => No_Path,
109 Display_Library_Src_Dir => No_Path,
110 Library_ALI_Dir => No_Path,
111 Display_Library_ALI_Dir => No_Path,
112 Library_Name => No_Name,
113 Library_Kind => Static,
114 Lib_Internal_Name => No_Name,
115 Standalone_Library => False,
116 Lib_Interface_ALIs => Nil_String,
117 Lib_Auto_Init => False,
118 Libgnarl_Needed => Unknown,
119 Symbol_Data => No_Symbols,
120 Ada_Sources => Nil_String,
121 Sources => Nil_String,
122 First_Source => No_Source,
123 Last_Source => No_Source,
124 Unit_Based_Language_Name => No_Name,
125 Unit_Based_Language_Index => No_Language_Index,
126 Imported_Directories_Switches => null,
127 Include_Path => null,
128 Include_Data_Set => False,
129 Include_Language => No_Language_Index,
130 Source_Dirs => Nil_String,
131 Known_Order_Of_Source_Dirs => True,
132 Object_Directory => No_Path,
133 Display_Object_Dir => No_Path,
134 Library_TS => Empty_Time_Stamp,
135 Exec_Directory => No_Path,
136 Display_Exec_Dir => No_Path,
137 Extends => No_Project,
138 Extended_By => No_Project,
139 Naming => Std_Naming_Data,
140 First_Language_Processing => No_Language_Index,
141 Decl => No_Declarations,
142 Imported_Projects => Empty_Project_List,
143 All_Imported_Projects => Empty_Project_List,
144 Ada_Include_Path => null,
145 Ada_Objects_Path => null,
146 Objects_Path => null,
147 Include_Path_File => No_Path,
148 Objects_Path_File_With_Libs => No_Path,
149 Objects_Path_File_Without_Libs => No_Path,
150 Config_File_Name => No_Path,
151 Config_File_Temp => False,
152 Linker_Name => No_File,
153 Linker_Path => No_Path,
154 Minimum_Linker_Options => No_Name_List,
155 Config_Checked => False,
158 Need_To_Build_Lib => False,
160 Unkept_Comments => False,
161 Langs => No_Languages,
162 Supp_Languages => No_Supp_Language_Index,
163 Ada_Sources_Present => True,
164 Other_Sources_Present => True,
165 First_Other_Source => No_Other_Source,
166 Last_Other_Source => No_Other_Source,
167 First_Lang_Processing => Default_First_Language_Processing_Data,
168 Supp_Language_Processing => No_Supp_Language_Index);
170 package Temp_Files is new Table.Table
171 (Table_Component_Type => Path_Name_Type,
172 Table_Index_Type => Integer,
173 Table_Low_Bound => 1,
175 Table_Increment => 100,
176 Table_Name => "Makegpr.Temp_Files");
177 -- Table to store the path name of all the created temporary files, so that
178 -- they can be deleted at the end, or when the program is interrupted.
180 -----------------------
181 -- Add_Language_Name --
182 -----------------------
184 procedure Add_Language_Name (Name : Name_Id) is
186 Last_Language_Index := Last_Language_Index + 1;
187 Language_Indexes.Set (Name, Last_Language_Index);
188 Language_Names.Increment_Last;
189 Language_Names.Table (Last_Language_Index) := Name;
190 end Add_Language_Name;
196 procedure Add_To_Buffer
198 To : in out String_Access;
199 Last : in out Natural)
203 To := new String (1 .. Initial_Buffer_Size);
207 -- If Buffer is too small, double its size
209 while Last + S'Length > To'Last loop
211 New_Buffer : constant String_Access :=
212 new String (1 .. 2 * Last);
215 New_Buffer (1 .. Last) := To (1 .. Last);
221 To (Last + 1 .. Last + S'Length) := S;
222 Last := Last + S'Length;
225 -----------------------
226 -- Body_Suffix_Id_Of --
227 -----------------------
229 function Body_Suffix_Id_Of
230 (In_Tree : Project_Tree_Ref;
232 Naming : Naming_Data) return File_Name_Type
234 Language_Id : Name_Id;
238 Add_Str_To_Name_Buffer (Language);
239 To_Lower (Name_Buffer (1 .. Name_Len));
240 Language_Id := Name_Find;
245 Language_Id => Language_Id,
247 end Body_Suffix_Id_Of;
249 -----------------------
250 -- Body_Suffix_Id_Of --
251 -----------------------
253 function Body_Suffix_Id_Of
254 (In_Tree : Project_Tree_Ref;
255 Language_Id : Name_Id;
256 Naming : Naming_Data) return File_Name_Type
258 Element_Id : Array_Element_Id;
259 Element : Array_Element;
260 Suffix : File_Name_Type := No_File;
261 Lang : Language_Index;
264 -- ??? This seems to be only for Ada_Only mode...
265 Element_Id := Naming.Body_Suffix;
266 while Element_Id /= No_Array_Element loop
267 Element := In_Tree.Array_Elements.Table (Element_Id);
269 if Element.Index = Language_Id then
270 return File_Name_Type (Element.Value.Value);
273 Element_Id := Element.Next;
276 if Current_Mode = Multi_Language then
277 Lang := In_Tree.First_Language;
278 while Lang /= No_Language_Index loop
279 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
281 In_Tree.Languages_Data.Table
282 (Lang).Config.Naming_Data.Body_Suffix;
286 Lang := In_Tree.Languages_Data.Table (Lang).Next;
291 end Body_Suffix_Id_Of;
297 function Body_Suffix_Of
298 (In_Tree : Project_Tree_Ref;
300 Naming : Naming_Data) return String
302 Language_Id : Name_Id;
303 Element_Id : Array_Element_Id;
304 Element : Array_Element;
305 Suffix : File_Name_Type := No_File;
306 Lang : Language_Index;
310 Add_Str_To_Name_Buffer (Language);
311 To_Lower (Name_Buffer (1 .. Name_Len));
312 Language_Id := Name_Find;
314 Element_Id := Naming.Body_Suffix;
315 while Element_Id /= No_Array_Element loop
316 Element := In_Tree.Array_Elements.Table (Element_Id);
318 if Element.Index = Language_Id then
319 return Get_Name_String (Element.Value.Value);
322 Element_Id := Element.Next;
325 if Current_Mode = Multi_Language then
326 Lang := In_Tree.First_Language;
327 while Lang /= No_Language_Index loop
328 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
331 (In_Tree.Languages_Data.Table
332 (Lang).Config.Naming_Data.Body_Suffix);
336 Lang := In_Tree.Languages_Data.Table (Lang).Next;
339 if Suffix /= No_File then
340 return Get_Name_String (Suffix);
347 function Body_Suffix_Of
348 (Language : Language_Index;
349 In_Project : Project_Data;
350 In_Tree : Project_Tree_Ref) return String
352 Suffix_Id : constant File_Name_Type :=
353 Suffix_Of (Language, In_Project, In_Tree);
355 if Suffix_Id /= No_File then
356 return Get_Name_String (Suffix_Id);
358 return "." & Get_Name_String (Language_Names.Table (Language));
362 -----------------------------
363 -- Default_Ada_Body_Suffix --
364 -----------------------------
366 function Default_Ada_Body_Suffix return File_Name_Type is
368 return Default_Ada_Body_Suffix_Id;
369 end Default_Ada_Body_Suffix;
371 -----------------------------
372 -- Default_Ada_Spec_Suffix --
373 -----------------------------
375 function Default_Ada_Spec_Suffix return File_Name_Type is
377 return Default_Ada_Spec_Suffix_Id;
378 end Default_Ada_Spec_Suffix;
380 ---------------------------
381 -- Delete_All_Temp_Files --
382 ---------------------------
384 procedure Delete_All_Temp_Files is
386 pragma Warnings (Off, Dont_Care);
388 if not Debug.Debug_Flag_N then
389 for Index in 1 .. Temp_Files.Last loop
391 (Get_Name_String (Temp_Files.Table (Index)), Dont_Care);
394 end Delete_All_Temp_Files;
396 ---------------------
397 -- Dependency_Name --
398 ---------------------
400 function Dependency_Name
401 (Source_File_Name : File_Name_Type;
402 Dependency : Dependency_File_Kind) return File_Name_Type
413 (Source_File_Name, Makefile_Dependency_Suffix));
419 (Source_File_Name, ALI_Dependency_Suffix));
423 ---------------------------
424 -- Display_Language_Name --
425 ---------------------------
427 procedure Display_Language_Name
428 (In_Tree : Project_Tree_Ref;
429 Language : Language_Index)
432 Get_Name_String (In_Tree.Languages_Data.Table (Language).Display_Name);
433 Write_Str (Name_Buffer (1 .. Name_Len));
434 end Display_Language_Name;
436 ---------------------------
437 -- Display_Language_Name --
438 ---------------------------
440 procedure Display_Language_Name (Language : Language_Index) is
442 Get_Name_String (Language_Names.Table (Language));
443 To_Upper (Name_Buffer (1 .. 1));
444 Write_Str (Name_Buffer (1 .. Name_Len));
445 end Display_Language_Name;
451 function Empty_File return File_Name_Type is
453 return File_Name_Type (The_Empty_String);
460 function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
461 Value : Project_Data;
464 Prj.Initialize (Tree => No_Project_Tree);
465 Value := Project_Empty;
466 Value.Naming := Tree.Private_Part.Default_Naming;
475 function Empty_String return Name_Id is
477 return The_Empty_String;
484 procedure Expect (The_Token : Token_Type; Token_Image : String) is
486 if Token /= The_Token then
487 Error_Msg (Token_Image & " expected", Token_Ptr);
496 (File : File_Name_Type;
497 With_Suffix : String) return File_Name_Type
502 Get_Name_String (File);
503 Last := Name_Len + 1;
505 while Name_Len /= 0 and then Name_Buffer (Name_Len) /= '.' loop
506 Name_Len := Name_Len - 1;
509 if Name_Len <= 1 then
513 for J in With_Suffix'Range loop
514 Name_Buffer (Name_Len) := With_Suffix (J);
515 Name_Len := Name_Len + 1;
518 Name_Len := Name_Len - 1;
523 --------------------------------
524 -- For_Every_Project_Imported --
525 --------------------------------
527 procedure For_Every_Project_Imported
529 In_Tree : Project_Tree_Ref;
530 With_State : in out State)
533 procedure Recursive_Check (Project : Project_Id);
534 -- Check if a project has already been seen. If not seen, mark it as
535 -- Seen, Call Action, and check all its imported projects.
537 ---------------------
538 -- Recursive_Check --
539 ---------------------
541 procedure Recursive_Check (Project : Project_Id) is
544 if not In_Tree.Projects.Table (Project).Seen then
545 In_Tree.Projects.Table (Project).Seen := True;
546 Action (Project, With_State);
548 List := In_Tree.Projects.Table (Project).Imported_Projects;
549 while List /= Empty_Project_List loop
550 Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
551 List := In_Tree.Project_Lists.Table (List).Next;
556 -- Start of processing for For_Every_Project_Imported
559 for Project in Project_Table.First ..
560 Project_Table.Last (In_Tree.Projects)
562 In_Tree.Projects.Table (Project).Seen := False;
565 Recursive_Check (Project => By);
566 end For_Every_Project_Imported;
572 function Get_Mode return Mode is
581 function Hash is new System.HTable.Hash (Header_Num => Header_Num);
582 -- Used in implementation of other functions Hash below
584 function Hash (Name : File_Name_Type) return Header_Num is
586 return Hash (Get_Name_String (Name));
589 function Hash (Name : Name_Id) return Header_Num is
591 return Hash (Get_Name_String (Name));
594 function Hash (Name : Path_Name_Type) return Header_Num is
596 return Hash (Get_Name_String (Name));
603 function Image (Casing : Casing_Type) return String is
605 return The_Casing_Images (Casing).all;
608 ----------------------
609 -- In_Configuration --
610 ----------------------
612 function In_Configuration return Boolean is
614 return Configuration_Mode;
615 end In_Configuration;
621 procedure Initialize (Tree : Project_Tree_Ref) is
623 if not Initialized then
627 The_Empty_String := Name_Find;
628 Empty_Name := The_Empty_String;
630 Name_Buffer (1 .. 4) := ".ads";
631 Default_Ada_Spec_Suffix_Id := Name_Find;
633 Name_Buffer (1 .. 4) := ".adb";
634 Default_Ada_Body_Suffix_Id := Name_Find;
636 Name_Buffer (1) := '/';
637 Slash_Id := Name_Find;
639 Name_Buffer (1 .. 3) := "c++";
640 Name_C_Plus_Plus := Name_Find;
644 Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
645 Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
646 Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
648 Language_Indexes.Reset;
649 Last_Language_Index := No_Language_Index;
651 Add_Language_Name (Name_Ada);
652 Add_Language_Name (Name_C);
653 Add_Language_Name (Name_C_Plus_Plus);
656 if Tree /= No_Project_Tree then
665 function Is_A_Language
666 (Tree : Project_Tree_Ref;
668 Language_Name : Name_Id) return Boolean
671 if Get_Mode = Ada_Only then
673 List : Name_List_Index := Data.Languages;
675 while List /= No_Name_List loop
676 if Tree.Name_Lists.Table (List).Name = Language_Name then
679 List := Tree.Name_Lists.Table (List).Next;
686 Lang_Ind : Language_Index := Data.First_Language_Processing;
687 Lang_Data : Language_Data;
690 while Lang_Ind /= No_Language_Index loop
691 Lang_Data := Tree.Languages_Data.Table (Lang_Ind);
693 if Lang_Data.Name = Language_Name then
697 Lang_Ind := Lang_Data.Next;
709 function Is_Extending
710 (Extending : Project_Id;
711 Extended : Project_Id;
712 In_Tree : Project_Tree_Ref) return Boolean
718 while Proj /= No_Project loop
719 if Proj = Extended then
723 Proj := In_Tree.Projects.Table (Proj).Extends;
734 (Language : Language_Index;
735 In_Project : Project_Data;
736 In_Tree : Project_Tree_Ref) return Boolean
740 when No_Language_Index =>
743 when First_Language_Indexes =>
744 return In_Project.Langs (Language);
748 Supp : Supp_Language;
749 Supp_Index : Supp_Language_Index;
752 Supp_Index := In_Project.Supp_Languages;
753 while Supp_Index /= No_Supp_Language_Index loop
754 Supp := In_Tree.Present_Languages.Table (Supp_Index);
756 if Supp.Index = Language then
760 Supp_Index := Supp.Next;
768 ---------------------------------
769 -- Language_Processing_Data_Of --
770 ---------------------------------
772 function Language_Processing_Data_Of
773 (Language : Language_Index;
774 In_Project : Project_Data;
775 In_Tree : Project_Tree_Ref) return Language_Processing_Data
779 when No_Language_Index =>
780 return Default_Language_Processing_Data;
782 when First_Language_Indexes =>
783 return In_Project.First_Lang_Processing (Language);
787 Supp : Supp_Language_Data;
788 Supp_Index : Supp_Language_Index;
791 Supp_Index := In_Project.Supp_Language_Processing;
792 while Supp_Index /= No_Supp_Language_Index loop
793 Supp := In_Tree.Supp_Languages.Table (Supp_Index);
795 if Supp.Index = Language then
799 Supp_Index := Supp.Next;
802 return Default_Language_Processing_Data;
805 end Language_Processing_Data_Of;
807 -----------------------
808 -- Objects_Exist_For --
809 -----------------------
811 function Objects_Exist_For
813 In_Tree : Project_Tree_Ref) return Boolean
815 Language_Id : Name_Id;
816 Lang : Language_Index;
819 if Current_Mode = Multi_Language then
821 Add_Str_To_Name_Buffer (Language);
822 To_Lower (Name_Buffer (1 .. Name_Len));
823 Language_Id := Name_Find;
825 Lang := In_Tree.First_Language;
826 while Lang /= No_Language_Index loop
827 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
829 In_Tree.Languages_Data.Table
830 (Lang).Config.Objects_Generated;
833 Lang := In_Tree.Languages_Data.Table (Lang).Next;
838 end Objects_Exist_For;
845 (Source_File_Name : File_Name_Type)
846 return File_Name_Type
849 return Extend_Name (Source_File_Name, Object_Suffix);
852 ----------------------
853 -- Record_Temp_File --
854 ----------------------
856 procedure Record_Temp_File (Path : Path_Name_Type) is
858 Temp_Files.Increment_Last;
859 Temp_Files.Table (Temp_Files.Last) := Path;
860 end Record_Temp_File;
862 ------------------------------------
863 -- Register_Default_Naming_Scheme --
864 ------------------------------------
866 procedure Register_Default_Naming_Scheme
868 Default_Spec_Suffix : File_Name_Type;
869 Default_Body_Suffix : File_Name_Type;
870 In_Tree : Project_Tree_Ref)
873 Suffix : Array_Element_Id;
874 Found : Boolean := False;
875 Element : Array_Element;
878 -- Get the language name in small letters
880 Get_Name_String (Language);
881 Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
884 -- Look for an element of the spec suffix array indexed by the language
885 -- name. If one is found, put the default value.
887 Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
889 while Suffix /= No_Array_Element and then not Found loop
890 Element := In_Tree.Array_Elements.Table (Suffix);
892 if Element.Index = Lang then
894 Element.Value.Value := Name_Id (Default_Spec_Suffix);
895 In_Tree.Array_Elements.Table (Suffix) := Element;
898 Suffix := Element.Next;
902 -- If none can be found, create a new one
908 Index_Case_Sensitive => False,
909 Value => (Project => No_Project,
911 Location => No_Location,
913 Value => Name_Id (Default_Spec_Suffix),
915 Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
916 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
917 In_Tree.Array_Elements.Table
918 (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
920 In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
921 Array_Element_Table.Last (In_Tree.Array_Elements);
924 -- Look for an element of the body suffix array indexed by the language
925 -- name. If one is found, put the default value.
927 Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
929 while Suffix /= No_Array_Element and then not Found loop
930 Element := In_Tree.Array_Elements.Table (Suffix);
932 if Element.Index = Lang then
934 Element.Value.Value := Name_Id (Default_Body_Suffix);
935 In_Tree.Array_Elements.Table (Suffix) := Element;
938 Suffix := Element.Next;
942 -- If none can be found, create a new one
948 Index_Case_Sensitive => False,
949 Value => (Project => No_Project,
951 Location => No_Location,
953 Value => Name_Id (Default_Body_Suffix),
955 Next => In_Tree.Private_Part.Default_Naming.Body_Suffix);
956 Array_Element_Table.Increment_Last
957 (In_Tree.Array_Elements);
958 In_Tree.Array_Elements.Table
959 (Array_Element_Table.Last (In_Tree.Array_Elements))
961 In_Tree.Private_Part.Default_Naming.Body_Suffix :=
962 Array_Element_Table.Last (In_Tree.Array_Elements);
964 end Register_Default_Naming_Scheme;
970 procedure Reset (Tree : Project_Tree_Ref) is
972 -- Def_Lang : constant Name_Node :=
973 -- (Name => Name_Ada,
974 -- Next => No_Name_List);
975 -- Why is the above commented out ???
982 Present_Language_Table.Init (Tree.Present_Languages);
983 Supp_Suffix_Table.Init (Tree.Supp_Suffixes);
984 Supp_Language_Table.Init (Tree.Supp_Languages);
985 Other_Source_Table.Init (Tree.Other_Sources);
989 Language_Data_Table.Init (Tree.Languages_Data);
990 Name_List_Table.Init (Tree.Name_Lists);
991 String_Element_Table.Init (Tree.String_Elements);
992 Variable_Element_Table.Init (Tree.Variable_Elements);
993 Array_Element_Table.Init (Tree.Array_Elements);
994 Array_Table.Init (Tree.Arrays);
995 Package_Table.Init (Tree.Packages);
996 Project_List_Table.Init (Tree.Project_Lists);
997 Project_Table.Init (Tree.Projects);
998 Source_Data_Table.Init (Tree.Sources);
999 Alternate_Language_Table.Init (Tree.Alt_Langs);
1000 Unit_Table.Init (Tree.Units);
1001 Units_Htable.Reset (Tree.Units_HT);
1002 Files_Htable.Reset (Tree.Files_HT);
1003 Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
1005 -- Private part table
1007 Naming_Table.Init (Tree.Private_Part.Namings);
1008 Naming_Table.Increment_Last (Tree.Private_Part.Namings);
1009 Tree.Private_Part.Namings.Table
1010 (Naming_Table.Last (Tree.Private_Part.Namings)) := Std_Naming_Data;
1011 Path_File_Table.Init (Tree.Private_Part.Path_Files);
1012 Source_Path_Table.Init (Tree.Private_Part.Source_Paths);
1013 Object_Path_Table.Init (Tree.Private_Part.Object_Paths);
1014 Tree.Private_Part.Default_Naming := Std_Naming_Data;
1016 if Current_Mode = Ada_Only then
1017 Register_Default_Naming_Scheme
1018 (Language => Name_Ada,
1019 Default_Spec_Suffix => Default_Ada_Spec_Suffix,
1020 Default_Body_Suffix => Default_Ada_Body_Suffix,
1022 Tree.Private_Part.Default_Naming.Separate_Suffix :=
1023 Default_Ada_Body_Suffix;
1027 ------------------------
1028 -- Same_Naming_Scheme --
1029 ------------------------
1031 function Same_Naming_Scheme
1032 (Left, Right : Naming_Data) return Boolean
1035 return Left.Dot_Replacement = Right.Dot_Replacement
1036 and then Left.Casing = Right.Casing
1037 and then Left.Separate_Suffix = Right.Separate_Suffix;
1038 end Same_Naming_Scheme;
1045 (Language : Language_Index;
1047 In_Project : in out Project_Data;
1048 In_Tree : Project_Tree_Ref)
1052 when No_Language_Index =>
1055 when First_Language_Indexes =>
1056 In_Project.Langs (Language) := Present;
1060 Supp : Supp_Language;
1061 Supp_Index : Supp_Language_Index;
1064 Supp_Index := In_Project.Supp_Languages;
1065 while Supp_Index /= No_Supp_Language_Index loop
1066 Supp := In_Tree.Present_Languages.Table (Supp_Index);
1068 if Supp.Index = Language then
1069 In_Tree.Present_Languages.Table (Supp_Index).Present :=
1074 Supp_Index := Supp.Next;
1077 Supp := (Index => Language, Present => Present,
1078 Next => In_Project.Supp_Languages);
1079 Present_Language_Table.Increment_Last
1080 (In_Tree.Present_Languages);
1082 Present_Language_Table.Last (In_Tree.Present_Languages);
1083 In_Tree.Present_Languages.Table (Supp_Index) :=
1085 In_Project.Supp_Languages := Supp_Index;
1091 (Language_Processing : Language_Processing_Data;
1092 For_Language : Language_Index;
1093 In_Project : in out Project_Data;
1094 In_Tree : Project_Tree_Ref)
1097 case For_Language is
1098 when No_Language_Index =>
1101 when First_Language_Indexes =>
1102 In_Project.First_Lang_Processing (For_Language) :=
1103 Language_Processing;
1107 Supp : Supp_Language_Data;
1108 Supp_Index : Supp_Language_Index;
1111 Supp_Index := In_Project.Supp_Language_Processing;
1112 while Supp_Index /= No_Supp_Language_Index loop
1113 Supp := In_Tree.Supp_Languages.Table (Supp_Index);
1115 if Supp.Index = For_Language then
1116 In_Tree.Supp_Languages.Table
1117 (Supp_Index).Data := Language_Processing;
1121 Supp_Index := Supp.Next;
1124 Supp := (Index => For_Language, Data => Language_Processing,
1125 Next => In_Project.Supp_Language_Processing);
1126 Supp_Language_Table.Increment_Last
1127 (In_Tree.Supp_Languages);
1128 Supp_Index := Supp_Language_Table.Last
1129 (In_Tree.Supp_Languages);
1130 In_Tree.Supp_Languages.Table (Supp_Index) := Supp;
1131 In_Project.Supp_Language_Processing := Supp_Index;
1137 (Suffix : File_Name_Type;
1138 For_Language : Language_Index;
1139 In_Project : in out Project_Data;
1140 In_Tree : Project_Tree_Ref)
1143 case For_Language is
1144 when No_Language_Index =>
1147 when First_Language_Indexes =>
1148 In_Project.Naming.Impl_Suffixes (For_Language) := Suffix;
1153 Supp_Index : Supp_Language_Index;
1156 Supp_Index := In_Project.Naming.Supp_Suffixes;
1157 while Supp_Index /= No_Supp_Language_Index loop
1158 Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
1160 if Supp.Index = For_Language then
1161 In_Tree.Supp_Suffixes.Table (Supp_Index).Suffix := Suffix;
1165 Supp_Index := Supp.Next;
1168 Supp := (Index => For_Language, Suffix => Suffix,
1169 Next => In_Project.Naming.Supp_Suffixes);
1170 Supp_Suffix_Table.Increment_Last (In_Tree.Supp_Suffixes);
1171 Supp_Index := Supp_Suffix_Table.Last (In_Tree.Supp_Suffixes);
1172 In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
1173 In_Project.Naming.Supp_Suffixes := Supp_Index;
1178 ---------------------
1179 -- Set_Body_Suffix --
1180 ---------------------
1182 procedure Set_Body_Suffix
1183 (In_Tree : Project_Tree_Ref;
1185 Naming : in out Naming_Data;
1186 Suffix : File_Name_Type)
1188 Language_Id : Name_Id;
1189 Element : Array_Element;
1193 Add_Str_To_Name_Buffer (Language);
1194 To_Lower (Name_Buffer (1 .. Name_Len));
1195 Language_Id := Name_Find;
1198 (Index => Language_Id,
1200 Index_Case_Sensitive => False,
1203 Project => No_Project,
1204 Location => No_Location,
1206 Value => Name_Id (Suffix),
1208 Next => Naming.Body_Suffix);
1210 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1211 Naming.Body_Suffix :=
1212 Array_Element_Table.Last (In_Tree.Array_Elements);
1213 In_Tree.Array_Elements.Table (Naming.Body_Suffix) := Element;
1214 end Set_Body_Suffix;
1216 --------------------------
1217 -- Set_In_Configuration --
1218 --------------------------
1220 procedure Set_In_Configuration (Value : Boolean) is
1222 Configuration_Mode := Value;
1223 end Set_In_Configuration;
1229 procedure Set_Mode (New_Mode : Mode) is
1231 Current_Mode := New_Mode;
1234 Default_Language_Is_Ada := True;
1235 Must_Check_Configuration := False;
1236 when Multi_Language =>
1237 Default_Language_Is_Ada := False;
1238 Must_Check_Configuration := True;
1242 ---------------------
1243 -- Set_Spec_Suffix --
1244 ---------------------
1246 procedure Set_Spec_Suffix
1247 (In_Tree : Project_Tree_Ref;
1249 Naming : in out Naming_Data;
1250 Suffix : File_Name_Type)
1252 Language_Id : Name_Id;
1253 Element : Array_Element;
1257 Add_Str_To_Name_Buffer (Language);
1258 To_Lower (Name_Buffer (1 .. Name_Len));
1259 Language_Id := Name_Find;
1262 (Index => Language_Id,
1264 Index_Case_Sensitive => False,
1267 Project => No_Project,
1268 Location => No_Location,
1270 Value => Name_Id (Suffix),
1272 Next => Naming.Spec_Suffix);
1274 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1275 Naming.Spec_Suffix :=
1276 Array_Element_Table.Last (In_Tree.Array_Elements);
1277 In_Tree.Array_Elements.Table (Naming.Spec_Suffix) := Element;
1278 end Set_Spec_Suffix;
1284 function Slash return Path_Name_Type is
1289 -----------------------
1290 -- Spec_Suffix_Id_Of --
1291 -----------------------
1293 function Spec_Suffix_Id_Of
1294 (In_Tree : Project_Tree_Ref;
1296 Naming : Naming_Data) return File_Name_Type
1298 Language_Id : Name_Id;
1302 Add_Str_To_Name_Buffer (Language);
1303 To_Lower (Name_Buffer (1 .. Name_Len));
1304 Language_Id := Name_Find;
1308 (In_Tree => In_Tree,
1309 Language_Id => Language_Id,
1311 end Spec_Suffix_Id_Of;
1313 -----------------------
1314 -- Spec_Suffix_Id_Of --
1315 -----------------------
1317 function Spec_Suffix_Id_Of
1318 (In_Tree : Project_Tree_Ref;
1319 Language_Id : Name_Id;
1320 Naming : Naming_Data) return File_Name_Type
1322 Element_Id : Array_Element_Id;
1323 Element : Array_Element;
1324 Suffix : File_Name_Type := No_File;
1325 Lang : Language_Index;
1328 Element_Id := Naming.Spec_Suffix;
1329 while Element_Id /= No_Array_Element loop
1330 Element := In_Tree.Array_Elements.Table (Element_Id);
1332 if Element.Index = Language_Id then
1333 return File_Name_Type (Element.Value.Value);
1336 Element_Id := Element.Next;
1339 if Current_Mode = Multi_Language then
1340 Lang := In_Tree.First_Language;
1341 while Lang /= No_Language_Index loop
1342 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1344 In_Tree.Languages_Data.Table
1345 (Lang).Config.Naming_Data.Spec_Suffix;
1349 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1354 end Spec_Suffix_Id_Of;
1356 --------------------
1357 -- Spec_Suffix_Of --
1358 --------------------
1360 function Spec_Suffix_Of
1361 (In_Tree : Project_Tree_Ref;
1363 Naming : Naming_Data) return String
1365 Language_Id : Name_Id;
1366 Element_Id : Array_Element_Id;
1367 Element : Array_Element;
1368 Suffix : File_Name_Type := No_File;
1369 Lang : Language_Index;
1373 Add_Str_To_Name_Buffer (Language);
1374 To_Lower (Name_Buffer (1 .. Name_Len));
1375 Language_Id := Name_Find;
1377 Element_Id := Naming.Spec_Suffix;
1378 while Element_Id /= No_Array_Element loop
1379 Element := In_Tree.Array_Elements.Table (Element_Id);
1381 if Element.Index = Language_Id then
1382 return Get_Name_String (Element.Value.Value);
1385 Element_Id := Element.Next;
1388 if Current_Mode = Multi_Language then
1389 Lang := In_Tree.First_Language;
1390 while Lang /= No_Language_Index loop
1391 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1394 (In_Tree.Languages_Data.Table
1395 (Lang).Config.Naming_Data.Spec_Suffix);
1399 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1402 if Suffix /= No_File then
1403 return Get_Name_String (Suffix);
1410 --------------------------
1411 -- Standard_Naming_Data --
1412 --------------------------
1414 function Standard_Naming_Data
1415 (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
1418 if Tree = No_Project_Tree then
1419 Prj.Initialize (Tree => No_Project_Tree);
1420 return Std_Naming_Data;
1423 return Tree.Private_Part.Default_Naming;
1425 end Standard_Naming_Data;
1432 (Language : Language_Index;
1433 In_Project : Project_Data;
1434 In_Tree : Project_Tree_Ref) return File_Name_Type
1438 when No_Language_Index =>
1441 when First_Language_Indexes =>
1442 return In_Project.Naming.Impl_Suffixes (Language);
1447 Supp_Index : Supp_Language_Index;
1450 Supp_Index := In_Project.Naming.Supp_Suffixes;
1451 while Supp_Index /= No_Supp_Language_Index loop
1452 Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
1454 if Supp.Index = Language then
1458 Supp_Index := Supp.Next;
1470 function Switches_Name
1471 (Source_File_Name : File_Name_Type) return File_Name_Type
1474 return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
1477 ---------------------------
1478 -- There_Are_Ada_Sources --
1479 ---------------------------
1481 function There_Are_Ada_Sources
1482 (In_Tree : Project_Tree_Ref;
1483 Project : Project_Id) return Boolean
1489 while Prj /= No_Project loop
1490 if In_Tree.Projects.Table (Prj).Ada_Sources /= Nil_String then
1494 Prj := In_Tree.Projects.Table (Prj).Extends;
1498 end There_Are_Ada_Sources;
1504 function Value (Image : String) return Casing_Type is
1506 for Casing in The_Casing_Images'Range loop
1507 if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
1512 raise Constraint_Error;
1516 -- Make sure that the standard config and user project file extensions are
1517 -- compatible with canonical case file naming.
1519 Canonical_Case_File_Name (Config_Project_File_Extension);
1520 Canonical_Case_File_Name (Project_File_Extension);