diff options
author | jb <jb@138bc75d-0d04-0410-961f-82ee72b054a4> | 2017-11-13 20:01:20 +0000 |
---|---|---|
committer | jb <jb@138bc75d-0d04-0410-961f-82ee72b054a4> | 2017-11-13 20:01:20 +0000 |
commit | a5c77ce247d148ff3081d123238091e3c086e48c (patch) | |
tree | 998046e9405ab59c1e4810c5718451f90c8f0da5 | |
parent | 2dec57182c458eae8c1714a8a2c4d677a8b5d767 (diff) | |
download | gcc-a5c77ce247d148ff3081d123238091e3c086e48c.tar.gz |
Introduce logical_type_node and use it
Backport from trunk.
Earlier GFortran used to redefine boolean_type_node, which in the rest
of the compiler means the C/C++ _Bool/bool type, to the Fortran
default logical type. When this redefinition was removed, a few
issues surfaced. Namely,
1) PR 82869, where we created a boolean tmp variable, and passed it to
the runtime library as a Fortran logical variable of a different size.
2) Fortran specifies that logical operations should be done with the
default logical kind, not in any other kind.
3) Using 8-bit variables have some issues, such as
- on x86, partial register stalls and length prefix changes.
- s390 has a compare with immediate and jump instruction which
works with 32-bit but not 8-bit quantities.
This patch addresses these issues by introducing a type
logical_type_node which is a Fortran LOGICAL variable of default
kind. It is then used in places were the Fortran standard mandates, as
well as for compiler generated temporary variables.
For x86-64, using the Polyhedron benchmark suite, no performance or
code size difference worth mentioning was observed.
Regtested on x86_64-pc-linux-gnu.
gcc/fortran/ChangeLog:
2017-11-13 Janne Blomqvist <jb@gcc.gnu.org>
PR 82869
* convert.c (truthvalue_conversion): Use logical_type_node.
* trans-array.c (gfc_trans_allocate_array_storage): Likewise.
(gfc_trans_create_temp_array): Likewise.
(gfc_trans_array_ctor_element): Likewise.
(gfc_trans_array_constructor_value): Likewise.
(trans_array_constructor): Likewise.
(trans_array_bound_check): Likewise.
(gfc_conv_array_ref): Likewise.
(gfc_trans_scalarized_loop_end): Likewise.
(gfc_conv_array_extent_dim): Likewise.
(gfc_array_init_size): Likewise.
(gfc_array_allocate): Likewise.
(gfc_trans_array_bounds): Likewise.
(gfc_trans_dummy_array_bias): Likewise.
(gfc_conv_array_parameter): Likewise.
(duplicate_allocatable): Likewise.
(duplicate_allocatable_coarray): Likewise.
(structure_alloc_comps): Likewise
(get_std_lbound): Likewise
(gfc_alloc_allocatable_for_assignment): Likewise
* trans-decl.c (add_argument_checking): Likewise
(gfc_generate_function_code): Likewise
* trans-expr.c (gfc_copy_class_to_class): Likewise
(gfc_trans_class_array_init_assign): Likewise
(gfc_trans_class_init_assign): Likewise
(gfc_conv_expr_present): Likewise
(gfc_conv_substring): Likewise
(gfc_conv_cst_int_power): Likewise
(gfc_conv_expr_op): Likewise
(gfc_conv_procedure_call): Likewise
(fill_with_spaces): Likewise
(gfc_trans_string_copy): Likewise
(gfc_trans_alloc_subarray_assign): Likewise
(gfc_trans_pointer_assignment): Likewise
(gfc_trans_scalar_assign): Likewise
(fcncall_realloc_result): Likewise
(alloc_scalar_allocatable_for_assignment): Likewise
(trans_class_assignment): Likewise
(gfc_trans_assignment_1): Likewise
* trans-intrinsic.c (build_fixbound_expr): Likewise
(gfc_conv_intrinsic_aint): Likewise
(gfc_trans_same_strlen_check): Likewise
(conv_caf_send): Likewise
(trans_this_image): Likewise
(conv_intrinsic_image_status): Likewise
(trans_image_index): Likewise
(gfc_conv_intrinsic_bound): Likewise
(conv_intrinsic_cobound): Likewise
(gfc_conv_intrinsic_mod): Likewise
(gfc_conv_intrinsic_dshift): Likewise
(gfc_conv_intrinsic_dim): Likewise
(gfc_conv_intrinsic_sign): Likewise
(gfc_conv_intrinsic_ctime): Likewise
(gfc_conv_intrinsic_fdate): Likewise
(gfc_conv_intrinsic_ttynam): Likewise
(gfc_conv_intrinsic_minmax): Likewise
(gfc_conv_intrinsic_minmax_char): Likewise
(gfc_conv_intrinsic_anyall): Likewise
(gfc_conv_intrinsic_arith): Likewise
(gfc_conv_intrinsic_minmaxloc): Likewise
(gfc_conv_intrinsic_minmaxval): Likewise
(gfc_conv_intrinsic_btest): Likewise
(gfc_conv_intrinsic_bitcomp): Likewise
(gfc_conv_intrinsic_shift): Likewise
(gfc_conv_intrinsic_ishft): Likewise
(gfc_conv_intrinsic_ishftc): Likewise
(gfc_conv_intrinsic_leadz): Likewise
(gfc_conv_intrinsic_trailz): Likewise
(gfc_conv_intrinsic_mask): Likewise
(gfc_conv_intrinsic_spacing): Likewise
(gfc_conv_intrinsic_rrspacing): Likewise
(gfc_conv_intrinsic_size): Likewise
(gfc_conv_intrinsic_sizeof): Likewise
(gfc_conv_intrinsic_transfer): Likewise
(gfc_conv_allocated): Likewise
(gfc_conv_associated): Likewise
(gfc_conv_same_type_as): Likewise
(gfc_conv_intrinsic_trim): Likewise
(gfc_conv_intrinsic_repeat): Likewise
(conv_isocbinding_function): Likewise
(conv_intrinsic_ieee_is_normal): Likewise
(conv_intrinsic_ieee_is_negative): Likewise
(conv_intrinsic_ieee_copy_sign): Likewise
(conv_intrinsic_move_alloc): Likewise
* trans-io.c (set_parameter_value_chk): Likewise
(set_parameter_value_inquire): Likewise
(set_string): Likewise
* trans-openmp.c (gfc_walk_alloc_comps): Likewise
(gfc_omp_clause_default_ctor): Likewise
(gfc_omp_clause_copy_ctor): Likewise
(gfc_omp_clause_assign_op): Likewise
(gfc_omp_clause_dtor): Likewise
(gfc_omp_finish_clause): Likewise
(gfc_trans_omp_clauses): Likewise
(gfc_trans_omp_do): Likewise
* trans-stmt.c (gfc_trans_goto): Likewise
(gfc_trans_sync): Likewise
(gfc_trans_arithmetic_if): Likewise
(gfc_trans_simple_do): Likewise
(gfc_trans_do): Likewise
(gfc_trans_forall_loop): Likewise
(gfc_trans_where_2): Likewise
(gfc_trans_allocate): Likewise
(gfc_trans_deallocate): Likewise
* trans-types.c (gfc_init_types): Initialize logical_type_node and
their true/false trees.
(gfc_get_array_descr_info): Use logical_type_node.
* trans-types.h (logical_type_node): New tree.
(logical_true_node): Likewise.
(logical_false_node): Likewise.
* trans.c (gfc_trans_runtime_check): Use logical_type_node.
(gfc_call_malloc): Likewise
(gfc_allocate_using_malloc): Likewise
(gfc_allocate_allocatable): Likewise
(gfc_add_comp_finalizer_call): Likewise
(gfc_add_finalizer_call): Likewise
(gfc_deallocate_with_status): Likewise
(gfc_deallocate_scalar_with_status): Likewise
(gfc_call_realloc): Likewise
gcc/testsuite/ChangeLog:
2017-11-13 Janne Blomqvist <jb@gcc.gnu.org>
PR 82869
* gfortran.dg/logical_temp_io.f90: New test.
* gfortran.dg/logical_temp_io_kind8.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-7-branch@254706 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r-- | gcc/fortran/ChangeLog | 123 | ||||
-rw-r--r-- | gcc/fortran/convert.c | 22 | ||||
-rw-r--r-- | gcc/fortran/trans-array.c | 144 | ||||
-rw-r--r-- | gcc/fortran/trans-decl.c | 16 | ||||
-rw-r--r-- | gcc/fortran/trans-expr.c | 82 | ||||
-rw-r--r-- | gcc/fortran/trans-intrinsic.c | 268 | ||||
-rw-r--r-- | gcc/fortran/trans-io.c | 12 | ||||
-rw-r--r-- | gcc/fortran/trans-openmp.c | 26 | ||||
-rw-r--r-- | gcc/fortran/trans-stmt.c | 58 | ||||
-rw-r--r-- | gcc/fortran/trans-types.c | 12 | ||||
-rw-r--r-- | gcc/fortran/trans-types.h | 14 | ||||
-rw-r--r-- | gcc/fortran/trans.c | 50 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/logical_temp_io.f90 | 13 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/logical_temp_io_kind8.f90 | 14 |
15 files changed, 523 insertions, 337 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4bdf1b99b26..37f7543d803 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,126 @@ +2017-11-13 Janne Blomqvist <jb@gcc.gnu.org> + + PR 82869 + * convert.c (truthvalue_conversion): Use logical_type_node. + * trans-array.c (gfc_trans_allocate_array_storage): Likewise. + (gfc_trans_create_temp_array): Likewise. + (gfc_trans_array_ctor_element): Likewise. + (gfc_trans_array_constructor_value): Likewise. + (trans_array_constructor): Likewise. + (trans_array_bound_check): Likewise. + (gfc_conv_array_ref): Likewise. + (gfc_trans_scalarized_loop_end): Likewise. + (gfc_conv_array_extent_dim): Likewise. + (gfc_array_init_size): Likewise. + (gfc_array_allocate): Likewise. + (gfc_trans_array_bounds): Likewise. + (gfc_trans_dummy_array_bias): Likewise. + (gfc_conv_array_parameter): Likewise. + (duplicate_allocatable): Likewise. + (duplicate_allocatable_coarray): Likewise. + (structure_alloc_comps): Likewise + (get_std_lbound): Likewise + (gfc_alloc_allocatable_for_assignment): Likewise + * trans-decl.c (add_argument_checking): Likewise + (gfc_generate_function_code): Likewise + * trans-expr.c (gfc_copy_class_to_class): Likewise + (gfc_trans_class_array_init_assign): Likewise + (gfc_trans_class_init_assign): Likewise + (gfc_conv_expr_present): Likewise + (gfc_conv_substring): Likewise + (gfc_conv_cst_int_power): Likewise + (gfc_conv_expr_op): Likewise + (gfc_conv_procedure_call): Likewise + (fill_with_spaces): Likewise + (gfc_trans_string_copy): Likewise + (gfc_trans_alloc_subarray_assign): Likewise + (gfc_trans_pointer_assignment): Likewise + (gfc_trans_scalar_assign): Likewise + (fcncall_realloc_result): Likewise + (alloc_scalar_allocatable_for_assignment): Likewise + (trans_class_assignment): Likewise + (gfc_trans_assignment_1): Likewise + * trans-intrinsic.c (build_fixbound_expr): Likewise + (gfc_conv_intrinsic_aint): Likewise + (gfc_trans_same_strlen_check): Likewise + (conv_caf_send): Likewise + (trans_this_image): Likewise + (conv_intrinsic_image_status): Likewise + (trans_image_index): Likewise + (gfc_conv_intrinsic_bound): Likewise + (conv_intrinsic_cobound): Likewise + (gfc_conv_intrinsic_mod): Likewise + (gfc_conv_intrinsic_dshift): Likewise + (gfc_conv_intrinsic_dim): Likewise + (gfc_conv_intrinsic_sign): Likewise + (gfc_conv_intrinsic_ctime): Likewise + (gfc_conv_intrinsic_fdate): Likewise + (gfc_conv_intrinsic_ttynam): Likewise + (gfc_conv_intrinsic_minmax): Likewise + (gfc_conv_intrinsic_minmax_char): Likewise + (gfc_conv_intrinsic_anyall): Likewise + (gfc_conv_intrinsic_arith): Likewise + (gfc_conv_intrinsic_minmaxloc): Likewise + (gfc_conv_intrinsic_minmaxval): Likewise + (gfc_conv_intrinsic_btest): Likewise + (gfc_conv_intrinsic_bitcomp): Likewise + (gfc_conv_intrinsic_shift): Likewise + (gfc_conv_intrinsic_ishft): Likewise + (gfc_conv_intrinsic_ishftc): Likewise + (gfc_conv_intrinsic_leadz): Likewise + (gfc_conv_intrinsic_trailz): Likewise + (gfc_conv_intrinsic_mask): Likewise + (gfc_conv_intrinsic_spacing): Likewise + (gfc_conv_intrinsic_rrspacing): Likewise + (gfc_conv_intrinsic_size): Likewise + (gfc_conv_intrinsic_sizeof): Likewise + (gfc_conv_intrinsic_transfer): Likewise + (gfc_conv_allocated): Likewise + (gfc_conv_associated): Likewise + (gfc_conv_same_type_as): Likewise + (gfc_conv_intrinsic_trim): Likewise + (gfc_conv_intrinsic_repeat): Likewise + (conv_isocbinding_function): Likewise + (conv_intrinsic_ieee_is_normal): Likewise + (conv_intrinsic_ieee_is_negative): Likewise + (conv_intrinsic_ieee_copy_sign): Likewise + (conv_intrinsic_move_alloc): Likewise + * trans-io.c (set_parameter_value_chk): Likewise + (set_parameter_value_inquire): Likewise + (set_string): Likewise + * trans-openmp.c (gfc_walk_alloc_comps): Likewise + (gfc_omp_clause_default_ctor): Likewise + (gfc_omp_clause_copy_ctor): Likewise + (gfc_omp_clause_assign_op): Likewise + (gfc_omp_clause_dtor): Likewise + (gfc_omp_finish_clause): Likewise + (gfc_trans_omp_clauses): Likewise + (gfc_trans_omp_do): Likewise + * trans-stmt.c (gfc_trans_goto): Likewise + (gfc_trans_sync): Likewise + (gfc_trans_arithmetic_if): Likewise + (gfc_trans_simple_do): Likewise + (gfc_trans_do): Likewise + (gfc_trans_forall_loop): Likewise + (gfc_trans_where_2): Likewise + (gfc_trans_allocate): Likewise + (gfc_trans_deallocate): Likewise + * trans-types.c (gfc_init_types): Initialize logical_type_node and + their true/false trees. + (gfc_get_array_descr_info): Use logical_type_node. + * trans-types.h (logical_type_node): New tree. + (logical_true_node): Likewise. + (logical_false_node): Likewise. + * trans.c (gfc_trans_runtime_check): Use logical_type_node. + (gfc_call_malloc): Likewise + (gfc_allocate_using_malloc): Likewise + (gfc_allocate_allocatable): Likewise + (gfc_add_comp_finalizer_call): Likewise + (gfc_add_finalizer_call): Likewise + (gfc_deallocate_with_status): Likewise + (gfc_deallocate_scalar_with_status): Likewise + (gfc_call_realloc): Likewise + 2017-11-06 Paul Thomas <pault@gcc.gnu.org> Backported from trunk diff --git a/gcc/fortran/convert.c b/gcc/fortran/convert.c index 35203235e8f..13bff7345aa 100644 --- a/gcc/fortran/convert.c +++ b/gcc/fortran/convert.c @@ -29,10 +29,14 @@ along with GCC; see the file COPYING3. If not see #include "fold-const.h" #include "convert.h" +#include "gfortran.h" +#include "trans.h" +#include "trans-types.h" + /* Prepare expr to be an argument of a TRUTH_NOT_EXPR, or validate its data type for a GIMPLE `if' or `while' statement. - The resulting type should always be `boolean_type_node'. */ + The resulting type should always be `logical_type_node'. */ static tree truthvalue_conversion (tree expr) @@ -40,25 +44,29 @@ truthvalue_conversion (tree expr) switch (TREE_CODE (TREE_TYPE (expr))) { case BOOLEAN_TYPE: - if (TREE_TYPE (expr) == boolean_type_node) + if (TREE_TYPE (expr) == logical_type_node) return expr; else if (COMPARISON_CLASS_P (expr)) { - TREE_TYPE (expr) = boolean_type_node; + TREE_TYPE (expr) = logical_type_node; return expr; } else if (TREE_CODE (expr) == NOP_EXPR) return fold_build1_loc (input_location, NOP_EXPR, - boolean_type_node, TREE_OPERAND (expr, 0)); + logical_type_node, + TREE_OPERAND (expr, 0)); else - return fold_build1_loc (input_location, NOP_EXPR, boolean_type_node, + return fold_build1_loc (input_location, NOP_EXPR, + logical_type_node, expr); case INTEGER_TYPE: if (TREE_CODE (expr) == INTEGER_CST) - return integer_zerop (expr) ? boolean_false_node : boolean_true_node; + return integer_zerop (expr) ? logical_false_node + : logical_true_node; else - return fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + return fold_build2_loc (input_location, NE_EXPR, + logical_type_node, expr, build_int_cst (TREE_TYPE (expr), 0)); default: diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index d3a452a13fa..96fe8d431a3 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -895,7 +895,7 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post, gfc_add_expr_to_block (&do_copying, tmp); was_packed = fold_build2_loc (input_location, EQ_EXPR, - boolean_type_node, packed, + logical_type_node, packed, source_data); tmp = gfc_finish_block (&do_copying); tmp = build3_v (COND_EXPR, was_packed, tmp, @@ -1163,7 +1163,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, to[n], gfc_index_one_node); /* Check whether the size for this dimension is negative. */ - cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, tmp, gfc_index_zero_node); cond = gfc_evaluate_now (cond, pre); @@ -1171,7 +1171,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, or_expr = cond; else or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, or_expr, cond); + logical_type_node, or_expr, cond); size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, size, tmp); @@ -1431,7 +1431,7 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc, /* Verify that all constructor elements are of the same length. */ tree cond = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, first_len_val, + logical_type_node, first_len_val, se->string_length); gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where, @@ -1773,14 +1773,14 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, /* Generate the exit condition. Depending on the sign of the step variable we have to generate the correct comparison. */ - tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node, step, build_int_cst (TREE_TYPE (step), 0)); cond = fold_build3_loc (input_location, COND_EXPR, - boolean_type_node, tmp, + logical_type_node, tmp, fold_build2_loc (input_location, GT_EXPR, - boolean_type_node, shadow_loopvar, end), + logical_type_node, shadow_loopvar, end), fold_build2_loc (input_location, LT_EXPR, - boolean_type_node, shadow_loopvar, end)); + logical_type_node, shadow_loopvar, end)); tmp = build1_v (GOTO_EXPR, exit_label); TREE_USED (exit_label) = 1; tmp = build3_v (COND_EXPR, cond, tmp, @@ -2288,7 +2288,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) /* Check if the character length is negative. If it is, then set LEN = 0. */ neg_len = fold_build2_loc (input_location, LT_EXPR, - boolean_type_node, ss_info->string_length, + logical_type_node, ss_info->string_length, build_int_cst (gfc_charlen_type_node, 0)); /* Print a warning if bounds checking is enabled. */ if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) @@ -2926,13 +2926,13 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n, msg = xasprintf ("Index '%%ld' of dimension %d " "outside of expected range (%%ld:%%ld)", n+1); - fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + fault = fold_build2_loc (input_location, LT_EXPR, logical_type_node, index, tmp_lo); gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg, fold_convert (long_integer_type_node, index), fold_convert (long_integer_type_node, tmp_lo), fold_convert (long_integer_type_node, tmp_up)); - fault = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + fault = fold_build2_loc (input_location, GT_EXPR, logical_type_node, index, tmp_up); gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg, fold_convert (long_integer_type_node, index), @@ -2951,7 +2951,7 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n, msg = xasprintf ("Index '%%ld' of dimension %d " "below lower bound of %%ld", n+1); - fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + fault = fold_build2_loc (input_location, LT_EXPR, logical_type_node, index, tmp_lo); gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg, fold_convert (long_integer_type_node, index), @@ -3456,7 +3456,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr, tmp = tmpse.expr; } - cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node, indexse.expr, tmp); msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' " "below lower bound of %%ld", n+1, var_name); @@ -3481,7 +3481,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr, } cond = fold_build2_loc (input_location, GT_EXPR, - boolean_type_node, indexse.expr, tmp); + logical_type_node, indexse.expr, tmp); msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' " "above upper bound of %%ld", n+1, var_name); gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg, @@ -3726,7 +3726,7 @@ gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n, OMP_FOR_INIT (stmt) = init; /* The exit condition. */ TREE_VEC_ELT (cond, 0) = build2_loc (input_location, LE_EXPR, - boolean_type_node, + logical_type_node, loop->loopvar[n], loop->to[n]); SET_EXPR_LOCATION (TREE_VEC_ELT (cond, 0), input_location); OMP_FOR_COND (stmt) = cond; @@ -3761,7 +3761,7 @@ gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n, /* The exit condition. */ cond = fold_build2_loc (input_location, reverse_loop ? LT_EXPR : GT_EXPR, - boolean_type_node, loop->loopvar[n], loop->to[n]); + logical_type_node, loop->loopvar[n], loop->to[n]); tmp = build1_v (GOTO_EXPR, exit_label); TREE_USED (exit_label) = 1; tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location)); @@ -4193,7 +4193,7 @@ done: check_upper = true; /* Zero stride is not allowed. */ - tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, info->stride[dim], gfc_index_zero_node); msg = xasprintf ("Zero stride is not allowed, for dimension %d " "of array '%s'", dim + 1, expr_name); @@ -4216,23 +4216,23 @@ done: /* non_zerosized is true when the selected range is not empty. */ stride_pos = fold_build2_loc (input_location, GT_EXPR, - boolean_type_node, info->stride[dim], + logical_type_node, info->stride[dim], gfc_index_zero_node); - tmp = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node, info->start[dim], end); stride_pos = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, stride_pos, tmp); + logical_type_node, stride_pos, tmp); stride_neg = fold_build2_loc (input_location, LT_EXPR, - boolean_type_node, + logical_type_node, info->stride[dim], gfc_index_zero_node); - tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node, info->start[dim], end); stride_neg = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, + logical_type_node, stride_neg, tmp); non_zerosized = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, + logical_type_node, stride_pos, stride_neg); /* Check the start of the range against the lower and upper @@ -4242,16 +4242,16 @@ done: if (check_upper) { tmp = fold_build2_loc (input_location, LT_EXPR, - boolean_type_node, + logical_type_node, info->start[dim], lbound); tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, + logical_type_node, non_zerosized, tmp); tmp2 = fold_build2_loc (input_location, GT_EXPR, - boolean_type_node, + logical_type_node, info->start[dim], ubound); tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, + logical_type_node, non_zerosized, tmp2); msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' " "outside of expected range (%%ld:%%ld)", @@ -4271,10 +4271,10 @@ done: else { tmp = fold_build2_loc (input_location, LT_EXPR, - boolean_type_node, + logical_type_node, info->start[dim], lbound); tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, non_zerosized, tmp); + logical_type_node, non_zerosized, tmp); msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' " "below lower bound of %%ld", dim + 1, expr_name); @@ -4298,15 +4298,15 @@ done: tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, end, tmp); tmp2 = fold_build2_loc (input_location, LT_EXPR, - boolean_type_node, tmp, lbound); + logical_type_node, tmp, lbound); tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, non_zerosized, tmp2); + logical_type_node, non_zerosized, tmp2); if (check_upper) { tmp3 = fold_build2_loc (input_location, GT_EXPR, - boolean_type_node, tmp, ubound); + logical_type_node, tmp, ubound); tmp3 = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, non_zerosized, tmp3); + logical_type_node, non_zerosized, tmp3); msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' " "outside of expected range (%%ld:%%ld)", dim + 1, expr_name); @@ -4352,7 +4352,7 @@ done: if (size[n]) { tmp3 = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, tmp, size[n]); + logical_type_node, tmp, size[n]); msg = xasprintf ("Array bound mismatch for dimension %d " "of array '%s' (%%ld/%%ld)", dim + 1, expr_name); @@ -5036,7 +5036,7 @@ gfc_conv_array_extent_dim (tree lbound, tree ubound, tree* or_expr) gfc_index_one_node); /* Check whether the size for this dimension is negative. */ - cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, res, + cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, res, gfc_index_zero_node); res = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond, gfc_index_zero_node, res); @@ -5044,7 +5044,7 @@ gfc_conv_array_extent_dim (tree lbound, tree ubound, tree* or_expr) /* Build OR expression. */ if (or_expr) *or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, *or_expr, cond); + logical_type_node, *or_expr, cond); return res; } @@ -5173,7 +5173,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, gfc_add_modify (pblock, tmp, gfc_get_dtype (type)); } - or_expr = boolean_false_node; + or_expr = logical_false_node; for (n = 0; n < rank; n++) { @@ -5281,12 +5281,12 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, TYPE_MAX_VALUE (gfc_array_index_type)), size); cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR, - boolean_type_node, tmp, stride), + logical_type_node, tmp, stride), PRED_FORTRAN_OVERFLOW); tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond, integer_one_node, integer_zero_node); cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR, - boolean_type_node, size, + logical_type_node, size, gfc_index_zero_node), PRED_FORTRAN_SIZE_ZERO); tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond, @@ -5382,12 +5382,12 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, size_type_node, TYPE_MAX_VALUE (size_type_node), element_size); cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR, - boolean_type_node, tmp, stride), + logical_type_node, tmp, stride), PRED_FORTRAN_OVERFLOW); tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond, integer_one_node, integer_zero_node); cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR, - boolean_type_node, element_size, + logical_type_node, element_size, build_int_cst (size_type_node, 0)), PRED_FORTRAN_SIZE_ZERO); tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond, @@ -5645,7 +5645,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, if (dimension) { cond = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, var_overflow, integer_zero_node), + logical_type_node, var_overflow, integer_zero_node), PRED_FORTRAN_OVERFLOW); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, error, gfc_finish_block (&elseblock)); @@ -5663,7 +5663,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, if (status != NULL_TREE) { cond = fold_build2_loc (input_location, EQ_EXPR, - boolean_type_node, status, + logical_type_node, status, build_int_cst (TREE_TYPE (status), 0)); gfc_add_expr_to_block (&se->pre, fold_build3_loc (input_location, COND_EXPR, void_type_node, @@ -5913,7 +5913,7 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset, /* Make sure that negative size arrays are translated to being zero size. */ - tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node, stride, gfc_index_zero_node); tmp = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, tmp, @@ -6200,10 +6200,10 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, /* For non-constant shape arrays we only check if the first dimension is contiguous. Repacking higher dimensions wouldn't gain us anything as we still don't know the array stride. */ - partial = gfc_create_var (boolean_type_node, "partial"); + partial = gfc_create_var (logical_type_node, "partial"); TREE_USED (partial) = 1; tmp = gfc_conv_descriptor_stride_get (dumdesc, gfc_rank_cst[0]); - tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, tmp, + tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, tmp, gfc_index_one_node); gfc_add_modify (&init, partial, tmp); } @@ -6218,7 +6218,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, stride = gfc_conv_descriptor_stride_get (dumdesc, gfc_rank_cst[0]); stride = gfc_evaluate_now (stride, &init); - tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, stride, gfc_index_zero_node); tmp = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, tmp, gfc_index_one_node, stride); @@ -6459,7 +6459,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, else tmp = build_fold_indirect_ref_loc (input_location, dumdesc); tmp = gfc_conv_descriptor_data_get (tmp); - tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp, tmpdesc); stmtCleanup = build3_v (COND_EXPR, tmp, stmtCleanup, build_empty_stmt (input_location)); @@ -7723,12 +7723,12 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, tmp = build_fold_indirect_ref_loc (input_location, desc); tmp = gfc_conv_array_data (tmp); - tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, fold_convert (TREE_TYPE (tmp), ptr), tmp); if (fsym && fsym->attr.optional && sym && sym->attr.optional) tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, + logical_type_node, gfc_conv_expr_present (sym), tmp); gfc_trans_runtime_check (false, true, tmp, &se->pre, @@ -7758,12 +7758,12 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, tmp = build_fold_indirect_ref_loc (input_location, desc); tmp = gfc_conv_array_data (tmp); - tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, fold_convert (TREE_TYPE (tmp), ptr), tmp); if (fsym && fsym->attr.optional && sym && sym->attr.optional) tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, + logical_type_node, gfc_conv_expr_present (sym), tmp); tmp = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt (input_location)); @@ -7902,7 +7902,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, null_cond = gfc_conv_descriptor_data_get (src); null_cond = convert (pvoid_type_node, null_cond); - null_cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + null_cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, null_cond, null_pointer_node); return build3_v (COND_EXPR, null_cond, tmp, null_data); } @@ -8036,7 +8036,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src, null_cond = gfc_conv_descriptor_data_get (src); null_cond = convert (pvoid_type_node, null_cond); - null_cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + null_cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, null_cond, null_pointer_node); gfc_add_expr_to_block (&globalblock, build3_v (COND_EXPR, null_cond, tmp, null_data)); @@ -8148,7 +8148,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, null_cond = gfc_conv_descriptor_data_get (decl); null_cond = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, null_cond, + logical_type_node, null_cond, build_int_cst (TREE_TYPE (null_cond), 0)); } else @@ -8386,7 +8386,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, dealloc_fndecl); tmp = build_int_cst (TREE_TYPE (comp), 0); is_allocated = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, tmp, + logical_type_node, tmp, comp); cdesc = gfc_build_addr_expr (NULL_TREE, cdesc); @@ -8666,7 +8666,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, null_data = gfc_finish_block (&tmpblock); null_cond = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, src_data, + logical_type_node, src_data, null_pointer_node); gfc_add_expr_to_block (&fnblock, build3_v (COND_EXPR, null_cond, @@ -8841,25 +8841,25 @@ get_std_lbound (gfc_expr *expr, tree desc, int dim, bool assumed_size) lbound = gfc_conv_descriptor_lbound_get (desc, tmp); ubound = gfc_conv_descriptor_ubound_get (desc, tmp); stride = gfc_conv_descriptor_stride_get (desc, tmp); - cond1 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, + cond1 = fold_build2_loc (input_location, GE_EXPR, logical_type_node, ubound, lbound); - cond3 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, + cond3 = fold_build2_loc (input_location, GE_EXPR, logical_type_node, stride, gfc_index_zero_node); cond3 = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, cond3, cond1); - cond4 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + logical_type_node, cond3, cond1); + cond4 = fold_build2_loc (input_location, LT_EXPR, logical_type_node, stride, gfc_index_zero_node); if (assumed_size) - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, tmp, build_int_cst (gfc_array_index_type, expr->rank - 1)); else - cond = boolean_false_node; + cond = logical_false_node; cond1 = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, cond3, cond4); + logical_type_node, cond3, cond4); cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, cond, cond1); + logical_type_node, cond, cond1); return fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond, @@ -9112,11 +9112,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, jump_label2 = gfc_build_label_decl (NULL_TREE); /* Allocate if data is NULL. */ - cond_null = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + cond_null = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, array1, build_int_cst (TREE_TYPE (array1), 0)); if (expr1->ts.deferred) - cond_null = gfc_evaluate_now (boolean_true_node, &fblock); + cond_null = gfc_evaluate_now (logical_true_node, &fblock); else cond_null= gfc_evaluate_now (cond_null, &fblock); @@ -9156,7 +9156,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, gfc_array_index_type, tmp, ubound); cond = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, + logical_type_node, tmp, gfc_index_zero_node); tmp = build3_v (COND_EXPR, cond, build1_v (GOTO_EXPR, jump_label1), @@ -9206,13 +9206,13 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, } size2 = gfc_evaluate_now (size2, &fblock); - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, size1, size2); /* If the lhs is deferred length, assume that the element size changes and force a reallocation. */ if (expr1->ts.deferred) - neq_size = gfc_evaluate_now (boolean_true_node, &fblock); + neq_size = gfc_evaluate_now (logical_true_node, &fblock); else neq_size = gfc_evaluate_now (cond, &fblock); @@ -9492,7 +9492,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* Malloc if not allocated; realloc otherwise. */ tmp = build_int_cst (TREE_TYPE (array1), 0); cond = fold_build2_loc (input_location, EQ_EXPR, - boolean_type_node, + logical_type_node, array1, tmp); tmp = build3_v (COND_EXPR, cond, alloc_expr, realloc_expr); gfc_add_expr_to_block (&fblock, tmp); diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 53e86729b47..5f2f76b7cbe 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -5698,7 +5698,7 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym) /* Build the condition. For optional arguments, an actual length of 0 is also acceptable if the associated string is NULL, which means the argument was not passed. */ - cond = fold_build2_loc (input_location, comparison, boolean_type_node, + cond = fold_build2_loc (input_location, comparison, logical_type_node, cl->passed_length, cl->backend_decl); if (fsym->attr.optional) { @@ -5707,7 +5707,7 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym) tree absent_failed; not_0length = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, + logical_type_node, cl->passed_length, build_zero_cst (gfc_charlen_type_node)); /* The symbol needs to be referenced for gfc_get_symbol_decl. */ @@ -5715,11 +5715,11 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym) not_absent = gfc_conv_expr_present (fsym); absent_failed = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, not_0length, + logical_type_node, not_0length, not_absent); cond = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, cond, absent_failed); + logical_type_node, cond, absent_failed); } /* Build the runtime check. */ @@ -6290,13 +6290,13 @@ gfc_generate_function_code (gfc_namespace * ns) msg = xasprintf ("Recursive call to nonrecursive procedure '%s'", sym->name); - recurcheckvar = gfc_create_var (boolean_type_node, "is_recursive"); + recurcheckvar = gfc_create_var (logical_type_node, "is_recursive"); TREE_STATIC (recurcheckvar) = 1; - DECL_INITIAL (recurcheckvar) = boolean_false_node; + DECL_INITIAL (recurcheckvar) = logical_false_node; gfc_add_expr_to_block (&init, recurcheckvar); gfc_trans_runtime_check (true, false, recurcheckvar, &init, &sym->declared_at, msg); - gfc_add_modify (&init, recurcheckvar, boolean_true_node); + gfc_add_modify (&init, recurcheckvar, logical_true_node); free (msg); } @@ -6425,7 +6425,7 @@ gfc_generate_function_code (gfc_namespace * ns) if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive && !flag_openmp && recurcheckvar != NULL_TREE) { - gfc_add_modify (&cleanup, recurcheckvar, boolean_false_node); + gfc_add_modify (&cleanup, recurcheckvar, logical_false_node); recurcheckvar = NULL; } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b72dc1a43b7..b9ca5257713 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1287,7 +1287,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) from_len = gfc_conv_descriptor_size (from_data, 1); tmp = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, from_len, orig_nelems); + logical_type_node, from_len, orig_nelems); msg = xasprintf ("Array bound mismatch for dimension %d " "of array '%s' (%%ld/%%ld)", 1, name); @@ -1338,7 +1338,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) extcopy = gfc_finish_block (&ifbody); tmp = fold_build2_loc (input_location, GT_EXPR, - boolean_type_node, from_len, + logical_type_node, from_len, integer_zero_node); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp, extcopy, stdcopy); @@ -1366,7 +1366,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) vec_safe_push (args, to_len); extcopy = build_call_vec (fcn_type, fcn, args); tmp = fold_build2_loc (input_location, GT_EXPR, - boolean_type_node, from_len, + logical_type_node, from_len, integer_zero_node); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp, extcopy, stdcopy); @@ -1380,7 +1380,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) { tree cond; cond = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, + logical_type_node, from_data, null_pointer_node); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, @@ -1425,7 +1425,7 @@ gfc_trans_class_array_init_assign (gfc_expr *rhs, gfc_expr *lhs, gfc_expr *obj) gfc_init_se (&src, NULL); gfc_conv_expr (&src, rhs); src.expr = gfc_build_addr_expr (NULL_TREE, src.expr); - tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tree cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, src.expr, fold_convert (TREE_TYPE (src.expr), null_pointer_node)); res = build3_loc (input_location, COND_EXPR, TREE_TYPE (res), cond, res, @@ -1492,7 +1492,7 @@ gfc_trans_class_init_assign (gfc_code *code) { /* Check if _def_init is non-NULL. */ tree cond = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, src.expr, + logical_type_node, src.expr, fold_convert (TREE_TYPE (src.expr), null_pointer_node)); tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp), cond, @@ -1662,7 +1662,7 @@ gfc_conv_expr_present (gfc_symbol * sym) decl = GFC_DECL_SAVED_DESCRIPTOR (decl); } - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, decl, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, decl, fold_convert (TREE_TYPE (decl), null_pointer_node)); /* Fortran 2008 allows to pass null pointers and non-associated pointers @@ -1699,10 +1699,10 @@ gfc_conv_expr_present (gfc_symbol * sym) if (tmp != NULL_TREE) { - tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp, + tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp, fold_convert (TREE_TYPE (tmp), null_pointer_node)); cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, - boolean_type_node, cond, tmp); + logical_type_node, cond, tmp); } } @@ -2264,15 +2264,15 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind, if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) { tree nonempty = fold_build2_loc (input_location, LE_EXPR, - boolean_type_node, start.expr, + logical_type_node, start.expr, end.expr); /* Check lower bound. */ - fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + fault = fold_build2_loc (input_location, LT_EXPR, logical_type_node, start.expr, build_int_cst (gfc_charlen_type_node, 1)); fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, - boolean_type_node, nonempty, fault); + logical_type_node, nonempty, fault); if (name) msg = xasprintf ("Substring out of bounds: lower bound (%%ld) of '%s' " "is less than one", name); @@ -2285,10 +2285,10 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind, free (msg); /* Check upper bound. */ - fault = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + fault = fold_build2_loc (input_location, GT_EXPR, logical_type_node, end.expr, se->string_length); fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, - boolean_type_node, nonempty, fault); + logical_type_node, nonempty, fault); if (name) msg = xasprintf ("Substring out of bounds: upper bound (%%ld) of '%s' " "exceeds string length (%%ld)", name); @@ -2890,9 +2890,9 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs) /* If rhs < 0 and lhs is an integer, the result is -1, 0 or 1. */ if ((sgn == -1) && (TREE_CODE (type) == INTEGER_TYPE)) { - tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, lhs, build_int_cst (TREE_TYPE (lhs), -1)); - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, lhs, build_int_cst (TREE_TYPE (lhs), 1)); /* If rhs is even, @@ -2900,7 +2900,7 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs) if ((n & 1) == 0) { tmp = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, tmp, cond); + logical_type_node, tmp, cond); se->expr = fold_build3_loc (input_location, COND_EXPR, type, tmp, build_int_cst (type, 1), build_int_cst (type, 0)); @@ -3386,8 +3386,8 @@ gfc_conv_expr_op (gfc_se * se, gfc_expr * expr) if (lop) { - /* The result of logical ops is always boolean_type_node. */ - tmp = fold_build2_loc (input_location, code, boolean_type_node, + /* The result of logical ops is always logical_type_node. */ + tmp = fold_build2_loc (input_location, code, logical_type_node, lse.expr, rse.expr); se->expr = convert (type, tmp); } @@ -4985,7 +4985,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tree descriptor_data; descriptor_data = ss->info->data.array.data; - tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, descriptor_data, fold_convert (TREE_TYPE (descriptor_data), null_pointer_node)); @@ -5149,7 +5149,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tree cond; tmp = gfc_build_addr_expr (NULL_TREE, parmse.expr); cond = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, tmp, + logical_type_node, tmp, fold_convert (TREE_TYPE (tmp), null_pointer_node)); gfc_start_block (&block); @@ -5680,16 +5680,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, present = gfc_conv_expr_present (e->symtree->n.sym); type = TREE_TYPE (present); present = fold_build2_loc (input_location, EQ_EXPR, - boolean_type_node, present, + logical_type_node, present, fold_convert (type, null_pointer_node)); type = TREE_TYPE (parmse.expr); null_ptr = fold_build2_loc (input_location, EQ_EXPR, - boolean_type_node, parmse.expr, + logical_type_node, parmse.expr, fold_convert (type, null_pointer_node)); cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, - boolean_type_node, present, null_ptr); + logical_type_node, present, null_ptr); } else { @@ -5716,7 +5716,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tmp = gfc_build_addr_expr (NULL_TREE, tmp); cond = fold_build2_loc (input_location, EQ_EXPR, - boolean_type_node, tmp, + logical_type_node, tmp, fold_convert (TREE_TYPE (tmp), null_pointer_node)); } @@ -6211,7 +6211,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, happen in a function returning a pointer. */ tmp = gfc_conv_descriptor_data_get (info->descriptor); tmp = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, + logical_type_node, tmp, info->data); gfc_trans_runtime_check (true, false, tmp, &se->pre, NULL, gfc_msg_fault); @@ -6337,7 +6337,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, final_fndecl = gfc_class_vtab_final_get (se->expr); is_final = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, + logical_type_node, final_fndecl, fold_convert (TREE_TYPE (final_fndecl), null_pointer_node)); @@ -6411,7 +6411,7 @@ fill_with_spaces (tree start, tree type, tree size) gfc_init_block (&loop); /* Exit condition. */ - cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, i, + cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, i, build_zero_cst (sizetype)); tmp = build1_v (GOTO_EXPR, exit_label); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp, @@ -6504,7 +6504,7 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest, */ /* Do nothing if the destination length is zero. */ - cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, dlen, + cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node, dlen, build_int_cst (size_type_node, 0)); /* For non-default character kinds, we have to multiply the string @@ -6540,7 +6540,7 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest, gfc_add_expr_to_block (&tmpblock2, tmp2); /* If the destination is longer, fill the end with spaces. */ - cond2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, slen, + cond2 = fold_build2_loc (input_location, LT_EXPR, logical_type_node, slen, dlen); /* Wstringop-overflow appears at -O3 even though this warning is not @@ -7125,7 +7125,7 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm, null_pointer_node); null_expr = gfc_finish_block (&block); tmp = gfc_conv_descriptor_data_get (arg->symtree->n.sym->backend_decl); - tmp = build2_loc (input_location, EQ_EXPR, boolean_type_node, tmp, + tmp = build2_loc (input_location, EQ_EXPR, logical_type_node, tmp, fold_convert (TREE_TYPE (tmp), null_pointer_node)); return build3_v (COND_EXPR, tmp, null_expr, non_null_expr); @@ -8666,7 +8666,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2) lsize = gfc_evaluate_now (lsize, &block); rsize = gfc_evaluate_now (rsize, &block); - fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + fault = fold_build2_loc (input_location, LT_EXPR, logical_type_node, rsize, lsize); msg = _("Target of rank remapping is too small (%ld < %ld)"); @@ -8785,7 +8785,7 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts, /* Are the rhs and the lhs the same? */ if (deep_copy) { - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, gfc_build_addr_expr (NULL_TREE, lse->expr), gfc_build_addr_expr (NULL_TREE, rse->expr)); cond = gfc_evaluate_now (cond, &lse->pre); @@ -9060,7 +9060,7 @@ fcncall_realloc_result (gfc_se *se, int rank) the lhs descriptor. */ tmp = gfc_conv_descriptor_data_get (desc); zero_cond = fold_build2_loc (input_location, EQ_EXPR, - boolean_type_node, tmp, + logical_type_node, tmp, build_int_cst (TREE_TYPE (tmp), 0)); zero_cond = gfc_evaluate_now (zero_cond, &se->post); tmp = gfc_call_free (tmp); @@ -9084,11 +9084,11 @@ fcncall_realloc_result (gfc_se *se, int rank) tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, tmp, tmp1); tmp = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, tmp, + logical_type_node, tmp, gfc_index_zero_node); tmp = gfc_evaluate_now (tmp, &se->post); zero_cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, tmp, + logical_type_node, tmp, zero_cond); } @@ -9527,7 +9527,7 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block, /* Do the allocation if the lhs is NULL. Otherwise go to label 1. */ tmp = build_int_cst (TREE_TYPE (lse.expr), 0); - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, lse.expr, tmp); tmp = build3_v (COND_EXPR, cond, build1_v (GOTO_EXPR, jump_label1), @@ -9605,7 +9605,7 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block, rhs are different. */ if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred) { - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, lse.string_length, size); /* Jump past the realloc if the lengths are the same. */ tmp = build3_v (COND_EXPR, cond, @@ -9751,7 +9751,7 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs, gfc_init_block (&alloc); gfc_allocate_using_malloc (&alloc, class_han, tmp, NULL_TREE); tmp = fold_build2_loc (input_location, EQ_EXPR, - boolean_type_node, class_han, + logical_type_node, class_han, build_int_cst (prvoid_type_node, 0)); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, gfc_unlikely (tmp, @@ -9804,7 +9804,7 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs, extcopy = build_call_vec (TREE_TYPE (TREE_TYPE (fcn)), fcn, args); tmp = fold_build2_loc (input_location, GT_EXPR, - boolean_type_node, from_len, + logical_type_node, from_len, integer_zero_node); return fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp, @@ -10033,7 +10033,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, if (TREE_CODE (lse.expr) == ARRAY_REF) tmp = gfc_build_addr_expr (NULL_TREE, tmp); - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, tmp, build_int_cst (TREE_TYPE (tmp), 0)); msg = _("Assignment of scalar to unallocated array"); gfc_trans_runtime_check (true, false, cond, &loop.pre, diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 6032727d34d..1ca00c132f2 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -358,7 +358,7 @@ build_fixbound_expr (stmtblock_t * pblock, tree arg, tree type, int up) tmp = convert (argtype, intval); cond = fold_build2_loc (input_location, up ? GE_EXPR : LE_EXPR, - boolean_type_node, tmp, arg); + logical_type_node, tmp, arg); tmp = fold_build2_loc (input_location, up ? PLUS_EXPR : MINUS_EXPR, type, intval, build_int_cst (type, 1)); @@ -490,14 +490,14 @@ gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum rounding_mode op) n = gfc_validate_kind (BT_INTEGER, kind, false); mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE); tmp = gfc_conv_mpfr_to_tree (huge, kind, 0); - cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, arg[0], + cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node, arg[0], tmp); mpfr_neg (huge, huge, GFC_RND_MODE); tmp = gfc_conv_mpfr_to_tree (huge, kind, 0); - tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, arg[0], + tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node, arg[0], tmp); - cond = fold_build2_loc (input_location, TRUTH_AND_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, TRUTH_AND_EXPR, logical_type_node, cond, tmp); itype = gfc_get_int_type (kind); @@ -885,7 +885,7 @@ gfc_trans_same_strlen_check (const char* intr_name, locus* where, return; /* Compare the two string lengths. */ - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, a, b); + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, a, b); /* Output the runtime-check. */ name = gfc_build_cstring_const (intr_name); @@ -1962,7 +1962,7 @@ conv_caf_send (gfc_code *code) { TYPE_SIZE_UNIT ( gfc_typenode_for_spec (&lhs_expr->ts)), NULL_TREE); - tmp = fold_build2 (EQ_EXPR, boolean_type_node, scal_se.expr, + tmp = fold_build2 (EQ_EXPR, logical_type_node, scal_se.expr, null_pointer_node); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp, gfc_finish_block (&scal_se.pre), @@ -2254,14 +2254,14 @@ trans_this_image (gfc_se * se, gfc_expr *expr) else if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) { dim_arg = gfc_evaluate_now (dim_arg, &se->pre); - cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node, dim_arg, build_int_cst (TREE_TYPE (dim_arg), 1)); tmp = gfc_rank_cst[GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc))]; - tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node, dim_arg, tmp); cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, - boolean_type_node, cond, tmp); + logical_type_node, cond, tmp); gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where, gfc_msg_fault); } @@ -2352,7 +2352,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr) m, extent)); /* Exit condition: if (i >= min_var) goto exit_label. */ - cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, loop_var, + cond = fold_build2_loc (input_location, GE_EXPR, logical_type_node, loop_var, min_var); tmp = build1_v (GOTO_EXPR, exit_label); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp, @@ -2377,7 +2377,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr) /* sub(co_dim) = (co_dim < corank) ? ml - m*extent + lcobound(dim_arg) : m + lcobound(corank) */ - cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, dim_arg, + cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node, dim_arg, build_int_cst (TREE_TYPE (dim_arg), corank)); lbound = gfc_conv_descriptor_lbound_get (desc, @@ -2415,7 +2415,7 @@ conv_intrinsic_image_status (gfc_se *se, gfc_expr *expr) { tree arg; arg = gfc_evaluate_now (args[0], &se->pre); - tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, fold_convert (integer_type_node, arg), integer_one_node); tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, @@ -2466,7 +2466,7 @@ trans_image_index (gfc_se * se, gfc_expr *expr) lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[rank+corank-1]); tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[corank-1], NULL); - invalid_bound = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + invalid_bound = fold_build2_loc (input_location, LT_EXPR, logical_type_node, fold_convert (gfc_array_index_type, tmp), lbound); @@ -2475,16 +2475,16 @@ trans_image_index (gfc_se * se, gfc_expr *expr) lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[codim]); ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[codim]); tmp = gfc_build_array_ref (subdesc, gfc_rank_cst[codim-rank], NULL); - cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node, fold_convert (gfc_array_index_type, tmp), lbound); invalid_bound = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, invalid_bound, cond); - cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + logical_type_node, invalid_bound, cond); + cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node, fold_convert (gfc_array_index_type, tmp), ubound); invalid_bound = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, invalid_bound, cond); + logical_type_node, invalid_bound, cond); } invalid_bound = gfc_unlikely (invalid_bound, PRED_FORTRAN_INVALID_BOUND); @@ -2544,11 +2544,11 @@ trans_image_index (gfc_se * se, gfc_expr *expr) tmp = gfc_create_var (type, NULL); gfc_add_modify (&se->pre, tmp, coindex); - cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, tmp, + cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node, tmp, num_images); - cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, logical_type_node, cond, - fold_convert (boolean_type_node, invalid_bound)); + fold_convert (logical_type_node, invalid_bound)); se->expr = fold_build3_loc (input_location, COND_EXPR, type, cond, build_int_cst (type, 0), tmp); } @@ -2679,16 +2679,16 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) { bound = gfc_evaluate_now (bound, &se->pre); - cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node, bound, build_int_cst (TREE_TYPE (bound), 0)); if (as && as->type == AS_ASSUMED_RANK) tmp = gfc_conv_descriptor_rank (desc); else tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))]; - tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node, bound, fold_convert(TREE_TYPE (bound), tmp)); cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, - boolean_type_node, cond, tmp); + logical_type_node, cond, tmp); gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where, gfc_msg_fault); } @@ -2734,27 +2734,27 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) { tree stride = gfc_conv_descriptor_stride_get (desc, bound); - cond1 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, + cond1 = fold_build2_loc (input_location, GE_EXPR, logical_type_node, ubound, lbound); - cond3 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, + cond3 = fold_build2_loc (input_location, GE_EXPR, logical_type_node, stride, gfc_index_zero_node); cond3 = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, cond3, cond1); - cond4 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + logical_type_node, cond3, cond1); + cond4 = fold_build2_loc (input_location, LT_EXPR, logical_type_node, stride, gfc_index_zero_node); if (upper) { tree cond5; cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, cond3, cond4); - cond5 = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + logical_type_node, cond3, cond4); + cond5 = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, gfc_index_one_node, lbound); cond5 = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, cond4, cond5); + logical_type_node, cond4, cond5); cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, cond, cond5); + logical_type_node, cond, cond5); if (assumed_rank_lb_one) { @@ -2773,16 +2773,16 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) else { if (as->type == AS_ASSUMED_SIZE) - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, bound, build_int_cst (TREE_TYPE (bound), arg->expr->rank - 1)); else - cond = boolean_false_node; + cond = logical_false_node; cond1 = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, cond3, cond4); + logical_type_node, cond3, cond4); cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, cond, cond1); + logical_type_node, cond, cond1); se->expr = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond, @@ -2872,13 +2872,13 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr) else if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) { bound = gfc_evaluate_now (bound, &se->pre); - cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node, bound, build_int_cst (TREE_TYPE (bound), 1)); tmp = gfc_rank_cst[GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc))]; - tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node, bound, tmp); cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, - boolean_type_node, cond, tmp); + logical_type_node, cond, tmp); gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where, gfc_msg_fault); } @@ -2947,7 +2947,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr) if (corank > 1) { - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, bound, build_int_cst (TREE_TYPE (bound), arg->expr->rank + corank - 1)); @@ -3136,16 +3136,16 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo) tmp = gfc_evaluate_now (se->expr, &se->pre); if (!flag_signed_zeros) { - test = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + test = fold_build2_loc (input_location, LT_EXPR, logical_type_node, args[0], zero); - test2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + test2 = fold_build2_loc (input_location, LT_EXPR, logical_type_node, args[1], zero); test2 = fold_build2_loc (input_location, TRUTH_XOR_EXPR, - boolean_type_node, test, test2); - test = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + logical_type_node, test, test2); + test = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp, zero); test = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, test, test2); + logical_type_node, test, test2); test = gfc_evaluate_now (test, &se->pre); se->expr = fold_build3_loc (input_location, COND_EXPR, type, test, fold_build2_loc (input_location, @@ -3158,18 +3158,18 @@ gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo) tree expr1, copysign, cscall; copysign = gfc_builtin_decl_for_float_kind (BUILT_IN_COPYSIGN, expr->ts.kind); - test = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + test = fold_build2_loc (input_location, LT_EXPR, logical_type_node, args[0], zero); - test2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + test2 = fold_build2_loc (input_location, LT_EXPR, logical_type_node, args[1], zero); test2 = fold_build2_loc (input_location, TRUTH_XOR_EXPR, - boolean_type_node, test, test2); + logical_type_node, test, test2); expr1 = fold_build3_loc (input_location, COND_EXPR, type, test2, fold_build2_loc (input_location, PLUS_EXPR, type, tmp, args[1]), tmp); - test = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + test = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp, zero); cscall = build_call_expr_loc (input_location, copysign, 2, zero, args[1]); @@ -3225,12 +3225,12 @@ gfc_conv_intrinsic_dshift (gfc_se * se, gfc_expr * expr, bool dshiftl) res = fold_build2_loc (input_location, BIT_IOR_EXPR, type, left, right); /* Special cases. */ - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, shift, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, shift, build_int_cst (stype, 0)); res = fold_build3_loc (input_location, COND_EXPR, type, cond, dshiftl ? arg1 : arg2, res); - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, shift, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, shift, build_int_cst (stype, bitsize)); res = fold_build3_loc (input_location, COND_EXPR, type, cond, dshiftl ? arg2 : arg1, res); @@ -3257,7 +3257,7 @@ gfc_conv_intrinsic_dim (gfc_se * se, gfc_expr * expr) val = gfc_evaluate_now (val, &se->pre); zero = gfc_build_const (type, integer_zero_node); - tmp = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, val, zero); + tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node, val, zero); se->expr = fold_build3_loc (input_location, COND_EXPR, type, tmp, zero, val); } @@ -3290,7 +3290,7 @@ gfc_conv_intrinsic_sign (gfc_se * se, gfc_expr * expr) { tree cond, zero; zero = build_real_from_int_cst (TREE_TYPE (args[1]), integer_zero_node); - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, args[1], zero); se->expr = fold_build3_loc (input_location, COND_EXPR, TREE_TYPE (args[0]), cond, @@ -3411,7 +3411,7 @@ gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr) gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary afterwards, if necessary. */ - cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node, len, build_int_cst (TREE_TYPE (len), 0)); tmp = gfc_call_free (var); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location)); @@ -3450,7 +3450,7 @@ gfc_conv_intrinsic_fdate (gfc_se * se, gfc_expr * expr) gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary afterwards, if necessary. */ - cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node, len, build_int_cst (TREE_TYPE (len), 0)); tmp = gfc_call_free (var); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location)); @@ -3660,7 +3660,7 @@ gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr) gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary afterwards, if necessary. */ - cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node, len, build_int_cst (TREE_TYPE (len), 0)); tmp = gfc_call_free (var); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location)); @@ -3724,7 +3724,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op) && argexpr->expr->symtree->n.sym->attr.optional && TREE_CODE (val) == INDIRECT_REF) cond = fold_build2_loc (input_location, - NE_EXPR, boolean_type_node, + NE_EXPR, logical_type_node, TREE_OPERAND (val, 0), build_int_cst (TREE_TYPE (TREE_OPERAND (val, 0)), 0)); else @@ -3738,7 +3738,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op) thencase = build2_v (MODIFY_EXPR, mvar, convert (type, val)); - tmp = fold_build2_loc (input_location, op, boolean_type_node, + tmp = fold_build2_loc (input_location, op, logical_type_node, convert (type, val), mvar); /* FIXME: When the IEEE_ARITHMETIC module is implemented, the call to @@ -3750,8 +3750,8 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op) builtin_decl_explicit (BUILT_IN_ISNAN), 1, mvar); tmp = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, tmp, - fold_convert (boolean_type_node, isnan)); + logical_type_node, tmp, + fold_convert (logical_type_node, isnan)); } tmp = build3_v (COND_EXPR, tmp, thencase, build_empty_stmt (input_location)); @@ -3803,7 +3803,7 @@ gfc_conv_intrinsic_minmax_char (gfc_se * se, gfc_expr * expr, int op) gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary afterwards, if necessary. */ - cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node, len, build_int_cst (TREE_TYPE (len), 0)); tmp = gfc_call_free (var); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location)); @@ -4003,7 +4003,7 @@ gfc_conv_intrinsic_anyall (gfc_se * se, gfc_expr * expr, enum tree_code op) gfc_conv_expr_val (&arrayse, actual->expr); gfc_add_block_to_block (&body, &arrayse.pre); - tmp = fold_build2_loc (input_location, op, boolean_type_node, arrayse.expr, + tmp = fold_build2_loc (input_location, op, logical_type_node, arrayse.expr, build_int_cst (TREE_TYPE (arrayse.expr), 0)); tmp = build3_v (COND_EXPR, tmp, found, build_empty_stmt (input_location)); gfc_add_expr_to_block (&body, tmp); @@ -4282,13 +4282,13 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, gfc_add_modify (&ifblock3, resvar, res2); res2 = gfc_finish_block (&ifblock3); - cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node, absX, scale); tmp = build3_v (COND_EXPR, cond, res1, res2); gfc_add_expr_to_block (&ifblock1, tmp); tmp = gfc_finish_block (&ifblock1); - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, arrayse.expr, gfc_build_const (type, integer_zero_node)); @@ -4594,7 +4594,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) nonempty = gfc_conv_mpz_to_tree (asize, gfc_index_integer_kind); mpz_clear (asize); nonempty = fold_build2_loc (input_location, GT_EXPR, - boolean_type_node, nonempty, + logical_type_node, nonempty, gfc_index_zero_node); } maskss = NULL; @@ -4658,7 +4658,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) gcc_assert (loop.dimen == 1); if (nonempty == NULL && maskss == NULL && loop.from[0] && loop.to[0]) - nonempty = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, + nonempty = fold_build2_loc (input_location, LE_EXPR, logical_type_node, loop.from[0], loop.to[0]); lab1 = NULL; @@ -4734,7 +4734,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) loop.loopvar[0], offset); gfc_add_modify (&ifblock2, pos, tmp); ifbody2 = gfc_finish_block (&ifblock2); - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pos, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, pos, gfc_index_zero_node); tmp = build3_v (COND_EXPR, cond, ifbody2, build_empty_stmt (input_location)); @@ -4755,9 +4755,9 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) if (lab1) cond = fold_build2_loc (input_location, op == GT_EXPR ? GE_EXPR : LE_EXPR, - boolean_type_node, arrayse.expr, limit); + logical_type_node, arrayse.expr, limit); else - cond = fold_build2_loc (input_location, op, boolean_type_node, + cond = fold_build2_loc (input_location, op, logical_type_node, arrayse.expr, limit); ifbody = build3_v (COND_EXPR, cond, ifbody, @@ -4828,7 +4828,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) ifbody = gfc_finish_block (&ifblock); - cond = fold_build2_loc (input_location, op, boolean_type_node, + cond = fold_build2_loc (input_location, op, logical_type_node, arrayse.expr, limit); tmp = build3_v (COND_EXPR, cond, ifbody, @@ -5080,7 +5080,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) nonempty = gfc_conv_mpz_to_tree (asize, gfc_index_integer_kind); mpz_clear (asize); nonempty = fold_build2_loc (input_location, GT_EXPR, - boolean_type_node, nonempty, + logical_type_node, nonempty, gfc_index_zero_node); } maskss = NULL; @@ -5114,15 +5114,15 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) if (nonempty == NULL && maskss == NULL && loop.dimen == 1 && loop.from[0] && loop.to[0]) - nonempty = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, + nonempty = fold_build2_loc (input_location, LE_EXPR, logical_type_node, loop.from[0], loop.to[0]); nonempty_var = NULL; if (nonempty == NULL && (HONOR_INFINITIES (DECL_MODE (limit)) || HONOR_NANS (DECL_MODE (limit)))) { - nonempty_var = gfc_create_var (boolean_type_node, "nonempty"); - gfc_add_modify (&se->pre, nonempty_var, boolean_false_node); + nonempty_var = gfc_create_var (logical_type_node, "nonempty"); + gfc_add_modify (&se->pre, nonempty_var, logical_false_node); nonempty = nonempty_var; } lab = NULL; @@ -5136,8 +5136,8 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) } else { - fast = gfc_create_var (boolean_type_node, "fast"); - gfc_add_modify (&se->pre, fast, boolean_false_node); + fast = gfc_create_var (logical_type_node, "fast"); + gfc_add_modify (&se->pre, fast, logical_false_node); } } @@ -5171,12 +5171,12 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) gfc_init_block (&block2); if (nonempty_var) - gfc_add_modify (&block2, nonempty_var, boolean_true_node); + gfc_add_modify (&block2, nonempty_var, logical_true_node); if (HONOR_NANS (DECL_MODE (limit))) { tmp = fold_build2_loc (input_location, op == GT_EXPR ? GE_EXPR : LE_EXPR, - boolean_type_node, arrayse.expr, limit); + logical_type_node, arrayse.expr, limit); if (lab) ifbody = build1_v (GOTO_EXPR, lab); else @@ -5185,7 +5185,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) gfc_init_block (&ifblock); gfc_add_modify (&ifblock, limit, arrayse.expr); - gfc_add_modify (&ifblock, fast, boolean_true_node); + gfc_add_modify (&ifblock, fast, logical_true_node); ifbody = gfc_finish_block (&ifblock); } tmp = build3_v (COND_EXPR, tmp, ifbody, @@ -5198,7 +5198,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) signed zeros. */ if (HONOR_SIGNED_ZEROS (DECL_MODE (limit))) { - tmp = fold_build2_loc (input_location, op, boolean_type_node, + tmp = fold_build2_loc (input_location, op, logical_type_node, arrayse.expr, limit); ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr); tmp = build3_v (COND_EXPR, tmp, ifbody, @@ -5223,7 +5223,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) if (HONOR_NANS (DECL_MODE (limit)) || HONOR_SIGNED_ZEROS (DECL_MODE (limit))) { - tmp = fold_build2_loc (input_location, op, boolean_type_node, + tmp = fold_build2_loc (input_location, op, logical_type_node, arrayse.expr, limit); ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr); ifbody = build3_v (COND_EXPR, tmp, ifbody, @@ -5286,7 +5286,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) if (HONOR_NANS (DECL_MODE (limit)) || HONOR_SIGNED_ZEROS (DECL_MODE (limit))) { - tmp = fold_build2_loc (input_location, op, boolean_type_node, + tmp = fold_build2_loc (input_location, op, logical_type_node, arrayse.expr, limit); ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr); tmp = build3_v (COND_EXPR, tmp, ifbody, @@ -5376,7 +5376,7 @@ gfc_conv_intrinsic_btest (gfc_se * se, gfc_expr * expr) tmp = fold_build2_loc (input_location, LSHIFT_EXPR, type, build_int_cst (type, 1), args[1]); tmp = fold_build2_loc (input_location, BIT_AND_EXPR, type, args[0], tmp); - tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp, + tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp, build_int_cst (type, 0)); type = gfc_typenode_for_spec (&expr->ts); se->expr = convert (type, tmp); @@ -5404,7 +5404,7 @@ gfc_conv_intrinsic_bitcomp (gfc_se * se, gfc_expr * expr, enum tree_code op) args[0] = fold_convert (TREE_TYPE (args[1]), args[0]); /* Now, we compare them. */ - se->expr = fold_build2_loc (input_location, op, boolean_type_node, + se->expr = fold_build2_loc (input_location, op, logical_type_node, args[0], args[1]); } @@ -5505,7 +5505,7 @@ gfc_conv_intrinsic_shift (gfc_se * se, gfc_expr * expr, bool right_shift, gcc requires a shift width < BIT_SIZE(I), so we have to catch this special case. */ num_bits = build_int_cst (TREE_TYPE (args[1]), TYPE_PRECISION (type)); - cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, GE_EXPR, logical_type_node, args[1], num_bits); se->expr = fold_build3_loc (input_location, COND_EXPR, type, cond, @@ -5551,7 +5551,7 @@ gfc_conv_intrinsic_ishft (gfc_se * se, gfc_expr * expr) rshift = fold_convert (type, fold_build2_loc (input_location, RSHIFT_EXPR, utype, convert (utype, args[0]), width)); - tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, args[1], + tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node, args[1], build_int_cst (TREE_TYPE (args[1]), 0)); tmp = fold_build3_loc (input_location, COND_EXPR, type, tmp, lshift, rshift); @@ -5559,7 +5559,7 @@ gfc_conv_intrinsic_ishft (gfc_se * se, gfc_expr * expr) gcc requires a shift width < BIT_SIZE(I), so we have to catch this special case. */ num_bits = build_int_cst (TREE_TYPE (args[1]), TYPE_PRECISION (type)); - cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, width, + cond = fold_build2_loc (input_location, GE_EXPR, logical_type_node, width, num_bits); se->expr = fold_build3_loc (input_location, COND_EXPR, type, cond, build_int_cst (type, 0), tmp); @@ -5643,12 +5643,12 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr) rrot = fold_build2_loc (input_location,RROTATE_EXPR, type, args[0], tmp); zero = build_int_cst (TREE_TYPE (args[1]), 0); - tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, args[1], + tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node, args[1], zero); rrot = fold_build3_loc (input_location, COND_EXPR, type, tmp, lrot, rrot); /* Do nothing if shift == 0. */ - tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, args[1], + tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, args[1], zero); se->expr = fold_build3_loc (input_location, COND_EXPR, type, tmp, args[0], rrot); @@ -5746,7 +5746,7 @@ gfc_conv_intrinsic_leadz (gfc_se * se, gfc_expr * expr) fold_convert (arg_type, ullmax), ullsize); cond = fold_build2_loc (input_location, BIT_AND_EXPR, arg_type, arg, cond); - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, cond, build_int_cst (arg_type, 0)); tmp1 = fold_build2_loc (input_location, RSHIFT_EXPR, arg_type, @@ -5770,7 +5770,7 @@ gfc_conv_intrinsic_leadz (gfc_se * se, gfc_expr * expr) /* Build BIT_SIZE. */ bit_size = build_int_cst (result_type, argsize); - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, arg, build_int_cst (arg_type, 0)); se->expr = fold_build3_loc (input_location, COND_EXPR, result_type, cond, bit_size, leadz); @@ -5855,7 +5855,7 @@ gfc_conv_intrinsic_trailz (gfc_se * se, gfc_expr *expr) cond = fold_build2_loc (input_location, BIT_AND_EXPR, arg_type, arg, fold_convert (arg_type, ullmax)); - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, cond, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, cond, build_int_cst (arg_type, 0)); tmp1 = fold_build2_loc (input_location, RSHIFT_EXPR, arg_type, @@ -5879,7 +5879,7 @@ gfc_conv_intrinsic_trailz (gfc_se * se, gfc_expr *expr) /* Build BIT_SIZE. */ bit_size = build_int_cst (result_type, argsize); - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, arg, build_int_cst (arg_type, 0)); se->expr = fold_build3_loc (input_location, COND_EXPR, result_type, cond, bit_size, trailz); @@ -6312,7 +6312,7 @@ gfc_conv_intrinsic_mask (gfc_se * se, gfc_expr * expr, int left) /* Special case arg == 0, because SHIFT_EXPR wants a shift strictly smaller than type width. */ - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, arg, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, arg, build_int_cst (TREE_TYPE (arg), 0)); res = fold_build3_loc (input_location, COND_EXPR, utype, cond, build_int_cst (utype, 0), res); @@ -6326,7 +6326,7 @@ gfc_conv_intrinsic_mask (gfc_se * se, gfc_expr * expr, int left) /* Special case agr == bit_size, because SHIFT_EXPR wants a shift strictly smaller than type width. */ - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, arg, bitsize); res = fold_build3_loc (input_location, COND_EXPR, utype, cond, allones, res); @@ -6447,7 +6447,7 @@ gfc_conv_intrinsic_spacing (gfc_se * se, gfc_expr * expr) gfc_add_modify (&block, res, tmp); /* Finish by building the IF statement for value zero. */ - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, arg, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, arg, build_real_from_int_cst (type, integer_zero_node)); tmp = build3_v (COND_EXPR, cond, build2_v (MODIFY_EXPR, res, tiny), gfc_finish_block (&block)); @@ -6518,7 +6518,7 @@ gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr) stmt = gfc_finish_block (&block); /* if (x != 0) */ - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, x, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, x, build_real_from_int_cst (type, integer_zero_node)); tmp = build3_v (COND_EXPR, cond, stmt, build_empty_stmt (input_location)); @@ -6648,7 +6648,7 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) argse.data_not_needed = 1; gfc_conv_expr (&argse, actual->expr); gfc_add_block_to_block (&se->pre, &argse.pre); - tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, argse.expr, null_pointer_node); tmp = gfc_evaluate_now (tmp, &se->pre); se->expr = fold_build3_loc (input_location, COND_EXPR, @@ -6817,7 +6817,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr) } exit: */ gfc_start_block (&body); - cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, GE_EXPR, logical_type_node, loop_var, tmp); tmp = build1_v (GOTO_EXPR, exit_label); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, @@ -7088,7 +7088,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) /* Clean up if it was repacked. */ gfc_init_block (&block); tmp = gfc_conv_array_data (argse.expr); - tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, source, tmp); tmp = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt (input_location)); @@ -7313,14 +7313,14 @@ scalar_transfer: indirect = gfc_finish_block (&block); /* Wrap it up with the condition. */ - tmp = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node, dest_word_len, source_bytes); tmp = build3_v (COND_EXPR, tmp, direct, indirect); gfc_add_expr_to_block (&se->pre, tmp); /* Free the temporary string, if necessary. */ free = gfc_call_free (tmpdecl); - tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, GT_EXPR, logical_type_node, dest_word_len, source_bytes); tmp = build3_v (COND_EXPR, tmp, free, build_empty_stmt (input_location)); gfc_add_expr_to_block (&se->post, tmp); @@ -7462,7 +7462,7 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr) tmp = gfc_conv_descriptor_data_get (arg1se.expr); } - tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp, + tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp, fold_convert (TREE_TYPE (tmp), null_pointer_node)); } se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp); @@ -7530,7 +7530,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) } gfc_add_block_to_block (&se->pre, &arg1se.pre); gfc_add_block_to_block (&se->post, &arg1se.post); - tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp2, + tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp2, fold_convert (TREE_TYPE (tmp2), null_pointer_node)); se->expr = tmp; } @@ -7543,7 +7543,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) nonzero_charlen = NULL_TREE; if (arg1->expr->ts.type == BT_CHARACTER) nonzero_charlen = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, + logical_type_node, arg1->expr->ts.u.cl->backend_decl, integer_zero_node); if (scalar) @@ -7568,12 +7568,12 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) gfc_add_block_to_block (&se->post, &arg1se.post); gfc_add_block_to_block (&se->pre, &arg2se.pre); gfc_add_block_to_block (&se->post, &arg2se.post); - tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, arg1se.expr, arg2se.expr); - tmp2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tmp2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node, arg1se.expr, null_pointer_node); se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, tmp, tmp2); + logical_type_node, tmp, tmp2); } else { @@ -7591,7 +7591,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) tmp = gfc_rank_cst[arg1->expr->rank - 1]; tmp = gfc_conv_descriptor_stride_get (arg1se.expr, tmp); nonzero_arraylen = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, tmp, + logical_type_node, tmp, build_int_cst (TREE_TYPE (tmp), 0)); /* A pointer to an array, call library function _gfor_associated. */ @@ -7605,9 +7605,9 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) se->expr = build_call_expr_loc (input_location, gfor_fndecl_associated, 2, arg1se.expr, arg2se.expr); - se->expr = convert (boolean_type_node, se->expr); + se->expr = convert (logical_type_node, se->expr); se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, se->expr, + logical_type_node, se->expr, nonzero_arraylen); } @@ -7615,7 +7615,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) be associated. */ if (nonzero_charlen != NULL_TREE) se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, + logical_type_node, se->expr, nonzero_charlen); } @@ -7643,14 +7643,14 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr) if (UNLIMITED_POLY (a)) { tmp = gfc_class_vptr_get (a->symtree->n.sym->backend_decl); - conda = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + conda = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp, build_int_cst (TREE_TYPE (tmp), 0)); } if (UNLIMITED_POLY (b)) { tmp = gfc_class_vptr_get (b->symtree->n.sym->backend_decl); - condb = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + condb = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp, build_int_cst (TREE_TYPE (tmp), 0)); } @@ -7676,16 +7676,16 @@ gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr) gfc_conv_expr (&se2, b); tmp = fold_build2_loc (input_location, EQ_EXPR, - boolean_type_node, se1.expr, + logical_type_node, se1.expr, fold_convert (TREE_TYPE (se1.expr), se2.expr)); if (conda) tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, - boolean_type_node, conda, tmp); + logical_type_node, conda, tmp); if (condb) tmp = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, - boolean_type_node, condb, tmp); + logical_type_node, condb, tmp); se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp); } @@ -7811,7 +7811,7 @@ 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 = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node, len, build_int_cst (TREE_TYPE (len), 0)); tmp = gfc_call_free (var); tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location)); @@ -7845,7 +7845,7 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) ncopies_type = TREE_TYPE (ncopies); /* Check that NCOPIES is not negative. */ - cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, ncopies, + cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node, ncopies, build_int_cst (ncopies_type, 0)); gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where, "Argument NCOPIES of REPEAT intrinsic is negative " @@ -7855,7 +7855,7 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) /* If the source length is zero, any non negative value of NCOPIES is valid, and nothing happens. */ n = gfc_create_var (ncopies_type, "ncopies"); - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, slen, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, slen, build_int_cst (size_type_node, 0)); tmp = fold_build3_loc (input_location, COND_EXPR, ncopies_type, cond, build_int_cst (ncopies_type, 0), ncopies); @@ -7872,13 +7872,13 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) fold_convert (size_type_node, max), slen); largest = TYPE_PRECISION (size_type_node) > TYPE_PRECISION (ncopies_type) ? size_type_node : ncopies_type; - cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node, fold_convert (largest, ncopies), fold_convert (largest, max)); - tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, slen, + tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, slen, build_int_cst (size_type_node, 0)); - cond = fold_build3_loc (input_location, COND_EXPR, boolean_type_node, tmp, - boolean_false_node, cond); + cond = fold_build3_loc (input_location, COND_EXPR, logical_type_node, tmp, + logical_false_node, cond); gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where, "Argument NCOPIES of REPEAT intrinsic is too large"); @@ -7901,7 +7901,7 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) gfc_start_block (&body); /* Exit the loop if count >= ncopies. */ - cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, count, + cond = fold_build2_loc (input_location, GE_EXPR, logical_type_node, count, ncopies); tmp = build1_v (GOTO_EXPR, exit_label); TREE_USED (exit_label) = 1; @@ -8050,7 +8050,7 @@ conv_isocbinding_function (gfc_se *se, gfc_expr *expr) if (arg->next->expr == NULL) /* Only given one arg so generate a null and do a not-equal comparison against the first arg. */ - se->expr = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + se->expr = fold_build2_loc (input_location, NE_EXPR, logical_type_node, arg1se.expr, fold_convert (TREE_TYPE (arg1se.expr), null_pointer_node)); @@ -8066,17 +8066,17 @@ conv_isocbinding_function (gfc_se *se, gfc_expr *expr) gfc_add_block_to_block (&se->post, &arg2se.post); /* Generate test to compare that the two args are equal. */ - eq_expr = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + eq_expr = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, arg1se.expr, arg2se.expr); /* Generate test to ensure that the first arg is not null. */ not_null_expr = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, + logical_type_node, arg1se.expr, null_pointer_node); /* Finally, the generated test must check that both arg1 is not NULL and that it is equal to the second arg. */ se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, + logical_type_node, not_null_expr, eq_expr); } } @@ -8301,11 +8301,11 @@ conv_intrinsic_ieee_is_normal (gfc_se * se, gfc_expr * expr) isnormal = build_call_expr_loc (input_location, builtin_decl_explicit (BUILT_IN_ISNORMAL), 1, arg); - iszero = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, arg, + iszero = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, arg, build_real_from_int_cst (TREE_TYPE (arg), integer_zero_node)); se->expr = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, isnormal, iszero); + logical_type_node, isnormal, iszero); se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), se->expr); } @@ -8330,11 +8330,11 @@ conv_intrinsic_ieee_is_negative (gfc_se * se, gfc_expr * expr) signbit = build_call_expr_loc (input_location, builtin_decl_explicit (BUILT_IN_SIGNBIT), 1, arg); - signbit = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + signbit = fold_build2_loc (input_location, NE_EXPR, logical_type_node, signbit, integer_zero_node); se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR, - boolean_type_node, signbit, + logical_type_node, signbit, fold_build1_loc (input_location, TRUTH_NOT_EXPR, TREE_TYPE(isnan), isnan)); @@ -8480,7 +8480,7 @@ conv_intrinsic_ieee_copy_sign (gfc_se * se, gfc_expr * expr) sign = build_call_expr_loc (input_location, builtin_decl_explicit (BUILT_IN_SIGNBIT), 1, args[1]); - sign = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + sign = fold_build2_loc (input_location, NE_EXPR, logical_type_node, sign, integer_zero_node); /* Create a value of one, with the right sign. */ @@ -10546,7 +10546,7 @@ conv_intrinsic_move_alloc (gfc_code *code) tmp = gfc_conv_descriptor_data_get (to_se.expr); cond = fold_build2_loc (input_location, EQ_EXPR, - boolean_type_node, tmp, + logical_type_node, tmp, fold_convert (TREE_TYPE (tmp), null_pointer_node)); tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all, diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index aa974eb3805..af8ee02494d 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -581,7 +581,7 @@ set_parameter_value_chk (stmtblock_t *block, bool has_iostat, tree var, /* 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_loc (input_location, LT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node, se.expr, fold_convert (TREE_TYPE (se.expr), val)); gfc_trans_io_runtime_check (has_iostat, cond, var, LIBERROR_BAD_UNIT, @@ -590,7 +590,7 @@ set_parameter_value_chk (stmtblock_t *block, bool has_iostat, tree var, /* UNIT numbers should be less than the max. */ val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4); - cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node, se.expr, fold_convert (TREE_TYPE (se.expr), val)); gfc_trans_io_runtime_check (has_iostat, cond, var, LIBERROR_BAD_UNIT, @@ -641,17 +641,17 @@ set_parameter_value_inquire (stmtblock_t *block, tree var, /* UNIT numbers should be greater than zero. */ i = gfc_validate_kind (BT_INTEGER, 4, false); - cond1 = build2_loc (input_location, LT_EXPR, boolean_type_node, + cond1 = build2_loc (input_location, LT_EXPR, logical_type_node, se.expr, fold_convert (TREE_TYPE (se.expr), integer_zero_node)); /* UNIT numbers should be less than the max. */ val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4); - cond2 = build2_loc (input_location, GT_EXPR, boolean_type_node, + cond2 = build2_loc (input_location, GT_EXPR, logical_type_node, se.expr, fold_convert (TREE_TYPE (se.expr), val)); cond3 = build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, cond1, cond2); + logical_type_node, cond1, cond2); gfc_start_block (&newblock); @@ -826,7 +826,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_loc (input_location, LT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, LT_EXPR, logical_type_node, tmp, build_int_cst (TREE_TYPE (tmp), 0)); msg = xasprintf ("Label assigned to variable '%s' (%%ld) is not a format " diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 662036f514d..bf96b695778 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -413,7 +413,7 @@ gfc_walk_alloc_comps (tree decl, tree dest, tree var, { tem = fold_convert (pvoid_type_node, tem); tem = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, tem, + logical_type_node, tem, null_pointer_node); then_b = build3_loc (input_location, COND_EXPR, void_type_node, tem, then_b, @@ -540,7 +540,7 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer) GFC_DESCRIPTOR_TYPE_P (type) ? gfc_conv_descriptor_data_get (outer) : outer); tem = unshare_expr (tem); - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tem, null_pointer_node); gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, @@ -646,7 +646,7 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src) build_zero_cst (TREE_TYPE (dest))); else_b = gfc_finish_block (&cond_block); - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, unshare_expr (srcptr), null_pointer_node); gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, @@ -699,7 +699,7 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src) GFC_DESCRIPTOR_TYPE_P (type) ? gfc_conv_descriptor_data_get (dest) : dest); tem = unshare_expr (tem); - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tem, null_pointer_node); tem = build3_loc (input_location, COND_EXPR, void_type_node, cond, then_b, build_empty_stmt (input_location)); @@ -739,7 +739,7 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src) destptr = fold_convert (pvoid_type_node, destptr); gfc_add_modify (&cond_block, ptr, destptr); - nonalloc = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + nonalloc = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, destptr, null_pointer_node); cond = nonalloc; if (GFC_DESCRIPTOR_TYPE_P (type)) @@ -755,11 +755,11 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src) tem = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, tem, gfc_conv_descriptor_lbound_get (dest, rank)); - tem = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tem = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tem, gfc_conv_descriptor_ubound_get (dest, rank)); cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, - boolean_type_node, cond, tem); + logical_type_node, cond, tem); } } @@ -835,7 +835,7 @@ gfc_omp_clause_assign_op (tree clause, tree dest, tree src) } else_b = gfc_finish_block (&cond_block); - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, unshare_expr (srcptr), null_pointer_node); gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, @@ -1028,7 +1028,7 @@ gfc_omp_clause_dtor (tree clause, tree decl) GFC_DESCRIPTOR_TYPE_P (type) ? gfc_conv_descriptor_data_get (decl) : decl); tem = unshare_expr (tem); - tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tree cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tem, null_pointer_node); tem = build3_loc (input_location, COND_EXPR, void_type_node, cond, then_b, build_empty_stmt (input_location)); @@ -1129,7 +1129,7 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p) tem = gfc_conv_descriptor_data_get (decl); tem = fold_convert (pvoid_type_node, tem); cond = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, tem, null_pointer_node); + logical_type_node, tem, null_pointer_node); gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR, void_type_node, cond, then_b, else_b)); @@ -2155,7 +2155,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, tem = gfc_conv_descriptor_data_get (decl); tem = fold_convert (pvoid_type_node, tem); cond = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, + logical_type_node, tem, null_pointer_node); gfc_add_expr_to_block (block, build3_loc (input_location, @@ -3596,7 +3596,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, /* The condition should not be folded. */ TREE_VEC_ELT (cond, i) = build2_loc (input_location, simple > 0 ? LE_EXPR : GE_EXPR, - boolean_type_node, dovar, to); + logical_type_node, dovar, to); TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR, type, dovar, step); TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, @@ -3623,7 +3623,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, build_int_cst (type, 0)); /* The condition should not be folded. */ TREE_VEC_ELT (cond, i) = build2_loc (input_location, LT_EXPR, - boolean_type_node, + logical_type_node, count, tmp); TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR, type, count, diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index d71e01e53ac..da3b44e0779 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -150,7 +150,7 @@ gfc_trans_goto (gfc_code * code) gfc_start_block (&se.pre); gfc_conv_label_variable (&se, code->expr1); tmp = GFC_DECL_STRING_LEN (se.expr); - tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp, + tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp, build_int_cst (TREE_TYPE (tmp), -1)); gfc_trans_runtime_check (true, false, tmp, &se.pre, &loc, "Assigned label is not a target label"); @@ -1106,7 +1106,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type) { tree cond; if (flag_coarray != GFC_FCOARRAY_LIB) - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, images, build_int_cst (TREE_TYPE (images), 1)); else { @@ -1114,13 +1114,13 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type) tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images, 2, integer_zero_node, build_int_cst (integer_type_node, -1)); - cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node, images, tmp); - cond2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + cond2 = fold_build2_loc (input_location, LT_EXPR, logical_type_node, images, build_int_cst (TREE_TYPE (images), 1)); cond = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, cond, cond2); + logical_type_node, cond, cond2); } gfc_trans_runtime_check (true, false, cond, &se.pre, &code->expr1->where, "Invalid image number " @@ -1412,10 +1412,10 @@ gfc_trans_arithmetic_if (gfc_code * code) branch2 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label2)); if (code->label1->value != code->label3->value) - tmp = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, LT_EXPR, logical_type_node, se.expr, zero); else - tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, se.expr, zero); branch1 = fold_build3_loc (input_location, COND_EXPR, void_type_node, @@ -1429,7 +1429,7 @@ gfc_trans_arithmetic_if (gfc_code * code) { /* if (cond <= 0) take branch1 else take branch2. */ branch2 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label3)); - tmp = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node, se.expr, zero); branch1 = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp, branch1, branch2); @@ -1913,10 +1913,10 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar, /* Evaluate the loop condition. */ if (is_step_positive) - cond = fold_build2_loc (loc, GT_EXPR, boolean_type_node, dovar, + cond = fold_build2_loc (loc, GT_EXPR, logical_type_node, dovar, fold_convert (type, to)); else - cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, dovar, + cond = fold_build2_loc (loc, LT_EXPR, logical_type_node, dovar, fold_convert (type, to)); cond = gfc_evaluate_now_loc (loc, cond, &body); @@ -1935,7 +1935,7 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar, tree boundary = is_step_positive ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type); - tmp = fold_build2_loc (loc, EQ_EXPR, boolean_type_node, + tmp = fold_build2_loc (loc, EQ_EXPR, logical_type_node, dovar, boundary); gfc_trans_runtime_check (true, false, tmp, &body, &code->loc, "Loop iterates infinitely"); @@ -1955,7 +1955,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 (loc, NE_EXPR, boolean_type_node, + tmp = fold_build2_loc (loc, NE_EXPR, logical_type_node, dovar, saved_dovar); gfc_trans_runtime_check (true, false, tmp, &body, &code->loc, "Loop variable has been modified"); @@ -2064,7 +2064,7 @@ gfc_trans_do (gfc_code * code, tree exit_cond) if (gfc_option.rtcheck & GFC_RTCHECK_DO) { - tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, step, + tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, step, build_zero_cst (type)); gfc_trans_runtime_check (true, false, tmp, &block, &code->loc, "DO step value is zero"); @@ -2131,7 +2131,7 @@ gfc_trans_do (gfc_code * code, tree exit_cond) /* For a positive step, when to < from, exit, otherwise compute countm1 = ((unsigned)to - (unsigned)from) / (unsigned)step */ - tmp = fold_build2_loc (loc, LT_EXPR, boolean_type_node, to, from); + tmp = fold_build2_loc (loc, LT_EXPR, logical_type_node, to, from); tmp2 = fold_build2_loc (loc, TRUNC_DIV_EXPR, utype, fold_build2_loc (loc, MINUS_EXPR, utype, tou, fromu), @@ -2146,7 +2146,7 @@ gfc_trans_do (gfc_code * code, tree exit_cond) /* For a negative step, when to > from, exit, otherwise compute countm1 = ((unsigned)from - (unsigned)to) / -(unsigned)step */ - tmp = fold_build2_loc (loc, GT_EXPR, boolean_type_node, to, from); + tmp = fold_build2_loc (loc, GT_EXPR, logical_type_node, to, from); tmp2 = fold_build2_loc (loc, TRUNC_DIV_EXPR, utype, fold_build2_loc (loc, MINUS_EXPR, utype, fromu, tou), @@ -2159,7 +2159,7 @@ gfc_trans_do (gfc_code * code, tree exit_cond) build1_loc (loc, GOTO_EXPR, void_type_node, exit_label), NULL_TREE)); - tmp = fold_build2_loc (loc, LT_EXPR, boolean_type_node, step, + tmp = fold_build2_loc (loc, LT_EXPR, logical_type_node, step, build_int_cst (TREE_TYPE (step), 0)); tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, tmp, neg, pos); @@ -2180,13 +2180,13 @@ gfc_trans_do (gfc_code * code, tree exit_cond) /* We need a special check for empty loops: empty = (step > 0 ? to < from : to > from); */ - pos_step = fold_build2_loc (loc, GT_EXPR, boolean_type_node, step, + pos_step = fold_build2_loc (loc, GT_EXPR, logical_type_node, step, build_zero_cst (type)); - tmp = fold_build3_loc (loc, COND_EXPR, boolean_type_node, pos_step, + tmp = fold_build3_loc (loc, COND_EXPR, logical_type_node, pos_step, fold_build2_loc (loc, LT_EXPR, - boolean_type_node, to, from), + logical_type_node, to, from), fold_build2_loc (loc, GT_EXPR, - boolean_type_node, to, from)); + logical_type_node, to, from)); /* If the loop is empty, go directly to the exit label. */ tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, tmp, build1_v (GOTO_EXPR, exit_label), @@ -2211,7 +2211,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 (loc, NE_EXPR, boolean_type_node, dovar, + tmp = fold_build2_loc (loc, NE_EXPR, logical_type_node, dovar, saved_dovar); gfc_trans_runtime_check (true, false, tmp, &body, &code->loc, "Loop variable has been modified"); @@ -2244,7 +2244,7 @@ gfc_trans_do (gfc_code * code, tree exit_cond) gfc_add_modify_loc (loc, &body, countm1, tmp); /* End with the loop condition. Loop until countm1t == 0. */ - cond = fold_build2_loc (loc, EQ_EXPR, boolean_type_node, countm1t, + cond = fold_build2_loc (loc, EQ_EXPR, logical_type_node, countm1t, build_int_cst (utype, 0)); tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_node, exit_label); tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, @@ -3398,7 +3398,7 @@ gfc_trans_forall_loop (forall_info *forall_tmp, tree body, gfc_init_block (&block); /* The exit condition. */ - cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, count, build_int_cst (TREE_TYPE (count), 0)); if (forall_tmp->do_concurrent) cond = build2 (ANNOTATE_EXPR, TREE_TYPE (cond), cond, @@ -5076,7 +5076,7 @@ gfc_trans_where_2 (gfc_code * code, tree mask, bool invert, &inner_size_body, block); /* Check whether the size is negative. */ - cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, size, + cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, size, gfc_index_zero_node); size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond, gfc_index_zero_node, size); @@ -6081,7 +6081,7 @@ gfc_trans_allocate (gfc_code * code) polymorphic and stores a _len dependent object, e.g., a string. */ memsz = fold_build2_loc (input_location, GT_EXPR, - boolean_type_node, expr3_len, + logical_type_node, expr3_len, integer_zero_node); memsz = fold_build3_loc (input_location, COND_EXPR, TREE_TYPE (expr3_esize), @@ -6214,7 +6214,7 @@ gfc_trans_allocate (gfc_code * code) { tmp = build1_v (GOTO_EXPR, label_errmsg); parm = fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, stat, + logical_type_node, stat, build_int_cst (TREE_TYPE (stat), 0)); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, gfc_unlikely (parm, PRED_FORTRAN_FAIL_ALLOC), @@ -6433,7 +6433,7 @@ gfc_trans_allocate (gfc_code * code) gfc_default_character_kind); dlen = gfc_finish_block (&errmsg_block); - tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, stat, build_int_cst (TREE_TYPE (stat), 0)); tmp = build3_v (COND_EXPR, tmp, @@ -6671,7 +6671,7 @@ gfc_trans_deallocate (gfc_code *code) { tree cond; - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, stat, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, stat, build_int_cst (TREE_TYPE (stat), 0)); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, gfc_unlikely (cond, PRED_FORTRAN_FAIL_ALLOC), @@ -6711,7 +6711,7 @@ gfc_trans_deallocate (gfc_code *code) slen, errmsg_str, gfc_default_character_kind); tmp = gfc_finish_block (&errmsg_block); - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, stat, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, stat, build_int_cst (TREE_TYPE (stat), 0)); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, gfc_unlikely (cond, PRED_FORTRAN_FAIL_ALLOC), tmp, diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 8617cd51a7c..8c2c8a69cac 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -60,6 +60,9 @@ tree ppvoid_type_node; tree pchar_type_node; tree pfunc_type_node; +tree logical_type_node; +tree logical_true_node; +tree logical_false_node; tree gfc_charlen_type_node; tree gfc_float128_type_node = NULL_TREE; @@ -976,6 +979,11 @@ gfc_init_types (void) wi::mask (n, UNSIGNED, TYPE_PRECISION (size_type_node))); + + logical_type_node = gfc_get_logical_type (gfc_default_logical_kind); + logical_true_node = build_int_cst (logical_type_node, 1); + logical_false_node = build_int_cst (logical_type_node, 0); + /* ??? Shouldn't this be based on gfc_index_integer_kind or so? */ gfc_charlen_int_kind = 4; gfc_charlen_type_node = gfc_get_int_type (gfc_charlen_int_kind); @@ -3228,11 +3236,11 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info) t = build1 (NOP_EXPR, build_pointer_type (ptr_type_node), t); info->data_location = build1 (INDIRECT_REF, ptr_type_node, t); if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE) - info->allocated = build2 (NE_EXPR, boolean_type_node, + info->allocated = build2 (NE_EXPR, logical_type_node, info->data_location, null_pointer_node); else if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT) - info->associated = build2 (NE_EXPR, boolean_type_node, + info->associated = build2 (NE_EXPR, logical_type_node, info->data_location, null_pointer_node); if ((GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT) diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index 2974e451304..6dba78e3671 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -33,6 +33,20 @@ extern GTY(()) tree pchar_type_node; extern GTY(()) tree gfc_float128_type_node; extern GTY(()) tree gfc_complex_float128_type_node; +/* logical_type_node is the Fortran LOGICAL type of default kind. In + addition to uses mandated by the Fortran standard, also prefer it + for compiler generated temporary variables, is it avoids some minor + issues with boolean_type_node (the C/C++ _Bool/bool). Namely: + - On x86, partial register stalls with 8/16 bit register access, + and length prefix changes. + - On s390 there is a compare with immediate and jump instruction, + but it works only with 32-bit quantities and not 8-bit such as + boolean_type_node. +*/ +extern GTY(()) tree logical_type_node; +extern GTY(()) tree logical_true_node; +extern GTY(()) tree logical_false_node; + /* This is the type used to hold the lengths of character variables. It must be the same as the corresponding definition in gfortran.h. */ /* TODO: This is still hardcoded as kind=4 in some bits of the compiler diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 6d698ba1690..47ed82a9114 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -533,9 +533,9 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock, if (once) { - tmpvar = gfc_create_var (boolean_type_node, "print_warning"); + tmpvar = gfc_create_var (logical_type_node, "print_warning"); TREE_STATIC (tmpvar) = 1; - DECL_INITIAL (tmpvar) = boolean_true_node; + DECL_INITIAL (tmpvar) = logical_true_node; gfc_add_expr_to_block (pblock, tmpvar); } @@ -554,7 +554,7 @@ gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock, va_end (ap); if (once) - gfc_add_modify (&block, tmpvar, boolean_false_node); + gfc_add_modify (&block, tmpvar, logical_false_node); body = gfc_finish_block (&block); @@ -607,7 +607,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) if (gfc_option.rtcheck & GFC_RTCHECK_MEM) { null_result = fold_build2_loc (input_location, EQ_EXPR, - boolean_type_node, res, + logical_type_node, res, build_int_cst (pvoid_type_node, 0)); msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const ("Memory allocation failed")); @@ -693,7 +693,7 @@ gfc_allocate_using_malloc (stmtblock_t * block, tree pointer, } error_cond = fold_build2_loc (input_location, EQ_EXPR, - boolean_type_node, pointer, + logical_type_node, pointer, build_int_cst (prvoid_type_node, 0)); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, gfc_unlikely (error_cond, PRED_FORTRAN_FAIL_ALLOC), @@ -795,7 +795,7 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, size = fold_convert (size_type_node, size); null_mem = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR, - boolean_type_node, mem, + logical_type_node, mem, build_int_cst (type, 0)), PRED_FORTRAN_REALLOC); @@ -873,7 +873,7 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, { TREE_USED (label_finish) = 1; tmp = build1_v (GOTO_EXPR, label_finish); - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, status, build_zero_cst (TREE_TYPE (status))); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, gfc_unlikely (cond, PRED_FORTRAN_FAIL_ALLOC), @@ -1090,12 +1090,12 @@ gfc_add_comp_finalizer_call (stmtblock_t *block, tree decl, gfc_component *comp, { tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (array)) ? gfc_conv_descriptor_data_get (array) : array; - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp, fold_convert (TREE_TYPE (tmp), null_pointer_node)); } else - cond = boolean_true_node; + cond = logical_true_node; if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (array))) { @@ -1111,12 +1111,12 @@ gfc_add_comp_finalizer_call (stmtblock_t *block, tree decl, gfc_component *comp, if (!final_expr) { - tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, final_fndecl, fold_convert (TREE_TYPE (final_fndecl), null_pointer_node)); cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, - boolean_type_node, cond, tmp); + logical_type_node, cond, tmp); } if (POINTER_TYPE_P (TREE_TYPE (final_fndecl))) @@ -1212,7 +1212,7 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) gfc_init_se (&se, NULL); se.want_pointer = 1; gfc_conv_expr (&se, final_expr); - cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, se.expr, build_int_cst (TREE_TYPE (se.expr), 0)); /* For CLASS(*) not only sym->_vtab->_final can be NULL @@ -1230,11 +1230,11 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) gfc_conv_expr (&se, vptr_expr); gfc_free_expr (vptr_expr); - cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node, se.expr, build_int_cst (TREE_TYPE (se.expr), 0)); cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR, - boolean_type_node, cond2, cond); + logical_type_node, cond2, cond); } tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, @@ -1340,7 +1340,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (pointer))) pointer = gfc_conv_descriptor_data_get (pointer); - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pointer, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, pointer, build_int_cst (TREE_TYPE (pointer), 0)); /* When POINTER is NULL, we set STATUS to 1 if it's present, otherwise @@ -1367,7 +1367,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, tree cond2; status_type = TREE_TYPE (TREE_TYPE (status)); - cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node, status, build_int_cst (TREE_TYPE (status), 0)); tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, fold_build1_loc (input_location, INDIRECT_REF, @@ -1400,7 +1400,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, tree status_type = TREE_TYPE (TREE_TYPE (status)); tree cond2; - cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node, status, build_int_cst (TREE_TYPE (status), 0)); tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, @@ -1463,7 +1463,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, TREE_USED (label_finish) = 1; tmp = build1_v (GOTO_EXPR, label_finish); - cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node, stat, build_zero_cst (TREE_TYPE (stat))); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, gfc_unlikely (cond2, PRED_FORTRAN_REALLOC), @@ -1499,7 +1499,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish, && comp_ref) caf_dereg_type = GFC_CAF_COARRAY_DEALLOCATE_ONLY; - cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pointer, + cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, pointer, build_int_cst (TREE_TYPE (pointer), 0)); /* When POINTER is NULL, we set STATUS to 1 if it's present, otherwise @@ -1526,7 +1526,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish, tree status_type = TREE_TYPE (TREE_TYPE (status)); tree cond2; - cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node, status, build_int_cst (TREE_TYPE (status), 0)); tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, fold_build1_loc (input_location, INDIRECT_REF, @@ -1571,7 +1571,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish, tree status_type = TREE_TYPE (TREE_TYPE (status)); tree cond2; - cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node, status, build_int_cst (TREE_TYPE (status), 0)); tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, @@ -1621,7 +1621,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish, TREE_USED (label_finish) = 1; tmp = build1_v (GOTO_EXPR, label_finish); - cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node, stat, build_zero_cst (TREE_TYPE (stat))); tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, gfc_unlikely (cond2, PRED_FORTRAN_REALLOC), @@ -1664,11 +1664,11 @@ gfc_call_realloc (stmtblock_t * block, tree mem, tree size) builtin_decl_explicit (BUILT_IN_REALLOC), 2, fold_convert (pvoid_type_node, mem), size); gfc_add_modify (block, res, fold_convert (type, tmp)); - null_result = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + null_result = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, res, build_int_cst (pvoid_type_node, 0)); - nonzero = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, size, + nonzero = fold_build2_loc (input_location, NE_EXPR, logical_type_node, size, build_int_cst (size_type_node, 0)); - null_result = fold_build2_loc (input_location, TRUTH_AND_EXPR, boolean_type_node, + null_result = fold_build2_loc (input_location, TRUTH_AND_EXPR, logical_type_node, null_result, nonzero); msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const ("Allocation would exceed memory limit")); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f07ee652fa1..bdc6ac899f3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2017-11-13 Janne Blomqvist <jb@gcc.gnu.org> + + PR 82869 + * gfortran.dg/logical_temp_io.f90: New test. + * gfortran.dg/logical_temp_io_kind8.f90: New test. + 2017-11-10 Eric Botcazou <ebotcazou@adacore.com> * gnat.dg/opt69.adb: New test. diff --git a/gcc/testsuite/gfortran.dg/logical_temp_io.f90 b/gcc/testsuite/gfortran.dg/logical_temp_io.f90 new file mode 100644 index 00000000000..77260a9c669 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/logical_temp_io.f90 @@ -0,0 +1,13 @@ +! { dg-do run } +! PR 82869 +! A temp variable of type logical was incorrectly transferred +! to the I/O library as a logical type of a different kind. +program pr82869 + use, intrinsic :: iso_c_binding + type(c_ptr) :: p = c_null_ptr + character(len=4) :: s + write (s, *) c_associated(p), c_associated(c_null_ptr) + if (s /= ' F F') then + call abort() + end if +end program pr82869 diff --git a/gcc/testsuite/gfortran.dg/logical_temp_io_kind8.f90 b/gcc/testsuite/gfortran.dg/logical_temp_io_kind8.f90 new file mode 100644 index 00000000000..662289e1c34 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/logical_temp_io_kind8.f90 @@ -0,0 +1,14 @@ +! { dg-do run } +! { dg-options "-fdefault-integer-8" } +! PR 82869 +! A temp variable of type logical was incorrectly transferred +! to the I/O library as a logical type of a different kind. +program pr82869_8 + use, intrinsic :: iso_c_binding + type(c_ptr) :: p = c_null_ptr + character(len=4) :: s + write (s, *) c_associated(p), c_associated(c_null_ptr) + if (s /= ' F F') then + call abort() + end if +end program pr82869_8 |