From a0ab480af081b8862c37028c48fc6bf23a15234d Mon Sep 17 00:00:00 2001 From: fxcoudert Date: Mon, 19 Mar 2007 08:13:30 +0000 Subject: [PATCH] PR fortran/31203 * trans-expr.c (gfc_trans_init_string_length): Length should never be negative. (gfc_conv_function_call): Likewise. * gfortran.dg/string_length_1.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@123051 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 ++ gcc/fortran/trans-expr.c | 10 ++- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/string_length_1.f90 | 74 +++++++++++++++++++ 4 files changed, 95 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/string_length_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9ba65443de3b..3f4ab3c9fa47 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2007-03-19 Francois-Xavier Coudert + + PR fortran/31203 + * trans-expr.c (gfc_trans_init_string_length): Length should + never be negative. + (gfc_conv_function_call): Likewise. + 2007-03-18 Paul Thomas PR fortran/30531 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index c6448ec73833..a6920db500e4 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -227,6 +227,8 @@ gfc_trans_init_string_length (gfc_charlen * cl, stmtblock_t * pblock) gfc_init_se (&se, NULL); gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node); + se.expr = fold_build2 (MAX_EXPR, gfc_charlen_type_node, se.expr, + build_int_cst (gfc_charlen_type_node, 0)); gfc_add_block_to_block (pblock, &se.pre); tmp = cl->backend_decl; @@ -2256,6 +2258,8 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, } else { + tree tmp; + /* Calculate the length of the returned string. */ gfc_init_se (&parmse, NULL); if (need_interface_mapping) @@ -2264,7 +2268,11 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, gfc_conv_expr (&parmse, sym->ts.cl->length); gfc_add_block_to_block (&se->pre, &parmse.pre); gfc_add_block_to_block (&se->post, &parmse.post); - cl.backend_decl = fold_convert (gfc_charlen_type_node, parmse.expr); + + tmp = fold_convert (gfc_charlen_type_node, parmse.expr); + tmp = fold_build2 (MAX_EXPR, gfc_charlen_type_node, tmp, + build_int_cst (gfc_charlen_type_node, 0)); + cl.backend_decl = tmp; } /* Set up a charlen structure for it. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 46a2b8dd69be..d58871fbd6bc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-03-19 Francois-Xavier Coudert + + PR fortran/31203 + * gfortran.dg/string_length_1.f90: New test. + 2007-03-18 John David Anglin PR testsuite/30395 diff --git a/gcc/testsuite/gfortran.dg/string_length_1.f90 b/gcc/testsuite/gfortran.dg/string_length_1.f90 new file mode 100644 index 000000000000..50883f0106ce --- /dev/null +++ b/gcc/testsuite/gfortran.dg/string_length_1.f90 @@ -0,0 +1,74 @@ +! { dg-do run } +! Testcase for PR 31203 +! We used to create strings with negative length +subroutine foo(i) + integer :: i + character(len=i) :: s(2) + if (len(s) < 0) call abort + if (len(s) /= max(i,0)) call abort +end + +function gee(i) + integer, intent(in) :: i + character(len=i) :: gee + + gee = "" +end function gee + +subroutine s1(i,j) + character(len=i-j) :: a + if (len(a) < 0) call abort() +end subroutine + +program test + interface + function gee(i) + integer, intent(in) :: i + character(len=i) :: gee + end function gee + end interface + + call foo(2) + call foo(-1) + call s1(1,2) + call s1(-1,-8) + call s1(-8,-1) + + if (len(gee(2)) /= 2) call abort + if (len(gee(-5)) /= 0) call abort + if (len(gee(intfunc(3))) /= max(intfunc(3),0)) call abort + if (len(gee(intfunc(2))) /= max(intfunc(2),0)) call abort + + if (len(bar(2)) /= 2) call abort + if (len(bar(-5)) /= 0) call abort + if (len(bar(intfunc(3))) /= max(intfunc(3),0)) call abort + if (len(bar(intfunc(2))) /= max(intfunc(2),0)) call abort + + if (cow(bar(2)) /= 2) call abort + if (cow(bar(-5)) /= 0) call abort + if (cow(bar(intfunc(3))) /= max(intfunc(3),0)) call abort + if (cow(bar(intfunc(2))) /= max(intfunc(2),0)) call abort + +contains + + function bar(i) + integer, intent(in) :: i + character(len=i) :: bar + + bar = "" + end function bar + + function cow(c) + character(len=*), intent(in) :: c + integer :: cow + cow = len(c) + end function cow + + pure function intfunc(i) + integer, intent(in) :: i + integer :: intfunc + + intfunc = 2*i-5 + end function intfunc + +end program test -- 2.47.2