Author: yamakenz
Date: Thu May 24 09:37:23 2007
New Revision: 4565
Modified:
sigscheme-trunk/QALog
sigscheme-trunk/src/string-procedure.c
sigscheme-trunk/test/test-string-proc.scm
Log:
* src/string-procedure.c
- (scm_p_make_string): Fix the error message about invalid length
- (scm_p_list2string): Add circular list check
* test/test-string-proc.scm
- Add test "list->string improper lists"
* QALog
- Update
Modified: sigscheme-trunk/QALog
==============================================================================
--- sigscheme-trunk/QALog (original)
+++ sigscheme-trunk/QALog Thu May 24 09:37:23 2007
@@ -839,12 +839,12 @@
file: char.c
category: r5rs
spec by eyes: [EMAIL PROTECTED]
-spec by tests: [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:
file: string.c
@@ -860,8 +860,8 @@
file: string-procedure.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:
Modified: sigscheme-trunk/src/string-procedure.c
==============================================================================
--- sigscheme-trunk/src/string-procedure.c (original)
+++ sigscheme-trunk/src/string-procedure.c Thu May 24 09:37:23 2007
@@ -96,7 +96,7 @@
if (len == 0)
return MAKE_STRING_COPYING("", 0);
if (len < 0)
- ERR_OBJ("length must be a positive integer", length);
+ ERR_OBJ("length must be a non-negative integer", length);
/* extract filler */
if (NULLP(args)) {
@@ -503,7 +503,13 @@
#if SCM_USE_MULTIBYTE_CHAR
ENSURE_STATELESS_CODEC(scm_current_char_codec);
#endif
+#if SCM_STRICT_ARGCHECK
+ len = scm_length(lst);
+ if (!SCM_LISTLEN_PROPERP(len))
+ ERR_OBJ("proper list required but got", lst);
+#else
ENSURE_LIST(lst);
+#endif
if (NULLP(lst))
return MAKE_STRING_COPYING("", 0);
Modified: sigscheme-trunk/test/test-string-proc.scm
==============================================================================
--- sigscheme-trunk/test/test-string-proc.scm (original)
+++ sigscheme-trunk/test/test-string-proc.scm Thu May 24 09:37:23 2007
@@ -957,6 +957,24 @@
(assert-error (tn) (lambda () (list->string '(#\a #x00))))
(assert-error (tn) (lambda () (list->string '(#x00 #\a))))
(assert-error (tn) (lambda () (list->string '(#\a #x00 #\a))))))
+(tn "list->string improper lists")
+(assert-error (tn) (lambda () (list->string '(#\ #\a #\ . #\b))))
+;; circular lists
+(define clst1 (list #\a))
+(set-cdr! clst1 clst1)
+(define clst2 (list #\a #\b))
+(set-cdr! (list-tail clst2 1) clst2)
+(define clst3 (list #\a #\b #\c))
+(set-cdr! (list-tail clst3 2) clst3)
+(define clst4 (list #\a #\b #\c #\d))
+(set-cdr! (list-tail clst4 3) clst4)
+(if (and sigscheme?
+ (provided? "strict-argcheck"))
+ (begin
+ (assert-error (tn) (lambda () (list->string clst1)))
+ (assert-error (tn) (lambda () (list->string clst2)))
+ (assert-error (tn) (lambda () (list->string clst3)))
+ (assert-error (tn) (lambda () (list->string clst4)))))
(tn "string-fill! immutable")
(assert-error (tn) (lambda () (string-fill! "" #\z)))
