OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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:
Arnaud Charlet 2013-01-04 10:25:59 +01:00
parent dc8b370ac0
commit 67b8ac46a6
6 changed files with 389 additions and 301 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
gcc/ada/ChangeLog
View File

@ -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>
* prj-nmsc.adb: Minor reformatting.

19
gcc/ada/exp_util.adb
View File

@ -6712,8 +6712,8 @@ package body Exp_Util is
or else Nkind (N) = N_Selected_Component
then
return Within_In_Parameter (Prefix (N));
else
else
return False;
end if;
end Within_In_Parameter;
@ -6743,7 +6743,10 @@ package body Exp_Util is
return;
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);
@ -6809,8 +6812,7 @@ package body Exp_Util is
and then Nkind (Expression (Exp)) = N_Explicit_Dereference
then
Remove_Side_Effects (Expression (Exp), Name_Req, Variable_Ref);
Scope_Suppress := Svg_Suppress;
return;
goto Leave;
-- If this is a type conversion, leave the type conversion and remove
-- 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
Remove_Side_Effects (Expression (Exp), Name_Req, Variable_Ref);
Scope_Suppress := Svg_Suppress;
return;
goto Leave;
-- If this is an unchecked conversion that Gigi can't handle, make
-- a copy or a use a renaming to capture the value.
@ -6935,7 +6936,7 @@ package body Exp_Util is
if Alfa_Mode
and then Nkind (Parent (Exp)) = N_Object_Declaration
then
return;
goto Leave;
end if;
-- Special processing for function calls that return a limited type.
@ -6965,7 +6966,7 @@ package body Exp_Util is
Insert_Action (Exp, Decl);
Set_Etype (Obj, Exp_Type);
Rewrite (Exp, New_Occurrence_Of (Obj, Loc));
return;
goto Leave;
end;
end if;
@ -7064,6 +7065,8 @@ package body Exp_Util is
Rewrite (Exp, Res);
Analyze_And_Resolve (Exp, Exp_Type);
<<Leave>>
Scope_Suppress := Svg_Suppress;
end Remove_Side_Effects;

9
gcc/ada/makeutl.ads
View File

@ -82,6 +82,15 @@ package Makeutl is
Load_Standard_Base : Boolean := True;
-- 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
(Table_Component_Type => Path_Name_Type,
Table_Index_Type => Integer,

624
gcc/ada/prj-conf.adb
View File

@ -621,6 +621,10 @@ package body Prj.Conf is
-- 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.
function Default_File_Name return String;
-- 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
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;
-- 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
@ -681,7 +688,14 @@ package body Prj.Conf is
if Switch.Value /= No_Name then
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_Buffer (1 .. 5) = "--RTS"
then
@ -791,37 +805,307 @@ package body Prj.Conf is
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,
Project.Decl.Attributes,
Shared);
Gprconfig_Path : String_Access;
Success : Boolean;
begin
Variable :=
Value_Of
(Name_Source_Dirs,
Project.Decl.Attributes,
Shared);
Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
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;
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
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 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 --
@ -1023,269 +1307,37 @@ package body Prj.Conf is
return Result;
end Get_Config_Switches;
-----------------
-- Do_Autoconf --
-----------------
------------------------
-- Might_Have_Sources --
------------------------
procedure Do_Autoconf is
Obj_Dir : constant Variable_Value :=
Value_Of
(Name_Object_Dir,
Project.Decl.Attributes,
Shared);
Gprconfig_Path : String_Access;
Success : Boolean;
function Might_Have_Sources (Project : Project_Id) return Boolean is
Variable : Variable_Value;
begin
Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
Variable :=
Value_Of
(Name_Source_Dirs,
Project.Decl.Attributes,
Shared);
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);
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
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;
return False;
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;
-- 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;
end Might_Have_Sources;
Success : Boolean;
Config_Project_Node : Project_Node_Id := Empty_Node;
@ -1298,19 +1350,19 @@ package body Prj.Conf is
Check_Builder_Switches;
if Config_File_Name'Length > 0 then
Config_File_Path := Locate_Config_File (Config_File_Name);
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'Length > 0
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;

9
gcc/ada/sem_res.adb
View File

@ -9474,8 +9474,8 @@ package body Sem_Res is
and then abs (Realval (Rop)) < Delta_Value (Standard_Duration)
then
Error_Msg_N
("??universal real operand can only " &
"be interpreted as Duration!", Rop);
("??universal real operand can only "
& "be interpreted as Duration!", Rop);
Error_Msg_N
("\??precision will be lost in the conversion!", Rop);
end if;
@ -9556,11 +9556,6 @@ package body Sem_Res is
and then not Is_Generic_Type (Root_Type (Target_Typ))
and then Target_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
Apply_Type_Conversion_Checks (N);
end if;

5
gcc/ada/usage.adb
View File

@ -202,6 +202,11 @@ begin
Write_Switch_Char ("ef");
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
Write_Switch_Char ("eG");