diff options
-rw-r--r-- | gcc/ada/ChangeLog | 22 | ||||
-rw-r--r-- | gcc/ada/exp_intr.adb | 6 | ||||
-rw-r--r-- | gcc/ada/exp_util.adb | 54 | ||||
-rw-r--r-- | gcc/ada/exp_util.ads | 39 | ||||
-rw-r--r-- | gcc/ada/opt.ads | 11 | ||||
-rw-r--r-- | gcc/ada/sem_ch8.adb | 23 |
6 files changed, 111 insertions, 44 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c4654d1..c490774 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2014-08-01 Robert Dewar <dewar@adacore.com> + + * sem_ch8.adb, opt.ads Minor comment updates. + +2014-08-01 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_intr.adb (Expand_Unc_Deallocation): Request a renaming + from the side effects removal machinery. + * exp_util.adb (Duplicate_Subexpr): Add formal parameter + Renaming_Req. Update the nested call to Remove_Side_Effects. + (Duplicate_Subexpr_No_Checks): Add formal parameter + Renaming_Req. Update the nested call to Remove_Side_Effects. + (Duplicate_Subexpr_Move_Checks): Add formal parameter + Renaming_Req. Update the nested call to Remove_Side_Effects. + (Remove_Side_Effects): Add formal parameter Renaming_Req. Generate + an object renaming declaration when the caller requests it. + * exp_util.ads (Duplicate_Subexpr): Add formal + parameter Renaming_Req. Update comment on usage. + (Duplicate_Subexpr_No_Checks): Add formal parameter Renaming_Req. + (Duplicate_Subexpr_Move_Checks): Add formal parameter + Renaming_Req. + 2014-08-01 Bob Duff <duff@adacore.com> * gnat_ugn.texi: Minor updates. diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index a2d02e8..465c8b2 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -1106,9 +1106,11 @@ package body Exp_Intr is end if; end if; - -- Normal processing for non-controlled types + -- Normal processing for non-controlled types. The argument to free is + -- a renaming rather than a constant to ensure that the original context + -- is always set to null after the deallocation takes place. - Free_Arg := Duplicate_Subexpr_No_Checks (Arg); + Free_Arg := Duplicate_Subexpr_No_Checks (Arg, Renaming_Req => True); Free_Node := Make_Free_Statement (Loc, Empty); Append_To (Stmts, Free_Node); Set_Storage_Pool (Free_Node, Pool); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 235951eb..64523f2 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1791,11 +1791,12 @@ package body Exp_Util is ----------------------- function Duplicate_Subexpr - (Exp : Node_Id; - Name_Req : Boolean := False) return Node_Id + (Exp : Node_Id; + Name_Req : Boolean := False; + Renaming_Req : Boolean := False) return Node_Id is begin - Remove_Side_Effects (Exp, Name_Req); + Remove_Side_Effects (Exp, Name_Req, Renaming_Req); return New_Copy_Tree (Exp); end Duplicate_Subexpr; @@ -1804,12 +1805,14 @@ package body Exp_Util is --------------------------------- function Duplicate_Subexpr_No_Checks - (Exp : Node_Id; - Name_Req : Boolean := False) return Node_Id + (Exp : Node_Id; + Name_Req : Boolean := False; + Renaming_Req : Boolean := False) return Node_Id is New_Exp : Node_Id; + begin - Remove_Side_Effects (Exp, Name_Req); + Remove_Side_Effects (Exp, Name_Req, Renaming_Req); New_Exp := New_Copy_Tree (Exp); Remove_Checks (New_Exp); return New_Exp; @@ -1820,12 +1823,14 @@ package body Exp_Util is ----------------------------------- function Duplicate_Subexpr_Move_Checks - (Exp : Node_Id; - Name_Req : Boolean := False) return Node_Id + (Exp : Node_Id; + Name_Req : Boolean := False; + Renaming_Req : Boolean := False) return Node_Id is New_Exp : Node_Id; + begin - Remove_Side_Effects (Exp, Name_Req); + Remove_Side_Effects (Exp, Name_Req, Renaming_Req); New_Exp := New_Copy_Tree (Exp); Remove_Checks (Exp); return New_Exp; @@ -7101,6 +7106,7 @@ package body Exp_Util is procedure Remove_Side_Effects (Exp : Node_Id; Name_Req : Boolean := False; + Renaming_Req : Boolean := False; Variable_Ref : Boolean := False) is Loc : constant Source_Ptr := Sloc (Exp); @@ -7186,14 +7192,30 @@ package body Exp_Util is Set_Analyzed (Prefix (Exp), False); end if; - E := - Make_Object_Declaration (Loc, - Defining_Identifier => Def_Id, - Object_Definition => New_Occurrence_Of (Exp_Type, Loc), - Constant_Present => True, - Expression => Relocate_Node (Exp)); + -- Generate: + -- Rnn : Exp_Type renames Expr; + + if Renaming_Req then + E := + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => Def_Id, + Subtype_Mark => New_Occurrence_Of (Exp_Type, Loc), + Name => Relocate_Node (Exp)); + + -- Generate: + -- Rnn : constant Exp_Type := Expr; + + else + E := + Make_Object_Declaration (Loc, + Defining_Identifier => Def_Id, + Object_Definition => New_Occurrence_Of (Exp_Type, Loc), + Constant_Present => True, + Expression => Relocate_Node (Exp)); + + Set_Assignment_OK (E); + end if; - Set_Assignment_OK (E); Insert_Action (Exp, E); -- If the expression has the form v.all then we can just capture the diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 0483f8f..a62ca9f 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -330,8 +330,9 @@ package Exp_Util is -- be the earliest point at which they are used. function Duplicate_Subexpr - (Exp : Node_Id; - Name_Req : Boolean := False) return Node_Id; + (Exp : Node_Id; + Name_Req : Boolean := False; + Renaming_Req : Boolean := False) return Node_Id; -- Given the node for a subexpression, this function makes a logical copy -- of the subexpression, and returns it. This is intended for use when the -- expansion of an expression needs to repeat part of it. For example, @@ -343,17 +344,25 @@ package Exp_Util is -- expression and the returned result then become references to this saved -- value. Exp must be analyzed on entry. On return, Exp is analyzed, but -- the caller is responsible for analyzing the returned copy after it is - -- attached to the tree. The Name_Req flag is set to ensure that the result - -- is suitable for use in a context requiring name (e.g. the prefix of an - -- attribute reference). + -- attached to the tree. + -- + -- The Name_Req flag is set to ensure that the result is suitable for use + -- in a context requiring a name (for example, the prefix of an attribute + -- reference) (can't this just be a qualification in Ada 2012???). + -- + -- The Renaming_Req flag is set to produce an object renaming declaration + -- rather than an object declaration. This is valid only if the expression + -- Exp designates a renamable object. This is used for example in the case + -- of an unchecked deallocation, to make sure the object gets set to null. -- -- Note that if there are any run time checks in Exp, these same checks -- will be duplicated in the returned duplicated expression. The two -- following functions allow this behavior to be modified. function Duplicate_Subexpr_No_Checks - (Exp : Node_Id; - Name_Req : Boolean := False) return Node_Id; + (Exp : Node_Id; + Name_Req : Boolean := False; + Renaming_Req : Boolean := False) return Node_Id; -- Identical in effect to Duplicate_Subexpr, except that Remove_Checks -- is called on the result, so that the duplicated expression does not -- include checks. This is appropriate for use when Exp, the original @@ -361,8 +370,9 @@ package Exp_Util is -- expression, so that there is no need to repeat any checks. function Duplicate_Subexpr_Move_Checks - (Exp : Node_Id; - Name_Req : Boolean := False) return Node_Id; + (Exp : Node_Id; + Name_Req : Boolean := False; + Renaming_Req : Boolean := False) return Node_Id; -- Identical in effect to Duplicate_Subexpr, except that Remove_Checks is -- called on Exp after the duplication is complete, so that the original -- expression does not include checks. In this case the result returned @@ -808,6 +818,7 @@ package Exp_Util is procedure Remove_Side_Effects (Exp : Node_Id; Name_Req : Boolean := False; + Renaming_Req : Boolean := False; Variable_Ref : Boolean := False); -- Given the node for a subexpression, this function replaces the node if -- necessary by an equivalent subexpression that is guaranteed to be side @@ -816,10 +827,12 @@ package Exp_Util is -- to which Exp is attached. Exp must be analyzed and resolved before the -- call and is analyzed and resolved on return. Name_Req may only be set to -- True if Exp has the form of a name, and the effect is to guarantee that - -- any replacement maintains the form of name. If Variable_Ref is set to - -- TRUE, a variable is considered as side effect (used in implementing - -- Force_Evaluation). Note: after call to Remove_Side_Effects, it is - -- safe to call New_Copy_Tree to obtain a copy of the resulting expression. + -- any replacement maintains the form of name. If Renaming_Req is set to + -- TRUE, the routine produces an object renaming reclaration capturing the + -- expression. If Variable_Ref is set to TRUE, a variable is considered as + -- side effect (used in implementing Force_Evaluation). Note: after call to + -- Remove_Side_Effects, it is safe to call New_Copy_Tree to obtain a copy + -- of the resulting expression. function Represented_As_Scalar (T : Entity_Id) return Boolean; -- Returns True iff the implementation of this type in code generation diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 2e7636d..f056f39 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -2097,7 +2097,12 @@ package Opt is -- GNAT -- True if compiling in GNAT system mode (-gnatg switch) - -- Setting this switch has the following effects + -- Setting this switch has the following effects on the language that is + -- accepted. Note that several of the following have the effect of changing + -- an error to a warning. But warnings are usually treated as fatal errors + -- in -gnatg mode, so to actually take advantage of such a change, it is + -- necessary to add an explicit pragma Warnings (Off) in the source and + -- this requires clear documentation of why this is necessary. -- The identifier character set is set to 'n' (7-bit ASCII) @@ -2141,13 +2146,11 @@ package Opt is -- Returning objects of limited types is allowed - -- All entities are considered known to Known_But_Invisible - -- Non-static call in preelaborated unit give a warning, not an error -- Warnings on possible elaboration errors are suppressed - -- Warning about packing being ignored is suppressed + -- Warnings about packing being ignored are suppressed -- Warnings in internal units are not suppressed (they normally are) diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 0e5c2e4..4a5bafc 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -4462,14 +4462,14 @@ package body Sem_Ch8 is -- for that processing function Known_But_Invisible (E : Entity_Id) return Boolean; - -- This function determines whether the entity E (which is not - -- visible) can reasonably be considered to be known to the writer - -- of the reference. This is a heuristic test, used only for the - -- purposes of figuring out whether we prefer to complain that an - -- entity is undefined or invisible (and identify the declaration - -- of the invisible entity in the latter case). The point here is - -- that we don't want to complain that something is invisible and - -- then point to something entirely mysterious to the writer. + -- This function determines whether a reference to the entity E, which + -- is not visible, can reasonably be considered to be known to the + -- writer of the reference. This is a heuristic test, used only for + -- the purposes of figuring out whether we prefer to complain that an + -- entity is undefined or invisible (and identify the declaration of + -- the invisible entity in the latter case). The point here is that we + -- don't want to complain that something is invisible and then point to + -- something entirely mysterious to the writer. procedure Nvis_Messages; -- Called if there are no visible entries for N, but there is at least @@ -4608,7 +4608,12 @@ package body Sem_Ch8 is elsif not Comes_From_Source (E) then return False; - -- In gnat internal mode, we consider all entities known + -- In gnat internal mode, we consider all entities known. The + -- historical reason behind this discrepancy is not known??? But the + -- only effect is to modify the error message given, so it is not + -- critical. Since it only affects the exact wording of error + -- messages in illegal programs, we do not mention this as an + -- effect of -gnatg, since it is not a language modification. elsif GNAT_Mode then return True; |