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

login
register
mail settings
Submitter Tobias Burnus
Date Oct. 13, 2010, 8:28 a.m.
Message ID <4CB56DC9.7030109@net-b.de>
Download mbox | patch
Permalink /patch/67661/
State New
Headers show

Comments

Tobias Burnus - Oct. 13, 2010, 8:28 a.m.
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
Mikael Morin - Oct. 13, 2010, 11:27 a.m.
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

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 *, ...);