Author: yamakenz
Date: Sun Aug 19 05:15:04 2007
New Revision: 4865
Modified:
sigscheme-trunk/NEWS
sigscheme-trunk/QALog
sigscheme-trunk/src/sigscheme.h
sigscheme-trunk/src/string-procedure.c
sigscheme-trunk/src/string.c
sigscheme-trunk/test/test-string-proc.scm
Log:
* src/string.c
- (scm_p_string_length): Fix string-length on multibyte string invalidly
counted based on current char codec. It is inconsistent with string length
recorded in string object
* src/sigscheme.h
- (scm_p_string_reconstructx): New function decl
* src/string-procedure.c
- (scm_p_string_reconstructx): New function
* test/test-string-proc.scm
- Add tests for %%string-reconstruct!
* QALog
* NEWS
- Update
Modified: sigscheme-trunk/NEWS
==============================================================================
--- sigscheme-trunk/NEWS (original)
+++ sigscheme-trunk/NEWS Sun Aug 19 05:15:04 2007
@@ -27,8 +27,8 @@
- System-installed libraries written in Scheme are introduced. And to manage
them, scm_set_system_load_path() and %%system-load-path have been added
- - New character codec procedures %%current-char-codec,
- %%set-current-char-codec! and with-char-codec
+ - New character codec related procedures %%current-char-codec,
+ %%set-current-char-codec!, with-char-codec and %%string-reconstruct!
- New port handling procedures %%current-error-port,
%%set-current-input-port!, %%set-current-output-port!,
@@ -76,6 +76,9 @@
such as (receive (x y) (call/cc (lambda (k) (k 0 1))))
- [SRFI-38] Fix broken execution by misinitialized internal hash table
+
+ - Fix string-length on multibyte string invalidly counted based on current
+ char codec. It is inconsistent with string length recorded in string object
- [R5RS] Fix error on (integer->char 0) on non-Unicode codecs
Modified: sigscheme-trunk/QALog
==============================================================================
--- sigscheme-trunk/QALog (original)
+++ sigscheme-trunk/QALog Sun Aug 19 05:15:04 2007
@@ -853,24 +853,24 @@
file: string.c
category: r5rs
-spec by eyes: [EMAIL PROTECTED]
-spec by tests: [EMAIL PROTECTED]
+spec by eyes: [EMAIL PROTECTED], [EMAIL PROTECTED]
+spec by tests: [EMAIL PROTECTED], [EMAIL PROTECTED]
general review: [EMAIL PROTECTED]
64-bit by eyes: [EMAIL PROTECTED]
64-bit by tests:
coding style: [EMAIL PROTECTED]
-normal case tests: [EMAIL PROTECTED]
+normal case tests: [EMAIL PROTECTED], [EMAIL PROTECTED]
corner case tests: [EMAIL PROTECTED]
file: string-procedure.c
category: r5rs
-spec by eyes: [EMAIL PROTECTED], [EMAIL PROTECTED]
-spec by tests: [EMAIL PROTECTED], [EMAIL PROTECTED]
+spec by eyes: [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED]
+spec by tests: [EMAIL PROTECTED], [EMAIL PROTECTED], [EMAIL PROTECTED]
general review: [EMAIL PROTECTED]
64-bit by eyes: [EMAIL PROTECTED]
64-bit by tests:
coding style: [EMAIL PROTECTED]
-normal case tests: [EMAIL PROTECTED]
+normal case tests: [EMAIL PROTECTED], [EMAIL PROTECTED]
corner case tests:
file: vector.c
@@ -1107,6 +1107,13 @@
Log
---
+2007-08-19 YamaKen <yamaken AT bp.iij4u.or.jp>
+ * string.c
+ * string-procedure.c
+ - QA done again @r4865 for multibyte string handlings. string-length
+ is fixed, and new procedure %%string-reconstruct! has been added
+ with tests in test-string-proc.scm
+
2007-08-11 YamaKen <yamaken AT bp.iij4u.or.jp>
* sigscheme.c
- QA done again @r4818 for array<->list conversion functions. The 3
Modified: sigscheme-trunk/src/sigscheme.h
==============================================================================
--- sigscheme-trunk/src/sigscheme.h (original)
+++ sigscheme-trunk/src/sigscheme.h Sun Aug 19 05:15:04 2007
@@ -1514,6 +1514,7 @@
SCM_EXPORT ScmObj scm_p_list2string(ScmObj lst);
SCM_EXPORT ScmObj scm_p_string_fillx(ScmObj str, ScmObj ch);
SCM_EXPORT ScmObj scm_p_string_mutablep(ScmObj str);
+SCM_EXPORT ScmObj scm_p_string_reconstructx(ScmObj str);
#endif /* SCM_USE_STRING_PROCEDURE */
/* vector.c */
Modified: sigscheme-trunk/src/string-procedure.c
==============================================================================
--- sigscheme-trunk/src/string-procedure.c (original)
+++ sigscheme-trunk/src/string-procedure.c Sun Aug 19 05:15:04 2007
@@ -615,3 +615,21 @@
return MAKE_BOOL(SCM_STRING_MUTABLEP(str));
}
+
+SCM_EXPORT ScmObj
+scm_p_string_reconstructx(ScmObj str)
+{
+ scm_int_t len;
+ DECLARE_FUNCTION("%%string-reconstruct!", procedure_fixed_1);
+
+ ENSURE_STRING(str);
+ ENSURE_MUTABLE_STRING(str);
+
+ /* recount string length in current char codec */
+#if SCM_USE_MULTIBYTE_CHAR
+ len = scm_mb_bare_c_strlen(scm_current_char_codec, SCM_STRING_STR(str));
+ SCM_STRING_SET_LEN(str, len);
+#endif
+
+ return str;
+}
Modified: sigscheme-trunk/src/string.c
==============================================================================
--- sigscheme-trunk/src/string.c (original)
+++ sigscheme-trunk/src/string.c Sun Aug 19 05:15:04 2007
@@ -81,11 +81,7 @@
ENSURE_STRING(str);
-#if SCM_USE_MULTIBYTE_CHAR
- len = scm_mb_bare_c_strlen(scm_current_char_codec, SCM_STRING_STR(str));
-#else
len = SCM_STRING_LEN(str);
-#endif
return MAKE_INT(len);
}
Modified: sigscheme-trunk/test/test-string-proc.scm
==============================================================================
--- sigscheme-trunk/test/test-string-proc.scm (original)
+++ sigscheme-trunk/test/test-string-proc.scm Sun Aug 19 05:15:04 2007
@@ -1034,4 +1034,31 @@
(assert-true (tn) (mutable? (my-string-fill! (cp "a b ") #\z)))
(assert-true (tn) (mutable? (my-string-fill! (cp " a b") #\z)))
+(tn "%%string-reconstruct!")
+(assert-error (tn) (lambda () (%%string-reconstruct! "")))
+(assert-error (tn) (lambda () (%%string-reconstruct! "const str")))
+(assert-error (tn) (lambda () (%%string-reconstruct! " a ")))
+(assert-equal? (tn) 0 (string-length (string-copy "")))
+(assert-equal? (tn) 9 (string-length (string-copy "const str")))
+(assert-equal? (tn) 3 (string-length (string-copy " a ")))
+(assert-equal? (tn) 0 (string-length (with-char-codec "ISO-8859-1"
+ (lambda ()
+ (%%string-reconstruct!
+ (string-copy ""))))))
+(assert-equal? (tn) 9 (string-length (with-char-codec "ISO-8859-1"
+ (lambda ()
+ (%%string-reconstruct!
+ (string-copy "const str"))))))
+(assert-equal? (tn) 7 (string-length (with-char-codec "ISO-8859-1"
+ (lambda ()
+ (%%string-reconstruct!
+ (string-copy " a "))))))
+(let ((byte-str (with-char-codec "ISO-8859-1"
+ (lambda ()
+ (%%string-reconstruct!
+ (string-copy " a "))))))
+ (assert-equal? (tn) 7 (string-length byte-str))
+ ;; reconstruct as UTF-8 string
+ (assert-equal? (tn) 3 (string-length (%%string-reconstruct! byte-str))))
+
(total-report)
