Skip to content

R
riscv-gcc-1
Commit 67b8ac46 by Arnaud Charlet
Options

[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
parent dc8b370a
Showing with 344 additions and 256 deletions
gcc/ada/ChangeLog
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.
......
gcc/ada/exp_util.adb
......@@ -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;
......
gcc/ada/makeutl.ads
......@@ -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,
......
gcc/ada/prj-conf.adb
......@@ -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,238 +805,6 @@ package body Prj.Conf is
end if;
end Default_File_Name;
------------------------
-- 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;
-------------------------
-- 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;
-----------------
-- Do_Autoconf --
-----------------
......@@ -1083,6 +865,7 @@ package body Prj.Conf is
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;
......@@ -1134,6 +917,10 @@ package body Prj.Conf is
Config_Switches := Get_Config_Switches;
-- Get eventual --db switches
Db_Switches := Get_Db_Switches;
-- Invoke gprconfig
Args (1) := new String'("--batch");
......@@ -1141,7 +928,7 @@ package body Prj.Conf is
-- If no config file was specified, set the auto.cgpr one
if Config_File_Name'Length = 0 then
if Conf_File_Name'Length = 0 then
if Obj_Dir_Exists then
Args (3) := new String'(Obj_Dir & Auto_Cgpr);
......@@ -1179,7 +966,7 @@ package body Prj.Conf is
end;
end if;
else
Args (3) := new String'(Config_File_Name);
Args (3) := Conf_File_Name;
end if;
if Normalized_Hostname = "" then
......@@ -1253,6 +1040,11 @@ package body Prj.Conf is
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
......@@ -1269,7 +1061,7 @@ package body Prj.Conf is
end if;
Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) &
Config_Switches.all,
Config_Switches.all & Db_Switches.all,
Success);
Free (Config_Switches);
......@@ -1287,6 +1079,266 @@ package body Prj.Conf is
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;
......@@ -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;
......
gcc/ada/sem_res.adb
......@@ -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;
......
gcc/ada/usage.adb
......@@ -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");
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment