re PR fortran/45186 (Gfortran 4.5.0 emits wrong linenumbers)

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.

From-SVN: r165507

1 files changed, 45 insertions, 24 deletions

diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index a9513af..6050e1a 100644
--- 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);
     }
 }