PR fortran/32382
* trans-stmt.h: Add prototype for gfc_trans_code_cond. Add tree cond to
gfc_trans_do prototype.
* trans-stmt.c (gfc_trans_simple_do): Add optional argument to pass in
a loop exit condition. If exit condition is given, build the loop exit
code, checking IO results of implied do loops in READ and WRITE.
(gfc_trans_do): Likewise.
* trans.c (trans_code): New static work function, previously
gfc_trans_code. Passes exit condition to gfc_trans_do.
(gfc_trans_code): Calls trans_code with NULL_TREE condition.
(gfc_trans_code_cond): Calls trans_code with loop exit condition.
* trans-io.c (build_dt): Build an exit condition to allow checking IO
result status bits in the dtparm structure. Use this condition in call
to gfc_trans_code_cond.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@156755
138bc75d-0d04-0410-961f-
82ee72b054a4
+2010-02-14 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR fortran/32382
+ * trans-stmt.h: Add prototype for gfc_trans_code_cond. Add tree cond to
+ gfc_trans_do prototype.
+ * trans-stmt.c (gfc_trans_simple_do): Add optional argument to pass in
+ a loop exit condition. If exit condition is given, build the loop exit
+ code, checking IO results of implied do loops in READ and WRITE.
+ (gfc_trans_do): Likewise.
+ * trans.c (trans_code): New static work function, previously
+ gfc_trans_code. Passes exit condition to gfc_trans_do.
+ (gfc_trans_code): Calls trans_code with NULL_TREE condition.
+ (gfc_trans_code_cond): Calls trans_code with loop exit condition.
+ * trans-io.c (build_dt): Build an exit condition to allow checking IO
+ result status bits in the dtparm structure. Use this condition in call
+ to gfc_trans_code_cond.
+
2010-02-13 Paul Thomas <pault@gcc.gnu.org>
PR fortran/41113
dt_parm = var;
dt_post_end_block = &post_end_block;
- gfc_add_expr_to_block (&block, gfc_trans_code (code->block->next));
+ /* Set implied do loop exit condition. */
+ if (last_dt == READ || last_dt == WRITE)
+ {
+ gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_flags];
+
+ tmp = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
+ dt_parm, TYPE_FIELDS (TREE_TYPE (dt_parm)), NULL_TREE);
+ tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
+ tmp, p->field, NULL_TREE);
+ tmp = fold_build2 (BIT_AND_EXPR, TREE_TYPE (tmp),
+ tmp, build_int_cst (TREE_TYPE (tmp),
+ IOPARM_common_libreturn_mask));
+ }
+ else /* IOLENGTH */
+ tmp = NULL_TREE;
+
+ gfc_add_expr_to_block (&block, gfc_trans_code_cond (code->block->next, tmp));
gfc_add_block_to_block (&block, &post_iu_block);
static tree
gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
- tree from, tree to, tree step)
+ tree from, tree to, tree step, tree exit_cond)
{
stmtblock_t body;
tree type;
gfc_start_block (&body);
/* Main loop body. */
- tmp = gfc_trans_code (code->block->next);
+ tmp = gfc_trans_code_cond (code->block->next, exit_cond);
gfc_add_expr_to_block (&body, tmp);
/* Label for cycle statements (if needed). */
"Loop variable has been modified");
}
+ /* Exit the loop if there is an I/O result condition or error. */
+ if (exit_cond)
+ {
+ tmp = build1_v (GOTO_EXPR, exit_label);
+ tmp = fold_build3 (COND_EXPR, void_type_node, exit_cond, tmp,
+ build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&body, tmp);
+ }
+
/* Evaluate the loop condition. */
cond = fold_build2 (EQ_EXPR, boolean_type_node, dovar, to);
cond = gfc_evaluate_now (cond, &body);
because the loop count itself can overflow. */
tree
-gfc_trans_do (gfc_code * code)
+gfc_trans_do (gfc_code * code, tree exit_cond)
{
gfc_se se;
tree dovar;
if (TREE_CODE (type) == INTEGER_TYPE
&& (integer_onep (step)
|| tree_int_cst_equal (step, integer_minus_one_node)))
- return gfc_trans_simple_do (code, &block, dovar, from, to, step);
+ return gfc_trans_simple_do (code, &block, dovar, from, to, step, exit_cond);
pos_step = fold_build2 (GT_EXPR, boolean_type_node, step,
fold_convert (type, integer_zero_node));
code->block->backend_decl = tree_cons (cycle_label, exit_label, NULL);
/* Main loop body. */
- tmp = gfc_trans_code (code->block->next);
+ tmp = gfc_trans_code_cond (code->block->next, exit_cond);
gfc_add_expr_to_block (&body, tmp);
/* Label for cycle statements (if needed). */
"Loop variable has been modified");
}
+ /* Exit the loop if there is an I/O result condition or error. */
+ if (exit_cond)
+ {
+ tmp = build1_v (GOTO_EXPR, exit_label);
+ tmp = fold_build3 (COND_EXPR, void_type_node, exit_cond, tmp,
+ build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&body, tmp);
+ }
+
/* Increment the loop variable. */
tmp = fold_build2 (PLUS_EXPR, type, dovar, step);
gfc_add_modify (&body, dovar, tmp);
Calls gfc_trans_*. */
tree gfc_trans_code (gfc_code *);
+/* Wrapper function used to pass a check condition for implied DO loops. */
+tree gfc_trans_code_cond (gfc_code *, tree);
+
/* All other gfc_trans_* should only need be called by gfc_trans_code */
/* trans-expr.c */
tree gfc_trans_if (gfc_code *);
tree gfc_trans_arithmetic_if (gfc_code *);
tree gfc_trans_block_construct (gfc_code *);
-tree gfc_trans_do (gfc_code *);
+tree gfc_trans_do (gfc_code *, tree);
tree gfc_trans_do_while (gfc_code *);
tree gfc_trans_select (gfc_code *);
tree gfc_trans_forall (gfc_code *);
}
-/* Translate an executable statement. */
+/* Translate an executable statement. The tree cond is used by gfc_trans_do.
+ This static function is wrapped by gfc_trans_code_cond and
+ gfc_trans_code. */
-tree
-gfc_trans_code (gfc_code * code)
+static tree
+trans_code (gfc_code * code, tree cond)
{
stmtblock_t block;
tree res;
break;
case EXEC_DO:
- res = gfc_trans_do (code);
+ res = gfc_trans_do (code, cond);
break;
case EXEC_DO_WHILE:
}
+/* Translate an executable statement with condition, cond. The condition is
+ used by gfc_trans_do to test for IO result conditions inside implied
+ DO loops of READ and WRITE statements. See build_dt in trans-io.c. */
+
+tree
+gfc_trans_code_cond (gfc_code * code, tree cond)
+{
+ return trans_code (code, cond);
+}
+
+/* Translate an executable statement without condition. */
+
+tree
+gfc_trans_code (gfc_code * code)
+{
+ return trans_code (code, NULL_TREE);
+}
+
+
/* This function is called after a complete program unit has been parsed
and resolved. */