1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2009, 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 Casing => All_Lower_Case,
77 Spec_Suffix => No_Array_Element,
78 Body_Suffix => No_Array_Element,
79 Separate_Suffix => No_File,
80 Specs => No_Array_Element,
81 Bodies => No_Array_Element,
82 Specification_Exceptions => No_Array_Element,
83 Implementation_Exceptions => No_Array_Element);
85 Project_Empty : constant Project_Data :=
86 (Qualifier => Unspecified,
87 Externally_Built => False,
88 Config => Default_Project_Config,
89 Languages => No_Name_List,
91 Display_Name => No_Name,
92 Path => No_Path_Information,
94 Location => No_Location,
96 Directory => No_Path_Information,
99 Library_Dir => No_Path_Information,
100 Library_Src_Dir => No_Path_Information,
101 Library_ALI_Dir => No_Path_Information,
102 Library_Name => No_Name,
103 Library_Kind => Static,
104 Lib_Internal_Name => No_Name,
105 Standalone_Library => False,
106 Lib_Interface_ALIs => Nil_String,
107 Lib_Auto_Init => False,
108 Libgnarl_Needed => Unknown,
109 Symbol_Data => No_Symbols,
110 Ada_Sources_Present => True,
111 Other_Sources_Present => True,
112 Ada_Sources => Nil_String,
113 First_Source => No_Source,
114 Last_Source => No_Source,
115 Interfaces_Defined => False,
116 Imported_Directories_Switches => null,
117 Include_Path => null,
118 Include_Data_Set => False,
119 Include_Language => No_Language_Index,
120 Source_Dirs => Nil_String,
121 Known_Order_Of_Source_Dirs => True,
122 Object_Directory => No_Path_Information,
123 Library_TS => Empty_Time_Stamp,
124 Exec_Directory => No_Path_Information,
125 Extends => No_Project,
126 Extended_By => No_Project,
127 Naming => Std_Naming_Data,
128 First_Language_Processing => No_Language_Index,
129 Decl => No_Declarations,
130 Imported_Projects => Empty_Project_List,
131 All_Imported_Projects => Empty_Project_List,
132 Ada_Include_Path => null,
133 Ada_Objects_Path => null,
134 Objects_Path => null,
135 Include_Path_File => No_Path,
136 Objects_Path_File_With_Libs => No_Path,
137 Objects_Path_File_Without_Libs => No_Path,
138 Config_File_Name => No_Path,
139 Config_File_Temp => False,
140 Config_Checked => False,
143 Need_To_Build_Lib => False,
145 Unkept_Comments => False);
147 package Temp_Files is new Table.Table
148 (Table_Component_Type => Path_Name_Type,
149 Table_Index_Type => Integer,
150 Table_Low_Bound => 1,
152 Table_Increment => 100,
153 Table_Name => "Makegpr.Temp_Files");
154 -- Table to store the path name of all the created temporary files, so that
155 -- they can be deleted at the end, or when the program is interrupted.
157 procedure Free (Project : in out Project_Data);
158 -- Free memory allocated for Project
164 procedure Add_To_Buffer
166 To : in out String_Access;
167 Last : in out Natural)
171 To := new String (1 .. Initial_Buffer_Size);
175 -- If Buffer is too small, double its size
177 while Last + S'Length > To'Last loop
179 New_Buffer : constant String_Access :=
180 new String (1 .. 2 * Last);
183 New_Buffer (1 .. Last) := To (1 .. Last);
189 To (Last + 1 .. Last + S'Length) := S;
190 Last := Last + S'Length;
193 -----------------------
194 -- Body_Suffix_Id_Of --
195 -----------------------
197 function Body_Suffix_Id_Of
198 (In_Tree : Project_Tree_Ref;
200 Naming : Naming_Data) return File_Name_Type
202 Language_Id : Name_Id;
206 Add_Str_To_Name_Buffer (Language);
207 To_Lower (Name_Buffer (1 .. Name_Len));
208 Language_Id := Name_Find;
213 Language_Id => Language_Id,
215 end Body_Suffix_Id_Of;
217 -----------------------
218 -- Body_Suffix_Id_Of --
219 -----------------------
221 function Body_Suffix_Id_Of
222 (In_Tree : Project_Tree_Ref;
223 Language_Id : Name_Id;
224 Naming : Naming_Data) return File_Name_Type
226 Element_Id : Array_Element_Id;
227 Element : Array_Element;
228 Suffix : File_Name_Type := No_File;
229 Lang : Language_Index;
232 -- ??? This seems to be only for Ada_Only mode...
233 Element_Id := Naming.Body_Suffix;
234 while Element_Id /= No_Array_Element loop
235 Element := In_Tree.Array_Elements.Table (Element_Id);
237 if Element.Index = Language_Id then
238 return File_Name_Type (Element.Value.Value);
241 Element_Id := Element.Next;
244 if Current_Mode = Multi_Language then
245 Lang := In_Tree.First_Language;
246 while Lang /= No_Language_Index loop
247 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
249 In_Tree.Languages_Data.Table
250 (Lang).Config.Naming_Data.Body_Suffix;
254 Lang := In_Tree.Languages_Data.Table (Lang).Next;
259 end Body_Suffix_Id_Of;
265 function Body_Suffix_Of
266 (In_Tree : Project_Tree_Ref;
268 Naming : Naming_Data) return String
270 Language_Id : Name_Id;
271 Element_Id : Array_Element_Id;
272 Element : Array_Element;
273 Suffix : File_Name_Type := No_File;
274 Lang : Language_Index;
278 Add_Str_To_Name_Buffer (Language);
279 To_Lower (Name_Buffer (1 .. Name_Len));
280 Language_Id := Name_Find;
282 Element_Id := Naming.Body_Suffix;
283 while Element_Id /= No_Array_Element loop
284 Element := In_Tree.Array_Elements.Table (Element_Id);
286 if Element.Index = Language_Id then
287 return Get_Name_String (Element.Value.Value);
290 Element_Id := Element.Next;
293 if Current_Mode = Multi_Language then
294 Lang := In_Tree.First_Language;
295 while Lang /= No_Language_Index loop
296 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
299 (In_Tree.Languages_Data.Table
300 (Lang).Config.Naming_Data.Body_Suffix);
304 Lang := In_Tree.Languages_Data.Table (Lang).Next;
307 if Suffix /= No_File then
308 return Get_Name_String (Suffix);
315 -----------------------------
316 -- Default_Ada_Body_Suffix --
317 -----------------------------
319 function Default_Ada_Body_Suffix return File_Name_Type is
321 return Default_Ada_Body_Suffix_Id;
322 end Default_Ada_Body_Suffix;
324 -----------------------------
325 -- Default_Ada_Spec_Suffix --
326 -----------------------------
328 function Default_Ada_Spec_Suffix return File_Name_Type is
330 return Default_Ada_Spec_Suffix_Id;
331 end Default_Ada_Spec_Suffix;
333 ---------------------------
334 -- Delete_All_Temp_Files --
335 ---------------------------
337 procedure Delete_All_Temp_Files is
339 pragma Warnings (Off, Dont_Care);
341 if not Debug.Debug_Flag_N then
342 for Index in 1 .. Temp_Files.Last loop
344 (Get_Name_String (Temp_Files.Table (Index)), Dont_Care);
347 end Delete_All_Temp_Files;
349 ---------------------
350 -- Dependency_Name --
351 ---------------------
353 function Dependency_Name
354 (Source_File_Name : File_Name_Type;
355 Dependency : Dependency_File_Kind) return File_Name_Type
366 (Source_File_Name, Makefile_Dependency_Suffix));
372 (Source_File_Name, ALI_Dependency_Suffix));
376 ---------------------------
377 -- Display_Language_Name --
378 ---------------------------
380 procedure Display_Language_Name
381 (In_Tree : Project_Tree_Ref;
382 Language : Language_Index)
385 Get_Name_String (In_Tree.Languages_Data.Table (Language).Display_Name);
386 Write_Str (Name_Buffer (1 .. Name_Len));
387 end Display_Language_Name;
393 function Empty_File return File_Name_Type is
395 return File_Name_Type (The_Empty_String);
402 function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
403 Value : Project_Data;
406 Prj.Initialize (Tree => No_Project_Tree);
407 Value := Project_Empty;
408 Value.Naming := Tree.Private_Part.Default_Naming;
417 function Empty_String return Name_Id is
419 return The_Empty_String;
426 procedure Expect (The_Token : Token_Type; Token_Image : String) is
428 if Token /= The_Token then
429 Error_Msg (Token_Image & " expected", Token_Ptr);
438 (File : File_Name_Type;
439 With_Suffix : String) return File_Name_Type
444 Get_Name_String (File);
445 Last := Name_Len + 1;
447 while Name_Len /= 0 and then Name_Buffer (Name_Len) /= '.' loop
448 Name_Len := Name_Len - 1;
451 if Name_Len <= 1 then
455 for J in With_Suffix'Range loop
456 Name_Buffer (Name_Len) := With_Suffix (J);
457 Name_Len := Name_Len + 1;
460 Name_Len := Name_Len - 1;
465 --------------------------------
466 -- For_Every_Project_Imported --
467 --------------------------------
469 procedure For_Every_Project_Imported
471 In_Tree : Project_Tree_Ref;
472 With_State : in out State)
475 procedure Recursive_Check (Project : Project_Id);
476 -- Check if a project has already been seen. If not seen, mark it as
477 -- Seen, Call Action, and check all its imported projects.
479 ---------------------
480 -- Recursive_Check --
481 ---------------------
483 procedure Recursive_Check (Project : Project_Id) is
486 if not In_Tree.Projects.Table (Project).Seen then
487 In_Tree.Projects.Table (Project).Seen := True;
488 Action (Project, With_State);
490 List := In_Tree.Projects.Table (Project).Imported_Projects;
491 while List /= Empty_Project_List loop
492 Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
493 List := In_Tree.Project_Lists.Table (List).Next;
498 -- Start of processing for For_Every_Project_Imported
501 for Project in Project_Table.First ..
502 Project_Table.Last (In_Tree.Projects)
504 In_Tree.Projects.Table (Project).Seen := False;
507 Recursive_Check (Project => By);
508 end For_Every_Project_Imported;
514 function Get_Mode return Mode is
523 function Hash is new System.HTable.Hash (Header_Num => Header_Num);
524 -- Used in implementation of other functions Hash below
526 function Hash (Name : File_Name_Type) return Header_Num is
528 return Hash (Get_Name_String (Name));
531 function Hash (Name : Name_Id) return Header_Num is
533 return Hash (Get_Name_String (Name));
536 function Hash (Name : Path_Name_Type) return Header_Num is
538 return Hash (Get_Name_String (Name));
541 function Hash (Project : Project_Id) return Header_Num is
543 return Header_Num (Project mod Max_Header_Num);
550 function Image (Casing : Casing_Type) return String is
552 return The_Casing_Images (Casing).all;
555 ----------------------
556 -- In_Configuration --
557 ----------------------
559 function In_Configuration return Boolean is
561 return Configuration_Mode;
562 end In_Configuration;
568 procedure Initialize (Tree : Project_Tree_Ref) is
570 if not Initialized then
574 The_Empty_String := Name_Find;
575 Empty_Name := The_Empty_String;
576 Empty_File_Name := File_Name_Type (The_Empty_String);
578 Name_Buffer (1 .. 4) := ".ads";
579 Default_Ada_Spec_Suffix_Id := Name_Find;
581 Name_Buffer (1 .. 4) := ".adb";
582 Default_Ada_Body_Suffix_Id := Name_Find;
584 Name_Buffer (1) := '/';
585 Slash_Id := Name_Find;
589 Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
590 Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
591 Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
594 if Tree /= No_Project_Tree then
603 function Is_A_Language
604 (Tree : Project_Tree_Ref;
606 Language_Name : Name_Id) return Boolean
609 if Get_Mode = Ada_Only then
611 List : Name_List_Index := Data.Languages;
613 while List /= No_Name_List loop
614 if Tree.Name_Lists.Table (List).Name = Language_Name then
617 List := Tree.Name_Lists.Table (List).Next;
624 Lang_Ind : Language_Index := Data.First_Language_Processing;
625 Lang_Data : Language_Data;
628 while Lang_Ind /= No_Language_Index loop
629 Lang_Data := Tree.Languages_Data.Table (Lang_Ind);
631 if Lang_Data.Name = Language_Name then
635 Lang_Ind := Lang_Data.Next;
647 function Is_Extending
648 (Extending : Project_Id;
649 Extended : Project_Id;
650 In_Tree : Project_Tree_Ref) return Boolean
656 while Proj /= No_Project loop
657 if Proj = Extended then
661 Proj := In_Tree.Projects.Table (Proj).Extends;
667 -----------------------
668 -- Objects_Exist_For --
669 -----------------------
671 function Objects_Exist_For
673 In_Tree : Project_Tree_Ref) return Boolean
675 Language_Id : Name_Id;
676 Lang : Language_Index;
679 if Current_Mode = Multi_Language then
681 Add_Str_To_Name_Buffer (Language);
682 To_Lower (Name_Buffer (1 .. Name_Len));
683 Language_Id := Name_Find;
685 Lang := In_Tree.First_Language;
686 while Lang /= No_Language_Index loop
687 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
689 In_Tree.Languages_Data.Table
690 (Lang).Config.Object_Generated;
693 Lang := In_Tree.Languages_Data.Table (Lang).Next;
698 end Objects_Exist_For;
705 (Source_File_Name : File_Name_Type;
706 Object_File_Suffix : Name_Id := No_Name)
707 return File_Name_Type
710 if Object_File_Suffix = No_Name then
712 (Source_File_Name, Object_Suffix);
715 (Source_File_Name, Get_Name_String (Object_File_Suffix));
719 ----------------------
720 -- Record_Temp_File --
721 ----------------------
723 procedure Record_Temp_File (Path : Path_Name_Type) is
725 Temp_Files.Increment_Last;
726 Temp_Files.Table (Temp_Files.Last) := Path;
727 end Record_Temp_File;
729 ------------------------------------
730 -- Register_Default_Naming_Scheme --
731 ------------------------------------
733 procedure Register_Default_Naming_Scheme
735 Default_Spec_Suffix : File_Name_Type;
736 Default_Body_Suffix : File_Name_Type;
737 In_Tree : Project_Tree_Ref)
740 Suffix : Array_Element_Id;
741 Found : Boolean := False;
742 Element : Array_Element;
745 -- Get the language name in small letters
747 Get_Name_String (Language);
748 Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
751 -- Look for an element of the spec suffix array indexed by the language
752 -- name. If one is found, put the default value.
754 Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
756 while Suffix /= No_Array_Element and then not Found loop
757 Element := In_Tree.Array_Elements.Table (Suffix);
759 if Element.Index = Lang then
761 Element.Value.Value := Name_Id (Default_Spec_Suffix);
762 In_Tree.Array_Elements.Table (Suffix) := Element;
765 Suffix := Element.Next;
769 -- If none can be found, create a new one
775 Index_Case_Sensitive => False,
776 Value => (Project => No_Project,
778 Location => No_Location,
780 Value => Name_Id (Default_Spec_Suffix),
782 Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
783 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
784 In_Tree.Array_Elements.Table
785 (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
787 In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
788 Array_Element_Table.Last (In_Tree.Array_Elements);
791 -- Look for an element of the body suffix array indexed by the language
792 -- name. If one is found, put the default value.
794 Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
796 while Suffix /= No_Array_Element and then not Found loop
797 Element := In_Tree.Array_Elements.Table (Suffix);
799 if Element.Index = Lang then
801 Element.Value.Value := Name_Id (Default_Body_Suffix);
802 In_Tree.Array_Elements.Table (Suffix) := Element;
805 Suffix := Element.Next;
809 -- If none can be found, create a new one
815 Index_Case_Sensitive => False,
816 Value => (Project => No_Project,
818 Location => No_Location,
820 Value => Name_Id (Default_Body_Suffix),
822 Next => In_Tree.Private_Part.Default_Naming.Body_Suffix);
823 Array_Element_Table.Increment_Last
824 (In_Tree.Array_Elements);
825 In_Tree.Array_Elements.Table
826 (Array_Element_Table.Last (In_Tree.Array_Elements))
828 In_Tree.Private_Part.Default_Naming.Body_Suffix :=
829 Array_Element_Table.Last (In_Tree.Array_Elements);
831 end Register_Default_Naming_Scheme;
837 procedure Free (Project : in out Project_Data) is
839 Free (Project.Dir_Path);
840 Free (Project.Include_Path);
841 Free (Project.Ada_Include_Path);
842 Free (Project.Objects_Path);
843 Free (Project.Ada_Objects_Path);
850 procedure Free (Tree : in out Project_Tree_Ref) is
851 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
852 (Project_Tree_Data, Project_Tree_Ref);
855 Language_Data_Table.Free (Tree.Languages_Data);
856 Name_List_Table.Free (Tree.Name_Lists);
857 String_Element_Table.Free (Tree.String_Elements);
858 Variable_Element_Table.Free (Tree.Variable_Elements);
859 Array_Element_Table.Free (Tree.Array_Elements);
860 Array_Table.Free (Tree.Arrays);
861 Package_Table.Free (Tree.Packages);
862 Project_List_Table.Free (Tree.Project_Lists);
863 Source_Data_Table.Free (Tree.Sources);
864 Alternate_Language_Table.Free (Tree.Alt_Langs);
865 Unit_Table.Free (Tree.Units);
866 Units_Htable.Reset (Tree.Units_HT);
867 Files_Htable.Reset (Tree.Files_HT);
868 Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
869 Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
871 for P in Project_Table.First ..
872 Project_Table.Last (Tree.Projects)
874 Free (Tree.Projects.Table (P));
877 Project_Table.Free (Tree.Projects);
881 Naming_Table.Free (Tree.Private_Part.Namings);
882 Path_File_Table.Free (Tree.Private_Part.Path_Files);
883 Source_Path_Table.Free (Tree.Private_Part.Source_Paths);
884 Object_Path_Table.Free (Tree.Private_Part.Object_Paths);
886 -- Naming data (nothing to free ?)
889 Unchecked_Free (Tree);
897 procedure Reset (Tree : Project_Tree_Ref) is
903 Language_Data_Table.Init (Tree.Languages_Data);
904 Name_List_Table.Init (Tree.Name_Lists);
905 String_Element_Table.Init (Tree.String_Elements);
906 Variable_Element_Table.Init (Tree.Variable_Elements);
907 Array_Element_Table.Init (Tree.Array_Elements);
908 Array_Table.Init (Tree.Arrays);
909 Package_Table.Init (Tree.Packages);
910 Project_List_Table.Init (Tree.Project_Lists);
911 Source_Data_Table.Init (Tree.Sources);
912 Alternate_Language_Table.Init (Tree.Alt_Langs);
913 Unit_Table.Init (Tree.Units);
914 Units_Htable.Reset (Tree.Units_HT);
915 Files_Htable.Reset (Tree.Files_HT);
916 Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
917 Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
919 if not Project_Table."=" (Tree.Projects.Table, null) then
920 for P in Project_Table.First ..
921 Project_Table.Last (Tree.Projects)
923 Free (Tree.Projects.Table (P));
927 Project_Table.Init (Tree.Projects);
929 -- Private part table
931 Naming_Table.Init (Tree.Private_Part.Namings);
932 Naming_Table.Increment_Last (Tree.Private_Part.Namings);
933 Tree.Private_Part.Namings.Table
934 (Naming_Table.Last (Tree.Private_Part.Namings)) := Std_Naming_Data;
935 Path_File_Table.Init (Tree.Private_Part.Path_Files);
936 Source_Path_Table.Init (Tree.Private_Part.Source_Paths);
937 Object_Path_Table.Init (Tree.Private_Part.Object_Paths);
938 Tree.Private_Part.Default_Naming := Std_Naming_Data;
940 if Current_Mode = Ada_Only then
941 Register_Default_Naming_Scheme
942 (Language => Name_Ada,
943 Default_Spec_Suffix => Default_Ada_Spec_Suffix,
944 Default_Body_Suffix => Default_Ada_Body_Suffix,
946 Tree.Private_Part.Default_Naming.Separate_Suffix :=
947 Default_Ada_Body_Suffix;
951 ------------------------
952 -- Same_Naming_Scheme --
953 ------------------------
955 function Same_Naming_Scheme
956 (Left, Right : Naming_Data) return Boolean
959 return Left.Dot_Replacement = Right.Dot_Replacement
960 and then Left.Casing = Right.Casing
961 and then Left.Separate_Suffix = Right.Separate_Suffix;
962 end Same_Naming_Scheme;
964 ---------------------
965 -- Set_Body_Suffix --
966 ---------------------
968 procedure Set_Body_Suffix
969 (In_Tree : Project_Tree_Ref;
971 Naming : in out Naming_Data;
972 Suffix : File_Name_Type)
974 Language_Id : Name_Id;
975 Element : Array_Element;
979 Add_Str_To_Name_Buffer (Language);
980 To_Lower (Name_Buffer (1 .. Name_Len));
981 Language_Id := Name_Find;
984 (Index => Language_Id,
986 Index_Case_Sensitive => False,
989 Project => No_Project,
990 Location => No_Location,
992 Value => Name_Id (Suffix),
994 Next => Naming.Body_Suffix);
996 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
997 Naming.Body_Suffix :=
998 Array_Element_Table.Last (In_Tree.Array_Elements);
999 In_Tree.Array_Elements.Table (Naming.Body_Suffix) := Element;
1000 end Set_Body_Suffix;
1002 --------------------------
1003 -- Set_In_Configuration --
1004 --------------------------
1006 procedure Set_In_Configuration (Value : Boolean) is
1008 Configuration_Mode := Value;
1009 end Set_In_Configuration;
1015 procedure Set_Mode (New_Mode : Mode) is
1017 Current_Mode := New_Mode;
1020 Default_Language_Is_Ada := True;
1021 Must_Check_Configuration := False;
1022 when Multi_Language =>
1023 Default_Language_Is_Ada := False;
1024 Must_Check_Configuration := True;
1028 ---------------------
1029 -- Set_Spec_Suffix --
1030 ---------------------
1032 procedure Set_Spec_Suffix
1033 (In_Tree : Project_Tree_Ref;
1035 Naming : in out Naming_Data;
1036 Suffix : File_Name_Type)
1038 Language_Id : Name_Id;
1039 Element : Array_Element;
1043 Add_Str_To_Name_Buffer (Language);
1044 To_Lower (Name_Buffer (1 .. Name_Len));
1045 Language_Id := Name_Find;
1048 (Index => Language_Id,
1050 Index_Case_Sensitive => False,
1053 Project => No_Project,
1054 Location => No_Location,
1056 Value => Name_Id (Suffix),
1058 Next => Naming.Spec_Suffix);
1060 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1061 Naming.Spec_Suffix :=
1062 Array_Element_Table.Last (In_Tree.Array_Elements);
1063 In_Tree.Array_Elements.Table (Naming.Spec_Suffix) := Element;
1064 end Set_Spec_Suffix;
1070 function Slash return Path_Name_Type is
1075 -----------------------
1076 -- Spec_Suffix_Id_Of --
1077 -----------------------
1079 function Spec_Suffix_Id_Of
1080 (In_Tree : Project_Tree_Ref;
1082 Naming : Naming_Data) return File_Name_Type
1084 Language_Id : Name_Id;
1088 Add_Str_To_Name_Buffer (Language);
1089 To_Lower (Name_Buffer (1 .. Name_Len));
1090 Language_Id := Name_Find;
1094 (In_Tree => In_Tree,
1095 Language_Id => Language_Id,
1097 end Spec_Suffix_Id_Of;
1099 -----------------------
1100 -- Spec_Suffix_Id_Of --
1101 -----------------------
1103 function Spec_Suffix_Id_Of
1104 (In_Tree : Project_Tree_Ref;
1105 Language_Id : Name_Id;
1106 Naming : Naming_Data) return File_Name_Type
1108 Element_Id : Array_Element_Id;
1109 Element : Array_Element;
1110 Suffix : File_Name_Type := No_File;
1111 Lang : Language_Index;
1114 Element_Id := Naming.Spec_Suffix;
1115 while Element_Id /= No_Array_Element loop
1116 Element := In_Tree.Array_Elements.Table (Element_Id);
1118 if Element.Index = Language_Id then
1119 return File_Name_Type (Element.Value.Value);
1122 Element_Id := Element.Next;
1125 if Current_Mode = Multi_Language then
1126 Lang := In_Tree.First_Language;
1127 while Lang /= No_Language_Index loop
1128 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1130 In_Tree.Languages_Data.Table
1131 (Lang).Config.Naming_Data.Spec_Suffix;
1135 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1140 end Spec_Suffix_Id_Of;
1142 --------------------
1143 -- Spec_Suffix_Of --
1144 --------------------
1146 function Spec_Suffix_Of
1147 (In_Tree : Project_Tree_Ref;
1149 Naming : Naming_Data) return String
1151 Language_Id : Name_Id;
1152 Element_Id : Array_Element_Id;
1153 Element : Array_Element;
1154 Suffix : File_Name_Type := No_File;
1155 Lang : Language_Index;
1159 Add_Str_To_Name_Buffer (Language);
1160 To_Lower (Name_Buffer (1 .. Name_Len));
1161 Language_Id := Name_Find;
1163 Element_Id := Naming.Spec_Suffix;
1164 while Element_Id /= No_Array_Element loop
1165 Element := In_Tree.Array_Elements.Table (Element_Id);
1167 if Element.Index = Language_Id then
1168 return Get_Name_String (Element.Value.Value);
1171 Element_Id := Element.Next;
1174 if Current_Mode = Multi_Language then
1175 Lang := In_Tree.First_Language;
1176 while Lang /= No_Language_Index loop
1177 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1180 (In_Tree.Languages_Data.Table
1181 (Lang).Config.Naming_Data.Spec_Suffix);
1185 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1188 if Suffix /= No_File then
1189 return Get_Name_String (Suffix);
1196 --------------------------
1197 -- Standard_Naming_Data --
1198 --------------------------
1200 function Standard_Naming_Data
1201 (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
1204 if Tree = No_Project_Tree then
1205 Prj.Initialize (Tree => No_Project_Tree);
1206 return Std_Naming_Data;
1208 return Tree.Private_Part.Default_Naming;
1210 end Standard_Naming_Data;
1216 function Switches_Name
1217 (Source_File_Name : File_Name_Type) return File_Name_Type
1220 return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
1227 function Value (Image : String) return Casing_Type is
1229 for Casing in The_Casing_Images'Range loop
1230 if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
1235 raise Constraint_Error;
1239 -- Make sure that the standard config and user project file extensions are
1240 -- compatible with canonical case file naming.
1242 Canonical_Case_File_Name (Config_Project_File_Extension);
1243 Canonical_Case_File_Name (Project_File_Extension);