diff mbox

[Fortran] PR 45186 - Improve location of expressions for debugging

Message ID 4CB56DC9.7030109@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Oct. 13, 2010, 8:28 a.m. UTC 
PR 45186 is "[4.6 Regression] Gfortran 4.5.0 emits wrong linenumbers". 
While most of it was fixed, I found two cases where the location was 
wrong or at least surprising. That's fixes with the following patch. I 
am sure there are more cases, but I intent to close the PR after those 
fixes are in.

Currently, one has surprising locations (cf. -fdump-tree-original-lineno 
[note the "-lineno"]) for:
   if (cond)
     a = b
   end if
as the condition has the line number of "a = b". Analogously for
   do while (cond)
      j = i
   end do

For DO loops,
   do i = 1, 2  ! or "i = 1, 2, k" which is handled differently
     j = i
     k = j
   end do
many generated expressions are in the "j = i" or in the "k = i" line. 
When trying, also use -fcheck=do to generate get more expressions.

While for "if (cond)" and for "do while(cond)" the line number is 
naturally given by the DO/IF statement, for DO loops it gets more 
complicated: To which line do you associate the loop-exit check, the 
initializations, the increment, ...? The patch mostly puts them into the 
DO line.

Build and currently regtesting.
OK for the trunk?

Tobias

Comments

Mikael Morin Oct. 13, 2010, 11:27 a.m. UTC | #1 
On Wednesday 13 October 2010 10:28:57 Tobias Burnus wrote:
>   PR 45186 is "[4.6 Regression] Gfortran 4.5.0 emits wrong linenumbers".
> While most of it was fixed, I found two cases where the location was
> wrong or at least surprising. That's fixes with the following patch. I
> am sure there are more cases, but I intent to close the PR after those
> fixes are in.
> 
> Currently, one has surprising locations (cf. -fdump-tree-original-lineno
> [note the "-lineno"]) for:
>    if (cond)
>      a = b
>    end if
> as the condition has the line number of "a = b". Analogously for
>    do while (cond)
>       j = i
>    end do
> 
> For DO loops,
>    do i = 1, 2  ! or "i = 1, 2, k" which is handled differently
>      j = i
>      k = j
>    end do
> many generated expressions are in the "j = i" or in the "k = i" line.
> When trying, also use -fcheck=do to generate get more expressions.
> 
> While for "if (cond)" and for "do while(cond)" the line number is
> naturally given by the DO/IF statement, for DO loops it gets more
> complicated: To which line do you associate the loop-exit check, the
> initializations, the increment, ...? The patch mostly puts them into the
> DO line.

I agree with all the above. However, about the implementation, I don't like 
this :

> -
> -tree
> -gfc_trans_runtime_error_vararg (bool error, locus* where, const char*
> msgid, -                               va_list ap)
> +static tree
> +trans_runtime_error_vararg (location_t loc, bool error, locus* where,
> +                               const char* msgid, va_list ap)

and the similar change(s). 
locus' gfc_linebuf has a source_location field, and location_t is typedef-ed 
from source_location in input.h. 
So having both a locus and a location_t arg seems to duplicate the location 
information.  

For the rest of the patch, I'm wondering whether we could remove dependency on 
input_location completely (I mean, in the PR45186 area), that is rely on 
gfc_expr's locus, gfc_code's locus or tree's EXPR_LOCATION only (provided they 
are correctly set of course).

Mikael
diff mbox

Patch

