1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2006-2011, 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 Default_Name : constant String := "default.cgpr";
52 -- Default configuration file that will be used if found
54 Config_Project_Env_Var : constant String := "GPR_CONFIG";
55 -- Name of the environment variable that provides the name of the
56 -- configuration file to use.
58 Gprconfig_Name : constant String := "gprconfig";
60 package RTS_Languages is new GNAT.HTable.Simple_HTable
61 (Header_Num => Prj.Header_Num,
63 No_Element => No_Name,
67 -- Stores the runtime names for the various languages. This is in general
68 -- set from a --RTS command line option.
70 -----------------------
71 -- Local_Subprograms --
72 -----------------------
74 procedure Add_Attributes
75 (Project_Tree : Project_Tree_Ref;
76 Conf_Decl : Declarations;
77 User_Decl : in out Declarations);
78 -- Process the attributes in the config declarations.
79 -- For single string values, if the attribute is not declared in the user
80 -- declarations, declare it with the value in the config declarations.
81 -- For string list values, prepend the value in the user declarations with
82 -- the value in the config declarations.
85 (Config_File : Prj.Project_Id;
86 Autoconf_Specified : Boolean;
87 Project_Tree : Prj.Project_Tree_Ref;
88 Target : String := "") return Boolean;
89 -- Check that the config file's target matches Target.
90 -- Target should be set to the empty string when the user did not specify
91 -- a target. If the target in the configuration file is invalid, this
92 -- function will raise Invalid_Config with an appropriate message.
93 -- Autoconf_Specified should be set to True if the user has used
96 function Locate_Config_File (Name : String) return String_Access;
97 -- Search for Name in the config files directory. Return full path if
98 -- found, or null otherwise.
100 procedure Raise_Invalid_Config (Msg : String);
101 pragma No_Return (Raise_Invalid_Config);
102 -- Raises exception Invalid_Config with given message
104 procedure Apply_Config_File
105 (Config_File : Prj.Project_Id;
106 Project_Tree : Prj.Project_Tree_Ref);
107 -- Apply the configuration file settings to all the projects in the
108 -- project tree. The Project_Tree must have been parsed first, and
109 -- processed through the first phase so that all its projects are known.
111 -- Currently, this will add new attributes and packages in the various
112 -- projects, so that when the second phase of the processing is performed
113 -- these attributes are automatically taken into account.
119 procedure Add_Attributes
120 (Project_Tree : Project_Tree_Ref;
121 Conf_Decl : Declarations;
122 User_Decl : in out Declarations)
124 Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
125 Conf_Attr_Id : Variable_Id;
126 Conf_Attr : Variable;
127 Conf_Array_Id : Array_Id;
128 Conf_Array : Array_Data;
129 Conf_Array_Elem_Id : Array_Element_Id;
130 Conf_Array_Elem : Array_Element;
131 Conf_List : String_List_Id;
132 Conf_List_Elem : String_Element;
134 User_Attr_Id : Variable_Id;
135 User_Attr : Variable;
136 User_Array_Id : Array_Id;
137 User_Array : Array_Data;
138 User_Array_Elem_Id : Array_Element_Id;
139 User_Array_Elem : Array_Element;
142 Conf_Attr_Id := Conf_Decl.Attributes;
143 User_Attr_Id := User_Decl.Attributes;
144 while Conf_Attr_Id /= No_Variable loop
145 Conf_Attr := Shared.Variable_Elements.Table (Conf_Attr_Id);
146 User_Attr := Shared.Variable_Elements.Table (User_Attr_Id);
148 if not Conf_Attr.Value.Default then
149 if User_Attr.Value.Default then
151 -- No attribute declared in user project file: just copy the
152 -- value of the configuration attribute.
154 User_Attr.Value := Conf_Attr.Value;
155 Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
157 elsif User_Attr.Value.Kind = List
158 and then Conf_Attr.Value.Values /= Nil_String
160 -- List attribute declared in both the user project and the
161 -- configuration project: prepend the user list with the
162 -- configuration list.
165 Conf_List : String_List_Id := Conf_Attr.Value.Values;
166 Conf_Elem : String_Element;
167 User_List : constant String_List_Id :=
168 User_Attr.Value.Values;
169 New_List : String_List_Id;
170 New_Elem : String_Element;
175 String_Element_Table.Increment_Last
176 (Shared.String_Elements);
178 String_Element_Table.Last (Shared.String_Elements);
180 -- Value of attribute is new list
182 User_Attr.Value.Values := New_List;
183 Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
186 -- Get each element of configuration list
188 Conf_Elem := Shared.String_Elements.Table (Conf_List);
189 New_Elem := Conf_Elem;
190 Conf_List := Conf_Elem.Next;
192 if Conf_List = Nil_String then
194 -- If it is the last element in the list, connect to
195 -- first element of user list, and we are done.
197 New_Elem.Next := User_List;
198 Shared.String_Elements.Table (New_List) := New_Elem;
202 -- If it is not the last element in the list, add to
205 String_Element_Table.Increment_Last
206 (Shared.String_Elements);
208 String_Element_Table.Last (Shared.String_Elements);
209 Shared.String_Elements.Table (New_List) := New_Elem;
210 New_List := New_Elem.Next;
217 Conf_Attr_Id := Conf_Attr.Next;
218 User_Attr_Id := User_Attr.Next;
221 Conf_Array_Id := Conf_Decl.Arrays;
222 while Conf_Array_Id /= No_Array loop
223 Conf_Array := Shared.Arrays.Table (Conf_Array_Id);
225 User_Array_Id := User_Decl.Arrays;
226 while User_Array_Id /= No_Array loop
227 User_Array := Shared.Arrays.Table (User_Array_Id);
228 exit when User_Array.Name = Conf_Array.Name;
229 User_Array_Id := User_Array.Next;
232 -- If this associative array does not exist in the user project file,
233 -- do a shallow copy of the full associative array.
235 if User_Array_Id = No_Array then
236 Array_Table.Increment_Last (Shared.Arrays);
237 User_Array := Conf_Array;
238 User_Array.Next := User_Decl.Arrays;
239 User_Decl.Arrays := Array_Table.Last (Shared.Arrays);
240 Shared.Arrays.Table (User_Decl.Arrays) := User_Array;
242 -- Otherwise, check each array element
245 Conf_Array_Elem_Id := Conf_Array.Value;
246 while Conf_Array_Elem_Id /= No_Array_Element loop
248 Shared.Array_Elements.Table (Conf_Array_Elem_Id);
250 User_Array_Elem_Id := User_Array.Value;
251 while User_Array_Elem_Id /= No_Array_Element loop
253 Shared.Array_Elements.Table (User_Array_Elem_Id);
254 exit when User_Array_Elem.Index = Conf_Array_Elem.Index;
255 User_Array_Elem_Id := User_Array_Elem.Next;
258 -- If the array element doesn't exist in the user array, insert
259 -- a shallow copy of the conf array element in the user array.
261 if User_Array_Elem_Id = No_Array_Element then
262 Array_Element_Table.Increment_Last (Shared.Array_Elements);
263 User_Array_Elem := Conf_Array_Elem;
264 User_Array_Elem.Next := User_Array.Value;
266 Array_Element_Table.Last (Shared.Array_Elements);
267 Shared.Array_Elements.Table (User_Array.Value) :=
269 Shared.Arrays.Table (User_Array_Id) := User_Array;
271 -- Otherwise, if the value is a string list, prepend the conf
272 -- array element value to the array element.
274 elsif Conf_Array_Elem.Value.Kind = List then
275 Conf_List := Conf_Array_Elem.Value.Values;
277 if Conf_List /= Nil_String then
279 Link : constant String_List_Id :=
280 User_Array_Elem.Value.Values;
281 Previous : String_List_Id := Nil_String;
282 Next : String_List_Id;
287 Shared.String_Elements.Table (Conf_List);
288 String_Element_Table.Increment_Last
289 (Shared.String_Elements);
291 String_Element_Table.Last
292 (Shared.String_Elements);
293 Shared.String_Elements.Table (Next) :=
296 if Previous = Nil_String then
297 User_Array_Elem.Value.Values := Next;
298 Shared.Array_Elements.Table
299 (User_Array_Elem_Id) := User_Array_Elem;
302 Shared.String_Elements.Table
303 (Previous).Next := Next;
308 Conf_List := Conf_List_Elem.Next;
310 if Conf_List = Nil_String then
311 Shared.String_Elements.Table (Previous).Next :=
320 Conf_Array_Elem_Id := Conf_Array_Elem.Next;
324 Conf_Array_Id := Conf_Array.Next;
328 ------------------------------------
329 -- Add_Default_GNAT_Naming_Scheme --
330 ------------------------------------
332 procedure Add_Default_GNAT_Naming_Scheme
333 (Config_File : in out Project_Node_Id;
334 Project_Tree : Project_Node_Tree_Ref)
336 procedure Create_Attribute
339 Index : String := "";
340 Pkg : Project_Node_Id := Empty_Node);
342 ----------------------
343 -- Create_Attribute --
344 ----------------------
346 procedure Create_Attribute
349 Index : String := "";
350 Pkg : Project_Node_Id := Empty_Node)
352 Attr : Project_Node_Id;
353 pragma Unreferenced (Attr);
355 Expr : Name_Id := No_Name;
356 Val : Name_Id := No_Name;
357 Parent : Project_Node_Id := Config_File;
361 Name_Len := Index'Length;
362 Name_Buffer (1 .. Name_Len) := Index;
366 if Pkg /= Empty_Node then
370 Name_Len := Value'Length;
371 Name_Buffer (1 .. Name_Len) := Value;
374 Attr := Create_Attribute
375 (Tree => Project_Tree,
376 Prj_Or_Pkg => Parent,
380 Value => Create_Literal_String (Expr, Project_Tree));
381 end Create_Attribute;
386 Naming : Project_Node_Id;
388 -- Start of processing for Add_Default_GNAT_Naming_Scheme
391 if Config_File = Empty_Node then
393 -- Create a dummy config file is none was found
395 Name_Len := Auto_Cgpr'Length;
396 Name_Buffer (1 .. Name_Len) := Auto_Cgpr;
399 -- An invalid project name to avoid conflicts with user-created ones
402 Name_Buffer (1 .. Name_Len) := "_auto";
406 (In_Tree => Project_Tree,
408 Full_Path => Path_Name_Type (Name),
409 Is_Config_File => True);
411 -- Setup library support
413 case MLib.Tgt.Support_For_Libraries is
418 Create_Attribute (Name_Library_Support, "static_only");
421 Create_Attribute (Name_Library_Support, "full");
424 if MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported then
425 Create_Attribute (Name_Library_Auto_Init_Supported, "true");
427 Create_Attribute (Name_Library_Auto_Init_Supported, "false");
430 -- Setup Ada support (Ada is the default language here, since this
431 -- is only called when no config file existed initially, ie for
434 Create_Attribute (Name_Default_Language, "ada");
436 Naming := Create_Package (Project_Tree, Config_File, "naming");
437 Create_Attribute (Name_Spec_Suffix, ".ads", "ada", Pkg => Naming);
438 Create_Attribute (Name_Separate_Suffix, ".adb", "ada", Pkg => Naming);
439 Create_Attribute (Name_Body_Suffix, ".adb", "ada", Pkg => Naming);
440 Create_Attribute (Name_Dot_Replacement, "-", Pkg => Naming);
441 Create_Attribute (Name_Casing, "lowercase", Pkg => Naming);
443 if Current_Verbosity = High then
444 Write_Line ("Automatically generated (in-memory) config file");
446 (Project => Config_File,
447 In_Tree => Project_Tree,
448 Backward_Compatibility => False);
451 end Add_Default_GNAT_Naming_Scheme;
453 -----------------------
454 -- Apply_Config_File --
455 -----------------------
457 procedure Apply_Config_File
458 (Config_File : Prj.Project_Id;
459 Project_Tree : Prj.Project_Tree_Ref)
461 Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
463 Conf_Decl : constant Declarations := Config_File.Decl;
464 Conf_Pack_Id : Package_Id;
465 Conf_Pack : Package_Element;
467 User_Decl : Declarations;
468 User_Pack_Id : Package_Id;
469 User_Pack : Package_Element;
473 Debug_Output ("Applying config file to a project tree");
475 Proj := Project_Tree.Projects;
476 while Proj /= null loop
477 if Proj.Project /= Config_File then
478 User_Decl := Proj.Project.Decl;
480 (Project_Tree => Project_Tree,
481 Conf_Decl => Conf_Decl,
482 User_Decl => User_Decl);
484 Conf_Pack_Id := Conf_Decl.Packages;
485 while Conf_Pack_Id /= No_Package loop
486 Conf_Pack := Shared.Packages.Table (Conf_Pack_Id);
488 User_Pack_Id := User_Decl.Packages;
489 while User_Pack_Id /= No_Package loop
490 User_Pack := Shared.Packages.Table (User_Pack_Id);
491 exit when User_Pack.Name = Conf_Pack.Name;
492 User_Pack_Id := User_Pack.Next;
495 if User_Pack_Id = No_Package then
496 Package_Table.Increment_Last (Shared.Packages);
497 User_Pack := Conf_Pack;
498 User_Pack.Next := User_Decl.Packages;
499 User_Decl.Packages := Package_Table.Last (Shared.Packages);
500 Shared.Packages.Table (User_Decl.Packages) := User_Pack;
504 (Project_Tree => Project_Tree,
505 Conf_Decl => Conf_Pack.Decl,
507 Shared.Packages.Table (User_Pack_Id).Decl);
510 Conf_Pack_Id := Conf_Pack.Next;
513 Proj.Project.Decl := User_Decl;
515 -- For aggregate projects, we need to apply the config to all
516 -- their aggregated trees as well.
518 if Proj.Project.Qualifier = Aggregate then
520 List : Aggregated_Project_List :=
521 Proj.Project.Aggregated_Projects;
523 while List /= null loop
525 ("Recursively apply config to aggregated tree",
529 Project_Tree => List.Tree);
538 end Apply_Config_File;
544 function Check_Target
545 (Config_File : Project_Id;
546 Autoconf_Specified : Boolean;
547 Project_Tree : Prj.Project_Tree_Ref;
548 Target : String := "") return Boolean
550 Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
551 Variable : constant Variable_Value :=
553 (Name_Target, Config_File.Decl.Attributes, Shared);
554 Tgt_Name : Name_Id := No_Name;
558 if Variable /= Nil_Variable_Value and then not Variable.Default then
559 Tgt_Name := Variable.Value;
563 OK := not Autoconf_Specified or else Tgt_Name = No_Name;
565 OK := Tgt_Name /= No_Name
566 and then Target = Get_Name_String (Tgt_Name);
570 if Autoconf_Specified then
572 Write_Line ("inconsistent targets, performing autoconf");
578 if Tgt_Name /= No_Name then
580 ("invalid target name """
581 & Get_Name_String (Tgt_Name) & """ in configuration");
584 ("no target specified in configuration file");
592 --------------------------------------
593 -- Get_Or_Create_Configuration_File --
594 --------------------------------------
596 procedure Get_Or_Create_Configuration_File
597 (Project : Project_Id;
598 Project_Tree : Project_Tree_Ref;
599 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
600 Env : in out Prj.Tree.Environment;
601 Allow_Automatic_Generation : Boolean;
602 Config_File_Name : String := "";
603 Autoconf_Specified : Boolean;
604 Target_Name : String := "";
605 Normalized_Hostname : String;
606 Packages_To_Check : String_List_Access := null;
607 Config : out Prj.Project_Id;
608 Config_File_Path : out String_Access;
609 Automatically_Generated : out Boolean;
610 On_Load_Config : Config_File_Hook := null)
612 Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
614 At_Least_One_Compiler_Command : Boolean := False;
615 -- Set to True if at least one attribute Ide'Compiler_Command is
616 -- specified for one language of the system.
618 function Default_File_Name return String;
619 -- Return the name of the default config file that should be tested
621 procedure Do_Autoconf;
622 -- Generate a new config file through gprconfig. In case of error, this
623 -- raises the Invalid_Config exception with an appropriate message
625 function Get_Config_Switches return Argument_List_Access;
626 -- Return the --config switches to use for gprconfig
628 function Might_Have_Sources (Project : Project_Id) return Boolean;
629 -- True if the specified project might have sources (ie the user has not
630 -- explicitly specified it. We haven't checked the file system, nor do
631 -- we need to at this stage.
633 -----------------------
634 -- Default_File_Name --
635 -----------------------
637 function Default_File_Name return String is
638 Ada_RTS : constant String := Runtime_Name_For (Name_Ada);
642 if Target_Name /= "" then
643 if Ada_RTS /= "" then
644 return Target_Name & '-' & Ada_RTS
645 & Config_Project_File_Extension;
647 return Target_Name & Config_Project_File_Extension;
650 elsif Ada_RTS /= "" then
651 return Ada_RTS & Config_Project_File_Extension;
654 Tmp := Getenv (Config_Project_Env_Var);
657 T : constant String := Tmp.all;
669 end Default_File_Name;
671 ------------------------
672 -- Might_Have_Sources --
673 ------------------------
675 function Might_Have_Sources (Project : Project_Id) return Boolean is
676 Variable : Variable_Value;
682 Project.Decl.Attributes,
685 if Variable = Nil_Variable_Value
686 or else Variable.Default
687 or else Variable.Values /= Nil_String
692 Project.Decl.Attributes,
694 return Variable = Nil_Variable_Value
695 or else Variable.Default
696 or else Variable.Values /= Nil_String;
701 end Might_Have_Sources;
703 -------------------------
704 -- Get_Config_Switches --
705 -------------------------
707 function Get_Config_Switches return Argument_List_Access is
708 package Language_Htable is new GNAT.HTable.Simple_HTable
709 (Header_Num => Prj.Header_Num,
711 No_Element => No_Name,
715 -- Hash table to keep the languages used in the project tree
717 IDE : constant Package_Id :=
718 Value_Of (Name_Ide, Project.Decl.Packages, Shared);
720 Prj_Iter : Project_List;
721 List : String_List_Id;
722 Elem : String_Element;
724 Variable : Variable_Value;
727 Result : Argument_List_Access;
729 Check_Default : Boolean;
732 Prj_Iter := Project_Tree.Projects;
733 while Prj_Iter /= null loop
734 if Might_Have_Sources (Prj_Iter.Project) then
738 Prj_Iter.Project.Decl.Attributes,
741 if Variable = Nil_Variable_Value
742 or else Variable.Default
744 -- Languages is not declared. If it is not an extending
745 -- project, or if it extends a project with no Languages,
746 -- check for Default_Language.
748 Check_Default := Prj_Iter.Project.Extends = No_Project;
750 if not Check_Default then
754 Prj_Iter.Project.Extends.Decl.Attributes,
757 Variable /= Nil_Variable_Value
758 and then Variable.Values = Nil_String;
761 if Check_Default then
764 (Name_Default_Language,
765 Prj_Iter.Project.Decl.Attributes,
768 if Variable /= Nil_Variable_Value
769 and then not Variable.Default
771 Get_Name_String (Variable.Value);
772 To_Lower (Name_Buffer (1 .. Name_Len));
774 Language_Htable.Set (Lang, Lang);
777 -- If no default language is declared, default to Ada
779 Language_Htable.Set (Name_Ada, Name_Ada);
783 elsif Variable.Values /= Nil_String then
785 -- Attribute Languages is declared with a non empty
786 -- list: put all the languages in Language_HTable.
788 List := Variable.Values;
789 while List /= Nil_String loop
790 Elem := Shared.String_Elements.Table (List);
792 Get_Name_String (Elem.Value);
793 To_Lower (Name_Buffer (1 .. Name_Len));
795 Language_Htable.Set (Lang, Lang);
802 Prj_Iter := Prj_Iter.Next;
805 Name := Language_Htable.Get_First;
807 while Name /= No_Name loop
809 Name := Language_Htable.Get_Next;
812 Result := new String_List (1 .. Count);
815 Name := Language_Htable.Get_First;
816 while Name /= No_Name loop
817 -- Check if IDE'Compiler_Command is declared for the language.
818 -- If it is, use its value to invoke gprconfig.
823 Attribute_Or_Array_Name => Name_Compiler_Command,
826 Force_Lower_Case_Index => True);
829 Config_Command : constant String :=
830 "--config=" & Get_Name_String (Name);
832 Runtime_Name : constant String :=
833 Runtime_Name_For (Name);
836 if Variable = Nil_Variable_Value
837 or else Length_Of_Name (Variable.Value) = 0
840 new String'(Config_Command & ",," & Runtime_Name);
843 At_Least_One_Compiler_Command := True;
846 Compiler_Command : constant String :=
847 Get_Name_String (Variable.Value);
850 if Is_Absolute_Path (Compiler_Command) then
853 (Config_Command & ",," & Runtime_Name & "," &
854 Containing_Directory (Compiler_Command) & "," &
855 Simple_Name (Compiler_Command));
859 (Config_Command & ",," & Runtime_Name & ",," &
867 Name := Language_Htable.Get_Next;
871 end Get_Config_Switches;
877 procedure Do_Autoconf is
878 Obj_Dir : constant Variable_Value :=
881 Project.Decl.Attributes,
884 Gprconfig_Path : String_Access;
888 Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
890 if Gprconfig_Path = null then
892 ("could not locate gprconfig for auto-configuration");
895 -- First, find the object directory of the user's project
897 if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
898 Get_Name_String (Project.Directory.Display_Name);
901 if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
902 Get_Name_String (Obj_Dir.Value);
906 Add_Str_To_Name_Buffer
907 (Get_Name_String (Project.Directory.Display_Name));
908 Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
912 if Subdirs /= null then
913 Add_Char_To_Name_Buffer (Directory_Separator);
914 Add_Str_To_Name_Buffer (Subdirs.all);
917 for J in 1 .. Name_Len loop
918 if Name_Buffer (J) = '/' then
919 Name_Buffer (J) := Directory_Separator;
924 Obj_Dir : constant String := Name_Buffer (1 .. Name_Len);
925 Config_Switches : Argument_List_Access;
926 Args : Argument_List (1 .. 5);
929 Obj_Dir_Exists : Boolean := True;
932 -- Check if the object directory exists. If Setup_Projects is True
933 -- (-p) and directory does not exist, attempt to create it.
934 -- Otherwise, if directory does not exist, fail without calling
937 if not Is_Directory (Obj_Dir)
938 and then (Setup_Projects or else Subdirs /= null)
941 Create_Path (Obj_Dir);
943 if not Quiet_Output then
944 Write_Str ("object directory """);
946 Write_Line (""" created");
952 ("could not create object directory " & Obj_Dir);
956 if not Is_Directory (Obj_Dir) then
957 case Env.Flags.Require_Obj_Dirs is
960 ("object directory " & Obj_Dir & " does not exist");
964 "?object directory " & Obj_Dir & " does not exist");
965 Obj_Dir_Exists := False;
971 -- If no switch --RTS have been specified on the command line,
972 -- look for --RTS switches in the Builder switches.
974 if RTS_Languages.Get_First = No_Name then
976 Builder : constant Package_Id :=
977 Value_Of (Name_Builder, Project.Decl.Packages, Shared);
978 Switch_Array_Id : Array_Element_Id;
980 procedure Check_RTS_Switches;
981 -- Take into account eventual switches --RTS in
984 ------------------------
985 -- Check_RTS_SWitches --
986 ------------------------
988 procedure Check_RTS_Switches is
989 Switch_Array : Array_Element;
991 Switch_List : String_List_Id := Nil_String;
992 Switch : String_Element;
995 Lang_Last : Positive;
997 while Switch_Array_Id /= No_Array_Element loop
999 Shared.Array_Elements.Table (Switch_Array_Id);
1000 Switch_List := Switch_Array.Value.Values;
1002 while Switch_List /= Nil_String loop
1004 Shared.String_Elements.Table (Switch_List);
1006 if Switch.Value /= No_Name then
1007 Get_Name_String (Switch.Value);
1009 if Name_Len >= 7 and then
1010 Name_Buffer (1 .. 5) = "--RTS"
1012 if Name_Buffer (6) = '=' then
1013 if not Runtime_Name_Set_For (Name_Ada) then
1016 Name_Buffer (7 .. Name_Len));
1019 elsif Name_Len > 7 and then
1020 Name_Buffer (6) = ':' and then
1021 Name_Buffer (7) /= '='
1024 while Lang_Last < Name_Len and then
1025 Name_Buffer (Lang_Last + 1) /= '='
1027 Lang_Last := Lang_Last + 1;
1031 Name_Buffer (Lang_Last + 1) = '='
1034 RTS : constant String :=
1035 Name_Buffer (Lang_Last + 2 ..
1038 Name_Buffer (1 .. Lang_Last - 6)
1039 := Name_Buffer (7 .. Lang_Last);
1040 Name_Len := Lang_Last - 6;
1042 (Name_Buffer (1 .. Name_Len));
1046 not Runtime_Name_Set_For (Lang)
1048 Set_Runtime_For (Lang, RTS);
1056 Switch_List := Switch.Next;
1059 Switch_Array_Id := Switch_Array.Next;
1061 end Check_RTS_Switches;
1064 if Builder /= No_Package then
1067 (Name => Name_Switches,
1069 Shared.Packages.Table (Builder).Decl.Arrays,
1075 (Name => Name_Default_Switches,
1077 Shared.Packages.Table (Builder).Decl.Arrays,
1084 -- Get the config switches. This should be done only now, as some
1085 -- runtimes may have been found if the Builder switches.
1087 Config_Switches := Get_Config_Switches;
1091 Args (1) := new String'("--batch");
1092 Args (2) := new String'("-o");
1094 -- If no config file was specified, set the auto.cgpr one
1096 if Config_File_Name = "" then
1097 if Obj_Dir_Exists then
1099 new String'(Obj_Dir & Directory_Separator & Auto_Cgpr);
1103 Path_FD : File_Descriptor;
1104 Path_Name : Path_Name_Type;
1107 Prj.Env.Create_Temp_File
1108 (Shared => Project_Tree.Shared,
1110 Path_Name => Path_Name,
1111 File_Use => "configuration file");
1113 if Path_FD /= Invalid_FD then
1114 Args (3) := new String'(Get_Name_String (Path_Name));
1115 GNAT.OS_Lib.Close (Path_FD);
1118 -- We'll have an error message later on
1122 (Obj_Dir & Directory_Separator & Auto_Cgpr);
1127 Args (3) := new String'(Config_File_Name);
1130 if Normalized_Hostname = "" then
1133 if Target_Name = "" then
1134 if At_Least_One_Compiler_Command then
1135 Args (4) := new String'("--target=all");
1139 new String'("--target=" & Normalized_Hostname);
1143 Args (4) := new String'("--target=" & Target_Name);
1149 if not Verbose_Mode then
1150 Arg_Last := Arg_Last + 1;
1151 Args (Arg_Last) := new String'("-q");
1154 if Verbose_Mode then
1155 Write_Str (Gprconfig_Name);
1157 for J in 1 .. Arg_Last loop
1159 Write_Str (Args (J).all);
1162 for J in Config_Switches'Range loop
1164 Write_Str (Config_Switches (J).all);
1169 elsif not Quiet_Output then
1170 -- Display no message if we are creating auto.cgpr, unless in
1173 if Config_File_Name /= ""
1174 or else Verbose_Mode
1176 Write_Str ("creating ");
1177 Write_Str (Simple_Name (Args (3).all));
1182 Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) &
1183 Config_Switches.all,
1186 Free (Config_Switches);
1188 Config_File_Path := Locate_Config_File (Args (3).all);
1190 if Config_File_Path = null then
1191 Raise_Invalid_Config
1192 ("could not create " & Args (3).all);
1195 for F in Args'Range loop
1202 Config_Project_Node : Project_Node_Id := Empty_Node;
1205 pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
1207 Free (Config_File_Path);
1208 Config := No_Project;
1210 if Config_File_Name /= "" then
1211 Config_File_Path := Locate_Config_File (Config_File_Name);
1213 Config_File_Path := Locate_Config_File (Default_File_Name);
1216 if Config_File_Path = null then
1217 if (not Allow_Automatic_Generation) and then
1218 Config_File_Name /= ""
1220 Raise_Invalid_Config
1221 ("could not locate main configuration project "
1222 & Config_File_Name);
1226 Automatically_Generated :=
1227 Allow_Automatic_Generation and then Config_File_Path = null;
1229 <<Process_Config_File>>
1231 if Automatically_Generated then
1232 if Hostparm.OpenVMS then
1234 -- There is no gprconfig on VMS
1236 Raise_Invalid_Config
1237 ("could not locate any configuration project file");
1240 -- This might raise an Invalid_Config exception
1245 -- If the config file is not auto-generated, warn if there is any --RTS
1246 -- switch on the command line.
1248 elsif RTS_Languages.Get_First /= No_Name and then
1249 Opt.Warning_Mode /= Opt.Suppress
1252 ("warning: --RTS is taken into account only in auto-configuration");
1255 -- Parse the configuration file
1257 if Verbose_Mode and then Config_File_Path /= null then
1258 Write_Str ("Checking configuration ");
1259 Write_Line (Config_File_Path.all);
1262 if On_Load_Config /= null then
1264 (Config_File => Config_Project_Node,
1265 Project_Node_Tree => Project_Node_Tree);
1267 elsif Config_File_Path /= null then
1269 (In_Tree => Project_Node_Tree,
1270 Project => Config_Project_Node,
1271 Project_File_Name => Config_File_Path.all,
1272 Errout_Handling => Prj.Part.Finalize_If_Error,
1273 Packages_To_Check => Packages_To_Check,
1274 Current_Directory => Current_Directory,
1275 Is_Config_File => True,
1278 Config_Project_Node := Empty_Node;
1281 if Config_Project_Node /= Empty_Node then
1282 Prj.Proc.Process_Project_Tree_Phase_1
1283 (In_Tree => Project_Tree,
1286 From_Project_Node => Config_Project_Node,
1287 From_Project_Node_Tree => Project_Node_Tree,
1289 Reset_Tree => False);
1292 if Config_Project_Node = Empty_Node
1293 or else Config = No_Project
1295 Raise_Invalid_Config
1296 ("processing of configuration project """
1297 & Config_File_Path.all & """ failed");
1300 -- Check that the target of the configuration file is the one the user
1301 -- specified on the command line. We do not need to check that when in
1302 -- auto-conf mode, since the appropriate target was passed to gprconfig.
1304 if not Automatically_Generated
1306 Check_Target (Config, Autoconf_Specified, Project_Tree, Target_Name)
1308 Automatically_Generated := True;
1309 goto Process_Config_File;
1311 end Get_Or_Create_Configuration_File;
1313 ------------------------
1314 -- Locate_Config_File --
1315 ------------------------
1317 function Locate_Config_File (Name : String) return String_Access is
1318 Prefix_Path : constant String := Executable_Prefix_Path;
1320 if Prefix_Path'Length /= 0 then
1321 return Locate_Regular_File
1323 "." & Path_Separator &
1324 Prefix_Path & "share" & Directory_Separator & "gpr");
1326 return Locate_Regular_File (Name, ".");
1328 end Locate_Config_File;
1330 ------------------------------------
1331 -- Parse_Project_And_Apply_Config --
1332 ------------------------------------
1334 procedure Parse_Project_And_Apply_Config
1335 (Main_Project : out Prj.Project_Id;
1336 User_Project_Node : out Prj.Tree.Project_Node_Id;
1337 Config_File_Name : String := "";
1338 Autoconf_Specified : Boolean;
1339 Project_File_Name : String;
1340 Project_Tree : Prj.Project_Tree_Ref;
1341 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
1342 Env : in out Prj.Tree.Environment;
1343 Packages_To_Check : String_List_Access;
1344 Allow_Automatic_Generation : Boolean := True;
1345 Automatically_Generated : out Boolean;
1346 Config_File_Path : out String_Access;
1347 Target_Name : String := "";
1348 Normalized_Hostname : String;
1349 On_Load_Config : Config_File_Hook := null)
1352 pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
1354 -- Parse the user project tree
1356 Prj.Initialize (Project_Tree);
1358 Main_Project := No_Project;
1359 Automatically_Generated := False;
1362 (In_Tree => Project_Node_Tree,
1363 Project => User_Project_Node,
1364 Project_File_Name => Project_File_Name,
1365 Errout_Handling => Prj.Part.Finalize_If_Error,
1366 Packages_To_Check => Packages_To_Check,
1367 Current_Directory => Current_Directory,
1368 Is_Config_File => False,
1371 if User_Project_Node = Empty_Node then
1372 User_Project_Node := Empty_Node;
1376 Process_Project_And_Apply_Config
1377 (Main_Project => Main_Project,
1378 User_Project_Node => User_Project_Node,
1379 Config_File_Name => Config_File_Name,
1380 Autoconf_Specified => Autoconf_Specified,
1381 Project_Tree => Project_Tree,
1382 Project_Node_Tree => Project_Node_Tree,
1384 Packages_To_Check => Packages_To_Check,
1385 Allow_Automatic_Generation => Allow_Automatic_Generation,
1386 Automatically_Generated => Automatically_Generated,
1387 Config_File_Path => Config_File_Path,
1388 Target_Name => Target_Name,
1389 Normalized_Hostname => Normalized_Hostname,
1390 On_Load_Config => On_Load_Config);
1391 end Parse_Project_And_Apply_Config;
1393 --------------------------------------
1394 -- Process_Project_And_Apply_Config --
1395 --------------------------------------
1397 procedure Process_Project_And_Apply_Config
1398 (Main_Project : out Prj.Project_Id;
1399 User_Project_Node : Prj.Tree.Project_Node_Id;
1400 Config_File_Name : String := "";
1401 Autoconf_Specified : Boolean;
1402 Project_Tree : Prj.Project_Tree_Ref;
1403 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
1404 Env : in out Prj.Tree.Environment;
1405 Packages_To_Check : String_List_Access;
1406 Allow_Automatic_Generation : Boolean := True;
1407 Automatically_Generated : out Boolean;
1408 Config_File_Path : out String_Access;
1409 Target_Name : String := "";
1410 Normalized_Hostname : String;
1411 On_Load_Config : Config_File_Hook := null;
1412 Reset_Tree : Boolean := True)
1414 Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
1415 Main_Config_Project : Project_Id;
1419 Main_Project := No_Project;
1420 Automatically_Generated := False;
1422 Process_Project_Tree_Phase_1
1423 (In_Tree => Project_Tree,
1424 Project => Main_Project,
1426 From_Project_Node => User_Project_Node,
1427 From_Project_Node_Tree => Project_Node_Tree,
1429 Reset_Tree => Reset_Tree);
1432 Main_Project := No_Project;
1436 if Project_Tree.Source_Info_File_Name /= null then
1437 if not Is_Absolute_Path (Project_Tree.Source_Info_File_Name.all) then
1439 Obj_Dir : constant Variable_Value :=
1442 Main_Project.Decl.Attributes,
1446 if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
1447 Get_Name_String (Main_Project.Directory.Display_Name);
1450 if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
1451 Get_Name_String (Obj_Dir.Value);
1455 Add_Str_To_Name_Buffer
1456 (Get_Name_String (Main_Project.Directory.Display_Name));
1457 Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
1461 Add_Char_To_Name_Buffer (Directory_Separator);
1462 Add_Str_To_Name_Buffer (Project_Tree.Source_Info_File_Name.all);
1463 Free (Project_Tree.Source_Info_File_Name);
1464 Project_Tree.Source_Info_File_Name :=
1465 new String'(Name_Buffer (1 .. Name_Len));
1469 Read_Source_Info_File (Project_Tree);
1472 -- Find configuration file
1474 Get_Or_Create_Configuration_File
1475 (Config => Main_Config_Project,
1476 Project => Main_Project,
1477 Project_Tree => Project_Tree,
1478 Project_Node_Tree => Project_Node_Tree,
1480 Allow_Automatic_Generation => Allow_Automatic_Generation,
1481 Config_File_Name => Config_File_Name,
1482 Autoconf_Specified => Autoconf_Specified,
1483 Target_Name => Target_Name,
1484 Normalized_Hostname => Normalized_Hostname,
1485 Packages_To_Check => Packages_To_Check,
1486 Config_File_Path => Config_File_Path,
1487 Automatically_Generated => Automatically_Generated,
1488 On_Load_Config => On_Load_Config);
1490 Apply_Config_File (Main_Config_Project, Project_Tree);
1492 -- Finish processing the user's project
1494 Prj.Proc.Process_Project_Tree_Phase_2
1495 (In_Tree => Project_Tree,
1496 Project => Main_Project,
1498 From_Project_Node => User_Project_Node,
1499 From_Project_Node_Tree => Project_Node_Tree,
1503 if Project_Tree.Source_Info_File_Name /= null and then
1504 not Project_Tree.Source_Info_File_Exists
1506 Write_Source_Info_File (Project_Tree);
1510 Main_Project := No_Project;
1512 end Process_Project_And_Apply_Config;
1514 --------------------------
1515 -- Raise_Invalid_Config --
1516 --------------------------
1518 procedure Raise_Invalid_Config (Msg : String) is
1520 Raise_Exception (Invalid_Config'Identity, Msg);
1521 end Raise_Invalid_Config;
1523 ----------------------
1524 -- Runtime_Name_For --
1525 ----------------------
1527 function Runtime_Name_For (Language : Name_Id) return String is
1529 if RTS_Languages.Get (Language) /= No_Name then
1530 return Get_Name_String (RTS_Languages.Get (Language));
1534 end Runtime_Name_For;
1536 --------------------------
1537 -- Runtime_Name_Set_For --
1538 --------------------------
1540 function Runtime_Name_Set_For (Language : Name_Id) return Boolean is
1542 return RTS_Languages.Get (Language) /= No_Name;
1543 end Runtime_Name_Set_For;
1545 ---------------------
1546 -- Set_Runtime_For --
1547 ---------------------
1549 procedure Set_Runtime_For (Language : Name_Id; RTS_Name : String) is
1551 Name_Len := RTS_Name'Length;
1552 Name_Buffer (1 .. Name_Len) := RTS_Name;
1553 RTS_Languages.Set (Language, Name_Find);
1554 end Set_Runtime_For;