public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-1523] [Ada] Fix incorrect itype sharing for case expression in limited type return
@ 2022-07-06 13:30 Pierre-Marie de Rodat
  0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2022-07-06 13:30 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:baa3015d8efebd731701d6985bb7a7083db244a8

commit r13-1523-gbaa3015d8efebd731701d6985bb7a7083db244a8
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Sat Jun 11 13:05:39 2022 +0200

    [Ada] Fix incorrect itype sharing for case expression in limited type return
    
    The compiler aborts with an internal error in gigi, but the problem is an
    itype incorrectly shared between several branches of an if_statement that
    has been created for a Build-In-Place return.
    
    Three branches of this if_statement contain an allocator statement and
    the latter two have been obtained as the result of calling New_Copy_Tree
    on the first; now the initialization expression of the first had also been
    obtained as the result of calling New_Copy_Tree on the original tree, and
    these chained calls to New_Copy_Tree run afoul of an issue with the copy
    of itypes after the rewrite of an aggregate as an expression with actions.
    
    Fixing this issue looks quite delicate, so this fixes the incorrect sharing
    by replacing the chained calls to New_Copy_Tree with repeated calls on the
    original expression, which is more elegant in any case.
    
    gcc/ada/
    
            * exp_ch3.adb (Make_Allocator_For_BIP_Return): New local function.
            (Expand_N_Object_Declaration): Use it to build the three allocators
            for a Build-In-Place return with an unconstrained type.  Update the
            head comment after other recent changes.

Diff:
---
 gcc/ada/exp_ch3.adb | 148 +++++++++++++++++++++++++++-------------------------
 1 file changed, 76 insertions(+), 72 deletions(-)

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index c9f0bfd9302..38552eff922 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -7980,16 +7980,11 @@ package body Exp_Ch3 is
             --  the value one, then the caller has passed access to an
             --  existing object for use as the return object. If the value
             --  is two, then the return object must be allocated on the
-            --  secondary stack. Otherwise, the object must be allocated in
-            --  a storage pool. We generate an if statement to test the
-            --  implicit allocation formal and initialize a local access
-            --  value appropriately, creating allocators in the secondary
-            --  stack and global heap cases. The special formal also exists
-            --  and must be tested when the function has a tagged result,
-            --  even when the result subtype is constrained, because in
-            --  general such functions can be called in dispatching contexts
-            --  and must be handled similarly to functions with a class-wide
-            --  result.
+            --  secondary stack. If the value is three, then the return
+            --  object must be allocated on the heap. Otherwise, the object
+            --  must be allocated in a storage pool. We generate an if
+            --  statement to test the BIP_Alloc_Form formal and initialize
+            --  a local access value appropriately.
 
             if Needs_BIP_Alloc_Form (Func_Id) then
                declare
@@ -8005,6 +8000,73 @@ package body Exp_Ch3 is
                   Pool_Id          : constant Entity_Id :=
                     Make_Temporary (Loc, 'P');
 
+                  function Make_Allocator_For_BIP_Return return Node_Id;
+                  --  Make an allocator for the BIP return being processed
+
+                  -----------------------------------
+                  -- Make_Allocator_For_BIP_Return --
+                  -----------------------------------
+
+                  function Make_Allocator_For_BIP_Return return Node_Id is
+                     Alloc : Node_Id;
+
+                  begin
+                     if Present (Expr_Q)
+                       and then not Is_Delayed_Aggregate (Expr_Q)
+                       and then not No_Initialization (N)
+                     then
+                        --  Always use the type of the expression for the
+                        --  qualified expression, rather than the result type.
+                        --  In general we cannot always use the result type
+                        --  for the allocator, because the expression might be
+                        --  of a specific type, such as in the case of an
+                        --  aggregate or even a nonlimited object when the
+                        --  result type is a limited class-wide interface type.
+
+                        Alloc :=
+                          Make_Allocator (Loc,
+                            Expression =>
+                              Make_Qualified_Expression (Loc,
+                                Subtype_Mark =>
+                                  New_Occurrence_Of (Etype (Expr_Q), Loc),
+                                Expression   => New_Copy_Tree (Expr_Q)));
+
+                     else
+                        --  If the function returns a class-wide type we cannot
+                        --  use the return type for the allocator. Instead we
+                        --  use the type of the expression, which must be an
+                        --  aggregate of a definite type.
+
+                        if Is_Class_Wide_Type (Ret_Obj_Typ) then
+                           Alloc :=
+                             Make_Allocator (Loc,
+                               Expression =>
+                                 New_Occurrence_Of (Etype (Expr_Q), Loc));
+
+                        else
+                           Alloc :=
+                             Make_Allocator (Loc,
+                               Expression =>
+                                 New_Occurrence_Of (Ret_Obj_Typ, Loc));
+                        end if;
+
+                        --  If the object requires default initialization then
+                        --  that will happen later following the elaboration of
+                        --  the object renaming. If we don't turn it off here
+                        --  then the object will be default initialized twice.
+
+                        Set_No_Initialization (Alloc);
+                     end if;
+
+                     --  Set the flag indicating that the allocator came from
+                     --  a build-in-place return statement, so we can avoid
+                     --  adjusting the allocated object.
+
+                     Set_Alloc_For_BIP_Return (Alloc);
+
+                     return Alloc;
+                  end Make_Allocator_For_BIP_Return;
+
                   Alloc_Obj_Id   : Entity_Id;
                   Alloc_Obj_Decl : Node_Id;
                   Alloc_Stmt      : Node_Id;
@@ -8049,71 +8111,15 @@ package body Exp_Ch3 is
 
                   Insert_Action (N, Alloc_Obj_Decl);
 
-                     --  Create allocators for both the secondary stack and
-                     --  global heap. If there's an initialization expression,
-                     --  then create these as initialized allocators.
-
-                  if Present (Expr_Q)
-                    and then not Is_Delayed_Aggregate (Expr_Q)
-                    and then not No_Initialization (N)
-                  then
-                     --  Always use the type of the expression for the
-                     --  qualified expression, rather than the result type.
-                     --  In general we cannot always use the result type
-                     --  for the allocator, because the expression might be
-                     --  of a specific type, such as in the case of an
-                     --  aggregate or even a nonlimited object when the
-                     --  result type is a limited class-wide interface type.
-
-                     Heap_Allocator :=
-                       Make_Allocator (Loc,
-                         Expression =>
-                           Make_Qualified_Expression (Loc,
-                             Subtype_Mark =>
-                               New_Occurrence_Of (Etype (Expr_Q), Loc),
-                             Expression   => New_Copy_Tree (Expr_Q)));
-
-                  else
-                     --  If the function returns a class-wide type we cannot
-                     --  use the return type for the allocator. Instead we
-                     --  use the type of the expression, which must be an
-                     --  aggregate of a definite type.
+                  --  First create the Heap_Allocator
 
-                     if Is_Class_Wide_Type (Ret_Obj_Typ) then
-                        Heap_Allocator :=
-                          Make_Allocator (Loc,
-                            Expression =>
-                              New_Occurrence_Of (Etype (Expr_Q), Loc));
-
-                     else
-                        Heap_Allocator :=
-                          Make_Allocator (Loc,
-                            Expression =>
-                              New_Occurrence_Of (Ret_Obj_Typ, Loc));
-                     end if;
-
-                     --  If the object requires default initialization then
-                     --  that will happen later following the elaboration of
-                     --  the object renaming. If we don't turn it off here
-                     --  then the object will be default initialized twice.
-
-                     Set_No_Initialization (Heap_Allocator);
-                  end if;
-
-                  --  Set the flag indicating that the allocator came from
-                  --  a build-in-place return statement, so we can avoid
-                  --  adjusting the allocated object. Note that this flag
-                  --  will be inherited by the copies made below.
-
-                  Set_Alloc_For_BIP_Return (Heap_Allocator);
+                  Heap_Allocator := Make_Allocator_For_BIP_Return;
 
                   --  The Pool_Allocator is just like the Heap_Allocator,
                   --  except we set Storage_Pool and Procedure_To_Call so
                   --  it will use the user-defined storage pool.
 
-                  Pool_Allocator := New_Copy_Tree (Heap_Allocator);
-
-                  pragma Assert (Alloc_For_BIP_Return (Pool_Allocator));
+                  Pool_Allocator := Make_Allocator_For_BIP_Return;
 
                   --  Do not generate the renaming of the build-in-place
                   --  pool parameter on ZFP because the parameter is not
@@ -8154,9 +8160,7 @@ package body Exp_Ch3 is
                   --  allocation.
 
                   else
-                     SS_Allocator := New_Copy_Tree (Heap_Allocator);
-
-                     pragma Assert (Alloc_For_BIP_Return (SS_Allocator));
+                     SS_Allocator := Make_Allocator_For_BIP_Return;
 
                      --  The heap and pool allocators are marked as
                      --  Comes_From_Source since they correspond to an


^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2022-07-06 13:30 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-07-06 13:30 [gcc r13-1523] [Ada] Fix incorrect itype sharing for case expression in limited type return Pierre-Marie de Rodat

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).