Commit f5655e4a by Arnaud Charlet

[multiple changes]

2014-08-04  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Expand_Array_Aggregate): Do not attempt expansion
	if error already detected.  We may reach this point in spite of
	previous errors when compiling with -gnatq, to force all possible
	errors (this is the usual ACATS mode).

2014-08-04  Gary Dismukes  <dismukes@adacore.com>

	* checks.adb (Generate_Range_Check): For the case of converting
	a base type with a larger range to a smaller target subtype, only
	use unchecked conversions of bounds in the range check followed
	by conversion in the case where both types are discrete. In other
	cases, convert to the target base type and save in a temporary
	followed by the range check.
	(Convert_And_Check_Range): New procedure factoring code to save
	conversion to a temporary followed by a range check (called two
	places in Generate_Range_Check).
	* exp_ch4.adb (Expand_N_Type_Conversion): Relax previous
	check-in, to generate range checks for conversions between
	any floating-point types rather than limiting it to matching
	base types.

From-SVN: r213532
parent 52627911
2014-08-04 Arnaud Charlet <charlet@adacore.com>
* g-trasym-vms-ia64.adb, g-trasym-vms-alpha.adb: Removed.
2014-08-04 Ed Schonberg <schonberg@adacore.com>
* exp_aggr.adb (Expand_Array_Aggregate): Do not attempt expansion
if error already detected. We may reach this point in spite of
previous errors when compiling with -gnatq, to force all possible
errors (this is the usual ACATS mode).
2014-08-04 Gary Dismukes <dismukes@adacore.com>
* checks.adb (Generate_Range_Check): For the case of converting
a base type with a larger range to a smaller target subtype, only
use unchecked conversions of bounds in the range check followed
by conversion in the case where both types are discrete. In other
cases, convert to the target base type and save in a temporary
followed by the range check.
(Convert_And_Check_Range): New procedure factoring code to save
conversion to a temporary followed by a range check (called two
places in Generate_Range_Check).
* exp_ch4.adb (Expand_N_Type_Conversion): Relax previous
check-in, to generate range checks for conversions between
any floating-point types rather than limiting it to matching
base types.
2014-08-02 Trevor Saunders <tsaunders@mozilla.com> 2014-08-02 Trevor Saunders <tsaunders@mozilla.com>
* gcc-interface/trans.c: Use hash_set instead of pointer_set. * gcc-interface/trans.c: Use hash_set instead of pointer_set.
......
...@@ -6402,6 +6402,59 @@ package body Checks is ...@@ -6402,6 +6402,59 @@ package body Checks is
Source_Base_Type : constant Entity_Id := Base_Type (Source_Type); Source_Base_Type : constant Entity_Id := Base_Type (Source_Type);
Target_Base_Type : constant Entity_Id := Base_Type (Target_Type); Target_Base_Type : constant Entity_Id := Base_Type (Target_Type);
procedure Convert_And_Check_Range;
-- Convert the conversion operand to the target base type and save in
-- a temporary. Then check the converted value against the range of the
-- target subtype.
procedure Convert_And_Check_Range is
-- To what does the following comment belong???
-- We make a temporary to hold the value of the converted value
-- (converted to the base type), and then we will do the test against
-- this temporary.
--
-- Tnn : constant Target_Base_Type := Target_Base_Type (N);
-- [constraint_error when Tnn not in Target_Type]
--
-- The conversion itself is replaced by an occurrence of Tnn
Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N);
-- To what does the following comment belong???
-- Follow the conversion with the explicit range check. Note that we
-- suppress checks for this code, since we don't want a recursive
-- range check popping up.
begin
Insert_Actions (N, New_List (
Make_Object_Declaration (Loc,
Defining_Identifier => Tnn,
Object_Definition => New_Occurrence_Of (Target_Base_Type, Loc),
Constant_Present => True,
Expression =>
Make_Type_Conversion (Loc,
Subtype_Mark => New_Occurrence_Of (Target_Base_Type, Loc),
Expression => Duplicate_Subexpr (N))),
Make_Raise_Constraint_Error (Loc,
Condition =>
Make_Not_In (Loc,
Left_Opnd => New_Occurrence_Of (Tnn, Loc),
Right_Opnd => New_Occurrence_Of (Target_Type, Loc)),
Reason => Reason)),
Suppress => All_Checks);
Rewrite (N, New_Occurrence_Of (Tnn, Loc));
-- Set the type of N, because the declaration for Tnn might not
-- be analyzed yet, as is the case if N appears within a record
-- declaration, as a discriminant constraint or expression.
Set_Etype (N, Target_Base_Type);
end Convert_And_Check_Range;
-- Start of processing for Generate_Range_Check
begin begin
-- First special case, if the source type is already within the range -- First special case, if the source type is already within the range
-- of the target type, then no check is needed (probably we should have -- of the target type, then no check is needed (probably we should have
...@@ -6500,29 +6553,44 @@ package body Checks is ...@@ -6500,29 +6553,44 @@ package body Checks is
-- Insert the explicit range check. Note that we suppress checks for -- Insert the explicit range check. Note that we suppress checks for
-- this code, since we don't want a recursive range check popping up. -- this code, since we don't want a recursive range check popping up.
Insert_Action (N, if Is_Discrete_Type (Source_Base_Type)
Make_Raise_Constraint_Error (Loc, and then
Condition => Is_Discrete_Type (Target_Base_Type)
Make_Not_In (Loc, then
Left_Opnd => Duplicate_Subexpr (N), Insert_Action (N,
Make_Raise_Constraint_Error (Loc,
Condition =>
Make_Not_In (Loc,
Left_Opnd => Duplicate_Subexpr (N),
Right_Opnd => Right_Opnd =>
Make_Range (Loc, Make_Range (Loc,
Low_Bound => Low_Bound =>
Unchecked_Convert_To (Source_Base_Type, Unchecked_Convert_To (Source_Base_Type,
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Prefix =>
New_Occurrence_Of (Target_Type, Loc), New_Occurrence_Of (Target_Type, Loc),
Attribute_Name => Name_First)), Attribute_Name => Name_First)),
High_Bound => High_Bound =>
Unchecked_Convert_To (Source_Base_Type, Unchecked_Convert_To (Source_Base_Type,
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Prefix =>
New_Occurrence_Of (Target_Type, Loc), New_Occurrence_Of (Target_Type, Loc),
Attribute_Name => Name_Last)))), Attribute_Name => Name_Last)))),
Reason => Reason), Reason => Reason),
Suppress => All_Checks); Suppress => All_Checks);
-- For conversions involving at least one type that is not discrete,
-- first convert to target type and then generate the range check.
-- This avoids problems with values that are close to a bound of the
-- target type that would fail a range check when done in a larger
-- source type before converting but would pass if converted with
-- rounding and then checked (such as in float-to-float conversions).
else
Convert_And_Check_Range;
end if;
-- Note that at this stage we now that the Target_Base_Type is not in -- Note that at this stage we now that the Target_Base_Type is not in
-- the range of the Source_Base_Type (since even the Target_Type itself -- the range of the Source_Base_Type (since even the Target_Type itself
...@@ -6533,51 +6601,7 @@ package body Checks is ...@@ -6533,51 +6601,7 @@ package body Checks is
-- and then test the target result against the bounds. -- and then test the target result against the bounds.
elsif In_Subrange_Of (Source_Type, Target_Base_Type) then elsif In_Subrange_Of (Source_Type, Target_Base_Type) then
Convert_And_Check_Range;
-- We make a temporary to hold the value of the converted value
-- (converted to the base type), and then we will do the test against
-- this temporary.
-- Tnn : constant Target_Base_Type := Target_Base_Type (N);
-- [constraint_error when Tnn not in Target_Type]
-- Then the conversion itself is replaced by an occurrence of Tnn
-- Insert the explicit range check. Note that we suppress checks for
-- this code, since we don't want a recursive range check popping up.
declare
Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N);
begin
Insert_Actions (N, New_List (
Make_Object_Declaration (Loc,
Defining_Identifier => Tnn,
Object_Definition =>
New_Occurrence_Of (Target_Base_Type, Loc),
Constant_Present => True,
Expression =>
Make_Type_Conversion (Loc,
Subtype_Mark => New_Occurrence_Of (Target_Base_Type, Loc),
Expression => Duplicate_Subexpr (N))),
Make_Raise_Constraint_Error (Loc,
Condition =>
Make_Not_In (Loc,
Left_Opnd => New_Occurrence_Of (Tnn, Loc),
Right_Opnd => New_Occurrence_Of (Target_Type, Loc)),
Reason => Reason)),
Suppress => All_Checks);
Rewrite (N, New_Occurrence_Of (Tnn, Loc));
-- Set the type of N, because the declaration for Tnn might not
-- be analyzed yet, as is the case if N appears within a record
-- declaration, as a discriminant constraint or expression.
Set_Etype (N, Target_Base_Type);
end;
-- At this stage, we know that we have two scalar types, which are -- At this stage, we know that we have two scalar types, which are
-- directly convertible, and where neither scalar type has a base -- directly convertible, and where neither scalar type has a base
......
...@@ -5013,6 +5013,13 @@ package body Exp_Aggr is ...@@ -5013,6 +5013,13 @@ package body Exp_Aggr is
(Return_Applies_To (Return_Statement_Entity (Parent (N)))) (Return_Applies_To (Return_Statement_Entity (Parent (N))))
then then
return; return;
-- Do not attempt expansion if error already detected. We may reach this
-- point in spite of previous errors when compiling with -gnatq, to
-- force all possible errors (this is the usual ACATS mode).
elsif Error_Posted (N) then
return;
end if; end if;
-- If the semantic analyzer has determined that aggregate N will raise -- If the semantic analyzer has determined that aggregate N will raise
......
...@@ -10844,19 +10844,19 @@ package body Exp_Ch4 is ...@@ -10844,19 +10844,19 @@ package body Exp_Ch4 is
-- The only remaining step is to generate a range check if we still have -- The only remaining step is to generate a range check if we still have
-- a type conversion at this stage and Do_Range_Check is set. For now we -- a type conversion at this stage and Do_Range_Check is set. For now we
-- do this only for conversions of discrete types and for floating-point -- do this only for conversions of discrete types and for float-to-float
-- conversions where the base types of source and target are the same. -- conversions.
if Nkind (N) = N_Type_Conversion then if Nkind (N) = N_Type_Conversion then
-- For now we only support floating-point cases where the base types -- For now we only support floating-point cases where both source
-- of the target type and source expression are the same, so there's -- and target are floating-point types. Conversions where the source
-- potentially only a range check. Conversions where the source and -- and target involve integer or fixed-point types are still TBD,
-- target have different base types are still TBD. ??? -- though not clear whether those can even happen at this point, due
-- to transformations above. ???
if Is_Floating_Point_Type (Etype (N)) if Is_Floating_Point_Type (Etype (N))
and then and then Is_Floating_Point_Type (Etype (Expression (N)))
Base_Type (Etype (N)) = Base_Type (Etype (Expression (N)))
then then
if Do_Range_Check (Expression (N)) if Do_Range_Check (Expression (N))
and then Is_Floating_Point_Type (Target_Type) and then Is_Floating_Point_Type (Target_Type)
...@@ -10865,6 +10865,8 @@ package body Exp_Ch4 is ...@@ -10865,6 +10865,8 @@ package body Exp_Ch4 is
(Expression (N), Target_Type, CE_Range_Check_Failed); (Expression (N), Target_Type, CE_Range_Check_Failed);
end if; end if;
-- Discrete-to-discrete conversions
elsif Is_Discrete_Type (Etype (N)) then elsif Is_Discrete_Type (Etype (N)) then
declare declare
Expr : constant Node_Id := Expression (N); Expr : constant Node_Id := Expression (N);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment