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

        PR fortran/45186
        * trans.h (gfc_add_modify_loc, gfc_evaluate_now_loc): New
        * prototypes.
        (gfc_trans_runtime_error_vararg): Remove prototype.
        * trans.c (gfc_add_modify_loc, gfc_evaluate_now_loc): New
        * functions.
        (gfc_add_modify, gfc_evaluate_now): Use them.
        (trans_runtime_error_vararg): Renamed from
        gfc_trans_runtime_error_vararg, made static and use locus.
        (gfc_trans_runtime_error): Use it.
        (gfc_trans_runtime_check): Ditto and make use of locus.
        * 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.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 517b500..b32454c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,18 @@
+2010-10-15  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/45186
+       * trans.h (gfc_add_modify_loc, gfc_evaluate_now_loc): New prototypes.
+       (gfc_trans_runtime_error_vararg): Remove prototype.
+       * trans.c (gfc_add_modify_loc, gfc_evaluate_now_loc): New functions.
+       (gfc_add_modify, gfc_evaluate_now): Use them.
+       (trans_runtime_error_vararg): Renamed from
+       gfc_trans_runtime_error_vararg, made static and use locus.
+       (gfc_trans_runtime_error): Use it.
+       (gfc_trans_runtime_check): Ditto and make use of locus.
+       * 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.
+
 2010-10-12  Daniel Kraft  <d@domob.eu>
 
        PR fortran/38936

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 70ddd51..31b0732 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -717,6 +717,7 @@ gfc_trans_if_1 (gfc_code * code)
 {
   gfc_se if_se;
   tree stmt, elsestmt;
+  location_t loc;
 
   /* Check for an unconditional ELSE clause.  */
   if (!code->expr1)
@@ -739,8 +740,9 @@ 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,
-                         if_se.expr, stmt, elsestmt);
+  loc = code->expr1->where.lb ? code->expr1->where.lb->location : input_location;
+  stmt = fold_build3_loc (loc, COND_EXPR, void_type_node, if_se.expr, stmt,
+                         elsestmt);
   
   gfc_add_expr_to_block (&if_se.pre, stmt);
 
@@ -942,17 +944,20 @@ 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;
   
   type = TREE_TYPE (dovar);
 
+  loc = code->ext.iterator->start->where.lb->location;
+
   /* Initialize the DO variable: dovar = from.  */
-  gfc_add_modify (pblock, dovar, from);
+  gfc_add_modify_loc (loc, pblock, dovar, from);
   
   /* Save value for do-tinkering checking. */
   if (gfc_option.rtcheck & GFC_RTCHECK_DO)
     {
       saved_dovar = gfc_create_var (type, ".saved_dovar");
-      gfc_add_modify (pblock, saved_dovar, dovar);
+      gfc_add_modify_loc (loc, pblock, saved_dovar, dovar);
     }
 
   /* Cycle and exit statements are implemented with gotos.  */
@@ -980,7 +985,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, NE_EXPR, boolean_type_node,
                             dovar, saved_dovar);
       gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
                               "Loop variable has been modified");
@@ -990,44 +995,44 @@ 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, COND_EXPR, void_type_node,
                             exit_cond, tmp,
-                            build_empty_stmt (input_location));
+                            build_empty_stmt (loc));
       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, EQ_EXPR, boolean_type_node, dovar,
                          to);
-  cond = gfc_evaluate_now (cond, &body);
+  cond = gfc_evaluate_now_loc (loc, cond, &body);
 
   /* 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, PLUS_EXPR, type, dovar, step);
+  gfc_add_modify_loc (loc, &body, dovar, tmp);
 
   if (gfc_option.rtcheck & GFC_RTCHECK_DO)
-    gfc_add_modify (&body, saved_dovar, dovar);
+    gfc_add_modify_loc (loc, &body, saved_dovar, dovar);
 
   /* The loop exit.  */
-  tmp = build1_v (GOTO_EXPR, exit_label);
+  tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_node, 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, COND_EXPR, void_type_node,
+                        cond, tmp, build_empty_stmt (loc));
   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_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, 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, 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, COND_EXPR, void_type_node, cond, tmp,
+                        build_empty_stmt (loc));
   gfc_add_expr_to_block (pblock, tmp);
 
   /* Add the exit label.  */
@@ -1090,9 +1095,12 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
   tree pos_step;
   stmtblock_t block;
   stmtblock_t body;
+  location_t loc;
 
   gfc_start_block (&block);
 
