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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@156755 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 86 insertions, 11 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0c1066d95d4..b498dc4ad7b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,20 @@
+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
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 30561bb168e..fd8a806d7d0 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 84c3c85ead4..60bffdf96d6 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 e6faacd0022..46abc09a098 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 a5bb6418780..535e639faad 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.  */