klisp

commit 43243b088c06945d29f360a967ff20bb29f09e36
parent 5de1ee19ef3b3b7fcdb8cd5ca1d95bf72bbdb283
Author: Oto Havle <havleoto@gmail.com>
Date:   Sun, 23 Oct 2011 11:10:09 +0200

Fixed string tests. Empty string is always immutable. All empty strings are eq?-equal.

Diffstat:
M
src/tests/strings.k
 | 
23
+++++++++++------------
M
src/tests/test-helpers.k
 | 
5
+++--

2 files changed, 14 insertions(+), 14 deletions(-)
diff --git a/src/tests/strings.k b/src/tests/strings.k
@@ -82,7 +82,6 @@
 ($check-predicate (string? (string #\a #\b #\c)))
 ($check equal? (string) "")
 ($check equal? (string #\a #\b #\c) "abc")
-($check-not-predicate ($let ((x (string)) (y (string))) (eq? x y)))
 ($check-not-predicate ($let ((x (string #\a)) (y (string #\a))) (eq? x y)))
 
 ;; XXX string-length
@@ -108,9 +107,13 @@
 
 ;; XXX string-fill!
 
-($check equal? ($let ((s (make-string 0))) (string-fill! s #\b) s) "")
 ($check equal? ($let ((s (make-string 3 #\a))) (string-fill! s #\b) s) "bbb")
-($check-error (string-fille "const" #\x))
+($check-error (string-fill! "const" #\x))
+
+;; Note: Empty string is always immutable. Therefore,
+;; it is an error to call string-fill! on empty string.
+
+($check-error (string-fill! (make-string 0) #\b))
 
 ;; XXX substring
 
@@ -130,8 +133,8 @@
   ($let* ((p "abc") (q (substring p 0 3)))
     (eq? p q)))
 
-($check-not-predicate (mutable-string? (substring "abc" 0 0)))
-($check-not-predicate (mutable-string? (substring "abc" 0 1)))
+($check-predicate (immutable-string? (substring "abc" 0 0)))
+($check-predicate (immutable-string? (substring "abc" 0 1)))
 
 ;; XXX string-append
 
@@ -145,8 +148,7 @@
   ($let* ((p "abc") (q (string-append p)))
     (eq? p q)))
 
-($check-predicate (mutable-string? (string-append)))
-($check-predicate (mutable-string? (string-append "a" "b")))
+($check-predicate (nonempty-mutable-string? (string-append "a" "b")))
 
 ;; XXX string-copy
 
@@ -157,8 +159,7 @@
   ($let* ((p "abc") (q (string-copy p)))
     (eq? p q)))
 
-($check-predicate (mutable-string? (string-copy "")))
-($check-predicate (mutable-string? (string-copy "abc")))
+($check-predicate (nonempty-mutable-string? (string-copy "abc")))
 
 ;; XXX string->immutable-string
 
@@ -182,7 +183,6 @@
 
 ($check equal? (list->string ()) "")
 ($check equal? (list->string (list #\a #\b #\c)) "abc")
-($check-not-predicate ($let ((x (list->string ())) (y (list->string ()))) (eq? x y)))
 
 ($check-not-predicate
   ($let*
@@ -191,7 +191,6 @@
       (y (list->string cs)))
   (eq? x y)))
 
-($check-predicate (mutable-string? (list->string ())))
-($check-predicate (mutable-string? (list->string (list #\a #\b))))
+($check-predicate (nonempty-mutable-string? (list->string (list #\a #\b))))
 
 ($check-error (list->string (($vau (x) #ignore x) (#\a #0=(#\a . #0#)))))
diff --git a/src/tests/test-helpers.k b/src/tests/test-helpers.k
@@ -26,10 +26,11 @@
 ($define! immutable-pair?
   ($lambda (obj) ($and? (pair? obj) (not? (mutable-pair? obj)))))
 
-($define! mutable-string?
+($define! nonempty-mutable-string?
   ($lambda (obj)
     ($and?
       (string? obj)
+      (>? (string-length obj) 0)
       (guard-dynamic-extent
         ()
         ($lambda () (string-fill! obj #\x) #t)
@@ -38,7 +39,7 @@
             ($lambda (#ignore divert) (apply divert #f))))))))
 
 ($define! immutable-string?
-  ($lambda (obj) ($and? (string? obj) (not? (mutable-string? obj)))))
+  ($lambda (obj) ($and? (string? obj) (not? (nonempty-mutable-string? obj)))))
 
 ;; ($false-for-all? P XS) evaluates to #t iff (P X) evaluates
 ;; to #f for all members X of the list XS.