mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Fix 'string-copy!' to work properly with overlapping src/dest.

Browse source 
* libguile/srfi-13.c (scm_string_copy_x): Fix to work properly with
  overlapping src/dest.

* test-suite/tests/srfi-13.test ("string-copy!"): Add tests.
This commit is contained in:
Mark H Weaver 2013-12-25 05:10:19 -05:00
parent 900a897cd3
commit 793e8a9317
2 changed files with 22 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

13
libguile/srfi-13.c
View file

@ -546,10 +546,17 @@ SCM_DEFINE (scm_string_copy_x, "string-copy!", 3, 2, 0,
SCM_ASSERT_RANGE (3, s, len <= scm_i_string_length (target) - ctstart); SCM_ASSERT_RANGE (3, s, len <= scm_i_string_length (target) - ctstart);
target = scm_i_string_start_writing (target); target = scm_i_string_start_writing (target);
for (i = 0; i < cend - cstart; i++) if (ctstart < cstart)
{ {
scm_i_string_set_x (target, ctstart + i, for (i = 0; i < len; i++)
scm_i_string_ref (s, cstart + i)); scm_i_string_set_x (target, ctstart + i,
scm_i_string_ref (s, cstart + i));
}
else
{
for (i = len; i--;)
scm_i_string_set_x (target, ctstart + i,
scm_i_string_ref (s, cstart + i));
} }
scm_i_string_stop_writing (); scm_i_string_stop_writing ();
scm_remember_upto_here_1 (target); scm_remember_upto_here_1 (target);

15
test-suite/tests/srfi-13.test
View file

@ -555,8 +555,7 @@
(string=? "o-bar" (string-copy "\u0100\u0101o-bar" 2))) (string=? "o-bar" (string-copy "\u0100\u0101o-bar" 2)))
(pass-if "start and end index" (pass-if "start and end index"
(string=? "o-ba" (string-copy "foo-bar" 2 6))) (string=? "o-ba" (string-copy "foo-bar" 2 6))))
)
(with-test-prefix "substring/shared" (with-test-prefix "substring/shared"
@ -578,7 +577,17 @@
(let* ((s "hello") (let* ((s "hello")
(t (string-copy "world, oh yeah!"))) (t (string-copy "world, oh yeah!")))
(string-copy! t 1 s 1 3) (string-copy! t 1 s 1 3)
t)))) t)))
(pass-if-equal "overlapping src and dest, moving right"
"aabce"
(let ((str (string-copy "abcde")))
(string-copy! str 1 str 0 3) str))
(pass-if-equal "overlapping src and dest, moving left"
"bcdde"
(let ((str (string-copy "abcde")))
(string-copy! str 0 str 1 4) str)))
(with-test-prefix "string-take" (with-test-prefix "string-take"