From b7d36ea3cc8cc960b98f307bcdb04f66085b9c2b Mon Sep 17 00:00:00 2001 From: =?utf8?q?Fran=C3=A7ois-Xavier=20Coudert?= Date: Mon, 12 May 2008 15:51:27 +0000 Subject: [PATCH] re PR fortran/36176 (TRANSFER of constant substrings) PR fortran/36176 * target-memory.c (gfc_target_expr_size): Correctly treat substrings. (gfc_target_encode_expr): Likewise. (gfc_interpret_complex): Whitespace change. * gfortran.dg/transfer_simplify_9.f90: New test. From-SVN: r135219 --- gcc/fortran/ChangeLog | 8 ++++ gcc/fortran/target-memory.c | 38 ++++++++++++++++--- gcc/testsuite/ChangeLog | 9 ++++- .../gfortran.dg/transfer_simplify_9.f90 | 23 +++++++++++ 4 files changed, 70 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/transfer_simplify_9.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ae78f0ea8af..05563105cde 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2008-05-12 Francois-Xavier Coudert + + PR fortran/36176 + * target-memory.c (gfc_target_expr_size): Correctly treat + substrings. + (gfc_target_encode_expr): Likewise. + (gfc_interpret_complex): Whitespace change. + 2008-05-11 Thomas Koenig PR fortran/35719 diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index 149afa1e8ca..389e2a53917 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.c @@ -100,7 +100,16 @@ gfc_target_expr_size (gfc_expr *e) case BT_LOGICAL: return size_logical (e->ts.kind); case BT_CHARACTER: - return size_character (e->value.character.length, e->ts.kind); + if (e->expr_type == EXPR_SUBSTRING && e->ref) + { + int start, end; + + gfc_extract_int (e->ref->u.ss.start, &start); + gfc_extract_int (e->ref->u.ss.end, &end); + return size_character (MAX(end - start + 1, 0), e->ts.kind); + } + else + return size_character (e->value.character.length, e->ts.kind); case BT_HOLLERITH: return e->representation.length; case BT_DERIVED: @@ -231,7 +240,8 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer, return encode_array (source, buffer, buffer_size); gcc_assert (source->expr_type == EXPR_CONSTANT - || source->expr_type == EXPR_STRUCTURE); + || source->expr_type == EXPR_STRUCTURE + || source->expr_type == EXPR_SUBSTRING); /* If we already have a target-memory representation, we use that rather than recreating one. */ @@ -257,9 +267,24 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer, return encode_logical (source->ts.kind, source->value.logical, buffer, buffer_size); case BT_CHARACTER: - return encode_character (source->ts.kind, source->value.character.length, - source->value.character.string, buffer, - buffer_size); + if (source->expr_type == EXPR_CONSTANT || source->ref == NULL) + return encode_character (source->ts.kind, + source->value.character.length, + source->value.character.string, buffer, + buffer_size); + else + { + int start, end; + + gcc_assert (source->expr_type == EXPR_SUBSTRING); + gfc_extract_int (source->ref->u.ss.start, &start); + gfc_extract_int (source->ref->u.ss.end, &end); + return encode_character (source->ts.kind, + MAX(end - start + 1, 0), + &source->value.character.string[start-1], + buffer, buffer_size); + } + case BT_DERIVED: return encode_derived (source, buffer, buffer_size); default: @@ -342,7 +367,8 @@ gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size, { int size; size = gfc_interpret_float (kind, &buffer[0], buffer_size, real); - size += gfc_interpret_float (kind, &buffer[size], buffer_size - size, imaginary); + size += gfc_interpret_float (kind, &buffer[size], buffer_size - size, + imaginary); return size; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1daba114a8a..182f0494d75 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,7 +1,12 @@ +2008-05-12 Francois-Xavier Coudert + + PR fortran/36176 + * gfortran.dg/transfer_simplify_9.f90: New test. + 2008-05-12 Paolo Carlini - PR c++/35331 - * g++.dg/cpp0x/vt-35331.C: New. + PR c++/35331 + * g++.dg/cpp0x/vt-35331.C: New. * g++.dg/cpp0x/pr32125.C: Adjust. * g++.dg/cpp0x/pr32126.C: Likewise. * g++.dg/cpp0x/pr31438.C: Likewise. diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_9.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_9.f90 new file mode 100644 index 00000000000..02b86111b2b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/transfer_simplify_9.f90 @@ -0,0 +1,23 @@ +! { dg-do run } +! +! Various checks on simplification of TRANSFER of substrings + character(len=4), parameter :: t = "xyzt" + integer, parameter :: w = transfer(t,0) + integer :: i = 1 + if (transfer(t,0) /= w) call abort + if (transfer(t(:),0) /= w) call abort + if (transfer(t(1:4),0) /= w) call abort + if (transfer(t(i:i+3),0) /= w) call abort + + if (transfer(t(1:1), 0_1) /= transfer("x", 0_1)) call abort + if (transfer(t(2:2), 0_1) /= transfer("y", 0_1)) call abort + if (transfer(t(i:i), 0_1) /= transfer("x", 0_1)) call abort + if (transfer(t(i+1:i+1), 0_1) /= transfer("y", 0_1)) call abort + if (transfer(t(1:2), 0_2) /= transfer("xy", 0_2)) call abort + if (transfer(t(3:4), 0_2) /= transfer("zt", 0_2)) call abort + + if (transfer(transfer(-1, t), 0) /= -1) call abort + if (transfer(transfer(-1, t(:)), 0) /= -1) call abort + if (any (transfer(transfer(-1, (/t(1:1)/)), (/0_1/)) /= -1)) call abort + if (transfer(transfer(-1, t(1:1)), 0_1) /= -1) call abort + end -- 2.30.2