This is a regression present on the mainline.  The compiler crashes during the 
function unnesting pass because of an out-of-context temporary, but the root 
cause of the problem is incorrect sharing of a tree node.  The problem has 
probably been latent since gimplification was devised: while the DECL_SIZE and 
DECL_SIZE_UNIT trees of VAR_DECLs are visited by walk_tree (via BIND_EXPR), 
this isn't the case for RESULT_DECL.  As a result, if it has variable size 
(this now happens much more often in Ada), its subtrees aren't unshared and 
this is problematic.

The proposed fix is to unshared them manually in unshare_body.  To implement 
this, the awkward interface to gimplify_body/unshare_body, where you pass both 
a pointer to the body and the decl itself and later need to test whether they 
are related, is simplified as the 2 calls of gimplify_body are idiomatic.

Tested on i586-suse-linux, OK for the mainline?


2012-01-10  Eric Botcazou  <ebotca...@adacore.com>

        * gimple.h (gimplify_body): Remove first argument.
        * gimplify.c (copy_if_shared): Add DATA argument.  Do not create the
        pointer set here, instead just pass DATA to walk_tree.
        (unshare_body): Remove BODY_P argument and adjust.  Create the pointer
        set here and invoke copy_if_shared on the size trees of DECL_RESULT.
        (unvisit_body): Likewise, but with unmark_visited.
        (gimplify_body): Remove BODY_P argument and adjust.
        (gimplify_function_tree): Adjust call to gimplify_body.
        * omp-low.c (finalize_task_copyfn): Likewise.


2012-01-10  Eric Botcazou  <ebotca...@adacore.com>

        * gnat.dg/array19.ad[sb]: New test.


-- 
Eric Botcazou
Index: gimple.h
===================================================================
--- gimple.h	(revision 182780)
+++ gimple.h	(working copy)
@@ -1099,7 +1099,7 @@ extern enum gimplify_status gimplify_exp
 extern void gimplify_type_sizes (tree, gimple_seq *);
 extern void gimplify_one_sizepos (tree *, gimple_seq *);
 extern bool gimplify_stmt (tree *, gimple_seq *);
-extern gimple gimplify_body (tree *, tree, bool);
+extern gimple gimplify_body (tree, bool);
 extern void push_gimplify_context (struct gimplify_ctx *);
 extern void pop_gimplify_context (gimple);
 extern void gimplify_and_add (tree, gimple_seq *);
Index: gimplify.c
===================================================================
--- gimplify.c	(revision 182780)
+++ gimplify.c	(working copy)
@@ -951,31 +951,33 @@ copy_if_shared_r (tree *tp, int *walk_su
 /* Unshare most of the shared trees rooted at *TP. */
 
 static inline void
-copy_if_shared (tree *tp)
+copy_if_shared (tree *tp, void *data)
 {
-  /* If the language requires deep unsharing, we need a pointer set to make
-     sure we don't repeatedly unshare subtrees of unshareable nodes.  */
-  struct pointer_set_t *visited
-    = lang_hooks.deep_unsharing ? pointer_set_create () : NULL;
-  walk_tree (tp, copy_if_shared_r, visited, NULL);
-  if (visited)
-    pointer_set_destroy (visited);
+  walk_tree (tp, copy_if_shared_r, data, NULL);
 }
 
-/* Unshare all the trees in BODY_P, a pointer into the body of FNDECL, and the
-   bodies of any nested functions if we are unsharing the entire body of
-   FNDECL.  */
+/* Unshare all the trees in the body of FNDECL, as well as in the bodies of
+   any nested functions.  */
 
 static void
-unshare_body (tree *body_p, tree fndecl)
+unshare_body (tree fndecl)
 {
   struct cgraph_node *cgn = cgraph_get_node (fndecl);
+  /* If the language requires deep unsharing, we need a pointer set to make
+     sure we don't repeatedly unshare subtrees of unshareable nodes.  */
+  struct pointer_set_t *visited
+    = lang_hooks.deep_unsharing ? pointer_set_create () : NULL;
 
-  copy_if_shared (body_p);
+  copy_if_shared (&DECL_SAVED_TREE (fndecl), visited);
+  copy_if_shared (&DECL_SIZE (DECL_RESULT (fndecl)), visited);
+  copy_if_shared (&DECL_SIZE_UNIT (DECL_RESULT (fndecl)), visited);
+
+  if (visited)
+    pointer_set_destroy (visited);
 
-  if (cgn && body_p == &DECL_SAVED_TREE (fndecl))
+  if (cgn)
     for (cgn = cgn->nested; cgn; cgn = cgn->next_nested)
-      unshare_body (&DECL_SAVED_TREE (cgn->decl), cgn->decl);
+      unshare_body (cgn->decl);
 }
 
 /* Callback for walk_tree to unmark the visited trees rooted at *TP.
@@ -1008,15 +1010,17 @@ unmark_visited (tree *tp)
 /* Likewise, but mark all trees as not visited.  */
 
 static void
-unvisit_body (tree *body_p, tree fndecl)
+unvisit_body (tree fndecl)
 {
   struct cgraph_node *cgn = cgraph_get_node (fndecl);
 
-  unmark_visited (body_p);
+  unmark_visited (&DECL_SAVED_TREE (fndecl));
+  unmark_visited (&DECL_SIZE (DECL_RESULT (fndecl)));
+  unmark_visited (&DECL_SIZE_UNIT (DECL_RESULT (fndecl)));
 
-  if (cgn && body_p == &DECL_SAVED_TREE (fndecl))
+  if (cgn)
     for (cgn = cgn->nested; cgn; cgn = cgn->next_nested)
-      unvisit_body (&DECL_SAVED_TREE (cgn->decl), cgn->decl);
+      unvisit_body (cgn->decl);
 }
 
 /* Unconditionally make an unshared copy of EXPR.  This is used when using
@@ -7932,13 +7936,12 @@ gimplify_one_sizepos (tree *expr_p, gimp
     }
 }
 
-/* Gimplify the body of statements pointed to by BODY_P and return a
-   GIMPLE_BIND containing the sequence of GIMPLE statements
-   corresponding to BODY_P.  FNDECL is the function decl containing
-   *BODY_P.  */
+/* Gimplify the body of statements of FNDECL and return a GIMPLE_BIND node
+   containing the sequence of corresponding GIMPLE statements.  If DO_PARMS
+   is true, also gimplify the parameters.  */
 
 gimple
-gimplify_body (tree *body_p, tree fndecl, bool do_parms)
+gimplify_body (tree fndecl, bool do_parms)
 {
   location_t saved_location = input_location;
   gimple_seq parm_stmts, seq;
@@ -7959,8 +7962,8 @@ gimplify_body (tree *body_p, tree fndecl
      It would seem we don't have to do this for nested functions because
      they are supposed to be output and then the outer function gimplified
      first, but the g++ front end doesn't always do it that way.  */
-  unshare_body (body_p, fndecl);
-  unvisit_body (body_p, fndecl);
+  unshare_body (fndecl);
+  unvisit_body (fndecl);
 
   cgn = cgraph_get_node (fndecl);
   if (cgn && cgn->origin)
@@ -7971,11 +7974,11 @@ gimplify_body (tree *body_p, tree fndecl
 
   /* Resolve callee-copies.  This has to be done before processing
      the body so that DECL_VALUE_EXPR gets processed correctly.  */
-  parm_stmts = (do_parms) ? gimplify_parameters () : NULL;
+  parm_stmts = do_parms ? gimplify_parameters () : NULL;
 
   /* Gimplify the function's body.  */
   seq = NULL;
-  gimplify_stmt (body_p, &seq);
+  gimplify_stmt (&DECL_SAVED_TREE (fndecl), &seq);
   outer_bind = gimple_seq_first_stmt (seq);
   if (!outer_bind)
     {
@@ -7991,7 +7994,7 @@ gimplify_body (tree *body_p, tree fndecl
   else
     outer_bind = gimple_build_bind (NULL_TREE, seq, NULL);
 
-  *body_p = NULL_TREE;
+  DECL_SAVED_TREE (fndecl) = NULL_TREE;
 
   /* If we had callee-copies statements, insert them at the beginning
      of the function and clear DECL_VALUE_EXPR_P on the parameters.  */
@@ -8109,7 +8112,7 @@ gimplify_function_tree (tree fndecl)
       && !needs_to_live_in_memory (ret))
     DECL_GIMPLE_REG_P (ret) = 1;
 
-  bind = gimplify_body (&DECL_SAVED_TREE (fndecl), fndecl, true);
+  bind = gimplify_body (fndecl, true);
 
   /* The tree body of the function is no longer needed, replace it
      with the new GIMPLE body.  */
Index: omp-low.c
===================================================================
--- omp-low.c	(revision 182780)
+++ omp-low.c	(working copy)
@@ -1248,7 +1248,7 @@ finalize_task_copyfn (gimple task_stmt)
   old_fn = current_function_decl;
   push_cfun (child_cfun);
   current_function_decl = child_fn;
-  bind = gimplify_body (&DECL_SAVED_TREE (child_fn), child_fn, false);
+  bind = gimplify_body (child_fn, false);
   seq = gimple_seq_alloc ();
   gimple_seq_add_stmt (&seq, bind);
   new_seq = maybe_catch_exception (seq);
-- { dg-do compile }

package body Array19 is

   function N return Integer is
   begin
      return 1;
   end;

   type Array_Type is array (1 .. N) of Float;

   type Enum is (One, Two);

   type Rec (D : Enum := Enum'First) is record
      case D is
         when One => null;
         when Two => A : Array_Type;
      end case;
   end record;

   procedure Proc is

      R : Rec;

      function F return Array_Type is
      begin
         return (others => 0.0);
      end F;

   begin
      R.A := F;
   end;

end Array19;
package Array19 is

   procedure Proc;

end Array19;

Reply via email to