Skip to content

R
riscv-gcc-1
Commit 8424e0d8 by Paul Thomas
Options

re PR fortran/30003 ([4.1 only] Expressions with side effects in array references) 

2006-12-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30003
	* trans-array.c (gfc_trans_create_temp_array): Set the section
	ends to zero.
	(gfc_conv_array_transpose): Likewise.
	(gfc_conv_section_startstride): Declare an expression for end,
	set it from a the array reference and evaluate it for the info
	structure. Zero the ends in the ss structure and set end, used
	in the bounds check, from the info structure.
	trans.h: Add and end array to the gfc_ss_info structure.

2006-12-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30003
	* gfortran.dg/allocatable_function_1.f90: Increase the number
	of expected calls of free to 10; the lhs section reference is
	now evaluated so there is another call to bar.  Change the
	comment appropriately.
	* gfortran.dg/array_section_1.f90: New test.

From-SVN: r119556
parent 742163c0
Showing with 90 additions and 5 deletions
gcc/fortran/ChangeLog
2006-12-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/30003
* trans-array.c (gfc_trans_create_temp_array): Set the section
ends to zero.
(gfc_conv_array_transpose): Likewise.
(gfc_conv_section_startstride): Declare an expression for end,
set it from a the array reference and evaluate it for the info
structure. Zero the ends in the ss structure and set end, used
in the bounds check, from the info structure.
trans.h: Add and end array to the gfc_ss_info structure.
2006-12-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29912
* trans-expr.c (gfc_trans_arrayfunc_assign): Return NULL if the
lhs and rhs character lengths are not constant and equal for
......
gcc/fortran/trans-array.c
......@@ -618,6 +618,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
info->delta[dim] = gfc_index_zero_node;
info->start[dim] = gfc_index_zero_node;
info->end[dim] = gfc_index_zero_node;
info->stride[dim] = gfc_index_one_node;
info->dim[dim] = dim;
}
......@@ -783,6 +784,7 @@ gfc_conv_array_transpose (gfc_se * se, gfc_expr * expr)
{
dest_info->delta[n] = gfc_index_zero_node;
dest_info->start[n] = gfc_index_zero_node;
dest_info->end[n] = gfc_index_zero_node;
dest_info->stride[n] = gfc_index_one_node;
dest_info->dim[n] = n;
......@@ -2449,6 +2451,7 @@ static void
gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int n)
{
gfc_expr *start;
gfc_expr *end;
gfc_expr *stride;
tree desc;
gfc_se se;
......@@ -2464,6 +2467,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int n)
{
/* We use a zero-based index to access the vector. */
info->start[n] = gfc_index_zero_node;
info->end[n] = gfc_index_zero_node;
info->stride[n] = gfc_index_one_node;
return;
}
......@@ -2471,6 +2475,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int n)
gcc_assert (info->ref->u.ar.dimen_type[dim] == DIMEN_RANGE);
desc = info->descriptor;
start = info->ref->u.ar.start[dim];
end = info->ref->u.ar.end[dim];
stride = info->ref->u.ar.stride[dim];
/* Calculate the start of the range. For vector subscripts this will
......@@ -2490,6 +2495,24 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int n)
}
info->start[n] = gfc_evaluate_now (info->start[n], &loop->pre);
/* Similarly calculate the end. Although this is not used in the
scalarizer, it is needed when checking bounds and where the end
is an expression with side-effects. */
if (end)
{
/* Specified section start. */
gfc_init_se (&se, NULL);
gfc_conv_expr_type (&se, end, gfc_array_index_type);
gfc_add_block_to_block (&loop->pre, &se.pre);
info->end[n] = se.expr;
}
else
{
/* No upper bound specified so use the bound of the array. */
info->end[n] = gfc_conv_array_ubound (desc, dim);
}
info->end[n] = gfc_evaluate_now (info->end[n], &loop->pre);
/* Calculate the stride. */
if (stride == NULL)
info->stride[n] = gfc_index_one_node;
......@@ -2582,6 +2605,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
for (n = 0; n < ss->data.info.dimen; n++)
{
ss->data.info.start[n] = gfc_index_zero_node;
ss->data.info.end[n] = gfc_index_zero_node;
ss->data.info.stride[n] = gfc_index_one_node;
}
break;
......@@ -2635,7 +2659,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
than it is here, with all the trees. */
lbound = gfc_conv_array_lbound (desc, dim);
ubound = gfc_conv_array_ubound (desc, dim);
end = gfc_conv_section_upper_bound (ss, n, &block);
end = info->end[n];
/* Zero stride is not allowed. */
tmp = fold_build2 (EQ_EXPR, boolean_type_node, info->stride[n],
......
gcc/fortran/trans.h
......@@ -107,6 +107,7 @@ typedef struct gfc_ss_info
start is used in the calculation of these. Indexed by scalarizer
dimension. */
tree start[GFC_MAX_DIMENSIONS];
tree end[GFC_MAX_DIMENSIONS];
tree stride[GFC_MAX_DIMENSIONS];
tree delta[GFC_MAX_DIMENSIONS];
......
gcc/testsuite/ChangeLog
2006-12-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/30003
* gfortran.dg/allocatable_function_1.f90: Increase the number
of expected calls of free to 10; the lhs section reference is
now evaluated so there is another call to bar. Change the
comment appropriately.
* gfortran.dg/array_section_1.f90: New test.
2006-12-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29912
* gfortran.dg/char_result_12.f90: New test.
gcc/testsuite/gfortran.dg/allocatable_function_1.f90
......@@ -65,9 +65,9 @@ program alloc_fun
! 1 _gfortran_internal_free
if (.not.all(2*bar(size(a)) + 5 == [ 7, 9, 11 ])) call abort()
! The first reference never happens because the rhs determines the loop size.
! Thus there is no subsequent _gfortran_internal_free.
! 2 _gfortran_internal_free's
! Although the rhs determines the loop size, the lhs reference is
! evaluated, in case it has side-effects or is needed for bounds checking.
! 3 _gfortran_internal_free's
a(1:size (bar (3))) = 2*bar(size(a)) + 2 + a(size (bar (3)))
if (.not.all(a == [ 7, 9, 11 ])) call abort()
......@@ -107,6 +107,6 @@ contains
end function bar
end program alloc_fun
! { dg-final { scan-tree-dump-times "free" 9 "original" } }
! { dg-final { scan-tree-dump-times "free" 10 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
! { dg-final { cleanup-modules "m" } }
gcc/testsuite/gfortran.dg/array_section_1.f90 0 → 100644
! { dg-do run }
! { dg-options "-fbounds-check" }
! Tests the fix for PR30003, in which the 'end' of an array section
! would not be evaluated at all if it was on the lhs of an assignment
! or would be evaluated many times if bound checking were on.
!
! Contributed by Erik Edelmann <eedelmann@gcc.gnu.org>
!
implicit none
integer :: a(5), b(3), cnt
b = [ 1, 2, 3 ]
! Check the lhs references
cnt = 0
a(bar(1):3) = b
if (cnt /= 1) call abort ()
cnt = 0
a(1:bar(3)) = b
if (cnt /= 1) call abort ()
cnt = 0
a(1:3:bar(1)) = b
if (cnt /= 1) call abort ()
! Check the rhs references
cnt = 0
a(1:3) = b(bar(1):3)
if (cnt /= 1) call abort ()
cnt = 0
a(1:3) = b(1:bar(3))
if (cnt /= 1) call abort ()
cnt = 0
a(1:3) = b(1:3:bar(1))
if (cnt /= 1) call abort ()
contains
integer function bar(n)
integer, intent(in) :: n
cnt = cnt + 1
bar = n
end function bar
end
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