[PATCH] Fix gimplification bug with constructors

[Eric Botcazou <ebotcazou at adacore dot com>]

Hi,

This is a regression present in the 4.x series of Ada compilers.

For

      V := (Components => Clone (V.Components));

we have in .original

  *v = {.components=p__clone ((natural___XDLU_0__2147483647[1:8] &) 
&v->components)};

and in .gimple

  D.1025 = &v->components;
  *v = {};
  v->components = p__clone (D.1025) [return slot optimization];

Now "Clone" dereferences its argument:

P.Clone (components)
{
  <retval> = *components;
  return <retval>;
}

so the block-clearing effectively clobbers the argument of "Clone".


It turns out that gimplify_init_ctor_preeval_1 already has a provision for 
"visible" dereferences within constructors:

  /* If the constructor component is indirect, determine if we have a
     potential overlap with the lhs.  The only bits of information we
     have to go on at this point are addressability and alias sets.  */
  if (TREE_CODE (t) == INDIRECT_REF
      && (!data->lhs_base_decl || TREE_ADDRESSABLE (data->lhs_base_decl))
      && alias_sets_conflict_p (data->lhs_alias_set, get_alias_set (t)))
    return t;

Here we have a "hidden" dereference, but we can still check the type of the 
parameters of the function.

Bootstrapped/regtested on i586-suse-linux, OK for mainline/4.2/4.1 branches?


2006-11-23  Eric Botcazou  <ebotcazou@adacore.com>

        * gimplify.c (gimplify_init_ctor_preeval_1): Detect potential overlap
        due to calls to functions taking pointers as parameters.


2006-11-23  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/self_aggregate_with_call.adb: New test.


:ADDPATCH gimplifier:

-- 
Eric Botcazou

Index: gimplify.c
===================================================================
--- gimplify.c	(revision 119010)
+++ gimplify.c	(working copy)
@@ -2637,6 +2637,21 @@ gimplify_init_ctor_preeval_1 (tree *tp, 
       && alias_sets_conflict_p (data->lhs_alias_set, get_alias_set (t)))
     return t;
 
+  /* If the constructor component is a call, determine if it can hide a
+     potential overlap with the lhs through an INDIRECT_REF like above.  */
+  if (TREE_CODE (t) == CALL_EXPR)
+    {
+      tree type, fntype = TREE_TYPE (TREE_TYPE (TREE_OPERAND (t, 0)));
+
+      for (type = TYPE_ARG_TYPES (fntype); type; type = TREE_CHAIN (type))
+	if (POINTER_TYPE_P (TREE_VALUE (type))
+	    && (!data->lhs_base_decl || TREE_ADDRESSABLE (data->lhs_base_decl))
+	    && alias_sets_conflict_p (data->lhs_alias_set,
+				      get_alias_set
+				        (TREE_TYPE (TREE_VALUE (type)))))
+	  return t;
+    }
+
   if (IS_TYPE_OR_DECL_P (t))
     *walk_subtrees = 0;
   return NULL;

-- { dg-do run }
-- { dg-options "-O2" }

procedure self_aggregate_with_call is

   type Values is array (1 .. 8) of Natural;

   type Vector is record
      Components : Values;
   end record;

   function Clone (Components: Values) return Values is
   begin
      return Components;
   end;

   procedure Process (V : in out Vector) is
   begin
      V.Components (Values'First) := 1;
      V := (Components => Clone (V.Components));

      if V.Components (Values'First) /= 1 then
         raise Program_Error;
      end if;
   end;

   V : Vector;
begin
   Process (V);
end;