2010-10-13  Tobias Burnus  <burnus@net-b.de>

	PR fortran/45186
	* trans.h (gfc_add_modify_loc, gfc_trans_runtime_check_loc):
	New prototypes.
	(gfc_trans_runtime_error_vararg): Remove prototype.
	* trans.c (gfc_add_modify_loc): New function.
	(gfc_add_modify): Use it.
	(trans_runtime_error_vararg): Renamed from
	gfc_trans_runtime_error_vararg and made static.
	(gfc_trans_runtime_error): Use it.
	(trans_runtime_check_loc): Renamed from
	gfc_trans_runtime_check, made static and takes
	va_list and location_t parameter.
	(gfc_trans_runtime_check_loc, trans_runtime_check): New
	wrapper function calling trans_runtime_check_loc.
	* trans-stmt.c (gfc_trans_if_1, gfc_trans_simple_do,
	gfc_trans_do, gfc_trans_do_while): Improve line number
	associated with generated expressions.

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 70ddd51..11fe025 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -717,6 +717,10 @@  gfc_trans_if_1 (gfc_code * code)
 {
   gfc_se if_se;
   tree stmt, elsestmt;
+  location_t loc_cond; 
+
+  /* Save position.  */
+  loc_cond = input_location;
 
   /* Check for an unconditional ELSE clause.  */
   if (!code->expr1)
@@ -739,7 +743,7 @@  gfc_trans_if_1 (gfc_code * code)
     elsestmt = build_empty_stmt (input_location);
 
   /* Build the condition expression and add it to the condition block.  */
-  stmt = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+  stmt = fold_build3_loc (loc_cond, COND_EXPR, void_type_node,
 			  if_se.expr, stmt, elsestmt);
   
   gfc_add_expr_to_block (&if_se.pre, stmt);
@@ -942,7 +946,8 @@  gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
   tree saved_dovar = NULL;
   tree cycle_label;
   tree exit_label;
-  
+  location_t loc_loop;
+ 
   type = TREE_TYPE (dovar);
 
   /* Initialize the DO variable: dovar = from.  */
@@ -963,6 +968,9 @@  gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
   code->cycle_label = cycle_label;
   code->exit_label = exit_label;
 
+  /* Save position.  */
+  loc_loop = input_location;
+
   /* Loop body.  */
   gfc_start_block (&body);
 
@@ -980,7 +988,7 @@  gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
   /* Check whether someone has modified the loop variable. */
   if (gfc_option.rtcheck & GFC_RTCHECK_DO)
     {
-      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+      tmp = fold_build2_loc (loc_loop, NE_EXPR, boolean_type_node,
 			     dovar, saved_dovar);
       gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
 			       "Loop variable has been modified");
@@ -990,19 +998,19 @@  gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
   if (exit_cond)
     {
       tmp = build1_v (GOTO_EXPR, exit_label);
-      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+      tmp = fold_build3_loc (loc_loop, COND_EXPR, void_type_node,
 			     exit_cond, tmp,
-			     build_empty_stmt (input_location));
+			     build_empty_stmt (loc_loop));
       gfc_add_expr_to_block (&body, tmp);
     }
 
   /* Evaluate the loop condition.  */
-  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, dovar,
+  cond = fold_build2_loc (loc_loop, EQ_EXPR, boolean_type_node, dovar,
 			  to);
   cond = gfc_evaluate_now (cond, &body);
 
   /* Increment the loop variable.  */
-  tmp = fold_build2_loc (input_location, PLUS_EXPR, type, dovar, step);
+  tmp = fold_build2_loc (loc_loop, PLUS_EXPR, type, dovar, step);
   gfc_add_modify (&body, dovar, tmp);
 
   if (gfc_option.rtcheck & GFC_RTCHECK_DO)
@@ -1011,23 +1019,23 @@  gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
   /* The loop exit.  */
   tmp = build1_v (GOTO_EXPR, exit_label);
   TREE_USED (exit_label) = 1;
-  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
-			 cond, tmp, build_empty_stmt (input_location));
+  tmp = fold_build3_loc (loc_loop, COND_EXPR, void_type_node,
+			 cond, tmp, build_empty_stmt (loc_loop));
   gfc_add_expr_to_block (&body, tmp);
 
   /* Finish the loop body.  */
   tmp = gfc_finish_block (&body);
-  tmp = build1_v (LOOP_EXPR, tmp);
+  tmp = fold_build1_loc (loc_loop, LOOP_EXPR, void_type_node, tmp);
 
   /* Only execute the loop if the number of iterations is positive.  */
   if (tree_int_cst_sgn (step) > 0)
-    cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, dovar,
+    cond = fold_build2_loc (loc_loop, LE_EXPR, boolean_type_node, dovar,
 			    to);
   else
-    cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, dovar,
+    cond = fold_build2_loc (loc_loop, GE_EXPR, boolean_type_node, dovar,
 			    to);
-  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp,
-			 build_empty_stmt (input_location));
+  tmp = fold_build3_loc (loc_loop, COND_EXPR, void_type_node, cond, tmp,
+			 build_empty_stmt (loc_loop));
   gfc_add_expr_to_block (pblock, tmp);
 
   /* Add the exit label.  */
@@ -1090,6 +1098,7 @@  gfc_trans_do (gfc_code * code, tree exit_cond)
   tree pos_step;
   stmtblock_t block;
   stmtblock_t body;
+  location_t loc_loop;
 
   gfc_start_block (&block);
 
