diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-08-04 11:47:14 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-08-04 11:47:14 +0200 |
commit | 29049f0b22b4475b4f8e0872b0455d025782e041 (patch) | |
tree | c9ba49866405f3050bb8de2fdb43f2badcc1cdb4 /gcc | |
parent | d26d790dca2c2135161666dc955cc39befbaf587 (diff) | |
download | gcc-29049f0b22b4475b4f8e0872b0455d025782e041.zip gcc-29049f0b22b4475b4f8e0872b0455d025782e041.tar.gz gcc-29049f0b22b4475b4f8e0872b0455d025782e041.tar.bz2 |
[multiple changes]
2014-08-04 Robert Dewar <dewar@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference, case Pred):
Remove special test for Float'First, no longer required.
(Expand_N_Attribute_Reference, case Succ): Remove special test
for Float'First, no longer required.
* s-fatgen.adb (Pred): return infinity unchanged.
(Succ): ditto.
2014-08-04 Claire Dross <dross@adacore.com>
* sem_ch12.adb (Analyze_Associations): Defaults should only be
used if there is no explicit match.
* exp_util.adb (Get_First_Parent_With_Ext_Axioms_For_Entity):
Also check for pragma external_axiomatization on generic units.
From-SVN: r213546
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 16 | ||||
-rw-r--r-- | gcc/ada/exp_attr.adb | 68 | ||||
-rw-r--r-- | gcc/ada/exp_util.adb | 16 | ||||
-rw-r--r-- | gcc/ada/s-fatgen.adb | 10 | ||||
-rw-r--r-- | gcc/ada/sem_ch12.adb | 32 |
5 files changed, 60 insertions, 82 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 39ace1f..b273bfc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,21 @@ 2014-08-04 Robert Dewar <dewar@adacore.com> + * exp_attr.adb (Expand_N_Attribute_Reference, case Pred): + Remove special test for Float'First, no longer required. + (Expand_N_Attribute_Reference, case Succ): Remove special test + for Float'First, no longer required. + * s-fatgen.adb (Pred): return infinity unchanged. + (Succ): ditto. + +2014-08-04 Claire Dross <dross@adacore.com> + + * sem_ch12.adb (Analyze_Associations): Defaults should only be + used if there is no explicit match. + * exp_util.adb (Get_First_Parent_With_Ext_Axioms_For_Entity): + Also check for pragma external_axiomatization on generic units. + +2014-08-04 Robert Dewar <dewar@adacore.com> + * checks.adb (Activate_Overflow_Check): Remove Check_Float_Overflow processing. (Apply_Scalar_Range_Check): Ditto. diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 4e1ba7f..bb1b6b6 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -4859,10 +4859,9 @@ package body Exp_Attr is -- Pred -- ---------- - -- 1. Deal with enumeration types with holes - -- 2. For floating-point, generate call to attribute function and deal - -- with range checking if Check_Float_Overflow mode is set. - -- 3. For other cases, deal with constraint checking + -- 1. Deal with enumeration types with holes. + -- 2. For floating-point, generate call to attribute function. + -- 3. For other cases, deal with constraint checking. when Attribute_Pred => Pred : declare @@ -4934,35 +4933,9 @@ package body Exp_Attr is -- For floating-point, we transform 'Pred into a call to the Pred -- floating-point attribute function in Fat_xxx (xxx is root type). + -- Note that this function takes care of the overflow case. elsif Is_Floating_Point_Type (Ptyp) then - - -- Handle case of range check. The Do_Range_Check flag is set only - -- in Check_Float_Overflow mode, and what we need is a specific - -- check against typ'First, since that is the only overflow case. - - declare - Expr : constant Node_Id := First (Exprs); - begin - if Do_Range_Check (Expr) then - Set_Do_Range_Check (Expr, False); - Insert_Action (N, - Make_Raise_Constraint_Error (Loc, - Condition => - Make_Op_Eq (Loc, - Left_Opnd => Duplicate_Subexpr (Expr), - Right_Opnd => - Make_Attribute_Reference (Loc, - Attribute_Name => Name_First, - Prefix => - New_Occurrence_Of (Base_Type (Ptyp), Loc))), - Reason => CE_Overflow_Check_Failed), - Suppress => All_Checks); - end if; - end; - - -- Transform into call to attribute function - Expand_Fpt_Attribute_R (N); Analyze_And_Resolve (N, Typ); @@ -5889,9 +5862,9 @@ package body Exp_Attr is -- Succ -- ---------- - -- 1. Deal with enumeration types with holes - -- 2. For floating-point, generate call to attribute function - -- 3. For other cases, deal with constraint checking + -- 1. Deal with enumeration types with holes. + -- 2. For floating-point, generate call to attribute function. + -- 3. For other cases, deal with constraint checking. when Attribute_Succ => Succ : declare Etyp : constant Entity_Id := Base_Type (Ptyp); @@ -5960,33 +5933,6 @@ package body Exp_Attr is -- floating-point attribute function in Fat_xxx (xxx is root type) elsif Is_Floating_Point_Type (Ptyp) then - - -- Handle case of range check. The Do_Range_Check flag is set only - -- in Check_Float_Overflow mode, and what we need is a specific - -- check against typ'Last, since that is the only overflow case. - - declare - Expr : constant Node_Id := First (Exprs); - begin - if Do_Range_Check (Expr) then - Set_Do_Range_Check (Expr, False); - Insert_Action (N, - Make_Raise_Constraint_Error (Loc, - Condition => - Make_Op_Eq (Loc, - Left_Opnd => Duplicate_Subexpr (Expr), - Right_Opnd => - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Last, - Prefix => - New_Occurrence_Of (Base_Type (Ptyp), Loc))), - Reason => CE_Overflow_Check_Failed), - Suppress => All_Checks); - end if; - end; - - -- Transform into call to attribute function - Expand_Fpt_Attribute_R (N); Analyze_And_Resolve (N, Typ); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index c1fca54..481fc37 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -3292,8 +3292,8 @@ package body Exp_Util is ------------------------------------------------- function Get_First_Parent_With_Ext_Axioms_For_Entity - (E : Entity_Id) return Entity_Id is - + (E : Entity_Id) return Entity_Id + is Decl : Node_Id; begin @@ -3305,9 +3305,9 @@ package body Exp_Util is end if; end if; - -- E is the package which is externally axiomatized + -- E is the package or generic package which is externally axiomatized - if Ekind (E) = E_Package + if Ekind_In (E, E_Package, E_Generic_Package) and then Has_Annotate_Pragma_For_External_Axiomatization (E) then return E; @@ -3318,14 +3318,14 @@ package body Exp_Util is elsif Ekind (E) = E_Package and then Present (Generic_Parent (Decl)) then - return Get_First_Parent_With_Ext_Axioms_For_Entity - (Generic_Parent (Decl)); + return + Get_First_Parent_With_Ext_Axioms_For_Entity (Generic_Parent (Decl)); -- Otherwise, look at E's scope instead if present elsif Present (Scope (E)) then - return Get_First_Parent_With_Ext_Axioms_For_Entity - (Scope (E)); + return + Get_First_Parent_With_Ext_Axioms_For_Entity (Scope (E)); -- Else there is no such axiomatized package diff --git a/gcc/ada/s-fatgen.adb b/gcc/ada/s-fatgen.adb index 62534f6..1f4c498 100644 --- a/gcc/ada/s-fatgen.adb +++ b/gcc/ada/s-fatgen.adb @@ -426,6 +426,11 @@ package body System.Fat_Gen is return X / (X - X); end if; + -- For infinities, return unchanged + + elsif X < T'First or else X > T'Last then + return X; + -- Subtract from the given number a number equivalent to the value -- of its least significant bit. Given that the most significant bit -- represents a value of 1.0 * radix ** (exp - 1), the value we want @@ -675,6 +680,11 @@ package body System.Fat_Gen is return X / (X - X); end if; + -- For infinities, return unchanged + + elsif X < T'First or else X > T'Last then + return X; + -- Add to the given number a number equivalent to the value -- of its least significant bit. Given that the most significant bit -- represents a value of 1.0 * radix ** (exp - 1), the value we want diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index f2e3eca..ada3adc 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -1680,21 +1680,27 @@ package body Sem_Ch12 is -- If actual is an entity (function or operator), -- build wrapper for it. - if Present (Match) - and then Nkind (Match) = N_Operator_Symbol - then - -- If the name is a default, find its visible - -- entity at the point of instantiation. + if Present (Match) then + if Nkind (Match) = N_Operator_Symbol then + -- If the name is a default, find its visible + -- entity at the point of instantiation. + + if Is_Entity_Name (Match) + and then No (Entity (Match)) + then + Find_Direct_Name (Match); + end if; - if Is_Entity_Name (Match) - and then No (Entity (Match)) - then - Find_Direct_Name (Match); - end if; + Append_To + (Assoc, + Build_Wrapper + (Defining_Entity (Analyzed_Formal), Match)); - Append_To (Assoc, - Build_Wrapper - (Defining_Entity (Analyzed_Formal), Match)); + else + Append_To (Assoc, + Instantiate_Formal_Subprogram + (Formal, Match, Analyzed_Formal)); + end if; -- Ditto if formal is an operator with a default. |