re PR fortran/27958 (assignments to and from zero-sized string selections not handled)
PR fortran/27958 * trans-expr.c (gfc_conv_substring): If the substring start is greater than its end, the length of the substring is zero, and not negative. (gfc_trans_string_copy): Don't generate a call to _gfortran_copy_string when destination length is zero. * gcc/testsuite/gfortran.dg/substr_2.f: New test. From-SVN: r114496
This commit is contained in:
parent
f6cf0340b9
commit
549033f3a2
@ -1,3 +1,12 @@
|
|||||||
|
2006-06-08 Francois-Xavier Coudert <coudert@clipper.ens.fr>
|
||||||
|
|
||||||
|
PR fortran/27958
|
||||||
|
* trans-expr.c (gfc_conv_substring): If the substring start is
|
||||||
|
greater than its end, the length of the substring is zero, and
|
||||||
|
not negative.
|
||||||
|
(gfc_trans_string_copy): Don't generate a call to
|
||||||
|
_gfortran_copy_string when destination length is zero.
|
||||||
|
|
||||||
2006-06-08 Asher Langton <langton2@llnl.gov>
|
2006-06-08 Asher Langton <langton2@llnl.gov>
|
||||||
|
|
||||||
PR fortran/27786
|
PR fortran/27786
|
||||||
|
@ -275,6 +275,8 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind)
|
|||||||
build_int_cst (gfc_charlen_type_node, 1),
|
build_int_cst (gfc_charlen_type_node, 1),
|
||||||
start.expr);
|
start.expr);
|
||||||
tmp = fold_build2 (PLUS_EXPR, gfc_charlen_type_node, end.expr, tmp);
|
tmp = fold_build2 (PLUS_EXPR, gfc_charlen_type_node, end.expr, tmp);
|
||||||
|
tmp = fold_build2 (MAX_EXPR, gfc_charlen_type_node, tmp,
|
||||||
|
build_int_cst (gfc_charlen_type_node, 0));
|
||||||
se->string_length = tmp;
|
se->string_length = tmp;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -2196,6 +2198,7 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlen, tree dest,
|
|||||||
tree tmp;
|
tree tmp;
|
||||||
tree dsc;
|
tree dsc;
|
||||||
tree ssc;
|
tree ssc;
|
||||||
|
tree cond;
|
||||||
|
|
||||||
/* Deal with single character specially. */
|
/* Deal with single character specially. */
|
||||||
dsc = gfc_to_single_character (dlen, dest);
|
dsc = gfc_to_single_character (dlen, dest);
|
||||||
@ -2206,12 +2209,16 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlen, tree dest,
|
|||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
cond = fold_build2 (GT_EXPR, boolean_type_node, dlen,
|
||||||
|
build_int_cst (gfc_charlen_type_node, 0));
|
||||||
|
|
||||||
tmp = NULL_TREE;
|
tmp = NULL_TREE;
|
||||||
tmp = gfc_chainon_list (tmp, dlen);
|
tmp = gfc_chainon_list (tmp, dlen);
|
||||||
tmp = gfc_chainon_list (tmp, dest);
|
tmp = gfc_chainon_list (tmp, dest);
|
||||||
tmp = gfc_chainon_list (tmp, slen);
|
tmp = gfc_chainon_list (tmp, slen);
|
||||||
tmp = gfc_chainon_list (tmp, src);
|
tmp = gfc_chainon_list (tmp, src);
|
||||||
tmp = build_function_call_expr (gfor_fndecl_copy_string, tmp);
|
tmp = build_function_call_expr (gfor_fndecl_copy_string, tmp);
|
||||||
|
tmp = fold_build3 (COND_EXPR, void_type_node, cond, tmp, build_empty_stmt ());
|
||||||
gfc_add_expr_to_block (block, tmp);
|
gfc_add_expr_to_block (block, tmp);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1,3 +1,8 @@
|
|||||||
|
2006-06-08 Francois-Xavier Coudert <coudert@clipper.ens.fr>
|
||||||
|
|
||||||
|
PR fortran/27958
|
||||||
|
* gcc/testsuite/gfortran.dg/substr_2.f: New test.
|
||||||
|
|
||||||
2006-06-08 Asher Langton <langton2@llnl.gov>
|
2006-06-08 Asher Langton <langton2@llnl.gov>
|
||||||
|
|
||||||
PR fortran/27786
|
PR fortran/27786
|
||||||
|
24
gcc/testsuite/gfortran.dg/substr_2.f
Normal file
24
gcc/testsuite/gfortran.dg/substr_2.f
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
! { dg-do run }
|
||||||
|
! Check that substrings behave correctly even when zero-sized
|
||||||
|
implicit none
|
||||||
|
character(len=10) :: s, t
|
||||||
|
integer :: i, j
|
||||||
|
|
||||||
|
s = "abcdefghij"
|
||||||
|
t(:10) = s(1:)
|
||||||
|
s(6:5) = "foo"
|
||||||
|
if (s /= t) call abort
|
||||||
|
i = 2
|
||||||
|
j = -1
|
||||||
|
s(i:i+j) = "foo"
|
||||||
|
if (s /= t) call abort
|
||||||
|
i = 20
|
||||||
|
s(i+1:i) = "foo"
|
||||||
|
if (s /= t) call abort
|
||||||
|
s(6:5) = s(7:5)
|
||||||
|
if (s /= t) call abort
|
||||||
|
s = t(7:6)
|
||||||
|
if (len(trim(s)) /= 0) call abort
|
||||||
|
if (len(t(8:4)) /= 0) call abort
|
||||||
|
if (len(trim(t(8:4))) /= 0) call abort
|
||||||
|
end
|
Loading…
Reference in New Issue
Block a user