From a7badc76b6db41797b31f28e29d03002d9fce79e Mon Sep 17 00:00:00 2001
From: Mario Domenech Goulart <mario.goulart@gmail.com>
Date: Fri, 27 Jun 2014 15:50:18 -0300
Subject: [PATCH] C_substring_copy: use C_memmove instead of C_memcpy when s1
and s2 are the same string
Fixes #1135 (related to string-copy!).
---
chicken.h | 11 ++++++++---
tests/srfi-13-tests.scm | 12 ++++++++++++
2 files changed, 20 insertions(+), 3 deletions(-)
diff --git a/chicken.h b/chicken.h
index 4a3c77a..59e518f 100644
|
a
|
b
|
extern double trunc(double); |
| 1260 | 1260 | #define C_i_char_greater_or_equal_p(x, y) C_mk_bool(C_character_code(x) >= C_character_code(y)) |
| 1261 | 1261 | #define C_i_char_less_or_equal_p(x, y) C_mk_bool(C_character_code(x) <= C_character_code(y)) |
| 1262 | 1262 | #define C_substring_copy(s1, s2, start1, end1, start2) \ |
| 1263 | | (C_memcpy((C_char *)C_data_pointer(s2) + C_unfix(start2), \ |
| 1264 | | (C_char *)C_data_pointer(s1) + C_unfix(start1), \ |
| 1265 | | C_unfix(end1) - C_unfix(start1) ), C_SCHEME_UNDEFINED) |
| | 1263 | ((C_char *)C_data_pointer(s1) == (C_char *)C_data_pointer(s2) \ |
| | 1264 | ? C_memmove((C_char *)C_data_pointer(s2) + C_unfix(start2), \ |
| | 1265 | (C_char *)C_data_pointer(s1) + C_unfix(start1), \ |
| | 1266 | C_unfix(end1) - C_unfix(start1) ) \ |
| | 1267 | : C_memcpy((C_char *)C_data_pointer(s2) + C_unfix(start2), \ |
| | 1268 | (C_char *)C_data_pointer(s1) + C_unfix(start1), \ |
| | 1269 | C_unfix(end1) - C_unfix(start1) ) \ |
| | 1270 | , C_SCHEME_UNDEFINED) |
| 1266 | 1271 | #define C_substring_compare(s1, s2, start1, start2, len) \ |
| 1267 | 1272 | C_mk_bool(C_memcmp((C_char *)C_data_pointer(s1) + C_unfix(start1), \ |
| 1268 | 1273 | (C_char *)C_data_pointer(s2) + C_unfix(start2), \ |
diff --git a/tests/srfi-13-tests.scm b/tests/srfi-13-tests.scm
index 1262b82..8df378a 100644
|
a
|
b
|
|
| 115 | 115 | (let ((x (string-copy "abcdefg"))) |
| 116 | 116 | (string-copy! x 2 "ZABCDEFG" 3 6) |
| 117 | 117 | x)) |
| | 118 | |
| | 119 | ;; From Guile. Thanks to Mark H Weaver. |
| | 120 | (test "string-copy!: overlapping src and dest, moving right" |
| | 121 | "aabce" |
| | 122 | (let ((str (string-copy "abcde"))) |
| | 123 | (string-copy! str 1 str 0 3) str)) |
| | 124 | |
| | 125 | (test "string-copy!: overlapping src and dest, moving left" |
| | 126 | "bcdde" |
| | 127 | (let ((str (string-copy "abcde"))) |
| | 128 | (string-copy! str 0 str 1 4) str)) |
| | 129 | |
| 118 | 130 | (test "string-take" "Pete S" (string-take "Pete Szilagyi" 6)) |
| 119 | 131 | (test "string-take" "" (string-take "Pete Szilagyi" 0)) |
| 120 | 132 | (test "string-take" "Pete Szilagyi" (string-take "Pete Szilagyi" 13)) |