From f5655e4a9433c8a865b36eb098fb2315d7621855 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 4 Aug 2014 09:54:00 +0200 Subject: [PATCH] [multiple changes] 2014-08-04 Ed Schonberg * 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 * 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 --- gcc/ada/ChangeLog | 27 ++++++++ gcc/ada/checks.adb | 158 +++++++++++++++++++++++++------------------ gcc/ada/exp_aggr.adb | 7 ++ gcc/ada/exp_ch4.adb | 18 ++--- 4 files changed, 135 insertions(+), 75 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 452488a37f3..bcbe25ddf74 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2014-08-04 Arnaud Charlet + + * g-trasym-vms-ia64.adb, g-trasym-vms-alpha.adb: Removed. + +2014-08-04 Ed Schonberg + + * 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 + + * 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 * gcc-interface/trans.c: Use hash_set instead of pointer_set. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index bf27d4ef3a2..bab3ba7eb0a 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -6402,6 +6402,59 @@ package body Checks is Source_Base_Type : constant Entity_Id := Base_Type (Source_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 -- 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 @@ -6500,29 +6553,44 @@ package body Checks is -- Insert the explicit range check. Note that we suppress checks for -- this code, since we don't want a recursive range check popping up. - Insert_Action (N, - Make_Raise_Constraint_Error (Loc, - Condition => - Make_Not_In (Loc, - Left_Opnd => Duplicate_Subexpr (N), + if Is_Discrete_Type (Source_Base_Type) + and then + Is_Discrete_Type (Target_Base_Type) + then + Insert_Action (N, + Make_Raise_Constraint_Error (Loc, + Condition => + Make_Not_In (Loc, + Left_Opnd => Duplicate_Subexpr (N), - Right_Opnd => - Make_Range (Loc, - Low_Bound => - Unchecked_Convert_To (Source_Base_Type, - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Target_Type, Loc), - Attribute_Name => Name_First)), - - High_Bound => - Unchecked_Convert_To (Source_Base_Type, - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Target_Type, Loc), - Attribute_Name => Name_Last)))), - Reason => Reason), - Suppress => All_Checks); + Right_Opnd => + Make_Range (Loc, + Low_Bound => + Unchecked_Convert_To (Source_Base_Type, + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (Target_Type, Loc), + Attribute_Name => Name_First)), + + High_Bound => + Unchecked_Convert_To (Source_Base_Type, + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (Target_Type, Loc), + Attribute_Name => Name_Last)))), + Reason => Reason), + 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 -- the range of the Source_Base_Type (since even the Target_Type itself @@ -6533,51 +6601,7 @@ package body Checks is -- and then test the target result against the bounds. elsif In_Subrange_Of (Source_Type, Target_Base_Type) then - - -- 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; + Convert_And_Check_Range; -- At this stage, we know that we have two scalar types, which are -- directly convertible, and where neither scalar type has a base diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 378d66fee63..60838de3674 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -5013,6 +5013,13 @@ package body Exp_Aggr is (Return_Applies_To (Return_Statement_Entity (Parent (N)))) then 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; -- If the semantic analyzer has determined that aggregate N will raise diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 0e6ea4f8fb2..7123389b813 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -10844,19 +10844,19 @@ package body Exp_Ch4 is -- 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 - -- do this only for conversions of discrete types and for floating-point - -- conversions where the base types of source and target are the same. + -- do this only for conversions of discrete types and for float-to-float + -- conversions. if Nkind (N) = N_Type_Conversion then - -- For now we only support floating-point cases where the base types - -- of the target type and source expression are the same, so there's - -- potentially only a range check. Conversions where the source and - -- target have different base types are still TBD. ??? + -- For now we only support floating-point cases where both source + -- and target are floating-point types. Conversions where the source + -- and target involve integer or fixed-point 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)) - and then - Base_Type (Etype (N)) = Base_Type (Etype (Expression (N))) + and then Is_Floating_Point_Type (Etype (Expression (N))) then if Do_Range_Check (Expression (N)) and then Is_Floating_Point_Type (Target_Type) @@ -10865,6 +10865,8 @@ package body Exp_Ch4 is (Expression (N), Target_Type, CE_Range_Check_Failed); end if; + -- Discrete-to-discrete conversions + elsif Is_Discrete_Type (Etype (N)) then declare Expr : constant Node_Id := Expression (N); -- 2.30.2