tests/strings.lisp

   1 (defvar *str* "hello world")
   2 (defvar *str2* "h")
   3
   4 (test (stringp *str*))
   5 (test (not (characterp *str*)))
   6 (test (not (integerp *str*)))
   7
   8 (test (stringp *str2*))
   9 (test (not (characterp *str2*)))
  10 (test (not (integerp *str2*)))
  11
  12 (test (= (length "hello world") 11))
  13 (test (arrayp "hello world"))
  14
  15 (test (string= "h" (string #\h)))
  16 (test (string= "foo" "foo"))
  17 (test (not (string= "Foo" "foo")))
  18 (test (not (string= "foo" "foox")))
  19
  20 (test (= (string< "one" "two") 0))
  21 (test (= (string< "oob" "ooc") 2))
  22 (test (null (string< "" "")))
  23 (test (null (string< "a" "")))
  24 (test (= (string< "" "a") 0))
  25 (test (= (string< "aaa" "aaaaa") 3))
  26
  27 ;;; BUG: The compiler will macroexpand the forms below (char str N)
  28 ;;; will expand to internal SBCL code instead of our (setf char). It
  29 ;;; is because macrodefinitions during bootstrapping are not included
  30 ;;; in the host's environment. It should, but we have to think how to
  31 ;;; avoid conflicts (package renaming??)
  32
  33 ;; (let ((str "hello"))
  34 ;;   (setf (char str 0) #\X)
  35 ;;   (setf (char str 4) #\X)
  36 ;;   (test (string= str "XellX")))
  37
  38 ;; ----------------------------------------
  39 ;; The following tests in this file were derived from the file "must-string.lisp",
  40 ;; part of SACLA <http://homepage1.nifty.com/bmonkey/lisp/sacla/>.
  41 ;; The origial copyright notice appears below:
  42
  43 ;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
  44 ;; ALL RIGHTS RESERVED.
  45 ;;
  46 ;; $Id: must-string.lisp,v 1.7 2004/02/20 07:23:42 yuji Exp $
  47 ;;
  48 ;; Redistribution and use in source and binary forms, with or without
  49 ;; modification, are permitted provided that the following conditions
  50 ;; are met:
  51 ;;
  52 ;;  * Redistributions of source code must retain the above copyright
  53 ;;    notice, this list of conditions and the following disclaimer.
  54 ;;  * Redistributions in binary form must reproduce the above copyright
  55 ;;    notice, this list of conditions and the following disclaimer in
  56 ;;    the documentation and/or other materials provided with the
  57 ;;    distribution.
  58 ;;
  59 ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  60 ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  61 ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  62 ;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  63 ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  64 ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  65 ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  66 ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  67 ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  68 ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  69 ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  70
  71 ;; JSCL: no SIMPLE-STRING-P yet, so disabled
  72 ;; (test (simple-string-p ""))
  73 ;; (test (simple-string-p "abc"))
  74 ;; (test (not (simple-string-p 'not-a-string)))
  75 ;; (test (let ((str (make-array 3 :element-type 'character :fill-pointer t)))
  76 ;;   (if (not (simple-vector-p str))
  77 ;;       (not (simple-string-p str))
  78 ;;     (simple-string-p str))))
  79
  80 (test (char= (char "abc" 0) #\a))
  81 (test (char= (char "abc" 1) #\b))
  82 (test (char= (char "abc" 2) #\c))
  83 ;; JSCL: no SCHAR yet, so disabled
  84 ;; (test (char= (schar "abc" 0) #\a))
  85 ;; (test (char= (schar "abc" 1) #\b))
  86 ;; (test (char= (schar "abc" 2) #\c))
  87 ;; JSCL: no :FILL-POINTER yet, so disabled
  88 ;; (test (let ((str (make-array 10
  89 ;;                     :element-type 'character
  90 ;;                     :fill-pointer 3
  91 ;;                     :initial-contents "0123456789")))
  92 ;;   (and (string= str "012")
  93 ;;        (char= (char str 3) #\3)
  94 ;;        (char= (char str 4) #\4)
  95 ;;        (char= (char str 5) #\5)
  96 ;;        (char= (char str 6) #\6)
  97 ;;        (char= (char str 7) #\7)
  98 ;;        (char= (char str 8) #\8)
  99 ;;        (char= (char str 9) #\9)
 100 ;;        (char= (vector-pop str) #\2))))
 101
 102 (test (string= (string "") ""))
 103 (test (string= (string "abc") "abc"))
 104 (test (string= (string "a") "a"))
 105 (test (string= (string 'abc) "ABC"))
 106 (test (string= (string 'a) "A"))
 107 (test (string= (string #\a) "a"))
 108
 109
 110 (test (string= (string-upcase "abcde") "ABCDE"))
 111 (test (string= (string-upcase "Dr. Livingston, I presume?")
 112          "DR. LIVINGSTON, I PRESUME?"))
 113 (test (string= (string-upcase "Dr. Livingston, I presume?" :start 6 :end 10)
 114          "Dr. LiVINGston, I presume?"))
 115 (test (string= (string-upcase 'Kludgy-HASH-Search) "KLUDGY-HASH-SEARCH"))
 116 (test (string= (string-upcase "abcde" :start 2 :end nil) "abCDE"))
 117
 118 (test (string= (string-downcase "Dr. Livingston, I presume?")
 119          "dr. livingston, i presume?"))
 120 (test (string= (string-downcase 'Kludgy-HASH-Search) "kludgy-hash-search"))
 121 (test (string= (string-downcase "A FOOL" :start 2 :end nil) "A fool"))
 122 (test (string= (string-capitalize "elm 13c arthur;fig don't")
 123          "Elm 13c Arthur;Fig Don'T"))
 124 (test (string= (string-capitalize " hello ") " Hello "))
 125 (test (string= (string-capitalize
 126           "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION")
 127          "Occluded Casements Forestall Inadvertent Defenestration"))
 128 (test (string= (string-capitalize 'kludgy-hash-search) "Kludgy-Hash-Search"))
 129 (test (string= (string-capitalize "DON'T!") "Don'T!"))    ;not "Don't!"
 130 (test (string= (string-capitalize "pipe 13a, foo16c") "Pipe 13a, Foo16c"))
 131 (test (string= (string-capitalize "a fool" :start 2 :end nil) "a Fool"))
 132
 133 ;; JSCL HACK: a simple COPY-SEQ for testing string functions, since we don't have a real one yet
 134 (defun copy-seq (string)
 135   (let ((copy (make-string (length string))))
 136     (dotimes (i (length string) copy)
 137       (aset copy i (char string i)))))
 138
 139 (test (let ((str (copy-seq "0123ABCD890a")))
 140   (and (string= (nstring-downcase str :start 5 :end 7) "0123AbcD890a")
 141        (string= str "0123AbcD890a"))))
 142
 143 (test (let* ((str0 (copy-seq "abcde"))
 144        (str  (nstring-upcase str0)))
 145   (and (eq str0 str)
 146        (string= str "ABCDE"))))
 147 (test (let* ((str0 (copy-seq "Dr. Livingston, I presume?"))
 148        (str  (nstring-upcase str0)))
 149   (and (eq str0 str)
 150        (string= str "DR. LIVINGSTON, I PRESUME?"))))
 151 (test (let* ((str0 (copy-seq "Dr. Livingston, I presume?"))
 152        (str  (nstring-upcase str0 :start 6 :end 10)))
 153   (and (eq str0 str)
 154        (string= str "Dr. LiVINGston, I presume?"))))
 155
 156 (test (let* ((str0 (copy-seq "abcde"))
 157        (str (nstring-upcase str0 :start 2 :end nil)))
 158   (string= str "abCDE")))
 159
 160
 161
 162 (test (let* ((str0 (copy-seq "Dr. Livingston, I presume?"))
 163        (str  (nstring-downcase str0)))
 164   (and (eq str0 str)
 165        (string= str "dr. livingston, i presume?"))))
 166 (test (let* ((str0 (copy-seq "ABCDE"))
 167        (str (nstring-downcase str0 :start 2 :end nil)))
 168   (string= str "ABcde")))
 169
 170 (test (let* ((str0 (copy-seq "elm 13c arthur;fig don't"))
 171        (str  (nstring-capitalize str0)))
 172   (and (eq str0 str)
 173        (string= str "Elm 13c Arthur;Fig Don'T"))))
 174
 175 (test (let* ((str0 (copy-seq " hello "))
 176        (str  (nstring-capitalize str0)))
 177   (and (eq str0 str)
 178        (string= str " Hello "))))
 179 (test (let* ((str0 (copy-seq
 180               "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION"))
 181        (str  (nstring-capitalize str0)))
 182   (and (eq str0 str)
 183        (string= str
 184                 "Occluded Casements Forestall Inadvertent Defenestration"))))
 185 (test (let* ((str0 (copy-seq "DON'T!"))
 186        (str  (nstring-capitalize str0)))
 187   (and (eq str0 str)
 188        (string= str "Don'T!"))))    ;not "Don't!"
 189 (test (let* ((str0 (copy-seq "pipe 13a, foo16c"))
 190        (str  (nstring-capitalize str0)))
 191   (and (eq str0 str)
 192        (string= str "Pipe 13a, Foo16c"))))
 193 (test (let* ((str0 (copy-seq "a fool"))
 194        (str (nstring-capitalize str0 :start 2 :end nil)))
 195   (string= str "a Fool")))
 196
 197
 198
 199 (test (string= (string-trim "abc" "abcaakaaakabcaaa") "kaaak"))
 200 ;; (test (string= (string-trim '(#\Space #\Tab #\Newline) " garbanzo beans
 201 ;;         ") "garbanzo beans"))
 202 (test (string= (string-trim " (*)" " ( *three (silly) words* ) ")
 203          "three (silly) words"))
 204 (test (string= (string-left-trim "abc" "labcabcabc") "labcabcabc"))
 205 (test (string= (string-left-trim " (*)" " ( *three (silly) words* ) ")
 206          "three (silly) words* ) "))
 207 (test (string= (string-right-trim " (*)" " ( *three (silly) words* ) ")
 208          " ( *three (silly) words"))
 209 (test (string= (string-trim "ABC" "abc") "abc"))
 210 (test (string= (string-trim "AABBCC" "abc") "abc"))
 211 (test (string= (string-trim "" "abc") "abc"))
 212 (test (string= (string-trim "ABC" "") ""))
 213 (test (string= (string-trim "cba" "abc") ""))
 214 (test (string= (string-trim "cba" "abccba") ""))
 215 (test (string= (string-trim "ccbbba" "abccba") ""))
 216 (test (string= (string-trim "cba" "abcxabc") "x"))
 217 (test (string= (string-trim "xyz" "xxyabcxyyz") "abc"))
 218 (test (string= (string-trim "CBA" 'abcxabc) "X"))
 219 (test (string= (string-trim "a" #\a) ""))
 220
 221
 222 (test (string= (string-left-trim "ABC" "abc") "abc"))
 223 (test (string= (string-left-trim "" "abc") "abc"))
 224 (test (string= (string-left-trim "ABC" "") ""))
 225 (test (string= (string-left-trim "cba" "abc") ""))
 226 (test (string= (string-left-trim "cba" "abccba") ""))
 227 (test (string= (string-left-trim "cba" "abcxabc") "xabc"))
 228 (test (string= (string-left-trim "xyz" "xxyabcxyz") "abcxyz"))
 229 (test (string= (string-left-trim "CBA" 'abcxabc) "XABC"))
 230 (test (string= (string-left-trim "a" #\a) ""))
 231
 232 (test (string= (string-right-trim "ABC" "abc") "abc"))
 233 (test (string= (string-right-trim "" "abc") "abc"))
 234 (test (string= (string-right-trim "ABC" "") ""))
 235 (test (string= (string-right-trim "cba" "abc") ""))
 236 (test (string= (string-right-trim "cba" "abccba") ""))
 237 (test (string= (string-right-trim "cba" "abcxabc") "abcx"))
 238 (test (string= (string-right-trim "xyz" "xxyabcxyz") "xxyabc"))
 239 (test (string= (string-right-trim "CBA" 'abcxabc) "ABCX"))
 240 (test (string= (string-right-trim "a" #\a) ""))
 241
 242
 243
 244 (test (string= (string "already a string") "already a string"))
 245 (test (string= (string 'elm) "ELM"))
 246 (test (string=  (string #\c) "c"))
 247
 248
 249 (test (string= "foo" "foo"))
 250 (test (not (string= "foo" "Foo")))
 251 (test (not (string= "foo" "bar")))
 252 (test (string= "together" "frog" :start1 1 :end1 3 :start2 2))
 253 (test (string-equal "foo" "Foo"))
 254 (test (string= "abcd" "01234abcd9012" :start2 5 :end2 9))
 255 (test (eql (string< "aaaa" "aaab") 3))
 256 ;; JSCL: STRING>= doesn't exist yet, disabled
 257 ;; (test (eql (string>= "aaaaa" "aaaa") 4))
 258 ;; JSCL: STRING-NOT-GREATERP doesn't exist yet, disabling:
 259 ;; (test (eql (string-not-greaterp "Abcde" "abcdE") 5))
 260 ;; (test (eql (string-lessp "012AAAA789" "01aaab6"
 261 ;;                 :start1 3 :end1 7
 262 ;;                 :start2 2 :end2 6) 6))
 263 ;; (test (not (string-not-equal "AAAA" "aaaA")))
 264
 265
 266 (test (string= "" ""))
 267 ;; JSCL: making an array of BASE-CHAR doesn't make a string, yet
 268 ;; (test (string= (make-array 0 :element-type 'character)
 269 ;;       (make-array 0 :element-type 'base-char)))
 270 (test (not (string= "abc" "")))
 271 (test (not (string= "" "abc")))
 272 (test (not (string= "A" "a")))
 273 (test (string= "abc" "xyz" :start1 3 :start2 3))
 274 (test (string= "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0))
 275 (test (string= "axyza" "xyz" :start1 1 :end1 4))
 276 (test (string= "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil))
 277 (test (string= "abxyz" "xyabz" :end1 2 :start2 2 :end2 4))
 278 (test (not (string= "love" "hate")))
 279 (test (string= 'love 'love))
 280 (test (not (string= 'love "hate")))
 281 (test (string= #\a #\a))
 282
 283
 284 (test (not (string/= "" "")))
 285 ;; (test (not (string/= (make-array 0 :element-type 'character)
 286 ;;             (make-array 0 :element-type 'base-char))))
 287 (test (eql (string/= "abc" "") 0))
 288 (test (eql (string/= "" "abc") 0))
 289 (test (eql (string/= "A" "a") 0))
 290 (test (not (string/= "abc" "xyz" :start1 3 :start2 3)))
 291 (test (not (string/= "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0)))
 292 (test (not (string/= "axyza" "xyz" :start1 1 :end1 4)))
 293 (test (not (string/= "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil)))
 294 (test (not (string/= "abxyz" "xyabz" :end1 2 :start2 2 :end2 4)))
 295 (test (eql (string/= "love" "hate") 0))
 296 (test (eql (string/= "love" "loVe") 2))
 297 (test (not (string/= "life" "death" :start1 3 :start2 1 :end2 2)))
 298 (test (eql (string/= "abcxyz" "ABCxyZ" :start1 3 :start2 3) 5))
 299 (test (eql (string/= "abcxyz" "ABCxyZ" :start1 3 :end1 nil :start2 3 :end2 nil) 5))
 300 (test (eql (string/= "abcxyz" "ABCxyZ" :end1 nil :start2 3 :end2 3) 0))
 301 (test (eql (string/= "abc" "abcxyz") 3))
 302 (test (eql (string/= "abcxyz" "abc") 3))
 303 (test (eql (string/= "abcxyz" "") 0))
 304 (test (eql (string/= "AbcDef" "cdef" :start1 2) 3))
 305 (test (eql (string/= "cdef" "AbcDef" :start2 2) 1))
 306 (test (= (string/= 'love "hate") 0))
 307 (test (not (string/= 'love 'love)))
 308 (test (not (string/= #\a #\a)))
 309 (test (= (string/= #\a #\b) 0))
 310
 311 (test (not (string< "" "")))
 312 (test (not (string< "dog" "dog")))
 313 (test (not (string< " " " ")))
 314 (test (not (string< "abc" "")))
 315 (test (eql (string< "" "abc") 0))
 316 (test (eql (string< "ab" "abc") 2))
 317 (test (not (string< "abc" "ab")))
 318 (test (eql (string< "aaa" "aba") 1))
 319 (test (not (string< "aba" "aaa")))
 320 (test (not (string< "my cat food" "your dog food" :start1 6 :start2 8)))
 321 (test (not (string< "cat food 2 dollars" "dog food 3 dollars"
 322               :start1 3 :end1 9 :start2 3 :end2 9)))
 323 (test (eql (string< "xyzabc" "abcd" :start1 3) 6))
 324 (test (eql (string< "abc" "abc" :end1 1) 1))
 325 (test (eql (string< "xyzabc" "abc" :start1 3 :end1 5) 5))
 326 (test (eql (string< "xyz" "abcxyzXYZ" :start2 3) 3))
 327 (test (not (string< "abc" "abcxyz" :end2 3)))
 328 (test (eql (string< "xyz" "abcxyz" :end1 2 :start2 3) 2))
 329 (test (not (string< "xyzabc" "abcdef" :start1 3 :end2 3)))
 330 (test (eql (string< "aaaa" "z") 0))
 331 (test (eql (string< "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
 332 (test (eql (string< "pppTTTaTTTqqq" "pTTTxTTT"
 333               :start1 6 :end1 7
 334               :start2 4 :end2 5) 6))
 335 ;; (test (not (string< (make-array 0 :element-type 'character)
 336 ;;            (make-array 0 :element-type 'base-char))))
 337 (test (not (string< 'love 'hate)))
 338 (test (= (string< 'peace 'war) 0))
 339 (test (not (string< 'love 'love)))
 340 (test (not (string< #\a #\a)))
 341 (test (= (string< #\a #\b) 0))
 342
 343
 344 (test (not (string> "" "")))
 345 (test (not (string> "dog" "dog")))
 346 (test (not (string> " " " ")))
 347 (test (eql (string> "abc" "") 0))
 348 (test (not (string> "" "abc")))
 349 (test (not (string> "ab" "abc")))
 350 (test (eql (string> "abc" "ab") 2))
 351 (test (eql (string> "aba" "aaa") 1))
 352 (test (not (string> "aaa" "aba")))
 353 (test (not (string> "my cat food" "your dog food" :start1 6 :start2 8)))
 354 (test (not (string> "cat food 2 dollars" "dog food 3 dollars"
 355               :start1 3 :end1 9 :start2 3 :end2 9)))
 356 (test (eql (string> "xyzabcde" "abcd" :start1 3) 7))
 357 (test (not (string> "abc" "abc" :end1 1)))
 358 (test (eql (string> "xyzabc" "a" :start1 3 :end1 5) 4))
 359 (test (eql (string> "xyzXYZ" "abcxyz" :start2 3) 3))
 360 (test (eql (string> "abcxyz" "abcxyz" :end2 3) 3))
 361 (test (not (string> "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
 362 (test (not (string> "xyzabc" "abcdef" :start1 3 :end2 3)))
 363 (test (eql (string> "z" "aaaa") 0))
 364 (test (eql (string> "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
 365 (test (eql (string> "pppTTTxTTTqqq" "pTTTaTTT"
 366               :start1 6 :end1 7
 367               :start2 4 :end2 5) 6))
 368 ;; (test (not (string> (make-array 0 :element-type 'character)
 369 ;;            (make-array 0 :element-type 'base-char))))
 370 (test (= (string> 'love 'hate) 0))
 371 (test (not (string> 'peace 'war)))
 372 (test (not (string> 'love 'love)))
 373 (test (not (string> #\a #\a)))
 374 (test (not (string> #\a #\b)))
 375 (test (= (string> #\z #\a) 0))
 376
 377
 378 ;; (test (eql (string<= "" "") 0))
 379 ;; (test (eql (string<= "dog" "dog") 3))
 380 ;; (test (eql (string<= " " " ") 1))
 381 ;; (test (not (string<= "abc" "")))
 382 ;; (test (eql (string<= "ab" "abc") 2))
 383 ;; (test (eql (string<= "aaa" "aba") 1))
 384 ;; (test (not (string<= "aba" "aaa")))
 385 ;; (test (eql (string<= "my cat food" "your dog food" :start1 6 :start2 8) 11))
 386 ;; (test (eql (string<= "cat food 2 dollars" "dog food 3 dollars"
 387 ;;             :start1 3 :end1 9 :start2 3 :end2 9) 9))
 388 ;; (test (eql (string<= "xyzabc" "abcd" :start1 3) 6))
 389 ;; (test (eql (string<= "abc" "abc" :end1 1) 1))
 390 ;; (test (eql (string<= "xyzabc" "abc" :start1 3 :end1 5) 5))
 391 ;; (test (eql (string<= "xyz" "abcxyzXYZ" :start2 3) 3))
 392 ;; (test (eql (string<= "abc" "abcxyz" :end2 3) 3))
 393 ;; (test (eql (string<= "xyz" "abcxyz" :end1 2 :start2 3) 2))
 394 ;; (test (eql (string<= "xyzabc" "abcdef" :start1 3 :end2 3) 6))
 395 ;; (test (eql (string<= "aaaa" "z") 0))
 396 ;; (test (eql (string<= "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
 397 ;; (test (eql (string<= "pppTTTaTTTqqq" "pTTTxTTT"
 398 ;;             :start1 6 :end1 7
 399 ;;             :start2 4 :end2 5) 6))
 400 ;; (test (eql (string<= (make-array 0 :element-type 'character)
 401 ;;             (make-array 0 :element-type 'base-char)) 0))
 402 ;; (test (not (string<= 'love 'hate)))
 403 ;; (test (= (string<= 'peace 'war) 0))
 404 ;; (test (= (string<= 'love 'love) 4))
 405 ;; (test (= (string<= #\a #\a) 1))
 406 ;; (test (= (string<= #\a #\b) 0))
 407 ;; (test (not (string<= #\z #\a)))
 408
 409
 410 ;; (test (eql (string>= "" "") 0))
 411 ;; (test (eql (string>= "dog" "dog") 3))
 412 ;; (test (eql (string>= " " " ") 1))
 413 ;; (test (eql (string>= "abc" "") 0))
 414 ;; (test (not (string>= "" "abc")))
 415 ;; (test (not (string>= "ab" "abc")))
 416 ;; (test (eql (string>= "abc" "ab") 2))
 417 ;; (test (eql (string>= "aba" "aaa") 1))
 418 ;; (test (not (string>= "aaa" "aba")))
 419 ;; (test (eql (string>= "my cat food" "your dog food" :start1 6 :start2 8) 11))
 420 ;; (test (eql (string>= "cat food 2 dollars" "dog food 3 dollars"
 421 ;;             :start1 3 :end1 9 :start2 3 :end2 9) 9))
 422 ;; (test (eql (string>= "xyzabcde" "abcd" :start1 3) 7))
 423 ;; (test (not (string>= "abc" "abc" :end1 1)))
 424 ;; (test (eql (string>= "xyzabc" "a" :start1 3 :end1 5) 4))
 425 ;; (test (eql (string>= "xyzXYZ" "abcxyz" :start2 3) 3))
 426 ;; (test (eql (string>= "abcxyz" "abcxyz" :end2 3) 3))
 427 ;; (test (not (string>= "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
 428 ;; (test (eql (string>= "xyzabc" "abcdef" :start1 3 :end2 3) 6))
 429 ;; (test (eql (string>= "z" "aaaa") 0))
 430 ;; (test (eql (string>= "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
 431 ;; (test (eql (string>= "pppTTTxTTTqqq" "pTTTaTTT"
 432 ;;             :start1 6 :end1 7
 433 ;;             :start2 4 :end2 5) 6))
 434 ;; (test (eql (string>= (make-array 0 :element-type 'character)
 435 ;;             (make-array 0 :element-type 'base-char)) 0))
 436 ;; (test (= (string>= 'love 'hate) 0))
 437 ;; (test (not (string>= 'peace 'war)))
 438 ;; (test (= (string>= 'love 'love) 4))
 439 ;; (test (= (string>= #\a #\a) 1))
 440 ;; (test (not (string>= #\a #\b)))
 441 ;; (test (= (string>= #\z #\a) 0))
 442
 443
 444
 445
 446 (test (string-equal "" ""))
 447 ;; (test (string-equal (make-array 0 :element-type 'character)
 448 ;;            (make-array 0 :element-type 'base-char)))
 449 (test (not (string-equal "abc" "")))
 450 (test (not (string-equal "" "abc")))
 451 (test (string-equal "A" "a"))
 452 (test (string-equal "abc" "xyz" :start1 3 :start2 3))
 453 (test (string-equal "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0))
 454 (test (string-equal "axyza" "xyz" :start1 1 :end1 4))
 455 (test (string-equal "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil))
 456 (test (string-equal "abxyz" "xyabz" :end1 2 :start2 2 :end2 4))
 457 (test (not (string-equal "love" "hate")))
 458 (test (string-equal "xyz" "XYZ"))
 459 (test (not (string-equal 'love 'hate)))
 460 (test (not (string-equal 'peace 'war)))
 461 (test (string-equal 'love 'love))
 462 (test (string-equal #\a #\a))
 463 (test (not (string-equal #\a #\b)))
 464 (test (not (string-equal #\z #\a)))
 465
 466
 467 (test (not (string-not-equal "" "")))
 468 ;; (test (not (string-not-equal (make-array 0 :element-type 'character)
 469 ;;                     (make-array 0 :element-type 'base-char))))
 470 (test (eql (string-not-equal "abc" "") 0))
 471 (test (eql (string-not-equal "" "abc") 0))
 472 (test (not (string-not-equal "A" "a")))
 473 (test (not (string-not-equal "abc" "xyz" :start1 3 :start2 3)))
 474 (test (not (string-not-equal "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0)))
 475 (test (not (string-not-equal "axyza" "xyz" :start1 1 :end1 4)))
 476 (test (not (string-not-equal "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil)))
 477 (test (not (string-not-equal "abxyz" "xyabz" :end1 2 :start2 2 :end2 4)))
 478 (test (eql (string-not-equal "love" "hate") 0))
 479 (test (not (string-not-equal "love" "loVe")))
 480 (test (not (string-not-equal "life" "death" :start1 3 :start2 1 :end2 2)))
 481 (test (not (string-not-equal "abcxyz" "ABCxyZ" :start1 3 :start2 3)))
 482 (test (not (string-not-equal "abcxyz" "ABCxyZ" :start1 3 :end1 nil :start2 3 :end2 nil)))
 483 (test (eql (string-not-equal "abcxyz" "ABCxyZ" :end1 nil :start2 3 :end2 3) 0))
 484 (test (eql (string-not-equal "abc" "abcxyz") 3))
 485 (test (eql (string-not-equal "abcxyz" "abc") 3))
 486 (test (eql (string-not-equal "abcxyz" "") 0))
 487 (test (not (string-not-equal "AbcDef" "cdef" :start1 2)))
 488 (test (not (string-not-equal "cdef" "AbcDef" :start2 2)))
 489 (test (not (string-not-equal "ABC" "abc")))
 490 (test (= (string-not-equal 'love 'hate) 0))
 491 (test (= (string-not-equal 'peace 'war) 0))
 492 (test (not (string-not-equal 'love 'love)))
 493 (test (not (string-not-equal #\a #\a)))
 494 (test (= (string-not-equal #\a #\b) 0))
 495 (test (= (string-not-equal #\z #\a) 0))
 496
 497
 498 ;; (test (not (string-lessp "" "")))
 499 ;; (test (not (string-lessp "dog" "dog")))
 500 ;; (test (not (string-lessp " " " ")))
 501 ;; (test (not (string-lessp "abc" "")))
 502 ;; (test (eql (string-lessp "" "abc") 0))
 503 ;; (test (eql (string-lessp "ab" "abc") 2))
 504 ;; (test (not (string-lessp "abc" "ab")))
 505 ;; (test (eql (string-lessp "aaa" "aba") 1))
 506 ;; (test (not (string-lessp "aba" "aaa")))
 507 ;; (test (not (string-lessp "my cat food" "your dog food" :start1 6 :start2 8)))
 508 ;; (test (not (string-lessp "cat food 2 dollars" "dog food 3 dollars"
 509 ;;                 :start1 3 :end1 9 :start2 3 :end2 9)))
 510 ;; (test (eql (string-lessp "xyzabc" "abcd" :start1 3) 6))
 511 ;; (test (eql (string-lessp "abc" "abc" :end1 1) 1))
 512 ;; (test (eql (string-lessp "xyzabc" "abc" :start1 3 :end1 5) 5))
 513 ;; (test (eql (string-lessp "xyz" "abcxyzXYZ" :start2 3) 3))
 514 ;; (test (not (string-lessp "abc" "abcxyz" :end2 3)))
 515 ;; (test (eql (string-lessp "xyz" "abcxyz" :end1 2 :start2 3) 2))
 516 ;; (test (not (string-lessp "xyzabc" "abcdef" :start1 3 :end2 3)))
 517 ;; (test (eql (string-lessp "aaaa" "z") 0))
 518 ;; (test (eql (string-lessp "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
 519 ;; (test (eql (string-lessp "pppTTTaTTTqqq" "pTTTxTTT"
 520 ;;                 :start1 6 :end1 7
 521 ;;                 :start2 4 :end2 5) 6))
 522 ;; (test (not (string-lessp (make-array 0 :element-type 'character)
 523 ;;                 (make-array 0 :element-type 'base-char))))
 524 ;; (test (and (not (string-lessp "abc" "ABC"))
 525 ;;      (not (string-lessp "ABC" "abc"))))
 526 ;; (test (not (string-lessp 'love 'hate)))
 527 ;; (test (= (string-lessp 'peace 'war) 0))
 528 ;; (test (not (string-lessp 'love 'love)))
 529 ;; (test (not (string-lessp #\a #\a)))
 530 ;; (test (= (string-lessp #\a #\b) 0))
 531 ;; (test (not (string-lessp #\z #\a)))
 532
 533
 534 ;; (test (not (string-greaterp "" "")))
 535 ;; (test (not (string-greaterp "dog" "dog")))
 536 ;; (test (not (string-greaterp " " " ")))
 537 ;; (test (eql (string-greaterp "abc" "") 0))
 538 ;; (test (not (string-greaterp "" "abc")))
 539 ;; (test (not (string-greaterp "ab" "abc")))
 540 ;; (test (eql (string-greaterp "abc" "ab") 2))
 541 ;; (test (eql (string-greaterp "aba" "aaa") 1))
 542 ;; (test (not (string-greaterp "aaa" "aba")))
 543 ;; (test (not (string-greaterp "my cat food" "your dog food" :start1 6 :start2 8)))
 544 ;; (test (not (string-greaterp "cat food 2 dollars" "dog food 3 dollars"
 545 ;;                    :start1 3 :end1 9 :start2 3 :end2 9)))
 546 ;; (test (eql (string-greaterp "xyzabcde" "abcd" :start1 3) 7))
 547 ;; (test (not (string-greaterp "abc" "abc" :end1 1)))
 548 ;; (test (eql (string-greaterp "xyzabc" "a" :start1 3 :end1 5) 4))
 549 ;; (test (eql (string-greaterp "xyzXYZ" "abcxyz" :start2 3) 3))
 550 ;; (test (eql (string-greaterp "abcxyz" "abcxyz" :end2 3) 3))
 551 ;; (test (not (string-greaterp "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
 552 ;; (test (not (string-greaterp "xyzabc" "abcdef" :start1 3 :end2 3)))
 553 ;; (test (eql (string-greaterp "z" "aaaa") 0))
 554 ;; (test (eql (string-greaterp "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
 555 ;; (test (eql (string-greaterp "pppTTTxTTTqqq" "pTTTaTTT"
 556 ;;                    :start1 6 :end1 7
 557 ;;                    :start2 4 :end2 5) 6))
 558 ;; (test (not (string-greaterp (make-array 0 :element-type 'character)
 559 ;;                    (make-array 0 :element-type 'base-char))))
 560 ;; (test (and (not (string-greaterp "abc" "ABC"))
 561 ;;      (not (string-greaterp "ABC" "abc"))))
 562 ;; (test (= (string-greaterp 'love 'hate) 0))
 563 ;; (test (not (string-greaterp 'peace 'war)))
 564 ;; (test (not (string-greaterp 'love 'love)))
 565 ;; (test (not (string-greaterp #\a #\a)))
 566 ;; (test (not (string-greaterp #\a #\b)))
 567 ;; (test (= (string-greaterp #\z #\a) 0))
 568
 569
 570 ;; (test (eql (string-not-greaterp "" "") 0))
 571 ;; (test (eql (string-not-greaterp "dog" "dog") 3))
 572 ;; (test (eql (string-not-greaterp " " " ") 1))
 573 ;; (test (not (string-not-greaterp "abc" "")))
 574 ;; (test (eql (string-not-greaterp "ab" "abc") 2))
 575 ;; (test (eql (string-not-greaterp "aaa" "aba") 1))
 576 ;; (test (not (string-not-greaterp "aba" "aaa")))
 577 ;; (test (eql (string-not-greaterp "my cat food" "your dog food" :start1 6 :start2 8) 11))
 578 ;; (test (eql (string-not-greaterp "cat food 2 dollars" "dog food 3 dollars"
 579 ;;                        :start1 3 :end1 9 :start2 3 :end2 9) 9))
 580 ;; (test (eql (string-not-greaterp "xyzabc" "abcd" :start1 3) 6))
 581 ;; (test (eql (string-not-greaterp "abc" "abc" :end1 1) 1))
 582 ;; (test (eql (string-not-greaterp "xyzabc" "abc" :start1 3 :end1 5) 5))
 583 ;; (test (eql (string-not-greaterp "xyz" "abcxyzXYZ" :start2 3) 3))
 584 ;; (test (eql (string-not-greaterp "abc" "abcxyz" :end2 3) 3))
 585 ;; (test (eql (string-not-greaterp "xyz" "abcxyz" :end1 2 :start2 3) 2))
 586 ;; (test (eql (string-not-greaterp "xyzabc" "abcdef" :start1 3 :end2 3) 6))
 587 ;; (test (eql (string-not-greaterp "aaaa" "z") 0))
 588 ;; (test (eql (string-not-greaterp "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
 589 ;; (test (eql (string-not-greaterp "pppTTTaTTTqqq" "pTTTxTTT"
 590 ;;                        :start1 6 :end1 7
 591 ;;                        :start2 4 :end2 5) 6))
 592 ;; (test (eql (string-not-greaterp (make-array 0 :element-type 'character)
 593 ;;                        (make-array 0 :element-type 'base-char)) 0))
 594 ;; (test (and (eql (string-not-greaterp "abc" "ABC") 3)
 595 ;;      (eql (string-not-greaterp "ABC" "abc") 3)))
 596 ;; (test (not (string-not-greaterp 'love 'hate)))
 597 ;; (test (= (string-not-greaterp 'peace 'war) 0))
 598 ;; (test (= (string-not-greaterp 'love 'love) 4))
 599 ;; (test (= (string-not-greaterp #\a #\a) 1))
 600 ;; (test (= (string-not-greaterp #\a #\b) 0))
 601 ;; (test (not (string-not-greaterp #\z #\a)))
 602
 603
 604 ;; (test (eql (string-not-lessp "" "") 0))
 605 ;; (test (eql (string-not-lessp "dog" "dog") 3))
 606 ;; (test (eql (string-not-lessp " " " ") 1))
 607 ;; (test (eql (string-not-lessp "abc" "") 0))
 608 ;; (test (not (string-not-lessp "" "abc")))
 609 ;; (test (not (string-not-lessp "ab" "abc")))
 610 ;; (test (eql (string-not-lessp "abc" "ab") 2))
 611 ;; (test (eql (string-not-lessp "aba" "aaa") 1))
 612 ;; (test (not (string-not-lessp "aaa" "aba")))
 613 ;; (test (eql (string-not-lessp "my cat food" "your dog food" :start1 6 :start2 8) 11))
 614 ;; (test (eql (string-not-lessp "cat food 2 dollars" "dog food 3 dollars"
 615 ;;                     :start1 3 :end1 9 :start2 3 :end2 9) 9))
 616 ;; (test (eql (string-not-lessp "xyzabcde" "abcd" :start1 3) 7))
 617 ;; (test (not (string-not-lessp "abc" "abc" :end1 1)))
 618 ;; (test (eql (string-not-lessp "xyzabc" "a" :start1 3 :end1 5) 4))
 619 ;; (test (eql (string-not-lessp "xyzXYZ" "abcxyz" :start2 3) 3))
 620 ;; (test (eql (string-not-lessp "abcxyz" "abcxyz" :end2 3) 3))
 621 ;; (test (not (string-not-lessp "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
 622 ;; (test (eql (string-not-lessp "xyzabc" "abcdef" :start1 3 :end2 3) 6))
 623 ;; (test (eql (string-not-lessp "z" "aaaa") 0))
 624 ;; (test (eql (string-not-lessp "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
 625 ;; (test (eql (string-not-lessp "pppTTTxTTTqqq" "pTTTaTTT"
 626 ;;                     :start1 6 :end1 7
 627 ;;                     :start2 4 :end2 5) 6))
 628 ;; (test (eql (string-not-lessp (make-array 0 :element-type 'character)
 629 ;;                     (make-array 0 :element-type 'base-char)) 0))
 630 ;; (test (and (eql (string-not-lessp "abc" "ABC") 3)
 631 ;;      (eql (string-not-lessp "ABC" "abc") 3)))
 632 ;; (test (= (string-not-lessp 'love 'hate) 0))
 633 ;; (test (not (string-not-lessp 'peace 'war)))
 634 ;; (test (= (string-not-lessp 'love 'love) 4))
 635 ;; (test (= (string-not-lessp #\a #\a) 1))
 636 ;; (test (not (string-not-lessp #\a #\b)))
 637 ;; (test (= (string-not-lessp #\z #\a) 0))
 638
 639
 640
 641 (test (stringp "aaaaaa"))
 642 (test (stringp (make-array 0 :element-type 'character)))
 643 ;; (test (stringp (make-array 0 :element-type 'base-char)))
 644 ;; JSCL: an array of STANDARD-CHAR isn't a STRINGP yet, either
 645 ;; (test (stringp (make-array 0 :element-type 'standard-char)))
 646 (test (not (stringp #\a)))
 647 (test (not (stringp 'a)))
 648 (test (not (stringp '(string))))
 649
 650 (test (string= (make-string 3 :initial-element #\a) "aaa"))
 651 ;; JSCL: no SCHAR, so disabled
 652 ;; (test (let ((str (make-string 3)))
 653 ;;   (and (simple-string-p str)
 654 ;;        (setf (schar str 0) #\x)
 655 ;;        (setf (schar str 1) #\y)
 656 ;;        (setf (schar str 2) #\z)
 657 ;;        (string= str "xyz"))))
 658 ;; JSCL: #\Space isn't read correctly yet
 659 ;; (test (string= (make-string 1 :initial-element #\Space) " "))
 660 (test (string= (make-string 0) ""))
 661
 662 ;; JSCL: BUG?: this barfs inside the JS function xstring(), and i don't know why.
 663 ;; (test (subtypep (upgraded-array-element-type
 664 ;;         (array-element-type (make-string 3 :element-type 'standard-char)))
 665 ;;        'character))