re PR fortran/57023 (Not packing arrays with changing variable used for size)
authorThomas Koenig <tkoenig@netcologne.de>
Wed, 21 Jan 2015 19:40:54 +0000 (19:40 +0000)
committerThomas Koenig <tkoenig@gcc.gnu.org>
Wed, 21 Jan 2015 19:40:54 +0000 (19:40 +0000)
2015-01-21  Thomas Koenig  <tkoenig@netcologne.de>

PR fortran/57023
* dependency.c (callback_dummy_intent_not_int):  New function.
(dummy_intent_not_in):  New function.
(gfc_full_array_ref_p):  Use dummy_intent_not_in.

2015-01-21  Thomas Koenig  <tkoenig@netcologne.de>

PR fortran/57023
* gfortran.dg/internal_pack_15.f90:  New test.

From-SVN: r219963

gcc/fortran/ChangeLog
gcc/fortran/dependency.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/internal_pack_15.f90 [new file with mode: 0644]

index 638f962270ec08847c66a4de96d1c2ba026127a0..db43df4cd7800cced5ec842e33b219f35cc154ec 100644 (file)
@@ -1,3 +1,10 @@
+2015-01-21  Thomas Koenig  <tkoenig@netcologne.de>
+
+       PR fortran/57023
+       * dependency.c (callback_dummy_intent_not_int):  New function.
+       (dummy_intent_not_in):  New function.
+       (gfc_full_array_ref_p):  Use dummy_intent_not_in.
+
 2015-01-18  Andre Vehreschild  <vehre@gmx.de>
            Janus Weil <janus@gcc.gnu.org>
 
index c5825b8f8192038b358e33dbf4bb21e9b12fd6b2..63c66303497ad99b1f5cc7ee9fc0b7a2a2b3833d 100644 (file)
@@ -1853,11 +1853,40 @@ gfc_check_element_vs_element (gfc_ref *lref, gfc_ref *rref, int n)
   return GFC_DEP_EQUAL;
 }
 
+/* Callback function for checking if an expression depends on a
+   dummy variable which is any other than INTENT(IN).  */
+
+static int
+callback_dummy_intent_not_in (gfc_expr **ep,
+                             int *walk_subtrees ATTRIBUTE_UNUSED,
+                             void *data ATTRIBUTE_UNUSED)
+{
+  gfc_expr *e = *ep;
+
+  if (e->expr_type == EXPR_VARIABLE && e->symtree
+      && e->symtree->n.sym->attr.dummy)
+    return e->symtree->n.sym->attr.intent != INTENT_IN;
+  else
+    return 0;
+}
+
+/* Auxiliary function to check if subexpressions have dummy variables which
+   are not intent(in).
+*/
+
+static bool
+dummy_intent_not_in (gfc_expr **ep)
+{
+  return gfc_expr_walker (ep, callback_dummy_intent_not_in, NULL);
+}
 
 /* Determine if an array ref, usually an array section specifies the
    entire array.  In addition, if the second, pointer argument is
    provided, the function will return true if the reference is
-   contiguous; eg. (:, 1) gives true but (1,:) gives false.  */
+   contiguous; eg. (:, 1) gives true but (1,:) gives false. 
+   If one of the bounds depends on a dummy variable which is
+   not INTENT(IN), also return false, because the user may
+   have changed the variable.  */
 
 bool
 gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous)
@@ -1921,14 +1950,16 @@ gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous)
          && (!ref->u.ar.as
              || !ref->u.ar.as->lower[i]
              || gfc_dep_compare_expr (ref->u.ar.start[i],
-                                      ref->u.ar.as->lower[i])))
+                                      ref->u.ar.as->lower[i])
+             || dummy_intent_not_in (&ref->u.ar.start[i])))
        lbound_OK = false;
       /* Check the upper bound.  */
       if (ref->u.ar.end[i]
          && (!ref->u.ar.as
              || !ref->u.ar.as->upper[i]
              || gfc_dep_compare_expr (ref->u.ar.end[i],
-                                      ref->u.ar.as->upper[i])))
+                                      ref->u.ar.as->upper[i])
+             || dummy_intent_not_in (&ref->u.ar.end[i])))
        ubound_OK = false;
       /* Check the stride.  */
       if (ref->u.ar.stride[i]
index e1a4ce87cfcca1d8cbf6c24e3d4b32a659f0129c..314e9e1acc1483c0d499fbdc488143563ad7c697 100644 (file)
@@ -1,3 +1,8 @@
+2015-01-21  Thomas Koenig  <tkoenig@netcologne.de>
+
+       PR fortran/57023
+       * gfortran.dg/internal_pack_15.f90:  New test.
+
 2015-01-21  Bernd Edlinger  <bernd.edlinger@hotmail.de>
 
        * gcc/testsuite/c-c++-common/tsan/step.c: New testcase.
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_15.f90 b/gcc/testsuite/gfortran.dg/internal_pack_15.f90
new file mode 100644 (file)
index 0000000..13e3304
--- /dev/null
@@ -0,0 +1,77 @@
+! { dg-do run }
+! { dg-options "-Warray-temporaries" }
+! PR 57023
+! This used to cause wrong packing because a(1:n,1:n) was
+! assumed to be a full array.
+module mymod
+  implicit none
+contains
+  subroutine foo1(a,n)
+    integer, dimension(n,n), intent(inout) :: a
+    integer :: n
+    n = n - 1
+    call baz(a(1:n,1:n),n)  ! { dg-warning "array temporary" }
+  end subroutine foo1
+
+  subroutine foo2(a,n)
+    integer, dimension(n,n), intent(inout) :: a
+    integer :: n
+    call decrement(n)
+    call baz(a(1:n,1:n),n)  ! { dg-warning "array temporary" }
+  end subroutine foo2
+
+  subroutine foo3(a,n)
+    integer, dimension(n,n), intent(inout) :: a
+    integer :: n, m
+    m = n - 1
+    call baz(a(1:m,1:m),m)  ! { dg-warning "array temporary" }
+  end subroutine foo3
+
+  subroutine foo4(a,n)
+    integer, dimension(n,n), intent(inout) :: a
+    integer, intent(in) :: n
+    a(1:n,1:n) = 1
+  end subroutine foo4
+
+  subroutine baz(a,n)
+    integer, dimension(n,n), intent(inout) :: a
+    integer, intent(in) :: n
+    a = 1
+  end subroutine baz
+
+  subroutine decrement(n)
+    integer, intent(inout) :: n
+    n = n - 1
+  end subroutine decrement
+
+end module mymod
+
+program main
+  use mymod
+  implicit none
+  integer, dimension(5,5) :: a, b
+  integer :: n
+
+  b = 0
+  b(1:4,1:4) = 1
+
+  n = 5
+  a = 0
+  call foo1(a,n)
+  if (any(a /= b)) call abort
+
+  n = 5
+  a = 0
+  call foo2(a,n)
+  if (any(a /= b)) call abort
+
+  n = 5
+  a = 0
+  call foo3(a,n)
+  if (any(a /= b)) call abort
+
+  n = 5
+  a = 0
+  call foo4(a,n)
+  if (any(a /= 1)) call abort
+end program main