From 27a4e07281d191dff6b8c109b51a62d8b0731210 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Wed, 12 Nov 2008 18:01:51 +0100 Subject: [PATCH] re PR target/35366 (gfortran.dg/equiv_7.f90 fails with -m64 -Os on powerpc-apple-darwin9) PR target/35366 PR fortran/33759 * fold-const.c (native_encode_string): New function. (native_encode_expr): Use it for STRING_CST. * 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. * gfortran.dg/hollerith.f90: Don't assume a 32-bit value stored into logical variable will be preserved. * gfortran.dg/transfer_simplify_4.f90: Remove undefined cases. Run at all optimization levels. Add a couple of new tests. * gfortran.dg/hollerith5.f90: New test. * gfortran.dg/hollerith_legacy.f90: Add dg-warning. From-SVN: r141790 --- gcc/ChangeLog | 6 +++ gcc/fold-const.c | 34 ++++++++++++++ gcc/fortran/ChangeLog | 12 +++++ gcc/fortran/trans-const.c | 16 +++++-- gcc/fortran/trans-intrinsic.c | 47 ++++++++++++++----- gcc/testsuite/ChangeLog | 10 ++++ gcc/testsuite/gfortran.dg/hollerith.f90 | 10 ++-- gcc/testsuite/gfortran.dg/hollerith5.f90 | 8 ++++ .../gfortran.dg/hollerith_legacy.f90 | 4 +- .../gfortran.dg/transfer_simplify_4.f90 | 37 +++++++++------ 10 files changed, 147 insertions(+), 37 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/hollerith5.f90 diff --git a/gcc/ChangeLog b/gcc/ChangeLog index dcfedb13cd5..fb4e453c7af 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,9 @@ +2008-11-12 Jakub Jelinek + + PR target/35366 + * fold-const.c (native_encode_string): New function. + (native_encode_expr): Use it for STRING_CST. + 2008-11-12 DJ Delorie * config/m32c/cond.md (cond_to_int peephole2): Don't eliminate the diff --git a/gcc/fold-const.c b/gcc/fold-const.c index 1a96c3f77fc..8dddca19c08 100644 --- a/gcc/fold-const.c +++ b/gcc/fold-const.c @@ -7315,6 +7315,37 @@ native_encode_vector (const_tree expr, unsigned char *ptr, int len) } +/* Subroutine of native_encode_expr. Encode the STRING_CST + specified by EXPR into the buffer PTR of length LEN bytes. + Return the number of bytes placed in the buffer, or zero + upon failure. */ + +static int +native_encode_string (const_tree expr, unsigned char *ptr, int len) +{ + tree type = TREE_TYPE (expr); + HOST_WIDE_INT total_bytes; + + if (TREE_CODE (type) != ARRAY_TYPE + || TREE_CODE (TREE_TYPE (type)) != INTEGER_TYPE + || GET_MODE_BITSIZE (TYPE_MODE (TREE_TYPE (type))) != BITS_PER_UNIT + || !host_integerp (TYPE_SIZE_UNIT (type), 0)) + return 0; + total_bytes = tree_low_cst (TYPE_SIZE_UNIT (type), 0); + if (total_bytes > len) + return 0; + if (TREE_STRING_LENGTH (expr) < total_bytes) + { + memcpy (ptr, TREE_STRING_POINTER (expr), TREE_STRING_LENGTH (expr)); + memset (ptr + TREE_STRING_LENGTH (expr), 0, + total_bytes - TREE_STRING_LENGTH (expr)); + } + else + memcpy (ptr, TREE_STRING_POINTER (expr), total_bytes); + return total_bytes; +} + + /* Subroutine of fold_view_convert_expr. Encode the INTEGER_CST, REAL_CST, COMPLEX_CST or VECTOR_CST specified by EXPR into the buffer PTR of length LEN bytes. Return the number of bytes @@ -7337,6 +7368,9 @@ native_encode_expr (const_tree expr, unsigned char *ptr, int len) case VECTOR_CST: return native_encode_vector (expr, ptr, len); + case STRING_CST: + return native_encode_string (expr, ptr, len); + default: return 0; } diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0b1253914b3..2b4fbaa9659 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2008-11-12 Jakub Jelinek + + 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 PR fortran/38065 diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index fd3d58f56b3..4db3512bc0e 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 acf0b73a760..b8d9f3ed43a 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: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 922525fea72..cd3752a741c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,15 @@ 2008-11-12 Jakub Jelinek + PR target/35366 + PR fortran/33759 + * gfortran.dg/hollerith.f90: Don't assume a 32-bit value + stored into logical variable will be preserved. + * gfortran.dg/transfer_simplify_4.f90: Remove undefined + cases. Run at all optimization levels. Add a couple of + new tests. + * gfortran.dg/hollerith5.f90: New test. + * gfortran.dg/hollerith_legacy.f90: Add dg-warning. + PR c++/35334 * gcc.dg/pr35334.c: New test. * g++.dg/other/error29.C: New test. diff --git a/gcc/testsuite/gfortran.dg/hollerith.f90 b/gcc/testsuite/gfortran.dg/hollerith.f90 index 5884799dfd0..f9836155b57 100644 --- a/gcc/testsuite/gfortran.dg/hollerith.f90 +++ b/gcc/testsuite/gfortran.dg/hollerith.f90 @@ -8,7 +8,7 @@ character z1(4) character*4 z2(2,2) character*80 line integer i -logical l +integer j real r character*8 c @@ -20,15 +20,15 @@ data z2/4h(i7),'xxxx','xxxx','xxxx'/ z2 (1,2) = 4h(i8) i = 4hHell -l = 4Ho wo +j = 4Ho wo r = 4Hrld! -write (line, '(3A4)') i, l, r +write (line, '(3A4)') i, j, r if (line .ne. 'Hello world!') call abort i = 2Hab +j = 2Hab r = 2Hab -l = 2Hab c = 2Hab -write (line, '(3A4, 8A)') i, l, r, c +write (line, '(3A4, 8A)') i, j, r, c if (line .ne. 'ab ab ab ab ') call abort write(line, '(4A8, "!")' ) x diff --git a/gcc/testsuite/gfortran.dg/hollerith5.f90 b/gcc/testsuite/gfortran.dg/hollerith5.f90 new file mode 100644 index 00000000000..ebd0a117c4f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/hollerith5.f90 @@ -0,0 +1,8 @@ + ! { dg-do compile } + implicit none + logical b + b = 4Habcd ! { dg-warning "has undefined result" } + end + +! { dg-warning "Hollerith constant" "const" { target *-*-* } 4 } +! { dg-warning "Conversion" "conversion" { target *-*-* } 4 } diff --git a/gcc/testsuite/gfortran.dg/hollerith_legacy.f90 b/gcc/testsuite/gfortran.dg/hollerith_legacy.f90 index 13a94bc40d0..1bbaf3f68f9 100644 --- a/gcc/testsuite/gfortran.dg/hollerith_legacy.f90 +++ b/gcc/testsuite/gfortran.dg/hollerith_legacy.f90 @@ -21,13 +21,13 @@ data z2/4h(i7),'xxxx','xxxx','xxxx'/ z2 (1,2) = 4h(i8) i = 4hHell -l = 4Ho wo +l = 4Ho wo ! { dg-warning "has undefined result" } r = 4Hrld! write (line, '(3A4)') i, l, r if (line .ne. 'Hello world!') call abort i = 2Hab r = 2Hab -l = 2Hab +l = 2Hab ! { dg-warning "has undefined result" } c = 2Hab write (line, '(3A4, 8A)') i, l, r, c if (line .ne. 'ab ab ab ab ') call abort diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_4.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_4.f90 index 314593474a9..65b1e41cfdf 100644 --- a/gcc/testsuite/gfortran.dg/transfer_simplify_4.f90 +++ b/gcc/testsuite/gfortran.dg/transfer_simplify_4.f90 @@ -1,30 +1,39 @@ ! { dg-do run } -! { dg-options "-O0" } ! Tests that the in-memory representation of a transferred variable ! propagates properly. ! implicit none integer, parameter :: ip1 = 42 - logical, parameter :: ap1 = transfer(ip1, .true.) - integer, parameter :: ip2 = transfer(ap1, 0) + integer, parameter :: ip2 = transfer(transfer(ip1, .true.), 0) + integer :: i, ai(4) + logical :: b - logical :: a - integer :: i + if (ip2 .ne. ip1) call abort () i = transfer(transfer(ip1, .true.), 0) if (i .ne. ip1) call abort () - i = transfer(ap1, 0) - if (i .ne. ip1) call abort () - - a = transfer(ip1, .true.) - i = transfer(a, 0) + i = 42 + i = transfer(transfer(i, .true.), 0) if (i .ne. ip1) call abort () - i = ip1 - a = transfer(i, .true.) - i = transfer(a, 0) - if (i .ne. ip1) call abort () + b = transfer(transfer(.true., 3.1415), .true.) + if (.not.b) call abort () + + b = transfer(transfer(.false., 3.1415), .true.) + if (b) call abort () + + i = 0 + b = transfer(i, .true.) + ! The standard doesn't guarantee here that b will be .false., + ! though in gfortran for all targets it will. + + ai = (/ 42, 42, 42, 42 /) + ai = transfer (transfer (ai, .false., 4), ai) + if (any(ai .ne. 42)) call abort + ai = transfer (transfer ((/ 42, 42, 42, 42 /), & +& (/ .false., .false., .false., .false. /)), ai) + if (any(ai .ne. 42)) call abort end -- 2.30.2