klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

strings.k (10595B)

      1 ;; check.k & test-helpers.k should be loaded
      2 ;;
      3 ;; Tests of string features.
      4 ;;
      5 
      6 ;; XXX immutability of string constants
      7 ;; this works because this file is loaded and the strings
      8 ;; are immutable, but just reading the file wouldn't make them
      9 ;; immutable
     10 ($check-predicate (immutable-string? ""))
     11 ($check-predicate (immutable-string? "abcd"))
     12 
     13 ;; 13.?.? string?
     14 
     15 ($check-predicate (string?))
     16 ($check-predicate (string? "" "abcdef"))
     17 
     18 ($check-not-predicate (string? #\a))
     19 ($check-not-predicate (string? 0))
     20 ($check-not-predicate (string? #f))
     21 ($check-not-predicate (string? ()))
     22 ($check-not-predicate (string? #inert))
     23 
     24 ;; XXX string=? string<? string<=? string>? string>=?
     25 ;; XXX string-ci=? string-ci<? string-ci<=? string-ci>? string-ci>=?
     26 
     27 ($check-predicate (string=? "" ""))
     28 ($check-predicate (string=? "abcd" "abcd"))
     29 ($check-not-predicate (string=? "abcd" ""))
     30 ($check-not-predicate (string=? "abcd" "ABCD"))
     31 ($check-not-predicate (string=? "aa" "aaa"))
     32 
     33 ($check-predicate (string<? "" "a"))
     34 ($check-predicate (string<? "a" "b"))
     35 ($check-predicate (string<? "a" "ab"))
     36 ($check-predicate (string<? "A" "a"))
     37 ($check-not-predicate (string<? "a" ""))
     38 ($check-not-predicate (string<? "aaa" "a"))
     39 ($check-not-predicate (string<? "b" "a"))
     40 
     41 ($check-predicate ($true-for-all-combinations? string<=?
     42                                                ("" "A") ("a" "A" "ab")))
     43 
     44 ($check-predicate ($true-for-all-combinations? string>?
     45                                                ("b" "c") ("" "a")))
     46 
     47 ($check-predicate ($true-for-all-combinations? string>=?
     48                                                ("b" "c") ("" "a" "b")))
     49 
     50 ($check-predicate (string-ci=? "" ""))
     51 ($check-predicate (string-ci=? "abcd" "AbCd"))
     52 ($check-not-predicate (string-ci=? "abcd" ""))
     53 ($check-not-predicate (string=? "aa" "AAA"))
     54 
     55 ($check-predicate ($true-for-all-combinations? string-ci<?
     56                                                ("" "a" "A") ("ab" "AB" "b" "B")))
     57 ($check-predicate ($false-for-all-combinations? string-ci<?
     58                                                 ("b" "B") ("" "a" "A" "aa" "b" "B" "ab" "aB" "Ab" "AB")))
     59 
     60 ($check-predicate ($true-for-all-combinations? string-ci<=?
     61                                                ("" "A" "a") ("a" "A" "ab")))
     62 
     63 ($check-predicate ($true-for-all-combinations? string-ci>?
     64                                                ("b" "B" "c" "C") ("" "a" "A")))
     65 
     66 ($check-predicate ($true-for-all-combinations? string-ci>=?
     67                                                ("b" "B" "c" "C") ("" "a" "A" "b" "B")))
     68 
     69 ;; XXX make-string
     70 
     71 ($check-predicate (string? (make-string 0)))
     72 ($check-predicate (string? (make-string 1)))
     73 ($check equal? (make-string 0) "")
     74 ($check equal? (make-string 0 #\a) "")
     75 ($check equal? (make-string 3 #\a) "aaa")
     76 ($check equal? (string-length (make-string 1000)) 1000)
     77 ($check equal? (string-length (make-string 1000 #\a)) 1000)
     78 ($check-error (make-string -1))
     79 ($check-error (make-string -1 #\a))
     80 
     81 ;; XXX string
     82 
     83 ($check-predicate (string? (string)))
     84 ($check-predicate (string? (string #\a #\b #\c)))
     85 ($check equal? (string) "")
     86 ($check equal? (string #\a #\b #\c) "abc")
     87 ($check-not-predicate ($let ((x (string #\a)) (y (string #\a))) (eq? x y)))
     88 
     89 ;; XXX string-upcase string-downcase string-titlecase string-foldcase
     90 ($check equal? (string-upcase "ABCDEFGHIJKLMNOPQRSTUVWXYZ01234567890abcdefghijklmnopqrstuvwxyz")
     91         "ABCDEFGHIJKLMNOPQRSTUVWXYZ01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ")
     92 ($check equal? (string-titlecase "this is a regular sentence. this 1 2!")
     93         "This Is A Regular Sentence. This 1 2!")
     94 ($check equal? (string-downcase "ABCDEFGHIJKLMNOPQRSTUVWXYZ01234567890abcdefghijklmnopqrstuvwxyz")
     95         "abcdefghijklmnopqrstuvwxyz01234567890abcdefghijklmnopqrstuvwxyz")
     96 ($check equal? (string-foldcase "ABCDEFGHIJKLMNOPQRSTUVWXYZ01234567890abcdefghijklmnopqrstuvwxyz")
     97         "abcdefghijklmnopqrstuvwxyz01234567890abcdefghijklmnopqrstuvwxyz")
     98 ($check-predicate (mutable-string? (string-upcase (string-copy "A0a"))))
     99 ($check-predicate (mutable-string? (string-upcase "A0a")))
    100 ($check-predicate (mutable-string? (string-downcase (string-copy "A0a"))))
    101 ($check-predicate (mutable-string? (string-downcase "A0a")))
    102 ($check-predicate (mutable-string? (string-titlecase (string-copy "A0a"))))
    103 ($check-predicate (mutable-string? (string-titlecase "A0a")))
    104 ($check-predicate (mutable-string? (string-foldcase (string-copy "A0a"))))
    105 ($check-predicate (mutable-string? (string-foldcase "A0a")))
    106 
    107 ;; XXX string-length
    108 
    109 ($check equal? (string-length "") 0)
    110 ($check equal? (string-length "0123456789") 10)
    111 
    112 ;; XXX string-ref
    113 
    114 ($check equal? (string-ref "0123456789" 0) #\0)
    115 ($check equal? (string-ref "0123456789" 9) #\9)
    116 ($check-error (string-ref "0123456789" 10))
    117 ($check-error (string-ref "0123456789" -1))
    118 ($check-error (string-ref "" 0))
    119 
    120 ;; XXX string-set!
    121 
    122 ($check equal? ($let ((s (make-string 2 #\a))) (string-set! s 0 #\b) s) "ba")
    123 ($check equal? ($let ((s (make-string 2 #\a))) (string-set! s 1 #\b) s) "ab")
    124 ($check-error (string-set! (make-string 2) -1 #\a))
    125 ($check-error (string-set! (make-string 2) 3 #\a))
    126 ($check-error (string-set! "const" 3 #\a))
    127 
    128 ;; XXX string-fill!
    129 
    130 ($check equal? ($let ((s (make-string 3 #\a))) (string-fill! s #\b) s) "bbb")
    131 ($check-error (string-fill! "const" #\x))
    132 
    133 ;; Note: Empty string is always immutable. Therefore,
    134 ;; it is an error to call string-fill! on empty string.
    135 
    136 ($check-error (string-fill! (make-string 0) #\b))
    137 
    138 ;; XXX substring
    139 
    140 ($check equal? (substring "" 0 0) "")
    141 ($check equal? (substring "abcdef" 0 0) "")
    142 ($check equal? (substring "abcdef" 3 3) "")
    143 ($check equal? (substring "abcdef" 5 5) "")
    144 ($check equal? (substring "abcdef" 6 6) "")
    145 ($check equal? (substring "abcdef" 2 5) "cde")
    146 ($check equal? (substring "abcdef" 0 6) "abcdef")
    147 ($check-error (substring "abcdef" -1 0))
    148 ($check-error (substring "abcdef" 10 11))
    149 ($check-error (substring "abcdef" 3 10))
    150 ($check-error (substring "abcdef" 4 2))
    151 
    152 
    153 ;; immutable strings are eq? iff string=?
    154 ;; substring generates mutable strings
    155 ;; Andres Navarro
    156 ($check-predicate
    157  ($let* ((p "abc") (q (string->immutable-string (substring p 0 3))))
    158    (eq? p q)))
    159 
    160 ;; string-copy always generate mutable strings
    161 ;; Andres Navarro
    162 ($check-not-predicate
    163  ($let* ((p (string-copy "abc")) (q (substring p 0 3)))
    164    (eq? p q)))
    165 
    166 ;; substring always generate mutable strings
    167 ($check-predicate (immutable-string? (substring "abc" 0 0)))
    168 ($check-not-predicate (immutable-string? (substring "abc" 0 1)))
    169 
    170 ;; XXX string-append
    171 
    172 ($check equal? (string-append) "")
    173 ($check equal? (string-append "") "")
    174 ($check equal? (string-append "a") "a")
    175 ($check equal? (string-append "a" "b") "ab")
    176 ($check equal? (string-append "a" "b" "c") "abc")
    177 
    178 ($check-not-predicate
    179  ($let* ((p "abc") (q (string-append p)))
    180    (eq? p q)))
    181 
    182 ($check-predicate (nonempty-mutable-string? (string-append "a" "b")))
    183 
    184 ;; XXX string-copy
    185 
    186 ($check equal? (string-copy "") "")
    187 ($check equal? (string-copy "abcd") "abcd")
    188 
    189 ($check-not-predicate
    190  ($let* ((p "abc") (q (string-copy p)))
    191    (eq? p q)))
    192 
    193 ($check-predicate (nonempty-mutable-string? (string-copy "abc")))
    194 
    195 ;; XXX string->immutable-string
    196 
    197 ($check equal? (string->immutable-string "") "")
    198 ($check equal? (string->immutable-string "abcd") "abcd")
    199 
    200 ($check-not-predicate
    201  ($let* ((p "abc") (q (string-copy p)))
    202    (eq? p q)))
    203 
    204 ($check-predicate (immutable-string? (string->immutable-string "")))
    205 ($check-predicate (immutable-string? (string->immutable-string "abc")))
    206 ($check-predicate (immutable-string? (string->immutable-string (make-string 10))))
    207 
    208 ;; XXX string->list
    209 
    210 ($check equal? (string->list "") ())
    211 ($check equal? (string->list "abc") (list #\a #\b #\c))
    212 
    213 ;; XXX list->string
    214 
    215 ($check equal? (list->string ()) "")
    216 ($check equal? (list->string (list #\a #\b #\c)) "abc")
    217 
    218 ($check-not-predicate
    219  ($let*
    220      ( (cs (list #\a #\b #\c))
    221        (x (list->string cs))
    222        (y (list->string cs)))
    223    (eq? x y)))
    224 
    225 ($check-predicate (nonempty-mutable-string? (list->string (list #\a #\b))))
    226 
    227 ($check-error (list->string ($quote (#\a #0=(#\a . #0#)))))
    228 
    229 ;; XXX string->vector
    230 
    231 ($check equal? (string->vector "") (vector))
    232 ($check equal? (string->vector "abc") (vector #\a #\b #\c))
    233 ($check-not-predicate (equal? (string->vector "abc") (vector #\a #\B #\c)))
    234 
    235 ($check-not-predicate
    236  ($let*
    237      ( (str "abc")
    238        (x (string->vector str))
    239        (y (string->vector str)))
    240    (eq? x y)))
    241 
    242 ($check-predicate (mutable-vector? (string->vector "abc")))
    243 
    244 ;; XXX vector->string
    245 
    246 ($check equal? (vector->string (vector)) "")
    247 ($check equal? (vector->string (vector #\a #\b #\c)) "abc")
    248 
    249 ($check-not-predicate
    250  ($let*
    251      ( (cs (vector #\a #\b #\c))
    252        (x (vector->string cs))
    253        (y (vector->string cs)))
    254    (eq? x y)))
    255 
    256 ($check-predicate (mutable-string? (vector->string (vector #\a #\b))))
    257 
    258 ;; errors
    259 ($check-error (vector->string (vector 41)))
    260 ($check-error (vector->string (vector "a")))
    261 
    262 ;; XXX string->bytevector
    263 
    264 ($check equal? (string->bytevector "") (bytevector))
    265 ($check equal? (string->bytevector "aBc") 
    266         (bytevector (char->integer #\a)
    267                     (char->integer #\B) 
    268                     (char->integer #\c)))
    269 
    270 ($check-not-predicate
    271  ($let*
    272      ( (str "abc")
    273        (x (string->bytevector str))
    274        (y (string->bytevector str)))
    275    (eq? x y)))
    276 
    277 ($check-predicate (mutable-bytevector? (string->bytevector "abc")))
    278 
    279 ;; XXX bytevector->string
    280 
    281 ($check equal? (bytevector->string (bytevector)) "")
    282 ($check equal? (bytevector->string (bytevector (char->integer #\a) 
    283                                                (char->integer #\b) 
    284                                                (char->integer #\c))) 
    285         "abc")
    286 
    287 ($check-not-predicate
    288  ($let*
    289      ((cs (bytevector (char->integer #\a) 
    290                       (char->integer #\b)
    291                       (char->integer #\c)))
    292       (x (bytevector->string cs))
    293       (y (bytevector->string cs)))
    294    (eq? x y)))
    295 
    296 ($check-predicate (mutable-string? 
    297                    (bytevector->string (bytevector (char->integer #\a)
    298                                                    (char->integer #\b)))))
    299 
    300 ;; errors
    301 ($check-error (bytevector->string (bytevector 128))) ;; only ASCII
    302 
    303 
    304 ;; 13.1.1 string->symbol
    305 ;; XXX symbol->string
    306 ;;
    307 
    308 ($check-predicate (symbol? (string->symbol "abcd")))
    309 ($check-predicate (symbol? (string->symbol "")))
    310 ($check-predicate (symbol? (string->symbol "0")))
    311 ($check-predicate (symbol? (string->symbol "#inert")))
    312 
    313 ($check equal? (string->symbol "abcd") ($quote abcd))
    314 ($check equal? (symbol->string ($quote abcd)) "abcd")
    315 
    316 ($check equal?
    317         ($quote sym)
    318         (string->symbol (symbol->string ($quote sym))))