This patch fixes an ordering problem with deferred string lengths. For
str = str2(:nn)
where "nn" is a something a tad more complicated than a local variable
(e.g. a non-VALUE dummy argument), the result was wrong: the temporary
variable with the string length was used before it was set.
The attached patch fixes the issue. However, I wonder whether the block
should/could always be added.
Build and regtested on x86-64-linux.
OK for the trunk?
* * *
Remaining deferred-length issues:
- PR 47674: a = a(:n); reallocation messed up; "realloc" should be
enough as the length has to be always <= previous length [memory content
is then guaranteed to remain untouched]. Alternatively, a temporary is
required
- PR 49954: String length is wrong for "array(:)(1:1)": It's wrongly the
one of "array" instead of 1; there might be some extra issues.
- PR 50221: Some odd array assignment issues.
- PR 51976: Deferred-string components. Needs a hidden component for the
string length. Tricky: expr->ts.u.cl->backend_decl is wrong as that
points to the component - missing the component ref ("var->comp").
Similar to the issue of PR49954.
Tobias
2012-05-24 Tobias Burnus <bur...@net-b.de>
PR fortran/45170
* trans-expr.c (gfc_trans_assignment_1): Fix handling of RHS
string lengths for deferred-length LHS.
(gfc_trans_scalar_assign): Remove superfluous gcc_assert.
2012-05-24 Tobias Burnus <bur...@net-b.de>
PR fortran/45170
* gfortran.dg/deferred_type_param_7.f90: New.
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9d48a09..ce915b6 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6106,7 +6110,6 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
if (rse->string_length != NULL_TREE)
{
- gcc_assert (rse->string_length != NULL_TREE);
gfc_conv_string_parameter (rse);
gfc_add_block_to_block (&block, &rse->pre);
rlen = rse->string_length;
@@ -6891,7 +6897,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 +7015,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,
--- /dev/null 2012-05-24 07:57:26.555773053 +0200
+++ gcc/gcc/testsuite/gfortran.dg/deferred_type_param_7.f90 2012-05-24 15:18:26.000000000 +0200
@@ -0,0 +1,64 @@
+! { dg-do run }
+!
+! PR fortran/45170
+!
+! Contribued by Steve Kargl
+!
+
+PROGRAM helloworld
+ implicit none
+ character(:),allocatable::string
+ character(11), parameter :: cmpstring = "hello world"
+ real::rnd
+ integer :: i, cnt
+ do i = 1, 100
+ call random_number(rnd)
+ cnt = floor(12*rnd)
+
+ if (allocated (string) .and. mod(i, 3) == 0) deallocate (string)
+ call hello1 (cnt, string)
+ if (len(string) /= cnt .or. string /= cmpstring(1:cnt)) call abort ()
+
+ if (allocated (string) .and. mod(i, 5) == 0) deallocate (string)
+ call hello2 (cnt, string)
+ if (len(string) /= cnt .or. string /= cmpstring(1:cnt)) call abort ()
+
+ if (allocated (string) .and. mod(i, 7) == 0) deallocate (string)
+ call hello3 (cnt, string)
+ if (len(string) /= cnt .or. string /= cmpstring(1:cnt)) call abort ()
+
+ if (allocated (string) .and. mod(i, 9) == 0) deallocate (string)
+ call hello4 (cnt, string)
+ if (len(string) /= cnt .or. string /= cmpstring(1:cnt)) call abort ()
+
+! print '(A,1X,I0)', '>' // string // '<', len(string)
+ end do
+contains
+ subroutine hello1 (n,string)
+ character(:),allocatable,intent(out)::string
+ integer,intent(in)::n
+ character(11)::helloworld="hello world"
+ string=helloworld(:n) ! Does not work.
+ end subroutine hello1
+
+ subroutine hello2 (n,string)
+ character(:),allocatable,intent(out)::string
+ integer,intent(in)::n
+ character(11)::helloworld="hello world"
+ string=(helloworld(:n))
+ end subroutine hello2
+
+ subroutine hello3 (n,string)
+ character(:),allocatable,intent(out)::string
+ integer,intent(in)::n
+ character(11)::helloworld="hello world"
+ allocate(string, source=helloworld(:n))
+ end subroutine hello3
+
+ subroutine hello4 (n,string)
+ character(:),allocatable,intent(out)::string
+ integer,intent(in)::n
+ character(11)::helloworld="hello world"
+ allocate(string, source=(helloworld(:n)))
+ end subroutine hello4
+end PROGRAM helloworld
