+2006-06-15 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 whether
+ the size along any argument is negative. In that case,
+ allocate size 0.
+ (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-10 Paul Thomas <pault@gcc.gnu.org>
PR fortran/24558
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;
size = size * sizeof(element);
*/
+ or_expr = NULL_TREE;
+
for (n = 0; n < info->dimen; n++)
{
if (loop->to[n] == NULL_TREE)
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);
}
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;
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++)