diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0c1066d95d4b..b498dc4ad7be 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,20 @@ +2010-02-14 Jerry DeLisle + + 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 PR fortran/41113 diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 30561bb168ec..fd8a806d7d08 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -1811,7 +1811,23 @@ build_dt (tree function, gfc_code * code) 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); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 84c3c85ead48..60bffdf96d6f 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -831,7 +831,7 @@ gfc_trans_block_construct (gfc_code* code) 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; @@ -864,7 +864,7 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar, 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). */ @@ -882,6 +882,15 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar, "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); @@ -955,7 +964,7 @@ exit_label: 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; @@ -1010,7 +1019,7 @@ gfc_trans_do (gfc_code * code) 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)); @@ -1125,7 +1134,7 @@ gfc_trans_do (gfc_code * code) 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). */ @@ -1143,6 +1152,15 @@ gfc_trans_do (gfc_code * code) "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); diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h index e6faacd00225..46abc09a0986 100644 --- a/gcc/fortran/trans-stmt.h +++ b/gcc/fortran/trans-stmt.h @@ -23,6 +23,9 @@ along with GCC; see the file COPYING3. If not see 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 */ @@ -45,7 +48,7 @@ tree gfc_trans_return (gfc_code *); 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 *); diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index a5bb64187806..535e639faad4 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -1048,10 +1048,12 @@ gfc_set_backend_locus (locus * loc) } -/* 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; @@ -1172,7 +1174,7 @@ gfc_trans_code (gfc_code * code) break; case EXEC_DO: - res = gfc_trans_do (code); + res = gfc_trans_do (code, cond); break; case EXEC_DO_WHILE: @@ -1298,6 +1300,25 @@ gfc_trans_code (gfc_code * code) } +/* 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. */