[multiple changes]
2013-01-04 Robert Dewar <dewar@adacore.com> * exp_util.adb (Remove_Side_Effects): Make sure scope suppress is restored on exit. 2013-01-04 Robert Dewar <dewar@adacore.com> * usage.adb: Document -gnateF (check overflow for predefined Float). 2013-01-04 Robert Dewar <dewar@adacore.com> * sem_res.adb (Resolve_Type_Conversion): Remove incorrect prevention of call to Apply_Type_Conversion_Checks, which resulted in missing check flags in formal mode. 2013-01-04 Vincent Celier <celier@adacore.com> * makeutl.ads (Db_Switch_Args): New table used by gprbuild. * prj-conf.adb (Check_Builder_Switches): Check for switches --config= (Get_Db_Switches): New procedure to get the --db switches so that they are used when invoking gprconfig in auto-configuration. (Do_Autoconf): When invoking gprconfig, use the --db switches, if any. From-SVN: r194894
This commit is contained in:
parent
dc8b370ac0
commit
67b8ac46a6
|
@ -1,3 +1,27 @@
|
||||||
|
2013-01-04 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
|
* exp_util.adb (Remove_Side_Effects): Make sure scope suppress
|
||||||
|
is restored on exit.
|
||||||
|
|
||||||
|
2013-01-04 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
|
* usage.adb: Document -gnateF (check overflow for predefined Float).
|
||||||
|
|
||||||
|
2013-01-04 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
|
* sem_res.adb (Resolve_Type_Conversion): Remove incorrect
|
||||||
|
prevention of call to Apply_Type_Conversion_Checks, which resulted
|
||||||
|
in missing check flags in formal mode.
|
||||||
|
|
||||||
|
2013-01-04 Vincent Celier <celier@adacore.com>
|
||||||
|
|
||||||
|
* makeutl.ads (Db_Switch_Args): New table used by gprbuild.
|
||||||
|
* prj-conf.adb (Check_Builder_Switches): Check for switches
|
||||||
|
--config= (Get_Db_Switches): New procedure to get the --db
|
||||||
|
switches so that they are used when invoking gprconfig in
|
||||||
|
auto-configuration.
|
||||||
|
(Do_Autoconf): When invoking gprconfig, use the --db switches, if any.
|
||||||
|
|
||||||
2013-01-04 Pascal Obry <obry@adacore.com>
|
2013-01-04 Pascal Obry <obry@adacore.com>
|
||||||
|
|
||||||
* prj-nmsc.adb: Minor reformatting.
|
* prj-nmsc.adb: Minor reformatting.
|
||||||
|
|
|
@ -6712,8 +6712,8 @@ package body Exp_Util is
|
||||||
or else Nkind (N) = N_Selected_Component
|
or else Nkind (N) = N_Selected_Component
|
||||||
then
|
then
|
||||||
return Within_In_Parameter (Prefix (N));
|
return Within_In_Parameter (Prefix (N));
|
||||||
else
|
|
||||||
|
|
||||||
|
else
|
||||||
return False;
|
return False;
|
||||||
end if;
|
end if;
|
||||||
end Within_In_Parameter;
|
end Within_In_Parameter;
|
||||||
|
@ -6743,7 +6743,10 @@ package body Exp_Util is
|
||||||
return;
|
return;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- All this must not have any checks
|
-- The remaining procesaing is done with all checks suppressed
|
||||||
|
|
||||||
|
-- Note: from now on, don't use return statements, instead do a goto
|
||||||
|
-- Leave, to ensure that we properly restore Scope_Suppress.Suppress.
|
||||||
|
|
||||||
Scope_Suppress.Suppress := (others => True);
|
Scope_Suppress.Suppress := (others => True);
|
||||||
|
|
||||||
|
@ -6809,8 +6812,7 @@ package body Exp_Util is
|
||||||
and then Nkind (Expression (Exp)) = N_Explicit_Dereference
|
and then Nkind (Expression (Exp)) = N_Explicit_Dereference
|
||||||
then
|
then
|
||||||
Remove_Side_Effects (Expression (Exp), Name_Req, Variable_Ref);
|
Remove_Side_Effects (Expression (Exp), Name_Req, Variable_Ref);
|
||||||
Scope_Suppress := Svg_Suppress;
|
goto Leave;
|
||||||
return;
|
|
||||||
|
|
||||||
-- If this is a type conversion, leave the type conversion and remove
|
-- If this is a type conversion, leave the type conversion and remove
|
||||||
-- the side effects in the expression. This is important in several
|
-- the side effects in the expression. This is important in several
|
||||||
|
@ -6820,8 +6822,7 @@ package body Exp_Util is
|
||||||
|
|
||||||
elsif Nkind (Exp) = N_Type_Conversion then
|
elsif Nkind (Exp) = N_Type_Conversion then
|
||||||
Remove_Side_Effects (Expression (Exp), Name_Req, Variable_Ref);
|
Remove_Side_Effects (Expression (Exp), Name_Req, Variable_Ref);
|
||||||
Scope_Suppress := Svg_Suppress;
|
goto Leave;
|
||||||
return;
|
|
||||||
|
|
||||||
-- If this is an unchecked conversion that Gigi can't handle, make
|
-- If this is an unchecked conversion that Gigi can't handle, make
|
||||||
-- a copy or a use a renaming to capture the value.
|
-- a copy or a use a renaming to capture the value.
|
||||||
|
@ -6935,7 +6936,7 @@ package body Exp_Util is
|
||||||
if Alfa_Mode
|
if Alfa_Mode
|
||||||
and then Nkind (Parent (Exp)) = N_Object_Declaration
|
and then Nkind (Parent (Exp)) = N_Object_Declaration
|
||||||
then
|
then
|
||||||
return;
|
goto Leave;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- Special processing for function calls that return a limited type.
|
-- Special processing for function calls that return a limited type.
|
||||||
|
@ -6965,7 +6966,7 @@ package body Exp_Util is
|
||||||
Insert_Action (Exp, Decl);
|
Insert_Action (Exp, Decl);
|
||||||
Set_Etype (Obj, Exp_Type);
|
Set_Etype (Obj, Exp_Type);
|
||||||
Rewrite (Exp, New_Occurrence_Of (Obj, Loc));
|
Rewrite (Exp, New_Occurrence_Of (Obj, Loc));
|
||||||
return;
|
goto Leave;
|
||||||
end;
|
end;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -7064,6 +7065,8 @@ package body Exp_Util is
|
||||||
|
|
||||||
Rewrite (Exp, Res);
|
Rewrite (Exp, Res);
|
||||||
Analyze_And_Resolve (Exp, Exp_Type);
|
Analyze_And_Resolve (Exp, Exp_Type);
|
||||||
|
|
||||||
|
<<Leave>>
|
||||||
Scope_Suppress := Svg_Suppress;
|
Scope_Suppress := Svg_Suppress;
|
||||||
end Remove_Side_Effects;
|
end Remove_Side_Effects;
|
||||||
|
|
||||||
|
|
|
@ -82,6 +82,15 @@ package Makeutl is
|
||||||
Load_Standard_Base : Boolean := True;
|
Load_Standard_Base : Boolean := True;
|
||||||
-- False when gprbuild is called with --db-
|
-- False when gprbuild is called with --db-
|
||||||
|
|
||||||
|
package Db_Switch_Args is new Table.Table
|
||||||
|
(Table_Component_Type => Name_Id,
|
||||||
|
Table_Index_Type => Integer,
|
||||||
|
Table_Low_Bound => 1,
|
||||||
|
Table_Initial => 200,
|
||||||
|
Table_Increment => 100,
|
||||||
|
Table_Name => "Makegpr.Db_Switch_Args");
|
||||||
|
-- Table of all the arguments of --db switches of gprbuild
|
||||||
|
|
||||||
package Directories is new Table.Table
|
package Directories is new Table.Table
|
||||||
(Table_Component_Type => Path_Name_Type,
|
(Table_Component_Type => Path_Name_Type,
|
||||||
Table_Index_Type => Integer,
|
Table_Index_Type => Integer,
|
||||||
|
|
|
@ -621,6 +621,10 @@ package body Prj.Conf is
|
||||||
-- Set to True if at least one attribute Ide'Compiler_Command is
|
-- Set to True if at least one attribute Ide'Compiler_Command is
|
||||||
-- specified for one language of the system.
|
-- 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.
|
||||||
|
|
||||||
function Default_File_Name return String;
|
function Default_File_Name return String;
|
||||||
-- Return the name of the default config file that should be tested
|
-- Return the name of the default config file that should be tested
|
||||||
|
|
||||||
|
@ -629,11 +633,14 @@ package body Prj.Conf is
|
||||||
-- raises the Invalid_Config exception with an appropriate message
|
-- raises the Invalid_Config exception with an appropriate message
|
||||||
|
|
||||||
procedure Check_Builder_Switches;
|
procedure Check_Builder_Switches;
|
||||||
-- Check for switch --RTS in package Builder
|
-- Check for switches --config and --RTS in package Builder
|
||||||
|
|
||||||
function Get_Config_Switches return Argument_List_Access;
|
function Get_Config_Switches return Argument_List_Access;
|
||||||
-- Return the --config switches to use for gprconfig
|
-- 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;
|
function Might_Have_Sources (Project : Project_Id) return Boolean;
|
||||||
-- True if the specified project might have sources (ie the user has not
|
-- 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
|
-- explicitly specified it. We haven't checked the file system, nor do
|
||||||
|
@ -681,7 +688,14 @@ package body Prj.Conf is
|
||||||
if Switch.Value /= No_Name then
|
if Switch.Value /= No_Name then
|
||||||
Get_Name_String (Switch.Value);
|
Get_Name_String (Switch.Value);
|
||||||
|
|
||||||
if Get_RTS_Switches
|
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_Len >= 7
|
||||||
and then Name_Buffer (1 .. 5) = "--RTS"
|
and then Name_Buffer (1 .. 5) = "--RTS"
|
||||||
then
|
then
|
||||||
|
@ -791,37 +805,307 @@ package body Prj.Conf is
|
||||||
end if;
|
end if;
|
||||||
end Default_File_Name;
|
end Default_File_Name;
|
||||||
|
|
||||||
------------------------
|
-----------------
|
||||||
-- Might_Have_Sources --
|
-- Do_Autoconf --
|
||||||
------------------------
|
-----------------
|
||||||
|
|
||||||
function Might_Have_Sources (Project : Project_Id) return Boolean is
|
procedure Do_Autoconf is
|
||||||
Variable : Variable_Value;
|
Obj_Dir : constant Variable_Value :=
|
||||||
|
Value_Of
|
||||||
|
(Name_Object_Dir,
|
||||||
|
Project.Decl.Attributes,
|
||||||
|
Shared);
|
||||||
|
|
||||||
|
Gprconfig_Path : String_Access;
|
||||||
|
Success : Boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Variable :=
|
Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
|
||||||
Value_Of
|
|
||||||
(Name_Source_Dirs,
|
|
||||||
Project.Decl.Attributes,
|
|
||||||
Shared);
|
|
||||||
|
|
||||||
if Variable = Nil_Variable_Value
|
if Gprconfig_Path = null then
|
||||||
or else Variable.Default
|
Raise_Invalid_Config
|
||||||
or else Variable.Values /= Nil_String
|
("could not locate gprconfig for auto-configuration");
|
||||||
then
|
end if;
|
||||||
Variable :=
|
|
||||||
Value_Of
|
-- First, find the object directory of the user's project
|
||||||
(Name_Source_Files,
|
|
||||||
Project.Decl.Attributes,
|
if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
|
||||||
Shared);
|
Get_Name_String (Project.Directory.Display_Name);
|
||||||
return Variable = Nil_Variable_Value
|
|
||||||
or else Variable.Default
|
|
||||||
or else Variable.Values /= Nil_String;
|
|
||||||
|
|
||||||
else
|
else
|
||||||
return False;
|
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;
|
end if;
|
||||||
end Might_Have_Sources;
|
|
||||||
|
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;
|
||||||
|
Db_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;
|
||||||
|
|
||||||
|
-- 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;
|
||||||
|
|
||||||
|
-- Get eventual --db switches
|
||||||
|
|
||||||
|
Db_Switches := Get_Db_Switches;
|
||||||
|
|
||||||
|
-- Invoke gprconfig
|
||||||
|
|
||||||
|
Args (1) := new String'("--batch");
|
||||||
|
Args (2) := new String'("-o");
|
||||||
|
|
||||||
|
-- If no config file was specified, set the auto.cgpr one
|
||||||
|
|
||||||
|
if Conf_File_Name'Length = 0 then
|
||||||
|
if Obj_Dir_Exists then
|
||||||
|
Args (3) := new String'(Obj_Dir & Auto_Cgpr);
|
||||||
|
|
||||||
|
else
|
||||||
|
declare
|
||||||
|
Path_FD : File_Descriptor;
|
||||||
|
Path_Name : Path_Name_Type;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Prj.Env.Create_Temp_File
|
||||||
|
(Shared => Project_Tree.Shared,
|
||||||
|
Path_FD => Path_FD,
|
||||||
|
Path_Name => Path_Name,
|
||||||
|
File_Use => "configuration file");
|
||||||
|
|
||||||
|
if Path_FD /= Invalid_FD then
|
||||||
|
declare
|
||||||
|
Temp_Dir : constant String :=
|
||||||
|
Containing_Directory
|
||||||
|
(Get_Name_String (Path_Name));
|
||||||
|
begin
|
||||||
|
GNAT.OS_Lib.Close (Path_FD);
|
||||||
|
Args (3) :=
|
||||||
|
new String'(Temp_Dir &
|
||||||
|
Directory_Separator &
|
||||||
|
Auto_Cgpr);
|
||||||
|
Delete_File (Get_Name_String (Path_Name));
|
||||||
|
end;
|
||||||
|
|
||||||
|
else
|
||||||
|
-- We'll have an error message later on
|
||||||
|
|
||||||
|
Args (3) := new String'(Obj_Dir & Auto_Cgpr);
|
||||||
|
end if;
|
||||||
|
end;
|
||||||
|
end if;
|
||||||
|
else
|
||||||
|
Args (3) := Conf_File_Name;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
if Normalized_Hostname = "" then
|
||||||
|
Arg_Last := 3;
|
||||||
|
else
|
||||||
|
if Target_Name = "" 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
|
||||||
|
Args (4) :=
|
||||||
|
new String'("--target=" &
|
||||||
|
Get_Name_String (Tgt_Name));
|
||||||
|
|
||||||
|
elsif At_Least_One_Compiler_Command then
|
||||||
|
Args (4) := new String'("--target=all");
|
||||||
|
|
||||||
|
else
|
||||||
|
Args (4) :=
|
||||||
|
new String'("--target=" & Normalized_Hostname);
|
||||||
|
end if;
|
||||||
|
end;
|
||||||
|
|
||||||
|
else
|
||||||
|
Args (4) := new String'("--target=" & Target_Name);
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Arg_Last := 4;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
if not Verbose_Mode then
|
||||||
|
Arg_Last := Arg_Last + 1;
|
||||||
|
Args (Arg_Last) := new String'("-q");
|
||||||
|
end if;
|
||||||
|
|
||||||
|
if Verbose_Mode then
|
||||||
|
Write_Str (Gprconfig_Name);
|
||||||
|
|
||||||
|
for J in 1 .. Arg_Last loop
|
||||||
|
Write_Char (' ');
|
||||||
|
Write_Str (Args (J).all);
|
||||||
|
end loop;
|
||||||
|
|
||||||
|
for J in Config_Switches'Range loop
|
||||||
|
Write_Char (' ');
|
||||||
|
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'Length > 0
|
||||||
|
or else Verbose_Mode
|
||||||
|
then
|
||||||
|
Write_Str ("creating ");
|
||||||
|
Write_Str (Simple_Name (Args (3).all));
|
||||||
|
Write_Eol;
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) &
|
||||||
|
Config_Switches.all & Db_Switches.all,
|
||||||
|
Success);
|
||||||
|
|
||||||
|
Free (Config_Switches);
|
||||||
|
|
||||||
|
Config_File_Path := Locate_Config_File (Args (3).all);
|
||||||
|
|
||||||
|
if Config_File_Path = null then
|
||||||
|
Raise_Invalid_Config
|
||||||
|
("could not create " & Args (3).all);
|
||||||
|
end if;
|
||||||
|
|
||||||
|
for F in Args'Range loop
|
||||||
|
Free (Args (F));
|
||||||
|
end loop;
|
||||||
|
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 --
|
-- Get_Config_Switches --
|
||||||
|
@ -1023,269 +1307,37 @@ package body Prj.Conf is
|
||||||
return Result;
|
return Result;
|
||||||
end Get_Config_Switches;
|
end Get_Config_Switches;
|
||||||
|
|
||||||
-----------------
|
------------------------
|
||||||
-- Do_Autoconf --
|
-- Might_Have_Sources --
|
||||||
-----------------
|
------------------------
|
||||||
|
|
||||||
procedure Do_Autoconf is
|
function Might_Have_Sources (Project : Project_Id) return Boolean is
|
||||||
Obj_Dir : constant Variable_Value :=
|
Variable : Variable_Value;
|
||||||
Value_Of
|
|
||||||
(Name_Object_Dir,
|
|
||||||
Project.Decl.Attributes,
|
|
||||||
Shared);
|
|
||||||
|
|
||||||
Gprconfig_Path : String_Access;
|
|
||||||
Success : Boolean;
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
|
Variable :=
|
||||||
|
Value_Of
|
||||||
|
(Name_Source_Dirs,
|
||||||
|
Project.Decl.Attributes,
|
||||||
|
Shared);
|
||||||
|
|
||||||
if Gprconfig_Path = null then
|
if Variable = Nil_Variable_Value
|
||||||
Raise_Invalid_Config
|
or else Variable.Default
|
||||||
("could not locate gprconfig for auto-configuration");
|
or else Variable.Values /= Nil_String
|
||||||
end if;
|
then
|
||||||
|
Variable :=
|
||||||
-- First, find the object directory of the user's project
|
Value_Of
|
||||||
|
(Name_Source_Files,
|
||||||
if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
|
Project.Decl.Attributes,
|
||||||
Get_Name_String (Project.Directory.Display_Name);
|
Shared);
|
||||||
|
return Variable = Nil_Variable_Value
|
||||||
|
or else Variable.Default
|
||||||
|
or else Variable.Values /= Nil_String;
|
||||||
|
|
||||||
else
|
else
|
||||||
if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
|
return False;
|
||||||
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;
|
end if;
|
||||||
|
end Might_Have_Sources;
|
||||||
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;
|
|
||||||
|
|
||||||
-- 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");
|
|
||||||
|
|
||||||
-- If no config file was specified, set the auto.cgpr one
|
|
||||||
|
|
||||||
if Config_File_Name'Length = 0 then
|
|
||||||
if Obj_Dir_Exists then
|
|
||||||
Args (3) := new String'(Obj_Dir & Auto_Cgpr);
|
|
||||||
|
|
||||||
else
|
|
||||||
declare
|
|
||||||
Path_FD : File_Descriptor;
|
|
||||||
Path_Name : Path_Name_Type;
|
|
||||||
|
|
||||||
begin
|
|
||||||
Prj.Env.Create_Temp_File
|
|
||||||
(Shared => Project_Tree.Shared,
|
|
||||||
Path_FD => Path_FD,
|
|
||||||
Path_Name => Path_Name,
|
|
||||||
File_Use => "configuration file");
|
|
||||||
|
|
||||||
if Path_FD /= Invalid_FD then
|
|
||||||
declare
|
|
||||||
Temp_Dir : constant String :=
|
|
||||||
Containing_Directory
|
|
||||||
(Get_Name_String (Path_Name));
|
|
||||||
begin
|
|
||||||
GNAT.OS_Lib.Close (Path_FD);
|
|
||||||
Args (3) :=
|
|
||||||
new String'(Temp_Dir &
|
|
||||||
Directory_Separator &
|
|
||||||
Auto_Cgpr);
|
|
||||||
Delete_File (Get_Name_String (Path_Name));
|
|
||||||
end;
|
|
||||||
|
|
||||||
else
|
|
||||||
-- We'll have an error message later on
|
|
||||||
|
|
||||||
Args (3) := new String'(Obj_Dir & Auto_Cgpr);
|
|
||||||
end if;
|
|
||||||
end;
|
|
||||||
end if;
|
|
||||||
else
|
|
||||||
Args (3) := new String'(Config_File_Name);
|
|
||||||
end if;
|
|
||||||
|
|
||||||
if Normalized_Hostname = "" then
|
|
||||||
Arg_Last := 3;
|
|
||||||
else
|
|
||||||
if Target_Name = "" 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
|
|
||||||
Args (4) :=
|
|
||||||
new String'("--target=" &
|
|
||||||
Get_Name_String (Tgt_Name));
|
|
||||||
|
|
||||||
elsif At_Least_One_Compiler_Command then
|
|
||||||
Args (4) := new String'("--target=all");
|
|
||||||
|
|
||||||
else
|
|
||||||
Args (4) :=
|
|
||||||
new String'("--target=" & Normalized_Hostname);
|
|
||||||
end if;
|
|
||||||
end;
|
|
||||||
|
|
||||||
else
|
|
||||||
Args (4) := new String'("--target=" & Target_Name);
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Arg_Last := 4;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
if not Verbose_Mode then
|
|
||||||
Arg_Last := Arg_Last + 1;
|
|
||||||
Args (Arg_Last) := new String'("-q");
|
|
||||||
end if;
|
|
||||||
|
|
||||||
if Verbose_Mode then
|
|
||||||
Write_Str (Gprconfig_Name);
|
|
||||||
|
|
||||||
for J in 1 .. Arg_Last loop
|
|
||||||
Write_Char (' ');
|
|
||||||
Write_Str (Args (J).all);
|
|
||||||
end loop;
|
|
||||||
|
|
||||||
for J in Config_Switches'Range loop
|
|
||||||
Write_Char (' ');
|
|
||||||
Write_Str (Config_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'Length > 0
|
|
||||||
or else Verbose_Mode
|
|
||||||
then
|
|
||||||
Write_Str ("creating ");
|
|
||||||
Write_Str (Simple_Name (Args (3).all));
|
|
||||||
Write_Eol;
|
|
||||||
end if;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) &
|
|
||||||
Config_Switches.all,
|
|
||||||
Success);
|
|
||||||
|
|
||||||
Free (Config_Switches);
|
|
||||||
|
|
||||||
Config_File_Path := Locate_Config_File (Args (3).all);
|
|
||||||
|
|
||||||
if Config_File_Path = null then
|
|
||||||
Raise_Invalid_Config
|
|
||||||
("could not create " & Args (3).all);
|
|
||||||
end if;
|
|
||||||
|
|
||||||
for F in Args'Range loop
|
|
||||||
Free (Args (F));
|
|
||||||
end loop;
|
|
||||||
end;
|
|
||||||
end Do_Autoconf;
|
|
||||||
|
|
||||||
Success : Boolean;
|
Success : Boolean;
|
||||||
Config_Project_Node : Project_Node_Id := Empty_Node;
|
Config_Project_Node : Project_Node_Id := Empty_Node;
|
||||||
|
@ -1298,19 +1350,19 @@ package body Prj.Conf is
|
||||||
|
|
||||||
Check_Builder_Switches;
|
Check_Builder_Switches;
|
||||||
|
|
||||||
if Config_File_Name'Length > 0 then
|
if Conf_File_Name'Length > 0 then
|
||||||
Config_File_Path := Locate_Config_File (Config_File_Name);
|
Config_File_Path := Locate_Config_File (Conf_File_Name.all);
|
||||||
else
|
else
|
||||||
Config_File_Path := Locate_Config_File (Default_File_Name);
|
Config_File_Path := Locate_Config_File (Default_File_Name);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Config_File_Path = null then
|
if Config_File_Path = null then
|
||||||
if (not Allow_Automatic_Generation)
|
if (not Allow_Automatic_Generation)
|
||||||
and then Config_File_Name'Length > 0
|
and then Conf_File_Name'Length > 0
|
||||||
then
|
then
|
||||||
Raise_Invalid_Config
|
Raise_Invalid_Config
|
||||||
("could not locate main configuration project "
|
("could not locate main configuration project "
|
||||||
& Config_File_Name);
|
& Conf_File_Name.all);
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
|
|
@ -9474,8 +9474,8 @@ package body Sem_Res is
|
||||||
and then abs (Realval (Rop)) < Delta_Value (Standard_Duration)
|
and then abs (Realval (Rop)) < Delta_Value (Standard_Duration)
|
||||||
then
|
then
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
("??universal real operand can only " &
|
("??universal real operand can only "
|
||||||
"be interpreted as Duration!", Rop);
|
& "be interpreted as Duration!", Rop);
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
("\??precision will be lost in the conversion!", Rop);
|
("\??precision will be lost in the conversion!", Rop);
|
||||||
end if;
|
end if;
|
||||||
|
@ -9556,11 +9556,6 @@ package body Sem_Res is
|
||||||
and then not Is_Generic_Type (Root_Type (Target_Typ))
|
and then not Is_Generic_Type (Root_Type (Target_Typ))
|
||||||
and then Target_Typ /= Universal_Fixed
|
and then Target_Typ /= Universal_Fixed
|
||||||
and then Operand_Typ /= Universal_Fixed
|
and then Operand_Typ /= Universal_Fixed
|
||||||
|
|
||||||
-- Also skip type conversion checks in formal verification mode, as
|
|
||||||
-- the formal verification backend deals directly with these checks.
|
|
||||||
|
|
||||||
and then not Alfa_Mode
|
|
||||||
then
|
then
|
||||||
Apply_Type_Conversion_Checks (N);
|
Apply_Type_Conversion_Checks (N);
|
||||||
end if;
|
end if;
|
||||||
|
|
|
@ -202,6 +202,11 @@ begin
|
||||||
Write_Switch_Char ("ef");
|
Write_Switch_Char ("ef");
|
||||||
Write_Line ("Full source path in brief error messages");
|
Write_Line ("Full source path in brief error messages");
|
||||||
|
|
||||||
|
-- Line for -gnateF switch
|
||||||
|
|
||||||
|
Write_Switch_Char ("eF");
|
||||||
|
Write_Line ("Check overflow on predefined Float types");
|
||||||
|
|
||||||
-- Line for -gnateG switch
|
-- Line for -gnateG switch
|
||||||
|
|
||||||
Write_Switch_Char ("eG");
|
Write_Switch_Char ("eG");
|
||||||
|
|
Loading…
Reference in New Issue