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 Osint; use Osint;
32 with Prj.Err; use Prj.Err;
33 with Snames; use Snames;
35 with Uintp; use Uintp;
37 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
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 The_Empty_String : Name_Id;
54 Default_Ada_Spec_Suffix_Id : File_Name_Type;
55 Default_Ada_Body_Suffix_Id : File_Name_Type;
56 -- Initialized in Prj.Initialize, then never modified
58 subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
60 The_Casing_Images : constant array (Known_Casing) of String_Access :=
61 (All_Lower_Case => new String'("lowercase"),
62 All_Upper_Case => new String'("UPPERCASE"),
63 Mixed_Case => new String'("MixedCase"));
65 Initialized : Boolean := False;
67 Project_Empty : constant Project_Data :=
68 (Qualifier => Unspecified,
69 Externally_Built => False,
70 Config => Default_Project_Config,
72 Display_Name => No_Name,
73 Path => No_Path_Information,
75 Location => No_Location,
77 Directory => No_Path_Information,
79 Library_Dir => No_Path_Information,
80 Library_Src_Dir => No_Path_Information,
81 Library_ALI_Dir => No_Path_Information,
82 Library_Name => No_Name,
83 Library_Kind => Static,
84 Lib_Internal_Name => No_Name,
85 Standalone_Library => False,
86 Lib_Interface_ALIs => Nil_String,
87 Lib_Auto_Init => False,
88 Libgnarl_Needed => Unknown,
89 Symbol_Data => No_Symbols,
90 Interfaces_Defined => False,
92 Include_Data_Set => False,
93 Source_Dirs => Nil_String,
94 Known_Order_Of_Source_Dirs => True,
95 Object_Directory => No_Path_Information,
96 Library_TS => Empty_Time_Stamp,
97 Exec_Directory => No_Path_Information,
98 Extends => No_Project,
99 Extended_By => No_Project,
100 Languages => No_Language_Index,
101 Decl => No_Declarations,
102 Imported_Projects => null,
103 All_Imported_Projects => null,
104 Ada_Include_Path => null,
105 Ada_Objects_Path => null,
106 Objects_Path => null,
107 Include_Path_File => No_Path,
108 Objects_Path_File_With_Libs => No_Path,
109 Objects_Path_File_Without_Libs => No_Path,
110 Config_File_Name => No_Path,
111 Config_File_Temp => False,
112 Config_Checked => False,
113 Need_To_Build_Lib => False,
115 Unkept_Comments => False);
117 package Temp_Files is new Table.Table
118 (Table_Component_Type => Path_Name_Type,
119 Table_Index_Type => Integer,
120 Table_Low_Bound => 1,
122 Table_Increment => 100,
123 Table_Name => "Makegpr.Temp_Files");
124 -- Table to store the path name of all the created temporary files, so that
125 -- they can be deleted at the end, or when the program is interrupted.
127 procedure Free (Project : in out Project_Id);
128 -- Free memory allocated for Project
130 procedure Free_List (Languages : in out Language_Ptr);
131 procedure Free_List (Source : in out Source_Id);
132 procedure Free_List (Languages : in out Language_List);
133 -- Free memory allocated for the list of languages or sources
135 procedure Free_Units (Table : in out Units_Htable.Instance);
136 -- Free memory allocated for unit information in the project
138 procedure Language_Changed (Iter : in out Source_Iterator);
139 procedure Project_Changed (Iter : in out Source_Iterator);
140 -- Called when a new project or language was selected for this iterator
142 function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean;
143 -- Return True if there is at least one ALI file in the directory Dir
149 procedure Add_To_Buffer
151 To : in out String_Access;
152 Last : in out Natural)
156 To := new String (1 .. Initial_Buffer_Size);
160 -- If Buffer is too small, double its size
162 while Last + S'Length > To'Last loop
164 New_Buffer : constant String_Access :=
165 new String (1 .. 2 * Last);
168 New_Buffer (1 .. Last) := To (1 .. Last);
174 To (Last + 1 .. Last + S'Length) := S;
175 Last := Last + S'Length;
178 -----------------------------
179 -- Default_Ada_Body_Suffix --
180 -----------------------------
182 function Default_Ada_Body_Suffix return File_Name_Type is
184 return Default_Ada_Body_Suffix_Id;
185 end Default_Ada_Body_Suffix;
187 -----------------------------
188 -- Default_Ada_Spec_Suffix --
189 -----------------------------
191 function Default_Ada_Spec_Suffix return File_Name_Type is
193 return Default_Ada_Spec_Suffix_Id;
194 end Default_Ada_Spec_Suffix;
196 ---------------------------
197 -- Delete_All_Temp_Files --
198 ---------------------------
200 procedure Delete_All_Temp_Files is
202 pragma Warnings (Off, Dont_Care);
204 if not Debug.Debug_Flag_N then
205 for Index in 1 .. Temp_Files.Last loop
207 (Get_Name_String (Temp_Files.Table (Index)), Dont_Care);
210 end Delete_All_Temp_Files;
212 ---------------------
213 -- Dependency_Name --
214 ---------------------
216 function Dependency_Name
217 (Source_File_Name : File_Name_Type;
218 Dependency : Dependency_File_Kind) return File_Name_Type
229 (Source_File_Name, Makefile_Dependency_Suffix));
235 (Source_File_Name, ALI_Dependency_Suffix));
243 function Empty_File return File_Name_Type is
245 return File_Name_Type (The_Empty_String);
252 function Empty_Project return Project_Data is
254 Prj.Initialize (Tree => No_Project_Tree);
255 return Project_Empty;
262 function Empty_String return Name_Id is
264 return The_Empty_String;
271 procedure Expect (The_Token : Token_Type; Token_Image : String) is
273 if Token /= The_Token then
274 Error_Msg (Token_Image & " expected", Token_Ptr);
283 (File : File_Name_Type;
284 With_Suffix : String) return File_Name_Type
289 Get_Name_String (File);
290 Last := Name_Len + 1;
292 while Name_Len /= 0 and then Name_Buffer (Name_Len) /= '.' loop
293 Name_Len := Name_Len - 1;
296 if Name_Len <= 1 then
300 for J in With_Suffix'Range loop
301 Name_Buffer (Name_Len) := With_Suffix (J);
302 Name_Len := Name_Len + 1;
305 Name_Len := Name_Len - 1;
310 ---------------------
311 -- Project_Changed --
312 ---------------------
314 procedure Project_Changed (Iter : in out Source_Iterator) is
316 Iter.Language := Iter.Project.Project.Languages;
317 Language_Changed (Iter);
320 ----------------------
321 -- Language_Changed --
322 ----------------------
324 procedure Language_Changed (Iter : in out Source_Iterator) is
326 Iter.Current := No_Source;
328 if Iter.Language_Name /= No_Name then
329 while Iter.Language /= null
330 and then Iter.Language.Name /= Iter.Language_Name
332 Iter.Language := Iter.Language.Next;
336 -- If there is no matching language in this project, move to next
338 if Iter.Language = No_Language_Index then
339 if Iter.All_Projects then
340 Iter.Project := Iter.Project.Next;
342 if Iter.Project /= null then
343 Project_Changed (Iter);
347 Iter.Project := null;
351 Iter.Current := Iter.Language.First_Source;
353 if Iter.Current = No_Source then
354 Iter.Language := Iter.Language.Next;
355 Language_Changed (Iter);
358 end Language_Changed;
360 ---------------------
361 -- For_Each_Source --
362 ---------------------
364 function For_Each_Source
365 (In_Tree : Project_Tree_Ref;
366 Project : Project_Id := No_Project;
367 Language : Name_Id := No_Name) return Source_Iterator
369 Iter : Source_Iterator;
371 Iter := Source_Iterator'
373 Project => In_Tree.Projects,
374 All_Projects => Project = No_Project,
375 Language_Name => Language,
376 Language => No_Language_Index,
377 Current => No_Source);
379 if Project /= null then
380 while Iter.Project /= null
381 and then Iter.Project.Project /= Project
383 Iter.Project := Iter.Project.Next;
387 Project_Changed (Iter);
396 function Element (Iter : Source_Iterator) return Source_Id is
405 procedure Next (Iter : in out Source_Iterator) is
407 Iter.Current := Iter.Current.Next_In_Lang;
408 if Iter.Current = No_Source then
409 Iter.Language := Iter.Language.Next;
410 Language_Changed (Iter);
414 --------------------------------
415 -- For_Every_Project_Imported --
416 --------------------------------
418 procedure For_Every_Project_Imported
420 With_State : in out State;
421 Imported_First : Boolean := False)
423 use Project_Boolean_Htable;
424 Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil;
426 procedure Recursive_Check (Project : Project_Id);
427 -- Check if a project has already been seen. If not seen, mark it as
428 -- Seen, Call Action, and check all its imported projects.
430 ---------------------
431 -- Recursive_Check --
432 ---------------------
434 procedure Recursive_Check (Project : Project_Id) is
438 if not Get (Seen, Project) then
439 Set (Seen, Project, True);
441 if not Imported_First then
442 Action (Project, With_State);
445 -- Visited all extended projects
447 if Project.Extends /= No_Project then
448 Recursive_Check (Project.Extends);
451 -- Visited all imported projects
453 List := Project.Imported_Projects;
454 while List /= null loop
455 Recursive_Check (List.Project);
459 if Imported_First then
460 Action (Project, With_State);
465 -- Start of processing for For_Every_Project_Imported
468 Recursive_Check (Project => By);
470 end For_Every_Project_Imported;
476 function Get_Mode return Mode is
485 function Hash is new System.HTable.Hash (Header_Num => Header_Num);
486 -- Used in implementation of other functions Hash below
488 function Hash (Name : File_Name_Type) return Header_Num is
490 return Hash (Get_Name_String (Name));
493 function Hash (Name : Name_Id) return Header_Num is
495 return Hash (Get_Name_String (Name));
498 function Hash (Name : Path_Name_Type) return Header_Num is
500 return Hash (Get_Name_String (Name));
503 function Hash (Project : Project_Id) return Header_Num is
505 if Project = No_Project then
506 return Header_Num'First;
508 return Hash (Get_Name_String (Project.Name));
516 function Image (Casing : Casing_Type) return String is
518 return The_Casing_Images (Casing).all;
525 procedure Initialize (Tree : Project_Tree_Ref) is
527 if not Initialized then
531 The_Empty_String := Name_Find;
532 Empty_Name := The_Empty_String;
533 Empty_File_Name := File_Name_Type (The_Empty_String);
535 Name_Buffer (1 .. 4) := ".ads";
536 Default_Ada_Spec_Suffix_Id := Name_Find;
538 Name_Buffer (1 .. 4) := ".adb";
539 Default_Ada_Body_Suffix_Id := Name_Find;
542 Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
543 Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
544 Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
547 if Tree /= No_Project_Tree then
556 function Is_A_Language
557 (Project : Project_Id;
558 Language_Name : Name_Id) return Boolean is
560 return Get_Language_From_Name
561 (Project, Get_Name_String (Language_Name)) /= null;
568 function Is_Extending
569 (Extending : Project_Id;
570 Extended : Project_Id) return Boolean
576 while Proj /= No_Project loop
577 if Proj = Extended then
581 Proj := Proj.Extends;
592 (Source_File_Name : File_Name_Type;
593 Object_File_Suffix : Name_Id := No_Name) return File_Name_Type
596 if Object_File_Suffix = No_Name then
598 (Source_File_Name, Object_Suffix);
601 (Source_File_Name, Get_Name_String (Object_File_Suffix));
605 ----------------------
606 -- Record_Temp_File --
607 ----------------------
609 procedure Record_Temp_File (Path : Path_Name_Type) is
611 Temp_Files.Increment_Last;
612 Temp_Files.Table (Temp_Files.Last) := Path;
613 end Record_Temp_File;
619 procedure Free (Project : in out Project_Id) is
620 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
621 (Project_Data, Project_Id);
624 if Project /= null then
625 Free (Project.Include_Path);
626 Free (Project.Ada_Include_Path);
627 Free (Project.Objects_Path);
628 Free (Project.Ada_Objects_Path);
629 Free_List (Project.Imported_Projects, Free_Project => False);
630 Free_List (Project.All_Imported_Projects, Free_Project => False);
631 Free_List (Project.Languages);
633 Unchecked_Free (Project);
641 procedure Free_List (Languages : in out Language_List) is
642 procedure Unchecked_Free is new Ada.Unchecked_Deallocation
643 (Language_List_Element, Language_List);
646 while Languages /= null loop
647 Tmp := Languages.Next;
648 Unchecked_Free (Languages);
657 procedure Free_List (Source : in out Source_Id) is
658 procedure Unchecked_Free is new
659 Ada.Unchecked_Deallocation (Source_Data, Source_Id);
664 while Source /= No_Source loop
665 Tmp := Source.Next_In_Lang;
666 Free_List (Source.Alternate_Languages);
668 if Source.Unit /= null
669 and then Source.Kind in Spec_Or_Body
671 Source.Unit.File_Names (Source.Kind) := null;
674 Unchecked_Free (Source);
684 (List : in out Project_List;
685 Free_Project : Boolean)
687 procedure Unchecked_Free is new
688 Ada.Unchecked_Deallocation (Project_List_Element, Project_List);
693 while List /= null loop
700 Unchecked_Free (List);
709 procedure Free_List (Languages : in out Language_Ptr) is
710 procedure Unchecked_Free is new
711 Ada.Unchecked_Deallocation (Language_Data, Language_Ptr);
716 while Languages /= null loop
717 Tmp := Languages.Next;
718 Free_List (Languages.First_Source);
719 Unchecked_Free (Languages);
728 procedure Free_Units (Table : in out Units_Htable.Instance) is
729 procedure Unchecked_Free is new
730 Ada.Unchecked_Deallocation (Unit_Data, Unit_Index);
735 Unit := Units_Htable.Get_First (Table);
736 while Unit /= No_Unit_Index loop
737 if Unit.File_Names (Spec) /= null then
738 Unit.File_Names (Spec).Unit := No_Unit_Index;
741 if Unit.File_Names (Impl) /= null then
742 Unit.File_Names (Impl).Unit := No_Unit_Index;
745 Unchecked_Free (Unit);
746 Unit := Units_Htable.Get_Next (Table);
749 Units_Htable.Reset (Table);
756 procedure Free (Tree : in out Project_Tree_Ref) is
757 procedure Unchecked_Free is new
758 Ada.Unchecked_Deallocation (Project_Tree_Data, Project_Tree_Ref);
762 Name_List_Table.Free (Tree.Name_Lists);
763 String_Element_Table.Free (Tree.String_Elements);
764 Variable_Element_Table.Free (Tree.Variable_Elements);
765 Array_Element_Table.Free (Tree.Array_Elements);
766 Array_Table.Free (Tree.Arrays);
767 Package_Table.Free (Tree.Packages);
768 Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
769 Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
771 Free_List (Tree.Projects, Free_Project => True);
772 Free_Units (Tree.Units_HT);
776 Path_File_Table.Free (Tree.Private_Part.Path_Files);
777 Source_Path_Table.Free (Tree.Private_Part.Source_Paths);
778 Object_Path_Table.Free (Tree.Private_Part.Object_Paths);
780 Free (Tree.Private_Part.Ada_Path_Buffer);
782 -- Naming data (nothing to free ???)
786 Unchecked_Free (Tree);
794 procedure Reset (Tree : Project_Tree_Ref) is
798 Name_List_Table.Init (Tree.Name_Lists);
799 String_Element_Table.Init (Tree.String_Elements);
800 Variable_Element_Table.Init (Tree.Variable_Elements);
801 Array_Element_Table.Init (Tree.Array_Elements);
802 Array_Table.Init (Tree.Arrays);
803 Package_Table.Init (Tree.Packages);
804 Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
805 Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
807 Free_List (Tree.Projects, Free_Project => True);
808 Free_Units (Tree.Units_HT);
810 -- Private part table
812 Path_File_Table.Init (Tree.Private_Part.Path_Files);
813 Source_Path_Table.Init (Tree.Private_Part.Source_Paths);
814 Object_Path_Table.Init (Tree.Private_Part.Object_Paths);
816 if Current_Mode = Ada_Only then
817 Tree.Private_Part.Current_Source_Path_File := No_Path;
818 Tree.Private_Part.Current_Object_Path_File := No_Path;
819 Tree.Private_Part.Ada_Path_Length := 0;
820 Tree.Private_Part.Ada_Prj_Include_File_Set := False;
821 Tree.Private_Part.Ada_Prj_Objects_File_Set := False;
822 Tree.Private_Part.Fill_Mapping_File := True;
830 procedure Set_Mode (New_Mode : Mode) is
832 Current_Mode := New_Mode;
836 Default_Language_Is_Ada := True;
837 Must_Check_Configuration := False;
838 when Multi_Language =>
839 Default_Language_Is_Ada := False;
840 Must_Check_Configuration := True;
848 function Switches_Name
849 (Source_File_Name : File_Name_Type) return File_Name_Type
852 return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
859 function Value (Image : String) return Casing_Type is
861 for Casing in The_Casing_Images'Range loop
862 if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
867 raise Constraint_Error;
870 ---------------------
871 -- Has_Ada_Sources --
872 ---------------------
874 function Has_Ada_Sources (Data : Project_Id) return Boolean is
878 Lang := Data.Languages;
879 while Lang /= No_Language_Index loop
880 if Lang.Name = Name_Ada then
881 return Lang.First_Source /= No_Source;
889 -------------------------
890 -- Has_Foreign_Sources --
891 -------------------------
893 function Has_Foreign_Sources (Data : Project_Id) return Boolean is
897 Lang := Data.Languages;
898 while Lang /= No_Language_Index loop
899 if Lang.Name /= Name_Ada
901 (Current_Mode = Ada_Only or else Lang.First_Source /= No_Source)
910 end Has_Foreign_Sources;
912 ------------------------
913 -- Contains_ALI_Files --
914 ------------------------
916 function Contains_ALI_Files (Dir : Path_Name_Type) return Boolean is
917 Dir_Name : constant String := Get_Name_String (Dir);
919 Name : String (1 .. 1_000);
921 Result : Boolean := False;
924 Open (Direct, Dir_Name);
926 -- For each file in the directory, check if it is an ALI file
929 Read (Direct, Name, Last);
931 Canonical_Case_File_Name (Name (1 .. Last));
932 Result := Last >= 5 and then Name (Last - 3 .. Last) = ".ali";
940 -- If there is any problem, close the directory if open and return True.
941 -- The library directory will be added to the path.
944 if Is_Open (Direct) then
949 end Contains_ALI_Files;
951 --------------------------
952 -- Get_Object_Directory --
953 --------------------------
955 function Get_Object_Directory
956 (Project : Project_Id;
957 Including_Libraries : Boolean;
958 Only_If_Ada : Boolean := False) return Path_Name_Type
961 if (Project.Library and Including_Libraries)
963 (Project.Object_Directory /= No_Path_Information
964 and then (not Including_Libraries or else not Project.Library))
966 -- For a library project, add the library ALI directory if there is
967 -- no object directory or if the library ALI directory contains ALI
968 -- files; otherwise add the object directory.
970 if Project.Library then
971 if Project.Object_Directory = No_Path_Information
972 or else Contains_ALI_Files (Project.Library_ALI_Dir.Name)
974 return Project.Library_ALI_Dir.Name;
976 return Project.Object_Directory.Name;
979 -- For a non-library project, add object directory if it is not a
980 -- virtual project, and if there are Ada sources in the project or
981 -- one of the projects it extends. If there are no Ada sources,
982 -- adding the object directory could disrupt the order of the
983 -- object dirs in the path.
985 elsif not Project.Virtual then
987 Add_Object_Dir : Boolean;
991 Add_Object_Dir := not Only_If_Ada;
993 while not Add_Object_Dir and then Prj /= No_Project loop
994 if Has_Ada_Sources (Prj) then
995 Add_Object_Dir := True;
1001 if Add_Object_Dir then
1002 return Project.Object_Directory.Name;
1009 end Get_Object_Directory;
1011 -----------------------------------
1012 -- Ultimate_Extending_Project_Of --
1013 -----------------------------------
1015 function Ultimate_Extending_Project_Of
1016 (Proj : Project_Id) return Project_Id
1022 while Prj /= null and then Prj.Extended_By /= No_Project loop
1023 Prj := Prj.Extended_By;
1027 end Ultimate_Extending_Project_Of;
1029 -----------------------------------
1030 -- Compute_All_Imported_Projects --
1031 -----------------------------------
1033 procedure Compute_All_Imported_Projects (Project : Project_Id) is
1034 procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean);
1035 -- Recursively add the projects imported by project Project, but not
1036 -- those that are extended.
1042 procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean) is
1043 pragma Unreferenced (Dummy);
1044 List : Project_List;
1048 -- A project is not importing itself
1050 if Project /= Prj then
1051 Prj2 := Ultimate_Extending_Project_Of (Prj);
1053 -- Check that the project is not already in the list. We know the
1054 -- one passed to Recursive_Add have never been visited before, but
1055 -- the one passed it are the extended projects.
1057 List := Project.All_Imported_Projects;
1058 while List /= null loop
1059 if List.Project = Prj2 then
1065 -- Add it to the list
1067 Project.All_Imported_Projects :=
1068 new Project_List_Element'
1070 Next => Project.All_Imported_Projects);
1074 procedure For_All_Projects is
1075 new For_Every_Project_Imported (Boolean, Recursive_Add);
1076 Dummy : Boolean := False;
1079 Free_List (Project.All_Imported_Projects, Free_Project => False);
1080 For_All_Projects (Project, Dummy);
1081 end Compute_All_Imported_Projects;
1087 function Is_Compilable (Source : Source_Id) return Boolean is
1089 return Source.Language.Config.Compiler_Driver /= Empty_File_Name
1090 and then not Source.Locally_Removed;
1093 ------------------------------
1094 -- Object_To_Global_Archive --
1095 ------------------------------
1097 function Object_To_Global_Archive (Source : Source_Id) return Boolean is
1099 return Source.Language.Config.Kind = File_Based
1100 and then Source.Kind = Impl
1101 and then Source.Language.Config.Objects_Linked
1102 and then Is_Compilable (Source)
1103 and then Source.Language.Config.Object_Generated;
1104 end Object_To_Global_Archive;
1106 ----------------------------
1107 -- Get_Language_From_Name --
1108 ----------------------------
1110 function Get_Language_From_Name
1111 (Project : Project_Id;
1112 Name : String) return Language_Ptr
1115 Result : Language_Ptr;
1118 Name_Len := Name'Length;
1119 Name_Buffer (1 .. Name_Len) := Name;
1120 To_Lower (Name_Buffer (1 .. Name_Len));
1123 Result := Project.Languages;
1124 while Result /= No_Language_Index loop
1125 if Result.Name = N then
1129 Result := Result.Next;
1132 return No_Language_Index;
1133 end Get_Language_From_Name;
1139 function Other_Part (Source : Source_Id) return Source_Id is
1141 if Source.Unit /= No_Unit_Index then
1144 return Source.Unit.File_Names (Spec);
1146 return Source.Unit.File_Names (Impl);
1156 -- Make sure that the standard config and user project file extensions are
1157 -- compatible with canonical case file naming.
1159 Canonical_Case_File_Name (Config_Project_File_Extension);
1160 Canonical_Case_File_Name (Project_File_Extension);