From 260abd713cecaf15b4c8803e4b609a66c6d10656 Mon Sep 17 00:00:00 2001 From: steven Date: Tue, 29 Jun 2004 22:01:35 +0000 Subject: [PATCH] 2004-06-29 Steven Bosscher Make sure types in assignments are compatible. Mostly mechanical. * trans-const.h (gfc_index_one_node): New define. * trans-array.c (gfc_trans_allocate_array_storage, gfc_trans_allocate_temp_array, gfc_trans_array_constructor_subarray, gfc_trans_array_constructor_value, gfc_trans_array_constructor, gfc_conv_array_ubound, gfc_conv_array_ref, gfc_trans_scalarized_loop_end, gfc_conv_section_startstride, gfc_conv_ss_startstride, gfc_conv_loop_setup, gfc_array_init_size, gfc_trans_array_bounds, gfc_trans_dummy_array_bias, gfc_conv_expr_descriptor, gfc_trans_deferred_array): Use the correct types in assignments, conversions and conditionals for expressions. * trans-expr.c (gfc_conv_expr_present, gfc_conv_substring, gfc_conv_unary_op, gfc_conv_cst_int_power, gfc_conv_string_tmp, gfc_conv_function_call, gfc_trans_pointer_assignment, gfc_trans_scalar_assign): Likewise. * trans-intrinsic.c (build_fixbound_expr, gfc_conv_intrinsic_bound, gfc_conv_intrinsic_anyall, gfc_conv_intrinsic_count, gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_btest, gfc_conv_intrinsic_singlebitop, gfc_conv_intrinsic_ishft, gfc_conv_intrinsic_ishftc, gfc_conv_intrinsic_strcmp, gfc_conv_allocated, gfc_conv_associated, gfc_conv_intrinsic_rrspacing, gfc_conv_intrinsic_trim): Likewise. * trans-io.c (set_string): Likewise. * trans-stmt.c (gfc_trans_do, gfc_trans_forall_loop, gfc_do_allocate, generate_loop_for_temp_to_lhs, generate_loop_for_rhs_to_temp, compute_inner_temp_size, compute_overall_iter_number, gfc_trans_assign_need_temp, gfc_trans_pointer_assign_need_temp, gfc_trans_forall_1, gfc_evaluate_where_mask, gfc_trans_where_assign, gfc_trans_where_2): Likewise. * trans-types.c (gfc_get_character_type, gfc_build_array_type, gfc_get_nodesc_array_type, gfc_get_array_type_bounds): Likewise. * trans.c (gfc_add_modify_expr): Add sanity check that types for the lhs and rhs are the same for scalar assignments. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@83877 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 38 +++++++++++++ gcc/fortran/trans-array.c | 115 +++++++++++++++++++------------------ gcc/fortran/trans-const.h | 2 + gcc/fortran/trans-expr.c | 63 ++++++++++++--------- gcc/fortran/trans-intrinsic.c | 55 +++++++++++------- gcc/fortran/trans-io.c | 13 +++-- gcc/fortran/trans-stmt.c | 128 +++++++++++++++++++++--------------------- gcc/fortran/trans-types.c | 16 +++--- gcc/fortran/trans.c | 10 ++++ 9 files changed, 264 insertions(+), 176 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 005d183d45e..135d8cfa8ca 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,41 @@ +2004-06-29 Steven Bosscher + + Make sure types in assignments are compatible. Mostly mechanical. + * trans-const.h (gfc_index_one_node): New define. + * trans-array.c (gfc_trans_allocate_array_storage, + gfc_trans_allocate_temp_array, gfc_trans_array_constructor_subarray, + gfc_trans_array_constructor_value, gfc_trans_array_constructor, + gfc_conv_array_ubound, gfc_conv_array_ref, + gfc_trans_scalarized_loop_end, gfc_conv_section_startstride, + gfc_conv_ss_startstride, gfc_conv_loop_setup, gfc_array_init_size, + gfc_trans_array_bounds, gfc_trans_dummy_array_bias, + gfc_conv_expr_descriptor, gfc_trans_deferred_array): Use the correct + types in assignments, conversions and conditionals for expressions. + * trans-expr.c (gfc_conv_expr_present, gfc_conv_substring, + gfc_conv_unary_op, gfc_conv_cst_int_power, gfc_conv_string_tmp, + gfc_conv_function_call, gfc_trans_pointer_assignment, + gfc_trans_scalar_assign): Likewise. + * trans-intrinsic.c (build_fixbound_expr, gfc_conv_intrinsic_bound, + gfc_conv_intrinsic_anyall, gfc_conv_intrinsic_count, + gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_btest, + gfc_conv_intrinsic_singlebitop, gfc_conv_intrinsic_ishft, + gfc_conv_intrinsic_ishftc, gfc_conv_intrinsic_strcmp, + gfc_conv_allocated, gfc_conv_associated, + gfc_conv_intrinsic_rrspacing, gfc_conv_intrinsic_trim): Likewise. + * trans-io.c (set_string): Likewise. + * trans-stmt.c (gfc_trans_do, gfc_trans_forall_loop, + gfc_do_allocate, generate_loop_for_temp_to_lhs, + generate_loop_for_rhs_to_temp, compute_inner_temp_size, + compute_overall_iter_number, gfc_trans_assign_need_temp, + gfc_trans_pointer_assign_need_temp, gfc_trans_forall_1, + gfc_evaluate_where_mask, gfc_trans_where_assign, + gfc_trans_where_2): Likewise. + * trans-types.c (gfc_get_character_type, gfc_build_array_type, + gfc_get_nodesc_array_type, gfc_get_array_type_bounds): Likewise. + + * trans.c (gfc_add_modify_expr): Add sanity check that types + for the lhs and rhs are the same for scalar assignments. + 2004-06-29 Tobias Schlueter * dump-parse-tree.c (show_common): New function. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index bccaf414895..731fb193099 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -443,7 +443,7 @@ gfc_trans_allocate_array_storage (gfc_loopinfo * loop, gfc_ss_info * info, /* Make a temporary variable to hold the data. */ tmp = fold (build (MINUS_EXPR, TREE_TYPE (nelem), nelem, integer_one_node)); - tmp = build_range_type (gfc_array_index_type, integer_zero_node, tmp); + tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp); tmp = build_array_type (gfc_get_element_type (TREE_TYPE (desc)), tmp); tmp = gfc_create_var (tmp, "A"); tmp = gfc_build_addr_expr (TREE_TYPE (data), tmp); @@ -515,12 +515,12 @@ gfc_trans_allocate_temp_array (gfc_loopinfo * loop, gfc_ss_info * info, { loop->to[n] = fold (build (MINUS_EXPR, gfc_array_index_type, loop->to[n], loop->from[n])); - loop->from[n] = integer_zero_node; + loop->from[n] = gfc_index_zero_node; } - info->delta[dim] = integer_zero_node; - info->start[dim] = integer_zero_node; - info->stride[dim] = integer_one_node; + info->delta[dim] = gfc_index_zero_node; + info->start[dim] = gfc_index_zero_node; + info->stride[dim] = gfc_index_one_node; info->dim[dim] = dim; } @@ -531,22 +531,26 @@ gfc_trans_allocate_temp_array (gfc_loopinfo * loop, gfc_ss_info * info, GFC_DECL_PACKED_ARRAY (desc) = 1; info->descriptor = desc; - size = integer_one_node; + size = gfc_index_one_node; /* Fill in the array dtype. */ tmp = gfc_conv_descriptor_dtype (desc); gfc_add_modify_expr (&loop->pre, tmp, GFC_TYPE_ARRAY_DTYPE (TREE_TYPE (desc))); - /* Fill in the bounds and stride. This is a packed array, so: + /* + Fill in the bounds and stride. This is a packed array, so: + size = 1; for (n = 0; n < rank; n++) - { - stride[n] = size - delta = ubound[n] + 1 - lbound[n]; - size = size * delta; - } - size = size * sizeof(element); */ + { + stride[n] = size + delta = ubound[n] + 1 - lbound[n]; + size = size * delta; + } + size = size * sizeof(element); + */ + for (n = 0; n < info->dimen; n++) { /* Store the stride and bound components in the descriptor. */ @@ -554,13 +558,13 @@ gfc_trans_allocate_temp_array (gfc_loopinfo * loop, gfc_ss_info * info, gfc_add_modify_expr (&loop->pre, tmp, size); tmp = gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n]); - gfc_add_modify_expr (&loop->pre, tmp, integer_zero_node); + gfc_add_modify_expr (&loop->pre, tmp, gfc_index_zero_node); tmp = gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]); gfc_add_modify_expr (&loop->pre, tmp, loop->to[n]); tmp = fold (build (PLUS_EXPR, gfc_array_index_type, - loop->to[n], integer_one_node)); + loop->to[n], gfc_index_one_node)); size = fold (build (MULT_EXPR, gfc_array_index_type, size, tmp)); size = gfc_evaluate_now (size, &loop->pre); @@ -645,7 +649,7 @@ gfc_trans_array_constructor_subarray (stmtblock_t * pblock, gfc_add_modify_expr (&body, tmp, se.expr); /* Increment the offset. */ - tmp = build (PLUS_EXPR, gfc_array_index_type, *poffset, integer_one_node); + tmp = build (PLUS_EXPR, gfc_array_index_type, *poffset, gfc_index_one_node); gfc_add_modify_expr (&body, *poffset, tmp); /* Finish the loop. */ @@ -716,11 +720,12 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, ref = gfc_build_indirect_ref (pointer); ref = gfc_build_array_ref (ref, *poffset); - gfc_add_modify_expr (&body, ref, se.expr); + gfc_add_modify_expr (&body, ref, + fold_convert (TREE_TYPE (ref), se.expr)); gfc_add_block_to_block (&body, &se.post); *poffset = fold (build (PLUS_EXPR, gfc_array_index_type, - *poffset, integer_one_node)); + *poffset, gfc_index_one_node)); } else { @@ -746,7 +751,7 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, bound = build_int_2 (n - 1, 0); /* Create an array type to hold them. */ tmptype = build_range_type (gfc_array_index_type, - integer_zero_node, bound); + gfc_index_zero_node, bound); tmptype = build_array_type (type, tmptype); init = build1 (CONSTRUCTOR, tmptype, nreverse (list)); @@ -942,7 +947,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss) gfc_trans_allocate_temp_array (loop, &ss->data.info, type, NULL_TREE); desc = ss->data.info.descriptor; - offset = integer_zero_node; + offset = gfc_index_zero_node; offsetvar = gfc_create_var_np (gfc_array_index_type, "offset"); TREE_USED (offsetvar) = 0; gfc_trans_array_constructor_value (&loop->pre, type, @@ -1214,7 +1219,7 @@ gfc_conv_array_ubound (tree descriptor, int dim) /* This should only ever happen when passing an assumed shape array as an actual parameter. The value will never be used. */ if (GFC_ARRAY_TYPE_P (TREE_TYPE (descriptor))) - return integer_zero_node; + return gfc_index_zero_node; tmp = gfc_conv_descriptor_ubound (descriptor, gfc_rank_cst[dim]); return tmp; @@ -1466,9 +1471,9 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar) return; } - index = integer_zero_node; + index = gfc_index_zero_node; - fault = integer_zero_node; + fault = gfc_index_zero_node; /* Calculate the offsets from all the dimensions. */ for (n = 0; n < ar->dimen; n++) @@ -1687,7 +1692,7 @@ gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n, /* Increment the loopvar. */ tmp = build (PLUS_EXPR, gfc_array_index_type, - loop->loopvar[n], integer_one_node); + loop->loopvar[n], gfc_index_one_node); gfc_add_modify_expr (&block, loop->loopvar[n], tmp); /* Build the loop. */ @@ -1885,7 +1890,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int n) /* Calculate the stride. */ if (stride == NULL) - info->stride[n] = integer_one_node; + info->stride[n] = gfc_index_one_node; else { gfc_init_se (&se, NULL); @@ -1948,8 +1953,8 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) case GFC_SS_FUNCTION: for (n = 0; n < ss->data.info.dimen; n++) { - ss->data.info.start[n] = integer_zero_node; - ss->data.info.stride[n] = integer_one_node; + ss->data.info.start[n] = gfc_index_zero_node; + ss->data.info.stride[n] = gfc_index_one_node; } break; @@ -2322,7 +2327,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop) /* Transform everything so we have a simple incrementing variable. */ if (integer_onep (info->stride[n])) - info->delta[n] = integer_zero_node; + info->delta[n] = gfc_index_zero_node; else { /* Set the delta for this section. */ @@ -2337,7 +2342,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop) info->stride[n])); loop->to[n] = gfc_evaluate_now (tmp, &loop->pre); /* Make the loop variable start at 0. */ - loop->from[n] = integer_zero_node; + loop->from[n] = gfc_index_zero_node; } } @@ -2435,8 +2440,8 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset, type = TREE_TYPE (descriptor); - stride = integer_one_node; - offset = integer_zero_node; + stride = gfc_index_one_node; + offset = gfc_index_zero_node; /* Set the dtype. */ tmp = gfc_conv_descriptor_dtype (descriptor); @@ -2454,7 +2459,7 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset, /* Set lower bound. */ gfc_init_se (&se, NULL); if (lower == NULL) - se.expr = integer_one_node; + se.expr = gfc_index_one_node; else { assert (lower[n]); @@ -2465,7 +2470,7 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset, } else { - se.expr = integer_one_node; + se.expr = gfc_index_one_node; ubound = lower[n]; } } @@ -2478,7 +2483,7 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset, /* Start the calculation for the size of this dimension. */ size = build (MINUS_EXPR, gfc_array_index_type, - integer_one_node, se.expr); + gfc_index_one_node, se.expr); /* Set upper bound. */ gfc_init_se (&se, NULL); @@ -2754,8 +2759,8 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset, as = sym->as; - size = integer_one_node; - offset = integer_zero_node; + size = gfc_index_one_node; + offset = gfc_index_zero_node; for (dim = 0; dim < as->rank; dim++) { /* Evaluate non-constant array bound expressions. */ @@ -2789,7 +2794,7 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset, { /* Calculate stride = size * (ubound + 1 - lbound). */ tmp = fold (build (MINUS_EXPR, gfc_array_index_type, - integer_one_node, lbound)); + gfc_index_one_node, lbound)); tmp = fold (build (PLUS_EXPR, gfc_array_index_type, ubound, tmp)); tmp = fold (build (MULT_EXPR, gfc_array_index_type, size, tmp)); if (stride) @@ -3062,7 +3067,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) tmp = build (EQ_EXPR, boolean_type_node, stride, integer_zero_node); tmp = build (COND_EXPR, gfc_array_index_type, tmp, - integer_one_node, stride); + gfc_index_one_node, stride); stride = GFC_TYPE_ARRAY_STRIDE (type, 0); gfc_add_modify_expr (&block, stride, tmp); @@ -3077,7 +3082,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) tmp = gfc_chainon_list (NULL_TREE, tmp); stmt_unpacked = gfc_build_function_call (gfor_fndecl_in_pack, tmp); - stride = integer_one_node; + stride = gfc_index_one_node; } /* This is for the case where the array data is used directly without @@ -3096,10 +3101,10 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) } else tmp = stmt_packed != NULL_TREE ? stmt_packed : stmt_unpacked; - gfc_add_modify_expr (&block, tmpdesc, tmp); + gfc_add_modify_expr (&block, tmpdesc, fold_convert (type, tmp)); - offset = integer_zero_node; - size = integer_one_node; + offset = gfc_index_zero_node; + size = gfc_index_one_node; /* Evaluate the bounds of the array. */ for (n = 0; n < sym->as->rank; n++) @@ -3185,7 +3190,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) { /* Calculate stride = size * (ubound + 1 - lbound). */ tmp = fold (build (MINUS_EXPR, gfc_array_index_type, - integer_one_node, lbound)); + gfc_index_one_node, lbound)); tmp = fold (build (PLUS_EXPR, gfc_array_index_type, ubound, tmp)); size = fold (build (MULT_EXPR, gfc_array_index_type, @@ -3266,8 +3271,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) } -/* Convert an array for passing as an actual parameter. Expressions - and vector subscripts are evaluated and stored in a teporary, which is then +/* Convert an array for passing as an actual parameter. Expressions and + vector subscripts are evaluated and stored in a temporary, which is then passed. For whole arrays the descriptor is passed. For array sections a modified copy of the descriptor is passed, but using the original data. Also used for array pointer assignments by setting se->direct_byref. */ @@ -3435,7 +3440,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) /* Set the first stride component to zero to indicate a temporary. */ desc = loop.temp_ss->data.info.descriptor; tmp = gfc_conv_descriptor_stride (desc, gfc_rank_cst[0]); - gfc_add_modify_expr (&loop.pre, tmp, integer_zero_node); + gfc_add_modify_expr (&loop.pre, tmp, gfc_index_zero_node); assert (is_gimple_lvalue (desc)); se->expr = gfc_build_addr_expr (NULL, desc); @@ -3473,7 +3478,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) parm = gfc_create_var (parmtype, "parm"); } - offset = integer_zero_node; + offset = gfc_index_zero_node; dim = 0; /* The following can be somewhat confusing. We have two @@ -3490,7 +3495,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) gfc_add_modify_expr (&loop.pre, tmp, GFC_TYPE_ARRAY_DTYPE (parmtype)); if (se->direct_byref) - base = integer_zero_node; + base = gfc_index_zero_node; else base = NULL_TREE; @@ -3536,10 +3541,10 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) if (!integer_onep (from)) { /* Make sure the new section starts at 1. */ - tmp = fold (build (MINUS_EXPR, TREE_TYPE (from), - integer_one_node, from)); - to = fold (build (PLUS_EXPR, TREE_TYPE (to), to, tmp)); - from = integer_one_node; + tmp = fold (build (MINUS_EXPR, gfc_array_index_type, + gfc_index_one_node, from)); + to = fold (build (PLUS_EXPR, gfc_array_index_type, to, tmp)); + from = gfc_index_one_node; } tmp = gfc_conv_descriptor_lbound (parm, gfc_rank_cst[dim]); gfc_add_modify_expr (&loop.pre, tmp, from); @@ -3573,7 +3578,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) offset = gfc_build_addr_expr (gfc_array_dataptr_type (desc), tmp); tmp = gfc_conv_descriptor_data (parm); - gfc_add_modify_expr (&loop.pre, tmp, offset); + gfc_add_modify_expr (&loop.pre, tmp, + fold_convert (TREE_TYPE (tmp), offset)); if (se->direct_byref) { @@ -3737,7 +3743,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body) /* NULLIFY the data pointer. */ tmp = gfc_conv_descriptor_data (descriptor); - gfc_add_modify_expr (&fnblock, tmp, integer_zero_node); + gfc_add_modify_expr (&fnblock, tmp, + convert (TREE_TYPE (tmp), integer_zero_node)); gfc_add_expr_to_block (&fnblock, body); diff --git a/gcc/fortran/trans-const.h b/gcc/fortran/trans-const.h index 91b3e84a424..97e831346fe 100644 --- a/gcc/fortran/trans-const.h +++ b/gcc/fortran/trans-const.h @@ -56,4 +56,6 @@ extern GTY(()) tree gfc_strconst_wrong_return; /* Integer constants 0..GFC_MAX_DIMENSIONS. */ extern GTY(()) tree gfc_rank_cst[GFC_MAX_DIMENSIONS + 1]; + #define gfc_index_zero_node gfc_rank_cst[0] +#define gfc_index_one_node gfc_rank_cst[1] diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 717a5d83bb3..47a844d92d2 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -135,7 +135,8 @@ gfc_conv_expr_present (gfc_symbol * sym) || GFC_ARRAY_TYPE_P (TREE_TYPE (decl))); decl = GFC_DECL_SAVED_DESCRIPTOR (decl); } - return build (NE_EXPR, boolean_type_node, decl, null_pointer_node); + return build (NE_EXPR, boolean_type_node, decl, + fold_convert (TREE_TYPE (decl), null_pointer_node)); } @@ -174,9 +175,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind) gfc_add_block_to_block (&se->pre, &start.pre); if (integer_onep (start.expr)) - { - gfc_conv_string_parameter (se); - } + gfc_conv_string_parameter (se); else { /* Change the start of the string. */ @@ -198,7 +197,9 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind) gfc_add_block_to_block (&se->pre, &end.pre); } tmp = - build (MINUS_EXPR, gfc_strlen_type_node, integer_one_node, start.expr); + build (MINUS_EXPR, gfc_strlen_type_node, + fold_convert (gfc_strlen_type_node, integer_one_node), + start.expr); tmp = build (PLUS_EXPR, gfc_strlen_type_node, end.expr, tmp); se->string_length = fold (tmp); } @@ -376,7 +377,8 @@ gfc_conv_unary_op (enum tree_code code, gfc_se * se, gfc_expr * expr) We must convert it to a compare to 0 (e.g. EQ_EXPR (op1, 0)). All other unary operators have an equivalent GIMPLE unary operator */ if (code == TRUTH_NOT_EXPR) - se->expr = build (EQ_EXPR, type, operand.expr, integer_zero_node); + se->expr = build (EQ_EXPR, type, operand.expr, + convert (type, integer_zero_node)); else se->expr = build1 (code, type, operand.expr); @@ -502,24 +504,27 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs) if ((sgn == -1) && (TREE_CODE (type) == INTEGER_TYPE)) { tmp = build (EQ_EXPR, boolean_type_node, lhs, - integer_minus_one_node); + fold_convert (TREE_TYPE (lhs), integer_minus_one_node)); cond = build (EQ_EXPR, boolean_type_node, lhs, - integer_one_node); + convert (TREE_TYPE (lhs), integer_one_node)); /* If rhs is an even, - result = (lhs == 1 || lhs == -1) ? 1 : 0. */ + result = (lhs == 1 || lhs == -1) ? 1 : 0. */ if ((n & 1) == 0) { tmp = build (TRUTH_OR_EXPR, boolean_type_node, tmp, cond); - se->expr = build (COND_EXPR, type, tmp, integer_one_node, - integer_zero_node); + se->expr = build (COND_EXPR, type, tmp, + convert (type, integer_one_node), + convert (type, integer_zero_node)); return 1; } /* If rhs is an odd, result = (lhs == 1) ? 1 : (lhs == -1) ? -1 : 0. */ - tmp = build (COND_EXPR, type, tmp, integer_minus_one_node, - integer_zero_node); - se->expr = build (COND_EXPR, type, cond, integer_one_node, + tmp = build (COND_EXPR, type, tmp, + convert (type, integer_minus_one_node), + convert (type, integer_zero_node)); + se->expr = build (COND_EXPR, type, cond, + convert (type, integer_one_node), tmp); return 1; } @@ -675,11 +680,16 @@ gfc_conv_string_tmp (gfc_se * se, tree type, tree len) tree tmp; tree args; + if (TREE_TYPE (len) != gfc_strlen_type_node) + abort (); + if (gfc_can_put_var_on_stack (len)) { /* Create a temporary variable to hold the result. */ - tmp = fold (build (MINUS_EXPR, TREE_TYPE (len), len, integer_one_node)); - tmp = build_range_type (gfc_array_index_type, integer_zero_node, tmp); + tmp = fold (build (MINUS_EXPR, gfc_strlen_type_node, len, + convert (gfc_strlen_type_node, + integer_one_node))); + tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp); tmp = build_array_type (gfc_character1_type_node, tmp); var = gfc_create_var (tmp, "str"); var = gfc_build_addr_expr (type, var); @@ -1030,7 +1040,8 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, /* Zero the first stride to indicate a temporary. */ tmp = gfc_conv_descriptor_stride (info->descriptor, gfc_rank_cst[0]); - gfc_add_modify_expr (&se->pre, tmp, integer_zero_node); + gfc_add_modify_expr (&se->pre, tmp, + convert (TREE_TYPE (tmp), integer_zero_node)); /* Pass the temporary as the first argument. */ tmp = info->descriptor; tmp = gfc_build_addr_expr (NULL, tmp); @@ -1080,8 +1091,10 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, parmse.expr = null_pointer_node; if (arg->missing_arg_type == BT_CHARACTER) { - stringargs = gfc_chainon_list (stringargs, - convert (gfc_strlen_type_node, integer_zero_node)); + stringargs = + gfc_chainon_list (stringargs, + convert (gfc_strlen_type_node, + integer_zero_node)); } } } @@ -1589,7 +1602,6 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gfc_ss *lss; gfc_ss *rss; stmtblock_t block; - tree tmp; gfc_start_block (&block); @@ -1607,7 +1619,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) gfc_conv_expr (&rse, expr2); gfc_add_block_to_block (&block, &lse.pre); gfc_add_block_to_block (&block, &rse.pre); - gfc_add_modify_expr (&block, lse.expr, rse.expr); + gfc_add_modify_expr (&block, lse.expr, + fold_convert (TREE_TYPE (lse.expr), rse.expr)); gfc_add_block_to_block (&block, &rse.post); gfc_add_block_to_block (&block, &lse.post); } @@ -1618,9 +1631,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) if (expr2->expr_type == EXPR_NULL) { lse.expr = gfc_conv_descriptor_data (lse.expr); - rse.expr = null_pointer_node; - tmp = build_v (MODIFY_EXPR, lse.expr, rse.expr); - gfc_add_expr_to_block (&block, tmp); + rse.expr = fold_convert (TREE_TYPE (lse.expr), null_pointer_node); + gfc_add_modify_expr (&block, lse.expr, rse.expr); } else { @@ -1690,7 +1702,8 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, bt type) gfc_add_block_to_block (&block, &lse->pre); gfc_add_block_to_block (&block, &rse->pre); - gfc_add_modify_expr (&block, lse->expr, rse->expr); + gfc_add_modify_expr (&block, lse->expr, + fold_convert (TREE_TYPE (lse->expr), rse->expr)); } gfc_add_block_to_block (&block, &lse->post); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 0c12353f240..37a6a05761e 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -228,7 +228,8 @@ build_fixbound_expr (stmtblock_t * pblock, tree arg, tree type, int up) tmp = convert (argtype, intval); cond = build (up ? GE_EXPR : LE_EXPR, boolean_type_node, tmp, arg); - tmp = build (up ? PLUS_EXPR : MINUS_EXPR, type, intval, integer_one_node); + tmp = build (up ? PLUS_EXPR : MINUS_EXPR, type, intval, + convert (type, integer_one_node)); tmp = build (COND_EXPR, type, cond, intval, tmp); return tmp; } @@ -651,7 +652,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) bound = argse.expr; /* Convert from one based to zero based. */ bound = fold (build (MINUS_EXPR, gfc_array_index_type, bound, - integer_one_node)); + gfc_index_one_node)); } /* TODO: don't re-evaluate the descriptor on each iteration. */ @@ -677,7 +678,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) { bound = gfc_evaluate_now (bound, &se->pre); cond = fold (build (LT_EXPR, boolean_type_node, bound, - integer_zero_node)); + convert (TREE_TYPE (bound), integer_zero_node))); tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))]; tmp = fold (build (GE_EXPR, boolean_type_node, bound, tmp)); cond = fold(build (TRUTH_ORIF_EXPR, boolean_type_node, cond, tmp)); @@ -1172,7 +1173,9 @@ gfc_conv_intrinsic_anyall (gfc_se * se, gfc_expr * expr, int op) gfc_conv_expr_val (&arrayse, actual->expr); gfc_add_block_to_block (&body, &arrayse.pre); - tmp = build (op, boolean_type_node, arrayse.expr, integer_zero_node); + tmp = build (op, boolean_type_node, arrayse.expr, + fold_convert (TREE_TYPE (arrayse.expr), + integer_zero_node)); tmp = build_v (COND_EXPR, tmp, found, build_empty_stmt ()); gfc_add_expr_to_block (&body, tmp); gfc_add_block_to_block (&body, &arrayse.post); @@ -1214,7 +1217,7 @@ gfc_conv_intrinsic_count (gfc_se * se, gfc_expr * expr) type = gfc_typenode_for_spec (&expr->ts); /* Initialize the result. */ resvar = gfc_create_var (type, "count"); - gfc_add_modify_expr (&se->pre, resvar, integer_zero_node); + gfc_add_modify_expr (&se->pre, resvar, convert (type, integer_zero_node)); /* Walk the arguments. */ arrayss = gfc_walk_expr (actual->expr); @@ -1232,7 +1235,8 @@ gfc_conv_intrinsic_count (gfc_se * se, gfc_expr * expr) /* Generate the loop body. */ gfc_start_scalarized_body (&loop, &body); - tmp = build (PLUS_EXPR, TREE_TYPE (resvar), resvar, integer_one_node); + tmp = build (PLUS_EXPR, TREE_TYPE (resvar), resvar, + convert (TREE_TYPE (resvar), integer_one_node)); tmp = build_v (MODIFY_EXPR, resvar, tmp); gfc_init_se (&arrayse, NULL); @@ -1453,7 +1457,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op) array, in case all elements are equal to the limit. ie. pos = (ubound >= lbound) ? lbound, lbound - 1; */ tmp = fold (build (MINUS_EXPR, gfc_array_index_type, - loop.from[0], integer_one_node)); + loop.from[0], gfc_index_one_node)); cond = fold (build (GE_EXPR, boolean_type_node, loop.to[0], loop.from[0])); tmp = fold (build (COND_EXPR, gfc_array_index_type, cond, @@ -1522,7 +1526,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op) /* Return a value in the range 1..SIZE(array). */ tmp = fold (build (MINUS_EXPR, gfc_array_index_type, loop.from[0], - integer_one_node)); + gfc_index_one_node)); tmp = fold (build (MINUS_EXPR, gfc_array_index_type, pos, tmp)); /* And convert to the required type. */ se->expr = convert (type, tmp); @@ -1670,9 +1674,10 @@ gfc_conv_intrinsic_btest (gfc_se * se, gfc_expr * expr) arg = TREE_VALUE (arg); type = TREE_TYPE (arg); - tmp = build (LSHIFT_EXPR, type, integer_one_node, arg2); + tmp = build (LSHIFT_EXPR, type, convert (type, integer_one_node), arg2); tmp = build (BIT_AND_EXPR, type, arg, tmp); - tmp = fold (build (NE_EXPR, boolean_type_node, tmp, integer_zero_node)); + tmp = fold (build (NE_EXPR, boolean_type_node, tmp, + convert (type, integer_zero_node))); type = gfc_typenode_for_spec (&expr->ts); se->expr = convert (type, tmp); } @@ -1720,7 +1725,8 @@ gfc_conv_intrinsic_singlebitop (gfc_se * se, gfc_expr * expr, int set) arg = TREE_VALUE (arg); type = TREE_TYPE (arg); - tmp = fold (build (LSHIFT_EXPR, type, integer_one_node, arg2)); + tmp = fold (build (LSHIFT_EXPR, type, + convert (type, integer_one_node), arg2)); if (set) op = BIT_IOR_EXPR; else @@ -1783,11 +1789,13 @@ gfc_conv_intrinsic_ishft (gfc_se * se, gfc_expr * expr) tmp = build1 (NEGATE_EXPR, TREE_TYPE (arg2), arg2); rshift = build (RSHIFT_EXPR, type, arg, tmp); - tmp = build (GT_EXPR, boolean_type_node, arg2, integer_zero_node); + tmp = build (GT_EXPR, boolean_type_node, arg2, + convert (TREE_TYPE (arg2), integer_zero_node)); rshift = build (COND_EXPR, type, tmp, lshift, rshift); /* Do nothing if shift == 0. */ - tmp = build (EQ_EXPR, boolean_type_node, arg2, integer_zero_node); + tmp = build (EQ_EXPR, boolean_type_node, arg2, + convert (TREE_TYPE (arg2), integer_zero_node)); se->expr = build (COND_EXPR, type, tmp, arg, rshift); } @@ -1843,11 +1851,13 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr) tmp = build1 (NEGATE_EXPR, TREE_TYPE (arg2), arg2); rrot = build (RROTATE_EXPR, type, arg, tmp); - tmp = build (GT_EXPR, boolean_type_node, arg2, integer_zero_node); + tmp = build (GT_EXPR, boolean_type_node, arg2, + convert (TREE_TYPE (arg2), integer_zero_node)); rrot = build (COND_EXPR, type, tmp, lrot, rrot); /* Do nothing if shift == 0. */ - tmp = build (EQ_EXPR, boolean_type_node, arg2, integer_zero_node); + tmp = build (EQ_EXPR, boolean_type_node, arg2, + convert (TREE_TYPE (arg2), integer_zero_node)); se->expr = build (COND_EXPR, type, tmp, arg, rrot); } @@ -2040,7 +2050,8 @@ gfc_conv_intrinsic_strcmp (gfc_se * se, gfc_expr * expr, int op) se->expr = gfc_build_function_call (gfor_fndecl_compare_string, args); type = gfc_typenode_for_spec (&expr->ts); - se->expr = build (op, type, se->expr, integer_zero_node); + se->expr = build (op, type, se->expr, + convert (TREE_TYPE (se->expr), integer_zero_node)); } /* Generate a call to the adjustl/adjustr library function. */ @@ -2130,7 +2141,8 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr) gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1); tmp = gfc_conv_descriptor_data (arg1se.expr); - tmp = build (NE_EXPR, boolean_type_node, tmp, null_pointer_node); + tmp = build (NE_EXPR, boolean_type_node, tmp, + fold_convert (TREE_TYPE (tmp), null_pointer_node)); se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp); } @@ -2176,7 +2188,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) gfc_conv_expr_lhs (&arg1se, arg1->expr); tmp2 = gfc_conv_descriptor_data (arg1se.expr); } - tmp = build (NE_EXPR, boolean_type_node, tmp2, null_pointer_node); + tmp = build (NE_EXPR, boolean_type_node, tmp2, + fold_convert (TREE_TYPE (tmp2), null_pointer_node)); se->expr = tmp; } else @@ -2450,7 +2463,8 @@ gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr) cond2 = build (EQ_EXPR, boolean_type_node, rcs.frac, zero); cond = build (TRUTH_ANDIF_EXPR, boolean_type_node, cond, cond2); - tmp = build (COND_EXPR, masktype, cond, integer_zero_node, tmp); + tmp = build (COND_EXPR, masktype, cond, + convert (masktype, integer_zero_node), tmp); tmp = build1 (VIEW_CONVERT_EXPR, rcs.type, tmp); se->expr = tmp; @@ -2527,7 +2541,8 @@ gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr) gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary afterwards, if necessary. */ - cond = build (GT_EXPR, boolean_type_node, len, integer_zero_node); + cond = build (GT_EXPR, boolean_type_node, len, + convert (TREE_TYPE (len), integer_zero_node)); arglist = gfc_chainon_list (NULL_TREE, var); tmp = gfc_build_function_call (gfor_fndecl_internal_free, arglist); tmp = build_v (COND_EXPR, cond, tmp, build_empty_stmt ()); diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index f3aa37d28d8..9c4acc5e035 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -404,13 +404,14 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, len = build (COMPONENT_REF, TREE_TYPE (var_len), ioparm_var, var_len, NULL_TREE); - /* Integer variable assigned a format label. */ + /* Integer variable assigned a format label. */ if (e->ts.type == BT_INTEGER && e->symtree->n.sym->attr.assign == 1) { msg = gfc_build_string_const (37, "Assigned label is not a format label"); tmp = GFC_DECL_STRING_LEN (se.expr); - tmp = build (LE_EXPR, boolean_type_node, tmp, integer_minus_one_node); + tmp = build (LE_EXPR, boolean_type_node, + tmp, convert (TREE_TYPE (tmp), integer_minus_one_node)); gfc_trans_runtime_check (tmp, msg, &se.pre); gfc_add_modify_expr (&se.pre, io, GFC_DECL_ASSIGN_ADDR (se.expr)); gfc_add_modify_expr (&se.pre, len, GFC_DECL_STRING_LEN (se.expr)); @@ -418,7 +419,7 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, else { gfc_conv_string_parameter (&se); - gfc_add_modify_expr (&se.pre, io, se.expr); + gfc_add_modify_expr (&se.pre, io, fold_convert (TREE_TYPE (io), se.expr)); gfc_add_modify_expr (&se.pre, len, se.string_length); } @@ -432,10 +433,10 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, static void set_flag (stmtblock_t *block, tree var) { - tree tmp; + tree tmp, type = TREE_TYPE (var); - tmp = build (COMPONENT_REF, TREE_TYPE(var), ioparm_var, var, NULL_TREE); - gfc_add_modify_expr (block, tmp, integer_one_node); + tmp = build (COMPONENT_REF, type, ioparm_var, var, NULL_TREE); + gfc_add_modify_expr (block, tmp, convert (type, integer_one_node)); } diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index bbaa19d1123..794e2fc9017 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -615,7 +615,7 @@ gfc_trans_do (gfc_code * code) gfc_add_modify_expr (&body, dovar, tmp); /* Decrement the loop count. */ - tmp = build (MINUS_EXPR, type, count, integer_one_node); + tmp = build (MINUS_EXPR, type, count, gfc_index_one_node); gfc_add_modify_expr (&body, count, tmp); /* End of loop body. */ @@ -1240,13 +1240,13 @@ gfc_trans_forall_loop (forall_info *forall_tmp, int nvar, tree body, int mask_fl maskindex = forall_tmp->maskindex; if (mask) { - tmp = build (PLUS_EXPR, gfc_array_index_type, maskindex, - integer_one_node); + tmp = build (PLUS_EXPR, gfc_array_index_type, + maskindex, gfc_index_one_node); gfc_add_modify_expr (&block, maskindex, tmp); } } /* Decrement the loop counter. */ - tmp = build (MINUS_EXPR, TREE_TYPE (var), count, integer_one_node); + tmp = build (MINUS_EXPR, TREE_TYPE (var), count, gfc_index_one_node); gfc_add_modify_expr (&block, count, tmp); body = gfc_finish_block (&block); @@ -1348,12 +1348,12 @@ gfc_do_allocate (tree bytesize, tree size, tree * pdata, stmtblock_t * pblock, if (INTEGER_CST_P (size)) { tmp = fold (build (MINUS_EXPR, gfc_array_index_type, size, - integer_one_node)); + gfc_index_one_node)); } else tmp = NULL_TREE; - type = build_range_type (gfc_array_index_type, integer_zero_node, tmp); + type = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp); type = build_array_type (elem_type, type); if (gfc_can_put_var_on_stack (bytesize)) { @@ -1438,7 +1438,7 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree size, gfc_mark_ss_chain_used (lss, 1); /* Initialize count2. */ - gfc_add_modify_expr (&block, count2, integer_zero_node); + gfc_add_modify_expr (&block, count2, gfc_index_zero_node); /* Start the scalarized loop body. */ gfc_start_scalarized_body (&loop1, &body); @@ -1480,15 +1480,15 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree size, gfc_add_expr_to_block (&body, tmp); /* Increment count2. */ - tmp = fold (build (PLUS_EXPR, TREE_TYPE (count2), count2, - integer_one_node)); + tmp = fold (build (PLUS_EXPR, gfc_array_index_type, + count2, gfc_index_one_node)); gfc_add_modify_expr (&body, count2, tmp); /* Increment count3. */ if (count3) { - tmp = fold (build (PLUS_EXPR, TREE_TYPE (count3), count3, - integer_one_node)); + tmp = fold (build (PLUS_EXPR, gfc_array_index_type, + count3, gfc_index_one_node)); gfc_add_modify_expr (&body, count3, tmp); } @@ -1537,7 +1537,7 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree size, else { /* Initilize count2. */ - gfc_add_modify_expr (&block, count2, integer_zero_node); + gfc_add_modify_expr (&block, count2, gfc_index_zero_node); /* Initiliaze the loop. */ gfc_init_loopinfo (&loop); @@ -1592,15 +1592,15 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree size, else { /* Increment count2. */ - tmp = fold (build (PLUS_EXPR, gfc_array_index_type, count2, - integer_one_node)); + tmp = fold (build (PLUS_EXPR, gfc_array_index_type, + count2, gfc_index_one_node)); gfc_add_modify_expr (&body1, count2, tmp); /* Increment count3. */ if (count3) { - tmp = fold (build (PLUS_EXPR, gfc_array_index_type, count3, - integer_one_node)); + tmp = fold (build (PLUS_EXPR, gfc_array_index_type, + count3, gfc_index_one_node)); gfc_add_modify_expr (&body1, count3, tmp); } @@ -1639,7 +1639,7 @@ compute_inner_temp_size (gfc_expr *expr1, gfc_expr *expr2, *lss = gfc_walk_expr (expr1); *rss = NULL; - size = integer_one_node; + size = gfc_index_one_node; if (*lss != gfc_ss_terminator) { gfc_init_loopinfo (&loop); @@ -1672,10 +1672,11 @@ compute_inner_temp_size (gfc_expr *expr1, gfc_expr *expr2, /* Figure out how many elements we need. */ for (i = 0; i < loop.dimen; i++) { - tmp = fold (build (MINUS_EXPR, TREE_TYPE (loop.from[i]), - integer_one_node, loop.from[i])); - tmp = fold (build (PLUS_EXPR, TREE_TYPE (tmp), tmp, loop.to[i])); - size = fold (build (MULT_EXPR, TREE_TYPE (size), size, tmp)); + tmp = fold (build (MINUS_EXPR, gfc_array_index_type, + gfc_index_one_node, loop.from[i])); + tmp = fold (build (PLUS_EXPR, gfc_array_index_type, + tmp, loop.to[i])); + size = fold (build (MULT_EXPR, gfc_array_index_type, size, tmp)); } gfc_add_block_to_block (pblock, &loop.pre); size = gfc_evaluate_now (size, pblock); @@ -1700,7 +1701,7 @@ compute_overall_iter_number (forall_info *nested_forall_info, tree inner_size, /* TODO: optimizing the computing process. */ number = gfc_create_var (gfc_array_index_type, "num"); - gfc_add_modify_expr (block, number, integer_zero_node); + gfc_add_modify_expr (block, number, gfc_index_zero_node); gfc_start_block (&body); if (nested_forall_info) @@ -1778,13 +1779,13 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask, if (wheremask) { count = gfc_create_var (gfc_array_index_type, "count"); - gfc_add_modify_expr (block, count, integer_zero_node); + gfc_add_modify_expr (block, count, gfc_index_zero_node); } else count = NULL; /* Initialize count1. */ - gfc_add_modify_expr (block, count1, integer_zero_node); + gfc_add_modify_expr (block, count1, gfc_index_zero_node); /* Calculate the size of temporary needed in the assignment. Return loop, lss and rss which are used in function generate_loop_for_rhs_to_temp(). */ @@ -1805,7 +1806,7 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask, mask = forall_tmp->mask; maskindex = forall_tmp->maskindex; if (mask) - gfc_add_modify_expr (block, maskindex, integer_zero_node); + gfc_add_modify_expr (block, maskindex, gfc_index_zero_node); forall_tmp = forall_tmp->next_nest; } @@ -1819,7 +1820,7 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask, gfc_add_expr_to_block (block, tmp); /* Reset count1. */ - gfc_add_modify_expr (block, count1, integer_zero_node); + gfc_add_modify_expr (block, count1, gfc_index_zero_node); /* Reset maskindexed. */ forall_tmp = nested_forall_info; @@ -1828,13 +1829,13 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask, mask = forall_tmp->mask; maskindex = forall_tmp->maskindex; if (mask) - gfc_add_modify_expr (block, maskindex, integer_zero_node); + gfc_add_modify_expr (block, maskindex, gfc_index_zero_node); forall_tmp = forall_tmp->next_nest; } /* Reset count. */ if (wheremask) - gfc_add_modify_expr (block, count, integer_zero_node); + gfc_add_modify_expr (block, count, gfc_index_zero_node); /* Generate codes to copy the temporary to lhs. */ tmp = generate_loop_for_temp_to_lhs (expr1, tmp1, inner_size, count, @@ -1879,7 +1880,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, forall_info *forall_tmp; count = gfc_create_var (gfc_array_index_type, "count"); - gfc_add_modify_expr (block, count, integer_zero_node); + gfc_add_modify_expr (block, count, gfc_index_zero_node); inner_size = integer_one_node; lss = gfc_walk_expr (expr1); @@ -1904,8 +1905,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, gfc_add_block_to_block (&body, &rse.post); /* Increment count. */ - tmp = fold (build (PLUS_EXPR, TREE_TYPE (count), count, - integer_one_node)); + tmp = fold (build (PLUS_EXPR, gfc_array_index_type, + count, gfc_index_one_node)); gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); @@ -1917,7 +1918,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, mask = forall_tmp->mask; maskindex = forall_tmp->maskindex; if (mask) - gfc_add_modify_expr (block, maskindex, integer_zero_node); + gfc_add_modify_expr (block, maskindex, gfc_index_zero_node); forall_tmp = forall_tmp->next_nest; } @@ -1927,7 +1928,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, gfc_add_expr_to_block (block, tmp); /* Reset count. */ - gfc_add_modify_expr (block, count, integer_zero_node); + gfc_add_modify_expr (block, count, gfc_index_zero_node); /* Reset maskindexes. */ forall_tmp = nested_forall_info; @@ -1936,7 +1937,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, mask = forall_tmp->mask; maskindex = forall_tmp->maskindex; if (mask) - gfc_add_modify_expr (block, maskindex, integer_zero_node); + gfc_add_modify_expr (block, maskindex, gfc_index_zero_node); forall_tmp = forall_tmp->next_nest; } gfc_start_block (&body); @@ -1949,8 +1950,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, gfc_add_modify_expr (&body, lse.expr, rse.expr); gfc_add_block_to_block (&body, &lse.post); /* Increment count. */ - tmp = fold (build (PLUS_EXPR, TREE_TYPE (count), count, - integer_one_node)); + tmp = fold (build (PLUS_EXPR, gfc_array_index_type, + count, gfc_index_one_node)); gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); @@ -1993,8 +1994,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, gfc_add_block_to_block (&body, &lse.post); /* Increment count. */ - tmp = fold (build (PLUS_EXPR, TREE_TYPE (count), count, - integer_one_node)); + tmp = fold (build (PLUS_EXPR, gfc_array_index_type, + count, gfc_index_one_node)); gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); @@ -2006,7 +2007,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, mask = forall_tmp->mask; maskindex = forall_tmp->maskindex; if (mask) - gfc_add_modify_expr (block, maskindex, integer_zero_node); + gfc_add_modify_expr (block, maskindex, gfc_index_zero_node); forall_tmp = forall_tmp->next_nest; } @@ -2016,7 +2017,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, gfc_add_expr_to_block (block, tmp); /* Reset count. */ - gfc_add_modify_expr (block, count, integer_zero_node); + gfc_add_modify_expr (block, count, gfc_index_zero_node); /* Reset maskindexes. */ forall_tmp = nested_forall_info; @@ -2025,7 +2026,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, mask = forall_tmp->mask; maskindex = forall_tmp->maskindex; if (mask) - gfc_add_modify_expr (block, maskindex, integer_zero_node); + gfc_add_modify_expr (block, maskindex, gfc_index_zero_node); forall_tmp = forall_tmp->next_nest; } parm = gfc_build_array_ref (tmp1, count); @@ -2038,8 +2039,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, gfc_add_block_to_block (&body, &lse.post); /* Increment count. */ - tmp = fold (build (PLUS_EXPR, TREE_TYPE (count), count, - integer_one_node)); + tmp = fold (build (PLUS_EXPR, gfc_array_index_type, + count, gfc_index_one_node)); gfc_add_modify_expr (&body, count, tmp); tmp = gfc_finish_block (&body); @@ -2207,7 +2208,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) /* Work out the number of elements in the mask array. */ tmpvar = NULL_TREE; lenvar = NULL_TREE; - size = integer_one_node; + size = gfc_index_one_node; sizevar = NULL_TREE; for (n = 0; n < nvar; n++) @@ -2257,7 +2258,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) info->mask = mask; info->maskindex = maskindex; - gfc_add_modify_expr (&block, maskindex, integer_zero_node); + gfc_add_modify_expr (&block, maskindex, gfc_index_zero_node); /* Start of mask assignment loop body. */ gfc_start_block (&body); @@ -2278,8 +2279,8 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) gfc_add_modify_expr (&body, tmp, se.expr); /* Advance to the next mask element. */ - tmp = build (PLUS_EXPR, gfc_array_index_type, maskindex, - integer_one_node); + tmp = build (PLUS_EXPR, gfc_array_index_type, + maskindex, gfc_index_one_node); gfc_add_modify_expr (&body, maskindex, tmp); /* Generate the loops. */ @@ -2317,7 +2318,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) /* Reset the mask index. */ if (mask) - gfc_add_modify_expr (&block, maskindex, integer_zero_node); + gfc_add_modify_expr (&block, maskindex, gfc_index_zero_node); /* Generate body and loops. */ tmp = gfc_trans_nested_forall_loop (nested_forall_info, assign, 1, 1); @@ -2362,7 +2363,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info) /* Reset the mask index. */ if (mask) - gfc_add_modify_expr (&block, maskindex, integer_zero_node); + gfc_add_modify_expr (&block, maskindex, gfc_index_zero_node); /* Generate body and loops. */ tmp = gfc_trans_nested_forall_loop (nested_forall_info, assign, @@ -2478,7 +2479,7 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info, /* Variable to index the temporary. */ count = gfc_create_var (gfc_array_index_type, "count"); /* Initilize count. */ - gfc_add_modify_expr (block, count, integer_zero_node); + gfc_add_modify_expr (block, count, gfc_index_zero_node); gfc_start_block (&body); @@ -2530,7 +2531,7 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info, { /* Increment count. */ tmp1 = fold (build (PLUS_EXPR, gfc_array_index_type, count, - integer_one_node)); + gfc_index_one_node)); gfc_add_modify_expr (&body1, count, tmp1); /* Generate the copying loops. */ @@ -2696,8 +2697,8 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask, if (lss == gfc_ss_terminator) { /* Increment count1. */ - tmp = fold (build (PLUS_EXPR, TREE_TYPE (count1), count1, - integer_one_node)); + tmp = fold (build (PLUS_EXPR, gfc_array_index_type, + count1, gfc_index_one_node)); gfc_add_modify_expr (&body, count1, tmp); /* Use the scalar assignment as is. */ @@ -2714,8 +2715,8 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask, { /* Increment count1 before finish the main body of a scalarized expression. */ - tmp = fold (build (PLUS_EXPR, TREE_TYPE (count1), count1, - integer_one_node)); + tmp = fold (build (PLUS_EXPR, gfc_array_index_type, + count1, gfc_index_one_node)); gfc_add_modify_expr (&body, count1, tmp); gfc_trans_scalarized_loop_boundary (&loop, &body); @@ -2758,16 +2759,17 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask, tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts.type); tmp = build_v (COND_EXPR, maskexpr, tmp, build_empty_stmt ()); gfc_add_expr_to_block (&body, tmp); + /* Increment count2. */ - tmp = fold (build (PLUS_EXPR, TREE_TYPE (count2), count2, - integer_one_node)); + tmp = fold (build (PLUS_EXPR, gfc_array_index_type, + count2, gfc_index_one_node)); gfc_add_modify_expr (&body, count2, tmp); } else { /* Increment count1. */ - tmp = fold (build (PLUS_EXPR, TREE_TYPE (count1), count1, - integer_one_node)); + tmp = fold (build (PLUS_EXPR, gfc_array_index_type, + count1, gfc_index_one_node)); gfc_add_modify_expr (&body, count1, tmp); } @@ -2876,8 +2878,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask, tree pmask, /* Variables to control maskexpr. */ count1 = gfc_create_var (gfc_array_index_type, "count1"); count2 = gfc_create_var (gfc_array_index_type, "count2"); - gfc_add_modify_expr (block, count1, integer_zero_node); - gfc_add_modify_expr (block, count2, integer_zero_node); + gfc_add_modify_expr (block, count1, gfc_index_zero_node); + gfc_add_modify_expr (block, count2, gfc_index_zero_node); tmp = gfc_trans_where_assign (expr1, expr2, mask, count1, count2); @@ -2891,8 +2893,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask, tree pmask, /* Variables to control maskexpr. */ count1 = gfc_create_var (gfc_array_index_type, "count1"); count2 = gfc_create_var (gfc_array_index_type, "count2"); - gfc_add_modify_expr (block, count1, integer_zero_node); - gfc_add_modify_expr (block, count2, integer_zero_node); + gfc_add_modify_expr (block, count1, gfc_index_zero_node); + gfc_add_modify_expr (block, count2, gfc_index_zero_node); tmp = gfc_trans_where_assign (expr1, expr2, mask, count1, count2); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 9a259b6447e..46146a941a0 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -290,7 +290,7 @@ gfc_get_character_type (int kind, gfc_charlen * cl) len = (cl == 0) ? NULL_TREE : cl->backend_decl; - bounds = build_range_type (gfc_array_index_type, integer_one_node, len); + bounds = build_range_type (gfc_array_index_type, gfc_index_one_node, len); type = build_array_type (base, bounds); TYPE_STRING_FLAG (type) = 1; @@ -493,7 +493,7 @@ gfc_build_array_type (tree type, gfc_array_spec * as) { /* Create expressions for the known bounds of the array. */ if (as->type == AS_ASSUMED_SHAPE && as->lower[n] == NULL) - lbound[n] = integer_one_node; + lbound[n] = gfc_index_one_node; else lbound[n] = gfc_conv_array_bound (as->lower[n]); ubound[n] = gfc_conv_array_bound (as->upper[n]); @@ -727,7 +727,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, int packed) GFC_TYPE_ARRAY_DTYPE (type) = gfc_get_dtype (etype, as->rank); GFC_TYPE_ARRAY_RANK (type) = as->rank; - range = build_range_type (gfc_array_index_type, integer_zero_node, + range = build_range_type (gfc_array_index_type, gfc_index_zero_node, NULL_TREE); /* TODO: use main type if it is unbounded. */ GFC_TYPE_ARRAY_DATAPTR_TYPE (type) = @@ -741,7 +741,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, int packed) else range = NULL_TREE; - range = build_range_type (gfc_array_index_type, integer_zero_node, range); + range = build_range_type (gfc_array_index_type, gfc_index_zero_node, range); TYPE_DOMAIN (type) = range; build_pointer_type (etype); @@ -806,7 +806,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound, /* Build an array descriptor record type. */ if (packed != 0) - stride = integer_one_node; + stride = gfc_index_one_node; else stride = NULL_TREE; @@ -840,7 +840,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound, { tmp = fold (build (MINUS_EXPR, gfc_array_index_type, upper, lower)); tmp = fold (build (PLUS_EXPR, gfc_array_index_type, tmp, - integer_one_node)); + gfc_index_one_node)); stride = fold (build (MULT_EXPR, gfc_array_index_type, tmp, stride)); /* Check the folding worked. */ @@ -858,7 +858,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound, arraytype = build_array_type (etype, build_range_type (gfc_array_index_type, - integer_zero_node, NULL_TREE)); + gfc_index_zero_node, NULL_TREE)); arraytype = build_pointer_type (arraytype); GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type) = arraytype; @@ -885,7 +885,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound, arraytype = build_array_type (gfc_get_desc_dim_type (), build_range_type (gfc_array_index_type, - integer_zero_node, + gfc_index_zero_node, gfc_rank_cst[dimen - 1])); decl = build_decl (FIELD_DECL, get_identifier ("dim"), arraytype); diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 29277282b5e..00215f6a2a4 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -146,6 +146,16 @@ gfc_add_modify_expr (stmtblock_t * pblock, tree lhs, tree rhs) { tree tmp; +#ifdef ENABLE_CHECKING + /* Make sure that the types of the rhs and the lhs are the same + for scalar assignments. We should probably have something + similar for aggregates, but right now removing that check just + breaks everything. */ + if (TREE_TYPE (rhs) != TREE_TYPE (lhs) + && !AGGREGATE_TYPE_P (TREE_TYPE (lhs))) + abort (); +#endif + tmp = fold (build_v (MODIFY_EXPR, lhs, rhs)); gfc_add_expr_to_block (pblock, tmp); } -- 2.11.0