2014-07-29 Hristian Kirtchev <kirtchev@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 29 Jul 2014 12:51:47 +0000 (12:51 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 29 Jul 2014 12:51:47 +0000 (12:51 +0000)
* exp_ch4.adb (Process_Transient_Object): Remove constant
In_Cond_Expr, use its initialization expression in place.
* exp_ch7.adb (Process_Declarations): There is no need to check
that a transient object being hooked is controlled as it would
not have been hooked in the first place.
* exp_util.adb (Is_Aliased): 'Reference-d or renamed transient
objects are not considered aliased when the related context is
a Boolean expression_with_actions.
(Requires_Cleanup_Actions): There is no need to check that a transient
object being hooked is controlled as it would not have been hooked in
the first place.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@213158 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/exp_ch4.adb
gcc/ada/exp_ch7.adb
gcc/ada/exp_util.adb

index 3b7ae6b..7d2e4ce 100644 (file)
@@ -1,3 +1,17 @@
+2014-07-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * exp_ch4.adb (Process_Transient_Object): Remove constant
+       In_Cond_Expr, use its initialization expression in place.
+       * exp_ch7.adb (Process_Declarations): There is no need to check
+       that a transient object being hooked is controlled as it would
+       not have been hooked in the first place.
+       * exp_util.adb (Is_Aliased): 'Reference-d or renamed transient
+       objects are not considered aliased when the related context is
+       a Boolean expression_with_actions.
+       (Requires_Cleanup_Actions): There is no need to check that a transient
+       object being hooked is controlled as it would not have been hooked in
+       the first place.
+
 2014-07-29  Robert Dewar  <dewar@adacore.com>
 
        * errout.adb: Minor reformatting.
index 9abe25a..96aa7f1 100644 (file)
@@ -12616,9 +12616,6 @@ package body Exp_Ch4 is
       --  If False, call to finalizer includes a test of whether the hook
       --  pointer is null.
 
-      In_Cond_Expr : constant Boolean :=
-                       Within_Case_Or_If_Expression (Rel_Node);
-
    begin
       --  Step 0: determine where to attach finalization actions in the tree
 
@@ -12636,10 +12633,10 @@ package body Exp_Ch4 is
          --  conditional expression.
 
          Finalize_Always :=
-            not (In_Cond_Expr
-                  or else
-                    Nkind_In (Original_Node (Rel_Node), N_Case_Expression,
-                                                        N_If_Expression));
+           not Within_Case_Or_If_Expression (Rel_Node)
+             and then not Nkind_In
+                            (Original_Node (Rel_Node), N_Case_Expression,
+                                                       N_If_Expression);
 
          declare
             Loc  : constant Source_Ptr := Sloc (Rel_Node);
index a714d20..c794f7d 100644 (file)
@@ -1817,9 +1817,7 @@ package body Exp_Ch7 is
                elsif Is_Access_Type (Obj_Typ)
                  and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
                  and then Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) =
-                                                        N_Object_Declaration
-                 and then Is_Finalizable_Transient
-                            (Status_Flag_Or_Transient_Decl (Obj_Id), Decl)
+                                   N_Object_Declaration
                then
                   Processing_Actions (Has_No_Init => True);
 
index d4b9604..d94e69d 100644 (file)
@@ -3435,9 +3435,8 @@ package body Exp_Util is
                    or else Etype (Assoc_Node) /= Standard_Void_Type)
         and then Nkind (Assoc_Node) /= N_Procedure_Call_Statement
         and then (Nkind (Assoc_Node) /= N_Attribute_Reference
-                   or else
-                     not Is_Procedure_Attribute_Name
-                           (Attribute_Name (Assoc_Node)))
+                   or else not Is_Procedure_Attribute_Name
+                                 (Attribute_Name (Assoc_Node)))
       then
          N := Assoc_Node;
          P := Parent (Assoc_Node);
@@ -4557,6 +4556,17 @@ package body Exp_Util is
       --  Start of processing for Is_Aliased
 
       begin
+         --  'Reference-d or renamed transient objects are not consider aliased
+         --  when the related context is a Boolean expression_with_actions. The
+         --  Boolean result is always known after the action list is evaluated,
+         --  therefore the transient objects must be finalized at that point.
+
+         if Nkind (Rel_Node) = N_Expression_With_Actions
+           and then Is_Boolean_Type (Etype (Rel_Node))
+         then
+            return False;
+         end if;
+
          Stmt := First_Stmt;
          while Present (Stmt) loop
             if Nkind (Stmt) = N_Object_Declaration then
@@ -4652,8 +4662,7 @@ package body Exp_Util is
                if Nkind (Stmt) = N_Object_Declaration
                  and then Present (Expression (Stmt))
                  and then Nkind (Expression (Stmt)) = N_Reference
-                 and then Nkind (Prefix (Expression (Stmt))) =
-                            N_Function_Call
+                 and then Nkind (Prefix (Expression (Stmt))) = N_Function_Call
                then
                   Call := Prefix (Expression (Stmt));
 
@@ -7441,9 +7450,7 @@ package body Exp_Util is
             elsif Is_Access_Type (Obj_Typ)
               and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
               and then Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) =
-                                N_Object_Declaration
-              and then Is_Finalizable_Transient
-                         (Status_Flag_Or_Transient_Decl (Obj_Id), Decl)
+                                                        N_Object_Declaration
             then
                return True;
 
@@ -7464,9 +7471,8 @@ package body Exp_Util is
             --  treated as controlled since they require manual cleanup.
 
             elsif Ekind (Obj_Id) = E_Variable
-              and then
-                (Is_Simple_Protected_Type (Obj_Typ)
-                  or else Has_Simple_Protected_Object (Obj_Typ))
+              and then (Is_Simple_Protected_Type (Obj_Typ)
+                         or else Has_Simple_Protected_Object (Obj_Typ))
             then
                return True;
             end if;
@@ -7529,9 +7535,7 @@ package body Exp_Util is
                   and then not Is_Access_Subprogram_Type (Typ)
                   and then Needs_Finalization
                              (Available_View (Designated_Type (Typ))))
-               or else
-                (Is_Type (Typ)
-                  and then Needs_Finalization (Typ)))
+                or else (Is_Type (Typ) and then Needs_Finalization (Typ)))
               and then Requires_Cleanup_Actions
                          (Actions (Decl), Lib_Level, Nested_Constructs)
             then
@@ -7756,7 +7760,8 @@ package body Exp_Util is
       if Ialign /= No_Uint and then Ialign > Maximum_Alignment then
          return True;
 
-      elsif Ialign /= No_Uint and then Oalign /= No_Uint
+      elsif Ialign /= No_Uint
+        and then Oalign /= No_Uint
         and then Ialign <= Oalign
       then
          return True;
@@ -8327,7 +8332,7 @@ package body Exp_Util is
 
          when N_Range =>
             return Side_Effect_Free (Low_Bound (N),  Name_Req, Variable_Ref)
-                      and then
+                     and then
                    Side_Effect_Free (High_Bound (N), Name_Req, Variable_Ref);
 
          --  A slice is side effect free if it is a side effect free