1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2006-2013, 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 ------------------------------------------------------------------------------
27 with Makeutl
; use Makeutl
;
30 with Output
; use Output
;
35 with Prj
.Proc
; use Prj
.Proc
;
36 with Prj
.Tree
; use Prj
.Tree
;
37 with Prj
.Util
; use Prj
.Util
;
39 with Snames
; use Snames
;
41 with Ada
.Directories
; use Ada
.Directories
;
42 with Ada
.Exceptions
; use Ada
.Exceptions
;
44 with GNAT
.Case_Util
; use GNAT
.Case_Util
;
45 with GNAT
.HTable
; use GNAT
.HTable
;
47 package body Prj
.Conf
is
49 Auto_Cgpr
: constant String := "auto.cgpr";
51 Config_Project_Env_Var
: constant String := "GPR_CONFIG";
52 -- Name of the environment variable that provides the name of the
53 -- configuration file to use.
55 Gprconfig_Name
: constant String := "gprconfig";
57 package RTS_Languages
is new GNAT
.HTable
.Simple_HTable
58 (Header_Num
=> Prj
.Header_Num
,
60 No_Element
=> No_Name
,
64 -- Stores the runtime names for the various languages. This is in general
65 -- set from a --RTS command line option.
67 -----------------------
68 -- Local_Subprograms --
69 -----------------------
72 (Config_File
: Prj
.Project_Id
;
73 Autoconf_Specified
: Boolean;
74 Project_Tree
: Prj
.Project_Tree_Ref
;
75 Target
: String := "") return Boolean;
76 -- Check that the config file's target matches Target.
77 -- Target should be set to the empty string when the user did not specify
78 -- a target. If the target in the configuration file is invalid, this
79 -- function will raise Invalid_Config with an appropriate message.
80 -- Autoconf_Specified should be set to True if the user has used
83 function Locate_Config_File
(Name
: String) return String_Access
;
84 -- Search for Name in the config files directory. Return full path if
85 -- found, or null otherwise.
87 procedure Raise_Invalid_Config
(Msg
: String);
88 pragma No_Return
(Raise_Invalid_Config
);
89 -- Raises exception Invalid_Config with given message
91 procedure Apply_Config_File
92 (Config_File
: Prj
.Project_Id
;
93 Project_Tree
: Prj
.Project_Tree_Ref
);
94 -- Apply the configuration file settings to all the projects in the
95 -- project tree. The Project_Tree must have been parsed first, and
96 -- processed through the first phase so that all its projects are known.
98 -- Currently, this will add new attributes and packages in the various
99 -- projects, so that when the second phase of the processing is performed
100 -- these attributes are automatically taken into account.
102 ------------------------------------
103 -- Add_Default_GNAT_Naming_Scheme --
104 ------------------------------------
106 procedure Add_Default_GNAT_Naming_Scheme
107 (Config_File
: in out Project_Node_Id
;
108 Project_Tree
: Project_Node_Tree_Ref
)
110 procedure Create_Attribute
113 Index
: String := "";
114 Pkg
: Project_Node_Id
:= Empty_Node
);
116 ----------------------
117 -- Create_Attribute --
118 ----------------------
120 procedure Create_Attribute
123 Index
: String := "";
124 Pkg
: Project_Node_Id
:= Empty_Node
)
126 Attr
: Project_Node_Id
;
127 pragma Unreferenced
(Attr
);
129 Expr
: Name_Id
:= No_Name
;
130 Val
: Name_Id
:= No_Name
;
131 Parent
: Project_Node_Id
:= Config_File
;
135 Name_Len
:= Index
'Length;
136 Name_Buffer
(1 .. Name_Len
) := Index
;
140 if Pkg
/= Empty_Node
then
144 Name_Len
:= Value
'Length;
145 Name_Buffer
(1 .. Name_Len
) := Value
;
148 Attr
:= Create_Attribute
149 (Tree
=> Project_Tree
,
150 Prj_Or_Pkg
=> Parent
,
154 Value
=> Create_Literal_String
(Expr
, Project_Tree
));
155 end Create_Attribute
;
160 Naming
: Project_Node_Id
;
161 Compiler
: Project_Node_Id
;
163 -- Start of processing for Add_Default_GNAT_Naming_Scheme
166 if Config_File
= Empty_Node
then
168 -- Create a dummy config file is none was found
170 Name_Len
:= Auto_Cgpr
'Length;
171 Name_Buffer
(1 .. Name_Len
) := Auto_Cgpr
;
174 -- An invalid project name to avoid conflicts with user-created ones
177 Name_Buffer
(1 .. Name_Len
) := "_auto";
181 (In_Tree
=> Project_Tree
,
183 Full_Path
=> Path_Name_Type
(Name
),
184 Is_Config_File
=> True);
186 -- Setup library support
188 case MLib
.Tgt
.Support_For_Libraries
is
193 Create_Attribute
(Name_Library_Support
, "static_only");
196 Create_Attribute
(Name_Library_Support
, "full");
199 if MLib
.Tgt
.Standalone_Library_Auto_Init_Is_Supported
then
200 Create_Attribute
(Name_Library_Auto_Init_Supported
, "true");
202 Create_Attribute
(Name_Library_Auto_Init_Supported
, "false");
205 -- Setup Ada support (Ada is the default language here, since this
206 -- is only called when no config file existed initially, ie for
209 Create_Attribute
(Name_Default_Language
, "ada");
211 Compiler
:= Create_Package
(Project_Tree
, Config_File
, "compiler");
213 (Name_Driver
, "gcc", "ada", Pkg
=> Compiler
);
215 (Name_Language_Kind
, "unit_based", "ada", Pkg
=> Compiler
);
217 (Name_Dependency_Kind
, "ALI_File", "ada", Pkg
=> Compiler
);
219 Naming
:= Create_Package
(Project_Tree
, Config_File
, "naming");
220 Create_Attribute
(Name_Spec_Suffix
, ".ads", "ada", Pkg
=> Naming
);
221 Create_Attribute
(Name_Separate_Suffix
, ".adb", "ada", Pkg
=> Naming
);
222 Create_Attribute
(Name_Body_Suffix
, ".adb", "ada", Pkg
=> Naming
);
223 Create_Attribute
(Name_Dot_Replacement
, "-", Pkg
=> Naming
);
224 Create_Attribute
(Name_Casing
, "lowercase", Pkg
=> Naming
);
226 if Current_Verbosity
= High
then
227 Write_Line
("Automatically generated (in-memory) config file");
229 (Project
=> Config_File
,
230 In_Tree
=> Project_Tree
,
231 Backward_Compatibility
=> False);
234 end Add_Default_GNAT_Naming_Scheme
;
236 -----------------------
237 -- Apply_Config_File --
238 -----------------------
240 procedure Apply_Config_File
241 (Config_File
: Prj
.Project_Id
;
242 Project_Tree
: Prj
.Project_Tree_Ref
)
244 procedure Add_Attributes
245 (Project_Tree
: Project_Tree_Ref
;
246 Conf_Decl
: Declarations
;
247 User_Decl
: in out Declarations
);
248 -- Process the attributes in the config declarations. For
249 -- single string values, if the attribute is not declared in
250 -- the user declarations, declare it with the value in the
251 -- config declarations. For string list values, prepend the
252 -- value in the user declarations with the value in the config
259 procedure Add_Attributes
260 (Project_Tree
: Project_Tree_Ref
;
261 Conf_Decl
: Declarations
;
262 User_Decl
: in out Declarations
)
264 Shared
: constant Shared_Project_Tree_Data_Access
:=
266 Conf_Attr_Id
: Variable_Id
;
267 Conf_Attr
: Variable
;
268 Conf_Array_Id
: Array_Id
;
269 Conf_Array
: Array_Data
;
270 Conf_Array_Elem_Id
: Array_Element_Id
;
271 Conf_Array_Elem
: Array_Element
;
272 Conf_List
: String_List_Id
;
273 Conf_List_Elem
: String_Element
;
275 User_Attr_Id
: Variable_Id
;
276 User_Attr
: Variable
;
277 User_Array_Id
: Array_Id
;
278 User_Array
: Array_Data
;
279 User_Array_Elem_Id
: Array_Element_Id
;
280 User_Array_Elem
: Array_Element
;
283 Conf_Attr_Id
:= Conf_Decl
.Attributes
;
284 User_Attr_Id
:= User_Decl
.Attributes
;
286 while Conf_Attr_Id
/= No_Variable
loop
287 Conf_Attr
:= Shared
.Variable_Elements
.Table
(Conf_Attr_Id
);
288 User_Attr
:= Shared
.Variable_Elements
.Table
(User_Attr_Id
);
290 if not Conf_Attr
.Value
.Default
then
291 if User_Attr
.Value
.Default
then
293 -- No attribute declared in user project file: just copy
294 -- the value of the configuration attribute.
296 User_Attr
.Value
:= Conf_Attr
.Value
;
297 Shared
.Variable_Elements
.Table
(User_Attr_Id
) := User_Attr
;
299 elsif User_Attr
.Value
.Kind
= List
300 and then Conf_Attr
.Value
.Values
/= Nil_String
302 -- List attribute declared in both the user project and the
303 -- configuration project: prepend the user list with the
304 -- configuration list.
307 User_List
: constant String_List_Id
:=
308 User_Attr
.Value
.Values
;
309 Conf_List
: String_List_Id
:= Conf_Attr
.Value
.Values
;
310 Conf_Elem
: String_Element
;
311 New_List
: String_List_Id
;
312 New_Elem
: String_Element
;
317 String_Element_Table
.Increment_Last
318 (Shared
.String_Elements
);
320 String_Element_Table
.Last
(Shared
.String_Elements
);
322 -- Value of attribute is new list
324 User_Attr
.Value
.Values
:= New_List
;
325 Shared
.Variable_Elements
.Table
(User_Attr_Id
) :=
329 -- Get each element of configuration list
331 Conf_Elem
:= Shared
.String_Elements
.Table
(Conf_List
);
332 New_Elem
:= Conf_Elem
;
333 Conf_List
:= Conf_Elem
.Next
;
335 if Conf_List
= Nil_String
then
337 -- If it is the last element in the list, connect
338 -- to first element of user list, and we are done.
340 New_Elem
.Next
:= User_List
;
341 Shared
.String_Elements
.Table
(New_List
) := New_Elem
;
345 -- If it is not the last element in the list, add
348 String_Element_Table
.Increment_Last
349 (Shared
.String_Elements
);
350 New_Elem
.Next
:= String_Element_Table
.Last
351 (Shared
.String_Elements
);
352 Shared
.String_Elements
.Table
(New_List
) := New_Elem
;
353 New_List
:= New_Elem
.Next
;
360 Conf_Attr_Id
:= Conf_Attr
.Next
;
361 User_Attr_Id
:= User_Attr
.Next
;
364 Conf_Array_Id
:= Conf_Decl
.Arrays
;
365 while Conf_Array_Id
/= No_Array
loop
366 Conf_Array
:= Shared
.Arrays
.Table
(Conf_Array_Id
);
368 User_Array_Id
:= User_Decl
.Arrays
;
369 while User_Array_Id
/= No_Array
loop
370 User_Array
:= Shared
.Arrays
.Table
(User_Array_Id
);
371 exit when User_Array
.Name
= Conf_Array
.Name
;
372 User_Array_Id
:= User_Array
.Next
;
375 -- If this associative array does not exist in the user project
376 -- file, do a shallow copy of the full associative array.
378 if User_Array_Id
= No_Array
then
379 Array_Table
.Increment_Last
(Shared
.Arrays
);
380 User_Array
:= Conf_Array
;
381 User_Array
.Next
:= User_Decl
.Arrays
;
382 User_Decl
.Arrays
:= Array_Table
.Last
(Shared
.Arrays
);
383 Shared
.Arrays
.Table
(User_Decl
.Arrays
) := User_Array
;
385 -- Otherwise, check each array element
388 Conf_Array_Elem_Id
:= Conf_Array
.Value
;
389 while Conf_Array_Elem_Id
/= No_Array_Element
loop
391 Shared
.Array_Elements
.Table
(Conf_Array_Elem_Id
);
393 User_Array_Elem_Id
:= User_Array
.Value
;
394 while User_Array_Elem_Id
/= No_Array_Element
loop
396 Shared
.Array_Elements
.Table
(User_Array_Elem_Id
);
397 exit when User_Array_Elem
.Index
= Conf_Array_Elem
.Index
;
398 User_Array_Elem_Id
:= User_Array_Elem
.Next
;
401 -- If the array element doesn't exist in the user array,
402 -- insert a shallow copy of the conf array element in the
405 if User_Array_Elem_Id
= No_Array_Element
then
406 Array_Element_Table
.Increment_Last
407 (Shared
.Array_Elements
);
408 User_Array_Elem
:= Conf_Array_Elem
;
409 User_Array_Elem
.Next
:= User_Array
.Value
;
411 Array_Element_Table
.Last
(Shared
.Array_Elements
);
412 Shared
.Array_Elements
.Table
(User_Array
.Value
) :=
414 Shared
.Arrays
.Table
(User_Array_Id
) := User_Array
;
416 -- Otherwise, if the value is a string list, prepend the
417 -- conf array element value to the array element.
419 elsif Conf_Array_Elem
.Value
.Kind
= List
then
420 Conf_List
:= Conf_Array_Elem
.Value
.Values
;
422 if Conf_List
/= Nil_String
then
424 Link
: constant String_List_Id
:=
425 User_Array_Elem
.Value
.Values
;
426 Previous
: String_List_Id
:= Nil_String
;
427 Next
: String_List_Id
;
432 Shared
.String_Elements
.Table
(Conf_List
);
433 String_Element_Table
.Increment_Last
434 (Shared
.String_Elements
);
436 String_Element_Table
.Last
437 (Shared
.String_Elements
);
438 Shared
.String_Elements
.Table
(Next
) :=
441 if Previous
= Nil_String
then
442 User_Array_Elem
.Value
.Values
:= Next
;
443 Shared
.Array_Elements
.Table
444 (User_Array_Elem_Id
) := User_Array_Elem
;
447 Shared
.String_Elements
.Table
448 (Previous
).Next
:= Next
;
453 Conf_List
:= Conf_List_Elem
.Next
;
455 if Conf_List
= Nil_String
then
456 Shared
.String_Elements
.Table
457 (Previous
).Next
:= Link
;
465 Conf_Array_Elem_Id
:= Conf_Array_Elem
.Next
;
469 Conf_Array_Id
:= Conf_Array
.Next
;
473 Shared
: constant Shared_Project_Tree_Data_Access
:= Project_Tree
.Shared
;
475 Conf_Decl
: constant Declarations
:= Config_File
.Decl
;
476 Conf_Pack_Id
: Package_Id
;
477 Conf_Pack
: Package_Element
;
479 User_Decl
: Declarations
;
480 User_Pack_Id
: Package_Id
;
481 User_Pack
: Package_Element
;
485 Debug_Output
("Applying config file to a project tree");
487 Proj
:= Project_Tree
.Projects
;
488 while Proj
/= null loop
489 if Proj
.Project
/= Config_File
then
490 User_Decl
:= Proj
.Project
.Decl
;
492 (Project_Tree
=> Project_Tree
,
493 Conf_Decl
=> Conf_Decl
,
494 User_Decl
=> User_Decl
);
496 Conf_Pack_Id
:= Conf_Decl
.Packages
;
497 while Conf_Pack_Id
/= No_Package
loop
498 Conf_Pack
:= Shared
.Packages
.Table
(Conf_Pack_Id
);
500 User_Pack_Id
:= User_Decl
.Packages
;
501 while User_Pack_Id
/= No_Package
loop
502 User_Pack
:= Shared
.Packages
.Table
(User_Pack_Id
);
503 exit when User_Pack
.Name
= Conf_Pack
.Name
;
504 User_Pack_Id
:= User_Pack
.Next
;
507 if User_Pack_Id
= No_Package
then
508 Package_Table
.Increment_Last
(Shared
.Packages
);
509 User_Pack
:= Conf_Pack
;
510 User_Pack
.Next
:= User_Decl
.Packages
;
511 User_Decl
.Packages
:= Package_Table
.Last
(Shared
.Packages
);
512 Shared
.Packages
.Table
(User_Decl
.Packages
) := User_Pack
;
516 (Project_Tree
=> Project_Tree
,
517 Conf_Decl
=> Conf_Pack
.Decl
,
518 User_Decl
=> Shared
.Packages
.Table
519 (User_Pack_Id
).Decl
);
522 Conf_Pack_Id
:= Conf_Pack
.Next
;
525 Proj
.Project
.Decl
:= User_Decl
;
527 -- For aggregate projects, we need to apply the config to all
528 -- their aggregated trees as well.
530 if Proj
.Project
.Qualifier
in Aggregate_Project
then
532 List
: Aggregated_Project_List
;
534 List
:= Proj
.Project
.Aggregated_Projects
;
535 while List
/= null loop
537 ("Recursively apply config to aggregated tree",
540 (Config_File
, Project_Tree
=> List
.Tree
);
549 end Apply_Config_File
;
555 function Check_Target
556 (Config_File
: Project_Id
;
557 Autoconf_Specified
: Boolean;
558 Project_Tree
: Prj
.Project_Tree_Ref
;
559 Target
: String := "") return Boolean
561 Shared
: constant Shared_Project_Tree_Data_Access
:=
563 Variable
: constant Variable_Value
:=
565 (Name_Target
, Config_File
.Decl
.Attributes
, Shared
);
566 Tgt_Name
: Name_Id
:= No_Name
;
570 if Variable
/= Nil_Variable_Value
and then not Variable
.Default
then
571 Tgt_Name
:= Variable
.Value
;
576 or else (Tgt_Name
/= No_Name
577 and then Target
= Get_Name_String
(Tgt_Name
));
580 if Autoconf_Specified
then
582 Write_Line
("inconsistent targets, performing autoconf");
588 if Tgt_Name
/= No_Name
then
590 ("invalid target name """
591 & Get_Name_String
(Tgt_Name
) & """ in configuration");
594 ("no target specified in configuration file");
602 --------------------------------------
603 -- Get_Or_Create_Configuration_File --
604 --------------------------------------
606 procedure Get_Or_Create_Configuration_File
607 (Project
: Project_Id
;
608 Conf_Project
: Project_Id
;
609 Project_Tree
: Project_Tree_Ref
;
610 Project_Node_Tree
: Prj
.Tree
.Project_Node_Tree_Ref
;
611 Env
: in out Prj
.Tree
.Environment
;
612 Allow_Automatic_Generation
: Boolean;
613 Config_File_Name
: String := "";
614 Autoconf_Specified
: Boolean;
615 Target_Name
: String := "";
616 Normalized_Hostname
: String;
617 Packages_To_Check
: String_List_Access
:= null;
618 Config
: out Prj
.Project_Id
;
619 Config_File_Path
: out String_Access
;
620 Automatically_Generated
: out Boolean;
621 On_Load_Config
: Config_File_Hook
:= null)
623 Shared
: constant Shared_Project_Tree_Data_Access
:= Project_Tree
.Shared
;
625 At_Least_One_Compiler_Command
: Boolean := False;
626 -- Set to True if at least one attribute Ide'Compiler_Command is
627 -- specified for one language of the system.
629 Conf_File_Name
: String_Access
:= new String'(Config_File_Name);
630 -- The configuration project file name. May be modified if there are
631 -- switches --config= in the Builder package of the main project.
633 Selected_Target : String_Access := new String'(Target_Name
);
635 function Default_File_Name
return String;
636 -- Return the name of the default config file that should be tested
638 procedure Do_Autoconf
;
639 -- Generate a new config file through gprconfig. In case of error, this
640 -- raises the Invalid_Config exception with an appropriate message
642 procedure Check_Builder_Switches
;
643 -- Check for switches --config and --RTS in package Builder
645 procedure Get_Project_Target
;
646 -- If Target_Name is empty, get the specified target in the project
649 function Get_Config_Switches
return Argument_List_Access
;
650 -- Return the --config switches to use for gprconfig
652 function Get_Db_Switches
return Argument_List_Access
;
653 -- Return the --db switches to use for gprconfig
655 function Might_Have_Sources
(Project
: Project_Id
) return Boolean;
656 -- True if the specified project might have sources (ie the user has not
657 -- explicitly specified it. We haven't checked the file system, nor do
658 -- we need to at this stage.
660 ----------------------------
661 -- Check_Builder_Switches --
662 ----------------------------
664 procedure Check_Builder_Switches
is
665 Get_RTS_Switches
: constant Boolean :=
666 RTS_Languages
.Get_First
= No_Name
;
667 -- If no switch --RTS have been specified on the command line, look
668 -- for --RTS switches in the Builder switches.
670 Builder
: constant Package_Id
:=
671 Value_Of
(Name_Builder
, Project
.Decl
.Packages
, Shared
);
673 Switch_Array_Id
: Array_Element_Id
;
674 -- The Switches to be checked
676 procedure Check_Switches
;
677 -- Check the switches in Switch_Array_Id
683 procedure Check_Switches
is
684 Switch_Array
: Array_Element
;
685 Switch_List
: String_List_Id
:= Nil_String
;
686 Switch
: String_Element
;
688 Lang_Last
: Positive;
691 while Switch_Array_Id
/= No_Array_Element
loop
693 Shared
.Array_Elements
.Table
(Switch_Array_Id
);
695 Switch_List
:= Switch_Array
.Value
.Values
;
696 List_Loop
: while Switch_List
/= Nil_String
loop
697 Switch
:= Shared
.String_Elements
.Table
(Switch_List
);
699 if Switch
.Value
/= No_Name
then
700 Get_Name_String
(Switch
.Value
);
702 if Conf_File_Name
'Length = 0
703 and then Name_Len
> 9
704 and then Name_Buffer
(1 .. 9) = "--config="
707 new String'(Name_Buffer (10 .. Name_Len));
709 elsif Get_RTS_Switches
710 and then Name_Len >= 7
711 and then Name_Buffer (1 .. 5) = "--RTS"
713 if Name_Buffer (6) = '=' then
714 if not Runtime_Name_Set_For (Name_Ada) then
717 Name_Buffer (7 .. Name_Len));
718 Locate_Runtime (Name_Ada, Project_Tree);
722 and then Name_Buffer (6) = ':'
723 and then Name_Buffer (7) /= '='
726 while Lang_Last < Name_Len
727 and then Name_Buffer (Lang_Last + 1) /= '='
729 Lang_Last := Lang_Last + 1;
732 if Name_Buffer (Lang_Last + 1) = '=' then
734 RTS : constant String :=
735 Name_Buffer (Lang_Last + 2 .. Name_Len);
737 Name_Buffer (1 .. Lang_Last - 6) :=
738 Name_Buffer (7 .. Lang_Last);
739 Name_Len := Lang_Last - 6;
740 To_Lower (Name_Buffer (1 .. Name_Len));
743 if not Runtime_Name_Set_For (Lang) then
744 Set_Runtime_For (Lang, RTS);
745 Locate_Runtime (Lang, Project_Tree);
753 Switch_List := Switch.Next;
756 Switch_Array_Id := Switch_Array.Next;
760 -- Start of processing for Check_Builder_Switches
763 if Builder /= No_Package then
766 (Name => Name_Switches,
767 In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays,
773 (Name => Name_Default_Switches,
774 In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays,
778 end Check_Builder_Switches;
780 ------------------------
781 -- Get_Project_Target --
782 ------------------------
784 procedure Get_Project_Target is
786 if Selected_Target'Length = 0 then
788 -- Check if attribute Target is specified in the main
789 -- project, or in a project it extends. If it is, use this
790 -- target to invoke gprconfig.
793 Variable : Variable_Value;
795 Tgt_Name : Name_Id := No_Name;
800 while Proj /= No_Project loop
802 Value_Of (Name_Target, Proj.Decl.Attributes, Shared);
804 if Variable /= Nil_Variable_Value
805 and then not Variable.Default
806 and then Variable.Value /= No_Name
808 Tgt_Name := Variable.Value;
812 Proj := Proj.Extends;
813 end loop Project_Loop;
815 if Tgt_Name /= No_Name then
816 Selected_Target := new String'(Get_Name_String
(Tgt_Name
));
820 end Get_Project_Target
;
822 -----------------------
823 -- Default_File_Name --
824 -----------------------
826 function Default_File_Name
return String is
827 Ada_RTS
: constant String := Runtime_Name_For
(Name_Ada
);
831 if Selected_Target
'Length /= 0 then
832 if Ada_RTS
/= "" then
834 Selected_Target
.all & '-' &
835 Ada_RTS
& Config_Project_File_Extension
;
838 Selected_Target
.all & Config_Project_File_Extension
;
841 elsif Ada_RTS
/= "" then
842 return Ada_RTS
& Config_Project_File_Extension
;
845 Tmp
:= Getenv
(Config_Project_Env_Var
);
848 T
: constant String := Tmp
.all;
854 return Default_Config_Name
;
860 end Default_File_Name
;
866 procedure Do_Autoconf
is
867 Obj_Dir
: constant Variable_Value
:=
870 Conf_Project
.Decl
.Attributes
,
873 Gprconfig_Path
: String_Access
;
877 Gprconfig_Path
:= Locate_Exec_On_Path
(Gprconfig_Name
);
879 if Gprconfig_Path
= null then
881 ("could not locate gprconfig for auto-configuration");
884 -- First, find the object directory of the Conf_Project
886 if Obj_Dir
= Nil_Variable_Value
or else Obj_Dir
.Default
then
887 Get_Name_String
(Conf_Project
.Directory
.Display_Name
);
890 if Is_Absolute_Path
(Get_Name_String
(Obj_Dir
.Value
)) then
891 Get_Name_String
(Obj_Dir
.Value
);
895 Add_Str_To_Name_Buffer
896 (Get_Name_String
(Conf_Project
.Directory
.Display_Name
));
897 Add_Str_To_Name_Buffer
(Get_Name_String
(Obj_Dir
.Value
));
901 if Subdirs
/= null then
902 Add_Char_To_Name_Buffer
(Directory_Separator
);
903 Add_Str_To_Name_Buffer
(Subdirs
.all);
906 for J
in 1 .. Name_Len
loop
907 if Name_Buffer
(J
) = '/' then
908 Name_Buffer
(J
) := Directory_Separator
;
912 -- Make sure that Obj_Dir ends with a directory separator
914 if Name_Buffer
(Name_Len
) /= Directory_Separator
then
915 Name_Len
:= Name_Len
+ 1;
916 Name_Buffer
(Name_Len
) := Directory_Separator
;
920 Obj_Dir
: constant String := Name_Buffer
(1 .. Name_Len
);
921 Config_Switches
: Argument_List_Access
;
922 Db_Switches
: Argument_List_Access
;
923 Args
: Argument_List
(1 .. 5);
925 Obj_Dir_Exists
: Boolean := True;
928 -- Check if the object directory exists. If Setup_Projects is True
929 -- (-p) and directory does not exist, attempt to create it.
930 -- Otherwise, if directory does not exist, fail without calling
933 if not Is_Directory
(Obj_Dir
)
934 and then (Setup_Projects
or else Subdirs
/= null)
937 Create_Path
(Obj_Dir
);
939 if not Quiet_Output
then
940 Write_Str
("object directory """);
942 Write_Line
(""" created");
948 ("could not create object directory " & Obj_Dir
);
952 if not Is_Directory
(Obj_Dir
) then
953 case Env
.Flags
.Require_Obj_Dirs
is
956 ("object directory " & Obj_Dir
& " does not exist");
961 "?object directory " & Obj_Dir
& " does not exist");
962 Obj_Dir_Exists
:= False;
969 -- Get the config switches. This should be done only now, as some
970 -- runtimes may have been found if the Builder switches.
972 Config_Switches
:= Get_Config_Switches
;
974 -- Get eventual --db switches
976 Db_Switches
:= Get_Db_Switches
;
980 Args
(1) := new String'("--batch");
981 Args (2) := new String'("-o");
983 -- If no config file was specified, set the auto.cgpr one
985 if Conf_File_Name
'Length = 0 then
986 if Obj_Dir_Exists
then
987 Args
(3) := new String'(Obj_Dir & Auto_Cgpr);
991 Path_FD : File_Descriptor;
992 Path_Name : Path_Name_Type;
995 Prj.Env.Create_Temp_File
996 (Shared => Project_Tree.Shared,
998 Path_Name => Path_Name,
999 File_Use => "configuration file");
1001 if Path_FD /= Invalid_FD then
1003 Temp_Dir : constant String :=
1004 Containing_Directory
1005 (Get_Name_String (Path_Name));
1007 GNAT.OS_Lib.Close (Path_FD);
1009 new String'(Temp_Dir
&
1010 Directory_Separator
&
1012 Delete_File
(Get_Name_String
(Path_Name
));
1016 -- We'll have an error message later on
1018 Args
(3) := new String'(Obj_Dir & Auto_Cgpr);
1023 Args (3) := Conf_File_Name;
1026 if Normalized_Hostname = "" then
1029 if Selected_Target'Length = 0 then
1030 if At_Least_One_Compiler_Command then
1032 new String'("--target=all");
1035 new String'("--target=" & Normalized_Hostname);
1040 new String'("--target=" & Selected_Target
.all);
1046 if not Verbose_Mode
then
1047 Arg_Last
:= Arg_Last
+ 1;
1048 Args
(Arg_Last
) := new String'("-q");
1051 if Verbose_Mode then
1052 Write_Str (Gprconfig_Name);
1054 for J in 1 .. Arg_Last loop
1056 Write_Str (Args (J).all);
1059 for J in Config_Switches'Range loop
1061 Write_Str (Config_Switches (J).all);
1064 for J in Db_Switches'Range loop
1066 Write_Str (Db_Switches (J).all);
1071 elsif not Quiet_Output then
1072 -- Display no message if we are creating auto.cgpr, unless in
1075 if Config_File_Name'Length > 0
1076 or else Verbose_Mode
1078 Write_Str ("creating ");
1079 Write_Str (Simple_Name (Args (3).all));
1084 Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) &
1085 Config_Switches.all & Db_Switches.all,
1088 Free (Config_Switches);
1090 Config_File_Path := Locate_Config_File (Args (3).all);
1092 if Config_File_Path = null then
1093 Raise_Invalid_Config
1094 ("could not create " & Args (3).all);
1097 for F in Args'Range loop
1103 ---------------------
1104 -- Get_Db_Switches --
1105 ---------------------
1107 function Get_Db_Switches return Argument_List_Access is
1108 Result : Argument_List_Access;
1112 (2 * Db_Switch_Args.Last) + Boolean'Pos (not Load_Standard_Base);
1113 Result := new Argument_List (1 .. Nmb_Arg);
1115 if Nmb_Arg /= 0 then
1116 for J in 1 .. Db_Switch_Args.Last loop
1117 Result (2 * J - 1) :=
1118 new String'("--db");
1120 new String'(Get_Name_String (Db_Switch_Args.Table (J)));
1123 if not Load_Standard_Base then
1124 Result (Result'Last) := new String'("--db-");
1129 end Get_Db_Switches
;
1131 -------------------------
1132 -- Get_Config_Switches --
1133 -------------------------
1135 function Get_Config_Switches
return Argument_List_Access
is
1137 package Language_Htable
is new GNAT
.HTable
.Simple_HTable
1138 (Header_Num
=> Prj
.Header_Num
,
1140 No_Element
=> No_Name
,
1144 -- Hash table to keep the languages used in the project tree
1146 IDE
: constant Package_Id
:=
1147 Value_Of
(Name_Ide
, Project
.Decl
.Packages
, Shared
);
1149 procedure Add_Config_Switches_For_Project
1150 (Project
: Project_Id
;
1151 Tree
: Project_Tree_Ref
;
1152 With_State
: in out Integer);
1153 -- Add all --config switches for this project. This is also called
1154 -- for aggregate projects.
1156 -------------------------------------
1157 -- Add_Config_Switches_For_Project --
1158 -------------------------------------
1160 procedure Add_Config_Switches_For_Project
1161 (Project
: Project_Id
;
1162 Tree
: Project_Tree_Ref
;
1163 With_State
: in out Integer)
1165 pragma Unreferenced
(With_State
);
1167 Shared
: constant Shared_Project_Tree_Data_Access
:= Tree
.Shared
;
1169 Variable
: Variable_Value
;
1170 Check_Default
: Boolean;
1172 List
: String_List_Id
;
1173 Elem
: String_Element
;
1176 if Might_Have_Sources
(Project
) then
1178 Value_Of
(Name_Languages
, Project
.Decl
.Attributes
, Shared
);
1180 if Variable
= Nil_Variable_Value
or else Variable
.Default
then
1182 -- Languages is not declared. If it is not an extending
1183 -- project, or if it extends a project with no Languages,
1184 -- check for Default_Language.
1186 Check_Default
:= Project
.Extends
= No_Project
;
1188 if not Check_Default
then
1192 Project
.Extends
.Decl
.Attributes
,
1195 Variable
/= Nil_Variable_Value
1196 and then Variable
.Values
= Nil_String
;
1199 if Check_Default
then
1202 (Name_Default_Language
,
1203 Project
.Decl
.Attributes
,
1206 if Variable
/= Nil_Variable_Value
1207 and then not Variable
.Default
1209 Get_Name_String
(Variable
.Value
);
1210 To_Lower
(Name_Buffer
(1 .. Name_Len
));
1212 Language_Htable
.Set
(Lang
, Lang
);
1214 -- If no default language is declared, default to Ada
1217 Language_Htable
.Set
(Name_Ada
, Name_Ada
);
1221 elsif Variable
.Values
/= Nil_String
then
1223 -- Attribute Languages is declared with a non empty list:
1224 -- put all the languages in Language_HTable.
1226 List
:= Variable
.Values
;
1227 while List
/= Nil_String
loop
1228 Elem
:= Shared
.String_Elements
.Table
(List
);
1230 Get_Name_String
(Elem
.Value
);
1231 To_Lower
(Name_Buffer
(1 .. Name_Len
));
1233 Language_Htable
.Set
(Lang
, Lang
);
1239 end Add_Config_Switches_For_Project
;
1241 procedure For_Every_Imported_Project
is new For_Every_Project_Imported
1242 (State
=> Integer, Action
=> Add_Config_Switches_For_Project
);
1243 -- Document this procedure ???
1249 Result
: Argument_List_Access
;
1250 Variable
: Variable_Value
;
1251 Dummy
: Integer := 0;
1253 -- Start of processing for Get_Config_Switches
1256 For_Every_Imported_Project
1258 Tree
=> Project_Tree
,
1259 With_State
=> Dummy
,
1260 Include_Aggregated
=> True);
1262 Name
:= Language_Htable
.Get_First
;
1264 while Name
/= No_Name
loop
1266 Name
:= Language_Htable
.Get_Next
;
1269 Result
:= new String_List
(1 .. Count
);
1272 Name
:= Language_Htable
.Get_First
;
1273 while Name
/= No_Name
loop
1275 -- Check if IDE'Compiler_Command is declared for the language.
1276 -- If it is, use its value to invoke gprconfig.
1281 Attribute_Or_Array_Name
=> Name_Compiler_Command
,
1284 Force_Lower_Case_Index
=> True);
1287 Config_Command
: constant String :=
1288 "--config=" & Get_Name_String
(Name
);
1290 Runtime_Name
: constant String :=
1291 Runtime_Name_For
(Name
);
1294 if Variable
= Nil_Variable_Value
1295 or else Length_Of_Name
(Variable
.Value
) = 0
1298 new String'(Config_Command & ",," & Runtime_Name);
1301 At_Least_One_Compiler_Command := True;
1304 Compiler_Command : constant String :=
1305 Get_Name_String (Variable.Value);
1308 if Is_Absolute_Path (Compiler_Command) then
1311 (Config_Command
& ",," & Runtime_Name
& "," &
1312 Containing_Directory
(Compiler_Command
) & "," &
1313 Simple_Name
(Compiler_Command
));
1317 (Config_Command & ",," & Runtime_Name & ",," &
1325 Name := Language_Htable.Get_Next;
1329 end Get_Config_Switches;
1331 ------------------------
1332 -- Might_Have_Sources --
1333 ------------------------
1335 function Might_Have_Sources (Project : Project_Id) return Boolean is
1336 Variable : Variable_Value;
1342 Project.Decl.Attributes,
1345 if Variable = Nil_Variable_Value
1346 or else Variable.Default
1347 or else Variable.Values /= Nil_String
1352 Project.Decl.Attributes,
1354 return Variable = Nil_Variable_Value
1355 or else Variable.Default
1356 or else Variable.Values /= Nil_String;
1361 end Might_Have_Sources;
1364 Config_Project_Node : Project_Node_Id := Empty_Node;
1367 pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
1369 Free (Config_File_Path);
1370 Config := No_Project;
1373 Check_Builder_Switches;
1375 if Conf_File_Name'Length > 0 then
1376 Config_File_Path := Locate_Config_File (Conf_File_Name.all);
1378 Config_File_Path := Locate_Config_File (Default_File_Name);
1381 if Config_File_Path = null then
1382 if not Allow_Automatic_Generation
1383 and then Conf_File_Name'Length > 0
1385 Raise_Invalid_Config
1386 ("could not locate main configuration project "
1387 & Conf_File_Name.all);
1391 Automatically_Generated :=
1392 Allow_Automatic_Generation and then Config_File_Path = null;
1394 <<Process_Config_File>>
1396 if Automatically_Generated then
1397 if Hostparm.OpenVMS then
1399 -- There is no gprconfig on VMS
1401 Raise_Invalid_Config
1402 ("could not locate any configuration project file");
1405 -- This might raise an Invalid_Config exception
1410 -- If the config file is not auto-generated, warn if there is any --RTS
1411 -- switch, but not when the config file is generated in memory.
1413 elsif RTS_Languages.Get_First /= No_Name
1414 and then Opt.Warning_Mode /= Opt.Suppress
1415 and then On_Load_Config = null
1418 ("warning: --RTS is taken into account only in auto-configuration");
1421 -- Parse the configuration file
1423 if Verbose_Mode and then Config_File_Path /= null then
1424 Write_Str ("Checking configuration ");
1425 Write_Line (Config_File_Path.all);
1428 if On_Load_Config /= null then
1430 (Config_File => Config_Project_Node,
1431 Project_Node_Tree => Project_Node_Tree);
1433 elsif Config_File_Path /= null then
1435 (In_Tree => Project_Node_Tree,
1436 Project => Config_Project_Node,
1437 Project_File_Name => Config_File_Path.all,
1438 Errout_Handling => Prj.Part.Finalize_If_Error,
1439 Packages_To_Check => Packages_To_Check,
1440 Current_Directory => Current_Directory,
1441 Is_Config_File => True,
1444 Config_Project_Node := Empty_Node;
1447 if Config_Project_Node /= Empty_Node then
1448 Prj.Proc.Process_Project_Tree_Phase_1
1449 (In_Tree => Project_Tree,
1451 Packages_To_Check => Packages_To_Check,
1453 From_Project_Node => Config_Project_Node,
1454 From_Project_Node_Tree => Project_Node_Tree,
1456 Reset_Tree => False);
1459 if Config_Project_Node = Empty_Node
1460 or else Config = No_Project
1462 Raise_Invalid_Config
1463 ("processing of configuration project """
1464 & Config_File_Path.all & """ failed");
1467 -- Check that the target of the configuration file is the one the user
1468 -- specified on the command line. We do not need to check that when in
1469 -- auto-conf mode, since the appropriate target was passed to gprconfig.
1471 if not Automatically_Generated
1474 (Config, Autoconf_Specified, Project_Tree, Selected_Target.all)
1476 Automatically_Generated := True;
1477 goto Process_Config_File;
1479 end Get_Or_Create_Configuration_File;
1481 ------------------------
1482 -- Locate_Config_File --
1483 ------------------------
1485 function Locate_Config_File (Name : String) return String_Access is
1486 Prefix_Path : constant String := Executable_Prefix_Path;
1488 if Prefix_Path'Length /= 0 then
1489 return Locate_Regular_File
1491 "." & Path_Separator &
1492 Prefix_Path & "share" & Directory_Separator & "gpr");
1494 return Locate_Regular_File (Name, ".");
1496 end Locate_Config_File;
1498 --------------------
1499 -- Locate_Runtime --
1500 --------------------
1502 procedure Locate_Runtime
1503 (Language : Name_Id;
1504 Project_Tree : Prj.Project_Tree_Ref)
1506 function Is_Base_Name (Path : String) return Boolean;
1507 -- Returns True if Path has no directory separator
1513 function Is_Base_Name (Path : String) return Boolean is
1515 for I in Path'Range loop
1516 if Path (I) = Directory_Separator or else Path (I) = '/' then
1523 -- Local declarations
1525 function Find_Rts_In_Path is new Prj.Env.Find_Name_In_Path
1526 (Check_Filename => Is_Directory);
1528 RTS_Name : constant String := Runtime_Name_For (Language);
1530 Full_Path : String_Access;
1532 -- Start of processing for Locate_Runtime
1535 if not Is_Base_Name (RTS_Name) then
1537 Find_Rts_In_Path (Root_Environment.Project_Path, RTS_Name);
1539 if Full_Path = null then
1540 Fail_Program (Project_Tree, "cannot find RTS " & RTS_Name);
1543 Set_Runtime_For (Language, Normalize_Pathname (Full_Path.all));
1548 ------------------------------------
1549 -- Parse_Project_And_Apply_Config --
1550 ------------------------------------
1552 procedure Parse_Project_And_Apply_Config
1553 (Main_Project : out Prj.Project_Id;
1554 User_Project_Node : out Prj.Tree.Project_Node_Id;
1555 Config_File_Name : String := "";
1556 Autoconf_Specified : Boolean;
1557 Project_File_Name : String;
1558 Project_Tree : Prj.Project_Tree_Ref;
1559 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
1560 Env : in out Prj.Tree.Environment;
1561 Packages_To_Check : String_List_Access;
1562 Allow_Automatic_Generation : Boolean := True;
1563 Automatically_Generated : out Boolean;
1564 Config_File_Path : out String_Access;
1565 Target_Name : String := "";
1566 Normalized_Hostname : String;
1567 On_Load_Config : Config_File_Hook := null;
1568 Implicit_Project : Boolean := False)
1571 pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
1573 -- Parse the user project tree
1575 Prj.Initialize (Project_Tree);
1577 Main_Project := No_Project;
1578 Automatically_Generated := False;
1581 (In_Tree => Project_Node_Tree,
1582 Project => User_Project_Node,
1583 Project_File_Name => Project_File_Name,
1584 Errout_Handling => Prj.Part.Finalize_If_Error,
1585 Packages_To_Check => Packages_To_Check,
1586 Current_Directory => Current_Directory,
1587 Is_Config_File => False,
1589 Implicit_Project => Implicit_Project);
1591 if User_Project_Node = Empty_Node then
1592 User_Project_Node := Empty_Node;
1596 Process_Project_And_Apply_Config
1597 (Main_Project => Main_Project,
1598 User_Project_Node => User_Project_Node,
1599 Config_File_Name => Config_File_Name,
1600 Autoconf_Specified => Autoconf_Specified,
1601 Project_Tree => Project_Tree,
1602 Project_Node_Tree => Project_Node_Tree,
1604 Packages_To_Check => Packages_To_Check,
1605 Allow_Automatic_Generation => Allow_Automatic_Generation,
1606 Automatically_Generated => Automatically_Generated,
1607 Config_File_Path => Config_File_Path,
1608 Target_Name => Target_Name,
1609 Normalized_Hostname => Normalized_Hostname,
1610 On_Load_Config => On_Load_Config);
1611 end Parse_Project_And_Apply_Config;
1613 --------------------------------------
1614 -- Process_Project_And_Apply_Config --
1615 --------------------------------------
1617 procedure Process_Project_And_Apply_Config
1618 (Main_Project : out Prj.Project_Id;
1619 User_Project_Node : Prj.Tree.Project_Node_Id;
1620 Config_File_Name : String := "";
1621 Autoconf_Specified : Boolean;
1622 Project_Tree : Prj.Project_Tree_Ref;
1623 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
1624 Env : in out Prj.Tree.Environment;
1625 Packages_To_Check : String_List_Access;
1626 Allow_Automatic_Generation : Boolean := True;
1627 Automatically_Generated : out Boolean;
1628 Config_File_Path : out String_Access;
1629 Target_Name : String := "";
1630 Normalized_Hostname : String;
1631 On_Load_Config : Config_File_Hook := null;
1632 Reset_Tree : Boolean := True)
1634 Shared : constant Shared_Project_Tree_Data_Access :=
1635 Project_Tree.Shared;
1636 Main_Config_Project : Project_Id;
1639 Conf_Project : Project_Id := No_Project;
1640 -- The object directory of this project is used to store the config
1641 -- project file in auto-configuration. Set by Check_Project below.
1643 procedure Check_Project (Project : Project_Id);
1644 -- Look for a non aggregate project. If one is found, put its project Id
1651 procedure Check_Project (Project : Project_Id) is
1653 if Project.Qualifier = Aggregate
1655 Project.Qualifier = Aggregate_Library
1658 List : Aggregated_Project_List := Project.Aggregated_Projects;
1661 -- Look for a non aggregate project until one is found
1663 while Conf_Project = No_Project and then List /= null loop
1664 Check_Project (List.Project);
1670 Conf_Project := Project;
1674 -- Start of processing for Process_Project_And_Apply_Config
1677 Main_Project := No_Project;
1678 Automatically_Generated := False;
1680 Process_Project_Tree_Phase_1
1681 (In_Tree => Project_Tree,
1682 Project => Main_Project,
1683 Packages_To_Check => Packages_To_Check,
1685 From_Project_Node => User_Project_Node,
1686 From_Project_Node_Tree => Project_Node_Tree,
1688 Reset_Tree => Reset_Tree);
1691 Main_Project := No_Project;
1695 if Project_Tree.Source_Info_File_Name /= null then
1696 if not Is_Absolute_Path (Project_Tree.Source_Info_File_Name.all) then
1698 Obj_Dir : constant Variable_Value :=
1701 Main_Project.Decl.Attributes,
1705 if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
1706 Get_Name_String (Main_Project.Directory.Display_Name);
1709 if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
1710 Get_Name_String (Obj_Dir.Value);
1714 Add_Str_To_Name_Buffer
1715 (Get_Name_String (Main_Project.Directory.Display_Name));
1716 Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
1720 Add_Char_To_Name_Buffer (Directory_Separator);
1721 Add_Str_To_Name_Buffer (Project_Tree.Source_Info_File_Name.all);
1722 Free (Project_Tree.Source_Info_File_Name);
1723 Project_Tree.Source_Info_File_Name :=
1724 new String'(Name_Buffer
(1 .. Name_Len
));
1728 Read_Source_Info_File
(Project_Tree
);
1731 -- Get the first project that is not an aggregate project or an
1732 -- aggregate library project. The object directory of this project will
1733 -- be used to store the config project file in auto-configuration.
1735 Check_Project
(Main_Project
);
1737 -- Fail if there is only aggregate projects and aggregate library
1738 -- projects in the project tree.
1740 if Conf_Project
= No_Project
then
1741 Raise_Invalid_Config
("there are no non-aggregate projects");
1744 -- Find configuration file
1746 Get_Or_Create_Configuration_File
1747 (Config
=> Main_Config_Project
,
1748 Project
=> Main_Project
,
1749 Conf_Project
=> Conf_Project
,
1750 Project_Tree
=> Project_Tree
,
1751 Project_Node_Tree
=> Project_Node_Tree
,
1753 Allow_Automatic_Generation
=> Allow_Automatic_Generation
,
1754 Config_File_Name
=> Config_File_Name
,
1755 Autoconf_Specified
=> Autoconf_Specified
,
1756 Target_Name
=> Target_Name
,
1757 Normalized_Hostname
=> Normalized_Hostname
,
1758 Packages_To_Check
=> Packages_To_Check
,
1759 Config_File_Path
=> Config_File_Path
,
1760 Automatically_Generated
=> Automatically_Generated
,
1761 On_Load_Config
=> On_Load_Config
);
1763 Apply_Config_File
(Main_Config_Project
, Project_Tree
);
1765 -- Finish processing the user's project
1767 Prj
.Proc
.Process_Project_Tree_Phase_2
1768 (In_Tree
=> Project_Tree
,
1769 Project
=> Main_Project
,
1771 From_Project_Node
=> User_Project_Node
,
1772 From_Project_Node_Tree
=> Project_Node_Tree
,
1776 if Project_Tree
.Source_Info_File_Name
/= null
1777 and then not Project_Tree
.Source_Info_File_Exists
1779 Write_Source_Info_File
(Project_Tree
);
1783 Main_Project
:= No_Project
;
1785 end Process_Project_And_Apply_Config
;
1787 --------------------------
1788 -- Raise_Invalid_Config --
1789 --------------------------
1791 procedure Raise_Invalid_Config
(Msg
: String) is
1793 Raise_Exception
(Invalid_Config
'Identity, Msg
);
1794 end Raise_Invalid_Config
;
1796 ----------------------
1797 -- Runtime_Name_For --
1798 ----------------------
1800 function Runtime_Name_For
(Language
: Name_Id
) return String is
1802 if RTS_Languages
.Get
(Language
) /= No_Name
then
1803 return Get_Name_String
(RTS_Languages
.Get
(Language
));
1807 end Runtime_Name_For
;
1809 --------------------------
1810 -- Runtime_Name_Set_For --
1811 --------------------------
1813 function Runtime_Name_Set_For
(Language
: Name_Id
) return Boolean is
1815 return RTS_Languages
.Get
(Language
) /= No_Name
;
1816 end Runtime_Name_Set_For
;
1818 ---------------------
1819 -- Set_Runtime_For --
1820 ---------------------
1822 procedure Set_Runtime_For
(Language
: Name_Id
; RTS_Name
: String) is
1824 Name_Len
:= RTS_Name
'Length;
1825 Name_Buffer
(1 .. Name_Len
) := RTS_Name
;
1826 RTS_Languages
.Set
(Language
, Name_Find
);
1827 end Set_Runtime_For
;