Commit 4d777a71 by Arnaud Charlet

[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
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> 2010-06-18 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Makefile.in, gcc-interface/Make-lang.in: Update * gcc-interface/Makefile.in, gcc-interface/Make-lang.in: Update
......
...@@ -31,7 +31,7 @@ ...@@ -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 Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.Heap_Sort_G; with GNAT.Heap_Sort_G;
...@@ -215,8 +215,8 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -215,8 +215,8 @@ package body GNAT.Perfect_Hash_Generators is
-- Output a title and a vertex table -- Output a title and a vertex table
function Ada_File_Base_Name (Pkg_Name : String) return String; function Ada_File_Base_Name (Pkg_Name : String) return String;
-- Return the base file name (i.e. without .ads/.adb extension) for an Ada -- Return the base file name (i.e. without .ads/.adb extension) for an
-- source file containing the named package, using the standard GNAT -- Ada source file containing the named package, using the standard GNAT
-- file-naming convention. For example, if Pkg_Name is "Parent.Child", we -- file-naming convention. For example, if Pkg_Name is "Parent.Child", we
-- return "parent-child". -- return "parent-child".
...@@ -1495,6 +1495,7 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1495,6 +1495,7 @@ package body GNAT.Perfect_Hash_Generators is
begin begin
File := Create_File (FName, Binary); File := Create_File (FName, Binary);
if File = Invalid_FD then if File = Invalid_FD then
raise Program_Error with "cannot create: " & FName; raise Program_Error with "cannot create: " & FName;
end if; end if;
...@@ -1518,6 +1519,7 @@ package body GNAT.Perfect_Hash_Generators is ...@@ -1518,6 +1519,7 @@ package body GNAT.Perfect_Hash_Generators is
FName (FName'Last) := 'b'; -- Set to body file name FName (FName'Last) := 'b'; -- Set to body file name
File := Create_File (FName, Binary); File := Create_File (FName, Binary);
if File = Invalid_FD then if File = Invalid_FD then
raise Program_Error with "cannot create: " & FName; raise Program_Error with "cannot create: " & FName;
end if; end if;
......
...@@ -6186,14 +6186,14 @@ package body Prj.Nmsc is ...@@ -6186,14 +6186,14 @@ package body Prj.Nmsc is
------------------ ------------------
procedure Find_Sources procedure Find_Sources
(Project : in out Project_Processing_Data; (Project : in out Project_Processing_Data;
Data : in out Tree_Processing_Data) Data : in out Tree_Processing_Data)
is is
Sources : constant Variable_Value := Sources : constant Variable_Value :=
Util.Value_Of Util.Value_Of
(Name_Source_Files, (Name_Source_Files,
Project.Project.Decl.Attributes, Project.Project.Decl.Attributes,
Data.Tree); Data.Tree);
Source_List_File : constant Variable_Value := Source_List_File : constant Variable_Value :=
Util.Value_Of Util.Value_Of
...@@ -6888,26 +6888,36 @@ package body Prj.Nmsc is ...@@ -6888,26 +6888,36 @@ package body Prj.Nmsc is
end if; end if;
declare declare
Path_Name : constant String := Path_Name : constant String :=
Normalize_Pathname Normalize_Pathname
(Name (1 .. Last), (Name (1 .. Last),
Directory => Directory =>
Source_Directory Source_Directory
(Source_Directory'First .. (Source_Directory'First ..
Dir_Last), Dir_Last),
Resolve_Links => Resolve_Links =>
Opt.Follow_Links_For_Files, Opt.Follow_Links_For_Files,
Case_Sensitive => True); Case_Sensitive => True);
Path : Path_Name_Type; Path : Path_Name_Type;
FF : File_Found := Excluded_Sources_Htable.Get Display_Path : Path_Name_Type;
(Project.Excluded, File_Name); FF : File_Found :=
To_Remove : Boolean := False; Excluded_Sources_Htable.Get
(Project.Excluded, File_Name);
To_Remove : Boolean := False;
begin begin
Name_Len := Path_Name'Length; Name_Len := Path_Name'Length;
Name_Buffer (1 .. Name_Len) := Path_Name; 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 FF /= No_File_Found then
if not FF.Found then if not FF.Found then
...@@ -6944,7 +6954,7 @@ package body Prj.Nmsc is ...@@ -6944,7 +6954,7 @@ package body Prj.Nmsc is
Source_Dir_Rank => Num_Nod.Number, Source_Dir_Rank => Num_Nod.Number,
Data => Data, Data => Data,
Path => Path, Path => Path,
Display_Path => Name_Find, Display_Path => Display_Path,
File_Name => File_Name, File_Name => File_Name,
Locally_Removed => To_Remove, Locally_Removed => To_Remove,
Display_File_Name => Display_File_Name, Display_File_Name => Display_File_Name,
......
...@@ -1804,17 +1804,79 @@ package body Sem_Eval is ...@@ -1804,17 +1804,79 @@ package body Sem_Eval is
-- Eval_Conditional_Expression -- -- Eval_Conditional_Expression --
--------------------------------- ---------------------------------
-- We never attempt folding of conditional expressions (and the language) -- We can fold to a static expression if the condition and both constituent
-- does not require it, so the only required processing is to do the check -- expressions are static. Othewise the only required processing is to do
-- for non-static context for the then and else expressions. -- the check for non-static context for the then and else expressions.
procedure Eval_Conditional_Expression (N : Node_Id) is procedure Eval_Conditional_Expression (N : Node_Id) is
Condition : constant Node_Id := First (Expressions (N)); Condition : constant Node_Id := First (Expressions (N));
Then_Expr : constant Node_Id := Next (Condition); Then_Expr : constant Node_Id := Next (Condition);
Else_Expr : constant Node_Id := Next (Then_Expr); 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 begin
Check_Non_Static_Context (Then_Expr); -- If any operand is Any_Type, just propagate to result and do not try
Check_Non_Static_Context (Else_Expr); -- 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; end Eval_Conditional_Expression;
---------------------- ----------------------
...@@ -2937,9 +2999,11 @@ package body Sem_Eval is ...@@ -2937,9 +2999,11 @@ package body Sem_Eval is
Left : constant Node_Id := Left_Opnd (N); Left : constant Node_Id := Left_Opnd (N);
Right : constant Node_Id := Right_Opnd (N); Right : constant Node_Id := Right_Opnd (N);
Left_Int : Uint; Left_Int : Uint;
Rstat : constant Boolean :=
Is_Static_Expression (Left) Rstat : constant Boolean :=
and then Is_Static_Expression (Right); Is_Static_Expression (Left)
and then
Is_Static_Expression (Right);
begin begin
-- Short circuit operations are never static in Ada 83 -- Short circuit operations are never static in Ada 83
...@@ -3001,7 +3065,7 @@ package body Sem_Eval is ...@@ -3001,7 +3065,7 @@ package body Sem_Eval is
if (Kind = N_And_Then and then Is_False (Left_Int)) if (Kind = N_And_Then and then Is_False (Left_Int))
or else or else
(Kind = N_Or_Else and then Is_True (Left_Int)) (Kind = N_Or_Else and then Is_True (Left_Int))
then then
Fold_Uint (N, Left_Int, Rstat); Fold_Uint (N, Left_Int, Rstat);
return; 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