backport: re PR fortran/45777 (Alias analysis broken for arrays where LHS or RHS...

2011-01-16  Thomas Koenig  <tkoenig@gcc.gnu.org>

	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  <tkoenig@gcc.gnu.org>

	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 614579dd14fc11aab1e663ccc8d158d6ca782132..553550bf58d85cd89386c2ec5346efcb1fdf8ca1 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,4 +1,19 @@
-2011-02-01  Thomas Koenig  <tkoenig@gcc.gnu.org>
+2011-01-16  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       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  <tkoenig@gcc.gnu.org>
 
        Backport from mainline
        PR fortran/45338

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 9b1a6fbcae206ea9d8f6c630363b838afa854d70..79bdfeb08b1831ecc716912635b6e6720aa1256f 100644 (file)
--- 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 5acd78acfbd295ad05b21cff6be384051d39545f..682ade2d9b03e25b5c73dbc3fbfda7e0d68a4cd3 100644 (file)
--- 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 d5b5c4745b72f2e5d599671558d27170b3ac512b..d5648a6b7bea9660706e86fd832f8b774bc06cb8 100644 (file)
--- 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 (file)
index 0000000..68c48a4
--- /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" } }