[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
This commit is contained in:
parent
90d28ec7ac
commit
4d777a7162
@ -1,3 +1,18 @@
|
||||
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
|
||||
|
@ -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;
|
||||
|
@ -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_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 : 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,
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user