@@ -1129,7 +1138,10 @@  gfc_trans_do (gfc_code * code, tree exit_cond)
 	|| tree_int_cst_equal (step, integer_minus_one_node)))
     return gfc_trans_simple_do (code, &block, dovar, from, to, step, exit_cond);
 
-  pos_step = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, step,
+  /* Save position.  */
+  loc_loop = input_location;
+
+  pos_step = fold_build2_loc (loc_loop, GT_EXPR, boolean_type_node, step,
 			      fold_convert (type, integer_zero_node));
 
   if (TREE_CODE (type) == INTEGER_TYPE)
@@ -1180,24 +1192,24 @@  gfc_trans_do (gfc_code * code, tree exit_cond)
 
       /* Calculate SIGN (1,step), as (step < 0 ? -1 : 1)  */
 
-      tmp = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, step,
+      tmp = fold_build2_loc (loc_loop, LT_EXPR, boolean_type_node, step,
 			     build_int_cst (TREE_TYPE (step), 0));
-      step_sign = fold_build3_loc (input_location, COND_EXPR, type, tmp, 
+      step_sign = fold_build3_loc (loc_loop, COND_EXPR, type, tmp, 
 				   build_int_cst (type, -1), 
 				   build_int_cst (type, 1));
 
-      tmp = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, to,
+      tmp = fold_build2_loc (loc_loop, LT_EXPR, boolean_type_node, to,
 			     from);
-      pos = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp,
+      pos = fold_build3_loc (loc_loop, COND_EXPR, void_type_node, tmp,
 			     build1_v (GOTO_EXPR, exit_label),
-			     build_empty_stmt (input_location));
+			     build_empty_stmt (loc_loop));
 
-      tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, to,
+      tmp = fold_build2_loc (loc_loop, GT_EXPR, boolean_type_node, to,
 			     from);
-      neg = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp,
+      neg = fold_build3_loc (loc_loop, COND_EXPR, void_type_node, tmp,
 			     build1_v (GOTO_EXPR, exit_label),
-			     build_empty_stmt (input_location));
-      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+			     build_empty_stmt (loc_loop));
+      tmp = fold_build3_loc (loc_loop, COND_EXPR, void_type_node,
 			     pos_step, pos, neg);
 
       gfc_add_expr_to_block (&block, tmp);
@@ -1205,17 +1217,17 @@  gfc_trans_do (gfc_code * code, tree exit_cond)
       /* Calculate the loop count.  to-from can overflow, so
 	 we cast to unsigned.  */
 
-      to2 = fold_build2_loc (input_location, MULT_EXPR, type, step_sign, to);
-      from2 = fold_build2_loc (input_location, MULT_EXPR, type, step_sign,
+      to2 = fold_build2_loc (loc_loop, MULT_EXPR, type, step_sign, to);
+      from2 = fold_build2_loc (loc_loop, MULT_EXPR, type, step_sign,
 			       from);
-      step2 = fold_build2_loc (input_location, MULT_EXPR, type, step_sign,
+      step2 = fold_build2_loc (loc_loop, MULT_EXPR, type, step_sign,
 			       step);
       step2 = fold_convert (utype, step2);
-      tmp = fold_build2_loc (input_location, MINUS_EXPR, type, to2, from2);
+      tmp = fold_build2_loc (loc_loop, MINUS_EXPR, type, to2, from2);
       tmp = fold_convert (utype, tmp);
-      tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, utype, tmp,
+      tmp = fold_build2_loc (loc_loop, TRUNC_DIV_EXPR, utype, tmp,
 			     step2);
-      tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+      tmp = fold_build2_loc (loc_loop, MODIFY_EXPR, void_type_node,
 			     countm1, tmp);
       gfc_add_expr_to_block (&block, tmp);
     }
@@ -1225,23 +1237,23 @@  gfc_trans_do (gfc_code * code, tree exit_cond)
 	 This would probably cause more problems that it solves
 	 when we implement "long double" types.  */
 
-      tmp = fold_build2_loc (input_location, MINUS_EXPR, type, to, from);
-      tmp = fold_build2_loc (input_location, RDIV_EXPR, type, tmp, step);
-      tmp = fold_build1_loc (input_location, FIX_TRUNC_EXPR, utype, tmp);
+      tmp = fold_build2_loc (loc_loop, MINUS_EXPR, type, to, from);
+      tmp = fold_build2_loc (loc_loop, RDIV_EXPR, type, tmp, step);
+      tmp = fold_build1_loc (loc_loop, FIX_TRUNC_EXPR, utype, tmp);
       gfc_add_modify (&block, countm1, tmp);
 
       /* We need a special check for empty loops:
 	 empty = (step > 0 ? to < from : to > from);  */
-      tmp = fold_build3_loc (input_location, COND_EXPR, boolean_type_node,
+      tmp = fold_build3_loc (loc_loop, COND_EXPR, boolean_type_node,
 			     pos_step,
-			     fold_build2_loc (input_location, LT_EXPR,
+			     fold_build2_loc (loc_loop, LT_EXPR,
 					      boolean_type_node, to, from),
-			     fold_build2_loc (input_location, GT_EXPR,
+			     fold_build2_loc (loc_loop, GT_EXPR,
 					      boolean_type_node, to, from));
       /* If the loop is empty, go directly to the exit label.  */
-      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp,
+      tmp = fold_build3_loc (loc_loop, COND_EXPR, void_type_node, tmp,
 			 build1_v (GOTO_EXPR, exit_label),
-			 build_empty_stmt (input_location));
+			 build_empty_stmt (loc_loop));
       gfc_add_expr_to_block (&block, tmp);
     }
 
@@ -1262,47 +1274,48 @@  gfc_trans_do (gfc_code * code, tree exit_cond)
   /* Check whether someone has modified the loop variable. */
   if (gfc_option.rtcheck & GFC_RTCHECK_DO)
     {
-      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, dovar,
+      tmp = fold_build2_loc (loc_loop, NE_EXPR, boolean_type_node, dovar,
 			     saved_dovar);
-      gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
-			       "Loop variable has been modified");
+      gfc_trans_runtime_check_loc (loc_loop, true, false, tmp,
+				   &body, &code->loc,
+				   "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_loc (input_location, COND_EXPR, void_type_node,
+      tmp = fold_build3_loc (loc_loop, COND_EXPR, void_type_node,
 			     exit_cond, tmp,
-			     build_empty_stmt (input_location));
+			     build_empty_stmt (loc_loop));
       gfc_add_expr_to_block (&body, tmp);
     }
 
   /* Increment the loop variable.  */
-  tmp = fold_build2_loc (input_location, PLUS_EXPR, type, dovar, step);
-  gfc_add_modify (&body, dovar, tmp);
+  tmp = fold_build2_loc (loc_loop, PLUS_EXPR, type, dovar, step);
+  gfc_add_modify_loc (loc_loop, &body, dovar, tmp);
 
   if (gfc_option.rtcheck & GFC_RTCHECK_DO)
-    gfc_add_modify (&body, saved_dovar, dovar);
+    gfc_add_modify_loc (loc_loop, &body, saved_dovar, dovar);
 
   /* End with the loop condition.  Loop until countm1 == 0.  */
-  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, countm1,
+  cond = fold_build2_loc (loc_loop, EQ_EXPR, boolean_type_node, countm1,
 			  build_int_cst (utype, 0));
   tmp = build1_v (GOTO_EXPR, exit_label);
-  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
-			 cond, tmp, build_empty_stmt (input_location));
+  tmp = fold_build3_loc (loc_loop, COND_EXPR, void_type_node,
+			 cond, tmp, build_empty_stmt (loc_loop));
   gfc_add_expr_to_block (&body, tmp);
 
   /* Decrement the loop count.  */
