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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0c1066d..b498dc4 100644 (file)
--- 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
 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 30561bb..fd8a806 100644 (file)
--- 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;
 
   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);
 
 
   gfc_add_block_to_block (&block, &post_iu_block);
 

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 84c3c85..60bffdf 100644 (file)
--- 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,
 
 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;
 {
   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.  */
   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).  */
   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");
     }
 
                               "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);
   /* 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
    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;
 {
   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)))
   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));
 
   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.  */
   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).  */
   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");
     }
 
                               "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);
   /* 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 e6faacd..46abc09 100644 (file)
--- 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 *);
 
    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 */
 /* 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_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 *);
 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 a5bb641..535e639 100644 (file)
--- 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;
 {
   stmtblock_t block;
   tree res;


@@ -1172,7 +1174,7 @@ gfc_trans_code (gfc_code * code)
          break;
 
        case EXEC_DO:
          break;
 
        case EXEC_DO:

-         res = gfc_trans_do (code);
+         res = gfc_trans_do (code, cond);

          break;
 
        case EXEC_DO_WHILE:
          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.  */
 
 /* This function is called after a complete program unit has been parsed
    and resolved.  */