aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2014-08-04 11:47:14 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2014-08-04 11:47:14 +0200
commit29049f0b22b4475b4f8e0872b0455d025782e041 (patch)
treec9ba49866405f3050bb8de2fdb43f2badcc1cdb4 /gcc
parentd26d790dca2c2135161666dc955cc39befbaf587 (diff)
downloadgcc-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/ChangeLog16
-rw-r--r--gcc/ada/exp_attr.adb68
-rw-r--r--gcc/ada/exp_util.adb16
-rw-r--r--gcc/ada/s-fatgen.adb10
-rw-r--r--gcc/ada/sem_ch12.adb32
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.