2007-12-02 Jakub Jelinek * gcc.c-torture/execute/20071202-1.c: New test. 2007-02-19 Eric Botcazou * gimplify.c (gimplify_init_ctor_preeval_1): Detect potential overlap due to calls to functions taking pointers as parameters. * gnat.dg/self_aggregate_with_call.adb: New test. 2006-08-21 Olivier Hainque * gimplify.c (gimplify_init_constructor) : Arrange for the temporary captures of components overlapping the lhs to happen before the lhs is possibly cleared. * gnat.dg/self_aggregate_with_zeros.adb: New test. * gnat.dg/self_aggregate_with_array.adb: New test. --- gcc/gimplify.c (revision 116299) +++ gcc/gimplify.c (revision 116300) @@ -2638,6 +2638,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; @@ -3061,6 +3061,20 @@ gimplify_init_constructor (tree *expr_p, } } + /* If there are nonzero elements, pre-evaluate to capture elements + overlapping with the lhs into temporaries. We must do this before + clearing to fetch the values before they are zeroed-out. */ + if (num_nonzero_elements > 0) + { + preeval_data.lhs_base_decl = get_base_address (object); + if (!DECL_P (preeval_data.lhs_base_decl)) + preeval_data.lhs_base_decl = NULL; + preeval_data.lhs_alias_set = get_alias_set (object); + + gimplify_init_ctor_preeval (&TREE_OPERAND (*expr_p, 1), + pre_p, post_p, &preeval_data); + } + if (cleared) { /* Zap the CONSTRUCTOR element list, which simplifies this case. @@ -3076,16 +3090,7 @@ gimplify_init_constructor (tree *expr_p, elements in the constructor, add assignments to the individual scalar fields of the object. */ if (!cleared || num_nonzero_elements > 0) - { - preeval_data.lhs_base_decl = get_base_address (object); - if (!DECL_P (preeval_data.lhs_base_decl)) - preeval_data.lhs_base_decl = NULL; - preeval_data.lhs_alias_set = get_alias_set (object); - - gimplify_init_ctor_preeval (&TREE_OPERAND (*expr_p, 1), - pre_p, post_p, &preeval_data); - gimplify_init_ctor_eval (object, elts, pre_p, cleared); - } + gimplify_init_ctor_eval (object, elts, pre_p, cleared); *expr_p = NULL_TREE; } --- gcc/testsuite/gcc.c-torture/execute/20071202-1.c.jj 2007-12-02 19:26:19.000000000 +0100 +++ gcc/testsuite/gcc.c-torture/execute/20071202-1.c 2007-12-02 19:24:28.000000000 +0100 @@ -0,0 +1,25 @@ +extern void abort (void); +struct T { int t; int r[8]; }; +struct S { int a; int b; int c[6]; struct T d; }; + +__attribute__((noinline)) void +foo (struct S *s) +{ + *s = (struct S) { s->b, s->a, { 0, 0, 0, 0, 0, 0 }, s->d }; +} + +int +main (void) +{ + struct S s = { 6, 12, { 1, 2, 3, 4, 5, 6 }, + { 7, { 8, 9, 10, 11, 12, 13, 14, 15 } } }; + foo (&s); + if (s.a != 12 || s.b != 6 + || s.c[0] || s.c[1] || s.c[2] || s.c[3] || s.c[4] || s.c[5]) + abort (); + if (s.d.t != 7 || s.d.r[0] != 8 || s.d.r[1] != 9 || s.d.r[2] != 10 + || s.d.r[3] != 11 || s.d.r[4] != 12 || s.d.r[5] != 13 + || s.d.r[6] != 14 || s.d.r[7] != 15) + abort (); + return 0; +} --- gcc/testsuite/gnat.dg/self_aggregate_with_zeros.adb (revision 0) +++ gcc/testsuite/gnat.dg/self_aggregate_with_zeros.adb (revision 116300) @@ -0,0 +1,19 @@ +-- { dg-do run } + +procedure self_aggregate_with_zeros is + + type Sensor is record + Value : Natural; + A, B, C, D, E, F, G, H, I, J, K, L, M : Natural; + end record; + + Pressure : Sensor; + +begin + Pressure.Value := 256; + Pressure := (Pressure.Value, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); + + if Pressure.Value /= 256 then + raise Program_Error; + end if; +end; --- gcc/testsuite/gnat.dg/self_aggregate_with_array.adb (revision 0) +++ gcc/testsuite/gnat.dg/self_aggregate_with_array.adb (revision 116300) @@ -0,0 +1,21 @@ +-- { dg-do run } + +procedure self_aggregate_with_array is + + type Value_Bounds is array (1 .. 2) of Natural; + + type Sensor is record + Value : Natural; + Bounds : Value_Bounds; + end record; + + Pressure : Sensor; + +begin + Pressure.Value := 256; + Pressure := (Value => Pressure.Value, Bounds => (1, 2)); + + if Pressure.Value /= 256 then + raise Program_Error; + end if; +end; --- gcc/testsuite/gnat.dg/self_aggregate_with_call.adb (revision 0) +++ gcc/testsuite/gnat.dg/self_aggregate_with_call.adb (revision 122134) @@ -0,0 +1,30 @@ +-- { 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;