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 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.Directories; use Ada.Directories;
27 with GNAT.HTable; use GNAT.HTable;
28 with Makeutl; use Makeutl;
31 with Output; use Output;
36 with Prj.Proc; use Prj.Proc;
37 with Prj.Tree; use Prj.Tree;
38 with Prj.Util; use Prj.Util;
40 with Snames; use Snames;
41 with System.Case_Util; use System.Case_Util;
44 package body Prj.Conf is
46 Auto_Cgpr : constant String := "auto.cgpr";
48 Default_Name : constant String := "default.cgpr";
49 -- Default configuration file that will be used if found
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 procedure Add_Attributes
68 (Project_Tree : Project_Tree_Ref;
69 Conf_Decl : Declarations;
70 User_Decl : in out Declarations);
71 -- Process the attributes in the config declarations.
72 -- For single string values, if the attribute is not declared in the user
73 -- declarations, declare it with the value in the config declarations.
74 -- For string list values, prepend the value in the user declarations with
75 -- the value in the config declarations.
77 function Locate_Config_File (Name : String) return String_Access;
78 -- Search for Name in the config files directory. Return full path if
79 -- found, or null otherwise
82 (Config_File : Prj.Project_Id;
83 Autoconf_Specified : Boolean;
84 Project_Tree : Prj.Project_Tree_Ref;
85 Target : String := "") return Boolean;
86 -- Check that the config file's target matches Target.
87 -- Target should be set to the empty string when the user did not specify
88 -- a target. If the target in the configuration file is invalid, this
89 -- function will raise Invalid_Config with an appropriate message.
90 -- Autoconf_Specified should be set to True if the user has used --autoconf
96 procedure Add_Attributes
97 (Project_Tree : Project_Tree_Ref;
98 Conf_Decl : Declarations;
99 User_Decl : in out Declarations)
101 Conf_Attr_Id : Variable_Id;
102 Conf_Attr : Variable;
103 Conf_Array_Id : Array_Id;
104 Conf_Array : Array_Data;
105 Conf_Array_Elem_Id : Array_Element_Id;
106 Conf_Array_Elem : Array_Element;
107 Conf_List : String_List_Id;
108 Conf_List_Elem : String_Element;
110 User_Attr_Id : Variable_Id;
111 User_Attr : Variable;
112 User_Array_Id : Array_Id;
113 User_Array : Array_Data;
114 User_Array_Elem_Id : Array_Element_Id;
115 User_Array_Elem : Array_Element;
118 Conf_Attr_Id := Conf_Decl.Attributes;
119 User_Attr_Id := User_Decl.Attributes;
120 while Conf_Attr_Id /= No_Variable loop
122 Project_Tree.Variable_Elements.Table (Conf_Attr_Id);
124 Project_Tree.Variable_Elements.Table (User_Attr_Id);
126 if not Conf_Attr.Value.Default then
127 if User_Attr.Value.Default then
129 -- No attribute declared in user project file: just copy the
130 -- value of the configuration attribute.
132 User_Attr.Value := Conf_Attr.Value;
133 Project_Tree.Variable_Elements.Table (User_Attr_Id) :=
136 elsif User_Attr.Value.Kind = List
137 and then Conf_Attr.Value.Values /= Nil_String
139 -- List attribute declared in both the user project and the
140 -- configuration project: prepend the user list with the
141 -- configuration list.
144 Conf_List : String_List_Id := Conf_Attr.Value.Values;
145 Conf_Elem : String_Element;
146 User_List : constant String_List_Id :=
147 User_Attr.Value.Values;
148 New_List : String_List_Id;
149 New_Elem : String_Element;
154 String_Element_Table.Increment_Last
155 (Project_Tree.String_Elements);
156 New_List := String_Element_Table.Last
157 (Project_Tree.String_Elements);
159 -- Value of attribute is new list
161 User_Attr.Value.Values := New_List;
162 Project_Tree.Variable_Elements.Table (User_Attr_Id) :=
167 -- Get each element of configuration list
170 Project_Tree.String_Elements.Table (Conf_List);
171 New_Elem := Conf_Elem;
172 Conf_List := Conf_Elem.Next;
174 if Conf_List = Nil_String then
176 -- If it is the last element in the list, connect to
177 -- first element of user list, and we are done.
179 New_Elem.Next := User_List;
180 Project_Tree.String_Elements.Table
181 (New_List) := New_Elem;
185 -- If it is not the last element in the list, add to
188 String_Element_Table.Increment_Last
189 (Project_Tree.String_Elements);
191 String_Element_Table.Last
192 (Project_Tree.String_Elements);
193 Project_Tree.String_Elements.Table
194 (New_List) := New_Elem;
195 New_List := New_Elem.Next;
202 Conf_Attr_Id := Conf_Attr.Next;
203 User_Attr_Id := User_Attr.Next;
206 Conf_Array_Id := Conf_Decl.Arrays;
207 while Conf_Array_Id /= No_Array loop
208 Conf_Array := Project_Tree.Arrays.Table (Conf_Array_Id);
210 User_Array_Id := User_Decl.Arrays;
211 while User_Array_Id /= No_Array loop
212 User_Array := Project_Tree.Arrays.Table (User_Array_Id);
213 exit when User_Array.Name = Conf_Array.Name;
214 User_Array_Id := User_Array.Next;
217 -- If this associative array does not exist in the user project file,
218 -- do a shallow copy of the full associative array.
220 if User_Array_Id = No_Array then
221 Array_Table.Increment_Last (Project_Tree.Arrays);
222 User_Array := Conf_Array;
223 User_Array.Next := User_Decl.Arrays;
224 User_Decl.Arrays := Array_Table.Last (Project_Tree.Arrays);
225 Project_Tree.Arrays.Table (User_Decl.Arrays) := User_Array;
228 -- Otherwise, check each array element
230 Conf_Array_Elem_Id := Conf_Array.Value;
231 while Conf_Array_Elem_Id /= No_Array_Element loop
233 Project_Tree.Array_Elements.Table (Conf_Array_Elem_Id);
235 User_Array_Elem_Id := User_Array.Value;
236 while User_Array_Elem_Id /= No_Array_Element loop
238 Project_Tree.Array_Elements.Table (User_Array_Elem_Id);
239 exit when User_Array_Elem.Index = Conf_Array_Elem.Index;
240 User_Array_Elem_Id := User_Array_Elem.Next;
243 -- If the array element does not exist in the user array,
244 -- insert a shallow copy of the conf array element in the
247 if User_Array_Elem_Id = No_Array_Element then
248 Array_Element_Table.Increment_Last
249 (Project_Tree.Array_Elements);
250 User_Array_Elem := Conf_Array_Elem;
251 User_Array_Elem.Next := User_Array.Value;
253 Array_Element_Table.Last (Project_Tree.Array_Elements);
254 Project_Tree.Array_Elements.Table (User_Array.Value) :=
256 Project_Tree.Arrays.Table (User_Array_Id) := User_Array;
258 -- Otherwise, if the value is a string list, prepend the
259 -- user array element with the conf array element value.
261 elsif Conf_Array_Elem.Value.Kind = List then
262 Conf_List := Conf_Array_Elem.Value.Values;
264 if Conf_List /= Nil_String then
266 Link : constant String_List_Id :=
267 User_Array_Elem.Value.Values;
268 Previous : String_List_Id := Nil_String;
269 Next : String_List_Id;
274 Project_Tree.String_Elements.Table
276 String_Element_Table.Increment_Last
277 (Project_Tree.String_Elements);
279 String_Element_Table.Last
280 (Project_Tree.String_Elements);
281 Project_Tree.String_Elements.Table (Next) :=
284 if Previous = Nil_String then
285 User_Array_Elem.Value.Values := Next;
286 Project_Tree.Array_Elements.Table
287 (User_Array_Elem_Id) := User_Array_Elem;
290 Project_Tree.String_Elements.Table
291 (Previous).Next := Next;
296 Conf_List := Conf_List_Elem.Next;
298 if Conf_List = Nil_String then
299 Project_Tree.String_Elements.Table
300 (Previous).Next := Link;
308 Conf_Array_Elem_Id := Conf_Array_Elem.Next;
312 Conf_Array_Id := Conf_Array.Next;
316 ------------------------
317 -- Locate_Config_File --
318 ------------------------
320 function Locate_Config_File (Name : String) return String_Access is
321 Prefix_Path : constant String := Executable_Prefix_Path;
323 if Prefix_Path'Length /= 0 then
324 return Locate_Regular_File
326 "." & Path_Separator &
327 Prefix_Path & "share" & Directory_Separator & "gpr");
329 return Locate_Regular_File (Name, ".");
331 end Locate_Config_File;
337 function Check_Target
338 (Config_File : Project_Id;
339 Autoconf_Specified : Boolean;
340 Project_Tree : Prj.Project_Tree_Ref;
341 Target : String := "") return Boolean
343 Variable : constant Variable_Value :=
345 (Name_Target, Config_File.Decl.Attributes, Project_Tree);
346 Tgt_Name : Name_Id := No_Name;
350 if Variable /= Nil_Variable_Value and then not Variable.Default then
351 Tgt_Name := Variable.Value;
355 OK := not Autoconf_Specified or else Tgt_Name = No_Name;
357 OK := Tgt_Name /= No_Name
358 and then Target = Get_Name_String (Tgt_Name);
362 if Autoconf_Specified then
364 Write_Line ("inconsistent targets, performing autoconf");
370 if Tgt_Name /= No_Name then
372 with "invalid target name """
373 & Get_Name_String (Tgt_Name) & """ in configuration";
377 with "no target specified in configuration file";
385 --------------------------------------
386 -- Get_Or_Create_Configuration_File --
387 --------------------------------------
389 procedure Get_Or_Create_Configuration_File
390 (Project : Project_Id;
391 Project_Tree : Project_Tree_Ref;
392 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
393 Allow_Automatic_Generation : Boolean;
394 Config_File_Name : String := "";
395 Autoconf_Specified : Boolean;
396 Target_Name : String := "";
397 Normalized_Hostname : String;
398 Packages_To_Check : String_List_Access := null;
399 Config : out Prj.Project_Id;
400 Config_File_Path : out String_Access;
401 Automatically_Generated : out Boolean;
402 Flags : Processing_Flags;
403 On_Load_Config : Config_File_Hook := null)
405 function Default_File_Name return String;
406 -- Return the name of the default config file that should be tested
408 procedure Do_Autoconf;
409 -- Generate a new config file through gprconfig.
410 -- In case of error, this raises the Invalid_Config exception with an
411 -- appropriate message
413 function Get_Config_Switches return Argument_List_Access;
414 -- Return the --config switches to use for gprconfig
416 function Might_Have_Sources (Project : Project_Id) return Boolean;
417 -- True if the specified project might have sources (ie the user has not
418 -- explicitly specified it. We haven't checked the file system, nor do
419 -- we need to at this stage.
421 -----------------------
422 -- Default_File_Name --
423 -----------------------
425 function Default_File_Name return String is
426 Ada_RTS : constant String := Runtime_Name_For (Name_Ada);
430 if Target_Name /= "" then
431 if Ada_RTS /= "" then
432 return Target_Name & '-' & Ada_RTS
433 & Config_Project_File_Extension;
435 return Target_Name & Config_Project_File_Extension;
438 elsif Ada_RTS /= "" then
439 return Ada_RTS & Config_Project_File_Extension;
442 Tmp := Getenv (Config_Project_Env_Var);
445 T : constant String := Tmp.all;
456 end Default_File_Name;
458 ------------------------
459 -- Might_Have_Sources --
460 ------------------------
462 function Might_Have_Sources (Project : Project_Id) return Boolean is
463 Variable : Variable_Value;
469 Project.Decl.Attributes,
472 if Variable = Nil_Variable_Value
473 or else Variable.Default
474 or else Variable.Values /= Nil_String
479 Project.Decl.Attributes,
481 return Variable = Nil_Variable_Value
482 or else Variable.Default
483 or else Variable.Values /= Nil_String;
488 end Might_Have_Sources;
490 -------------------------
491 -- Get_Config_Switches --
492 -------------------------
494 function Get_Config_Switches return Argument_List_Access is
495 package Language_Htable is new GNAT.HTable.Simple_HTable
496 (Header_Num => Prj.Header_Num,
498 No_Element => No_Name,
502 -- Hash table to keep the languages used in the project tree
504 IDE : constant Package_Id :=
507 Project.Decl.Packages,
510 Prj_Iter : Project_List;
511 List : String_List_Id;
512 Elem : String_Element;
514 Variable : Variable_Value;
517 Result : Argument_List_Access;
520 Prj_Iter := Project_Tree.Projects;
521 while Prj_Iter /= null loop
522 if Might_Have_Sources (Prj_Iter.Project) then
526 Prj_Iter.Project.Decl.Attributes,
529 if Variable = Nil_Variable_Value
530 or else Variable.Default
532 -- Languages is not declared. If it is not an extending
533 -- project, check for Default_Language
535 if Prj_Iter.Project.Extends = No_Project then
538 (Name_Default_Language,
539 Prj_Iter.Project.Decl.Attributes,
542 if Variable /= Nil_Variable_Value
543 and then not Variable.Default
545 Get_Name_String (Variable.Value);
546 To_Lower (Name_Buffer (1 .. Name_Len));
548 Language_Htable.Set (Lang, Lang);
551 -- If no language is declared, default to Ada
553 Language_Htable.Set (Name_Ada, Name_Ada);
557 elsif Variable.Values /= Nil_String then
559 -- Attribute Languages is declared with a non empty
560 -- list: put all the languages in Language_HTable.
562 List := Variable.Values;
563 while List /= Nil_String loop
564 Elem := Project_Tree.String_Elements.Table (List);
566 Get_Name_String (Elem.Value);
567 To_Lower (Name_Buffer (1 .. Name_Len));
569 Language_Htable.Set (Lang, Lang);
576 Prj_Iter := Prj_Iter.Next;
579 Name := Language_Htable.Get_First;
581 while Name /= No_Name loop
583 Name := Language_Htable.Get_Next;
586 Result := new String_List (1 .. Count);
589 Name := Language_Htable.Get_First;
590 while Name /= No_Name loop
591 -- Check if IDE'Compiler_Command is declared for the language.
592 -- If it is, use its value to invoke gprconfig.
597 Attribute_Or_Array_Name => Name_Compiler_Command,
599 In_Tree => Project_Tree,
600 Force_Lower_Case_Index => True);
603 Config_Command : constant String :=
604 "--config=" & Get_Name_String (Name);
606 Runtime_Name : constant String :=
607 Runtime_Name_For (Name);
610 if Variable = Nil_Variable_Value
611 or else Length_Of_Name (Variable.Value) = 0
614 new String'(Config_Command & ",," & Runtime_Name);
618 Compiler_Command : constant String :=
619 Get_Name_String (Variable.Value);
622 if Is_Absolute_Path (Compiler_Command) then
625 (Config_Command & ",," & Runtime_Name & "," &
626 Containing_Directory (Compiler_Command) & "," &
627 Simple_Name (Compiler_Command));
631 (Config_Command & ",," & Runtime_Name & ",," &
639 Name := Language_Htable.Get_Next;
643 end Get_Config_Switches;
649 procedure Do_Autoconf is
650 Obj_Dir : constant Variable_Value :=
653 Project.Decl.Attributes,
656 Gprconfig_Path : String_Access;
660 Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
662 if Gprconfig_Path = null then
664 with "could not locate gprconfig for auto-configuration";
667 -- First, find the object directory of the user's project
669 if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
670 Get_Name_String (Project.Directory.Name);
673 if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
674 Get_Name_String (Obj_Dir.Value);
678 Add_Str_To_Name_Buffer
679 (Get_Name_String (Project.Directory.Name));
680 Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
684 if Subdirs /= null then
685 Add_Char_To_Name_Buffer (Directory_Separator);
686 Add_Str_To_Name_Buffer (Subdirs.all);
689 for J in 1 .. Name_Len loop
690 if Name_Buffer (J) = '/' then
691 Name_Buffer (J) := Directory_Separator;
696 Obj_Dir : constant String := Name_Buffer (1 .. Name_Len);
697 Switches : Argument_List_Access := Get_Config_Switches;
698 Args : Argument_List (1 .. 5);
700 Obj_Dir_Exists : Boolean := True;
703 -- Check if the object directory exists. If Setup_Projects is True
704 -- (-p) and directory does not exist, attempt to create it.
705 -- Otherwise, if directory does not exist, fail without calling
708 if not Is_Directory (Obj_Dir)
709 and then (Setup_Projects or else Subdirs /= null)
712 Create_Path (Obj_Dir);
714 if not Quiet_Output then
715 Write_Str ("object directory """);
717 Write_Line (""" created");
723 with "could not create object directory " & Obj_Dir;
727 if not Is_Directory (Obj_Dir) then
728 case Flags.Require_Obj_Dirs is
731 with "object directory " & Obj_Dir & " does not exist";
735 "?object directory " & Obj_Dir & " does not exist");
736 Obj_Dir_Exists := False;
744 Args (1) := new String'("--batch");
745 Args (2) := new String'("-o");
747 -- If no config file was specified, set the auto.cgpr one
749 if Config_File_Name = "" then
750 if Obj_Dir_Exists then
751 Args (3) := new String'
752 (Obj_Dir & Directory_Separator & Auto_Cgpr);
755 Path_FD : File_Descriptor;
756 Path_Name : Path_Name_Type;
758 Prj.Env.Create_Temp_File
759 (In_Tree => Project_Tree,
761 Path_Name => Path_Name,
762 File_Use => "configuration file");
764 if Path_FD /= Invalid_FD then
765 Args (3) := new String'(Get_Name_String (Path_Name));
766 GNAT.OS_Lib.Close (Path_FD);
768 -- We'll have an error message later on
769 Args (3) := new String'
770 (Obj_Dir & Directory_Separator & Auto_Cgpr);
775 Args (3) := new String'(Config_File_Name);
778 if Normalized_Hostname = "" then
781 if Target_Name = "" then
782 Args (4) := new String'("--target=" & Normalized_Hostname);
784 Args (4) := new String'("--target=" & Target_Name);
790 if not Verbose_Mode then
791 Arg_Last := Arg_Last + 1;
792 Args (Arg_Last) := new String'("-q");
796 Write_Str (Gprconfig_Name);
798 for J in 1 .. Arg_Last loop
800 Write_Str (Args (J).all);
803 for J in Switches'Range loop
805 Write_Str (Switches (J).all);
810 elsif not Quiet_Output then
811 -- Display no message if we are creating auto.cgpr, unless in
814 if Config_File_Name /= ""
817 Write_Str ("creating ");
818 Write_Str (Simple_Name (Args (3).all));
823 Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) & Switches.all,
828 Config_File_Path := Locate_Config_File (Args (3).all);
830 if Config_File_Path = null then
832 with "could not create " & Args (3).all;
835 for F in Args'Range loop
842 Config_Project_Node : Project_Node_Id := Empty_Node;
845 Free (Config_File_Path);
846 Config := No_Project;
848 if Config_File_Name /= "" then
849 Config_File_Path := Locate_Config_File (Config_File_Name);
851 Config_File_Path := Locate_Config_File (Default_File_Name);
854 if Config_File_Path = null then
855 if (not Allow_Automatic_Generation) and then
856 Config_File_Name /= ""
859 with "could not locate main configuration project "
864 Automatically_Generated :=
865 Allow_Automatic_Generation and then Config_File_Path = null;
867 <<Process_Config_File>>
869 if Automatically_Generated then
870 -- This might raise an Invalid_Config exception
874 -- Parse the configuration file
876 if Verbose_Mode and then Config_File_Path /= null then
877 Write_Str ("Checking configuration ");
878 Write_Line (Config_File_Path.all);
881 if Config_File_Path /= null then
883 (In_Tree => Project_Node_Tree,
884 Project => Config_Project_Node,
885 Project_File_Name => Config_File_Path.all,
886 Always_Errout_Finalize => False,
887 Packages_To_Check => Packages_To_Check,
888 Current_Directory => Current_Directory,
889 Is_Config_File => True,
892 -- Maybe the user will want to create his own configuration file
893 Config_Project_Node := Empty_Node;
896 if On_Load_Config /= null then
898 (Config_File => Config_Project_Node,
899 Project_Node_Tree => Project_Node_Tree);
902 if Config_Project_Node /= Empty_Node then
903 Prj.Proc.Process_Project_Tree_Phase_1
904 (In_Tree => Project_Tree,
907 From_Project_Node => Config_Project_Node,
908 From_Project_Node_Tree => Project_Node_Tree,
910 Reset_Tree => False);
913 if Config_Project_Node = Empty_Node
914 or else Config = No_Project
917 with "processing of configuration project """
918 & Config_File_Path.all & """ failed";
921 -- Check that the target of the configuration file is the one the user
922 -- specified on the command line. We do not need to check that when in
923 -- auto-conf mode, since the appropriate target was passed to gprconfig.
925 if not Automatically_Generated
927 Check_Target (Config, Autoconf_Specified, Project_Tree, Target_Name)
929 Automatically_Generated := True;
930 goto Process_Config_File;
932 end Get_Or_Create_Configuration_File;
934 --------------------------------------
935 -- Process_Project_And_Apply_Config --
936 --------------------------------------
938 procedure Process_Project_And_Apply_Config
939 (Main_Project : out Prj.Project_Id;
940 User_Project_Node : Prj.Tree.Project_Node_Id;
941 Config_File_Name : String := "";
942 Autoconf_Specified : Boolean;
943 Project_Tree : Prj.Project_Tree_Ref;
944 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
945 Packages_To_Check : String_List_Access;
946 Allow_Automatic_Generation : Boolean := True;
947 Automatically_Generated : out Boolean;
948 Config_File_Path : out String_Access;
949 Target_Name : String := "";
950 Normalized_Hostname : String;
951 Flags : Processing_Flags;
952 On_Load_Config : Config_File_Hook := null;
953 Reset_Tree : Boolean := True)
955 Main_Config_Project : Project_Id;
959 Main_Project := No_Project;
960 Automatically_Generated := False;
962 Process_Project_Tree_Phase_1
963 (In_Tree => Project_Tree,
964 Project => Main_Project,
966 From_Project_Node => User_Project_Node,
967 From_Project_Node_Tree => Project_Node_Tree,
969 Reset_Tree => Reset_Tree);
972 Main_Project := No_Project;
976 -- Find configuration file
978 Get_Or_Create_Configuration_File
979 (Config => Main_Config_Project,
980 Project => Main_Project,
981 Project_Tree => Project_Tree,
982 Project_Node_Tree => Project_Node_Tree,
983 Allow_Automatic_Generation => Allow_Automatic_Generation,
984 Config_File_Name => Config_File_Name,
985 Autoconf_Specified => Autoconf_Specified,
986 Target_Name => Target_Name,
987 Normalized_Hostname => Normalized_Hostname,
988 Packages_To_Check => Packages_To_Check,
989 Config_File_Path => Config_File_Path,
990 Automatically_Generated => Automatically_Generated,
992 On_Load_Config => On_Load_Config);
994 Apply_Config_File (Main_Config_Project, Project_Tree);
996 -- Finish processing the user's project
998 Prj.Proc.Process_Project_Tree_Phase_2
999 (In_Tree => Project_Tree,
1000 Project => Main_Project,
1002 From_Project_Node => User_Project_Node,
1003 From_Project_Node_Tree => Project_Node_Tree,
1007 Main_Project := No_Project;
1009 end Process_Project_And_Apply_Config;
1011 ------------------------------------
1012 -- Parse_Project_And_Apply_Config --
1013 ------------------------------------
1015 procedure Parse_Project_And_Apply_Config
1016 (Main_Project : out Prj.Project_Id;
1017 User_Project_Node : out Prj.Tree.Project_Node_Id;
1018 Config_File_Name : String := "";
1019 Autoconf_Specified : Boolean;
1020 Project_File_Name : String;
1021 Project_Tree : Prj.Project_Tree_Ref;
1022 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
1023 Packages_To_Check : String_List_Access;
1024 Allow_Automatic_Generation : Boolean := True;
1025 Automatically_Generated : out Boolean;
1026 Config_File_Path : out String_Access;
1027 Target_Name : String := "";
1028 Normalized_Hostname : String;
1029 Flags : Processing_Flags;
1030 On_Load_Config : Config_File_Hook := null)
1033 -- Parse the user project tree
1035 Prj.Initialize (Project_Tree);
1037 Main_Project := No_Project;
1038 Automatically_Generated := False;
1041 (In_Tree => Project_Node_Tree,
1042 Project => User_Project_Node,
1043 Project_File_Name => Project_File_Name,
1044 Always_Errout_Finalize => False,
1045 Packages_To_Check => Packages_To_Check,
1046 Current_Directory => Current_Directory,
1047 Is_Config_File => False,
1050 if User_Project_Node = Empty_Node then
1051 User_Project_Node := Empty_Node;
1055 Process_Project_And_Apply_Config
1056 (Main_Project => Main_Project,
1057 User_Project_Node => User_Project_Node,
1058 Config_File_Name => Config_File_Name,
1059 Autoconf_Specified => Autoconf_Specified,
1060 Project_Tree => Project_Tree,
1061 Project_Node_Tree => Project_Node_Tree,
1062 Packages_To_Check => Packages_To_Check,
1063 Allow_Automatic_Generation => Allow_Automatic_Generation,
1064 Automatically_Generated => Automatically_Generated,
1065 Config_File_Path => Config_File_Path,
1066 Target_Name => Target_Name,
1067 Normalized_Hostname => Normalized_Hostname,
1069 On_Load_Config => On_Load_Config);
1070 end Parse_Project_And_Apply_Config;
1072 -----------------------
1073 -- Apply_Config_File --
1074 -----------------------
1076 procedure Apply_Config_File
1077 (Config_File : Prj.Project_Id;
1078 Project_Tree : Prj.Project_Tree_Ref)
1080 Conf_Decl : constant Declarations := Config_File.Decl;
1081 Conf_Pack_Id : Package_Id;
1082 Conf_Pack : Package_Element;
1084 User_Decl : Declarations;
1085 User_Pack_Id : Package_Id;
1086 User_Pack : Package_Element;
1087 Proj : Project_List;
1090 Proj := Project_Tree.Projects;
1091 while Proj /= null loop
1092 if Proj.Project /= Config_File then
1093 User_Decl := Proj.Project.Decl;
1095 (Project_Tree => Project_Tree,
1096 Conf_Decl => Conf_Decl,
1097 User_Decl => User_Decl);
1099 Conf_Pack_Id := Conf_Decl.Packages;
1100 while Conf_Pack_Id /= No_Package loop
1101 Conf_Pack := Project_Tree.Packages.Table (Conf_Pack_Id);
1103 User_Pack_Id := User_Decl.Packages;
1104 while User_Pack_Id /= No_Package loop
1105 User_Pack := Project_Tree.Packages.Table (User_Pack_Id);
1106 exit when User_Pack.Name = Conf_Pack.Name;
1107 User_Pack_Id := User_Pack.Next;
1110 if User_Pack_Id = No_Package then
1111 Package_Table.Increment_Last (Project_Tree.Packages);
1112 User_Pack := Conf_Pack;
1113 User_Pack.Next := User_Decl.Packages;
1114 User_Decl.Packages :=
1115 Package_Table.Last (Project_Tree.Packages);
1116 Project_Tree.Packages.Table (User_Decl.Packages) :=
1121 (Project_Tree => Project_Tree,
1122 Conf_Decl => Conf_Pack.Decl,
1123 User_Decl => Project_Tree.Packages.Table
1124 (User_Pack_Id).Decl);
1127 Conf_Pack_Id := Conf_Pack.Next;
1130 Proj.Project.Decl := User_Decl;
1135 end Apply_Config_File;
1137 ---------------------
1138 -- Set_Runtime_For --
1139 ---------------------
1141 procedure Set_Runtime_For (Language : Name_Id; RTS_Name : String) is
1143 Name_Len := RTS_Name'Length;
1144 Name_Buffer (1 .. Name_Len) := RTS_Name;
1145 RTS_Languages.Set (Language, Name_Find);
1146 end Set_Runtime_For;
1148 ----------------------
1149 -- Runtime_Name_For --
1150 ----------------------
1152 function Runtime_Name_For (Language : Name_Id) return String is
1154 if RTS_Languages.Get (Language) /= No_Name then
1155 return Get_Name_String (RTS_Languages.Get (Language));
1159 end Runtime_Name_For;
1161 ------------------------------------
1162 -- Add_Default_GNAT_Naming_Scheme --
1163 ------------------------------------
1165 procedure Add_Default_GNAT_Naming_Scheme
1166 (Config_File : in out Project_Node_Id;
1167 Project_Tree : Project_Node_Tree_Ref)
1169 procedure Create_Attribute
1172 Index : String := "";
1173 Pkg : Project_Node_Id := Empty_Node);
1175 ----------------------
1176 -- Create_Attribute --
1177 ----------------------
1179 procedure Create_Attribute
1182 Index : String := "";
1183 Pkg : Project_Node_Id := Empty_Node)
1185 Attr : Project_Node_Id;
1186 Val : Name_Id := No_Name;
1187 Parent : Project_Node_Id := Config_File;
1190 Name_Len := Index'Length;
1191 Name_Buffer (1 .. Name_Len) := Index;
1195 if Pkg /= Empty_Node then
1199 Attr := Create_Attribute
1200 (Tree => Project_Tree,
1201 Prj_Or_Pkg => Parent,
1204 Kind => Prj.Single);
1206 Name_Len := Value'Length;
1207 Name_Buffer (1 .. Name_Len) := Value;
1211 (Attr, Project_Tree,
1212 Enclose_In_Expression
1213 (Create_Literal_String (Val, Project_Tree),
1215 end Create_Attribute;
1218 Naming : Project_Node_Id;
1220 -- Start of processing for Add_Default_GNAT_Naming_Scheme
1223 if Config_File = Empty_Node then
1225 -- Create a dummy config file is none was found
1227 Name_Len := Auto_Cgpr'Length;
1228 Name_Buffer (1 .. Name_Len) := Auto_Cgpr;
1231 -- An invalid project name to avoid conflicts with user-created ones
1234 Name_Buffer (1 .. Name_Len) := "_auto";
1238 (In_Tree => Project_Tree,
1240 Full_Path => Path_Name_Type (Name),
1241 Is_Config_File => True);
1243 -- Setup library support
1245 case MLib.Tgt.Support_For_Libraries is
1250 Create_Attribute (Name_Library_Support, "static_only");
1253 Create_Attribute (Name_Library_Support, "full");
1256 if MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported then
1257 Create_Attribute (Name_Library_Auto_Init_Supported, "true");
1259 Create_Attribute (Name_Library_Auto_Init_Supported, "false");
1262 -- Setup Ada support (Ada is the default language here, since this
1263 -- is only called when no config file existed initially, ie for
1266 Create_Attribute (Name_Default_Language, "ada");
1268 Naming := Create_Package (Project_Tree, Config_File, "naming");
1269 Create_Attribute (Name_Spec_Suffix, ".ads", "ada", Pkg => Naming);
1270 Create_Attribute (Name_Separate_Suffix, ".adb", "ada", Pkg => Naming);
1271 Create_Attribute (Name_Body_Suffix, ".adb", "ada", Pkg => Naming);
1272 Create_Attribute (Name_Dot_Replacement, "-", Pkg => Naming);
1273 Create_Attribute (Name_Casing, "lowercase", Pkg => Naming);
1275 if Current_Verbosity = High then
1276 Write_Line ("Automatically generated (in-memory) config file");
1278 (Project => Config_File,
1279 In_Tree => Project_Tree,
1280 Backward_Compatibility => False);
1283 end Add_Default_GNAT_Naming_Scheme;