mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-21 15:31:09 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/45777 (Alias analysis broken for arrays where LHS or RHS is a component ref)

Browse Source 
2011-01-08  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-08  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/45777
	* gfortran.dg/dependency_39.f90:  New test.

From-SVN: r168596
This commit is contained in:
Thomas Koenig 2011-01-08 09:38:13 +00:00
parent 72e961c86a
commit ecb3baaa8e
6 changed files with 146 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/fortran/ChangeLog
View File

@ -1,3 +1,16 @@
2011-01-08 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-07 Tobias Burnus <burnus@net-b.de>
PR fortran/41580

2
gcc/fortran/gfortran.h
View File

@ -2561,8 +2561,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 *);

35
gcc/fortran/symbol.c
View File

@ -2813,41 +2813,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.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. */

95
gcc/fortran/trans-array.c
View File

@ -3449,6 +3449,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_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. */
@ -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;

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2011-01-08 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/45777
* gfortran.dg/dependency_39.f90: New test.
2011-01-07 Jan Hubicka <jh@suse.cz>
Get builtins tests ready for linker plugin.

37
gcc/testsuite/gfortran.dg/dependency_39.f90 Normal file
View File

@ -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" } }