1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-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 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 (Qualifier => Unspecified,
92 Externally_Built => False,
93 Config => Default_Project_Config,
94 Languages => No_Name_List,
95 First_Referred_By => No_Project,
97 Display_Name => No_Name,
99 Display_Path_Name => No_Path,
101 Location => No_Location,
103 Directory => No_Path,
104 Display_Directory => No_Path,
107 Library_Dir => No_Path,
108 Display_Library_Dir => No_Path,
109 Library_Src_Dir => No_Path,
110 Display_Library_Src_Dir => No_Path,
111 Library_ALI_Dir => No_Path,
112 Display_Library_ALI_Dir => No_Path,
113 Library_Name => No_Name,
114 Library_Kind => Static,
115 Lib_Internal_Name => No_Name,
116 Standalone_Library => False,
117 Lib_Interface_ALIs => Nil_String,
118 Lib_Auto_Init => False,
119 Libgnarl_Needed => Unknown,
120 Symbol_Data => No_Symbols,
121 Ada_Sources => Nil_String,
122 Sources => Nil_String,
123 First_Source => No_Source,
124 Last_Source => No_Source,
125 Interfaces_Defined => False,
126 Unit_Based_Language_Name => No_Name,
127 Unit_Based_Language_Index => No_Language_Index,
128 Imported_Directories_Switches => null,
129 Include_Path => null,
130 Include_Data_Set => False,
131 Include_Language => No_Language_Index,
132 Source_Dirs => Nil_String,
133 Known_Order_Of_Source_Dirs => True,
134 Object_Directory => No_Path,
135 Display_Object_Dir => No_Path,
136 Library_TS => Empty_Time_Stamp,
137 Exec_Directory => No_Path,
138 Display_Exec_Dir => No_Path,
139 Extends => No_Project,
140 Extended_By => No_Project,
141 Naming => Std_Naming_Data,
142 First_Language_Processing => No_Language_Index,
143 Decl => No_Declarations,
144 Imported_Projects => Empty_Project_List,
145 All_Imported_Projects => Empty_Project_List,
146 Ada_Include_Path => null,
147 Ada_Objects_Path => null,
148 Objects_Path => null,
149 Include_Path_File => No_Path,
150 Objects_Path_File_With_Libs => No_Path,
151 Objects_Path_File_Without_Libs => No_Path,
152 Config_File_Name => No_Path,
153 Config_File_Temp => False,
154 Linker_Name => No_File,
155 Linker_Path => No_Path,
156 Minimum_Linker_Options => No_Name_List,
157 Config_Checked => False,
160 Need_To_Build_Lib => False,
162 Unkept_Comments => False,
163 Langs => No_Languages,
164 Supp_Languages => No_Supp_Language_Index,
165 Ada_Sources_Present => True,
166 Other_Sources_Present => True,
167 First_Other_Source => No_Other_Source,
168 Last_Other_Source => No_Other_Source,
169 First_Lang_Processing =>
170 Default_First_Language_Processing_Data,
171 Supp_Language_Processing =>
172 No_Supp_Language_Index);
174 package Temp_Files is new Table.Table
175 (Table_Component_Type => Path_Name_Type,
176 Table_Index_Type => Integer,
177 Table_Low_Bound => 1,
179 Table_Increment => 100,
180 Table_Name => "Makegpr.Temp_Files");
181 -- Table to store the path name of all the created temporary files, so that
182 -- they can be deleted at the end, or when the program is interrupted.
184 -----------------------
185 -- Add_Language_Name --
186 -----------------------
188 procedure Add_Language_Name (Name : Name_Id) is
190 Last_Language_Index := Last_Language_Index + 1;
191 Language_Indexes.Set (Name, Last_Language_Index);
192 Language_Names.Increment_Last;
193 Language_Names.Table (Last_Language_Index) := Name;
194 end Add_Language_Name;
200 procedure Add_To_Buffer
202 To : in out String_Access;
203 Last : in out Natural)
207 To := new String (1 .. Initial_Buffer_Size);
211 -- If Buffer is too small, double its size
213 while Last + S'Length > To'Last loop
215 New_Buffer : constant String_Access :=
216 new String (1 .. 2 * Last);
219 New_Buffer (1 .. Last) := To (1 .. Last);
225 To (Last + 1 .. Last + S'Length) := S;
226 Last := Last + S'Length;
229 -----------------------
230 -- Body_Suffix_Id_Of --
231 -----------------------
233 function Body_Suffix_Id_Of
234 (In_Tree : Project_Tree_Ref;
236 Naming : Naming_Data) return File_Name_Type
238 Language_Id : Name_Id;
242 Add_Str_To_Name_Buffer (Language);
243 To_Lower (Name_Buffer (1 .. Name_Len));
244 Language_Id := Name_Find;
249 Language_Id => Language_Id,
251 end Body_Suffix_Id_Of;
253 -----------------------
254 -- Body_Suffix_Id_Of --
255 -----------------------
257 function Body_Suffix_Id_Of
258 (In_Tree : Project_Tree_Ref;
259 Language_Id : Name_Id;
260 Naming : Naming_Data) return File_Name_Type
262 Element_Id : Array_Element_Id;
263 Element : Array_Element;
264 Suffix : File_Name_Type := No_File;
265 Lang : Language_Index;
268 -- ??? This seems to be only for Ada_Only mode...
269 Element_Id := Naming.Body_Suffix;
270 while Element_Id /= No_Array_Element loop
271 Element := In_Tree.Array_Elements.Table (Element_Id);
273 if Element.Index = Language_Id then
274 return File_Name_Type (Element.Value.Value);
277 Element_Id := Element.Next;
280 if Current_Mode = Multi_Language then
281 Lang := In_Tree.First_Language;
282 while Lang /= No_Language_Index loop
283 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
285 In_Tree.Languages_Data.Table
286 (Lang).Config.Naming_Data.Body_Suffix;
290 Lang := In_Tree.Languages_Data.Table (Lang).Next;
295 end Body_Suffix_Id_Of;
301 function Body_Suffix_Of
302 (In_Tree : Project_Tree_Ref;
304 Naming : Naming_Data) return String
306 Language_Id : Name_Id;
307 Element_Id : Array_Element_Id;
308 Element : Array_Element;
309 Suffix : File_Name_Type := No_File;
310 Lang : Language_Index;
314 Add_Str_To_Name_Buffer (Language);
315 To_Lower (Name_Buffer (1 .. Name_Len));
316 Language_Id := Name_Find;
318 Element_Id := Naming.Body_Suffix;
319 while Element_Id /= No_Array_Element loop
320 Element := In_Tree.Array_Elements.Table (Element_Id);
322 if Element.Index = Language_Id then
323 return Get_Name_String (Element.Value.Value);
326 Element_Id := Element.Next;
329 if Current_Mode = Multi_Language then
330 Lang := In_Tree.First_Language;
331 while Lang /= No_Language_Index loop
332 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
335 (In_Tree.Languages_Data.Table
336 (Lang).Config.Naming_Data.Body_Suffix);
340 Lang := In_Tree.Languages_Data.Table (Lang).Next;
343 if Suffix /= No_File then
344 return Get_Name_String (Suffix);
351 function Body_Suffix_Of
352 (Language : Language_Index;
353 In_Project : Project_Data;
354 In_Tree : Project_Tree_Ref) return String
356 Suffix_Id : constant File_Name_Type :=
357 Suffix_Of (Language, In_Project, In_Tree);
359 if Suffix_Id /= No_File then
360 return Get_Name_String (Suffix_Id);
362 return "." & Get_Name_String (Language_Names.Table (Language));
366 -----------------------------
367 -- Default_Ada_Body_Suffix --
368 -----------------------------
370 function Default_Ada_Body_Suffix return File_Name_Type is
372 return Default_Ada_Body_Suffix_Id;
373 end Default_Ada_Body_Suffix;
375 -----------------------------
376 -- Default_Ada_Spec_Suffix --
377 -----------------------------
379 function Default_Ada_Spec_Suffix return File_Name_Type is
381 return Default_Ada_Spec_Suffix_Id;
382 end Default_Ada_Spec_Suffix;
384 ---------------------------
385 -- Delete_All_Temp_Files --
386 ---------------------------
388 procedure Delete_All_Temp_Files is
390 pragma Warnings (Off, Dont_Care);
392 if not Debug.Debug_Flag_N then
393 for Index in 1 .. Temp_Files.Last loop
395 (Get_Name_String (Temp_Files.Table (Index)), Dont_Care);
398 end Delete_All_Temp_Files;
400 ---------------------
401 -- Dependency_Name --
402 ---------------------
404 function Dependency_Name
405 (Source_File_Name : File_Name_Type;
406 Dependency : Dependency_File_Kind) return File_Name_Type
417 (Source_File_Name, Makefile_Dependency_Suffix));
423 (Source_File_Name, ALI_Dependency_Suffix));
427 ---------------------------
428 -- Display_Language_Name --
429 ---------------------------
431 procedure Display_Language_Name
432 (In_Tree : Project_Tree_Ref;
433 Language : Language_Index)
436 Get_Name_String (In_Tree.Languages_Data.Table (Language).Display_Name);
437 Write_Str (Name_Buffer (1 .. Name_Len));
438 end Display_Language_Name;
440 ---------------------------
441 -- Display_Language_Name --
442 ---------------------------
444 procedure Display_Language_Name (Language : Language_Index) is
446 Get_Name_String (Language_Names.Table (Language));
447 To_Upper (Name_Buffer (1 .. 1));
448 Write_Str (Name_Buffer (1 .. Name_Len));
449 end Display_Language_Name;
455 function Empty_File return File_Name_Type is
457 return File_Name_Type (The_Empty_String);
464 function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
465 Value : Project_Data;
468 Prj.Initialize (Tree => No_Project_Tree);
469 Value := Project_Empty;
470 Value.Naming := Tree.Private_Part.Default_Naming;
479 function Empty_String return Name_Id is
481 return The_Empty_String;
488 procedure Expect (The_Token : Token_Type; Token_Image : String) is
490 if Token /= The_Token then
491 Error_Msg (Token_Image & " expected", Token_Ptr);
500 (File : File_Name_Type;
501 With_Suffix : String) return File_Name_Type
506 Get_Name_String (File);
507 Last := Name_Len + 1;
509 while Name_Len /= 0 and then Name_Buffer (Name_Len) /= '.' loop
510 Name_Len := Name_Len - 1;
513 if Name_Len <= 1 then
517 for J in With_Suffix'Range loop
518 Name_Buffer (Name_Len) := With_Suffix (J);
519 Name_Len := Name_Len + 1;
522 Name_Len := Name_Len - 1;
527 --------------------------------
528 -- For_Every_Project_Imported --
529 --------------------------------
531 procedure For_Every_Project_Imported
533 In_Tree : Project_Tree_Ref;
534 With_State : in out State)
537 procedure Recursive_Check (Project : Project_Id);
538 -- Check if a project has already been seen. If not seen, mark it as
539 -- Seen, Call Action, and check all its imported projects.
541 ---------------------
542 -- Recursive_Check --
543 ---------------------
545 procedure Recursive_Check (Project : Project_Id) is
548 if not In_Tree.Projects.Table (Project).Seen then
549 In_Tree.Projects.Table (Project).Seen := True;
550 Action (Project, With_State);
552 List := In_Tree.Projects.Table (Project).Imported_Projects;
553 while List /= Empty_Project_List loop
554 Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
555 List := In_Tree.Project_Lists.Table (List).Next;
560 -- Start of processing for For_Every_Project_Imported
563 for Project in Project_Table.First ..
564 Project_Table.Last (In_Tree.Projects)
566 In_Tree.Projects.Table (Project).Seen := False;
569 Recursive_Check (Project => By);
570 end For_Every_Project_Imported;
576 function Get_Mode return Mode is
585 function Hash is new System.HTable.Hash (Header_Num => Header_Num);
586 -- Used in implementation of other functions Hash below
588 function Hash (Name : File_Name_Type) return Header_Num is
590 return Hash (Get_Name_String (Name));
593 function Hash (Name : Name_Id) return Header_Num is
595 return Hash (Get_Name_String (Name));
598 function Hash (Name : Path_Name_Type) return Header_Num is
600 return Hash (Get_Name_String (Name));
603 function Hash (Project : Project_Id) return Header_Num is
605 return Header_Num (Project mod Max_Header_Num);
612 function Image (Casing : Casing_Type) return String is
614 return The_Casing_Images (Casing).all;
617 ----------------------
618 -- In_Configuration --
619 ----------------------
621 function In_Configuration return Boolean is
623 return Configuration_Mode;
624 end In_Configuration;
630 procedure Initialize (Tree : Project_Tree_Ref) is
632 if not Initialized then
636 The_Empty_String := Name_Find;
637 Empty_Name := The_Empty_String;
638 Empty_File_Name := File_Name_Type (The_Empty_String);
640 Name_Buffer (1 .. 4) := ".ads";
641 Default_Ada_Spec_Suffix_Id := Name_Find;
643 Name_Buffer (1 .. 4) := ".adb";
644 Default_Ada_Body_Suffix_Id := Name_Find;
646 Name_Buffer (1) := '/';
647 Slash_Id := Name_Find;
649 Name_Buffer (1 .. 3) := "c++";
650 Name_C_Plus_Plus := Name_Find;
654 Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
655 Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
656 Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
658 Language_Indexes.Reset;
659 Last_Language_Index := No_Language_Index;
661 Add_Language_Name (Name_Ada);
662 Add_Language_Name (Name_C);
663 Add_Language_Name (Name_C_Plus_Plus);
666 if Tree /= No_Project_Tree then
675 function Is_A_Language
676 (Tree : Project_Tree_Ref;
678 Language_Name : Name_Id) return Boolean
681 if Get_Mode = Ada_Only then
683 List : Name_List_Index := Data.Languages;
685 while List /= No_Name_List loop
686 if Tree.Name_Lists.Table (List).Name = Language_Name then
689 List := Tree.Name_Lists.Table (List).Next;
696 Lang_Ind : Language_Index := Data.First_Language_Processing;
697 Lang_Data : Language_Data;
700 while Lang_Ind /= No_Language_Index loop
701 Lang_Data := Tree.Languages_Data.Table (Lang_Ind);
703 if Lang_Data.Name = Language_Name then
707 Lang_Ind := Lang_Data.Next;
719 function Is_Extending
720 (Extending : Project_Id;
721 Extended : Project_Id;
722 In_Tree : Project_Tree_Ref) return Boolean
728 while Proj /= No_Project loop
729 if Proj = Extended then
733 Proj := In_Tree.Projects.Table (Proj).Extends;
744 (Language : Language_Index;
745 In_Project : Project_Data;
746 In_Tree : Project_Tree_Ref) return Boolean
750 when No_Language_Index =>
753 when First_Language_Indexes =>
754 return In_Project.Langs (Language);
758 Supp : Supp_Language;
759 Supp_Index : Supp_Language_Index;
762 Supp_Index := In_Project.Supp_Languages;
763 while Supp_Index /= No_Supp_Language_Index loop
764 Supp := In_Tree.Present_Languages.Table (Supp_Index);
766 if Supp.Index = Language then
770 Supp_Index := Supp.Next;
778 ---------------------------------
779 -- Language_Processing_Data_Of --
780 ---------------------------------
782 function Language_Processing_Data_Of
783 (Language : Language_Index;
784 In_Project : Project_Data;
785 In_Tree : Project_Tree_Ref) return Language_Processing_Data
789 when No_Language_Index =>
790 return Default_Language_Processing_Data;
792 when First_Language_Indexes =>
793 return In_Project.First_Lang_Processing (Language);
797 Supp : Supp_Language_Data;
798 Supp_Index : Supp_Language_Index;
801 Supp_Index := In_Project.Supp_Language_Processing;
802 while Supp_Index /= No_Supp_Language_Index loop
803 Supp := In_Tree.Supp_Languages.Table (Supp_Index);
805 if Supp.Index = Language then
809 Supp_Index := Supp.Next;
812 return Default_Language_Processing_Data;
815 end Language_Processing_Data_Of;
817 -----------------------
818 -- Objects_Exist_For --
819 -----------------------
821 function Objects_Exist_For
823 In_Tree : Project_Tree_Ref) return Boolean
825 Language_Id : Name_Id;
826 Lang : Language_Index;
829 if Current_Mode = Multi_Language then
831 Add_Str_To_Name_Buffer (Language);
832 To_Lower (Name_Buffer (1 .. Name_Len));
833 Language_Id := Name_Find;
835 Lang := In_Tree.First_Language;
836 while Lang /= No_Language_Index loop
837 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
839 In_Tree.Languages_Data.Table
840 (Lang).Config.Objects_Generated;
843 Lang := In_Tree.Languages_Data.Table (Lang).Next;
848 end Objects_Exist_For;
855 (Source_File_Name : File_Name_Type)
856 return File_Name_Type
859 return Extend_Name (Source_File_Name, Object_Suffix);
862 ----------------------
863 -- Record_Temp_File --
864 ----------------------
866 procedure Record_Temp_File (Path : Path_Name_Type) is
868 Temp_Files.Increment_Last;
869 Temp_Files.Table (Temp_Files.Last) := Path;
870 end Record_Temp_File;
872 ------------------------------------
873 -- Register_Default_Naming_Scheme --
874 ------------------------------------
876 procedure Register_Default_Naming_Scheme
878 Default_Spec_Suffix : File_Name_Type;
879 Default_Body_Suffix : File_Name_Type;
880 In_Tree : Project_Tree_Ref)
883 Suffix : Array_Element_Id;
884 Found : Boolean := False;
885 Element : Array_Element;
888 -- Get the language name in small letters
890 Get_Name_String (Language);
891 Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
894 -- Look for an element of the spec suffix array indexed by the language
895 -- name. If one is found, put the default value.
897 Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
899 while Suffix /= No_Array_Element and then not Found loop
900 Element := In_Tree.Array_Elements.Table (Suffix);
902 if Element.Index = Lang then
904 Element.Value.Value := Name_Id (Default_Spec_Suffix);
905 In_Tree.Array_Elements.Table (Suffix) := Element;
908 Suffix := Element.Next;
912 -- If none can be found, create a new one
918 Index_Case_Sensitive => False,
919 Value => (Project => No_Project,
921 Location => No_Location,
923 Value => Name_Id (Default_Spec_Suffix),
925 Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
926 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
927 In_Tree.Array_Elements.Table
928 (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
930 In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
931 Array_Element_Table.Last (In_Tree.Array_Elements);
934 -- Look for an element of the body suffix array indexed by the language
935 -- name. If one is found, put the default value.
937 Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
939 while Suffix /= No_Array_Element and then not Found loop
940 Element := In_Tree.Array_Elements.Table (Suffix);
942 if Element.Index = Lang then
944 Element.Value.Value := Name_Id (Default_Body_Suffix);
945 In_Tree.Array_Elements.Table (Suffix) := Element;
948 Suffix := Element.Next;
952 -- If none can be found, create a new one
958 Index_Case_Sensitive => False,
959 Value => (Project => No_Project,
961 Location => No_Location,
963 Value => Name_Id (Default_Body_Suffix),
965 Next => In_Tree.Private_Part.Default_Naming.Body_Suffix);
966 Array_Element_Table.Increment_Last
967 (In_Tree.Array_Elements);
968 In_Tree.Array_Elements.Table
969 (Array_Element_Table.Last (In_Tree.Array_Elements))
971 In_Tree.Private_Part.Default_Naming.Body_Suffix :=
972 Array_Element_Table.Last (In_Tree.Array_Elements);
974 end Register_Default_Naming_Scheme;
980 procedure Reset (Tree : Project_Tree_Ref) is
982 -- Def_Lang : constant Name_Node :=
983 -- (Name => Name_Ada,
984 -- Next => No_Name_List);
985 -- Why is the above commented out ???
992 Present_Language_Table.Init (Tree.Present_Languages);
993 Supp_Suffix_Table.Init (Tree.Supp_Suffixes);
994 Supp_Language_Table.Init (Tree.Supp_Languages);
995 Other_Source_Table.Init (Tree.Other_Sources);
999 Language_Data_Table.Init (Tree.Languages_Data);
1000 Name_List_Table.Init (Tree.Name_Lists);
1001 String_Element_Table.Init (Tree.String_Elements);
1002 Variable_Element_Table.Init (Tree.Variable_Elements);
1003 Array_Element_Table.Init (Tree.Array_Elements);
1004 Array_Table.Init (Tree.Arrays);
1005 Package_Table.Init (Tree.Packages);
1006 Project_List_Table.Init (Tree.Project_Lists);
1007 Project_Table.Init (Tree.Projects);
1008 Source_Data_Table.Init (Tree.Sources);
1009 Alternate_Language_Table.Init (Tree.Alt_Langs);
1010 Unit_Table.Init (Tree.Units);
1011 Units_Htable.Reset (Tree.Units_HT);
1012 Files_Htable.Reset (Tree.Files_HT);
1013 Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
1015 -- Private part table
1017 Naming_Table.Init (Tree.Private_Part.Namings);
1018 Naming_Table.Increment_Last (Tree.Private_Part.Namings);
1019 Tree.Private_Part.Namings.Table
1020 (Naming_Table.Last (Tree.Private_Part.Namings)) := Std_Naming_Data;
1021 Path_File_Table.Init (Tree.Private_Part.Path_Files);
1022 Source_Path_Table.Init (Tree.Private_Part.Source_Paths);
1023 Object_Path_Table.Init (Tree.Private_Part.Object_Paths);
1024 Tree.Private_Part.Default_Naming := Std_Naming_Data;
1026 if Current_Mode = Ada_Only then
1027 Register_Default_Naming_Scheme
1028 (Language => Name_Ada,
1029 Default_Spec_Suffix => Default_Ada_Spec_Suffix,
1030 Default_Body_Suffix => Default_Ada_Body_Suffix,
1032 Tree.Private_Part.Default_Naming.Separate_Suffix :=
1033 Default_Ada_Body_Suffix;
1037 ------------------------
1038 -- Same_Naming_Scheme --
1039 ------------------------
1041 function Same_Naming_Scheme
1042 (Left, Right : Naming_Data) return Boolean
1045 return Left.Dot_Replacement = Right.Dot_Replacement
1046 and then Left.Casing = Right.Casing
1047 and then Left.Separate_Suffix = Right.Separate_Suffix;
1048 end Same_Naming_Scheme;
1055 (Language : Language_Index;
1057 In_Project : in out Project_Data;
1058 In_Tree : Project_Tree_Ref)
1062 when No_Language_Index =>
1065 when First_Language_Indexes =>
1066 In_Project.Langs (Language) := Present;
1070 Supp : Supp_Language;
1071 Supp_Index : Supp_Language_Index;
1074 Supp_Index := In_Project.Supp_Languages;
1075 while Supp_Index /= No_Supp_Language_Index loop
1076 Supp := In_Tree.Present_Languages.Table (Supp_Index);
1078 if Supp.Index = Language then
1079 In_Tree.Present_Languages.Table (Supp_Index).Present :=
1084 Supp_Index := Supp.Next;
1087 Supp := (Index => Language, Present => Present,
1088 Next => In_Project.Supp_Languages);
1089 Present_Language_Table.Increment_Last
1090 (In_Tree.Present_Languages);
1092 Present_Language_Table.Last (In_Tree.Present_Languages);
1093 In_Tree.Present_Languages.Table (Supp_Index) :=
1095 In_Project.Supp_Languages := Supp_Index;
1101 (Language_Processing : Language_Processing_Data;
1102 For_Language : Language_Index;
1103 In_Project : in out Project_Data;
1104 In_Tree : Project_Tree_Ref)
1107 case For_Language is
1108 when No_Language_Index =>
1111 when First_Language_Indexes =>
1112 In_Project.First_Lang_Processing (For_Language) :=
1113 Language_Processing;
1117 Supp : Supp_Language_Data;
1118 Supp_Index : Supp_Language_Index;
1121 Supp_Index := In_Project.Supp_Language_Processing;
1122 while Supp_Index /= No_Supp_Language_Index loop
1123 Supp := In_Tree.Supp_Languages.Table (Supp_Index);
1125 if Supp.Index = For_Language then
1126 In_Tree.Supp_Languages.Table
1127 (Supp_Index).Data := Language_Processing;
1131 Supp_Index := Supp.Next;
1134 Supp := (Index => For_Language, Data => Language_Processing,
1135 Next => In_Project.Supp_Language_Processing);
1136 Supp_Language_Table.Increment_Last
1137 (In_Tree.Supp_Languages);
1138 Supp_Index := Supp_Language_Table.Last
1139 (In_Tree.Supp_Languages);
1140 In_Tree.Supp_Languages.Table (Supp_Index) := Supp;
1141 In_Project.Supp_Language_Processing := Supp_Index;
1147 (Suffix : File_Name_Type;
1148 For_Language : Language_Index;
1149 In_Project : in out Project_Data;
1150 In_Tree : Project_Tree_Ref)
1153 case For_Language is
1154 when No_Language_Index =>
1157 when First_Language_Indexes =>
1158 In_Project.Naming.Impl_Suffixes (For_Language) := Suffix;
1163 Supp_Index : Supp_Language_Index;
1166 Supp_Index := In_Project.Naming.Supp_Suffixes;
1167 while Supp_Index /= No_Supp_Language_Index loop
1168 Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
1170 if Supp.Index = For_Language then
1171 In_Tree.Supp_Suffixes.Table (Supp_Index).Suffix := Suffix;
1175 Supp_Index := Supp.Next;
1178 Supp := (Index => For_Language, Suffix => Suffix,
1179 Next => In_Project.Naming.Supp_Suffixes);
1180 Supp_Suffix_Table.Increment_Last (In_Tree.Supp_Suffixes);
1181 Supp_Index := Supp_Suffix_Table.Last (In_Tree.Supp_Suffixes);
1182 In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
1183 In_Project.Naming.Supp_Suffixes := Supp_Index;
1188 ---------------------
1189 -- Set_Body_Suffix --
1190 ---------------------
1192 procedure Set_Body_Suffix
1193 (In_Tree : Project_Tree_Ref;
1195 Naming : in out Naming_Data;
1196 Suffix : File_Name_Type)
1198 Language_Id : Name_Id;
1199 Element : Array_Element;
1203 Add_Str_To_Name_Buffer (Language);
1204 To_Lower (Name_Buffer (1 .. Name_Len));
1205 Language_Id := Name_Find;
1208 (Index => Language_Id,
1210 Index_Case_Sensitive => False,
1213 Project => No_Project,
1214 Location => No_Location,
1216 Value => Name_Id (Suffix),
1218 Next => Naming.Body_Suffix);
1220 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1221 Naming.Body_Suffix :=
1222 Array_Element_Table.Last (In_Tree.Array_Elements);
1223 In_Tree.Array_Elements.Table (Naming.Body_Suffix) := Element;
1224 end Set_Body_Suffix;
1226 --------------------------
1227 -- Set_In_Configuration --
1228 --------------------------
1230 procedure Set_In_Configuration (Value : Boolean) is
1232 Configuration_Mode := Value;
1233 end Set_In_Configuration;
1239 procedure Set_Mode (New_Mode : Mode) is
1241 Current_Mode := New_Mode;
1244 Default_Language_Is_Ada := True;
1245 Must_Check_Configuration := False;
1246 when Multi_Language =>
1247 Default_Language_Is_Ada := False;
1248 Must_Check_Configuration := True;
1252 ---------------------
1253 -- Set_Spec_Suffix --
1254 ---------------------
1256 procedure Set_Spec_Suffix
1257 (In_Tree : Project_Tree_Ref;
1259 Naming : in out Naming_Data;
1260 Suffix : File_Name_Type)
1262 Language_Id : Name_Id;
1263 Element : Array_Element;
1267 Add_Str_To_Name_Buffer (Language);
1268 To_Lower (Name_Buffer (1 .. Name_Len));
1269 Language_Id := Name_Find;
1272 (Index => Language_Id,
1274 Index_Case_Sensitive => False,
1277 Project => No_Project,
1278 Location => No_Location,
1280 Value => Name_Id (Suffix),
1282 Next => Naming.Spec_Suffix);
1284 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1285 Naming.Spec_Suffix :=
1286 Array_Element_Table.Last (In_Tree.Array_Elements);
1287 In_Tree.Array_Elements.Table (Naming.Spec_Suffix) := Element;
1288 end Set_Spec_Suffix;
1294 function Slash return Path_Name_Type is
1299 -----------------------
1300 -- Spec_Suffix_Id_Of --
1301 -----------------------
1303 function Spec_Suffix_Id_Of
1304 (In_Tree : Project_Tree_Ref;
1306 Naming : Naming_Data) return File_Name_Type
1308 Language_Id : Name_Id;
1312 Add_Str_To_Name_Buffer (Language);
1313 To_Lower (Name_Buffer (1 .. Name_Len));
1314 Language_Id := Name_Find;
1318 (In_Tree => In_Tree,
1319 Language_Id => Language_Id,
1321 end Spec_Suffix_Id_Of;
1323 -----------------------
1324 -- Spec_Suffix_Id_Of --
1325 -----------------------
1327 function Spec_Suffix_Id_Of
1328 (In_Tree : Project_Tree_Ref;
1329 Language_Id : Name_Id;
1330 Naming : Naming_Data) return File_Name_Type
1332 Element_Id : Array_Element_Id;
1333 Element : Array_Element;
1334 Suffix : File_Name_Type := No_File;
1335 Lang : Language_Index;
1338 Element_Id := Naming.Spec_Suffix;
1339 while Element_Id /= No_Array_Element loop
1340 Element := In_Tree.Array_Elements.Table (Element_Id);
1342 if Element.Index = Language_Id then
1343 return File_Name_Type (Element.Value.Value);
1346 Element_Id := Element.Next;
1349 if Current_Mode = Multi_Language then
1350 Lang := In_Tree.First_Language;
1351 while Lang /= No_Language_Index loop
1352 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1354 In_Tree.Languages_Data.Table
1355 (Lang).Config.Naming_Data.Spec_Suffix;
1359 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1364 end Spec_Suffix_Id_Of;
1366 --------------------
1367 -- Spec_Suffix_Of --
1368 --------------------
1370 function Spec_Suffix_Of
1371 (In_Tree : Project_Tree_Ref;
1373 Naming : Naming_Data) return String
1375 Language_Id : Name_Id;
1376 Element_Id : Array_Element_Id;
1377 Element : Array_Element;
1378 Suffix : File_Name_Type := No_File;
1379 Lang : Language_Index;
1383 Add_Str_To_Name_Buffer (Language);
1384 To_Lower (Name_Buffer (1 .. Name_Len));
1385 Language_Id := Name_Find;
1387 Element_Id := Naming.Spec_Suffix;
1388 while Element_Id /= No_Array_Element loop
1389 Element := In_Tree.Array_Elements.Table (Element_Id);
1391 if Element.Index = Language_Id then
1392 return Get_Name_String (Element.Value.Value);
1395 Element_Id := Element.Next;
1398 if Current_Mode = Multi_Language then
1399 Lang := In_Tree.First_Language;
1400 while Lang /= No_Language_Index loop
1401 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1404 (In_Tree.Languages_Data.Table
1405 (Lang).Config.Naming_Data.Spec_Suffix);
1409 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1412 if Suffix /= No_File then
1413 return Get_Name_String (Suffix);
1420 --------------------------
1421 -- Standard_Naming_Data --
1422 --------------------------
1424 function Standard_Naming_Data
1425 (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
1428 if Tree = No_Project_Tree then
1429 Prj.Initialize (Tree => No_Project_Tree);
1430 return Std_Naming_Data;
1432 return Tree.Private_Part.Default_Naming;
1434 end Standard_Naming_Data;
1441 (Language : Language_Index;
1442 In_Project : Project_Data;
1443 In_Tree : Project_Tree_Ref) return File_Name_Type
1447 when No_Language_Index =>
1450 when First_Language_Indexes =>
1451 return In_Project.Naming.Impl_Suffixes (Language);
1456 Supp_Index : Supp_Language_Index;
1459 Supp_Index := In_Project.Naming.Supp_Suffixes;
1460 while Supp_Index /= No_Supp_Language_Index loop
1461 Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
1463 if Supp.Index = Language then
1467 Supp_Index := Supp.Next;
1479 function Switches_Name
1480 (Source_File_Name : File_Name_Type) return File_Name_Type
1483 return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
1486 ---------------------------
1487 -- There_Are_Ada_Sources --
1488 ---------------------------
1490 function There_Are_Ada_Sources
1491 (In_Tree : Project_Tree_Ref;
1492 Project : Project_Id) return Boolean
1498 while Prj /= No_Project loop
1499 if In_Tree.Projects.Table (Prj).Ada_Sources /= Nil_String then
1503 Prj := In_Tree.Projects.Table (Prj).Extends;
1507 end There_Are_Ada_Sources;
1513 function Value (Image : String) return Casing_Type is
1515 for Casing in The_Casing_Images'Range loop
1516 if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
1521 raise Constraint_Error;
1525 -- Make sure that the standard config and user project file extensions are
1526 -- compatible with canonical case file naming.
1528 Canonical_Case_File_Name (Config_Project_File_Extension);
1529 Canonical_Case_File_Name (Project_File_Extension);