-  tmp = fold_build2_loc (input_location, MINUS_EXPR, utype, countm1,
+  tmp = fold_build2_loc (loc_loop, MINUS_EXPR, utype, countm1,
 			 build_int_cst (utype, 1));
-  gfc_add_modify (&body, countm1, tmp);
+  gfc_add_modify_loc (loc_loop, &body, countm1, tmp);
 
   /* End of loop body.  */
   tmp = gfc_finish_block (&body);
 
   /* The for loop itself.  */
-  tmp = build1_v (LOOP_EXPR, tmp);
+  tmp = fold_build1_loc (loc_loop, LOOP_EXPR, void_type_node, tmp);
   gfc_add_expr_to_block (&block, tmp);
 
   /* Add the exit label.  */
@@ -1344,6 +1357,10 @@  gfc_trans_do_while (gfc_code * code)
   tree cycle_label;
   tree exit_label;
   stmtblock_t block;
+  location_t loc_loop;
+
+  /* Save position.  */
+  loc_loop = input_location;
 
   /* Everything we build here is part of the loop body.  */
   gfc_start_block (&block);
@@ -1360,13 +1377,13 @@  gfc_trans_do_while (gfc_code * code)
   gfc_init_se (&cond, NULL);
   gfc_conv_expr_val (&cond, code->expr1);
   gfc_add_block_to_block (&block, &cond.pre);
-  cond.expr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
+  cond.expr = fold_build1_loc (loc_loop, TRUTH_NOT_EXPR,
 			       boolean_type_node, cond.expr);
 
   /* Build "IF (! cond) GOTO exit_label".  */
   tmp = build1_v (GOTO_EXPR, exit_label);
   TREE_USED (exit_label) = 1;
-  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+  tmp = fold_build3_loc (loc_loop, COND_EXPR, void_type_node,
 			 cond.expr, tmp, build_empty_stmt (input_location));
   gfc_add_expr_to_block (&block, tmp);
 
@@ -1386,7 +1403,7 @@  gfc_trans_do_while (gfc_code * code)
 
   gfc_init_block (&block);
   /* Build the loop.  */
-  tmp = build1_v (LOOP_EXPR, tmp);
+  tmp = fold_build1_loc (loc_loop, LOOP_EXPR, void_type_node, tmp);
   gfc_add_expr_to_block (&block, tmp);
 
   /* Add the exit label.  */
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index a9513af..e9de768 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -151,7 +151,7 @@  gfc_evaluate_now (tree expr, stmtblock_t * pblock)
    LHS <- RHS.  */
 
 void
-gfc_add_modify (stmtblock_t * pblock, tree lhs, tree rhs)
+gfc_add_modify_loc (location_t loc, stmtblock_t * pblock, tree lhs, tree rhs)
 {
   tree tmp;
 
@@ -167,12 +167,19 @@  gfc_add_modify (stmtblock_t * pblock, tree lhs, tree rhs)
 	      || AGGREGATE_TYPE_P (TREE_TYPE (lhs)));
 #endif
 
-  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, lhs,
+  tmp = fold_build2_loc (loc, MODIFY_EXPR, void_type_node, lhs,
 			 rhs);
   gfc_add_expr_to_block (pblock, tmp);
 }
 
 
+void
+gfc_add_modify (stmtblock_t * pblock, tree lhs, tree rhs)
+{
+  gfc_add_modify_loc (input_location, pblock, lhs, rhs);
+}
+
+
 /* Create a new scope/binding level and initialize a block.  Care must be
    taken when translating expressions as any temporaries will be placed in
    the innermost scope.  */
@@ -355,18 +362,9 @@  gfc_build_array_ref (tree base, tree offset, tree decl)
 /* Generate a call to print a runtime error possibly including multiple
    arguments and a locus.  */
 
