This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
Other format: | [Raw text] |
Hello world, this patch fixes one of the fortran-90 wrong-code bugs still left. I have taken the liberty of moving one function to where it is actually needed. OK for trunk? Thomas 2011-01-04 Thomas Koenig <tkoenig@gcc.gnu.org> 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. 2011-01-04 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/45777 * gfortran.dg/dependency_39.f90: New test.
Index: trans-array.c =================================================================== --- trans-array.c (Revision 168201) +++ trans-array.c (Arbeitskopie) @@ -3449,7 +3449,38 @@ 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_target && rsym_target + && ((lsym->attr.dummy && !lsym->attr.contiguous + && (!lsym->attr.dimension || lsym->as->type == AS_ASSUMED_SHAPE)) + || (rsym->attr.dummy && !rsym->attr.contiguous + && (!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. */ /* TODO: resolve aliases based on frontend expressions. */ @@ -3461,10 +3492,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 && rsym->ts.type != BT_CLASS @@ -3479,27 +3518,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; Index: symbol.c =================================================================== --- symbol.c (Revision 168201) +++ symbol.c (Arbeitskopie) @@ -2842,41 +2842,6 @@ gfc_get_ha_symbol (const char *name, gfc_symbol ** 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.contiguous - && (!lsym->attr.dimension || lsym->as->type == AS_ASSUMED_SHAPE)) - || (rsym->attr.dummy && !rsym->attr.contiguous - && (!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. */ Index: gfortran.h =================================================================== --- gfortran.h (Revision 168201) +++ gfortran.h (Arbeitskopie) @@ -2563,8 +2563,6 @@ int gfc_get_sym_tree (const char *, gfc_namespace 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 *);
Attachment:
dependency_39.f90
Description: Text document
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |