git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

2012-10-04  Vincent Celier  <celier@adacore.com>

	* prj-proc.adb (Recursive_Process): Use project directory
	display path name as the value of 'Project_Dir.

2012-10-04  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Expand_Compare_Minimize_Eliminate_Overflow):
	Deal with case where we get a bignum operand and cannot do a
	range analysis.
	* sem_eval.adb (Why_Not_Static): Deal with bignum operands

2012-10-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Find_Unary_Types): Within an instance, an
	interpretation that involves a predefied arithmetic operator is
	not a candidate if the corresponding generic formal type is not
	a numeric type.
	* sem_util.ads, sem_util.adb (Corresonding_Generic_Type): If a
	type is a generic actual type within an instance, return the
	corresponding formal in the generic unit, otherwise return
	Any_Type.

From-SVN: r192071
This commit is contained in:
Arnaud Charlet 2012-10-04 11:12:18 +02:00
parent a40ada7ef7
commit 65f7ed64ca
7 changed files with 115 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
gcc/ada/ChangeLog
View File

@ -1,3 +1,26 @@
2012-10-04 Vincent Celier <celier@adacore.com>
* prj-proc.adb (Recursive_Process): Use project directory
display path name as the value of 'Project_Dir.
2012-10-04 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Expand_Compare_Minimize_Eliminate_Overflow):
Deal with case where we get a bignum operand and cannot do a
range analysis.
* sem_eval.adb (Why_Not_Static): Deal with bignum operands
2012-10-04 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Find_Unary_Types): Within an instance, an
interpretation that involves a predefied arithmetic operator is
not a candidate if the corresponding generic formal type is not
a numeric type.
* sem_util.ads, sem_util.adb (Corresonding_Generic_Type): If a
type is a generic actual type within an instance, return the
corresponding formal in the generic unit, otherwise return
Any_Type.
2012-10-04 Robert Dewar <dewar@adacore.com>
* checks.adb (Minimize_Eliminate_Overflow_Checks): Dont reanalyze

16
gcc/ada/exp_ch4.adb
View File

@ -2325,9 +2325,12 @@ package body Exp_Ch4 is
Minimize_Eliminate_Overflow_Checks
(Right_Opnd (N), Rlo, Rhi, Top_Level => False);
-- See if the range information decides the result of the comparison
-- See if the range information decides the result of the comparison.
-- We can only do this if we in fact have full range information (which
-- won't be the case if either operand is bignum at this stage).
case N_Op_Compare (Nkind (N)) is
if Llo /= No_Uint and then Rlo /= No_Uint then
case N_Op_Compare (Nkind (N)) is
when N_Op_Eq =>
if Llo = Lhi and then Rlo = Rhi and then Llo = Rlo then
Set_True;
@ -2369,12 +2372,13 @@ package body Exp_Ch4 is
elsif Llo > Rhi or else Lhi < Rlo then
Set_True;
end if;
end case;
end case;
-- All done if we did the rewrite
-- All done if we did the rewrite
if Nkind (N) not in N_Op_Compare then
return;
if Nkind (N) not in N_Op_Compare then
return;
end if;
end if;
-- Otherwise, time to do the comparison

2
gcc/ada/prj-proc.adb
View File

@ -2850,7 +2850,7 @@ package body Prj.Proc is
Add_Attributes
(Project,
Name,
Name_Id (Project.Directory.Name),
Name_Id (Project.Directory.Display_Name),
In_Tree.Shared,
Project.Decl,
Prj.Attr.Attribute_First,

26
gcc/ada/sem_ch4.adb
View File

@ -5888,14 +5888,36 @@ package body Sem_Ch4 is
begin
if not Is_Overloaded (R) then
if Is_Numeric_Type (Etype (R)) then
Add_One_Interp (N, Op_Id, Base_Type (Etype (R)));
-- In an instance a generic actual may be a numeric type even if
-- the formal in the generic unit was not. In that case, the
-- predefined operator was not a possible interpretation in the
-- generic, and cannot be one in the instance.
if In_Instance
and then
not Is_Numeric_Type (Corresponding_Generic_Type (Etype (R)))
then
null;
else
Add_One_Interp (N, Op_Id, Base_Type (Etype (R)));
end if;
end if;
else
Get_First_Interp (R, Index, It);
while Present (It.Typ) loop
if Is_Numeric_Type (It.Typ) then
Add_One_Interp (N, Op_Id, Base_Type (It.Typ));
if In_Instance
and then
not Is_Numeric_Type
(Corresponding_Generic_Type (Etype (It.Typ)))
then
null;
else
Add_One_Interp (N, Op_Id, Base_Type (It.Typ));
end if;
end if;
Get_Next_Interp (Index, It);

14
gcc/ada/sem_eval.adb
View File

@ -37,6 +37,7 @@ with Namet; use Namet;
with Nmake; use Nmake;
with Nlists; use Nlists;
with Opt; use Opt;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Cat; use Sem_Cat;
@ -5419,10 +5420,12 @@ package body Sem_Eval is
return;
end if;
-- Type must be scalar or string type
-- Type must be scalar or string type (but allow Bignum, since this
-- is really a scalar type from our point of view in this diagnosis).
if not Is_Scalar_Type (Typ)
and then not Is_String_Type (Typ)
and then not Is_RTE (Typ, RE_Bignum)
then
Error_Msg_N
("static expression must have scalar or string type " &
@ -5539,7 +5542,14 @@ package body Sem_Eval is
when N_Function_Call =>
Why_Not_Static_List (Parameter_Associations (N));
Error_Msg_N ("non-static function call (RM 4.9(6,18))!", N);
-- Complain about non-static function call unless we have Bignum
-- which means that the underlying expression is really some
-- scalar arithmetic operation.
if not Is_RTE (Typ, RE_Bignum) then
Error_Msg_N ("non-static function call (RM 4.9(6,18))!", N);
end if;
when N_Parameter_Association =>
Why_Not_Static (Explicit_Actual_Parameter (N));

39
gcc/ada/sem_util.adb
View File

@ -2489,6 +2489,45 @@ package body Sem_Util is
return Plist;
end Copy_Parameter_List;
--------------------------------
-- Corresponding_Generic_Type --
--------------------------------
function Corresponding_Generic_Type (T : Entity_Id) return Entity_Id is
Inst : Entity_Id;
Gen : Entity_Id;
Typ : Entity_Id;
begin
if not Is_Generic_Actual_Type (T) then
return Any_Type;
else
Inst := Scope (T);
if Is_Wrapper_Package (Inst) then
Inst := Related_Instance (Inst);
end if;
Gen :=
Generic_Parent
(Specification (Unit_Declaration_Node (Inst)));
-- Generic actual has the same name as the corresponding formal
Typ := First_Entity (Gen);
while Present (Typ) loop
if Chars (Typ) = Chars (T) then
return Typ;
end if;
Next_Entity (Typ);
end loop;
return Any_Type;
end if;
end Corresponding_Generic_Type;
--------------------
-- Current_Entity --
--------------------

6
gcc/ada/sem_util.ads
View File

@ -299,6 +299,12 @@ package Sem_Util is
-- create a new compatible record type. Loc is the source location assigned
-- to the created nodes.
function Corresponding_Generic_Type (T : Entity_Id) return Entity_Id;
-- If a type is a generic actual type, return the corresponding formal in
-- the generic parent unit. There is no direct link in the tree for this
-- attribute, except in the case of formal private and derived types.
-- Possible optimization???
function Current_Entity (N : Node_Id) return Entity_Id;
pragma Inline (Current_Entity);
-- Find the currently visible definition for a given identifier, that is to