-tree
-gfc_trans_runtime_error (bool error, locus* where, const char* msgid, ...)
-{
-  va_list ap;
-
-  va_start (ap, msgid);
-  return gfc_trans_runtime_error_vararg (error, where, msgid, ap);
-}
-
-tree
-gfc_trans_runtime_error_vararg (bool error, locus* where, const char* msgid,
-				va_list ap)
+static tree
+trans_runtime_error_vararg (location_t loc, bool error, locus* where,
+				const char* msgid, va_list ap)
 {
   stmtblock_t block;
   tree tmp;
@@ -414,7 +412,6 @@  gfc_trans_runtime_error_vararg (bool error, locus* where, const char* msgid,
   argarray[1] = arg2;
   for (i = 0; i < nargs; i++)
     argarray[2 + i] = va_arg (ap, tree);
-  va_end (ap);
   
   /* Build the function call to runtime_(warning,error)_at; because of the
      variable number of arguments, we can't use build_call_expr_loc dinput_location,
@@ -424,8 +421,8 @@  gfc_trans_runtime_error_vararg (bool error, locus* where, const char* msgid,
   else
     fntype = TREE_TYPE (gfor_fndecl_runtime_warning_at);
 
-  tmp = fold_builtin_call_array (input_location, TREE_TYPE (fntype),
-				 fold_build1_loc (input_location, ADDR_EXPR,
+  tmp = fold_builtin_call_array (loc, TREE_TYPE (fntype),
+				 fold_build1_loc (loc, ADDR_EXPR,
 					     build_pointer_type (fntype),
 					     error
 					     ? gfor_fndecl_runtime_error_at
@@ -437,13 +434,26 @@  gfc_trans_runtime_error_vararg (bool error, locus* where, const char* msgid,
 }
 
 
+tree
+gfc_trans_runtime_error (bool error, locus* where, const char* msgid, ...)
+{
+  va_list ap;
+  tree result;
+
+  va_start (ap, msgid);
+  result = trans_runtime_error_vararg (input_location, error, where, msgid, ap);
+  va_end (ap);
+  return result;
+}
+
+
 /* Generate a runtime error if COND is true.  */
 
-void
-gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
-			 locus * where, const char * msgid, ...)
+static void
+trans_runtime_check_loc (location_t loc, bool error, bool once, tree cond,
+			 stmtblock_t * pblock, locus * where,
+			 const char * msgid, va_list ap)
 {
-  va_list ap;
   stmtblock_t block;
   tree body;
   tree tmp;
@@ -463,13 +473,11 @@  gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
   gfc_start_block (&block);
 
   /* The code to generate the error.  */
-  va_start (ap, msgid);
-  gfc_add_expr_to_block (&block,
-			 gfc_trans_runtime_error_vararg (error, where,
-							 msgid, ap));
+  gfc_add_expr_to_block (&block, trans_runtime_error_vararg (loc, error, where,
+							     msgid, ap));
 
   if (once)
-    gfc_add_modify (&block, tmpvar, boolean_false_node);
+    gfc_add_modify_loc (loc, &block, tmpvar, boolean_false_node);
 
   body = gfc_finish_block (&block);
 
@@ -481,22 +489,45 @@  gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
     {
       /* Tell the compiler that this isn't likely.  */
       if (once)
-	cond = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+	cond = fold_build2_loc (loc, TRUTH_AND_EXPR,
 				long_integer_type_node, tmpvar, cond);
       else
 	cond = fold_convert (long_integer_type_node, cond);
 
       tmp = build_int_cst (long_integer_type_node, 0);
-      cond = build_call_expr_loc (input_location,
+      cond = build_call_expr_loc (loc,
 			      built_in_decls[BUILT_IN_EXPECT], 2, cond, tmp);
       cond = fold_convert (boolean_type_node, cond);
 
-      tmp = build3_v (COND_EXPR, cond, body, build_empty_stmt (input_location));
+      tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, cond,
+			     body, build_empty_stmt (loc));
       gfc_add_expr_to_block (pblock, tmp);
     }
 }
 
 
+void
+gfc_trans_runtime_check_loc (location_t loc, bool error, bool once, tree cond,
+			     stmtblock_t * pblock, locus * where,
+			     const char * msgid, ...)
+{
+  va_list ap;
+  va_start (ap, msgid);
+  trans_runtime_check_loc (loc, error, once, cond, pblock, where, msgid, ap);
+  va_end (ap);
+}
+
+void
+gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
+			 locus * where, const char * msgid, ...)
+{
+  va_list ap;
+  va_start (ap, msgid);
+  trans_runtime_check_loc (input_location, error, once, cond, pblock, where,
+			   msgid, ap);
+  va_end (ap);
+}
+
 /* Call malloc to allocate size bytes of memory, with special conditions:
       + if size <= 0, return a malloced area of size 1,
       + if malloc returns NULL, issue a runtime error.  */
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index b3c6032..827ee06 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -398,6 +398,7 @@  void gfc_add_expr_to_block (stmtblock_t *, tree);
 /* Add a block to the end of a block.  */
 void gfc_add_block_to_block (stmtblock_t *, stmtblock_t *);
 /* Add a MODIFY_EXPR to a block.  */
+void gfc_add_modify_loc (location_t, stmtblock_t *, tree, tree);
 void gfc_add_modify (stmtblock_t *, tree, tree);
 
 /* Initialize a statement block.  */
@@ -504,9 +505,10 @@  bool get_array_ctor_strlen (stmtblock_t *, gfc_constructor_base, tree *);
 
 /* Generate a runtime error call.  */
 tree gfc_trans_runtime_error (bool, locus*, const char*, ...);
-tree gfc_trans_runtime_error_vararg (bool, locus*, const char*, va_list);
 
 /* Generate a runtime warning/error check.  */
+void gfc_trans_runtime_check_loc (location_t, bool, bool, tree, stmtblock_t *,
+				  locus *, const char *, ...);
 void gfc_trans_runtime_check (bool, bool, tree, stmtblock_t *, locus *,
 			      const char *, ...);