[patch, fortran] Fix PR 27980
Paul Thomas
paulthomas2@wanadoo.fr
Wed Jun 14 17:15:00 GMT 2006
Thomas,
This is OK - it regtests OK on FC5/Athlon1700.
There are one or two tiny remarks below.
>:
>
>OK?
>
> Thomas
>
>2006-06-13 Thomas Koenig <Thomas.Koenig@online.de>
>
> * trans-array.h (gfc_trans_create_temp_array): Add bool argument.
> * trans-arrray.c (gfc_trans_create_temp_array): Add extra argument
> "function" to show if we are translating a function.
> If we are translating a function, perform checks wether
> the size along any argument is negative. In that case,
> allocate size 0.
>
>
wether => whether
Is there some reason for the odd line lengths?
> (gfc_trans_allocate_storage): Add function argument (as false) to
> gfc_trans_create_temp_array call.
> * trans-expr.c (gfc_conv_function_call): Add function argument
> (as true) to gfc_trans_create_temp_array call.
> * trans-stmt.c (gfc_conv_elemental_dependencies): Add function
> argument (as false) to gfc_trans_create_temp_array call.
> * trans-intrinsic.c: Likewise.
>
>2006-06-13 Thomas Koenig <Thomas.Koenig@online.de>
>
> * gfortran.dg/allocate_zerosize_2.f90: New test case.
>
>
>------------------------------------------------------------------------
>
>! { dg-do run }
>program xint_func
>
>
Please add a comment to indicate the PR and what has been fixed.
Thanks
Paul
> implicit none
> integer, parameter :: n=3,ii(n)=(/2,0,-1/)
> integer :: i
> character(len=80) :: line
> do i=1,n
> write (line,'(10I5)') int_func(ii(i))
> end do
>contains
> function int_func(n) result(ivec)
> integer, intent(in) :: n
> integer :: ivec(n)
> integer :: i
> if (n > 0) then
> forall (i=1:n) ivec(i) = i
> end if
> end function int_func
>end program xint_func
>
>
>------------------------------------------------------------------------
>
>Index: trans-expr.c
>===================================================================
>--- trans-expr.c (revision 114496)
>+++ trans-expr.c (working copy)
>@@ -2041,7 +2041,8 @@ gfc_conv_function_call (gfc_se * se, gfc
> 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);
>+ false, !sym->attr.pointer, callee_alloc,
>+ true);
>
> /* Pass the temporary as the first argument. */
> tmp = info->descriptor;
>Index: trans-array.c
>===================================================================
>--- trans-array.c (revision 114496)
>+++ trans-array.c (working copy)
>@@ -575,13 +575,20 @@ 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 callee_alloc, bool function)
> {
> tree type;
> tree desc;
> tree tmp;
> tree size;
> tree nelem;
>+ tree cond;
>+ tree or_expr;
>+ tree thencase;
>+ tree elsecase;
>+ tree var;
>+ stmtblock_t thenblock;
>+ stmtblock_t elseblock;
> int n;
> int dim;
>
>@@ -633,6 +640,8 @@ gfc_trans_create_temp_array (stmtblock_t
> size = size * sizeof(element);
> */
>
>+ or_expr = NULL_TREE;
>+
> for (n = 0; n < info->dimen; n++)
> {
> if (loop->to[n] == NULL_TREE)
>@@ -660,17 +669,55 @@ gfc_trans_create_temp_array (stmtblock_t
> tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
> loop->to[n], gfc_index_one_node);
>
>+ if (function)
>+ {
>+ /* Check wether 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);
>+
>+ 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);
> }
>
> /* Get the size of the array. */
>- nelem = size;
>+
> if (size && !callee_alloc)
>- size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
>- TYPE_SIZE_UNIT (gfc_get_element_type (type)));
>+ {
>+ if (function)
>+ {
>+ 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);
>+ nelem = var;
>+ size = var;
>+ }
>+ else
>+ nelem = size;
>+
>+ size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
>+ TYPE_SIZE_UNIT (gfc_get_element_type (type)));
>+ }
> else
>- size = NULL_TREE;
>+ {
>+ nelem = size;
>+ size = NULL_TREE;
>+ }
>
> gfc_trans_allocate_array_storage (pre, post, info, size, nelem, dynamic,
> dealloc);
>@@ -1421,7 +1468,7 @@ gfc_trans_array_constructor (gfc_loopinf
> }
>
> gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info,
>- type, dynamic, true, false);
>+ type, dynamic, true, false, false);
>
> desc = ss->data.info.descriptor;
> offset = gfc_index_zero_node;
>@@ -2890,7 +2937,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++)
>Index: trans-array.h
>===================================================================
>--- trans-array.h (revision 114496)
>+++ trans-array.h (working copy)
>@@ -32,7 +32,7 @@ void gfc_set_loop_bounds_from_array_spec
>
> /* 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);
>+ gfc_ss_info *, tree, bool, bool, bool, bool);
>
> /* Generate function entry code for allocation of compiler allocated array
> variables. */
>Index: trans-stmt.c
>===================================================================
>--- trans-stmt.c (revision 114496)
>+++ trans-stmt.c (working copy)
>@@ -270,7 +270,7 @@ gfc_conv_elemental_dependencies (gfc_se
> 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, true, false, 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);
>Index: trans-intrinsic.c
>===================================================================
>--- trans-intrinsic.c (revision 114496)
>+++ trans-intrinsic.c (working copy)
>@@ -2712,7 +2712,7 @@ gfc_conv_intrinsic_array_transfer (gfc_s
> data field. This is already allocated so set callee_alloc. */
> tmp = gfc_typenode_for_spec (&expr->ts);
> gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
>- info, tmp, false, true, false);
>+ info, tmp, false, true, false, false);
>
> /* Use memcpy to do the transfer. */
> tmp = gfc_conv_descriptor_data_get (info->descriptor);
>
>
More information about the Gcc-patches
mailing list