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;
27 with Ada.Unchecked_Deallocation;
30 with Output; use Output;
31 with Osint; use Osint;
34 with Prj.Err; use Prj.Err;
35 with Snames; use Snames;
37 with Uintp; use Uintp;
39 with System.Case_Util; use System.Case_Util;
44 Object_Suffix : constant String := Get_Target_Object_Suffix.all;
45 -- File suffix for object files
47 Initial_Buffer_Size : constant := 100;
48 -- Initial size for extensible buffer used in Add_To_Buffer
50 Current_Mode : Mode := Ada_Only;
52 Configuration_Mode : Boolean := False;
54 The_Empty_String : Name_Id;
56 Default_Ada_Spec_Suffix_Id : File_Name_Type;
57 Default_Ada_Body_Suffix_Id : File_Name_Type;
58 Slash_Id : Path_Name_Type;
59 -- Initialized in Prj.Initialize, then never modified
61 subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
63 The_Casing_Images : constant array (Known_Casing) of String_Access :=
64 (All_Lower_Case => new String'("lowercase"),
65 All_Upper_Case => new String'("UPPERCASE"),
66 Mixed_Case => new String'("MixedCase"));
68 Initialized : Boolean := False;
70 Standard_Dot_Replacement : constant File_Name_Type :=
72 (First_Name_Id + Character'Pos ('-'));
74 Std_Naming_Data : constant Naming_Data :=
75 (Dot_Replacement => Standard_Dot_Replacement,
76 Dot_Repl_Loc => No_Location,
77 Casing => All_Lower_Case,
78 Spec_Suffix => No_Array_Element,
79 Ada_Spec_Suffix_Loc => No_Location,
80 Body_Suffix => No_Array_Element,
81 Ada_Body_Suffix_Loc => No_Location,
82 Separate_Suffix => No_File,
83 Sep_Suffix_Loc => No_Location,
84 Specs => No_Array_Element,
85 Bodies => No_Array_Element,
86 Specification_Exceptions => No_Array_Element,
87 Implementation_Exceptions => No_Array_Element);
89 Project_Empty : constant Project_Data :=
90 (Qualifier => Unspecified,
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,
97 Path => No_Path_Information,
99 Location => No_Location,
101 Directory => No_Path_Information,
104 Library_Dir => No_Path_Information,
105 Library_Src_Dir => No_Path_Information,
106 Library_ALI_Dir => No_Path_Information,
107 Library_Name => No_Name,
108 Library_Kind => Static,
109 Lib_Internal_Name => No_Name,
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 Ada_Sources => Nil_String,
118 First_Source => No_Source,
119 Last_Source => No_Source,
120 Interfaces_Defined => False,
121 Unit_Based_Language_Name => No_Name,
122 Unit_Based_Language_Index => No_Language_Index,
123 Imported_Directories_Switches => null,
124 Include_Path => null,
125 Include_Data_Set => False,
126 Include_Language => No_Language_Index,
127 Source_Dirs => Nil_String,
128 Known_Order_Of_Source_Dirs => True,
129 Object_Directory => No_Path_Information,
130 Library_TS => Empty_Time_Stamp,
131 Exec_Directory => No_Path_Information,
132 Extends => No_Project,
133 Extended_By => No_Project,
134 Naming => Std_Naming_Data,
135 First_Language_Processing => No_Language_Index,
136 Decl => No_Declarations,
137 Imported_Projects => Empty_Project_List,
138 All_Imported_Projects => Empty_Project_List,
139 Ada_Include_Path => null,
140 Ada_Objects_Path => null,
141 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,
150 Need_To_Build_Lib => False,
152 Unkept_Comments => False);
154 package Temp_Files is new Table.Table
155 (Table_Component_Type => Path_Name_Type,
156 Table_Index_Type => Integer,
157 Table_Low_Bound => 1,
159 Table_Increment => 100,
160 Table_Name => "Makegpr.Temp_Files");
161 -- Table to store the path name of all the created temporary files, so that
162 -- they can be deleted at the end, or when the program is interrupted.
164 procedure Free (Project : in out Project_Data);
165 -- Free memory allocated for Project
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 :=
187 new String (1 .. 2 * Last);
190 New_Buffer (1 .. Last) := To (1 .. Last);
196 To (Last + 1 .. Last + S'Length) := S;
197 Last := Last + S'Length;
200 -----------------------
201 -- Body_Suffix_Id_Of --
202 -----------------------
204 function Body_Suffix_Id_Of
205 (In_Tree : Project_Tree_Ref;
207 Naming : Naming_Data) return File_Name_Type
209 Language_Id : Name_Id;
213 Add_Str_To_Name_Buffer (Language);
214 To_Lower (Name_Buffer (1 .. Name_Len));
215 Language_Id := Name_Find;
220 Language_Id => Language_Id,
222 end Body_Suffix_Id_Of;
224 -----------------------
225 -- Body_Suffix_Id_Of --
226 -----------------------
228 function Body_Suffix_Id_Of
229 (In_Tree : Project_Tree_Ref;
230 Language_Id : Name_Id;
231 Naming : Naming_Data) return File_Name_Type
233 Element_Id : Array_Element_Id;
234 Element : Array_Element;
235 Suffix : File_Name_Type := No_File;
236 Lang : Language_Index;
239 -- ??? This seems to be only for Ada_Only mode...
240 Element_Id := Naming.Body_Suffix;
241 while Element_Id /= No_Array_Element loop
242 Element := In_Tree.Array_Elements.Table (Element_Id);
244 if Element.Index = Language_Id then
245 return File_Name_Type (Element.Value.Value);
248 Element_Id := Element.Next;
251 if Current_Mode = Multi_Language then
252 Lang := In_Tree.First_Language;
253 while Lang /= No_Language_Index loop
254 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
256 In_Tree.Languages_Data.Table
257 (Lang).Config.Naming_Data.Body_Suffix;
261 Lang := In_Tree.Languages_Data.Table (Lang).Next;
266 end Body_Suffix_Id_Of;
272 function Body_Suffix_Of
273 (In_Tree : Project_Tree_Ref;
275 Naming : Naming_Data) return String
277 Language_Id : Name_Id;
278 Element_Id : Array_Element_Id;
279 Element : Array_Element;
280 Suffix : File_Name_Type := No_File;
281 Lang : Language_Index;
285 Add_Str_To_Name_Buffer (Language);
286 To_Lower (Name_Buffer (1 .. Name_Len));
287 Language_Id := Name_Find;
289 Element_Id := Naming.Body_Suffix;
290 while Element_Id /= No_Array_Element loop
291 Element := In_Tree.Array_Elements.Table (Element_Id);
293 if Element.Index = Language_Id then
294 return Get_Name_String (Element.Value.Value);
297 Element_Id := Element.Next;
300 if Current_Mode = Multi_Language then
301 Lang := In_Tree.First_Language;
302 while Lang /= No_Language_Index loop
303 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
306 (In_Tree.Languages_Data.Table
307 (Lang).Config.Naming_Data.Body_Suffix);
311 Lang := In_Tree.Languages_Data.Table (Lang).Next;
314 if Suffix /= No_File then
315 return Get_Name_String (Suffix);
322 -----------------------------
323 -- Default_Ada_Body_Suffix --
324 -----------------------------
326 function Default_Ada_Body_Suffix return File_Name_Type is
328 return Default_Ada_Body_Suffix_Id;
329 end Default_Ada_Body_Suffix;
331 -----------------------------
332 -- Default_Ada_Spec_Suffix --
333 -----------------------------
335 function Default_Ada_Spec_Suffix return File_Name_Type is
337 return Default_Ada_Spec_Suffix_Id;
338 end Default_Ada_Spec_Suffix;
340 ---------------------------
341 -- Delete_All_Temp_Files --
342 ---------------------------
344 procedure Delete_All_Temp_Files is
346 pragma Warnings (Off, Dont_Care);
348 if not Debug.Debug_Flag_N then
349 for Index in 1 .. Temp_Files.Last loop
351 (Get_Name_String (Temp_Files.Table (Index)), Dont_Care);
354 end Delete_All_Temp_Files;
356 ---------------------
357 -- Dependency_Name --
358 ---------------------
360 function Dependency_Name
361 (Source_File_Name : File_Name_Type;
362 Dependency : Dependency_File_Kind) return File_Name_Type
373 (Source_File_Name, Makefile_Dependency_Suffix));
379 (Source_File_Name, ALI_Dependency_Suffix));
383 ---------------------------
384 -- Display_Language_Name --
385 ---------------------------
387 procedure Display_Language_Name
388 (In_Tree : Project_Tree_Ref;
389 Language : Language_Index)
392 Get_Name_String (In_Tree.Languages_Data.Table (Language).Display_Name);
393 Write_Str (Name_Buffer (1 .. Name_Len));
394 end Display_Language_Name;
400 function Empty_File return File_Name_Type is
402 return File_Name_Type (The_Empty_String);
409 function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
410 Value : Project_Data;
413 Prj.Initialize (Tree => No_Project_Tree);
414 Value := Project_Empty;
415 Value.Naming := Tree.Private_Part.Default_Naming;
424 function Empty_String return Name_Id is
426 return The_Empty_String;
433 procedure Expect (The_Token : Token_Type; Token_Image : String) is
435 if Token /= The_Token then
436 Error_Msg (Token_Image & " expected", Token_Ptr);
445 (File : File_Name_Type;
446 With_Suffix : String) return File_Name_Type
451 Get_Name_String (File);
452 Last := Name_Len + 1;
454 while Name_Len /= 0 and then Name_Buffer (Name_Len) /= '.' loop
455 Name_Len := Name_Len - 1;
458 if Name_Len <= 1 then
462 for J in With_Suffix'Range loop
463 Name_Buffer (Name_Len) := With_Suffix (J);
464 Name_Len := Name_Len + 1;
467 Name_Len := Name_Len - 1;
472 --------------------------------
473 -- For_Every_Project_Imported --
474 --------------------------------
476 procedure For_Every_Project_Imported
478 In_Tree : Project_Tree_Ref;
479 With_State : in out State)
482 procedure Recursive_Check (Project : Project_Id);
483 -- Check if a project has already been seen. If not seen, mark it as
484 -- Seen, Call Action, and check all its imported projects.
486 ---------------------
487 -- Recursive_Check --
488 ---------------------
490 procedure Recursive_Check (Project : Project_Id) is
493 if not In_Tree.Projects.Table (Project).Seen then
494 In_Tree.Projects.Table (Project).Seen := True;
495 Action (Project, With_State);
497 List := In_Tree.Projects.Table (Project).Imported_Projects;
498 while List /= Empty_Project_List loop
499 Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
500 List := In_Tree.Project_Lists.Table (List).Next;
505 -- Start of processing for For_Every_Project_Imported
508 for Project in Project_Table.First ..
509 Project_Table.Last (In_Tree.Projects)
511 In_Tree.Projects.Table (Project).Seen := False;
514 Recursive_Check (Project => By);
515 end For_Every_Project_Imported;
521 function Get_Mode return Mode is
530 function Hash is new System.HTable.Hash (Header_Num => Header_Num);
531 -- Used in implementation of other functions Hash below
533 function Hash (Name : File_Name_Type) return Header_Num is
535 return Hash (Get_Name_String (Name));
538 function Hash (Name : Name_Id) return Header_Num is
540 return Hash (Get_Name_String (Name));
543 function Hash (Name : Path_Name_Type) return Header_Num is
545 return Hash (Get_Name_String (Name));
548 function Hash (Project : Project_Id) return Header_Num is
550 return Header_Num (Project mod Max_Header_Num);
557 function Image (Casing : Casing_Type) return String is
559 return The_Casing_Images (Casing).all;
562 ----------------------
563 -- In_Configuration --
564 ----------------------
566 function In_Configuration return Boolean is
568 return Configuration_Mode;
569 end In_Configuration;
575 procedure Initialize (Tree : Project_Tree_Ref) is
577 if not Initialized then
581 The_Empty_String := Name_Find;
582 Empty_Name := The_Empty_String;
583 Empty_File_Name := File_Name_Type (The_Empty_String);
585 Name_Buffer (1 .. 4) := ".ads";
586 Default_Ada_Spec_Suffix_Id := Name_Find;
588 Name_Buffer (1 .. 4) := ".adb";
589 Default_Ada_Body_Suffix_Id := Name_Find;
591 Name_Buffer (1) := '/';
592 Slash_Id := Name_Find;
596 Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
597 Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
598 Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
601 if Tree /= No_Project_Tree then
610 function Is_A_Language
611 (Tree : Project_Tree_Ref;
613 Language_Name : Name_Id) return Boolean
616 if Get_Mode = Ada_Only then
618 List : Name_List_Index := Data.Languages;
620 while List /= No_Name_List loop
621 if Tree.Name_Lists.Table (List).Name = Language_Name then
624 List := Tree.Name_Lists.Table (List).Next;
631 Lang_Ind : Language_Index := Data.First_Language_Processing;
632 Lang_Data : Language_Data;
635 while Lang_Ind /= No_Language_Index loop
636 Lang_Data := Tree.Languages_Data.Table (Lang_Ind);
638 if Lang_Data.Name = Language_Name then
642 Lang_Ind := Lang_Data.Next;
654 function Is_Extending
655 (Extending : Project_Id;
656 Extended : Project_Id;
657 In_Tree : Project_Tree_Ref) return Boolean
663 while Proj /= No_Project loop
664 if Proj = Extended then
668 Proj := In_Tree.Projects.Table (Proj).Extends;
674 -----------------------
675 -- Objects_Exist_For --
676 -----------------------
678 function Objects_Exist_For
680 In_Tree : Project_Tree_Ref) return Boolean
682 Language_Id : Name_Id;
683 Lang : Language_Index;
686 if Current_Mode = Multi_Language then
688 Add_Str_To_Name_Buffer (Language);
689 To_Lower (Name_Buffer (1 .. Name_Len));
690 Language_Id := Name_Find;
692 Lang := In_Tree.First_Language;
693 while Lang /= No_Language_Index loop
694 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
696 In_Tree.Languages_Data.Table
697 (Lang).Config.Object_Generated;
700 Lang := In_Tree.Languages_Data.Table (Lang).Next;
705 end Objects_Exist_For;
712 (Source_File_Name : File_Name_Type;
713 Object_File_Suffix : Name_Id := No_Name)
714 return File_Name_Type
717 if Object_File_Suffix = No_Name then
719 (Source_File_Name, Object_Suffix);
722 (Source_File_Name, Get_Name_String (Object_File_Suffix));
726 ----------------------
727 -- Record_Temp_File --
728 ----------------------
730 procedure Record_Temp_File (Path : Path_Name_Type) is
732 Temp_Files.Increment_Last;
733 Temp_Files.Table (Temp_Files.Last) := Path;
734 end Record_Temp_File;
736 ------------------------------------
737 -- Register_Default_Naming_Scheme --
738 ------------------------------------
740 procedure Register_Default_Naming_Scheme
742 Default_Spec_Suffix : File_Name_Type;
743 Default_Body_Suffix : File_Name_Type;
744 In_Tree : Project_Tree_Ref)
747 Suffix : Array_Element_Id;
748 Found : Boolean := False;
749 Element : Array_Element;
752 -- Get the language name in small letters
754 Get_Name_String (Language);
755 Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
758 -- Look for an element of the spec suffix array indexed by the language
759 -- name. If one is found, put the default value.
761 Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
763 while Suffix /= No_Array_Element and then not Found loop
764 Element := In_Tree.Array_Elements.Table (Suffix);
766 if Element.Index = Lang then
768 Element.Value.Value := Name_Id (Default_Spec_Suffix);
769 In_Tree.Array_Elements.Table (Suffix) := Element;
772 Suffix := Element.Next;
776 -- If none can be found, create a new one
782 Index_Case_Sensitive => False,
783 Value => (Project => No_Project,
785 Location => No_Location,
787 Value => Name_Id (Default_Spec_Suffix),
789 Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
790 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
791 In_Tree.Array_Elements.Table
792 (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
794 In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
795 Array_Element_Table.Last (In_Tree.Array_Elements);
798 -- Look for an element of the body suffix array indexed by the language
799 -- name. If one is found, put the default value.
801 Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
803 while Suffix /= No_Array_Element and then not Found loop
804 Element := In_Tree.Array_Elements.Table (Suffix);
806 if Element.Index = Lang then
808 Element.Value.Value := Name_Id (Default_Body_Suffix);
809 In_Tree.Array_Elements.Table (Suffix) := Element;
812 Suffix := Element.Next;
816 -- If none can be found, create a new one
822 Index_Case_Sensitive => False,
823 Value => (Project => No_Project,
825 Location => No_Location,
827 Value => Name_Id (Default_Body_Suffix),
829 Next => In_Tree.Private_Part.Default_Naming.Body_Suffix);
830 Array_Element_Table.Increment_Last
831 (In_Tree.Array_Elements);
832 In_Tree.Array_Elements.Table
833 (Array_Element_Table.Last (In_Tree.Array_Elements))
835 In_Tree.Private_Part.Default_Naming.Body_Suffix :=
836 Array_Element_Table.Last (In_Tree.Array_Elements);
838 end Register_Default_Naming_Scheme;
844 procedure Free (Project : in out Project_Data) is
846 Free (Project.Dir_Path);
847 Free (Project.Include_Path);
848 Free (Project.Ada_Include_Path);
849 Free (Project.Objects_Path);
850 Free (Project.Ada_Objects_Path);
857 procedure Free (Tree : in out Project_Tree_Ref) is
858 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
859 (Project_Tree_Data, Project_Tree_Ref);
862 Language_Data_Table.Free (Tree.Languages_Data);
863 Name_List_Table.Free (Tree.Name_Lists);
864 String_Element_Table.Free (Tree.String_Elements);
865 Variable_Element_Table.Free (Tree.Variable_Elements);
866 Array_Element_Table.Free (Tree.Array_Elements);
867 Array_Table.Free (Tree.Arrays);
868 Package_Table.Free (Tree.Packages);
869 Project_List_Table.Free (Tree.Project_Lists);
870 Source_Data_Table.Free (Tree.Sources);
871 Alternate_Language_Table.Free (Tree.Alt_Langs);
872 Unit_Table.Free (Tree.Units);
873 Units_Htable.Reset (Tree.Units_HT);
874 Files_Htable.Reset (Tree.Files_HT);
875 Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
876 Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
878 for P in Project_Table.First ..
879 Project_Table.Last (Tree.Projects)
881 Free (Tree.Projects.Table (P));
884 Project_Table.Free (Tree.Projects);
888 Naming_Table.Free (Tree.Private_Part.Namings);
889 Path_File_Table.Free (Tree.Private_Part.Path_Files);
890 Source_Path_Table.Free (Tree.Private_Part.Source_Paths);
891 Object_Path_Table.Free (Tree.Private_Part.Object_Paths);
893 -- Naming data (nothing to free ?)
896 Unchecked_Free (Tree);
904 procedure Reset (Tree : Project_Tree_Ref) is
910 Language_Data_Table.Init (Tree.Languages_Data);
911 Name_List_Table.Init (Tree.Name_Lists);
912 String_Element_Table.Init (Tree.String_Elements);
913 Variable_Element_Table.Init (Tree.Variable_Elements);
914 Array_Element_Table.Init (Tree.Array_Elements);
915 Array_Table.Init (Tree.Arrays);
916 Package_Table.Init (Tree.Packages);
917 Project_List_Table.Init (Tree.Project_Lists);
918 Source_Data_Table.Init (Tree.Sources);
919 Alternate_Language_Table.Init (Tree.Alt_Langs);
920 Unit_Table.Init (Tree.Units);
921 Units_Htable.Reset (Tree.Units_HT);
922 Files_Htable.Reset (Tree.Files_HT);
923 Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
924 Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
926 if not Project_Table."=" (Tree.Projects.Table, null) then
927 for P in Project_Table.First ..
928 Project_Table.Last (Tree.Projects)
930 Free (Tree.Projects.Table (P));
934 Project_Table.Init (Tree.Projects);
936 -- Private part table
938 Naming_Table.Init (Tree.Private_Part.Namings);
939 Naming_Table.Increment_Last (Tree.Private_Part.Namings);
940 Tree.Private_Part.Namings.Table
941 (Naming_Table.Last (Tree.Private_Part.Namings)) := Std_Naming_Data;
942 Path_File_Table.Init (Tree.Private_Part.Path_Files);
943 Source_Path_Table.Init (Tree.Private_Part.Source_Paths);
944 Object_Path_Table.Init (Tree.Private_Part.Object_Paths);
945 Tree.Private_Part.Default_Naming := Std_Naming_Data;
947 if Current_Mode = Ada_Only then
948 Register_Default_Naming_Scheme
949 (Language => Name_Ada,
950 Default_Spec_Suffix => Default_Ada_Spec_Suffix,
951 Default_Body_Suffix => Default_Ada_Body_Suffix,
953 Tree.Private_Part.Default_Naming.Separate_Suffix :=
954 Default_Ada_Body_Suffix;
958 ------------------------
959 -- Same_Naming_Scheme --
960 ------------------------
962 function Same_Naming_Scheme
963 (Left, Right : Naming_Data) return Boolean
966 return Left.Dot_Replacement = Right.Dot_Replacement
967 and then Left.Casing = Right.Casing
968 and then Left.Separate_Suffix = Right.Separate_Suffix;
969 end Same_Naming_Scheme;
971 ---------------------
972 -- Set_Body_Suffix --
973 ---------------------
975 procedure Set_Body_Suffix
976 (In_Tree : Project_Tree_Ref;
978 Naming : in out Naming_Data;
979 Suffix : File_Name_Type)
981 Language_Id : Name_Id;
982 Element : Array_Element;
986 Add_Str_To_Name_Buffer (Language);
987 To_Lower (Name_Buffer (1 .. Name_Len));
988 Language_Id := Name_Find;
991 (Index => Language_Id,
993 Index_Case_Sensitive => False,
996 Project => No_Project,
997 Location => No_Location,
999 Value => Name_Id (Suffix),
1001 Next => Naming.Body_Suffix);
1003 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1004 Naming.Body_Suffix :=
1005 Array_Element_Table.Last (In_Tree.Array_Elements);
1006 In_Tree.Array_Elements.Table (Naming.Body_Suffix) := Element;
1007 end Set_Body_Suffix;
1009 --------------------------
1010 -- Set_In_Configuration --
1011 --------------------------
1013 procedure Set_In_Configuration (Value : Boolean) is
1015 Configuration_Mode := Value;
1016 end Set_In_Configuration;
1022 procedure Set_Mode (New_Mode : Mode) is
1024 Current_Mode := New_Mode;
1027 Default_Language_Is_Ada := True;
1028 Must_Check_Configuration := False;
1029 when Multi_Language =>
1030 Default_Language_Is_Ada := False;
1031 Must_Check_Configuration := True;
1035 ---------------------
1036 -- Set_Spec_Suffix --
1037 ---------------------
1039 procedure Set_Spec_Suffix
1040 (In_Tree : Project_Tree_Ref;
1042 Naming : in out Naming_Data;
1043 Suffix : File_Name_Type)
1045 Language_Id : Name_Id;
1046 Element : Array_Element;
1050 Add_Str_To_Name_Buffer (Language);
1051 To_Lower (Name_Buffer (1 .. Name_Len));
1052 Language_Id := Name_Find;
1055 (Index => Language_Id,
1057 Index_Case_Sensitive => False,
1060 Project => No_Project,
1061 Location => No_Location,
1063 Value => Name_Id (Suffix),
1065 Next => Naming.Spec_Suffix);
1067 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1068 Naming.Spec_Suffix :=
1069 Array_Element_Table.Last (In_Tree.Array_Elements);
1070 In_Tree.Array_Elements.Table (Naming.Spec_Suffix) := Element;
1071 end Set_Spec_Suffix;
1077 function Slash return Path_Name_Type is
1082 -----------------------
1083 -- Spec_Suffix_Id_Of --
1084 -----------------------
1086 function Spec_Suffix_Id_Of
1087 (In_Tree : Project_Tree_Ref;
1089 Naming : Naming_Data) return File_Name_Type
1091 Language_Id : Name_Id;
1095 Add_Str_To_Name_Buffer (Language);
1096 To_Lower (Name_Buffer (1 .. Name_Len));
1097 Language_Id := Name_Find;
1101 (In_Tree => In_Tree,
1102 Language_Id => Language_Id,
1104 end Spec_Suffix_Id_Of;
1106 -----------------------
1107 -- Spec_Suffix_Id_Of --
1108 -----------------------
1110 function Spec_Suffix_Id_Of
1111 (In_Tree : Project_Tree_Ref;
1112 Language_Id : Name_Id;
1113 Naming : Naming_Data) return File_Name_Type
1115 Element_Id : Array_Element_Id;
1116 Element : Array_Element;
1117 Suffix : File_Name_Type := No_File;
1118 Lang : Language_Index;
1121 Element_Id := Naming.Spec_Suffix;
1122 while Element_Id /= No_Array_Element loop
1123 Element := In_Tree.Array_Elements.Table (Element_Id);
1125 if Element.Index = Language_Id then
1126 return File_Name_Type (Element.Value.Value);
1129 Element_Id := Element.Next;
1132 if Current_Mode = Multi_Language then
1133 Lang := In_Tree.First_Language;
1134 while Lang /= No_Language_Index loop
1135 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1137 In_Tree.Languages_Data.Table
1138 (Lang).Config.Naming_Data.Spec_Suffix;
1142 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1147 end Spec_Suffix_Id_Of;
1149 --------------------
1150 -- Spec_Suffix_Of --
1151 --------------------
1153 function Spec_Suffix_Of
1154 (In_Tree : Project_Tree_Ref;
1156 Naming : Naming_Data) return String
1158 Language_Id : Name_Id;
1159 Element_Id : Array_Element_Id;
1160 Element : Array_Element;
1161 Suffix : File_Name_Type := No_File;
1162 Lang : Language_Index;
1166 Add_Str_To_Name_Buffer (Language);
1167 To_Lower (Name_Buffer (1 .. Name_Len));
1168 Language_Id := Name_Find;
1170 Element_Id := Naming.Spec_Suffix;
1171 while Element_Id /= No_Array_Element loop
1172 Element := In_Tree.Array_Elements.Table (Element_Id);
1174 if Element.Index = Language_Id then
1175 return Get_Name_String (Element.Value.Value);
1178 Element_Id := Element.Next;
1181 if Current_Mode = Multi_Language then
1182 Lang := In_Tree.First_Language;
1183 while Lang /= No_Language_Index loop
1184 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1187 (In_Tree.Languages_Data.Table
1188 (Lang).Config.Naming_Data.Spec_Suffix);
1192 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1195 if Suffix /= No_File then
1196 return Get_Name_String (Suffix);
1203 --------------------------
1204 -- Standard_Naming_Data --
1205 --------------------------
1207 function Standard_Naming_Data
1208 (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
1211 if Tree = No_Project_Tree then
1212 Prj.Initialize (Tree => No_Project_Tree);
1213 return Std_Naming_Data;
1215 return Tree.Private_Part.Default_Naming;
1217 end Standard_Naming_Data;
1223 function Switches_Name
1224 (Source_File_Name : File_Name_Type) return File_Name_Type
1227 return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
1234 function Value (Image : String) return Casing_Type is
1236 for Casing in The_Casing_Images'Range loop
1237 if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
1242 raise Constraint_Error;
1246 -- Make sure that the standard config and user project file extensions are
1247 -- compatible with canonical case file naming.
1249 Canonical_Case_File_Name (Config_Project_File_Extension);
1250 Canonical_Case_File_Name (Project_File_Extension);