Skip to content

R
riscv-gcc-1
Commit 65a9ca82 by Tobias Burnus Committed by Tobias Burnus
Options

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
parent d7830142
Showing with 155 additions and 82 deletions
gcc/fortran/ChangeLog
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.
2010-09-03 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/45159
......
gcc/fortran/trans-intrinsic.c
......@@ -1306,8 +1306,10 @@ gfc_conv_intrinsic_sign (gfc_se * se, gfc_expr * expr)
zero = build_real_from_int_cst (TREE_TYPE (args[1]), integer_zero_node);
cond = fold_build2 (EQ_EXPR, boolean_type_node, args[1], zero);
se->expr = fold_build3 (COND_EXPR, TREE_TYPE (args[0]), cond,
build_call_expr (abs, 1, args[0]),
build_call_expr (tmp, 2, args[0], args[1]));
build_call_expr_loc (input_location, abs, 1,
args[0]),
build_call_expr_loc (input_location, tmp, 2,
args[0], args[1]));
}
else
se->expr = build_call_expr_loc (input_location, tmp, 2,
......@@ -3412,7 +3414,8 @@ gfc_conv_intrinsic_leadz (gfc_se * se, gfc_expr * expr)
/* Compute LEADZ for the case i .ne. 0. */
s = TYPE_PRECISION (arg_type) - argsize;
tmp = fold_convert (result_type, build_call_expr (func, 1, arg));
tmp = fold_convert (result_type, build_call_expr_loc (input_location, func,
1, arg));
leadz = fold_build2 (MINUS_EXPR, result_type,
tmp, build_int_cst (result_type, s));
......
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 = 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, TREE_TYPE (p->field), var, p->field,
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,7 +465,8 @@ 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,
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",
......@@ -472,7 +474,8 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type,
/* 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,
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",
......@@ -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 = 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,9 +547,10 @@ 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 = 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, TREE_TYPE (p->field),
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,20 +589,25 @@ 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,
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 (PLUS_EXPR, gfc_array_index_type, tmp,
tmp = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, tmp,
gfc_index_one_node);
size = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp, size);
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,
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,
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,11 +634,13 @@ 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 = fold_build3_loc (input_location, 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),
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),
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. */
......@@ -640,7 +653,7 @@ 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,
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 "
......@@ -694,12 +707,12 @@ 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),
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),
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),
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,11 +822,12 @@ 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 = fold_build3_loc (input_location, 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),
rc = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
var, p->field, NULL_TREE);
rc = fold_build2 (BIT_AND_EXPR, TREE_TYPE (rc),
rc = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (rc),
rc, build_int_cst (TREE_TYPE (rc),
IOPARM_common_libreturn_mask));
......@@ -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,
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 (COMPONENT_REF, TREE_TYPE (p->field),
locus_file, p->field, 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,7 +1463,7 @@ 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),
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
......@@ -1786,11 +1801,13 @@ 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 = 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));
}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment