diff options
| -rw-r--r-- | gcc/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/gimplify.c | 15 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/self_aggregate_with_call.adb | 30 |
4 files changed, 54 insertions, 0 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 6bf8954..0f834e4 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,8 @@ +2007-02-19 Eric Botcazou <ebotcazou@adacore.com> + + * gimplify.c (gimplify_init_ctor_preeval_1): Detect potential overlap + due to calls to functions taking pointers as parameters. + 2007-02-19 Richard Henderson <rth@redhat.com> PR debug/29558 diff --git a/gcc/gimplify.c b/gcc/gimplify.c index 34e6249..02eed6a 100644 --- a/gcc/gimplify.c +++ b/gcc/gimplify.c @@ -2628,6 +2628,21 @@ gimplify_init_ctor_preeval_1 (tree *tp, int *walk_subtrees, void *xdata) && 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 (CALL_EXPR_FN (t))); + + 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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3633d7d..2101cee 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2007-02-19 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/self_aggregate_with_call.adb: New test. + 2007-02-18 Dorit Nuzman <dorit@il.ibm.com> PR tree-optimization/30975 diff --git a/gcc/testsuite/gnat.dg/self_aggregate_with_call.adb b/gcc/testsuite/gnat.dg/self_aggregate_with_call.adb new file mode 100644 index 0000000..4979bd4 --- /dev/null +++ b/gcc/testsuite/gnat.dg/self_aggregate_with_call.adb @@ -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; |