FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
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
This commit is contained in:
Arnaud Charlet 2014-08-04 11:47:14 +02:00
parent d26d790dca
commit 29049f0b22
5 changed files with 60 additions and 82 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
gcc/ada/ChangeLog
View file

@ -1,3 +1,19 @@
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

68
gcc/ada/exp_attr.adb
View file

@ -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);

16
gcc/ada/exp_util.adb
View file

@ -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

10
gcc/ada/s-fatgen.adb
View file

@ -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

32
gcc/ada/sem_ch12.adb
View file

@ -1680,22 +1680,28 @@ 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);
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));
else
Append_To (Assoc,
Instantiate_Formal_Subprogram
(Formal, Match, Analyzed_Formal));
end if;
Append_To (Assoc,
Build_Wrapper
(Defining_Entity (Analyzed_Formal), Match));
-- Ditto if formal is an operator with a default.
elsif Box_Present (Formal)