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
This commit is contained in:
parent
173148bb12
commit
4195393b3c
4 changed files with 123 additions and 3 deletions
|
@ -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>
|
||||
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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.
|
||||
|
|
77
gcc/testsuite/gfortran.dg/internal_pack_15.f90
Normal file
77
gcc/testsuite/gfortran.dg/internal_pack_15.f90
Normal file
|
@ -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
|
Loading…
Add table
Reference in a new issue