+  loc = code->ext.iterator->start->where.lb->location;
+
   /* Evaluate all the expressions in the iterator.  */
   gfc_init_se (&se, NULL);
   gfc_conv_expr_lhs (&se, code->ext.iterator->var);
@@ -1129,7 +1137,7 @@ 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,
+  pos_step = fold_build2_loc (loc, GT_EXPR, boolean_type_node, step,
                              fold_convert (type, integer_zero_node));
 
   if (TREE_CODE (type) == INTEGER_TYPE)
@@ -1154,7 +1162,7 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
   if (gfc_option.rtcheck & GFC_RTCHECK_DO)
     {
       saved_dovar = gfc_create_var (type, ".saved_dovar");
-      gfc_add_modify (&block, saved_dovar, dovar);
+      gfc_add_modify_loc (loc, &block, saved_dovar, dovar);
     }
 
   /* Initialize loop count and jump to exit label if the loop is empty.
@@ -1180,24 +1188,25 @@ 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, 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, 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,
-                            from);
-      pos = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp,
-                            build1_v (GOTO_EXPR, exit_label),
-                            build_empty_stmt (input_location));
+      tmp = fold_build2_loc (loc, LT_EXPR, boolean_type_node, to, from);
+      pos = fold_build3_loc (loc, COND_EXPR, void_type_node, tmp,
+                            fold_build1_loc (loc, GOTO_EXPR, void_type_node,
+                                             exit_label),
+                            build_empty_stmt (loc));
 
-      tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, to,
+      tmp = fold_build2_loc (loc, GT_EXPR, boolean_type_node, to,
                             from);
-      neg = fold_build3_loc (input_location, 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,
+      neg = fold_build3_loc (loc, COND_EXPR, void_type_node, tmp,
+                            fold_build1_loc (loc, GOTO_EXPR, void_type_node,
+                                             exit_label),
+                            build_empty_stmt (loc));
+      tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
                             pos_step, pos, neg);
 
       gfc_add_expr_to_block (&block, tmp);
@@ -1205,18 +1214,14 @@ 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,
-                              from);
-      step2 = fold_build2_loc (input_location, MULT_EXPR, type, step_sign,
-                              step);
+      to2 = fold_build2_loc (loc, MULT_EXPR, type, step_sign, to);
+      from2 = fold_build2_loc (loc, MULT_EXPR, type, step_sign, from);
+      step2 = fold_build2_loc (loc, 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, MINUS_EXPR, type, to2, from2);
       tmp = fold_convert (utype, tmp);
-      tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, utype, tmp,
-                            step2);
-      tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
-                            countm1, tmp);
+      tmp = fold_build2_loc (loc, TRUNC_DIV_EXPR, utype, tmp, step2);
+      tmp = fold_build2_loc (loc, MODIFY_EXPR, void_type_node, countm1, tmp);
       gfc_add_expr_to_block (&block, tmp);
     }
   else
@@ -1225,21 +1230,20 @@ 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, MINUS_EXPR, type, to, from);
+      tmp = fold_build2_loc (loc, RDIV_EXPR, type, tmp, step);
+      tmp = fold_build1_loc (loc, 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,
-                            pos_step,
-                            fold_build2_loc (input_location, LT_EXPR,
+      tmp = fold_build3_loc (loc, COND_EXPR, boolean_type_node, pos_step,
+                            fold_build2_loc (loc, LT_EXPR,
                                              boolean_type_node, to, from),
-                            fold_build2_loc (input_location, GT_EXPR,
+                            fold_build2_loc (loc, 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, COND_EXPR, void_type_node, tmp,
                         build1_v (GOTO_EXPR, exit_label),
                         build_empty_stmt (input_location));
       gfc_add_expr_to_block (&block, tmp);
@@ -1262,7 +1266,7 @@ 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, NE_EXPR, boolean_type_node, dovar,
                             saved_dovar);
       gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
                               "Loop variable has been modified");
@@ -1272,37 +1276,37 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
   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, 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_loc (input_location, PLUS_EXPR, type, dovar, step);
-  gfc_add_modify (&body, dovar, tmp);
+  tmp = fold_build2_loc (loc, PLUS_EXPR, type, dovar, step);
+  gfc_add_modify_loc (loc, &body, dovar, tmp);
 
   if (gfc_option.rtcheck & GFC_RTCHECK_DO)
-    gfc_add_modify (&body, saved_dovar, dovar);
+    gfc_add_modify_loc (loc, &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, 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_build1_loc (loc, GOTO_EXPR, void_type_node, exit_label);
+  tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
+                        cond, tmp, build_empty_stmt (loc));
   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, MINUS_EXPR, utype, countm1,
                         build_int_cst (utype, 1));
-  gfc_add_modify (&body, countm1, tmp);
+  gfc_add_modify_loc (loc, &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_EXPR, void_type_node, tmp);
   gfc_add_expr_to_block (&block, tmp);
 
   /* Add the exit label.  */
