diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-10-04 11:12:18 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-10-04 11:12:18 +0200 |
commit | 65f7ed64ca282f4c084499723a96c47085faaab8 (patch) | |
tree | 5c4a4a3d3a91aa0e0ba8ef824071967b4ac40d15 | |
parent | a40ada7ef7d7a4e6d66af16425d1135d15129404 (diff) | |
download | gcc-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/ChangeLog | 23 | ||||
-rw-r--r-- | gcc/ada/exp_ch4.adb | 16 | ||||
-rw-r--r-- | gcc/ada/prj-proc.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_ch4.adb | 26 | ||||
-rw-r--r-- | gcc/ada/sem_eval.adb | 14 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 39 | ||||
-rw-r--r-- | gcc/ada/sem_util.ads | 6 |
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 |