diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 59 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 3 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 2 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/array_function_1.f90 | 27 |
8 files changed, 66 insertions, 52 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 59636db..e501db6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2007-02-09 Francois-Xavier Coudert <coudert@clipper.ens.fr> + + PR fortran/30720 + * trans-array.c (gfc_trans_create_temp_array): Remove use of the + function argument. Always generate code for negative extent. + Simplify said code. + * trans-array.h (gfc_trans_create_temp_array): Change prototype. + * trans-expr.c (gfc_conv_function_call): Remove use of last argument + of gfc_trans_create_temp_array. + * trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): Likewise. + * trans-stmt.c (gfc_conv_elemental_dependencies): Likewise. + 2007-02-08 Roger Sayle <roger@eyesopen.com> * trans-stmt.c (gfc_trans_forall_1): Optimize the cases where the diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index a39f6647..1c89975 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -583,7 +583,7 @@ tree gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_loopinfo * loop, gfc_ss_info * info, tree eltype, bool dynamic, bool dealloc, - bool callee_alloc, bool function) + bool callee_alloc) { tree type; tree desc; @@ -592,11 +592,6 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, tree nelem; tree cond; tree or_expr; - tree thencase; - tree elsecase; - tree var; - stmtblock_t thenblock; - stmtblock_t elseblock; int n; int dim; @@ -678,19 +673,16 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, loop->to[n], gfc_index_one_node); - if (function) - { - /* Check whether the size for this dimension is negative. */ - cond = fold_build2 (LE_EXPR, boolean_type_node, tmp, + /* Check whether the size for this dimension is negative. */ + cond = fold_build2 (LE_EXPR, boolean_type_node, tmp, gfc_index_zero_node); + cond = gfc_evaluate_now (cond, pre); - cond = gfc_evaluate_now (cond, pre); + if (n == 0) + or_expr = cond; + else + or_expr = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, or_expr, cond); - if (n == 0) - or_expr = cond; - else - or_expr = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, or_expr, cond); - } size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp); size = gfc_evaluate_now (size, pre); } @@ -699,33 +691,10 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, if (size && !callee_alloc) { - if (function) - { - /* If we know at compile-time whether any dimension size is - negative, we can avoid a conditional and pass the true size - to gfc_trans_allocate_array_storage, which can then decide - whether to allocate this on the heap or on the stack. */ - if (integer_zerop (or_expr)) - ; - else if (integer_onep (or_expr)) - size = gfc_index_zero_node; - else - { - var = gfc_create_var (TREE_TYPE (size), "size"); - gfc_start_block (&thenblock); - gfc_add_modify_expr (&thenblock, var, gfc_index_zero_node); - thencase = gfc_finish_block (&thenblock); - - gfc_start_block (&elseblock); - gfc_add_modify_expr (&elseblock, var, size); - elsecase = gfc_finish_block (&elseblock); - - tmp = gfc_evaluate_now (or_expr, pre); - tmp = build3_v (COND_EXPR, tmp, thencase, elsecase); - gfc_add_expr_to_block (pre, tmp); - size = var; - } - } + /* If or_expr is true, then the extent in at least one + dimension is zero and the size is set to zero. */ + size = fold_build3 (COND_EXPR, gfc_array_index_type, + or_expr, gfc_index_zero_node, size); nelem = size; size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, @@ -1647,7 +1616,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss) } gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info, - type, dynamic, true, false, false); + type, dynamic, true, false); desc = ss->data.info.descriptor; offset = gfc_index_zero_node; @@ -3241,7 +3210,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop) loop->temp_ss->data.info.dimen = n; gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &loop->temp_ss->data.info, tmp, false, true, - false, false); + false); } for (n = 0; n < loop->temp_dim; n++) diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 278ea1e..d3f4e5f 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -32,7 +32,7 @@ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *, /* Generate code to create a temporary array. */ tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *, - gfc_ss_info *, tree, bool, bool, bool, bool); + gfc_ss_info *, tree, bool, bool, bool); /* Generate function entry code for allocation of compiler allocated array variables. */ diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 723ffab..1a97e31 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2332,8 +2332,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, mustn't be deallocated. */ callee_alloc = sym->attr.allocatable || sym->attr.pointer; gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp, - false, !sym->attr.pointer, callee_alloc, - true); + false, !sym->attr.pointer, callee_alloc); /* Pass the temporary as the first argument. */ tmp = info->descriptor; diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index aa8008b..5ad0f38 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2975,10 +2975,12 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr) se->loop->to[n] = upper; /* Build a destination descriptor, using the pointer, source, as the - data field. This is already allocated so set callee_alloc. */ + data field. This is already allocated so set callee_alloc. + FIXME callee_alloc is not set! */ + tmp = gfc_typenode_for_spec (&expr->ts); gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, - info, tmp, false, true, false, false); + info, tmp, false, true, false); /* Use memcpy to do the transfer. */ tmp = gfc_conv_descriptor_data_get (info->descriptor); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index db92c02..6b8a9a0 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -268,7 +268,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, tmp = gfc_typenode_for_spec (&e->ts); tmp = gfc_trans_create_temp_array (&se->pre, &se->post, &tmp_loop, info, tmp, - false, true, false, false); + false, true, false); gfc_add_modify_expr (&se->pre, size, tmp); tmp = fold_convert (pvoid_type_node, info->data); gfc_add_modify_expr (&se->pre, data, tmp); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4d65bf4..1570d3e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-02-09 Francois-Xavier Coudert <coudert@clipper.ens.fr> + + PR fortran/30720 + * gfortran.dg/array_function_1.f90: New test. + 2007-02-09 Richard Sandiford <richard@codesourcery.com> * lib/target-supports.exp (check_effective_target_lax_strtofp) @@ -161,7 +166,7 @@ 2007-02-04 Francois-Xavier Coudert <coudert@clipper.ens.fr> PR fortran/30611 - * gcc/testsuite/gfortran.dg/repeat_1.f90: New test. + * gfortran.dg/repeat_1.f90: New test. 2007-02-04 Steven G. Kargl <kargl@gcc.gnu.org> diff --git a/gcc/testsuite/gfortran.dg/array_function_1.f90 b/gcc/testsuite/gfortran.dg/array_function_1.f90 new file mode 100644 index 0000000..281ae88b8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_function_1.f90 @@ -0,0 +1,27 @@ +! { dg-do run } +! PR fortran/30720 +program array_function_1 + integer :: a(5), b, l, u + l = 4 + u = 2 + + a = (/ 1, 2, 3, 4, 5 /) + + b = f(a(l:u) - 2) + if (b /= 0) call abort + + b = f(a(4:2) - 2) + if (b /= 0) call abort + + b = f(a(u:l) - 2) + if (b /= 3) call abort + + b = f(a(2:4) - 2) + if (b /= 3) call abort + + contains + integer function f(x) + integer, dimension(:), intent(in) :: x + f = sum(x) + end function +end program |