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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@119556
138bc75d-0d04-0410-961f-
82ee72b054a4
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
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;
}
{
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;
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;
{
/* 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;
}
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
}
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;
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;
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],
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];
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.
! 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()
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" } }
--- /dev/null
+! { 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
OSDN Git Service
