From: Thomas Koenig Date: Sun, 16 Jan 2011 11:46:55 +0000 (+0000) Subject: backport: re PR fortran/45777 (Alias analysis broken for arrays where LHS or RHS... X-Git-Tag: releases/gcc-4.5.3~310 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=bf4d986c32e095a4ec68c1d22a32bc40b3338b82;p=thirdparty%2Fgcc.git backport: re PR fortran/45777 (Alias analysis broken for arrays where LHS or RHS is a component ref) 2011-01-16 Thomas Koenig Backport from trunk PR fortran/45777 * symbol.c (gfc_symbols_could_alias): Strip gfc_ prefix, make static and move in front of its only caller, to ... * trans-array.c (symbols_could_alias): ... here. Pass information about pointer and target status as arguments. Allocatable arrays don't alias anything unless they have the POINTER attribute. (gfc_could_be_alias): Keep track of pointer and target status when following references. Also check if typespecs of components match those of other components or symbols. * gfortran.h: Remove prototype for gfc_symbols_could_alias. 2011-01-16 Thomas Koenig Backport from trunk PR fortran/45777 * gfortran.dg/dependency_39.f90: New test. From-SVN: r168851 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 614579dd14fc..553550bf58d8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,4 +1,19 @@ -2011-02-01 Thomas Koenig +2011-01-16 Thomas Koenig + + Backport from trunk + PR fortran/45777 + * symbol.c (gfc_symbols_could_alias): Strip gfc_ prefix, + make static and move in front of its only caller, to ... + * trans-array.c (symbols_could_alias): ... here. + Pass information about pointer and target status as + arguments. Allocatable arrays don't alias anything + unless they have the POINTER attribute. + (gfc_could_be_alias): Keep track of pointer and target + status when following references. Also check if typespecs + of components match those of other components or symbols. + * gfortran.h: Remove prototype for gfc_symbols_could_alias. + +2011-01-02 Thomas Koenig Backport from mainline PR fortran/45338 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 9b1a6fbcae20..79bdfeb08b18 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2483,8 +2483,6 @@ int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool); int gfc_get_ha_symbol (const char *, gfc_symbol **); int gfc_get_ha_sym_tree (const char *, gfc_symtree **); -int gfc_symbols_could_alias (gfc_symbol *, gfc_symbol *); - void gfc_undo_symbols (void); void gfc_commit_symbols (void); void gfc_commit_symbol (gfc_symbol *); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 5acd78acfbd2..682ade2d9b03 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -2733,41 +2733,6 @@ gfc_get_ha_symbol (const char *name, gfc_symbol **result) return i; } -/* Return true if both symbols could refer to the same data object. Does - not take account of aliasing due to equivalence statements. */ - -int -gfc_symbols_could_alias (gfc_symbol *lsym, gfc_symbol *rsym) -{ - /* Aliasing isn't possible if the symbols have different base types. */ - if (gfc_compare_types (&lsym->ts, &rsym->ts) == 0) - return 0; - - /* Pointers can point to other pointers, target objects and allocatable - objects. Two allocatable objects cannot share the same storage. */ - if (lsym->attr.pointer - && (rsym->attr.pointer || rsym->attr.allocatable || rsym->attr.target)) - return 1; - if (lsym->attr.target && rsym->attr.pointer) - return 1; - if (lsym->attr.allocatable && rsym->attr.pointer) - return 1; - - /* Special case: Argument association, cf. F90 12.4.1.6, F2003 12.4.1.7 - and F2008 12.5.2.13 items 3b and 4b. The pointer case (a) is already - checked above. */ - if (lsym->attr.target && rsym->attr.target - && ((lsym->attr.dummy - && (!lsym->attr.dimension || lsym->as->type == AS_ASSUMED_SHAPE)) - || (rsym->attr.dummy - && (!rsym->attr.dimension - || rsym->as->type == AS_ASSUMED_SHAPE)))) - return 1; - - return 0; -} - - /* Undoes all the changes made to symbols in the current statement. This subroutine is made simpler due to the fact that attributes are never removed once added. */ diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index d5b5c4745b72..d5648a6b7bea 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3389,6 +3389,37 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) } } +/* Return true if both symbols could refer to the same data object. Does + not take account of aliasing due to equivalence statements. */ + +static int +symbols_could_alias (gfc_symbol *lsym, gfc_symbol *rsym, bool lsym_pointer, + bool lsym_target, bool rsym_pointer, bool rsym_target) +{ + /* Aliasing isn't possible if the symbols have different base types. */ + if (gfc_compare_types (&lsym->ts, &rsym->ts) == 0) + return 0; + + /* Pointers can point to other pointers and target objects. */ + + if ((lsym_pointer && (rsym_pointer || rsym_target)) + || (rsym_pointer && (lsym_pointer || lsym_target))) + return 1; + + /* Special case: Argument association, cf. F90 12.4.1.6, F2003 12.4.1.7 + and F2008 12.5.2.13 items 3b and 4b. The pointer case (a) is already + checked above. */ + if (lsym->attr.target && rsym->attr.target + && ((lsym->attr.dummy + && (!lsym->attr.dimension || lsym->as->type == AS_ASSUMED_SHAPE)) + || (rsym->attr.dummy + && (!rsym->attr.dimension + || rsym->as->type == AS_ASSUMED_SHAPE)))) + return 1; + + return 0; +} + /* Return true if the two SS could be aliased, i.e. both point to the same data object. */ @@ -3401,10 +3432,18 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) gfc_ref *rref; gfc_symbol *lsym; gfc_symbol *rsym; + bool lsym_pointer, lsym_target, rsym_pointer, rsym_target; lsym = lss->expr->symtree->n.sym; rsym = rss->expr->symtree->n.sym; - if (gfc_symbols_could_alias (lsym, rsym)) + + lsym_pointer = lsym->attr.pointer; + lsym_target = lsym->attr.target; + rsym_pointer = rsym->attr.pointer; + rsym_target = rsym->attr.target; + + if (symbols_could_alias (lsym, rsym, lsym_pointer, lsym_target, + rsym_pointer, rsym_target)) return 1; if (rsym->ts.type != BT_DERIVED @@ -3419,27 +3458,75 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) if (lref->type != REF_COMPONENT) continue; - if (gfc_symbols_could_alias (lref->u.c.sym, rsym)) + lsym_pointer = lsym_pointer || lref->u.c.sym->attr.pointer; + lsym_target = lsym_target || lref->u.c.sym->attr.target; + + if (symbols_could_alias (lref->u.c.sym, rsym, lsym_pointer, lsym_target, + rsym_pointer, rsym_target)) return 1; + if ((lsym_pointer && (rsym_pointer || rsym_target)) + || (rsym_pointer && (lsym_pointer || lsym_target))) + { + if (gfc_compare_types (&lref->u.c.component->ts, + &rsym->ts)) + return 1; + } + for (rref = rss->expr->ref; rref != rss->data.info.ref; rref = rref->next) { if (rref->type != REF_COMPONENT) continue; - if (gfc_symbols_could_alias (lref->u.c.sym, rref->u.c.sym)) + rsym_pointer = rsym_pointer || rref->u.c.sym->attr.pointer; + rsym_target = lsym_target || rref->u.c.sym->attr.target; + + if (symbols_could_alias (lref->u.c.sym, rref->u.c.sym, + lsym_pointer, lsym_target, + rsym_pointer, rsym_target)) return 1; + + if ((lsym_pointer && (rsym_pointer || rsym_target)) + || (rsym_pointer && (lsym_pointer || lsym_target))) + { + if (gfc_compare_types (&lref->u.c.component->ts, + &rref->u.c.sym->ts)) + return 1; + if (gfc_compare_types (&lref->u.c.sym->ts, + &rref->u.c.component->ts)) + return 1; + if (gfc_compare_types (&lref->u.c.component->ts, + &rref->u.c.component->ts)) + return 1; + } } } + lsym_pointer = lsym->attr.pointer; + lsym_target = lsym->attr.target; + lsym_pointer = lsym->attr.pointer; + lsym_target = lsym->attr.target; + for (rref = rss->expr->ref; rref != rss->data.info.ref; rref = rref->next) { if (rref->type != REF_COMPONENT) break; - if (gfc_symbols_could_alias (rref->u.c.sym, lsym)) + rsym_pointer = rsym_pointer || rref->u.c.sym->attr.pointer; + rsym_target = lsym_target || rref->u.c.sym->attr.target; + + if (symbols_could_alias (rref->u.c.sym, lsym, + lsym_pointer, lsym_target, + rsym_pointer, rsym_target)) return 1; + + if ((lsym_pointer && (rsym_pointer || rsym_target)) + || (rsym_pointer && (lsym_pointer || lsym_target))) + { + if (gfc_compare_types (&lsym->ts, &rref->u.c.component->ts)) + return 1; + } } return 0; diff --git a/gcc/testsuite/gfortran.dg/dependency_39.f90 b/gcc/testsuite/gfortran.dg/dependency_39.f90 new file mode 100644 index 000000000000..68c48a4dc817 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dependency_39.f90 @@ -0,0 +1,37 @@ +! { dg-do run } +! PR 45777 - component ref aliases when both are pointers +module m1 + type t1 + integer, dimension(:), allocatable :: data + end type t1 +contains + subroutine s1(t,d) + integer, dimension(:), pointer :: d + type(t1), pointer :: t + d(1:5)=t%data(3:7) + end subroutine s1 + subroutine s2(d,t) + integer, dimension(:), pointer :: d + type(t1), pointer :: t + t%data(3:7) = d(1:5) + end subroutine s2 +end module m1 + +program main + use m1 + type(t1), pointer :: t + integer, dimension(:), pointer :: d + allocate(t) + allocate(t%data(10)) + t%data=(/(i,i=1,10)/) + d=>t%data(5:9) + call s1(t,d) + if (any(d.ne.(/3,4,5,6,7/))) call abort() + t%data=(/(i,i=1,10)/) + d=>t%data(1:5) + call s2(d,t) + if (any(t%data.ne.(/1,2,1,2,3,4,5,8,9,10/))) call abort + deallocate(t%data) + deallocate(t) +end program main +! { dg-final { cleanup-modules "m1" } }