OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/30720 ([4.1 only] runtime: check for empty array slices before allocating a negative amount of memory) 

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.

	* gfortran.dg/array_function_1.f90: New test.

From-SVN: r121773
This commit is contained in:
Francois-Xavier Coudert 2007-02-09 21:31:18 +01:00 committed by François-Xavier Coudert
parent b964502b99
commit 999ffb1a4b
8 changed files with 66 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -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

59
gcc/fortran/trans-array.c
View File

@ -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++)

2
gcc/fortran/trans-array.h
View File

@ -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. */

3
gcc/fortran/trans-expr.c
View File

@ -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;

6
gcc/fortran/trans-intrinsic.c
View File

@ -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);

2
gcc/fortran/trans-stmt.c
View File

@ -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);

7
gcc/testsuite/ChangeLog
View File

@ -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>

27
gcc/testsuite/gfortran.dg/array_function_1.f90 Normal file
View File

@ -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