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;
36 with Uintp; use Uintp;
38 with System.Case_Util; use System.Case_Util;
43 Object_Suffix : constant String := Get_Target_Object_Suffix.all;
44 -- File suffix for object files
46 Initial_Buffer_Size : constant := 100;
47 -- Initial size for extensible buffer used in Add_To_Buffer
49 Current_Mode : Mode := Ada_Only;
51 Configuration_Mode : Boolean := False;
53 The_Empty_String : 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);
88 Project_Empty : constant Project_Data :=
89 (Qualifier => Unspecified,
90 Externally_Built => False,
91 Config => Default_Project_Config,
92 Languages => No_Name_List,
93 First_Referred_By => No_Project,
95 Display_Name => No_Name,
96 Path => No_Path_Information,
98 Location => No_Location,
100 Directory => No_Path_Information,
103 Library_Dir => No_Path_Information,
104 Library_Src_Dir => No_Path_Information,
105 Library_ALI_Dir => No_Path_Information,
106 Library_Name => No_Name,
107 Library_Kind => Static,
108 Lib_Internal_Name => No_Name,
109 Standalone_Library => False,
110 Lib_Interface_ALIs => Nil_String,
111 Lib_Auto_Init => False,
112 Libgnarl_Needed => Unknown,
113 Symbol_Data => No_Symbols,
114 Ada_Sources_Present => True,
115 Other_Sources_Present => True,
116 Ada_Sources => Nil_String,
117 First_Source => No_Source,
118 Last_Source => No_Source,
119 Interfaces_Defined => False,
120 Unit_Based_Language_Name => No_Name,
121 Unit_Based_Language_Index => No_Language_Index,
122 Imported_Directories_Switches => null,
123 Include_Path => null,
124 Include_Data_Set => False,
125 Include_Language => No_Language_Index,
126 Source_Dirs => Nil_String,
127 Known_Order_Of_Source_Dirs => True,
128 Object_Directory => No_Path_Information,
129 Library_TS => Empty_Time_Stamp,
130 Exec_Directory => No_Path_Information,
131 Extends => No_Project,
132 Extended_By => No_Project,
133 Naming => Std_Naming_Data,
134 First_Language_Processing => No_Language_Index,
135 Decl => No_Declarations,
136 Imported_Projects => Empty_Project_List,
137 All_Imported_Projects => Empty_Project_List,
138 Ada_Include_Path => null,
139 Ada_Objects_Path => null,
140 Objects_Path => null,
141 Include_Path_File => No_Path,
142 Objects_Path_File_With_Libs => No_Path,
143 Objects_Path_File_Without_Libs => No_Path,
144 Config_File_Name => No_Path,
145 Config_File_Temp => False,
146 Config_Checked => False,
149 Need_To_Build_Lib => False,
151 Unkept_Comments => False);
153 package Temp_Files is new Table.Table
154 (Table_Component_Type => Path_Name_Type,
155 Table_Index_Type => Integer,
156 Table_Low_Bound => 1,
158 Table_Increment => 100,
159 Table_Name => "Makegpr.Temp_Files");
160 -- Table to store the path name of all the created temporary files, so that
161 -- they can be deleted at the end, or when the program is interrupted.
167 procedure Add_To_Buffer
169 To : in out String_Access;
170 Last : in out Natural)
174 To := new String (1 .. Initial_Buffer_Size);
178 -- If Buffer is too small, double its size
180 while Last + S'Length > To'Last loop
182 New_Buffer : constant String_Access :=
183 new String (1 .. 2 * Last);
186 New_Buffer (1 .. Last) := To (1 .. Last);
192 To (Last + 1 .. Last + S'Length) := S;
193 Last := Last + S'Length;
196 -----------------------
197 -- Body_Suffix_Id_Of --
198 -----------------------
200 function Body_Suffix_Id_Of
201 (In_Tree : Project_Tree_Ref;
203 Naming : Naming_Data) return File_Name_Type
205 Language_Id : Name_Id;
209 Add_Str_To_Name_Buffer (Language);
210 To_Lower (Name_Buffer (1 .. Name_Len));
211 Language_Id := Name_Find;
216 Language_Id => Language_Id,
218 end Body_Suffix_Id_Of;
220 -----------------------
221 -- Body_Suffix_Id_Of --
222 -----------------------
224 function Body_Suffix_Id_Of
225 (In_Tree : Project_Tree_Ref;
226 Language_Id : Name_Id;
227 Naming : Naming_Data) return File_Name_Type
229 Element_Id : Array_Element_Id;
230 Element : Array_Element;
231 Suffix : File_Name_Type := No_File;
232 Lang : Language_Index;
235 -- ??? This seems to be only for Ada_Only mode...
236 Element_Id := Naming.Body_Suffix;
237 while Element_Id /= No_Array_Element loop
238 Element := In_Tree.Array_Elements.Table (Element_Id);
240 if Element.Index = Language_Id then
241 return File_Name_Type (Element.Value.Value);
244 Element_Id := Element.Next;
247 if Current_Mode = Multi_Language then
248 Lang := In_Tree.First_Language;
249 while Lang /= No_Language_Index loop
250 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
252 In_Tree.Languages_Data.Table
253 (Lang).Config.Naming_Data.Body_Suffix;
257 Lang := In_Tree.Languages_Data.Table (Lang).Next;
262 end Body_Suffix_Id_Of;
268 function Body_Suffix_Of
269 (In_Tree : Project_Tree_Ref;
271 Naming : Naming_Data) return String
273 Language_Id : Name_Id;
274 Element_Id : Array_Element_Id;
275 Element : Array_Element;
276 Suffix : File_Name_Type := No_File;
277 Lang : Language_Index;
281 Add_Str_To_Name_Buffer (Language);
282 To_Lower (Name_Buffer (1 .. Name_Len));
283 Language_Id := Name_Find;
285 Element_Id := Naming.Body_Suffix;
286 while Element_Id /= No_Array_Element loop
287 Element := In_Tree.Array_Elements.Table (Element_Id);
289 if Element.Index = Language_Id then
290 return Get_Name_String (Element.Value.Value);
293 Element_Id := Element.Next;
296 if Current_Mode = Multi_Language then
297 Lang := In_Tree.First_Language;
298 while Lang /= No_Language_Index loop
299 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
302 (In_Tree.Languages_Data.Table
303 (Lang).Config.Naming_Data.Body_Suffix);
307 Lang := In_Tree.Languages_Data.Table (Lang).Next;
310 if Suffix /= No_File then
311 return Get_Name_String (Suffix);
318 -----------------------------
319 -- Default_Ada_Body_Suffix --
320 -----------------------------
322 function Default_Ada_Body_Suffix return File_Name_Type is
324 return Default_Ada_Body_Suffix_Id;
325 end Default_Ada_Body_Suffix;
327 -----------------------------
328 -- Default_Ada_Spec_Suffix --
329 -----------------------------
331 function Default_Ada_Spec_Suffix return File_Name_Type is
333 return Default_Ada_Spec_Suffix_Id;
334 end Default_Ada_Spec_Suffix;
336 ---------------------------
337 -- Delete_All_Temp_Files --
338 ---------------------------
340 procedure Delete_All_Temp_Files is
342 pragma Warnings (Off, Dont_Care);
344 if not Debug.Debug_Flag_N then
345 for Index in 1 .. Temp_Files.Last loop
347 (Get_Name_String (Temp_Files.Table (Index)), Dont_Care);
350 end Delete_All_Temp_Files;
352 ---------------------
353 -- Dependency_Name --
354 ---------------------
356 function Dependency_Name
357 (Source_File_Name : File_Name_Type;
358 Dependency : Dependency_File_Kind) return File_Name_Type
369 (Source_File_Name, Makefile_Dependency_Suffix));
375 (Source_File_Name, ALI_Dependency_Suffix));
379 ---------------------------
380 -- Display_Language_Name --
381 ---------------------------
383 procedure Display_Language_Name
384 (In_Tree : Project_Tree_Ref;
385 Language : Language_Index)
388 Get_Name_String (In_Tree.Languages_Data.Table (Language).Display_Name);
389 Write_Str (Name_Buffer (1 .. Name_Len));
390 end Display_Language_Name;
396 function Empty_File return File_Name_Type is
398 return File_Name_Type (The_Empty_String);
405 function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
406 Value : Project_Data;
409 Prj.Initialize (Tree => No_Project_Tree);
410 Value := Project_Empty;
411 Value.Naming := Tree.Private_Part.Default_Naming;
420 function Empty_String return Name_Id is
422 return The_Empty_String;
429 procedure Expect (The_Token : Token_Type; Token_Image : String) is
431 if Token /= The_Token then
432 Error_Msg (Token_Image & " expected", Token_Ptr);
441 (File : File_Name_Type;
442 With_Suffix : String) return File_Name_Type
447 Get_Name_String (File);
448 Last := Name_Len + 1;
450 while Name_Len /= 0 and then Name_Buffer (Name_Len) /= '.' loop
451 Name_Len := Name_Len - 1;
454 if Name_Len <= 1 then
458 for J in With_Suffix'Range loop
459 Name_Buffer (Name_Len) := With_Suffix (J);
460 Name_Len := Name_Len + 1;
463 Name_Len := Name_Len - 1;
468 --------------------------------
469 -- For_Every_Project_Imported --
470 --------------------------------
472 procedure For_Every_Project_Imported
474 In_Tree : Project_Tree_Ref;
475 With_State : in out State)
478 procedure Recursive_Check (Project : Project_Id);
479 -- Check if a project has already been seen. If not seen, mark it as
480 -- Seen, Call Action, and check all its imported projects.
482 ---------------------
483 -- Recursive_Check --
484 ---------------------
486 procedure Recursive_Check (Project : Project_Id) is
489 if not In_Tree.Projects.Table (Project).Seen then
490 In_Tree.Projects.Table (Project).Seen := True;
491 Action (Project, With_State);
493 List := In_Tree.Projects.Table (Project).Imported_Projects;
494 while List /= Empty_Project_List loop
495 Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
496 List := In_Tree.Project_Lists.Table (List).Next;
501 -- Start of processing for For_Every_Project_Imported
504 for Project in Project_Table.First ..
505 Project_Table.Last (In_Tree.Projects)
507 In_Tree.Projects.Table (Project).Seen := False;
510 Recursive_Check (Project => By);
511 end For_Every_Project_Imported;
517 function Get_Mode return Mode is
526 function Hash is new System.HTable.Hash (Header_Num => Header_Num);
527 -- Used in implementation of other functions Hash below
529 function Hash (Name : File_Name_Type) return Header_Num is
531 return Hash (Get_Name_String (Name));
534 function Hash (Name : Name_Id) return Header_Num is
536 return Hash (Get_Name_String (Name));
539 function Hash (Name : Path_Name_Type) return Header_Num is
541 return Hash (Get_Name_String (Name));
544 function Hash (Project : Project_Id) return Header_Num is
546 return Header_Num (Project mod Max_Header_Num);
553 function Image (Casing : Casing_Type) return String is
555 return The_Casing_Images (Casing).all;
558 ----------------------
559 -- In_Configuration --
560 ----------------------
562 function In_Configuration return Boolean is
564 return Configuration_Mode;
565 end In_Configuration;
571 procedure Initialize (Tree : Project_Tree_Ref) is
573 if not Initialized then
577 The_Empty_String := Name_Find;
578 Empty_Name := The_Empty_String;
579 Empty_File_Name := File_Name_Type (The_Empty_String);
581 Name_Buffer (1 .. 4) := ".ads";
582 Default_Ada_Spec_Suffix_Id := Name_Find;
584 Name_Buffer (1 .. 4) := ".adb";
585 Default_Ada_Body_Suffix_Id := Name_Find;
587 Name_Buffer (1) := '/';
588 Slash_Id := Name_Find;
592 Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
593 Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
594 Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
597 if Tree /= No_Project_Tree then
606 function Is_A_Language
607 (Tree : Project_Tree_Ref;
609 Language_Name : Name_Id) return Boolean
612 if Get_Mode = Ada_Only then
614 List : Name_List_Index := Data.Languages;
616 while List /= No_Name_List loop
617 if Tree.Name_Lists.Table (List).Name = Language_Name then
620 List := Tree.Name_Lists.Table (List).Next;
627 Lang_Ind : Language_Index := Data.First_Language_Processing;
628 Lang_Data : Language_Data;
631 while Lang_Ind /= No_Language_Index loop
632 Lang_Data := Tree.Languages_Data.Table (Lang_Ind);
634 if Lang_Data.Name = Language_Name then
638 Lang_Ind := Lang_Data.Next;
650 function Is_Extending
651 (Extending : Project_Id;
652 Extended : Project_Id;
653 In_Tree : Project_Tree_Ref) return Boolean
659 while Proj /= No_Project loop
660 if Proj = Extended then
664 Proj := In_Tree.Projects.Table (Proj).Extends;
670 -----------------------
671 -- Objects_Exist_For --
672 -----------------------
674 function Objects_Exist_For
676 In_Tree : Project_Tree_Ref) return Boolean
678 Language_Id : Name_Id;
679 Lang : Language_Index;
682 if Current_Mode = Multi_Language then
684 Add_Str_To_Name_Buffer (Language);
685 To_Lower (Name_Buffer (1 .. Name_Len));
686 Language_Id := Name_Find;
688 Lang := In_Tree.First_Language;
689 while Lang /= No_Language_Index loop
690 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
692 In_Tree.Languages_Data.Table
693 (Lang).Config.Object_Generated;
696 Lang := In_Tree.Languages_Data.Table (Lang).Next;
701 end Objects_Exist_For;
708 (Source_File_Name : File_Name_Type)
709 return File_Name_Type
712 return Extend_Name (Source_File_Name, Object_Suffix);
715 ----------------------
716 -- Record_Temp_File --
717 ----------------------
719 procedure Record_Temp_File (Path : Path_Name_Type) is
721 Temp_Files.Increment_Last;
722 Temp_Files.Table (Temp_Files.Last) := Path;
723 end Record_Temp_File;
725 ------------------------------------
726 -- Register_Default_Naming_Scheme --
727 ------------------------------------
729 procedure Register_Default_Naming_Scheme
731 Default_Spec_Suffix : File_Name_Type;
732 Default_Body_Suffix : File_Name_Type;
733 In_Tree : Project_Tree_Ref)
736 Suffix : Array_Element_Id;
737 Found : Boolean := False;
738 Element : Array_Element;
741 -- Get the language name in small letters
743 Get_Name_String (Language);
744 Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
747 -- Look for an element of the spec suffix array indexed by the language
748 -- name. If one is found, put the default value.
750 Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
752 while Suffix /= No_Array_Element and then not Found loop
753 Element := In_Tree.Array_Elements.Table (Suffix);
755 if Element.Index = Lang then
757 Element.Value.Value := Name_Id (Default_Spec_Suffix);
758 In_Tree.Array_Elements.Table (Suffix) := Element;
761 Suffix := Element.Next;
765 -- If none can be found, create a new one
771 Index_Case_Sensitive => False,
772 Value => (Project => No_Project,
774 Location => No_Location,
776 Value => Name_Id (Default_Spec_Suffix),
778 Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
779 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
780 In_Tree.Array_Elements.Table
781 (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
783 In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
784 Array_Element_Table.Last (In_Tree.Array_Elements);
787 -- Look for an element of the body suffix array indexed by the language
788 -- name. If one is found, put the default value.
790 Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
792 while Suffix /= No_Array_Element and then not Found loop
793 Element := In_Tree.Array_Elements.Table (Suffix);
795 if Element.Index = Lang then
797 Element.Value.Value := Name_Id (Default_Body_Suffix);
798 In_Tree.Array_Elements.Table (Suffix) := Element;
801 Suffix := Element.Next;
805 -- If none can be found, create a new one
811 Index_Case_Sensitive => False,
812 Value => (Project => No_Project,
814 Location => No_Location,
816 Value => Name_Id (Default_Body_Suffix),
818 Next => In_Tree.Private_Part.Default_Naming.Body_Suffix);
819 Array_Element_Table.Increment_Last
820 (In_Tree.Array_Elements);
821 In_Tree.Array_Elements.Table
822 (Array_Element_Table.Last (In_Tree.Array_Elements))
824 In_Tree.Private_Part.Default_Naming.Body_Suffix :=
825 Array_Element_Table.Last (In_Tree.Array_Elements);
827 end Register_Default_Naming_Scheme;
833 procedure Reset (Tree : Project_Tree_Ref) is
835 -- Def_Lang : constant Name_Node :=
836 -- (Name => Name_Ada,
837 -- Next => No_Name_List);
838 -- Why is the above commented out ???
845 Language_Data_Table.Init (Tree.Languages_Data);
846 Name_List_Table.Init (Tree.Name_Lists);
847 String_Element_Table.Init (Tree.String_Elements);
848 Variable_Element_Table.Init (Tree.Variable_Elements);
849 Array_Element_Table.Init (Tree.Array_Elements);
850 Array_Table.Init (Tree.Arrays);
851 Package_Table.Init (Tree.Packages);
852 Project_List_Table.Init (Tree.Project_Lists);
853 Project_Table.Init (Tree.Projects);
854 Source_Data_Table.Init (Tree.Sources);
855 Alternate_Language_Table.Init (Tree.Alt_Langs);
856 Unit_Table.Init (Tree.Units);
857 Units_Htable.Reset (Tree.Units_HT);
858 Files_Htable.Reset (Tree.Files_HT);
859 Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
860 Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
862 -- Private part table
864 Naming_Table.Init (Tree.Private_Part.Namings);
865 Naming_Table.Increment_Last (Tree.Private_Part.Namings);
866 Tree.Private_Part.Namings.Table
867 (Naming_Table.Last (Tree.Private_Part.Namings)) := Std_Naming_Data;
868 Path_File_Table.Init (Tree.Private_Part.Path_Files);
869 Source_Path_Table.Init (Tree.Private_Part.Source_Paths);
870 Object_Path_Table.Init (Tree.Private_Part.Object_Paths);
871 Tree.Private_Part.Default_Naming := Std_Naming_Data;
873 if Current_Mode = Ada_Only then
874 Register_Default_Naming_Scheme
875 (Language => Name_Ada,
876 Default_Spec_Suffix => Default_Ada_Spec_Suffix,
877 Default_Body_Suffix => Default_Ada_Body_Suffix,
879 Tree.Private_Part.Default_Naming.Separate_Suffix :=
880 Default_Ada_Body_Suffix;
884 ------------------------
885 -- Same_Naming_Scheme --
886 ------------------------
888 function Same_Naming_Scheme
889 (Left, Right : Naming_Data) return Boolean
892 return Left.Dot_Replacement = Right.Dot_Replacement
893 and then Left.Casing = Right.Casing
894 and then Left.Separate_Suffix = Right.Separate_Suffix;
895 end Same_Naming_Scheme;
897 ---------------------
898 -- Set_Body_Suffix --
899 ---------------------
901 procedure Set_Body_Suffix
902 (In_Tree : Project_Tree_Ref;
904 Naming : in out Naming_Data;
905 Suffix : File_Name_Type)
907 Language_Id : Name_Id;
908 Element : Array_Element;
912 Add_Str_To_Name_Buffer (Language);
913 To_Lower (Name_Buffer (1 .. Name_Len));
914 Language_Id := Name_Find;
917 (Index => Language_Id,
919 Index_Case_Sensitive => False,
922 Project => No_Project,
923 Location => No_Location,
925 Value => Name_Id (Suffix),
927 Next => Naming.Body_Suffix);
929 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
930 Naming.Body_Suffix :=
931 Array_Element_Table.Last (In_Tree.Array_Elements);
932 In_Tree.Array_Elements.Table (Naming.Body_Suffix) := Element;
935 --------------------------
936 -- Set_In_Configuration --
937 --------------------------
939 procedure Set_In_Configuration (Value : Boolean) is
941 Configuration_Mode := Value;
942 end Set_In_Configuration;
948 procedure Set_Mode (New_Mode : Mode) is
950 Current_Mode := New_Mode;
953 Default_Language_Is_Ada := True;
954 Must_Check_Configuration := False;
955 when Multi_Language =>
956 Default_Language_Is_Ada := False;
957 Must_Check_Configuration := True;
961 ---------------------
962 -- Set_Spec_Suffix --
963 ---------------------
965 procedure Set_Spec_Suffix
966 (In_Tree : Project_Tree_Ref;
968 Naming : in out Naming_Data;
969 Suffix : File_Name_Type)
971 Language_Id : Name_Id;
972 Element : Array_Element;
976 Add_Str_To_Name_Buffer (Language);
977 To_Lower (Name_Buffer (1 .. Name_Len));
978 Language_Id := Name_Find;
981 (Index => Language_Id,
983 Index_Case_Sensitive => False,
986 Project => No_Project,
987 Location => No_Location,
989 Value => Name_Id (Suffix),
991 Next => Naming.Spec_Suffix);
993 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
994 Naming.Spec_Suffix :=
995 Array_Element_Table.Last (In_Tree.Array_Elements);
996 In_Tree.Array_Elements.Table (Naming.Spec_Suffix) := Element;
1003 function Slash return Path_Name_Type is
1008 -----------------------
1009 -- Spec_Suffix_Id_Of --
1010 -----------------------
1012 function Spec_Suffix_Id_Of
1013 (In_Tree : Project_Tree_Ref;
1015 Naming : Naming_Data) return File_Name_Type
1017 Language_Id : Name_Id;
1021 Add_Str_To_Name_Buffer (Language);
1022 To_Lower (Name_Buffer (1 .. Name_Len));
1023 Language_Id := Name_Find;
1027 (In_Tree => In_Tree,
1028 Language_Id => Language_Id,
1030 end Spec_Suffix_Id_Of;
1032 -----------------------
1033 -- Spec_Suffix_Id_Of --
1034 -----------------------
1036 function Spec_Suffix_Id_Of
1037 (In_Tree : Project_Tree_Ref;
1038 Language_Id : Name_Id;
1039 Naming : Naming_Data) return File_Name_Type
1041 Element_Id : Array_Element_Id;
1042 Element : Array_Element;
1043 Suffix : File_Name_Type := No_File;
1044 Lang : Language_Index;
1047 Element_Id := Naming.Spec_Suffix;
1048 while Element_Id /= No_Array_Element loop
1049 Element := In_Tree.Array_Elements.Table (Element_Id);
1051 if Element.Index = Language_Id then
1052 return File_Name_Type (Element.Value.Value);
1055 Element_Id := Element.Next;
1058 if Current_Mode = Multi_Language then
1059 Lang := In_Tree.First_Language;
1060 while Lang /= No_Language_Index loop
1061 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1063 In_Tree.Languages_Data.Table
1064 (Lang).Config.Naming_Data.Spec_Suffix;
1068 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1073 end Spec_Suffix_Id_Of;
1075 --------------------
1076 -- Spec_Suffix_Of --
1077 --------------------
1079 function Spec_Suffix_Of
1080 (In_Tree : Project_Tree_Ref;
1082 Naming : Naming_Data) return String
1084 Language_Id : Name_Id;
1085 Element_Id : Array_Element_Id;
1086 Element : Array_Element;
1087 Suffix : File_Name_Type := No_File;
1088 Lang : Language_Index;
1092 Add_Str_To_Name_Buffer (Language);
1093 To_Lower (Name_Buffer (1 .. Name_Len));
1094 Language_Id := Name_Find;
1096 Element_Id := Naming.Spec_Suffix;
1097 while Element_Id /= No_Array_Element loop
1098 Element := In_Tree.Array_Elements.Table (Element_Id);
1100 if Element.Index = Language_Id then
1101 return Get_Name_String (Element.Value.Value);
1104 Element_Id := Element.Next;
1107 if Current_Mode = Multi_Language then
1108 Lang := In_Tree.First_Language;
1109 while Lang /= No_Language_Index loop
1110 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1113 (In_Tree.Languages_Data.Table
1114 (Lang).Config.Naming_Data.Spec_Suffix);
1118 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1121 if Suffix /= No_File then
1122 return Get_Name_String (Suffix);
1129 --------------------------
1130 -- Standard_Naming_Data --
1131 --------------------------
1133 function Standard_Naming_Data
1134 (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
1137 if Tree = No_Project_Tree then
1138 Prj.Initialize (Tree => No_Project_Tree);
1139 return Std_Naming_Data;
1141 return Tree.Private_Part.Default_Naming;
1143 end Standard_Naming_Data;
1149 function Switches_Name
1150 (Source_File_Name : File_Name_Type) return File_Name_Type
1153 return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
1160 function Value (Image : String) return Casing_Type is
1162 for Casing in The_Casing_Images'Range loop
1163 if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
1168 raise Constraint_Error;
1172 -- Make sure that the standard config and user project file extensions are
1173 -- compatible with canonical case file naming.
1175 Canonical_Case_File_Name (Config_Project_File_Extension);
1176 Canonical_Case_File_Name (Project_File_Extension);