[patch, fortran] Fix PR 57023, packing for some array temporaries

[Thomas Koenig <tkoenig at netcologne dot de>]

Hello world,

this patch fixes a longstanding regression where an upper array
bound and the upper bound of an array section compared equal
(using gfc_dep_compare_expr), but they weren't because
the value of the upper bound had been changed in the
meantime.  This led to gfc_full_array_ref_p to erroneously
returning true, which led to the array not being packed
and thus wrong code.

This patch takes the approach that any array bound which
contains a dummy variable which is not INTENT(IN) may be
changed by the user, and that we cannot be assured that
it will not be changed.  Anybody who is sensible should
be using INTENT(IN) for array bounds, anyway :-)

So, here is the patch.  Regression-tested.

OK for all affected branches?

	Thomas

2015-01-20  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-20  Thomas Koenig  <tkoenig@netcologne.de>

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

Index: dependency.c
===================================================================
--- dependency.c	(Revision 219193)
+++ dependency.c	(Arbeitskopie)
@@ -1853,11 +1853,40 @@ gfc_check_element_vs_element (gfc_ref *lref, gfc_r
   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,7 +1950,8 @@ gfc_full_array_ref_p (gfc_ref *ref, bool *contiguo
 	  && (!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]
@@ -1928,7 +1958,8 @@ gfc_full_array_ref_p (gfc_ref *ref, bool *contiguo
 	  && (!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]

! { 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