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,
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.
163 procedure Free (Project : in out Project_Data);
164 -- Free memory allocated for Project
170 procedure Add_To_Buffer
172 To : in out String_Access;
173 Last : in out Natural)
177 To := new String (1 .. Initial_Buffer_Size);
181 -- If Buffer is too small, double its size
183 while Last + S'Length > To'Last loop
185 New_Buffer : constant String_Access :=
186 new String (1 .. 2 * Last);
189 New_Buffer (1 .. Last) := To (1 .. Last);
195 To (Last + 1 .. Last + S'Length) := S;
196 Last := Last + S'Length;
199 -----------------------
200 -- Body_Suffix_Id_Of --
201 -----------------------
203 function Body_Suffix_Id_Of
204 (In_Tree : Project_Tree_Ref;
206 Naming : Naming_Data) return File_Name_Type
208 Language_Id : Name_Id;
212 Add_Str_To_Name_Buffer (Language);
213 To_Lower (Name_Buffer (1 .. Name_Len));
214 Language_Id := Name_Find;
219 Language_Id => Language_Id,
221 end Body_Suffix_Id_Of;
223 -----------------------
224 -- Body_Suffix_Id_Of --
225 -----------------------
227 function Body_Suffix_Id_Of
228 (In_Tree : Project_Tree_Ref;
229 Language_Id : Name_Id;
230 Naming : Naming_Data) return File_Name_Type
232 Element_Id : Array_Element_Id;
233 Element : Array_Element;
234 Suffix : File_Name_Type := No_File;
235 Lang : Language_Index;
238 -- ??? This seems to be only for Ada_Only mode...
239 Element_Id := Naming.Body_Suffix;
240 while Element_Id /= No_Array_Element loop
241 Element := In_Tree.Array_Elements.Table (Element_Id);
243 if Element.Index = Language_Id then
244 return File_Name_Type (Element.Value.Value);
247 Element_Id := Element.Next;
250 if Current_Mode = Multi_Language then
251 Lang := In_Tree.First_Language;
252 while Lang /= No_Language_Index loop
253 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
255 In_Tree.Languages_Data.Table
256 (Lang).Config.Naming_Data.Body_Suffix;
260 Lang := In_Tree.Languages_Data.Table (Lang).Next;
265 end Body_Suffix_Id_Of;
271 function Body_Suffix_Of
272 (In_Tree : Project_Tree_Ref;
274 Naming : Naming_Data) return String
276 Language_Id : Name_Id;
277 Element_Id : Array_Element_Id;
278 Element : Array_Element;
279 Suffix : File_Name_Type := No_File;
280 Lang : Language_Index;
284 Add_Str_To_Name_Buffer (Language);
285 To_Lower (Name_Buffer (1 .. Name_Len));
286 Language_Id := Name_Find;
288 Element_Id := Naming.Body_Suffix;
289 while Element_Id /= No_Array_Element loop
290 Element := In_Tree.Array_Elements.Table (Element_Id);
292 if Element.Index = Language_Id then
293 return Get_Name_String (Element.Value.Value);
296 Element_Id := Element.Next;
299 if Current_Mode = Multi_Language then
300 Lang := In_Tree.First_Language;
301 while Lang /= No_Language_Index loop
302 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
305 (In_Tree.Languages_Data.Table
306 (Lang).Config.Naming_Data.Body_Suffix);
310 Lang := In_Tree.Languages_Data.Table (Lang).Next;
313 if Suffix /= No_File then
314 return Get_Name_String (Suffix);
321 -----------------------------
322 -- Default_Ada_Body_Suffix --
323 -----------------------------
325 function Default_Ada_Body_Suffix return File_Name_Type is
327 return Default_Ada_Body_Suffix_Id;
328 end Default_Ada_Body_Suffix;
330 -----------------------------
331 -- Default_Ada_Spec_Suffix --
332 -----------------------------
334 function Default_Ada_Spec_Suffix return File_Name_Type is
336 return Default_Ada_Spec_Suffix_Id;
337 end Default_Ada_Spec_Suffix;
339 ---------------------------
340 -- Delete_All_Temp_Files --
341 ---------------------------
343 procedure Delete_All_Temp_Files is
345 pragma Warnings (Off, Dont_Care);
347 if not Debug.Debug_Flag_N then
348 for Index in 1 .. Temp_Files.Last loop
350 (Get_Name_String (Temp_Files.Table (Index)), Dont_Care);
353 end Delete_All_Temp_Files;
355 ---------------------
356 -- Dependency_Name --
357 ---------------------
359 function Dependency_Name
360 (Source_File_Name : File_Name_Type;
361 Dependency : Dependency_File_Kind) return File_Name_Type
372 (Source_File_Name, Makefile_Dependency_Suffix));
378 (Source_File_Name, ALI_Dependency_Suffix));
382 ---------------------------
383 -- Display_Language_Name --
384 ---------------------------
386 procedure Display_Language_Name
387 (In_Tree : Project_Tree_Ref;
388 Language : Language_Index)
391 Get_Name_String (In_Tree.Languages_Data.Table (Language).Display_Name);
392 Write_Str (Name_Buffer (1 .. Name_Len));
393 end Display_Language_Name;
399 function Empty_File return File_Name_Type is
401 return File_Name_Type (The_Empty_String);
408 function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
409 Value : Project_Data;
412 Prj.Initialize (Tree => No_Project_Tree);
413 Value := Project_Empty;
414 Value.Naming := Tree.Private_Part.Default_Naming;
423 function Empty_String return Name_Id is
425 return The_Empty_String;
432 procedure Expect (The_Token : Token_Type; Token_Image : String) is
434 if Token /= The_Token then
435 Error_Msg (Token_Image & " expected", Token_Ptr);
444 (File : File_Name_Type;
445 With_Suffix : String) return File_Name_Type
450 Get_Name_String (File);
451 Last := Name_Len + 1;
453 while Name_Len /= 0 and then Name_Buffer (Name_Len) /= '.' loop
454 Name_Len := Name_Len - 1;
457 if Name_Len <= 1 then
461 for J in With_Suffix'Range loop
462 Name_Buffer (Name_Len) := With_Suffix (J);
463 Name_Len := Name_Len + 1;
466 Name_Len := Name_Len - 1;
471 --------------------------------
472 -- For_Every_Project_Imported --
473 --------------------------------
475 procedure For_Every_Project_Imported
477 In_Tree : Project_Tree_Ref;
478 With_State : in out State)
481 procedure Recursive_Check (Project : Project_Id);
482 -- Check if a project has already been seen. If not seen, mark it as
483 -- Seen, Call Action, and check all its imported projects.
485 ---------------------
486 -- Recursive_Check --
487 ---------------------
489 procedure Recursive_Check (Project : Project_Id) is
492 if not In_Tree.Projects.Table (Project).Seen then
493 In_Tree.Projects.Table (Project).Seen := True;
494 Action (Project, With_State);
496 List := In_Tree.Projects.Table (Project).Imported_Projects;
497 while List /= Empty_Project_List loop
498 Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
499 List := In_Tree.Project_Lists.Table (List).Next;
504 -- Start of processing for For_Every_Project_Imported
507 for Project in Project_Table.First ..
508 Project_Table.Last (In_Tree.Projects)
510 In_Tree.Projects.Table (Project).Seen := False;
513 Recursive_Check (Project => By);
514 end For_Every_Project_Imported;
520 function Get_Mode return Mode is
529 function Hash is new System.HTable.Hash (Header_Num => Header_Num);
530 -- Used in implementation of other functions Hash below
532 function Hash (Name : File_Name_Type) return Header_Num is
534 return Hash (Get_Name_String (Name));
537 function Hash (Name : Name_Id) return Header_Num is
539 return Hash (Get_Name_String (Name));
542 function Hash (Name : Path_Name_Type) return Header_Num is
544 return Hash (Get_Name_String (Name));
547 function Hash (Project : Project_Id) return Header_Num is
549 return Header_Num (Project mod Max_Header_Num);
556 function Image (Casing : Casing_Type) return String is
558 return The_Casing_Images (Casing).all;
561 ----------------------
562 -- In_Configuration --
563 ----------------------
565 function In_Configuration return Boolean is
567 return Configuration_Mode;
568 end In_Configuration;
574 procedure Initialize (Tree : Project_Tree_Ref) is
576 if not Initialized then
580 The_Empty_String := Name_Find;
581 Empty_Name := The_Empty_String;
582 Empty_File_Name := File_Name_Type (The_Empty_String);
584 Name_Buffer (1 .. 4) := ".ads";
585 Default_Ada_Spec_Suffix_Id := Name_Find;
587 Name_Buffer (1 .. 4) := ".adb";
588 Default_Ada_Body_Suffix_Id := Name_Find;
590 Name_Buffer (1) := '/';
591 Slash_Id := Name_Find;
595 Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
596 Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
597 Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
600 if Tree /= No_Project_Tree then
609 function Is_A_Language
610 (Tree : Project_Tree_Ref;
612 Language_Name : Name_Id) return Boolean
615 if Get_Mode = Ada_Only then
617 List : Name_List_Index := Data.Languages;
619 while List /= No_Name_List loop
620 if Tree.Name_Lists.Table (List).Name = Language_Name then
623 List := Tree.Name_Lists.Table (List).Next;
630 Lang_Ind : Language_Index := Data.First_Language_Processing;
631 Lang_Data : Language_Data;
634 while Lang_Ind /= No_Language_Index loop
635 Lang_Data := Tree.Languages_Data.Table (Lang_Ind);
637 if Lang_Data.Name = Language_Name then
641 Lang_Ind := Lang_Data.Next;
653 function Is_Extending
654 (Extending : Project_Id;
655 Extended : Project_Id;
656 In_Tree : Project_Tree_Ref) return Boolean
662 while Proj /= No_Project loop
663 if Proj = Extended then
667 Proj := In_Tree.Projects.Table (Proj).Extends;
673 -----------------------
674 -- Objects_Exist_For --
675 -----------------------
677 function Objects_Exist_For
679 In_Tree : Project_Tree_Ref) return Boolean
681 Language_Id : Name_Id;
682 Lang : Language_Index;
685 if Current_Mode = Multi_Language then
687 Add_Str_To_Name_Buffer (Language);
688 To_Lower (Name_Buffer (1 .. Name_Len));
689 Language_Id := Name_Find;
691 Lang := In_Tree.First_Language;
692 while Lang /= No_Language_Index loop
693 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
695 In_Tree.Languages_Data.Table
696 (Lang).Config.Object_Generated;
699 Lang := In_Tree.Languages_Data.Table (Lang).Next;
704 end Objects_Exist_For;
711 (Source_File_Name : File_Name_Type;
712 Object_File_Suffix : Name_Id := No_Name)
713 return File_Name_Type
716 if Object_File_Suffix = No_Name then
718 (Source_File_Name, Object_Suffix);
721 (Source_File_Name, Get_Name_String (Object_File_Suffix));
725 ----------------------
726 -- Record_Temp_File --
727 ----------------------
729 procedure Record_Temp_File (Path : Path_Name_Type) is
731 Temp_Files.Increment_Last;
732 Temp_Files.Table (Temp_Files.Last) := Path;
733 end Record_Temp_File;
735 ------------------------------------
736 -- Register_Default_Naming_Scheme --
737 ------------------------------------
739 procedure Register_Default_Naming_Scheme
741 Default_Spec_Suffix : File_Name_Type;
742 Default_Body_Suffix : File_Name_Type;
743 In_Tree : Project_Tree_Ref)
746 Suffix : Array_Element_Id;
747 Found : Boolean := False;
748 Element : Array_Element;
751 -- Get the language name in small letters
753 Get_Name_String (Language);
754 Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
757 -- Look for an element of the spec suffix array indexed by the language
758 -- name. If one is found, put the default value.
760 Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
762 while Suffix /= No_Array_Element and then not Found loop
763 Element := In_Tree.Array_Elements.Table (Suffix);
765 if Element.Index = Lang then
767 Element.Value.Value := Name_Id (Default_Spec_Suffix);
768 In_Tree.Array_Elements.Table (Suffix) := Element;
771 Suffix := Element.Next;
775 -- If none can be found, create a new one
781 Index_Case_Sensitive => False,
782 Value => (Project => No_Project,
784 Location => No_Location,
786 Value => Name_Id (Default_Spec_Suffix),
788 Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
789 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
790 In_Tree.Array_Elements.Table
791 (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
793 In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
794 Array_Element_Table.Last (In_Tree.Array_Elements);
797 -- Look for an element of the body suffix array indexed by the language
798 -- name. If one is found, put the default value.
800 Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
802 while Suffix /= No_Array_Element and then not Found loop
803 Element := In_Tree.Array_Elements.Table (Suffix);
805 if Element.Index = Lang then
807 Element.Value.Value := Name_Id (Default_Body_Suffix);
808 In_Tree.Array_Elements.Table (Suffix) := Element;
811 Suffix := Element.Next;
815 -- If none can be found, create a new one
821 Index_Case_Sensitive => False,
822 Value => (Project => No_Project,
824 Location => No_Location,
826 Value => Name_Id (Default_Body_Suffix),
828 Next => In_Tree.Private_Part.Default_Naming.Body_Suffix);
829 Array_Element_Table.Increment_Last
830 (In_Tree.Array_Elements);
831 In_Tree.Array_Elements.Table
832 (Array_Element_Table.Last (In_Tree.Array_Elements))
834 In_Tree.Private_Part.Default_Naming.Body_Suffix :=
835 Array_Element_Table.Last (In_Tree.Array_Elements);
837 end Register_Default_Naming_Scheme;
843 procedure Free (Project : in out Project_Data) is
845 Free (Project.Dir_Path);
846 Free (Project.Include_Path);
847 Free (Project.Ada_Include_Path);
848 Free (Project.Objects_Path);
849 Free (Project.Ada_Objects_Path);
856 procedure Free (Tree : in out Project_Tree_Ref) is
857 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
858 (Project_Tree_Data, Project_Tree_Ref);
861 Language_Data_Table.Free (Tree.Languages_Data);
862 Name_List_Table.Free (Tree.Name_Lists);
863 String_Element_Table.Free (Tree.String_Elements);
864 Variable_Element_Table.Free (Tree.Variable_Elements);
865 Array_Element_Table.Free (Tree.Array_Elements);
866 Array_Table.Free (Tree.Arrays);
867 Package_Table.Free (Tree.Packages);
868 Project_List_Table.Free (Tree.Project_Lists);
869 Source_Data_Table.Free (Tree.Sources);
870 Alternate_Language_Table.Free (Tree.Alt_Langs);
871 Unit_Table.Free (Tree.Units);
872 Units_Htable.Reset (Tree.Units_HT);
873 Files_Htable.Reset (Tree.Files_HT);
874 Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
875 Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
877 for P in Project_Table.First ..
878 Project_Table.Last (Tree.Projects)
880 Free (Tree.Projects.Table (P));
883 Project_Table.Free (Tree.Projects);
887 Naming_Table.Free (Tree.Private_Part.Namings);
888 Path_File_Table.Free (Tree.Private_Part.Path_Files);
889 Source_Path_Table.Free (Tree.Private_Part.Source_Paths);
890 Object_Path_Table.Free (Tree.Private_Part.Object_Paths);
892 -- Naming data (nothing to free ?)
895 Unchecked_Free (Tree);
903 procedure Reset (Tree : Project_Tree_Ref) is
909 Language_Data_Table.Init (Tree.Languages_Data);
910 Name_List_Table.Init (Tree.Name_Lists);
911 String_Element_Table.Init (Tree.String_Elements);
912 Variable_Element_Table.Init (Tree.Variable_Elements);
913 Array_Element_Table.Init (Tree.Array_Elements);
914 Array_Table.Init (Tree.Arrays);
915 Package_Table.Init (Tree.Packages);
916 Project_List_Table.Init (Tree.Project_Lists);
917 Source_Data_Table.Init (Tree.Sources);
918 Alternate_Language_Table.Init (Tree.Alt_Langs);
919 Unit_Table.Init (Tree.Units);
920 Units_Htable.Reset (Tree.Units_HT);
921 Files_Htable.Reset (Tree.Files_HT);
922 Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
923 Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
925 if not Project_Table."=" (Tree.Projects.Table, null) then
926 for P in Project_Table.First ..
927 Project_Table.Last (Tree.Projects)
929 Free (Tree.Projects.Table (P));
933 Project_Table.Init (Tree.Projects);
935 -- Private part table
937 Naming_Table.Init (Tree.Private_Part.Namings);
938 Naming_Table.Increment_Last (Tree.Private_Part.Namings);
939 Tree.Private_Part.Namings.Table
940 (Naming_Table.Last (Tree.Private_Part.Namings)) := Std_Naming_Data;
941 Path_File_Table.Init (Tree.Private_Part.Path_Files);
942 Source_Path_Table.Init (Tree.Private_Part.Source_Paths);
943 Object_Path_Table.Init (Tree.Private_Part.Object_Paths);
944 Tree.Private_Part.Default_Naming := Std_Naming_Data;
946 if Current_Mode = Ada_Only then
947 Register_Default_Naming_Scheme
948 (Language => Name_Ada,
949 Default_Spec_Suffix => Default_Ada_Spec_Suffix,
950 Default_Body_Suffix => Default_Ada_Body_Suffix,
952 Tree.Private_Part.Default_Naming.Separate_Suffix :=
953 Default_Ada_Body_Suffix;
957 ------------------------
958 -- Same_Naming_Scheme --
959 ------------------------
961 function Same_Naming_Scheme
962 (Left, Right : Naming_Data) return Boolean
965 return Left.Dot_Replacement = Right.Dot_Replacement
966 and then Left.Casing = Right.Casing
967 and then Left.Separate_Suffix = Right.Separate_Suffix;
968 end Same_Naming_Scheme;
970 ---------------------
971 -- Set_Body_Suffix --
972 ---------------------
974 procedure Set_Body_Suffix
975 (In_Tree : Project_Tree_Ref;
977 Naming : in out Naming_Data;
978 Suffix : File_Name_Type)
980 Language_Id : Name_Id;
981 Element : Array_Element;
985 Add_Str_To_Name_Buffer (Language);
986 To_Lower (Name_Buffer (1 .. Name_Len));
987 Language_Id := Name_Find;
990 (Index => Language_Id,
992 Index_Case_Sensitive => False,
995 Project => No_Project,
996 Location => No_Location,
998 Value => Name_Id (Suffix),
1000 Next => Naming.Body_Suffix);
1002 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1003 Naming.Body_Suffix :=
1004 Array_Element_Table.Last (In_Tree.Array_Elements);
1005 In_Tree.Array_Elements.Table (Naming.Body_Suffix) := Element;
1006 end Set_Body_Suffix;
1008 --------------------------
1009 -- Set_In_Configuration --
1010 --------------------------
1012 procedure Set_In_Configuration (Value : Boolean) is
1014 Configuration_Mode := Value;
1015 end Set_In_Configuration;
1021 procedure Set_Mode (New_Mode : Mode) is
1023 Current_Mode := New_Mode;
1026 Default_Language_Is_Ada := True;
1027 Must_Check_Configuration := False;
1028 when Multi_Language =>
1029 Default_Language_Is_Ada := False;
1030 Must_Check_Configuration := True;
1034 ---------------------
1035 -- Set_Spec_Suffix --
1036 ---------------------
1038 procedure Set_Spec_Suffix
1039 (In_Tree : Project_Tree_Ref;
1041 Naming : in out Naming_Data;
1042 Suffix : File_Name_Type)
1044 Language_Id : Name_Id;
1045 Element : Array_Element;
1049 Add_Str_To_Name_Buffer (Language);
1050 To_Lower (Name_Buffer (1 .. Name_Len));
1051 Language_Id := Name_Find;
1054 (Index => Language_Id,
1056 Index_Case_Sensitive => False,
1059 Project => No_Project,
1060 Location => No_Location,
1062 Value => Name_Id (Suffix),
1064 Next => Naming.Spec_Suffix);
1066 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1067 Naming.Spec_Suffix :=
1068 Array_Element_Table.Last (In_Tree.Array_Elements);
1069 In_Tree.Array_Elements.Table (Naming.Spec_Suffix) := Element;
1070 end Set_Spec_Suffix;
1076 function Slash return Path_Name_Type is
1081 -----------------------
1082 -- Spec_Suffix_Id_Of --
1083 -----------------------
1085 function Spec_Suffix_Id_Of
1086 (In_Tree : Project_Tree_Ref;
1088 Naming : Naming_Data) return File_Name_Type
1090 Language_Id : Name_Id;
1094 Add_Str_To_Name_Buffer (Language);
1095 To_Lower (Name_Buffer (1 .. Name_Len));
1096 Language_Id := Name_Find;
1100 (In_Tree => In_Tree,
1101 Language_Id => Language_Id,
1103 end Spec_Suffix_Id_Of;
1105 -----------------------
1106 -- Spec_Suffix_Id_Of --
1107 -----------------------
1109 function Spec_Suffix_Id_Of
1110 (In_Tree : Project_Tree_Ref;
1111 Language_Id : Name_Id;
1112 Naming : Naming_Data) return File_Name_Type
1114 Element_Id : Array_Element_Id;
1115 Element : Array_Element;
1116 Suffix : File_Name_Type := No_File;
1117 Lang : Language_Index;
1120 Element_Id := Naming.Spec_Suffix;
1121 while Element_Id /= No_Array_Element loop
1122 Element := In_Tree.Array_Elements.Table (Element_Id);
1124 if Element.Index = Language_Id then
1125 return File_Name_Type (Element.Value.Value);
1128 Element_Id := Element.Next;
1131 if Current_Mode = Multi_Language then
1132 Lang := In_Tree.First_Language;
1133 while Lang /= No_Language_Index loop
1134 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1136 In_Tree.Languages_Data.Table
1137 (Lang).Config.Naming_Data.Spec_Suffix;
1141 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1146 end Spec_Suffix_Id_Of;
1148 --------------------
1149 -- Spec_Suffix_Of --
1150 --------------------
1152 function Spec_Suffix_Of
1153 (In_Tree : Project_Tree_Ref;
1155 Naming : Naming_Data) return String
1157 Language_Id : Name_Id;
1158 Element_Id : Array_Element_Id;
1159 Element : Array_Element;
1160 Suffix : File_Name_Type := No_File;
1161 Lang : Language_Index;
1165 Add_Str_To_Name_Buffer (Language);
1166 To_Lower (Name_Buffer (1 .. Name_Len));
1167 Language_Id := Name_Find;
1169 Element_Id := Naming.Spec_Suffix;
1170 while Element_Id /= No_Array_Element loop
1171 Element := In_Tree.Array_Elements.Table (Element_Id);
1173 if Element.Index = Language_Id then
1174 return Get_Name_String (Element.Value.Value);
1177 Element_Id := Element.Next;
1180 if Current_Mode = Multi_Language then
1181 Lang := In_Tree.First_Language;
1182 while Lang /= No_Language_Index loop
1183 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1186 (In_Tree.Languages_Data.Table
1187 (Lang).Config.Naming_Data.Spec_Suffix);
1191 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1194 if Suffix /= No_File then
1195 return Get_Name_String (Suffix);
1202 --------------------------
1203 -- Standard_Naming_Data --
1204 --------------------------
1206 function Standard_Naming_Data
1207 (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
1210 if Tree = No_Project_Tree then
1211 Prj.Initialize (Tree => No_Project_Tree);
1212 return Std_Naming_Data;
1214 return Tree.Private_Part.Default_Naming;
1216 end Standard_Naming_Data;
1222 function Switches_Name
1223 (Source_File_Name : File_Name_Type) return File_Name_Type
1226 return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
1233 function Value (Image : String) return Casing_Type is
1235 for Casing in The_Casing_Images'Range loop
1236 if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
1241 raise Constraint_Error;
1245 -- Make sure that the standard config and user project file extensions are
1246 -- compatible with canonical case file naming.
1248 Canonical_Case_File_Name (Config_Project_File_Extension);
1249 Canonical_Case_File_Name (Project_File_Extension);