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 <tkoe...@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 <tkoe...@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
