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:
Francois-Xavier Coudert 2006-06-08 23:48:05 +02:00 committed by François-Xavier Coudert
parent f6cf0340b9
commit 549033f3a2
4 changed files with 45 additions and 0 deletions

View File

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

View File

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

View File

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

View 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