~ chicken-core (chicken-5) 6b36695d94e0bd977e0d85d48438f621128e1101

commit 6b36695d94e0bd977e0d85d48438f621128e1101
Author:     Mario Domenech Goulart <mario.goulart@gmail.com>
AuthorDate: Fri Jun 27 17:43:38 2014 -0300
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Mon Jun 30 19:53:54 2014 +0200

    C_substring_copy: use C_memmove instead of C_memcpy
    
    memcpy will screw things up when given the src and dest strings'
    memory area overlap (e.g., the same string object is given as src and
    dest argument), and that can cause problems in some string-copy! use
    cases.
    
    Fixes #1135.
    
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>

diff --git a/NEWS b/NEWS
index a9ded9e5..c8ce4276 100644
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,8 @@
   - Unit tcp now implicitly depends on ports instead of extras.
      This may break programs which don't use modules and forgot to
      require extras but use procedures from it.
+  - SRFI-13: fix string-copy! in cases source and destination strings'
+    memory areas overlap (#1135).
 
 - Unit lolevel:
   - Restore long-lost but still documented "vector-like?" procedure (#983)
diff --git a/chicken.h b/chicken.h
index 4a3c77ad..f5a103ee 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1260,9 +1260,9 @@ extern double trunc(double);
 #define C_i_char_greater_or_equal_p(x, y)  C_mk_bool(C_character_code(x) >= C_character_code(y))
 #define C_i_char_less_or_equal_p(x, y)  C_mk_bool(C_character_code(x) <= C_character_code(y))
 #define C_substring_copy(s1, s2, start1, end1, start2) \
-                                        (C_memcpy((C_char *)C_data_pointer(s2) + C_unfix(start2), \
-                                                  (C_char *)C_data_pointer(s1) + C_unfix(start1), \
-                                                  C_unfix(end1) - C_unfix(start1) ), C_SCHEME_UNDEFINED)
+                                        (C_memmove((C_char *)C_data_pointer(s2) + C_unfix(start2), \
+                                                   (C_char *)C_data_pointer(s1) + C_unfix(start1), \
+                                                   C_unfix(end1) - C_unfix(start1) ), C_SCHEME_UNDEFINED)
 #define C_substring_compare(s1, s2, start1, start2, len) \
                                         C_mk_bool(C_memcmp((C_char *)C_data_pointer(s1) + C_unfix(start1), \
                                                            (C_char *)C_data_pointer(s2) + C_unfix(start2), \
diff --git a/tests/srfi-13-tests.scm b/tests/srfi-13-tests.scm
index 1262b82d..8df378ac 100644
--- a/tests/srfi-13-tests.scm
+++ b/tests/srfi-13-tests.scm
@@ -115,6 +115,18 @@
        (let ((x (string-copy "abcdefg")))
          (string-copy! x 2 "ZABCDEFG" 3 6)
          x))
+
+;; From Guile.  Thanks to Mark H Weaver.
+(test "string-copy!: overlapping src and dest, moving right"
+      "aabce"
+      (let ((str (string-copy "abcde")))
+	(string-copy! str 1 str 0 3) str))
+
+(test "string-copy!: overlapping src and dest, moving left"
+      "bcdde"
+      (let ((str (string-copy "abcde")))
+	(string-copy! str 0 str 1 4) str))
+
 (test "string-take" "Pete S"  (string-take "Pete Szilagyi" 6))
 (test "string-take" ""        (string-take "Pete Szilagyi" 0))
 (test "string-take" "Pete Szilagyi" (string-take "Pete Szilagyi" 13))