aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2012-10-04 11:12:18 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2012-10-04 11:12:18 +0200
commit65f7ed64ca282f4c084499723a96c47085faaab8 (patch)
tree5c4a4a3d3a91aa0e0ba8ef824071967b4ac40d15
parenta40ada7ef7d7a4e6d66af16425d1135d15129404 (diff)
downloadgcc-65f7ed64ca282f4c084499723a96c47085faaab8.zip
gcc-65f7ed64ca282f4c084499723a96c47085faaab8.tar.gz
gcc-65f7ed64ca282f4c084499723a96c47085faaab8.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog23
-rw-r--r--gcc/ada/exp_ch4.adb16
-rw-r--r--gcc/ada/prj-proc.adb2
-rw-r--r--gcc/ada/sem_ch4.adb26
-rw-r--r--gcc/ada/sem_eval.adb14
-rw-r--r--gcc/ada/sem_util.adb39
-rw-r--r--gcc/ada/sem_util.ads6
7 files changed, 115 insertions, 11 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 66a0466..b976f9c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 8691437..f47bae4 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -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
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index 19a92e9..cb9d533 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -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,
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 64b40e6..9d63e88 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -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);
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index f42bfb3..95a240e 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -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));
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 2e68039..2202c88 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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 --
--------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 57c4880..1b089b8 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -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