diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a65b4a73196..34ea1e5e17a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2006-12-05 Paul Thomas + + 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 PR fortran/29912 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0049ad5b54b..bfd0600b582 100644 --- a/gcc/fortran/trans-array.c +++ b/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], diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index ed968386083..d16a5df83d2 100644 --- a/gcc/fortran/trans.h +++ b/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]; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 363e298502a..dc199b6aac0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2006-12-05 Paul Thomas + + 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 PR fortran/29912 diff --git a/gcc/testsuite/gfortran.dg/allocatable_function_1.f90 b/gcc/testsuite/gfortran.dg/allocatable_function_1.f90 index b20ff3d19c0..fc3b983ad1d 100644 --- a/gcc/testsuite/gfortran.dg/allocatable_function_1.f90 +++ b/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" } } diff --git a/gcc/testsuite/gfortran.dg/array_section_1.f90 b/gcc/testsuite/gfortran.dg/array_section_1.f90 new file mode 100644 index 00000000000..4d5eedf2ae1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_section_1.f90 @@ -0,0 +1,39 @@ +! { 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 +! + 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