@@ -1360,14 +1364,15 @@ 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,
-                              boolean_type_node, cond.expr);
+  cond.expr = fold_build1_loc (code->expr1->where.lb->location,
+                              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,
-                        cond.expr, tmp, build_empty_stmt (input_location));
+  tmp = fold_build3_loc (code->expr1->where.lb->location, COND_EXPR,
+                        void_type_node, cond.expr, tmp,
+                        build_empty_stmt (code->expr1->where.lb->location));
   gfc_add_expr_to_block (&block, tmp);
 
   /* The main body of the loop.  */
@@ -1386,7 +1391,8 @@ gfc_trans_do_while (gfc_code * code)
 
   gfc_init_block (&block);
   /* Build the loop.  */
-  tmp = build1_v (LOOP_EXPR, tmp);
+  tmp = fold_build1_loc (code->expr1->where.lb->location, 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..6050e1a 100644 (file)
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -132,7 +132,7 @@ gfc_create_var (tree type, const char *prefix)
    return a pointer to the VAR_DECL node for this variable.  */
 
 tree
-gfc_evaluate_now (tree expr, stmtblock_t * pblock)
+gfc_evaluate_now_loc (location_t loc, tree expr, stmtblock_t * pblock)
 {
   tree var;
 
@@ -140,18 +140,25 @@ gfc_evaluate_now (tree expr, stmtblock_t * pblock)
     return expr;
 
   var = gfc_create_var (TREE_TYPE (expr), NULL);
-  gfc_add_modify (pblock, var, expr);
+  gfc_add_modify_loc (loc, pblock, var, expr);
 
   return var;
 }
 
 
+tree
+gfc_evaluate_now (tree expr, stmtblock_t * pblock)
+{
+  return gfc_evaluate_now_loc (input_location, expr, pblock);
+}
+
+
 /* Build a MODIFY_EXPR node and add it to a given statement block PBLOCK.  
    A MODIFY_EXPR is an assignment:
    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 +174,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 +369,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 (bool error, locus* where, const char* msgid,
+                           va_list ap)
 {
   stmtblock_t block;
   tree tmp;
@@ -376,6 +381,7 @@ gfc_trans_runtime_error_vararg (bool error, locus* where, const char* msgid,
   char *message;
   const char *p;
   int line, nargs, i;
+  location_t loc;
 
   /* Compute the number of extra arguments from the format string.  */
   for (p = msgid, nargs = 0; *p; p++)
@@ -414,7 +420,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 +429,9 @@ 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,
+  loc = where ? where->lb->location : input_location;
+  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,6 +443,19 @@ 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 (error, where, msgid, ap);
+  va_end (ap);
+  return result;
+}
+
+
 /* Generate a runtime error if COND is true.  */
 
 void
@@ -465,8 +484,8 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
   /* 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));
+                        trans_runtime_error_vararg (error, where,
+                                                    msgid, ap));
 
   if (once)
     gfc_add_modify (&block, tmpvar, boolean_false_node);
@@ -481,17 +500,19 @@ 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 (where->lb->location, 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 (where->lb->location,
                              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 (where->lb->location, COND_EXPR, void_type_node,
+                            cond, body,
+                            build_empty_stmt (where->lb->location));
       gfc_add_expr_to_block (pblock, tmp);
     }
 }

diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index b3c6032..d4c54c0 100644 (file)
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -342,6 +342,7 @@ tree gfc_string_to_single_character (tree len, tree str, int kind);
 /* Find the decl containing the auxiliary variables for assigned variables.  */
 void gfc_conv_label_variable (gfc_se * se, gfc_expr * expr);
 /* If the value is not constant, Create a temporary and copy the value.  */
+tree gfc_evaluate_now_loc (location_t, tree, stmtblock_t *);
 tree gfc_evaluate_now (tree, stmtblock_t *);
 
 /* Find the appropriate variant of a math intrinsic.  */
@@ -398,6 +399,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,7 +506,6 @@ 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 (bool, bool, tree, stmtblock_t *, locus *,