From d26d790dca2c2135161666dc955cc39befbaf587 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 4 Aug 2014 11:38:17 +0200 Subject: [PATCH] [multiple changes] 2014-08-04 Robert Dewar * checks.adb (Activate_Overflow_Check): Remove Check_Float_Overflow processing. (Apply_Scalar_Range_Check): Ditto. (Generate_Range_Check): Ditto. * exp_ch4.adb (Expand_N_Op_Add): Add call to Check_Float_Op_Overflow. (Expand_N_Op_Divide): ditto. (Expand_N_Op_Multiply): ditto. (Expand_N_Op_Subtract): ditto. * exp_util.ads, exp_util.adb (Check_Float_Op_Overflow): New procedure. * sem_attr.adb (Analyze_Attribute, case Pred): Make sure Do_Range_Check is set for floating-point case in -gnatc or GNATprove mode. (Analyze_Attribute, case Succ): Make sure Do_Range_Check is set for floating-point case in -gnatc or GNATprove mode. * sem_res.adb (Resolve_Type_Conversion): Make sure Do_Range_Check flag is set for real to integer conversion in GNATprove or -gnatc mode. 2014-08-04 Gary Dismukes * sem_ch13.adb (Analyze_Aspect_Specifications): Resolve the expression of an Import or Export aspect as type Boolean and require it to be static. Add ??? comment. Also, set the Is_Exported flag when appropriate. From-SVN: r213545 --- gcc/ada/ChangeLog | 29 ++++++++++++++++++++++++++++ gcc/ada/checks.adb | 18 ++---------------- gcc/ada/exp_ch4.adb | 10 +++++----- gcc/ada/exp_util.adb | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/exp_util.ads | 7 +++++++ gcc/ada/sem_attr.adb | 12 ++++-------- gcc/ada/sem_ch13.adb | 36 +++++++++++++++++++++++++---------- gcc/ada/sem_res.adb | 4 +++- 8 files changed, 130 insertions(+), 40 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d4e1dc8..39ace1f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,34 @@ 2014-08-04 Robert Dewar + * checks.adb (Activate_Overflow_Check): Remove + Check_Float_Overflow processing. + (Apply_Scalar_Range_Check): Ditto. + (Generate_Range_Check): Ditto. + * exp_ch4.adb (Expand_N_Op_Add): Add call to + Check_Float_Op_Overflow. + (Expand_N_Op_Divide): ditto. + (Expand_N_Op_Multiply): ditto. + (Expand_N_Op_Subtract): ditto. + * exp_util.ads, exp_util.adb (Check_Float_Op_Overflow): New procedure. + * sem_attr.adb (Analyze_Attribute, case Pred): Make sure + Do_Range_Check is set for floating-point case in -gnatc or + GNATprove mode. + (Analyze_Attribute, case Succ): Make sure + Do_Range_Check is set for floating-point case in -gnatc or + GNATprove mode. + * sem_res.adb (Resolve_Type_Conversion): Make sure Do_Range_Check + flag is set for real to integer conversion in GNATprove or + -gnatc mode. + +2014-08-04 Gary Dismukes + + * sem_ch13.adb (Analyze_Aspect_Specifications): Resolve + the expression of an Import or Export aspect as type Boolean + and require it to be static. Add ??? comment. Also, set the + Is_Exported flag when appropriate. + +2014-08-04 Robert Dewar + * exp_ch4.adb: Minor reformatting. * exp_attr.adb: Minor reformatting. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index f41df54..1f9493d 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -396,10 +396,6 @@ package body Checks is if Present (Etype (N)) and then Is_Floating_Point_Type (Etype (N)) and then not Is_Constrained (Etype (N)) - - -- But do the check after all if float overflow checking enforced - - and then not Check_Float_Overflow then return; end if; @@ -2871,11 +2867,6 @@ package body Checks is and then not Has_Infinities (Target_Typ) then Enable_Range_Check (Expr); - - -- Always do a range check for operators if option set - - elsif Check_Float_Overflow and then Nkind (Expr) in N_Op then - Enable_Range_Check (Expr); end if; end if; @@ -2984,9 +2975,9 @@ package body Checks is -- Normally, we only do range checks if the type is constrained. We do -- NOT want range checks for unconstrained types, since we want to have - -- infinities. Override this decision in Check_Float_Overflow mode. + -- infinities. - if Is_Constrained (S_Typ) or else Check_Float_Overflow then + if Is_Constrained (S_Typ) then Enable_Range_Check (Expr); end if; @@ -6471,11 +6462,6 @@ package body Checks is or else (Is_Entity_Name (N) and then Ekind (Entity (N)) = E_Enumeration_Literal)) - - -- Also do not apply this for floating-point if Check_Float_Overflow - - and then not - (Is_Floating_Point_Type (Source_Type) and Check_Float_Overflow) then Set_Do_Range_Check (N, False); return; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index e0f76fc..0f4261f 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -151,11 +151,11 @@ package body Exp_Ch4 is Bodies : List_Id) return Node_Id; -- Local recursive function used to expand equality for nested composite -- types. Used by Expand_Record/Array_Equality, Bodies is a list on which - -- to attach bodies of local functions that are created in the process. - -- It is the responsibility of the caller to insert those bodies at the - -- right place. Nod provides the Sloc value for generated code. Lhs and Rhs - -- are the left and right sides for the comparison, and Typ is the type of - -- the objects to compare. + -- to attach bodies of local functions that are created in the process. It + -- is the responsibility of the caller to insert those bodies at the right + -- place. Nod provides the Sloc value for generated code. Lhs and Rhs are + -- the left and right sides for the comparison, and Typ is the type of the + -- objects to compare. procedure Expand_Concatenate (Cnode : Node_Id; Opnds : List_Id); -- Routine to expand concatenation of a sequence of two or more operands diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 64523f2..c1fca54 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1633,6 +1633,60 @@ package body Exp_Util is return Build_Task_Image_Function (Loc, Decls, Stats, Res); end Build_Task_Record_Image; + ----------------------------- + -- Check_Float_Op_Overflow -- + ----------------------------- + + procedure Check_Float_Op_Overflow (N : Node_Id) is + begin + -- Return if no check needed + + if not Check_Float_Overflow + or else not Is_Floating_Point_Type (Etype (N)) + then + return; + end if; + + -- Otherwise we replace the expression by + + -- do Tnn : constant ftype := expression; + -- constraint_error when not Tnn'Valid; + -- in Tnn; + + declare + Loc : constant Source_Ptr := Sloc (N); + Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', N); + Typ : constant Entity_Id := Etype (N); + + begin + -- Prevent recursion + + Set_Analyzed (N); + + -- Do the rewrite to include the check + + Rewrite (N, + Make_Expression_With_Actions (Loc, + Actions => New_List ( + Make_Object_Declaration (Loc, + Defining_Identifier => Tnn, + Object_Definition => New_Occurrence_Of (Typ, Loc), + Constant_Present => True, + Expression => Relocate_Node (N)), + Make_Raise_Constraint_Error (Loc, + Condition => + Make_Op_Not (Loc, + Right_Opnd => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Tnn, Loc), + Attribute_Name => Name_Valid)), + Reason => CE_Overflow_Check_Failed)), + Expression => New_Occurrence_Of (Tnn, Loc))); + + Analyze_And_Resolve (N, Typ); + end; + end Check_Float_Op_Overflow; + ---------------------------------- -- Component_May_Be_Bit_Aligned -- ---------------------------------- diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index a62ca9f..cdc2a24 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -276,6 +276,13 @@ package Exp_Util is -- is false, the call is for a stand-alone object, and the generated -- function itself must do its own cleanups. + procedure Check_Float_Op_Overflow (N : Node_Id); + -- Called where we could have a floating-point binary operator where we + -- must check for infinities if we are operating in Check_Float_Overflow + -- mode. Note that we don't need to worry about unary operator cases, + -- since for floating-point, abs, unary "-", and unary "+" can never + -- case overflow. + function Component_May_Be_Bit_Aligned (Comp : Entity_Id) return Boolean; -- This function is in charge of detecting record components that may -- cause trouble in the back end if an attempt is made to assign the diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 2fab55a..cab75c9 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -4808,10 +4808,8 @@ package body Sem_Attr is -- make an exception in Check_Float_Overflow mode. if Is_Floating_Point_Type (P_Type) then - if Check_Float_Overflow - and then not Range_Checks_Suppressed (P_Base_Type) - then - Enable_Range_Check (E1); + if not Range_Checks_Suppressed (P_Base_Type) then + Set_Do_Range_Check (E1); end if; -- If not modular type, test for overflow check required @@ -5702,10 +5700,8 @@ package body Sem_Attr is -- make an exception in Check_Float_Overflow mode. if Is_Floating_Point_Type (P_Type) then - if Check_Float_Overflow - and then not Range_Checks_Suppressed (P_Base_Type) - then - Enable_Range_Check (E1); + if not Range_Checks_Suppressed (P_Base_Type) then + Set_Do_Range_Check (E1); end if; -- If not modular type, test for overflow check required diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 15bb5b3..3ef5836 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2949,18 +2949,34 @@ package body Sem_Ch13 is -- that verifed that there was a matching convention -- is now obsolete. - if A_Id = Aspect_Import then - Set_Is_Imported (E); + -- Resolve the expression of an Import or Export here, + -- and require it to be of type Boolean and static. This + -- is not quite right, because in general this should be + -- delayed, but that seems tricky for these, because + -- normally Boolean aspects are replaced with pragmas at + -- the freeze point (in Make_Pragma_From_Boolean_Aspect), + -- but in the case of these aspects we can't generate + -- a simple pragma with just the entity name. ??? + + if not Present (Expr) + or else Is_True (Static_Boolean (Expr)) + then + if A_Id = Aspect_Import then + Set_Is_Imported (E); - -- An imported entity cannot have an explicit - -- initialization. + -- An imported entity cannot have an explicit + -- initialization. - if Nkind (N) = N_Object_Declaration - and then Present (Expression (N)) - then - Error_Msg_N - ("imported entities cannot be initialized " - & "(RM B.1(24))", Expression (N)); + if Nkind (N) = N_Object_Declaration + and then Present (Expression (N)) + then + Error_Msg_N + ("imported entities cannot be initialized " + & "(RM B.1(24))", Expression (N)); + end if; + + elsif A_Id = Aspect_Export then + Set_Is_Exported (E); end if; end if; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 87024ee..6708bc6 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -10507,9 +10507,11 @@ package body Sem_Res is -- 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. + -- general need a range check. We only need this if expansion is off + -- or we are in GNATProve mode. if Nkind (N) = N_Type_Conversion + and then (GNATprove_Mode or not Expander_Active) and then Is_Integer_Type (Target_Typ) and then Is_Real_Type (Operand_Typ) then -- 2.7.4