Skip to content

R
riscv-gcc-1
Commit 4d777a71 by Arnaud Charlet
Options

[multiple changes] 

2010-06-18  Robert Dewar  <dewar@adacore.com>

	* sem_eval.adb (Eval_Conditional_Expression): Result is static if
	condition and both sub-expressions are static (and result is selected
	expression).

2010-06-18  Robert Dewar  <dewar@adacore.com>

	* g-pehage.adb: Minor reformatting

2010-06-18  Pascal Obry  <obry@adacore.com>

	* prj-nmsc.adb (Search_Directories): Insert canonical filenames into
	source hash table.

From-SVN: r160988
parent 90d28ec7
Showing with 127 additions and 36 deletions
gcc/ada/ChangeLog
2010-06-18 Robert Dewar <dewar@adacore.com>
* sem_eval.adb (Eval_Conditional_Expression): Result is static if
condition and both sub-expressions are static (and result is selected
expression).
2010-06-18 Robert Dewar <dewar@adacore.com>
* g-pehage.adb: Minor reformatting
2010-06-18 Pascal Obry <obry@adacore.com>
* prj-nmsc.adb (Search_Directories): Insert canonical filenames into
source hash table.
2010-06-18 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Makefile.in, gcc-interface/Make-lang.in: Update
......
gcc/ada/g-pehage.adb
......@@ -31,7 +31,7 @@
-- --
------------------------------------------------------------------------------
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.Heap_Sort_G;
......@@ -215,8 +215,8 @@ package body GNAT.Perfect_Hash_Generators is
-- Output a title and a vertex table
function Ada_File_Base_Name (Pkg_Name : String) return String;
-- Return the base file name (i.e. without .ads/.adb extension) for an Ada
-- source file containing the named package, using the standard GNAT
-- Return the base file name (i.e. without .ads/.adb extension) for an
-- Ada source file containing the named package, using the standard GNAT
-- file-naming convention. For example, if Pkg_Name is "Parent.Child", we
-- return "parent-child".
......@@ -1495,6 +1495,7 @@ package body GNAT.Perfect_Hash_Generators is
begin
File := Create_File (FName, Binary);
if File = Invalid_FD then
raise Program_Error with "cannot create: " & FName;
end if;
......@@ -1518,6 +1519,7 @@ package body GNAT.Perfect_Hash_Generators is
FName (FName'Last) := 'b'; -- Set to body file name
File := Create_File (FName, Binary);
if File = Invalid_FD then
raise Program_Error with "cannot create: " & FName;
end if;
......
gcc/ada/prj-nmsc.adb
......@@ -6186,14 +6186,14 @@ package body Prj.Nmsc is
------------------
procedure Find_Sources
(Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data)
(Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data)
is
Sources : constant Variable_Value :=
Util.Value_Of
(Name_Source_Files,
Project.Project.Decl.Attributes,
Data.Tree);
Project.Project.Decl.Attributes,
Data.Tree);
Source_List_File : constant Variable_Value :=
Util.Value_Of
......@@ -6888,26 +6888,36 @@ package body Prj.Nmsc is
end if;
declare
Path_Name : constant String :=
Normalize_Pathname
(Name (1 .. Last),
Directory =>
Source_Directory
(Source_Directory'First ..
Dir_Last),
Resolve_Links =>
Opt.Follow_Links_For_Files,
Case_Sensitive => True);
Path : Path_Name_Type;
FF : File_Found := Excluded_Sources_Htable.Get
(Project.Excluded, File_Name);
To_Remove : Boolean := False;
Path_Name : constant String :=
Normalize_Pathname
(Name (1 .. Last),
Directory =>
Source_Directory
(Source_Directory'First ..
Dir_Last),
Resolve_Links =>
Opt.Follow_Links_For_Files,
Case_Sensitive => True);
Path : Path_Name_Type;
Display_Path : Path_Name_Type;
FF : File_Found :=
Excluded_Sources_Htable.Get
(Project.Excluded, File_Name);
To_Remove : Boolean := False;
begin
Name_Len := Path_Name'Length;
Name_Buffer (1 .. Name_Len) := Path_Name;
Path := Name_Find;
Display_Path := Name_Find;
if Osint.File_Names_Case_Sensitive then
Path := Display_Path;
else
Canonical_Case_File_Name
(Name_Buffer (1 .. Name_Len));
Path := Name_Find;
end if;
if FF /= No_File_Found then
if not FF.Found then
......@@ -6944,7 +6954,7 @@ package body Prj.Nmsc is
Source_Dir_Rank => Num_Nod.Number,
Data => Data,
Path => Path,
Display_Path => Name_Find,
Display_Path => Display_Path,
File_Name => File_Name,
Locally_Removed => To_Remove,
Display_File_Name => Display_File_Name,
......
gcc/ada/sem_eval.adb
......@@ -1804,17 +1804,79 @@ package body Sem_Eval is
-- Eval_Conditional_Expression --
---------------------------------
-- We never attempt folding of conditional expressions (and the language)
-- does not require it, so the only required processing is to do the check
-- for non-static context for the then and else expressions.
-- We can fold to a static expression if the condition and both constituent
-- expressions are static. Othewise the only required processing is to do
-- the check for non-static context for the then and else expressions.
procedure Eval_Conditional_Expression (N : Node_Id) is
Condition : constant Node_Id := First (Expressions (N));
Then_Expr : constant Node_Id := Next (Condition);
Else_Expr : constant Node_Id := Next (Then_Expr);
Condition : constant Node_Id := First (Expressions (N));
Then_Expr : constant Node_Id := Next (Condition);
Else_Expr : constant Node_Id := Next (Then_Expr);
Result : Node_Id;
Non_Result : Node_Id;
Rstat : constant Boolean :=
Is_Static_Expression (Condition)
and then
Is_Static_Expression (Then_Expr)
and then
Is_Static_Expression (Else_Expr);
begin
Check_Non_Static_Context (Then_Expr);
Check_Non_Static_Context (Else_Expr);
-- If any operand is Any_Type, just propagate to result and do not try
-- to fold, this prevents cascaded errors.
if Etype (Condition) = Any_Type or else
Etype (Then_Expr) = Any_Type or else
Etype (Else_Expr) = Any_Type
then
Set_Etype (N, Any_Type);
Set_Is_Static_Expression (N, False);
return;
-- Static case where we can fold. Note that we don't try to fold cases
-- where the condition is known at compile time, but the result is
-- non-static. This avoids possible cases of infinite recursion where
-- the expander puts in a redundant test and we remove it. Instead we
-- deal with these cases in the expander.
elsif Rstat then
-- Select result operand
if Is_True (Expr_Value (Condition)) then
Result := Then_Expr;
Non_Result := Else_Expr;
else
Result := Else_Expr;
Non_Result := Then_Expr;
end if;
-- Note that it does not matter if the non-result operand raises a
-- Constraint_Error, but if the result raises constraint error then
-- we replace the node with a raise constraint error. This will
-- properly propagate Raises_Constraint_Error since this flag is
-- set in Result.
if Raises_Constraint_Error (Result) then
Rewrite_In_Raise_CE (N, Result);
Check_Non_Static_Context (Non_Result);
-- Otherwise the result operand replaces the original node
else
Rewrite (N, Relocate_Node (Result));
end if;
-- Case of condition not known at compile time
else
Check_Non_Static_Context (Condition);
Check_Non_Static_Context (Then_Expr);
Check_Non_Static_Context (Else_Expr);
end if;
Set_Is_Static_Expression (N, Rstat);
end Eval_Conditional_Expression;
----------------------
......@@ -2937,9 +2999,11 @@ package body Sem_Eval is
Left : constant Node_Id := Left_Opnd (N);
Right : constant Node_Id := Right_Opnd (N);
Left_Int : Uint;
Rstat : constant Boolean :=
Is_Static_Expression (Left)
and then Is_Static_Expression (Right);
Rstat : constant Boolean :=
Is_Static_Expression (Left)
and then
Is_Static_Expression (Right);
begin
-- Short circuit operations are never static in Ada 83
......@@ -3001,7 +3065,7 @@ package body Sem_Eval is
if (Kind = N_And_Then and then Is_False (Left_Int))
or else
(Kind = N_Or_Else and then Is_True (Left_Int))
(Kind = N_Or_Else and then Is_True (Left_Int))
then
Fold_Uint (N, Left_Int, Rstat);
return;
......
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