Commit 4195393b by Thomas Koenig Committed by Thomas Koenig

re PR fortran/57023 (Not packing arrays with changing variable used for size)

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
parent 173148bb
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>
......
......@@ -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]
......
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.
......
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment