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

2010-09-03  Tobias Burnus  <burnus@net-b.de>

        PR fortran/45186
        * trans-intrinsic.c (gfc_conv_intrinsic_sign,
        gfc_conv_intrinsic_leadz): Use build_call_expr_loc instead
        of build_call_expr.
        * trans-expr.c (gfc_conv_expr_present, gfc_conv_missing_dummy,
        gfc_conv_string_length, gfc_conv_substring,
        gfc_conv_component_ref, gfc_conv_unary_op, gfc_conv_powi,
        gfc_conv_cst_int_power, gfc_conv_string_tmp, gfc_conv_concat_op,
        gfc_conv_expr_op, gfc_build_compare_string,
        gfc_set_interface_mapping_bounds, gfc_conv_subref_array_arg,
        gfc_conv_derived_to_class, conv_isocbinding_procedure,
        gfc_conv_procedure_call, fill_with_spaces,
        gfc_trans_string_copy, gfc_trans_alloc_subarray_assign,
        gfc_trans_structure_assign, gfc_trans_pointer_assignment,
        gfc_trans_scalar_assign, gfc_trans_zero_assign,
        gfc_trans_array_copy, gfc_trans_array_constructor_copy): Change
        fold_build[0-9] to fold_build[0-9]_loc.
        * trans-io.c (set_parameter_const, set_parameter_value,
        set_parameter_ref, gfc_convert_array_to_string, set_string,
        set_internal_unit, io_result, set_error_locus,
        nml_get_addr_expr, build_dt): Ditto.
        * trans-openmp.c (gfc_omp_clause_default_ctor,
        gfc_omp_clause_copy_ctor, gfc_omp_clause_assign_op,
        gfc_trans_omp_array_reduction, gfc_trans_omp_atomic,
        gfc_trans_omp_do): Ditto.
        * trans.c (gfc_add_modify, gfc_build_addr_expr,
        gfc_build_array_ref, gfc_trans_runtime_error_vararg,
        gfc_trans_runtime_check, gfc_call_malloc,
        gfc_allocate_with_status, gfc_allocate_array_with_status,
        gfc_call_free, gfc_deallocate_with_status,
        gfc_call_realloc): Ditto.

From-SVN: r163838

1 files changed, 76 insertions, 59 deletions

diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 89c8df7..6d4cba2 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -428,10 +428,11 @@ set_parameter_const (stmtblock_t *block, tree var, enum iofield type,
   gfc_st_parameter_field *p = &st_parameter_field[type];
 
   if (p->param_type == IOPARM_ptype_common)
-    var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
-		       var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
-  tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field,
-		     NULL_TREE);
+    var = fold_build3_loc (input_location, COMPONENT_REF,
+			   st_parameter[IOPARM_ptype_common].type,
+			   var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+  tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+			 var, p->field, NULL_TREE);
   gfc_add_modify (block, tmp, build_int_cst (TREE_TYPE (p->field), val));
   return p->mask;
 }
@@ -464,16 +465,18 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type,
       /* UNIT numbers should be greater than the min.  */
       i = gfc_validate_kind (BT_INTEGER, 4, false);
       val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].pedantic_min_int, 4);
-      cond = fold_build2 (LT_EXPR, boolean_type_node, se.expr,
-			  fold_convert (TREE_TYPE (se.expr), val));
+      cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+			      se.expr,
+			      fold_convert (TREE_TYPE (se.expr), val));
       gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT,
 			       "Unit number in I/O statement too small",
 			       &se.pre);
     
       /* UNIT numbers should be less than the max.  */
       val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4);
-      cond = fold_build2 (GT_EXPR, boolean_type_node, se.expr,
-			  fold_convert (TREE_TYPE (se.expr), val));
+      cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+			      se.expr,
+			      fold_convert (TREE_TYPE (se.expr), val));
       gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT,
 			       "Unit number in I/O statement too large",
 			       &se.pre);
@@ -484,10 +487,12 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type,
   gfc_add_block_to_block (block, &se.pre);
 
   if (p->param_type == IOPARM_ptype_common)
-    var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
-		       var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+    var = fold_build3_loc (input_location, COMPONENT_REF,
+			   st_parameter[IOPARM_ptype_common].type,
+			   var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
 
-  tmp = fold_build3 (COMPONENT_REF, dest_type, var, p->field, NULL_TREE);
+  tmp = fold_build3_loc (input_location, COMPONENT_REF, dest_type, var,
+			 p->field, NULL_TREE);
   gfc_add_modify (block, tmp, se.expr);
   return p->mask;
 }
@@ -542,10 +547,11 @@ set_parameter_ref (stmtblock_t *block, stmtblock_t *postblock,
      }
 
   if (p->param_type == IOPARM_ptype_common)
-    var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
-		       var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
-  tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
-		     var, p->field, NULL_TREE);
+    var = fold_build3_loc (input_location, COMPONENT_REF,
+			   st_parameter[IOPARM_ptype_common].type,
+			   var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+  tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+			 var, p->field, NULL_TREE);
   gfc_add_modify (block, tmp, addr);
   return p->mask;
 }
@@ -583,21 +589,26 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
 	{
 	  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
 	  size = gfc_conv_array_stride (array, rank);
-	  tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
-			     gfc_conv_array_ubound (array, rank),
-			     gfc_conv_array_lbound (array, rank));
-	  tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp,
-			     gfc_index_one_node);
-	  size = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp, size);
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type,
+				 gfc_conv_array_ubound (array, rank),
+				 gfc_conv_array_lbound (array, rank));
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, tmp,
+				 gfc_index_one_node);
+	  size = fold_build2_loc (input_location, MULT_EXPR,
+				  gfc_array_index_type, tmp, size);
 	}
       gcc_assert (size);
 
-      size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size,
-			  TREE_OPERAND (se->expr, 1));
+      size = fold_build2_loc (input_location, MINUS_EXPR,
+			      gfc_array_index_type, size,
+			      TREE_OPERAND (se->expr, 1));
       se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
       tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
-      size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
-			  fold_convert (gfc_array_index_type, tmp));
+      size = fold_build2_loc (input_location, MULT_EXPR,
+			      gfc_array_index_type, size,
+			      fold_convert (gfc_array_index_type, tmp));
       se->string_length = fold_convert (gfc_charlen_type_node, size);
       return;
     }
@@ -623,12 +634,14 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
   gfc_init_se (&se, NULL);
 
   if (p->param_type == IOPARM_ptype_common)
-    var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
-		       var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
-  io = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
+    var = fold_build3_loc (input_location, COMPONENT_REF,
+			   st_parameter[IOPARM_ptype_common].type,
+			   var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+  io = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
 		    var, p->field, NULL_TREE);
-  len = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field_len),
-		     var, p->field_len, NULL_TREE);
+  len = fold_build3_loc (input_location, COMPONENT_REF,
+			 TREE_TYPE (p->field_len),
+			 var, p->field_len, NULL_TREE);
 
   /* Integer variable assigned a format label.  */
   if (e->ts.type == BT_INTEGER
@@ -640,8 +653,8 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
 
       gfc_conv_label_variable (&se, e);
       tmp = GFC_DECL_STRING_LEN (se.expr);
-      cond = fold_build2 (LT_EXPR, boolean_type_node,
-			  tmp, build_int_cst (TREE_TYPE (tmp), 0));
+      cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+			      tmp, build_int_cst (TREE_TYPE (tmp), 0));
 
       asprintf(&msg, "Label assigned to variable '%s' (%%ld) is not a format "
 	       "label", e->symtree->name);
@@ -694,13 +707,13 @@ set_internal_unit (stmtblock_t * block, stmtblock_t * post_block,
 
   p = &st_parameter_field[IOPARM_dt_internal_unit];
   mask = p->mask;
-  io = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
-		    var, p->field, NULL_TREE);
-  len = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field_len),
-		     var, p->field_len,	NULL_TREE);
+  io = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+			var, p->field, NULL_TREE);
+  len = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field_len),
+			 var, p->field_len,	NULL_TREE);
   p = &st_parameter_field[IOPARM_dt_internal_unit_desc];
-  desc = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
-		      var, p->field, NULL_TREE);
+  desc = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+			  var, p->field, NULL_TREE);
 
   gcc_assert (e->ts.type == BT_CHARACTER);
 
@@ -809,13 +822,14 @@ io_result (stmtblock_t * block, tree var, gfc_st_label * err_label,
 
   tmp = gfc_finish_block (&body);
 
-  var = fold_build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
-		     var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
-  rc = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
-		    var, p->field, NULL_TREE);
-  rc = fold_build2 (BIT_AND_EXPR, TREE_TYPE (rc),
-		    rc, build_int_cst (TREE_TYPE (rc),
-				       IOPARM_common_libreturn_mask));
+  var = fold_build3_loc (input_location, COMPONENT_REF,
+			 st_parameter[IOPARM_ptype_common].type,
+			 var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+  rc = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+			var, p->field, NULL_TREE);
+  rc = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (rc),
+			rc, build_int_cst (TREE_TYPE (rc),
+					   IOPARM_common_libreturn_mask));
 
   tmp = build3_v (SWITCH_EXPR, rc, tmp, NULL_TREE);
 
@@ -834,11 +848,12 @@ set_error_locus (stmtblock_t * block, tree var, locus * where)
   int line;
   gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_filename];
 
-  locus_file = fold_build3 (COMPONENT_REF,
-			    st_parameter[IOPARM_ptype_common].type,
-			    var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
-  locus_file = fold_build3 (COMPONENT_REF, TREE_TYPE (p->field),
-			    locus_file, p->field, NULL_TREE);
+  locus_file = fold_build3_loc (input_location, COMPONENT_REF,
+				st_parameter[IOPARM_ptype_common].type,
+				var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+  locus_file = fold_build3_loc (input_location, COMPONENT_REF,
+				TREE_TYPE (p->field), locus_file,
+				p->field, NULL_TREE);
   f = where->lb->file;
   str = gfc_build_cstring_const (f->filename);
 
@@ -1448,8 +1463,8 @@ nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,
      the derived type.  */
 
   if (TREE_CODE (decl) == FIELD_DECL)
-    tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (tmp),
-		       base_addr, tmp, NULL_TREE);
+    tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
+			   base_addr, tmp, NULL_TREE);
 
   /* If we have a derived type component, a reference to the first
      element of the array is built.  This is done so that base_addr,
@@ -1786,13 +1801,15 @@ build_dt (tree function, gfc_code * code)
     {
       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));
+      tmp = fold_build3_loc (input_location, COMPONENT_REF,
+			     st_parameter[IOPARM_ptype_common].type,
+			     dt_parm, TYPE_FIELDS (TREE_TYPE (dt_parm)),
+			     NULL_TREE);
+      tmp = fold_build3_loc (input_location, COMPONENT_REF,
+			     TREE_TYPE (p->field), tmp, p->field, NULL_TREE);
+      tmp = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (tmp),
+			     tmp, build_int_cst (TREE_TYPE (tmp),
+			     IOPARM_common_libreturn_mask));
     }
   else /* IOLENGTH */
     tmp = NULL_TREE;