Author: yamakenz
Date: Thu Nov 22 02:52:35 2007
New Revision: 5049
Modified:
branches/sigscheme-0.8/src/alloc.c
branches/sigscheme-0.8/src/sigscheme.h
branches/sigscheme-0.8/src/storage-compact.h
branches/sigscheme-0.8/src/string-procedure.c
branches/sigscheme-0.8/test/test-string-proc.scm
Log:
* src/storage-compact.h
* src/sigscheme.h
* src/alloc.c
* src/string-procedure.c
* test/test-string-proc.scm
- Port -r5037:5047 from trunk
Modified: branches/sigscheme-0.8/src/alloc.c
==============================================================================
--- branches/sigscheme-0.8/src/alloc.c (original)
+++ branches/sigscheme-0.8/src/alloc.c Thu Nov 22 02:52:35 2007
@@ -181,10 +181,12 @@
return copied;
}
-#if 0
/* For 'name' slot of symbol object on storage-compact. If your
malloc(3) does
* not ensure 8-bytes alignment, Complete this function and hook this into
- * symbol object creation and modification. -- YamaKen 2006-05-30 */
+ * symbol object creation and modification. -- YamaKen 2006-05-30
+ *
+ * At least strdup(3) with short string in FreeBSD Release 7.0 BETA1.5
+ * and 8.0-CURRENT x86 returns unaligned address -- ekato 2007-11-04 */
SCM_EXPORT char *
scm_align_str(char *str)
{
@@ -192,17 +194,16 @@
size_t size;
/* Use ScmCell-alignment to ensure at least 8-bytes aligned. */
- if ((uintptr_t)ptr % sizeof(ScmCell)) {
+ if ((uintptr_t)str % sizeof(ScmCell)) {
size = strlen(str) + sizeof("");
- copied = scm_malloc_aligned8(size);
+ copied = scm_malloc_aligned(size);
strcpy(copied, str);
free(str);
return copied;
} else {
- return ptr;
+ return str;
}
}
-#endif
/*=======================================
Extendable Local Buffer
Modified: branches/sigscheme-0.8/src/sigscheme.h
==============================================================================
--- branches/sigscheme-0.8/src/sigscheme.h (original)
+++ branches/sigscheme-0.8/src/sigscheme.h Thu Nov 22 02:52:35 2007
@@ -1298,6 +1298,7 @@
SCM_EXPORT void *scm_calloc(size_t number, size_t size);
SCM_EXPORT void *scm_realloc(void *ptr, size_t size);
SCM_EXPORT char *scm_strdup(const char *str);
+SCM_EXPORT char *scm_align_str(char *str);
/* storage-gc.c */
SCM_EXPORT void scm_gc_protect(ScmObj *var);
Modified: branches/sigscheme-0.8/src/storage-compact.h
==============================================================================
--- branches/sigscheme-0.8/src/storage-compact.h (original)
+++ branches/sigscheme-0.8/src/storage-compact.h Thu Nov 22 02:52:35 2007
@@ -640,11 +640,14 @@
(SCM_ASSERT(SCM_ALIGNED_SYMBOL_NAME(n)),
\
SCM_SET_Y(SCM_SYMBOL_PTR(o), (scm_uintobj_t)(n) | SCM_MTAG_SYMBOL))
#define SCM_ISAL_SYMBOL_INIT(o, n, c)
\
- (SCM_ASSERT(SCM_ALIGNED_SYMBOL_NAME(n)),
\
- SCM_INIT((o),
\
- (c),
\
- (scm_uintobj_t)(n) | SCM_MTAG_SYMBOL,
\
- SCM_PTAG_MISC))
+ do {
\
+ char *_s = scm_align_str(n);
\
+ SCM_ASSERT(SCM_ALIGNED_SYMBOL_NAME(_s));
\
+ SCM_INIT((o),
\
+ (c),
\
+ (scm_uintobj_t)(_s) | SCM_MTAG_SYMBOL,
\
+ SCM_PTAG_MISC);
\
+ } while (0)
#define SCM_CELL_SYMBOLP(c) SCM_MISC_CELL_TYPEP((c), SYMBOL)
#define SCM_CELL_SYMBOL_FIN(c)
\
do {
\
Modified: branches/sigscheme-0.8/src/string-procedure.c
==============================================================================
--- branches/sigscheme-0.8/src/string-procedure.c (original)
+++ branches/sigscheme-0.8/src/string-procedure.c Thu Nov 22 02:52:35 2007
@@ -238,8 +238,11 @@
suffix_len = strlen(suffix_src);
new_str_len = prefix_len + ch_len + suffix_len;
- new_str = scm_realloc(c_str, new_str_len + sizeof(""));
-
+ if (ch_len > orig_ch_len) {
+ new_str = scm_realloc(c_str, new_str_len + sizeof(""));
+ } else {
+ new_str = c_str;
+ }
suffix_src = &new_str[prefix_len + orig_ch_len];
suffix_dst = &new_str[prefix_len + ch_len];
memmove(suffix_dst, suffix_src, suffix_len);
Modified: branches/sigscheme-0.8/test/test-string-proc.scm
==============================================================================
--- branches/sigscheme-0.8/test/test-string-proc.scm (original)
+++ branches/sigscheme-0.8/test/test-string-proc.scm Thu Nov 22
02:52:35 2007
@@ -545,6 +545,11 @@
(assert-error (tn) (lambda () (string-set! (cp "あaうb") 3 #x00)))
(assert-error (tn) (lambda () (string-set! (cp "あaうb") 4 #x00)))
(assert-error (tn) (lambda () (string-set! (cp "あaうb") 5 #x00)))))
+;; Tests for the bug fixed in r5040
+(tn "string-set! multibyte char modification")
+(assert-equal? (tn) "Aabcde" (my-string-set! (cp "あabcde") 0 #\A))
+(assert-equal? (tn) "Aaう" (my-string-set! (cp "あaう") 0 #\A))
+(assert-equal? (tn) "Aaうb" (my-string-set! (cp "あaうb") 0 #\A))
(tn "substring invalid forms")
(assert-error (tn) (lambda () (substring #\a 0 0)))
