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

* 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.

2 files changed, 22 insertions, 6 deletions

diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index 4e5d5725f..5c30dfe20 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -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);
 
       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, 
-                              scm_i_string_ref (s, cstart + i));
+          for (i = 0; i < len; 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_remember_upto_here_1 (target);
diff --git a/test-suite/tests/srfi-13.test b/test-suite/tests/srfi-13.test
index de6df8e52..a1bae7b9f 100644
--- a/test-suite/tests/srfi-13.test
+++ b/test-suite/tests/srfi-13.test
@@ -555,8 +555,7 @@
     (string=? "o-bar" (string-copy "\u0100\u0101o-bar" 2)))
 
   (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"
 
@@ -578,7 +577,17 @@
 	      (let* ((s "hello")
 		     (t (string-copy "world, oh yeah!")))
 		(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"