From: Tobias Burnus Date: Sat, 16 Jun 2012 18:13:38 +0000 (+0200) Subject: re PR fortran/53642 (Front-end optimization: Wrong string length for deferred-length... X-Git-Tag: misc/gccgo-go1_1_2~2328 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=0f6bfefdef06889fa31e3df1ef4646bc5b3fac67;p=thirdparty%2Fgcc.git re PR fortran/53642 (Front-end optimization: Wrong string length for deferred-length strings) 2012-06-16 Tobias Burnus PR fortran/53642 PR fortran/45170 * frontend-passes.c (optimize_assignment): Don't remove RHS's trim when assigning to a deferred-length string. * trans-expr.c (gfc_trans_assignment_1): Ensure that the RHS string length is evaluated before the deferred-length LHS is reallocated. 2012-06-16 Tobias Burnus PR fortran/53642 PR fortran/45170 * gfortran.dg/deferred_type_param_8.f90: New. From-SVN: r188692 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 27c06795313a..845a53480c85 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2012-06-16 Tobias Burnus + + PR fortran/53642 + PR fortran/45170 + * frontend-passes.c (optimize_assignment): Don't remove RHS's + trim when assigning to a deferred-length string. + * trans-expr.c (gfc_trans_assignment_1): Ensure that the RHS string + length is evaluated before the deferred-length LHS is reallocated. + 2012-06-13 Tobias Burnus PR fortran/53643 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index bcc1bdc323b9..fc32e56dfc62 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -735,15 +735,13 @@ optimize_assignment (gfc_code * c) lhs = c->expr1; rhs = c->expr2; - if (lhs->ts.type == BT_CHARACTER) + if (lhs->ts.type == BT_CHARACTER && !lhs->ts.deferred) { - /* Optimize away a = trim(b), where a is a character variable. */ + /* Optimize a = trim(b) to a = b. */ remove_trim (rhs); - /* Replace a = ' ' by a = '' to optimize away a memcpy, but only - for strings with non-deferred length (otherwise we would - reallocate the length. */ - if (empty_string(rhs) && ! lhs->ts.deferred) + /* Replace a = ' ' by a = '' to optimize away a memcpy. */ + if (empty_string(rhs)) rhs->value.character.length = 0; } @@ -1171,7 +1169,7 @@ optimize_trim (gfc_expr *e) ref->u.ss.start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1); - /* Build the function call to len_trim(x, gfc_defaul_integer_kind). */ + /* Build the function call to len_trim(x, gfc_default_integer_kind). */ fcn = get_len_trim_call (gfc_copy_expr (e), gfc_default_integer_kind); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 9d48a09e1298..7d1a6d438419 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -6891,7 +6891,6 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, stmtblock_t body; bool l_is_temp; bool scalar_to_array; - bool def_clen_func; tree string_length; int n; @@ -7010,13 +7009,8 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, otherwise the character length of the result is not known. NOTE: This relies on having the exact dependence of the length type parameter available to the caller; gfortran saves it in the .mod files. */ - def_clen_func = (expr2->expr_type == EXPR_FUNCTION - || expr2->expr_type == EXPR_COMPCALL - || expr2->expr_type == EXPR_PPC); - if (gfc_option.flag_realloc_lhs - && expr2->ts.type == BT_CHARACTER - && (def_clen_func || expr2->expr_type == EXPR_OP) - && expr1->ts.deferred) + if (gfc_option.flag_realloc_lhs && expr2->ts.type == BT_CHARACTER + && expr1->ts.deferred) gfc_add_block_to_block (&block, &rse.pre); tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index bcff75712cf8..42d8f7c8d8b5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2012-06-16 Tobias Burnus + + PR fortran/53642 + PR fortran/45170 + * gfortran.dg/deferred_type_param_8.f90: New. + 2012-06-15 Janis Johnson * lib/gcov.exp (verify-lines, verify-branches, verify-calls): Use diff --git a/gcc/testsuite/gfortran.dg/deferred_type_param_8.f90 b/gcc/testsuite/gfortran.dg/deferred_type_param_8.f90 new file mode 100644 index 000000000000..3c768c567a74 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/deferred_type_param_8.f90 @@ -0,0 +1,54 @@ +! { dg-do run } +! +! PR fortran/53642 +! PR fortran/45170 (comments 24, 34, 37) +! + +PROGRAM helloworld + implicit none + character(:),allocatable::string + character(11), parameter :: cmp = "hello world" + real::rnd + integer :: n, i + do i = 1, 10 + call random_number(rnd) + n = ceiling(11*rnd) + call hello(n, string) +! print '(A,1X,I0)', '>' // string // '<', len(string) + if (n /= len (string) .or. string /= cmp(1:n)) call abort () + end do + + call test_PR53642() + +contains + + subroutine hello (n,string) + character(:), allocatable, intent(out) :: string + integer,intent(in) :: n + character(11) :: helloworld="hello world" + + string=helloworld(:n) ! Didn't work +! string=(helloworld(:n)) ! Works. +! allocate(string, source=helloworld(:n)) ! Fixed for allocate_with_source_2.f90 +! allocate(string, source=(helloworld(:n))) ! Works. + end subroutine hello + + subroutine test_PR53642() + character(len=4) :: string="123 " + character(:), allocatable :: trimmed + + trimmed = trim(string) + if (len_trim(string) /= len(trimmed)) call abort () + if (len(trimmed) /= 3) call abort () + if (trimmed /= "123") call abort () +! print *,len_trim(string),len(trimmed) + + ! Clear + trimmed = "XXXXXX" + if (trimmed /= "XXXXXX" .or. len(trimmed) /= 6) call abort () + + trimmed = string(1:len_trim(string)) + if (len_trim(trimmed) /= 3) call abort () + if (trimmed /= "123") call abort () + end subroutine test_PR53642 +end PROGRAM helloworld