OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/53642 (Front-end optimization: Wrong string length for deferred-length strings) 

2012-06-16  Tobias Burnus  <burnus@net-b.de>

        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  <burnus@net-b.de>

        PR fortran/53642
        PR fortran/45170
        * gfortran.dg/deferred_type_param_8.f90: New.

From-SVN: r188692
This commit is contained in:
Tobias Burnus 2012-06-16 20:13:38 +02:00 committed by Tobias Burnus
parent 9510c5af63
commit 0f6bfefdef
5 changed files with 76 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View File

@ -1,3 +1,12 @@
2012-06-16 Tobias Burnus <burnus@net-b.de>
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 <burnus@net-b.de>
PR fortran/53643

12
gcc/fortran/frontend-passes.c
View File

@ -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);

10
gcc/fortran/trans-expr.c
View File

@ -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,

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2012-06-16 Tobias Burnus <burnus@net-b.de>
PR fortran/53642
PR fortran/45170
* gfortran.dg/deferred_type_param_8.f90: New.
2012-06-15 Janis Johnson <janosjo@codesourcery.com>
* lib/gcov.exp (verify-lines, verify-branches, verify-calls): Use

54
gcc/testsuite/gfortran.dg/deferred_type_param_8.f90 Normal file
View File

@ -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