1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2006-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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Ada.Directories; use Ada.Directories;
28 with GNAT.HTable; use GNAT.HTable;
29 with Makeutl; use Makeutl;
31 with Output; use Output;
33 with Prj.Proc; use Prj.Proc;
34 with Prj.Tree; use Prj.Tree;
35 with Prj.Util; use Prj.Util;
38 with Snames; use Snames;
39 with System.Case_Util; use System.Case_Util;
42 package body Prj.Conf is
44 Auto_Cgpr : constant String := "auto.cgpr";
46 Default_Name : constant String := "default.cgpr";
47 -- Default configuration file that will be used if found
49 Config_Project_Env_Var : constant String := "GPR_CONFIG";
50 -- Name of the environment variable that provides the name of the
51 -- configuration file to use.
53 Gprconfig_Name : constant String := "gprconfig";
55 package RTS_Languages is new GNAT.HTable.Simple_HTable
56 (Header_Num => Prj.Header_Num,
58 No_Element => No_Name,
62 -- Stores the runtime names for the various languages. This is in general
63 -- set from a --RTS command line option.
65 procedure Add_Attributes
66 (Project_Tree : Project_Tree_Ref;
67 Conf_Decl : Declarations;
68 User_Decl : in out Declarations);
69 -- Process the attributes in the config declarations.
70 -- For single string values, if the attribute is not declared in the user
71 -- declarations, declare it with the value in the config declarations.
72 -- For string list values, prepend the value in the user declarations with
73 -- the value in the config declarations.
75 function Locate_Config_File (Name : String) return String_Access;
76 -- Search for Name in the config files directory. Return full path if
77 -- found, or null otherwise
80 (Config_File : Prj.Project_Id;
81 Autoconf_Specified : Boolean;
82 Project_Tree : Prj.Project_Tree_Ref;
83 Target : String := "") return Boolean;
84 -- Check that the config file's target matches Target.
85 -- Target should be set to the empty string when the user did not specify
86 -- a target. If the target in the configuration file is invalid, this
87 -- function will raise Invalid_Config with an appropriate message.
88 -- Autoconf_Specified should be set to True if the user has used --autoconf
94 procedure Add_Attributes
95 (Project_Tree : Project_Tree_Ref;
96 Conf_Decl : Declarations;
97 User_Decl : in out Declarations)
99 Conf_Attr_Id : Variable_Id;
100 Conf_Attr : Variable;
101 Conf_Array_Id : Array_Id;
102 Conf_Array : Array_Data;
103 Conf_Array_Elem_Id : Array_Element_Id;
104 Conf_Array_Elem : Array_Element;
105 Conf_List : String_List_Id;
106 Conf_List_Elem : String_Element;
108 User_Attr_Id : Variable_Id;
109 User_Attr : Variable;
110 User_Array_Id : Array_Id;
111 User_Array : Array_Data;
112 User_Array_Elem_Id : Array_Element_Id;
113 User_Array_Elem : Array_Element;
116 Conf_Attr_Id := Conf_Decl.Attributes;
117 User_Attr_Id := User_Decl.Attributes;
118 while Conf_Attr_Id /= No_Variable loop
120 Project_Tree.Variable_Elements.Table (Conf_Attr_Id);
122 Project_Tree.Variable_Elements.Table (User_Attr_Id);
124 if not Conf_Attr.Value.Default then
125 if User_Attr.Value.Default then
127 -- No attribute declared in user project file: just copy the
128 -- value of the configuration attribute.
130 User_Attr.Value := Conf_Attr.Value;
131 Project_Tree.Variable_Elements.Table (User_Attr_Id) :=
134 elsif User_Attr.Value.Kind = List
135 and then Conf_Attr.Value.Values /= Nil_String
137 -- List attribute declared in both the user project and the
138 -- configuration project: prepend the user list with the
139 -- configuration list.
142 Conf_List : String_List_Id := Conf_Attr.Value.Values;
143 Conf_Elem : String_Element;
144 User_List : constant String_List_Id :=
145 User_Attr.Value.Values;
146 New_List : String_List_Id;
147 New_Elem : String_Element;
152 String_Element_Table.Increment_Last
153 (Project_Tree.String_Elements);
154 New_List := String_Element_Table.Last
155 (Project_Tree.String_Elements);
157 -- Value of attribute is new list
159 User_Attr.Value.Values := New_List;
160 Project_Tree.Variable_Elements.Table (User_Attr_Id) :=
165 -- Get each element of configuration list
168 Project_Tree.String_Elements.Table (Conf_List);
169 New_Elem := Conf_Elem;
170 Conf_List := Conf_Elem.Next;
172 if Conf_List = Nil_String then
174 -- If it is the last element in the list, connect to
175 -- first element of user list, and we are done.
177 New_Elem.Next := User_List;
178 Project_Tree.String_Elements.Table
179 (New_List) := New_Elem;
183 -- If it is not the last element in the list, add to
186 String_Element_Table.Increment_Last
187 (Project_Tree.String_Elements);
189 String_Element_Table.Last
190 (Project_Tree.String_Elements);
191 Project_Tree.String_Elements.Table
192 (New_List) := New_Elem;
193 New_List := New_Elem.Next;
200 Conf_Attr_Id := Conf_Attr.Next;
201 User_Attr_Id := User_Attr.Next;
204 Conf_Array_Id := Conf_Decl.Arrays;
205 while Conf_Array_Id /= No_Array loop
206 Conf_Array := Project_Tree.Arrays.Table (Conf_Array_Id);
208 User_Array_Id := User_Decl.Arrays;
209 while User_Array_Id /= No_Array loop
210 User_Array := Project_Tree.Arrays.Table (User_Array_Id);
211 exit when User_Array.Name = Conf_Array.Name;
212 User_Array_Id := User_Array.Next;
215 -- If this associative array does not exist in the user project file,
216 -- do a shallow copy of the full associative array.
218 if User_Array_Id = No_Array then
219 Array_Table.Increment_Last (Project_Tree.Arrays);
220 User_Array := Conf_Array;
221 User_Array.Next := User_Decl.Arrays;
222 User_Decl.Arrays := Array_Table.Last (Project_Tree.Arrays);
223 Project_Tree.Arrays.Table (User_Decl.Arrays) := User_Array;
226 -- Otherwise, check each array element
228 Conf_Array_Elem_Id := Conf_Array.Value;
229 while Conf_Array_Elem_Id /= No_Array_Element loop
231 Project_Tree.Array_Elements.Table (Conf_Array_Elem_Id);
233 User_Array_Elem_Id := User_Array.Value;
234 while User_Array_Elem_Id /= No_Array_Element loop
236 Project_Tree.Array_Elements.Table (User_Array_Elem_Id);
237 exit when User_Array_Elem.Index = Conf_Array_Elem.Index;
238 User_Array_Elem_Id := User_Array_Elem.Next;
241 -- If the array element does not exist in the user array,
242 -- insert a shallow copy of the conf array element in the
245 if User_Array_Elem_Id = No_Array_Element then
246 Array_Element_Table.Increment_Last
247 (Project_Tree.Array_Elements);
248 User_Array_Elem := Conf_Array_Elem;
249 User_Array_Elem.Next := User_Array.Value;
251 Array_Element_Table.Last (Project_Tree.Array_Elements);
252 Project_Tree.Array_Elements.Table (User_Array.Value) :=
254 Project_Tree.Arrays.Table (User_Array_Id) := User_Array;
256 -- Otherwise, if the value is a string list, prepend the
257 -- user array element with the conf array element value.
259 elsif Conf_Array_Elem.Value.Kind = List then
260 Conf_List := Conf_Array_Elem.Value.Values;
262 if Conf_List /= Nil_String then
264 Link : constant String_List_Id :=
265 User_Array_Elem.Value.Values;
266 Previous : String_List_Id := Nil_String;
267 Next : String_List_Id;
272 Project_Tree.String_Elements.Table
274 String_Element_Table.Increment_Last
275 (Project_Tree.String_Elements);
277 String_Element_Table.Last
278 (Project_Tree.String_Elements);
279 Project_Tree.String_Elements.Table (Next) :=
282 if Previous = Nil_String then
283 User_Array_Elem.Value.Values := Next;
284 Project_Tree.Array_Elements.Table
285 (User_Array_Elem_Id) := User_Array_Elem;
288 Project_Tree.String_Elements.Table
289 (Previous).Next := Next;
294 Conf_List := Conf_List_Elem.Next;
296 if Conf_List = Nil_String then
297 Project_Tree.String_Elements.Table
298 (Previous).Next := Link;
306 Conf_Array_Elem_Id := Conf_Array_Elem.Next;
310 Conf_Array_Id := Conf_Array.Next;
314 ------------------------
315 -- Locate_Config_File --
316 ------------------------
318 function Locate_Config_File (Name : String) return String_Access is
319 Prefix_Path : constant String := Executable_Prefix_Path;
321 if Prefix_Path'Length /= 0 then
322 return Locate_Regular_File
324 "." & Path_Separator &
325 Prefix_Path & "share" & Directory_Separator & "gpr");
327 return Locate_Regular_File (Name, ".");
329 end Locate_Config_File;
335 function Check_Target
336 (Config_File : Project_Id;
337 Autoconf_Specified : Boolean;
338 Project_Tree : Prj.Project_Tree_Ref;
339 Target : String := "") return Boolean
341 Variable : constant Variable_Value :=
343 (Name_Target, Config_File.Decl.Attributes, Project_Tree);
344 Tgt_Name : Name_Id := No_Name;
348 if Variable /= Nil_Variable_Value and then not Variable.Default then
349 Tgt_Name := Variable.Value;
353 OK := not Autoconf_Specified or Tgt_Name = No_Name;
355 OK := Tgt_Name /= No_Name
356 and then Target = Get_Name_String (Tgt_Name);
360 if Autoconf_Specified then
362 Write_Line ("inconsistent targets, performing autoconf");
368 if Tgt_Name /= No_Name then
370 with "invalid target name """
371 & Get_Name_String (Tgt_Name) & """ in configuration";
375 with "no target specified in configuration file";
383 --------------------------------------
384 -- Get_Or_Create_Configuration_File --
385 --------------------------------------
387 procedure Get_Or_Create_Configuration_File
388 (Project : Project_Id;
389 Project_Tree : Project_Tree_Ref;
390 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
391 Allow_Automatic_Generation : Boolean;
392 Config_File_Name : String := "";
393 Autoconf_Specified : Boolean;
394 Target_Name : String := "";
395 Normalized_Hostname : String;
396 Packages_To_Check : String_List_Access := null;
397 Config : out Prj.Project_Id;
398 Config_File_Path : out String_Access;
399 Automatically_Generated : out Boolean;
400 On_Load_Config : Config_File_Hook := null)
402 function Default_File_Name return String;
403 -- Return the name of the default config file that should be tested
405 procedure Do_Autoconf;
406 -- Generate a new config file through gprconfig.
407 -- In case of error, this raises the Invalid_Config exception with an
408 -- appropriate message
410 function Get_Config_Switches return Argument_List_Access;
411 -- Return the --config switches to use for gprconfig
413 function Might_Have_Sources (Project : Project_Id) return Boolean;
414 -- True if the specified project might have sources (ie the user has not
415 -- explicitly specified it. We haven't checked the file system, nor do
416 -- we need to at this stage.
418 -----------------------
419 -- Default_File_Name --
420 -----------------------
422 function Default_File_Name return String is
423 Ada_RTS : constant String := Runtime_Name_For (Name_Ada);
427 if Target_Name /= "" then
428 if Ada_RTS /= "" then
429 return Target_Name & '-' & Ada_RTS
430 & Config_Project_File_Extension;
432 return Target_Name & Config_Project_File_Extension;
435 elsif Ada_RTS /= "" then
436 return Ada_RTS & Config_Project_File_Extension;
439 Tmp := Getenv (Config_Project_Env_Var);
442 T : constant String := Tmp.all;
453 end Default_File_Name;
455 ------------------------
456 -- Might_Have_Sources --
457 ------------------------
459 function Might_Have_Sources (Project : Project_Id) return Boolean is
460 Variable : Variable_Value;
466 Project.Decl.Attributes,
469 if Variable = Nil_Variable_Value
470 or else Variable.Default
471 or else Variable.Values /= Nil_String
476 Project.Decl.Attributes,
478 return Variable = Nil_Variable_Value
479 or else Variable.Default
480 or else Variable.Values /= Nil_String;
485 end Might_Have_Sources;
487 -------------------------
488 -- Get_Config_Switches --
489 -------------------------
491 function Get_Config_Switches return Argument_List_Access is
492 package Language_Htable is new GNAT.HTable.Simple_HTable
493 (Header_Num => Prj.Header_Num,
495 No_Element => No_Name,
499 -- Hash table to keep the languages used in the project tree
501 IDE : constant Package_Id :=
504 Project.Decl.Packages,
507 Prj_Iter : Project_List;
508 List : String_List_Id;
509 Elem : String_Element;
511 Variable : Variable_Value;
514 Result : Argument_List_Access;
517 Prj_Iter := Project_Tree.Projects;
518 while Prj_Iter /= null loop
519 if Might_Have_Sources (Prj_Iter.Project) then
523 Prj_Iter.Project.Decl.Attributes,
526 if Variable = Nil_Variable_Value
527 or else Variable.Default
529 -- Languages is not declared. If it is not an extending
530 -- project, check for Default_Language
532 if Prj_Iter.Project.Extends = No_Project then
535 (Name_Default_Language,
536 Prj_Iter.Project.Decl.Attributes,
539 if Variable /= Nil_Variable_Value
540 and then not Variable.Default
542 Get_Name_String (Variable.Value);
543 To_Lower (Name_Buffer (1 .. Name_Len));
545 Language_Htable.Set (Lang, Lang);
548 -- If no language is declared, default to Ada
550 Language_Htable.Set (Name_Ada, Name_Ada);
554 elsif Variable.Values /= Nil_String then
556 -- Attribute Languages is declared with a non empty
557 -- list: put all the languages in Language_HTable.
559 List := Variable.Values;
560 while List /= Nil_String loop
561 Elem := Project_Tree.String_Elements.Table (List);
563 Get_Name_String (Elem.Value);
564 To_Lower (Name_Buffer (1 .. Name_Len));
566 Language_Htable.Set (Lang, Lang);
573 Prj_Iter := Prj_Iter.Next;
576 Name := Language_Htable.Get_First;
578 while Name /= No_Name loop
580 Name := Language_Htable.Get_Next;
583 Result := new String_List (1 .. Count);
586 Name := Language_Htable.Get_First;
587 while Name /= No_Name loop
588 -- Check if IDE'Compiler_Command is declared for the language.
589 -- If it is, use its value to invoke gprconfig.
594 Attribute_Or_Array_Name => Name_Compiler_Command,
596 In_Tree => Project_Tree,
597 Force_Lower_Case_Index => True);
600 Config_Command : constant String :=
601 "--config=" & Get_Name_String (Name);
603 Runtime_Name : constant String :=
604 Runtime_Name_For (Name);
607 if Variable = Nil_Variable_Value
608 or else Length_Of_Name (Variable.Value) = 0
611 new String'(Config_Command & ",," & Runtime_Name);
615 Compiler_Command : constant String :=
616 Get_Name_String (Variable.Value);
619 if Is_Absolute_Path (Compiler_Command) then
622 (Config_Command & ",," & Runtime_Name & "," &
623 Containing_Directory (Compiler_Command) & "," &
624 Simple_Name (Compiler_Command));
628 (Config_Command & ",," & Runtime_Name & ",," &
636 Name := Language_Htable.Get_Next;
640 end Get_Config_Switches;
646 procedure Do_Autoconf is
647 Obj_Dir : constant Variable_Value :=
650 Project.Decl.Attributes,
653 Gprconfig_Path : String_Access;
657 Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
659 if Gprconfig_Path = null then
661 with "could not locate gprconfig for auto-configuration";
664 -- First, find the object directory of the user's project
666 if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
667 Get_Name_String (Project.Directory.Name);
670 if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
671 Get_Name_String (Obj_Dir.Value);
675 Add_Str_To_Name_Buffer
676 (Get_Name_String (Project.Directory.Name));
677 Add_Char_To_Name_Buffer (Directory_Separator);
678 Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
682 if Subdirs /= null then
683 Add_Char_To_Name_Buffer (Directory_Separator);
684 Add_Str_To_Name_Buffer (Subdirs.all);
687 for J in 1 .. Name_Len loop
688 if Name_Buffer (J) = '/' then
689 Name_Buffer (J) := Directory_Separator;
694 Obj_Dir : constant String := Name_Buffer (1 .. Name_Len);
695 Switches : Argument_List_Access := Get_Config_Switches;
696 Args : Argument_List (1 .. 5);
700 -- Check if the object directory exists. If Setup_Projects is True
701 -- (-p) and directory does not exist, attempt to create it.
702 -- Otherwise, if directory does not exist, fail without calling
705 if not Is_Directory (Obj_Dir)
706 and then (Setup_Projects or Subdirs /= null)
709 Create_Path (Obj_Dir);
711 if not Quiet_Output then
712 Write_Str ("object directory """);
714 Write_Line (""" created");
720 with "could not create object directory " & Obj_Dir;
724 if not Is_Directory (Obj_Dir) then
726 with "object directory " & Obj_Dir & " does not exist";
731 Args (1) := new String'("--batch");
732 Args (2) := new String'("-o");
734 -- If no config file was specified, set the auto.cgpr one
736 if Config_File_Name = "" then
737 Args (3) := new String'
738 (Obj_Dir & Directory_Separator & Auto_Cgpr);
740 Args (3) := new String'(Config_File_Name);
743 if Normalized_Hostname = "" then
746 if Target_Name = "" then
747 Args (4) := new String'("--target=" & Normalized_Hostname);
749 Args (4) := new String'("--target=" & Target_Name);
755 if not Verbose_Mode then
756 Arg_Last := Arg_Last + 1;
757 Args (Arg_Last) := new String'("-q");
761 Write_Str (Gprconfig_Name);
763 for J in 1 .. Arg_Last loop
765 Write_Str (Args (J).all);
768 for J in Switches'Range loop
770 Write_Str (Switches (J).all);
775 elsif not Quiet_Output then
776 Write_Str ("creating ");
777 Write_Str (Simple_Name (Args (3).all));
781 Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) & Switches.all,
786 Config_File_Path := Locate_Config_File (Args (3).all);
788 if Config_File_Path = null then
790 with "could not create " & Args (3).all;
793 for F in Args'Range loop
800 Config_Project_Node : Project_Node_Id := Empty_Node;
803 Free (Config_File_Path);
805 if Config_File_Name /= "" then
806 Config_File_Path := Locate_Config_File (Config_File_Name);
808 Config_File_Path := Locate_Config_File (Default_File_Name);
811 if Config_File_Path = null then
812 if (not Allow_Automatic_Generation) and then
813 Config_File_Name /= ""
816 with "could not locate main configuration project "
821 Automatically_Generated :=
822 Allow_Automatic_Generation and then Config_File_Path = null;
824 <<Process_Config_File>>
826 if Automatically_Generated then
827 -- This might raise an Invalid_Config exception
831 -- Parse the configuration file
834 Write_Str ("Checking configuration ");
835 Write_Line (Config_File_Path.all);
839 (In_Tree => Project_Node_Tree,
840 Project => Config_Project_Node,
841 Project_File_Name => Config_File_Path.all,
842 Always_Errout_Finalize => False,
843 Packages_To_Check => Packages_To_Check,
844 Current_Directory => Current_Directory,
845 Is_Config_File => True);
847 if Config_Project_Node /= Empty_Node then
849 if On_Load_Config /= null then
851 (Config_File => Config_Project_Node,
852 Project_Node_Tree => Project_Node_Tree);
855 Prj.Proc.Process_Project_Tree_Phase_1
856 (In_Tree => Project_Tree,
859 From_Project_Node => Config_Project_Node,
860 From_Project_Node_Tree => Project_Node_Tree,
861 Report_Error => null,
862 Reset_Tree => False);
865 if Config_Project_Node = Empty_Node
866 or else Config = No_Project
869 with "processing of configuration project """
870 & Config_File_Path.all & """ failed";
873 -- Check that the target of the configuration file is the one the user
874 -- specified on the command line. We do not need to check that when in
875 -- auto-conf mode, since the appropriate target was passed to gprconfig.
877 if not Automatically_Generated
879 (Config, Autoconf_Specified, Project_Tree, Target_Name)
881 Automatically_Generated := True;
882 goto Process_Config_File;
884 end Get_Or_Create_Configuration_File;
886 --------------------------------------
887 -- Process_Project_And_Apply_Config --
888 --------------------------------------
890 procedure Process_Project_And_Apply_Config
891 (Main_Project : out Prj.Project_Id;
892 User_Project_Node : Prj.Tree.Project_Node_Id;
893 Config_File_Name : String := "";
894 Autoconf_Specified : Boolean;
895 Project_Tree : Prj.Project_Tree_Ref;
896 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
897 Packages_To_Check : String_List_Access;
898 Allow_Automatic_Generation : Boolean := True;
899 Automatically_Generated : out Boolean;
900 Config_File_Path : out String_Access;
901 Target_Name : String := "";
902 Normalized_Hostname : String;
903 Report_Error : Put_Line_Access := null;
904 On_Load_Config : Config_File_Hook := null)
906 Main_Config_Project : Project_Id;
910 Main_Project := No_Project;
911 Automatically_Generated := False;
913 Process_Project_Tree_Phase_1
914 (In_Tree => Project_Tree,
915 Project => Main_Project,
917 From_Project_Node => User_Project_Node,
918 From_Project_Node_Tree => Project_Node_Tree,
919 Report_Error => Report_Error);
922 Main_Project := No_Project;
926 -- Find configuration file
928 Get_Or_Create_Configuration_File
929 (Config => Main_Config_Project,
930 Project => Main_Project,
931 Project_Tree => Project_Tree,
932 Project_Node_Tree => Project_Node_Tree,
933 Allow_Automatic_Generation => Allow_Automatic_Generation,
934 Config_File_Name => Config_File_Name,
935 Autoconf_Specified => Autoconf_Specified,
936 Target_Name => Target_Name,
937 Normalized_Hostname => Normalized_Hostname,
938 Packages_To_Check => Packages_To_Check,
939 Config_File_Path => Config_File_Path,
940 Automatically_Generated => Automatically_Generated,
941 On_Load_Config => On_Load_Config);
943 Apply_Config_File (Main_Config_Project, Project_Tree);
945 -- Finish processing the user's project
947 Sinput.P.Reset_First;
949 Prj.Proc.Process_Project_Tree_Phase_2
950 (In_Tree => Project_Tree,
951 Project => Main_Project,
953 From_Project_Node => User_Project_Node,
954 From_Project_Node_Tree => Project_Node_Tree,
955 Report_Error => Report_Error,
956 Current_Dir => Current_Directory,
957 When_No_Sources => Warning,
958 Is_Config_File => False);
961 Main_Project := No_Project;
963 end Process_Project_And_Apply_Config;
965 ------------------------------------
966 -- Parse_Project_And_Apply_Config --
967 ------------------------------------
969 procedure Parse_Project_And_Apply_Config
970 (Main_Project : out Prj.Project_Id;
971 User_Project_Node : out Prj.Tree.Project_Node_Id;
972 Config_File_Name : String := "";
973 Autoconf_Specified : Boolean;
974 Project_File_Name : String;
975 Project_Tree : Prj.Project_Tree_Ref;
976 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
977 Packages_To_Check : String_List_Access;
978 Allow_Automatic_Generation : Boolean := True;
979 Automatically_Generated : out Boolean;
980 Config_File_Path : out String_Access;
981 Target_Name : String := "";
982 Normalized_Hostname : String;
983 Report_Error : Put_Line_Access := null;
984 On_Load_Config : Config_File_Hook := null)
987 -- Parse the user project tree
989 Prj.Tree.Initialize (Project_Node_Tree);
990 Prj.Initialize (Project_Tree);
992 Main_Project := No_Project;
993 Automatically_Generated := False;
996 (In_Tree => Project_Node_Tree,
997 Project => User_Project_Node,
998 Project_File_Name => Project_File_Name,
999 Always_Errout_Finalize => False,
1000 Packages_To_Check => Packages_To_Check,
1001 Current_Directory => Current_Directory,
1002 Is_Config_File => False);
1004 if User_Project_Node = Empty_Node then
1005 User_Project_Node := Empty_Node;
1009 Process_Project_And_Apply_Config
1010 (Main_Project => Main_Project,
1011 User_Project_Node => User_Project_Node,
1012 Config_File_Name => Config_File_Name,
1013 Autoconf_Specified => Autoconf_Specified,
1014 Project_Tree => Project_Tree,
1015 Project_Node_Tree => Project_Node_Tree,
1016 Packages_To_Check => Packages_To_Check,
1017 Allow_Automatic_Generation => Allow_Automatic_Generation,
1018 Automatically_Generated => Automatically_Generated,
1019 Config_File_Path => Config_File_Path,
1020 Target_Name => Target_Name,
1021 Normalized_Hostname => Normalized_Hostname,
1022 Report_Error => Report_Error,
1023 On_Load_Config => On_Load_Config);
1024 end Parse_Project_And_Apply_Config;
1026 -----------------------
1027 -- Apply_Config_File --
1028 -----------------------
1030 procedure Apply_Config_File
1031 (Config_File : Prj.Project_Id;
1032 Project_Tree : Prj.Project_Tree_Ref)
1034 Conf_Decl : constant Declarations := Config_File.Decl;
1035 Conf_Pack_Id : Package_Id;
1036 Conf_Pack : Package_Element;
1038 User_Decl : Declarations;
1039 User_Pack_Id : Package_Id;
1040 User_Pack : Package_Element;
1041 Proj : Project_List;
1044 Proj := Project_Tree.Projects;
1045 while Proj /= null loop
1046 if Proj.Project /= Config_File then
1047 User_Decl := Proj.Project.Decl;
1049 (Project_Tree => Project_Tree,
1050 Conf_Decl => Conf_Decl,
1051 User_Decl => User_Decl);
1053 Conf_Pack_Id := Conf_Decl.Packages;
1054 while Conf_Pack_Id /= No_Package loop
1055 Conf_Pack := Project_Tree.Packages.Table (Conf_Pack_Id);
1057 User_Pack_Id := User_Decl.Packages;
1058 while User_Pack_Id /= No_Package loop
1059 User_Pack := Project_Tree.Packages.Table (User_Pack_Id);
1060 exit when User_Pack.Name = Conf_Pack.Name;
1061 User_Pack_Id := User_Pack.Next;
1064 if User_Pack_Id = No_Package then
1065 Package_Table.Increment_Last (Project_Tree.Packages);
1066 User_Pack := Conf_Pack;
1067 User_Pack.Next := User_Decl.Packages;
1068 User_Decl.Packages :=
1069 Package_Table.Last (Project_Tree.Packages);
1070 Project_Tree.Packages.Table (User_Decl.Packages) :=
1075 (Project_Tree => Project_Tree,
1076 Conf_Decl => Conf_Pack.Decl,
1077 User_Decl => Project_Tree.Packages.Table
1078 (User_Pack_Id).Decl);
1081 Conf_Pack_Id := Conf_Pack.Next;
1084 Proj.Project.Decl := User_Decl;
1089 end Apply_Config_File;
1091 ---------------------
1092 -- Set_Runtime_For --
1093 ---------------------
1095 procedure Set_Runtime_For (Language : Name_Id; RTS_Name : String) is
1097 Name_Len := RTS_Name'Length;
1098 Name_Buffer (1 .. Name_Len) := RTS_Name;
1099 RTS_Languages.Set (Language, Name_Find);
1100 end Set_Runtime_For;
1102 ----------------------
1103 -- Runtime_Name_For --
1104 ----------------------
1106 function Runtime_Name_For (Language : Name_Id) return String is
1108 if RTS_Languages.Get (Language) /= No_Name then
1109 return Get_Name_String (RTS_Languages.Get (Language));
1113 end Runtime_Name_For;