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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 57b071007098d856a92ea4388d7912f20a19dcad..f313fd8e2dfe3f3ac13a57792bf0fd8b0e670a3e 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index d4443ecc68fe2459b6a0143c8bc3bcbf8c17898e..1444ee8ef65d929209a38fe2ad5f3c2ff9b85abb 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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 *);

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 998eac9b3dfdadfe18be29a638286f62ecb4ef73..1a385b5f7bb6239f67b3dfa7669fd8f0926ff016 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -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.  */

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 4b8dd68119fc945307a6efa8c42fb935714d1d5f..b95dd90a35414c93ad19ea99a1fb574a9a5bfee1 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index def943376257dbf964036515a33c8f13e6f1818e..5cb1143b13901da954eb443a74178212b13fef66 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.

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