From: Arnaud Charlet Date: Mon, 29 Jun 2020 08:22:35 +0000 (-0400) Subject: [Ada] No range check on fixed point to integer conversion X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=17ea7fad2830423188e2055708bb2d4a983c33bc;p=gcc.git [Ada] No range check on fixed point to integer conversion gcc/ada/ * checks.adb (Apply_Type_Conversion_Checks): Minor code clean up. * exp_ch4.adb (Discrete_Range_Check): Optimize range checks. Update comments. (Expand_N_Type_Conversion): Generate range check when rewriting a type conversion if needed. Add assertion. * exp_ch6.adb (Expand_Simple_Function_Return): Minor code clean up. * sem_res.adb (Resolve_Type_Conversion): Apply range check when needed. Update comments. --- diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 4eebfd7b7cb..cfbb4bc9fcf 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -3646,14 +3646,10 @@ package body Checks is (Entity (High_Bound (Scalar_Range (Enum_T)))); end if; - if Last_E <= Last_I then - null; - - else + if Last_E > Last_I then Activate_Overflow_Check (N); end if; end; - else Activate_Overflow_Check (N); end if; @@ -3666,7 +3662,6 @@ package body Checks is and then not GNATprove_Mode then Apply_Float_Conversion_Check (Expr, Target_Type); - else -- Conversions involving fixed-point types are expanded -- separately, and do not need a Range_Check flag, except diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 6622a16c983..7139e4948b3 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -11447,7 +11447,12 @@ package body Exp_Ch4 is -- Start of processing for Discrete_Range_Check begin - -- Nothing to do if conversion was rewritten + -- Clear the Do_Range_Check flag on N if needed: this can occur when + -- e.g. a trivial type conversion is rewritten by its expression. + + Set_Do_Range_Check (N, False); + + -- Nothing more to do if conversion was rewritten if Nkind (N) /= N_Type_Conversion then return; @@ -11455,6 +11460,16 @@ package body Exp_Ch4 is Expr := Expression (N); + -- Nothing to do if no range check flag set + + if not Do_Range_Check (Expr) then + return; + end if; + + -- Clear the Do_Range_Check flag on Expr + + Set_Do_Range_Check (Expr, False); + -- Nothing to do if range checks suppressed if Range_Checks_Suppressed (Target_Type) then @@ -11473,23 +11488,20 @@ package body Exp_Ch4 is -- Before we do a range check, we have to deal with treating -- a fixed-point operand as an integer. The way we do this -- is simply to do an unchecked conversion to an appropriate - -- integer type large enough to hold the result. + -- integer type with the smallest size, so that we can suppress + -- trivial checks. if Is_Fixed_Point_Type (Etype (Expr)) then - if Esize (Base_Type (Etype (Expr))) > Standard_Integer_Size then - Ityp := Standard_Long_Long_Integer; - else - Ityp := Standard_Integer; - end if; + Ityp := Small_Integer_Type_For + (Esize (Base_Type (Etype (Expr))), False); - -- Generate a temporary with the large type to facilitate in the C - -- backend the code generation for the unchecked conversion. + -- Generate a temporary with the integer type to facilitate in the + -- C backend the code generation for the unchecked conversion. if Modify_Tree_For_C then Generate_Temporary; end if; - Set_Do_Range_Check (Expr, False); Rewrite (Expr, Unchecked_Convert_To (Ityp, Expr)); end if; @@ -11726,7 +11738,12 @@ package body Exp_Ch4 is Tnn : Entity_Id; begin - -- Nothing to do if conversion was rewritten + -- Clear the Do_Range_Check flag on N if needed: this can occur when + -- e.g. a trivial type conversion is rewritten by its expression. + + Set_Do_Range_Check (N, False); + + -- Nothing more to do if conversion was rewritten if Nkind (N) /= N_Type_Conversion then return; @@ -11734,7 +11751,7 @@ package body Exp_Ch4 is Expr := Expression (N); - -- Clear the flag once for all + -- Clear the Do_Range_Check flag on Expr Set_Do_Range_Check (Expr, False); @@ -12009,7 +12026,8 @@ package body Exp_Ch4 is -- Nothing at all to do if conversion is to the identical type so remove -- the conversion completely, it is useless, except that it may carry - -- an Assignment_OK attribute, which must be propagated to the operand. + -- an Assignment_OK attribute, which must be propagated to the operand + -- and the Do_Range_Check flag on Operand should be taken into account. if Operand_Type = Target_Type then if Assignment_OK (N) then @@ -12017,6 +12035,13 @@ package body Exp_Ch4 is end if; Rewrite (N, Relocate_Node (Operand)); + + if Do_Range_Check (Operand) then + pragma Assert (Is_Discrete_Type (Operand_Type)); + + Discrete_Range_Check; + end if; + goto Done; end if; @@ -12125,7 +12150,7 @@ package body Exp_Ch4 is -- in Checks.Apply_Arithmetic_Overflow_Check, but we catch more cases in -- the processing here. Also we still need the Checks circuit, since we -- have to be sure not to generate junk overflow checks in the first - -- place, since it would be trick to remove them here. + -- place, since it would be tricky to remove them here. if Integer_Promotion_Possible (N) then @@ -12409,7 +12434,9 @@ package body Exp_Ch4 is -- These conversions require special expansion and processing, found in -- the Exp_Fixd package. We ignore cases where Conversion_OK is set, -- since from a semantic point of view, these are simple integer - -- conversions, which do not need further processing. + -- conversions, which do not need further processing except for the + -- generation of range checks, which is performed at the end of this + -- procedure. elsif Is_Fixed_Point_Type (Operand_Type) and then not Conversion_OK (N) @@ -12617,11 +12644,15 @@ package body Exp_Ch4 is then Real_Range_Check; end if; + + pragma Assert (not Do_Range_Check (Expression (N))); end if; -- Here at end of processing <> + pragma Assert (not Do_Range_Check (N)); + -- Apply predicate check if required. Note that we can't just call -- Apply_Predicate_Check here, because the type looks right after -- the conversion and it would omit the check. The Comes_From_Source diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index c059ee6276e..20506c807ef 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -7457,10 +7457,9 @@ package body Exp_Ch6 is -- Check the result expression of a scalar function against the subtype -- of the function by inserting a conversion. This conversion must -- eventually be performed for other classes of types, but for now it's - -- only done for scalars. - -- ??? + -- only done for scalars ??? - if Is_Scalar_Type (Exp_Typ) then + if Is_Scalar_Type (Exp_Typ) and then Exp_Typ /= R_Type then Rewrite (Exp, Convert_To (R_Type, Exp)); -- The expression is resolved to ensure that the conversion gets diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index cd87ec235af..1ca62ecaddc 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -11641,12 +11641,12 @@ package body Sem_Res is -- to apply checks required for a subtype conversion. -- Skip these type conversion checks if universal fixed operands - -- operands involved, since range checks are handled separately for + -- are involved, since range checks are handled separately for -- these cases (in the appropriate Expand routines in unit Exp_Fixd). if Nkind (N) = N_Type_Conversion and then not Is_Generic_Type (Root_Type (Target_Typ)) - and then Target_Typ /= Universal_Fixed + and then Target_Typ /= Universal_Fixed and then Operand_Typ /= Universal_Fixed then Apply_Type_Conversion_Checks (N); @@ -11886,19 +11886,13 @@ package body Sem_Res is (N, Target_Typ, Static_Failure_Is_Error => True); end if; - -- If at this stage we have a real to integer conversion, make sure that - -- the Do_Range_Check flag is set, because such conversions in general - -- need a range check. We only need this if expansion is off. - -- In GNATprove mode, we only do that when converting from fixed-point - -- (as floating-point to integer conversions are now handled in - -- GNATprove mode). + -- If at this stage we have a fixed point to integer conversion, make + -- sure that the Do_Range_Check flag is set which is not always done + -- by exp_fixd.adb. if Nkind (N) = N_Type_Conversion - and then not Expander_Active and then Is_Integer_Type (Target_Typ) - and then (Is_Fixed_Point_Type (Operand_Typ) - or else (not GNATprove_Mode - and then Is_Floating_Point_Type (Operand_Typ))) + and then Is_Fixed_Point_Type (Operand_Typ) and then not Range_Checks_Suppressed (Target_Typ) and then not Range_Checks_Suppressed (Operand_Typ) then