diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/fortran/trans-const.c | 16 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 47 |
3 files changed, 59 insertions, 16 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0b12539..2b4fbaa 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2008-11-12 Jakub Jelinek <jakub@redhat.com> + + PR target/35366 + PR fortran/33759 + * trans-const.c (gfc_conv_constant_to_tree): Warn when + converting an integer outside of LOGICAL's range to + LOGICAL. + * trans-intrinsic.c (gfc_conv_intrinsic_function, + gfc_conv_intrinsic_array_transfer, gfc_conv_intrinsic_transfer): + Use INTEGER_TYPE instead of BOOLEAN_TYPE for TRANSFER as + argument of another TRANSFER. + 2008-11-12 Tobias Burnus <burnus@net-b.de> PR fortran/38065 diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index fd3d58f..4db3512 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -281,13 +281,19 @@ gfc_conv_constant_to_tree (gfc_expr * expr) case BT_LOGICAL: if (expr->representation.string) - return fold_build1 (VIEW_CONVERT_EXPR, - gfc_get_logical_type (expr->ts.kind), - gfc_build_string_const (expr->representation.length, - expr->representation.string)); + { + tree tmp = fold_build1 (VIEW_CONVERT_EXPR, + gfc_get_int_type (expr->ts.kind), + gfc_build_string_const (expr->representation.length, + expr->representation.string)); + if (!integer_zerop (tmp) && !integer_onep (tmp)) + gfc_warning ("Assigning value other than 0 or 1 to LOGICAL" + " has undefined result at %L", &expr->where); + return fold_convert (gfc_get_logical_type (expr->ts.kind), tmp); + } else return build_int_cst (gfc_get_logical_type (expr->ts.kind), - expr->value.logical); + expr->value.logical); case BT_COMPLEX: if (expr->representation.string) diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index acf0b73..b8d9f3e 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -3707,6 +3707,14 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr) mold_type = gfc_get_element_type (TREE_TYPE (argse.expr)); } + if (strcmp (expr->value.function.name, "__transfer_in_transfer") == 0) + { + /* If this TRANSFER is nested in another TRANSFER, use a type + that preserves all bits. */ + if (arg->expr->ts.type == BT_LOGICAL) + mold_type = gfc_get_int_type (arg->expr->ts.kind); + } + if (arg->expr->ts.type == BT_CHARACTER) { tmp = size_of_string_in_bytes (arg->expr->ts.kind, argse.string_length); @@ -3835,6 +3843,13 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) arg = arg->next; type = gfc_typenode_for_spec (&expr->ts); + if (strcmp (expr->value.function.name, "__transfer_in_transfer") == 0) + { + /* If this TRANSFER is nested in another TRANSFER, use a type + that preserves all bits. */ + if (expr->ts.type == BT_LOGICAL) + type = gfc_get_int_type (expr->ts.kind); + } if (expr->ts.type == BT_CHARACTER) { @@ -4750,20 +4765,30 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) break; case GFC_ISYM_TRANSFER: - if (se->ss) + if (se->ss && se->ss->useflags) { - if (se->ss->useflags) - { - /* Access the previously obtained result. */ - gfc_conv_tmp_array_ref (se); - gfc_advance_se_ss_chain (se); - break; - } - else - gfc_conv_intrinsic_array_transfer (se, expr); + /* Access the previously obtained result. */ + gfc_conv_tmp_array_ref (se); + gfc_advance_se_ss_chain (se); } else - gfc_conv_intrinsic_transfer (se, expr); + { + /* Ensure double transfer through LOGICAL preserves all + the needed bits. */ + gfc_expr *source = expr->value.function.actual->expr; + if (source->expr_type == EXPR_FUNCTION + && source->value.function.esym == NULL + && source->value.function.isym != NULL + && source->value.function.isym->id == GFC_ISYM_TRANSFER + && source->ts.type == BT_LOGICAL + && expr->ts.type != source->ts.type) + source->value.function.name = "__transfer_in_transfer"; + + if (se->ss) + gfc_conv_intrinsic_array_transfer (se, expr); + else + gfc_conv_intrinsic_transfer (se, expr); + } break; case GFC_ISYM_TTYNAM: |