-- --
-- GNAT COMPILER COMPONENTS --
-- --
--- P R J . C O N F --
+-- P R J . C O N F --
-- --
-- B o d y --
-- --
--- Copyright (C) 2006-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2006-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Auto_Cgpr : constant String := "auto.cgpr";
- Default_Name : constant String := "default.cgpr";
- -- Default configuration file that will be used if found
-
Config_Project_Env_Var : constant String := "GPR_CONFIG";
-- Name of the environment variable that provides the name of the
-- configuration file to use.
Tgt_Name := Variable.Value;
end if;
- if Target = "" then
- OK := not Autoconf_Specified or else Tgt_Name = No_Name;
- else
- OK := Tgt_Name /= No_Name
- and then Target = Get_Name_String (Tgt_Name);
- end if;
+ OK :=
+ Target = ""
+ or else (Tgt_Name /= No_Name
+ and then Target = Get_Name_String (Tgt_Name));
if not OK then
if Autoconf_Specified then
procedure Get_Or_Create_Configuration_File
(Project : Project_Id;
+ Conf_Project : Project_Id;
Project_Tree : Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
-- Set to True if at least one attribute Ide'Compiler_Command is
-- specified for one language of the system.
+ Conf_File_Name : String_Access := new String'(Config_File_Name);
+ -- The configuration project file name. May be modified if there are
+ -- switches --config= in the Builder package of the main project.
+
+ Selected_Target : String_Access := new String'(Target_Name);
+
function Default_File_Name return String;
-- Return the name of the default config file that should be tested
-- Generate a new config file through gprconfig. In case of error, this
-- raises the Invalid_Config exception with an appropriate message
+ procedure Check_Builder_Switches;
+ -- Check for switches --config and --RTS in package Builder
+
+ procedure Get_Project_Target;
+ -- Target_Name is empty, get the specifiedtarget in the project file,
+ -- if any.
+
function Get_Config_Switches return Argument_List_Access;
-- Return the --config switches to use for gprconfig
+ function Get_Db_Switches return Argument_List_Access;
+ -- Return the --db switches to use for gprconfig
+
function Might_Have_Sources (Project : Project_Id) return Boolean;
-- True if the specified project might have sources (ie the user has not
-- explicitly specified it. We haven't checked the file system, nor do
-- we need to at this stage.
+ ----------------------------
+ -- Check_Builder_Switches --
+ ----------------------------
+
+ procedure Check_Builder_Switches is
+ Get_RTS_Switches : constant Boolean :=
+ RTS_Languages.Get_First = No_Name;
+ -- If no switch --RTS have been specified on the command line, look
+ -- for --RTS switches in the Builder switches.
+
+ Builder : constant Package_Id :=
+ Value_Of (Name_Builder, Project.Decl.Packages, Shared);
+
+ Switch_Array_Id : Array_Element_Id;
+ -- The Switches to be checked
+
+ procedure Check_Switches;
+ -- Check the switches in Switch_Array_Id
+
+ --------------------
+ -- Check_Switches --
+ --------------------
+
+ procedure Check_Switches is
+ Switch_Array : Array_Element;
+ Switch_List : String_List_Id := Nil_String;
+ Switch : String_Element;
+ Lang : Name_Id;
+ Lang_Last : Positive;
+
+ begin
+ while Switch_Array_Id /= No_Array_Element loop
+ Switch_Array :=
+ Shared.Array_Elements.Table (Switch_Array_Id);
+
+ Switch_List := Switch_Array.Value.Values;
+ List_Loop : while Switch_List /= Nil_String loop
+ Switch := Shared.String_Elements.Table (Switch_List);
+
+ if Switch.Value /= No_Name then
+ Get_Name_String (Switch.Value);
+
+ if Conf_File_Name'Length = 0
+ and then Name_Len > 9
+ and then Name_Buffer (1 .. 9) = "--config="
+ then
+ Conf_File_Name :=
+ new String'(Name_Buffer (10 .. Name_Len));
+
+ elsif Get_RTS_Switches
+ and then Name_Len >= 7
+ and then Name_Buffer (1 .. 5) = "--RTS"
+ then
+ if Name_Buffer (6) = '=' then
+ if not Runtime_Name_Set_For (Name_Ada) then
+ Set_Runtime_For
+ (Name_Ada,
+ Name_Buffer (7 .. Name_Len));
+ Locate_Runtime (Name_Ada, Project_Tree);
+ end if;
+
+ elsif Name_Len > 7
+ and then Name_Buffer (6) = ':'
+ and then Name_Buffer (7) /= '='
+ then
+ Lang_Last := 7;
+ while Lang_Last < Name_Len
+ and then Name_Buffer (Lang_Last + 1) /= '='
+ loop
+ Lang_Last := Lang_Last + 1;
+ end loop;
+
+ if Name_Buffer (Lang_Last + 1) = '=' then
+ declare
+ RTS : constant String :=
+ Name_Buffer (Lang_Last + 2 .. Name_Len);
+ begin
+ Name_Buffer (1 .. Lang_Last - 6) :=
+ Name_Buffer (7 .. Lang_Last);
+ Name_Len := Lang_Last - 6;
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Lang := Name_Find;
+
+ if not Runtime_Name_Set_For (Lang) then
+ Set_Runtime_For (Lang, RTS);
+ Locate_Runtime (Lang, Project_Tree);
+ end if;
+ end;
+ end if;
+ end if;
+ end if;
+ end if;
+
+ Switch_List := Switch.Next;
+ end loop List_Loop;
+
+ Switch_Array_Id := Switch_Array.Next;
+ end loop;
+ end Check_Switches;
+
+ -- Start of processing for Check_Builder_Switches
+
+ begin
+ if Builder /= No_Package then
+ Switch_Array_Id :=
+ Value_Of
+ (Name => Name_Switches,
+ In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays,
+ Shared => Shared);
+ Check_Switches;
+
+ Switch_Array_Id :=
+ Value_Of
+ (Name => Name_Default_Switches,
+ In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays,
+ Shared => Shared);
+ Check_Switches;
+ end if;
+ end Check_Builder_Switches;
+
+ ------------------------
+ -- Get_Project_Target --
+ ------------------------
+
+ procedure Get_Project_Target is
+ begin
+ if Selected_Target'Length = 0 then
+
+ -- Check if attribute Target is specified in the main
+ -- project, or in a project it extends. If it is, use this
+ -- target to invoke gprconfig.
+
+ declare
+ Variable : Variable_Value;
+ Proj : Project_Id;
+ Tgt_Name : Name_Id := No_Name;
+
+ begin
+ Proj := Project;
+ Project_Loop :
+ while Proj /= No_Project loop
+ Variable :=
+ Value_Of (Name_Target, Proj.Decl.Attributes, Shared);
+
+ if Variable /= Nil_Variable_Value
+ and then not Variable.Default
+ and then Variable.Value /= No_Name
+ then
+ Tgt_Name := Variable.Value;
+ exit Project_Loop;
+ end if;
+
+ Proj := Proj.Extends;
+ end loop Project_Loop;
+
+ if Tgt_Name /= No_Name then
+ Selected_Target := new String'(Get_Name_String (Tgt_Name));
+ end if;
+ end;
+ end if;
+ end Get_Project_Target;
+
-----------------------
-- Default_File_Name --
-----------------------
Tmp : String_Access;
begin
- if Target_Name /= "" then
+ if Selected_Target'Length /= 0 then
if Ada_RTS /= "" then
- return Target_Name & '-' & Ada_RTS
- & Config_Project_File_Extension;
+ return
+ Selected_Target.all & '-' &
+ Ada_RTS & Config_Project_File_Extension;
else
- return Target_Name & Config_Project_File_Extension;
+ return
+ Selected_Target.all & Config_Project_File_Extension;
end if;
elsif Ada_RTS /= "" then
Free (Tmp);
if T'Length = 0 then
- return Default_Name;
+ return Default_Config_Name;
else
return T;
end if;
end if;
end Default_File_Name;
- ------------------------
- -- Might_Have_Sources --
- ------------------------
+ -----------------
+ -- Do_Autoconf --
+ -----------------
- function Might_Have_Sources (Project : Project_Id) return Boolean is
- Variable : Variable_Value;
+ procedure Do_Autoconf is
+ Obj_Dir : constant Variable_Value :=
+ Value_Of
+ (Name_Object_Dir,
+ Conf_Project.Decl.Attributes,
+ Shared);
- begin
- Variable :=
- Value_Of
- (Name_Source_Dirs,
- Project.Decl.Attributes,
- Shared);
+ Gprconfig_Path : String_Access;
+ Success : Boolean;
- if Variable = Nil_Variable_Value
- or else Variable.Default
- or else Variable.Values /= Nil_String
- then
- Variable :=
- Value_Of
- (Name_Source_Files,
- Project.Decl.Attributes,
- Shared);
- return Variable = Nil_Variable_Value
- or else Variable.Default
- or else Variable.Values /= Nil_String;
+ begin
+ Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
- else
- return False;
+ if Gprconfig_Path = null then
+ Raise_Invalid_Config
+ ("could not locate gprconfig for auto-configuration");
end if;
- end Might_Have_Sources;
- -------------------------
- -- Get_Config_Switches --
- -------------------------
+ -- First, find the object directory of the Conf_Project
- function Get_Config_Switches return Argument_List_Access is
+ if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
+ Get_Name_String (Conf_Project.Directory.Display_Name);
- package Language_Htable is new GNAT.HTable.Simple_HTable
- (Header_Num => Prj.Header_Num,
- Element => Name_Id,
- No_Element => No_Name,
- Key => Name_Id,
- Hash => Prj.Hash,
- Equal => "=");
- -- Hash table to keep the languages used in the project tree
+ else
+ if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
+ Get_Name_String (Obj_Dir.Value);
- IDE : constant Package_Id :=
- Value_Of (Name_Ide, Project.Decl.Packages, Shared);
+ else
+ Name_Len := 0;
+ Add_Str_To_Name_Buffer
+ (Get_Name_String (Conf_Project.Directory.Display_Name));
+ Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
+ end if;
+ end if;
- procedure Add_Config_Switches_For_Project
- (Project : Project_Id;
- Tree : Project_Tree_Ref;
- With_State : in out Integer);
- -- Add all --config switches for this project. This is also called
- -- for aggregate projects.
+ if Subdirs /= null then
+ Add_Char_To_Name_Buffer (Directory_Separator);
+ Add_Str_To_Name_Buffer (Subdirs.all);
+ end if;
- -------------------------------------
- -- Add_Config_Switches_For_Project --
- -------------------------------------
+ for J in 1 .. Name_Len loop
+ if Name_Buffer (J) = '/' then
+ Name_Buffer (J) := Directory_Separator;
+ end if;
+ end loop;
- procedure Add_Config_Switches_For_Project
- (Project : Project_Id;
- Tree : Project_Tree_Ref;
- With_State : in out Integer)
- is
- pragma Unreferenced (With_State);
+ -- Make sure that Obj_Dir ends with a directory separator
- Shared : constant Shared_Project_Tree_Data_Access := Tree.Shared;
+ if Name_Buffer (Name_Len) /= Directory_Separator then
+ Name_Len := Name_Len + 1;
+ Name_Buffer (Name_Len) := Directory_Separator;
+ end if;
- Variable : Variable_Value;
- Check_Default : Boolean;
- Lang : Name_Id;
- List : String_List_Id;
- Elem : String_Element;
+ declare
+ Obj_Dir : constant String := Name_Buffer (1 .. Name_Len);
+ Config_Switches : Argument_List_Access;
+ Db_Switches : Argument_List_Access;
+ Args : Argument_List (1 .. 5);
+ Arg_Last : Positive;
+ Obj_Dir_Exists : Boolean := True;
begin
- if Might_Have_Sources (Project) then
- Variable :=
- Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
-
- if Variable = Nil_Variable_Value or else Variable.Default then
-
- -- Languages is not declared. If it is not an extending
- -- project, or if it extends a project with no Languages,
- -- check for Default_Language.
+ -- Check if the object directory exists. If Setup_Projects is True
+ -- (-p) and directory does not exist, attempt to create it.
+ -- Otherwise, if directory does not exist, fail without calling
+ -- gprconfig.
- Check_Default := Project.Extends = No_Project;
+ if not Is_Directory (Obj_Dir)
+ and then (Setup_Projects or else Subdirs /= null)
+ then
+ begin
+ Create_Path (Obj_Dir);
- if not Check_Default then
- Variable :=
- Value_Of
- (Name_Languages,
- Project.Extends.Decl.Attributes,
- Shared);
- Check_Default :=
- Variable /= Nil_Variable_Value
- and then Variable.Values = Nil_String;
+ if not Quiet_Output then
+ Write_Str ("object directory """);
+ Write_Str (Obj_Dir);
+ Write_Line (""" created");
end if;
- if Check_Default then
- Variable :=
- Value_Of
- (Name_Default_Language,
- Project.Decl.Attributes,
- Shared);
+ exception
+ when others =>
+ Raise_Invalid_Config
+ ("could not create object directory " & Obj_Dir);
+ end;
+ end if;
- if Variable /= Nil_Variable_Value
- and then not Variable.Default
- then
- Get_Name_String (Variable.Value);
- To_Lower (Name_Buffer (1 .. Name_Len));
- Lang := Name_Find;
- Language_Htable.Set (Lang, Lang);
+ if not Is_Directory (Obj_Dir) then
+ case Env.Flags.Require_Obj_Dirs is
+ when Error =>
+ Raise_Invalid_Config
+ ("object directory " & Obj_Dir & " does not exist");
- -- If no default language is declared, default to Ada
+ when Warning =>
+ Prj.Err.Error_Msg
+ (Env.Flags,
+ "?object directory " & Obj_Dir & " does not exist");
+ Obj_Dir_Exists := False;
- else
- Language_Htable.Set (Name_Ada, Name_Ada);
- end if;
- end if;
+ when Silent =>
+ null;
+ end case;
+ end if;
- elsif Variable.Values /= Nil_String then
+ -- Get the config switches. This should be done only now, as some
+ -- runtimes may have been found if the Builder switches.
- -- Attribute Languages is declared with a non empty list:
- -- put all the languages in Language_HTable.
+ Config_Switches := Get_Config_Switches;
- List := Variable.Values;
- while List /= Nil_String loop
- Elem := Shared.String_Elements.Table (List);
+ -- Get eventual --db switches
- Get_Name_String (Elem.Value);
- To_Lower (Name_Buffer (1 .. Name_Len));
- Lang := Name_Find;
- Language_Htable.Set (Lang, Lang);
+ Db_Switches := Get_Db_Switches;
- List := Elem.Next;
- end loop;
- end if;
- end if;
- end Add_Config_Switches_For_Project;
+ -- Invoke gprconfig
- procedure For_Every_Imported_Project is new For_Every_Project_Imported
- (State => Integer, Action => Add_Config_Switches_For_Project);
- -- Document this procedure ???
-
- -- Local variables
-
- Name : Name_Id;
- Count : Natural;
- Result : Argument_List_Access;
- Variable : Variable_Value;
- Dummy : Integer := 0;
-
- -- Start of processing for Get_Config_Switches
-
- begin
- For_Every_Imported_Project
- (By => Project,
- Tree => Project_Tree,
- With_State => Dummy,
- Include_Aggregated => True);
-
- Name := Language_Htable.Get_First;
- Count := 0;
- while Name /= No_Name loop
- Count := Count + 1;
- Name := Language_Htable.Get_Next;
- end loop;
-
- Result := new String_List (1 .. Count);
-
- Count := 1;
- Name := Language_Htable.Get_First;
- while Name /= No_Name loop
-
- -- Check if IDE'Compiler_Command is declared for the language.
- -- If it is, use its value to invoke gprconfig.
-
- Variable :=
- Value_Of
- (Name,
- Attribute_Or_Array_Name => Name_Compiler_Command,
- In_Package => IDE,
- Shared => Shared,
- Force_Lower_Case_Index => True);
-
- declare
- Config_Command : constant String :=
- "--config=" & Get_Name_String (Name);
-
- Runtime_Name : constant String :=
- Runtime_Name_For (Name);
-
- begin
- if Variable = Nil_Variable_Value
- or else Length_Of_Name (Variable.Value) = 0
- then
- Result (Count) :=
- new String'(Config_Command & ",," & Runtime_Name);
-
- else
- At_Least_One_Compiler_Command := True;
-
- declare
- Compiler_Command : constant String :=
- Get_Name_String (Variable.Value);
-
- begin
- if Is_Absolute_Path (Compiler_Command) then
- Result (Count) :=
- new String'
- (Config_Command & ",," & Runtime_Name & "," &
- Containing_Directory (Compiler_Command) & "," &
- Simple_Name (Compiler_Command));
- else
- Result (Count) :=
- new String'
- (Config_Command & ",," & Runtime_Name & ",," &
- Compiler_Command);
- end if;
- end;
- end if;
- end;
-
- Count := Count + 1;
- Name := Language_Htable.Get_Next;
- end loop;
-
- return Result;
- end Get_Config_Switches;
-
- -----------------
- -- Do_Autoconf --
- -----------------
-
- procedure Do_Autoconf is
- Obj_Dir : constant Variable_Value :=
- Value_Of
- (Name_Object_Dir,
- Project.Decl.Attributes,
- Shared);
-
- Gprconfig_Path : String_Access;
- Success : Boolean;
-
- begin
- Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
-
- if Gprconfig_Path = null then
- Raise_Invalid_Config
- ("could not locate gprconfig for auto-configuration");
- end if;
-
- -- First, find the object directory of the user's project
-
- if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
- Get_Name_String (Project.Directory.Display_Name);
-
- else
- if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
- Get_Name_String (Obj_Dir.Value);
-
- else
- Name_Len := 0;
- Add_Str_To_Name_Buffer
- (Get_Name_String (Project.Directory.Display_Name));
- Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
- end if;
- end if;
-
- if Subdirs /= null then
- Add_Char_To_Name_Buffer (Directory_Separator);
- Add_Str_To_Name_Buffer (Subdirs.all);
- end if;
-
- for J in 1 .. Name_Len loop
- if Name_Buffer (J) = '/' then
- Name_Buffer (J) := Directory_Separator;
- end if;
- end loop;
-
- -- Make sure that Obj_Dir ends with a directory separator
-
- if Name_Buffer (Name_Len) /= Directory_Separator then
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Directory_Separator;
- end if;
-
- declare
- Obj_Dir : constant String := Name_Buffer (1 .. Name_Len);
- Config_Switches : Argument_List_Access;
- Args : Argument_List (1 .. 5);
- Arg_Last : Positive;
- Obj_Dir_Exists : Boolean := True;
-
- begin
- -- Check if the object directory exists. If Setup_Projects is True
- -- (-p) and directory does not exist, attempt to create it.
- -- Otherwise, if directory does not exist, fail without calling
- -- gprconfig.
-
- if not Is_Directory (Obj_Dir)
- and then (Setup_Projects or else Subdirs /= null)
- then
- begin
- Create_Path (Obj_Dir);
-
- if not Quiet_Output then
- Write_Str ("object directory """);
- Write_Str (Obj_Dir);
- Write_Line (""" created");
- end if;
-
- exception
- when others =>
- Raise_Invalid_Config
- ("could not create object directory " & Obj_Dir);
- end;
- end if;
-
- if not Is_Directory (Obj_Dir) then
- case Env.Flags.Require_Obj_Dirs is
- when Error =>
- Raise_Invalid_Config
- ("object directory " & Obj_Dir & " does not exist");
-
- when Warning =>
- Prj.Err.Error_Msg
- (Env.Flags,
- "?object directory " & Obj_Dir & " does not exist");
- Obj_Dir_Exists := False;
-
- when Silent =>
- null;
- end case;
- end if;
-
- -- If no switch --RTS have been specified on the command line,
- -- look for --RTS switches in the Builder switches.
-
- if RTS_Languages.Get_First = No_Name then
- declare
- Builder : constant Package_Id :=
- Value_Of
- (Name_Builder, Project.Decl.Packages, Shared);
- Switch_Array_Id : Array_Element_Id;
-
- procedure Check_RTS_Switches;
- -- Take into account eventual switches --RTS in
- -- Switch_Array_Id.
-
- ------------------------
- -- Check_RTS_SWitches --
- ------------------------
-
- procedure Check_RTS_Switches is
- Switch_Array : Array_Element;
- Switch_List : String_List_Id := Nil_String;
- Switch : String_Element;
- Lang : Name_Id;
- Lang_Last : Positive;
-
- begin
- while Switch_Array_Id /= No_Array_Element loop
- Switch_Array :=
- Shared.Array_Elements.Table (Switch_Array_Id);
-
- Switch_List := Switch_Array.Value.Values;
- while Switch_List /= Nil_String loop
- Switch :=
- Shared.String_Elements.Table (Switch_List);
-
- if Switch.Value /= No_Name then
- Get_Name_String (Switch.Value);
-
- if Name_Len >= 7 and then
- Name_Buffer (1 .. 5) = "--RTS"
- then
- if Name_Buffer (6) = '=' then
- if not Runtime_Name_Set_For (Name_Ada) then
- Set_Runtime_For
- (Name_Ada,
- Name_Buffer (7 .. Name_Len));
- end if;
-
- elsif Name_Len > 7 and then
- Name_Buffer (6) = ':' and then
- Name_Buffer (7) /= '='
- then
- Lang_Last := 7;
- while Lang_Last < Name_Len and then
- Name_Buffer (Lang_Last + 1) /= '='
- loop
- Lang_Last := Lang_Last + 1;
- end loop;
-
- if Name_Buffer (Lang_Last + 1) = '=' then
- declare
- RTS : constant String :=
- Name_Buffer (Lang_Last + 2 ..
- Name_Len);
- begin
- Name_Buffer (1 .. Lang_Last - 6) :=
- Name_Buffer (7 .. Lang_Last);
- Name_Len := Lang_Last - 6;
- To_Lower
- (Name_Buffer (1 .. Name_Len));
- Lang := Name_Find;
-
- if not
- Runtime_Name_Set_For (Lang)
- then
- Set_Runtime_For (Lang, RTS);
- end if;
- end;
- end if;
- end if;
- end if;
- end if;
-
- Switch_List := Switch.Next;
- end loop;
-
- Switch_Array_Id := Switch_Array.Next;
- end loop;
- end Check_RTS_Switches;
-
- begin
- if Builder /= No_Package then
- Switch_Array_Id :=
- Value_Of
- (Name => Name_Switches,
- In_Arrays =>
- Shared.Packages.Table (Builder).Decl.Arrays,
- Shared => Shared);
- Check_RTS_Switches;
-
- Switch_Array_Id :=
- Value_Of
- (Name => Name_Default_Switches,
- In_Arrays =>
- Shared.Packages.Table (Builder).Decl.Arrays,
- Shared => Shared);
- Check_RTS_Switches;
- end if;
- end;
- end if;
-
- -- Get the config switches. This should be done only now, as some
- -- runtimes may have been found if the Builder switches.
-
- Config_Switches := Get_Config_Switches;
-
- -- Invoke gprconfig
-
- Args (1) := new String'("--batch");
- Args (2) := new String'("-o");
+ Args (1) := new String'("--batch");
+ Args (2) := new String'("-o");
-- If no config file was specified, set the auto.cgpr one
- if Config_File_Name = "" then
+ if Conf_File_Name'Length = 0 then
if Obj_Dir_Exists then
Args (3) := new String'(Obj_Dir & Auto_Cgpr);
end;
end if;
else
- Args (3) := new String'(Config_File_Name);
+ Args (3) := Conf_File_Name;
end if;
if Normalized_Hostname = "" then
Arg_Last := 3;
else
- if Target_Name = "" then
+ if Selected_Target'Length = 0 then
if At_Least_One_Compiler_Command then
- Args (4) := new String'("--target=all");
-
+ Args (4) :=
+ new String'("--target=all");
else
Args (4) :=
new String'("--target=" & Normalized_Hostname);
end if;
else
- Args (4) := new String'("--target=" & Target_Name);
+ Args (4) :=
+ new String'("--target=" & Selected_Target.all);
end if;
Arg_Last := 4;
Write_Str (Config_Switches (J).all);
end loop;
+ for J in Db_Switches'Range loop
+ Write_Char (' ');
+ Write_Str (Db_Switches (J).all);
+ end loop;
+
Write_Eol;
elsif not Quiet_Output then
-- Display no message if we are creating auto.cgpr, unless in
-- verbose mode
- if Config_File_Name /= ""
+ if Config_File_Name'Length > 0
or else Verbose_Mode
then
Write_Str ("creating ");
end if;
Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) &
- Config_Switches.all,
+ Config_Switches.all & Db_Switches.all,
Success);
Free (Config_Switches);
end;
end Do_Autoconf;
+ ---------------------
+ -- Get_Db_Switches --
+ ---------------------
+
+ function Get_Db_Switches return Argument_List_Access is
+ Result : Argument_List_Access;
+ Nmb_Arg : Natural;
+ begin
+ Nmb_Arg :=
+ (2 * Db_Switch_Args.Last) + Boolean'Pos (not Load_Standard_Base);
+ Result := new Argument_List (1 .. Nmb_Arg);
+
+ if Nmb_Arg /= 0 then
+ for J in 1 .. Db_Switch_Args.Last loop
+ Result (2 * J - 1) :=
+ new String'("--db");
+ Result (2 * J) :=
+ new String'(Get_Name_String (Db_Switch_Args.Table (J)));
+ end loop;
+
+ if not Load_Standard_Base then
+ Result (Result'Last) := new String'("--db-");
+ end if;
+ end if;
+
+ return Result;
+ end Get_Db_Switches;
+
+ -------------------------
+ -- Get_Config_Switches --
+ -------------------------
+
+ function Get_Config_Switches return Argument_List_Access is
+
+ package Language_Htable is new GNAT.HTable.Simple_HTable
+ (Header_Num => Prj.Header_Num,
+ Element => Name_Id,
+ No_Element => No_Name,
+ Key => Name_Id,
+ Hash => Prj.Hash,
+ Equal => "=");
+ -- Hash table to keep the languages used in the project tree
+
+ IDE : constant Package_Id :=
+ Value_Of (Name_Ide, Project.Decl.Packages, Shared);
+
+ procedure Add_Config_Switches_For_Project
+ (Project : Project_Id;
+ Tree : Project_Tree_Ref;
+ With_State : in out Integer);
+ -- Add all --config switches for this project. This is also called
+ -- for aggregate projects.
+
+ -------------------------------------
+ -- Add_Config_Switches_For_Project --
+ -------------------------------------
+
+ procedure Add_Config_Switches_For_Project
+ (Project : Project_Id;
+ Tree : Project_Tree_Ref;
+ With_State : in out Integer)
+ is
+ pragma Unreferenced (With_State);
+
+ Shared : constant Shared_Project_Tree_Data_Access := Tree.Shared;
+
+ Variable : Variable_Value;
+ Check_Default : Boolean;
+ Lang : Name_Id;
+ List : String_List_Id;
+ Elem : String_Element;
+
+ begin
+ if Might_Have_Sources (Project) then
+ Variable :=
+ Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
+
+ if Variable = Nil_Variable_Value or else Variable.Default then
+
+ -- Languages is not declared. If it is not an extending
+ -- project, or if it extends a project with no Languages,
+ -- check for Default_Language.
+
+ Check_Default := Project.Extends = No_Project;
+
+ if not Check_Default then
+ Variable :=
+ Value_Of
+ (Name_Languages,
+ Project.Extends.Decl.Attributes,
+ Shared);
+ Check_Default :=
+ Variable /= Nil_Variable_Value
+ and then Variable.Values = Nil_String;
+ end if;
+
+ if Check_Default then
+ Variable :=
+ Value_Of
+ (Name_Default_Language,
+ Project.Decl.Attributes,
+ Shared);
+
+ if Variable /= Nil_Variable_Value
+ and then not Variable.Default
+ then
+ Get_Name_String (Variable.Value);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Lang := Name_Find;
+ Language_Htable.Set (Lang, Lang);
+
+ -- If no default language is declared, default to Ada
+
+ else
+ Language_Htable.Set (Name_Ada, Name_Ada);
+ end if;
+ end if;
+
+ elsif Variable.Values /= Nil_String then
+
+ -- Attribute Languages is declared with a non empty list:
+ -- put all the languages in Language_HTable.
+
+ List := Variable.Values;
+ while List /= Nil_String loop
+ Elem := Shared.String_Elements.Table (List);
+
+ Get_Name_String (Elem.Value);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Lang := Name_Find;
+ Language_Htable.Set (Lang, Lang);
+
+ List := Elem.Next;
+ end loop;
+ end if;
+ end if;
+ end Add_Config_Switches_For_Project;
+
+ procedure For_Every_Imported_Project is new For_Every_Project_Imported
+ (State => Integer, Action => Add_Config_Switches_For_Project);
+ -- Document this procedure ???
+
+ -- Local variables
+
+ Name : Name_Id;
+ Count : Natural;
+ Result : Argument_List_Access;
+ Variable : Variable_Value;
+ Dummy : Integer := 0;
+
+ -- Start of processing for Get_Config_Switches
+
+ begin
+ For_Every_Imported_Project
+ (By => Project,
+ Tree => Project_Tree,
+ With_State => Dummy,
+ Include_Aggregated => True);
+
+ Name := Language_Htable.Get_First;
+ Count := 0;
+ while Name /= No_Name loop
+ Count := Count + 1;
+ Name := Language_Htable.Get_Next;
+ end loop;
+
+ Result := new String_List (1 .. Count);
+
+ Count := 1;
+ Name := Language_Htable.Get_First;
+ while Name /= No_Name loop
+
+ -- Check if IDE'Compiler_Command is declared for the language.
+ -- If it is, use its value to invoke gprconfig.
+
+ Variable :=
+ Value_Of
+ (Name,
+ Attribute_Or_Array_Name => Name_Compiler_Command,
+ In_Package => IDE,
+ Shared => Shared,
+ Force_Lower_Case_Index => True);
+
+ declare
+ Config_Command : constant String :=
+ "--config=" & Get_Name_String (Name);
+
+ Runtime_Name : constant String :=
+ Runtime_Name_For (Name);
+
+ begin
+ if Variable = Nil_Variable_Value
+ or else Length_Of_Name (Variable.Value) = 0
+ then
+ Result (Count) :=
+ new String'(Config_Command & ",," & Runtime_Name);
+
+ else
+ At_Least_One_Compiler_Command := True;
+
+ declare
+ Compiler_Command : constant String :=
+ Get_Name_String (Variable.Value);
+
+ begin
+ if Is_Absolute_Path (Compiler_Command) then
+ Result (Count) :=
+ new String'
+ (Config_Command & ",," & Runtime_Name & "," &
+ Containing_Directory (Compiler_Command) & "," &
+ Simple_Name (Compiler_Command));
+ else
+ Result (Count) :=
+ new String'
+ (Config_Command & ",," & Runtime_Name & ",," &
+ Compiler_Command);
+ end if;
+ end;
+ end if;
+ end;
+
+ Count := Count + 1;
+ Name := Language_Htable.Get_Next;
+ end loop;
+
+ return Result;
+ end Get_Config_Switches;
+
+ ------------------------
+ -- Might_Have_Sources --
+ ------------------------
+
+ function Might_Have_Sources (Project : Project_Id) return Boolean is
+ Variable : Variable_Value;
+
+ begin
+ Variable :=
+ Value_Of
+ (Name_Source_Dirs,
+ Project.Decl.Attributes,
+ Shared);
+
+ if Variable = Nil_Variable_Value
+ or else Variable.Default
+ or else Variable.Values /= Nil_String
+ then
+ Variable :=
+ Value_Of
+ (Name_Source_Files,
+ Project.Decl.Attributes,
+ Shared);
+ return Variable = Nil_Variable_Value
+ or else Variable.Default
+ or else Variable.Values /= Nil_String;
+
+ else
+ return False;
+ end if;
+ end Might_Have_Sources;
+
Success : Boolean;
Config_Project_Node : Project_Node_Id := Empty_Node;
Free (Config_File_Path);
Config := No_Project;
- if Config_File_Name /= "" then
- Config_File_Path := Locate_Config_File (Config_File_Name);
+ Get_Project_Target;
+ Check_Builder_Switches;
+
+ if Conf_File_Name'Length > 0 then
+ Config_File_Path := Locate_Config_File (Conf_File_Name.all);
else
Config_File_Path := Locate_Config_File (Default_File_Name);
end if;
if Config_File_Path = null then
- if (not Allow_Automatic_Generation)
- and then Config_File_Name /= ""
+ if not Allow_Automatic_Generation
+ and then Conf_File_Name'Length > 0
then
Raise_Invalid_Config
("could not locate main configuration project "
- & Config_File_Name);
+ & Conf_File_Name.all);
end if;
end if;
end if;
-- If the config file is not auto-generated, warn if there is any --RTS
- -- switch on the command line.
+ -- switch, but not when the config file is generated in memory.
elsif RTS_Languages.Get_First /= No_Name
and then Opt.Warning_Mode /= Opt.Suppress
+ and then On_Load_Config = null
then
Write_Line
("warning: --RTS is taken into account only in auto-configuration");
if not Automatically_Generated
and then not
- Check_Target (Config, Autoconf_Specified, Project_Tree, Target_Name)
+ Check_Target
+ (Config, Autoconf_Specified, Project_Tree, Selected_Target.all)
then
Automatically_Generated := True;
goto Process_Config_File;
end if;
end Locate_Config_File;
+ --------------------
+ -- Locate_Runtime --
+ --------------------
+
+ procedure Locate_Runtime
+ (Language : Name_Id;
+ Project_Tree : Prj.Project_Tree_Ref)
+ is
+ function Is_Base_Name (Path : String) return Boolean;
+ -- Returns True if Path has no directory separator
+
+ ------------------
+ -- Is_Base_Name --
+ ------------------
+
+ function Is_Base_Name (Path : String) return Boolean is
+ begin
+ for I in Path'Range loop
+ if Path (I) = Directory_Separator or else Path (I) = '/' then
+ return False;
+ end if;
+ end loop;
+ return True;
+ end Is_Base_Name;
+
+ -- Local declarations
+
+ function Find_Rts_In_Path is new Prj.Env.Find_Name_In_Path
+ (Check_Filename => Is_Directory);
+
+ RTS_Name : constant String := Runtime_Name_For (Language);
+
+ Full_Path : String_Access;
+
+ -- Start of processing for Locate_Runtime
+
+ begin
+ if not Is_Base_Name (RTS_Name) then
+ Full_Path :=
+ Find_Rts_In_Path (Root_Environment.Project_Path, RTS_Name);
+
+ if Full_Path = null then
+ Fail_Program (Project_Tree, "cannot find RTS " & RTS_Name);
+ end if;
+
+ Set_Runtime_For (Language, Normalize_Pathname (Full_Path.all));
+ Free (Full_Path);
+ end if;
+ end Locate_Runtime;
+
------------------------------------
-- Parse_Project_And_Apply_Config --
------------------------------------
Main_Config_Project : Project_Id;
Success : Boolean;
+ Conf_Project : Project_Id := No_Project;
+ -- The object directory of this project is used to store the config
+ -- project file in auto-configuration. Set by Check_Project below.
+
+ procedure Check_Project (Project : Project_Id);
+ -- Look for a non aggregate project. If one is found, put its project Id
+ -- in Conf_Project.
+
+ -------------------
+ -- Check_Project --
+ -------------------
+
+ procedure Check_Project (Project : Project_Id) is
+ begin
+ if Project.Qualifier = Aggregate
+ or else
+ Project.Qualifier = Aggregate_Library
+ then
+ declare
+ List : Aggregated_Project_List := Project.Aggregated_Projects;
+
+ begin
+ -- Look for a non aggregate project until one is found
+
+ while Conf_Project = No_Project and then List /= null loop
+ Check_Project (List.Project);
+ List := List.Next;
+ end loop;
+ end;
+
+ else
+ Conf_Project := Project;
+ end if;
+ end Check_Project;
+
+ -- Start of processing for Process_Project_And_Apply_Config
+
begin
Main_Project := No_Project;
Automatically_Generated := False;
Read_Source_Info_File (Project_Tree);
end if;
+ -- Get the first project that is not an aggregate project or an
+ -- aggregate library project. The object directory of this project will
+ -- be used to store the config project file in auto-configuration.
+
+ Check_Project (Main_Project);
+
+ -- Fail if there is only aggregate projects and aggregate library
+ -- projects in the project tree.
+
+ if Conf_Project = No_Project then
+ Raise_Invalid_Config ("there are no non-aggregate projects");
+ end if;
+
-- Find configuration file
Get_Or_Create_Configuration_File
(Config => Main_Config_Project,
Project => Main_Project,
+ Conf_Project => Conf_Project,
Project_Tree => Project_Tree,
Project_Node_Tree => Project_Node_Tree,
Env => Env,
projects / platform / upstream / gcc48.git / blobdiff