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 (test (let ((str (copy-seq "0123ABCD890a")))
 134   (and (string= (nstring-downcase str :start 5 :end 7) "0123AbcD890a")
 135        (string= str "0123AbcD890a"))))
 136
 137 (test (let* ((str0 (copy-seq "abcde"))
 138        (str  (nstring-upcase str0)))
 139   (and (eq str0 str)
 140        (string= str "ABCDE"))))
 141 (test (let* ((str0 (copy-seq "Dr. Livingston, I presume?"))
 142        (str  (nstring-upcase str0)))
 143   (and (eq str0 str)
 144        (string= str "DR. LIVINGSTON, I PRESUME?"))))
 145 (test (let* ((str0 (copy-seq "Dr. Livingston, I presume?"))
 146        (str  (nstring-upcase str0 :start 6 :end 10)))
 147   (and (eq str0 str)
 148        (string= str "Dr. LiVINGston, I presume?"))))
 149
 150 (test (let* ((str0 (copy-seq "abcde"))
 151        (str (nstring-upcase str0 :start 2 :end nil)))
 152   (string= str "abCDE")))
 153
 154
 155
 156 (test (let* ((str0 (copy-seq "Dr. Livingston, I presume?"))
 157        (str  (nstring-downcase str0)))
 158   (and (eq str0 str)
 159        (string= str "dr. livingston, i presume?"))))
 160 (test (let* ((str0 (copy-seq "ABCDE"))
 161        (str (nstring-downcase str0 :start 2 :end nil)))
 162   (string= str "ABcde")))
 163
 164 (test (let* ((str0 (copy-seq "elm 13c arthur;fig don't"))
 165        (str  (nstring-capitalize str0)))
 166   (and (eq str0 str)
 167        (string= str "Elm 13c Arthur;Fig Don'T"))))
 168
 169 (test (let* ((str0 (copy-seq " hello "))
 170        (str  (nstring-capitalize str0)))
 171   (and (eq str0 str)
 172        (string= str " Hello "))))
 173 (test (let* ((str0 (copy-seq
 174               "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION"))
 175        (str  (nstring-capitalize str0)))
 176   (and (eq str0 str)
 177        (string= str
 178                 "Occluded Casements Forestall Inadvertent Defenestration"))))
 179 (test (let* ((str0 (copy-seq "DON'T!"))
 180        (str  (nstring-capitalize str0)))
 181   (and (eq str0 str)
 182        (string= str "Don'T!"))))    ;not "Don't!"
 183 (test (let* ((str0 (copy-seq "pipe 13a, foo16c"))
 184        (str  (nstring-capitalize str0)))
 185   (and (eq str0 str)
 186        (string= str "Pipe 13a, Foo16c"))))
 187 (test (let* ((str0 (copy-seq "a fool"))
 188        (str (nstring-capitalize str0 :start 2 :end nil)))
 189   (string= str "a Fool")))
 190
 191
 192
 193 (test (string= (string-trim "abc" "abcaakaaakabcaaa") "kaaak"))
 194 ;; (test (string= (string-trim '(#\Space #\Tab #\Newline) " garbanzo beans
 195 ;;         ") "garbanzo beans"))
 196 (test (string= (string-trim " (*)" " ( *three (silly) words* ) ")
 197          "three (silly) words"))
 198 (test (string= (string-left-trim "abc" "labcabcabc") "labcabcabc"))
 199 (test (string= (string-left-trim " (*)" " ( *three (silly) words* ) ")
 200          "three (silly) words* ) "))
 201 (test (string= (string-right-trim " (*)" " ( *three (silly) words* ) ")
 202          " ( *three (silly) words"))
 203 (test (string= (string-trim "ABC" "abc") "abc"))
 204 (test (string= (string-trim "AABBCC" "abc") "abc"))
 205 (test (string= (string-trim "" "abc") "abc"))
 206 (test (string= (string-trim "ABC" "") ""))
 207 (test (string= (string-trim "cba" "abc") ""))
 208 (test (string= (string-trim "cba" "abccba") ""))
 209 (test (string= (string-trim "ccbbba" "abccba") ""))
 210 (test (string= (string-trim "cba" "abcxabc") "x"))
 211 (test (string= (string-trim "xyz" "xxyabcxyyz") "abc"))
 212 (test (string= (string-trim "CBA" 'abcxabc) "X"))
 213 (test (string= (string-trim "a" #\a) ""))
 214
 215
 216 (test (string= (string-left-trim "ABC" "abc") "abc"))
 217 (test (string= (string-left-trim "" "abc") "abc"))
 218 (test (string= (string-left-trim "ABC" "") ""))
 219 (test (string= (string-left-trim "cba" "abc") ""))
 220 (test (string= (string-left-trim "cba" "abccba") ""))
 221 (test (string= (string-left-trim "cba" "abcxabc") "xabc"))
 222 (test (string= (string-left-trim "xyz" "xxyabcxyz") "abcxyz"))
 223 (test (string= (string-left-trim "CBA" 'abcxabc) "XABC"))
 224 (test (string= (string-left-trim "a" #\a) ""))
 225
 226 (test (string= (string-right-trim "ABC" "abc") "abc"))
 227 (test (string= (string-right-trim "" "abc") "abc"))
 228 (test (string= (string-right-trim "ABC" "") ""))
 229 (test (string= (string-right-trim "cba" "abc") ""))
 230 (test (string= (string-right-trim "cba" "abccba") ""))
 231 (test (string= (string-right-trim "cba" "abcxabc") "abcx"))
 232 (test (string= (string-right-trim "xyz" "xxyabcxyz") "xxyabc"))
 233 (test (string= (string-right-trim "CBA" 'abcxabc) "ABCX"))
 234 (test (string= (string-right-trim "a" #\a) ""))
 235
 236
 237
 238 (test (string= (string "already a string") "already a string"))
 239 (test (string= (string 'elm) "ELM"))
 240 (test (string=  (string #\c) "c"))
 241
 242
 243 (test (string= "foo" "foo"))
 244 (test (not (string= "foo" "Foo")))
 245 (test (not (string= "foo" "bar")))
 246 (test (string= "together" "frog" :start1 1 :end1 3 :start2 2))
 247 (test (string-equal "foo" "Foo"))
 248 (test (string= "abcd" "01234abcd9012" :start2 5 :end2 9))
 249 (test (eql (string< "aaaa" "aaab") 3))
 250 (test (eql (string>= "aaaaa" "aaaa") 4))
 251 (test (eql (string-not-greaterp "Abcde" "abcdE") 5))
 252 (test (eql (string-lessp "012AAAA789" "01aaab6"
 253                    :start1 3 :end1 7
 254                    :start2 2 :end2 6) 6))
 255 (test (not (string-not-equal "AAAA" "aaaA")))
 256
 257
 258 (test (string= "" ""))
 259 ;; JSCL: making an array of BASE-CHAR doesn't make a string, yet
 260 ;; (test (string= (make-array 0 :element-type 'character)
 261 ;;       (make-array 0 :element-type 'base-char)))
 262 (test (not (string= "abc" "")))
 263 (test (not (string= "" "abc")))
 264 (test (not (string= "A" "a")))
 265 (test (string= "abc" "xyz" :start1 3 :start2 3))
 266 (test (string= "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0))
 267 (test (string= "axyza" "xyz" :start1 1 :end1 4))
 268 (test (string= "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil))
 269 (test (string= "abxyz" "xyabz" :end1 2 :start2 2 :end2 4))
 270 (test (not (string= "love" "hate")))
 271 (test (string= 'love 'love))
 272 (test (not (string= 'love "hate")))
 273 (test (string= #\a #\a))
 274
 275
 276 (test (not (string/= "" "")))
 277 ;; (test (not (string/= (make-array 0 :element-type 'character)
 278 ;;             (make-array 0 :element-type 'base-char))))
 279 (test (eql (string/= "abc" "") 0))
 280 (test (eql (string/= "" "abc") 0))
 281 (test (eql (string/= "A" "a") 0))
 282 (test (not (string/= "abc" "xyz" :start1 3 :start2 3)))
 283 (test (not (string/= "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0)))
 284 (test (not (string/= "axyza" "xyz" :start1 1 :end1 4)))
 285 (test (not (string/= "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil)))
 286 (test (not (string/= "abxyz" "xyabz" :end1 2 :start2 2 :end2 4)))
 287 (test (eql (string/= "love" "hate") 0))
 288 (test (eql (string/= "love" "loVe") 2))
 289 (test (not (string/= "life" "death" :start1 3 :start2 1 :end2 2)))
 290 (test (eql (string/= "abcxyz" "ABCxyZ" :start1 3 :start2 3) 5))
 291 (test (eql (string/= "abcxyz" "ABCxyZ" :start1 3 :end1 nil :start2 3 :end2 nil) 5))
 292 (test (eql (string/= "abcxyz" "ABCxyZ" :end1 nil :start2 3 :end2 3) 0))
 293 (test (eql (string/= "abc" "abcxyz") 3))
 294 (test (eql (string/= "abcxyz" "abc") 3))
 295 (test (eql (string/= "abcxyz" "") 0))
 296 (test (eql (string/= "AbcDef" "cdef" :start1 2) 3))
 297 (test (eql (string/= "cdef" "AbcDef" :start2 2) 1))
 298 (test (= (string/= 'love "hate") 0))
 299 (test (not (string/= 'love 'love)))
 300 (test (not (string/= #\a #\a)))
 301 (test (= (string/= #\a #\b) 0))
 302
 303 (test (not (string< "" "")))
 304 (test (not (string< "dog" "dog")))
 305 (test (not (string< " " " ")))
 306 (test (not (string< "abc" "")))
 307 (test (eql (string< "" "abc") 0))
 308 (test (eql (string< "ab" "abc") 2))
 309 (test (not (string< "abc" "ab")))
 310 (test (eql (string< "aaa" "aba") 1))
 311 (test (not (string< "aba" "aaa")))
 312 (test (not (string< "my cat food" "your dog food" :start1 6 :start2 8)))
 313 (test (not (string< "cat food 2 dollars" "dog food 3 dollars"
 314               :start1 3 :end1 9 :start2 3 :end2 9)))
 315 (test (eql (string< "xyzabc" "abcd" :start1 3) 6))
 316 (test (eql (string< "abc" "abc" :end1 1) 1))
 317 (test (eql (string< "xyzabc" "abc" :start1 3 :end1 5) 5))
 318 (test (eql (string< "xyz" "abcxyzXYZ" :start2 3) 3))
 319 (test (not (string< "abc" "abcxyz" :end2 3)))
 320 (test (eql (string< "xyz" "abcxyz" :end1 2 :start2 3) 2))
 321 (test (not (string< "xyzabc" "abcdef" :start1 3 :end2 3)))
 322 (test (eql (string< "aaaa" "z") 0))
 323 (test (eql (string< "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
 324 (test (eql (string< "pppTTTaTTTqqq" "pTTTxTTT"
 325               :start1 6 :end1 7
 326               :start2 4 :end2 5) 6))
 327 ;; (test (not (string< (make-array 0 :element-type 'character)
 328 ;;            (make-array 0 :element-type 'base-char))))
 329 (test (not (string< 'love 'hate)))
 330 (test (= (string< 'peace 'war) 0))
 331 (test (not (string< 'love 'love)))
 332 (test (not (string< #\a #\a)))
 333 (test (= (string< #\a #\b) 0))
 334
 335
 336 (test (not (string> "" "")))
 337 (test (not (string> "dog" "dog")))
 338 (test (not (string> " " " ")))
 339 (test (eql (string> "abc" "") 0))
 340 (test (not (string> "" "abc")))
 341 (test (not (string> "ab" "abc")))
 342 (test (eql (string> "abc" "ab") 2))
 343 (test (eql (string> "aba" "aaa") 1))
 344 (test (not (string> "aaa" "aba")))
 345 (test (not (string> "my cat food" "your dog food" :start1 6 :start2 8)))
 346 (test (not (string> "cat food 2 dollars" "dog food 3 dollars"
 347               :start1 3 :end1 9 :start2 3 :end2 9)))
 348 (test (eql (string> "xyzabcde" "abcd" :start1 3) 7))
 349 (test (not (string> "abc" "abc" :end1 1)))
 350 (test (eql (string> "xyzabc" "a" :start1 3 :end1 5) 4))
 351 (test (eql (string> "xyzXYZ" "abcxyz" :start2 3) 3))
 352 (test (eql (string> "abcxyz" "abcxyz" :end2 3) 3))
 353 (test (not (string> "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
 354 (test (not (string> "xyzabc" "abcdef" :start1 3 :end2 3)))
 355 (test (eql (string> "z" "aaaa") 0))
 356 (test (eql (string> "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
 357 (test (eql (string> "pppTTTxTTTqqq" "pTTTaTTT"
 358               :start1 6 :end1 7
 359               :start2 4 :end2 5) 6))
 360 ;; (test (not (string> (make-array 0 :element-type 'character)
 361 ;;            (make-array 0 :element-type 'base-char))))
 362 (test (= (string> 'love 'hate) 0))
 363 (test (not (string> 'peace 'war)))
 364 (test (not (string> 'love 'love)))
 365 (test (not (string> #\a #\a)))
 366 (test (not (string> #\a #\b)))
 367 (test (= (string> #\z #\a) 0))
 368
 369
 370 (test (eql (string<= "" "") 0))
 371 (test (eql (string<= "dog" "dog") 3))
 372 (test (eql (string<= " " " ") 1))
 373 (test (not (string<= "abc" "")))
 374 (test (eql (string<= "ab" "abc") 2))
 375 (test (eql (string<= "aaa" "aba") 1))
 376 (test (not (string<= "aba" "aaa")))
 377 (test (eql (string<= "my cat food" "your dog food" :start1 6 :start2 8) 11))
 378 (test (eql (string<= "cat food 2 dollars" "dog food 3 dollars"
 379                :start1 3 :end1 9 :start2 3 :end2 9) 9))
 380 (test (eql (string<= "xyzabc" "abcd" :start1 3) 6))
 381 (test (eql (string<= "abc" "abc" :end1 1) 1))
 382 (test (eql (string<= "xyzabc" "abc" :start1 3 :end1 5) 5))
 383 (test (eql (string<= "xyz" "abcxyzXYZ" :start2 3) 3))
 384 (test (eql (string<= "abc" "abcxyz" :end2 3) 3))
 385 (test (eql (string<= "xyz" "abcxyz" :end1 2 :start2 3) 2))
 386 (test (eql (string<= "xyzabc" "abcdef" :start1 3 :end2 3) 6))
 387 (test (eql (string<= "aaaa" "z") 0))
 388 (test (eql (string<= "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
 389 (test (eql (string<= "pppTTTaTTTqqq" "pTTTxTTT"
 390                :start1 6 :end1 7
 391                :start2 4 :end2 5) 6))
 392 ;; (test (eql (string<= (make-array 0 :element-type 'character)
 393 ;;             (make-array 0 :element-type 'base-char)) 0))
 394 (test (not (string<= 'love 'hate)))
 395 (test (= (string<= 'peace 'war) 0))
 396 (test (= (string<= 'love 'love) 4))
 397 (test (= (string<= #\a #\a) 1))
 398 (test (= (string<= #\a #\b) 0))
 399 (test (not (string<= #\z #\a)))
 400
 401
 402 (test (eql (string>= "" "") 0))
 403 (test (eql (string>= "dog" "dog") 3))
 404 (test (eql (string>= " " " ") 1))
 405 (test (eql (string>= "abc" "") 0))
 406 (test (not (string>= "" "abc")))
 407 (test (not (string>= "ab" "abc")))
 408 (test (eql (string>= "abc" "ab") 2))
 409 (test (eql (string>= "aba" "aaa") 1))
 410 (test (not (string>= "aaa" "aba")))
 411 (test (eql (string>= "my cat food" "your dog food" :start1 6 :start2 8) 11))
 412 (test (eql (string>= "cat food 2 dollars" "dog food 3 dollars"
 413                :start1 3 :end1 9 :start2 3 :end2 9) 9))
 414 (test (eql (string>= "xyzabcde" "abcd" :start1 3) 7))
 415 (test (not (string>= "abc" "abc" :end1 1)))
 416 (test (eql (string>= "xyzabc" "a" :start1 3 :end1 5) 4))
 417 (test (eql (string>= "xyzXYZ" "abcxyz" :start2 3) 3))
 418 (test (eql (string>= "abcxyz" "abcxyz" :end2 3) 3))
 419 (test (not (string>= "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
 420 (test (eql (string>= "xyzabc" "abcdef" :start1 3 :end2 3) 6))
 421 (test (eql (string>= "z" "aaaa") 0))
 422 (test (eql (string>= "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
 423 (test (eql (string>= "pppTTTxTTTqqq" "pTTTaTTT"
 424                :start1 6 :end1 7
 425                :start2 4 :end2 5) 6))
 426 ;; (test (eql (string>= (make-array 0 :element-type 'character)
 427 ;;             (make-array 0 :element-type 'base-char)) 0))
 428 (test (= (string>= 'love 'hate) 0))
 429 (test (not (string>= 'peace 'war)))
 430 (test (= (string>= 'love 'love) 4))
 431 (test (= (string>= #\a #\a) 1))
 432 (test (not (string>= #\a #\b)))
 433 (test (= (string>= #\z #\a) 0))
 434
 435
 436
 437
 438 (test (string-equal "" ""))
 439 ;; (test (string-equal (make-array 0 :element-type 'character)
 440 ;;            (make-array 0 :element-type 'base-char)))
 441 (test (not (string-equal "abc" "")))
 442 (test (not (string-equal "" "abc")))
 443 (test (string-equal "A" "a"))
 444 (test (string-equal "abc" "xyz" :start1 3 :start2 3))
 445 (test (string-equal "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0))
 446 (test (string-equal "axyza" "xyz" :start1 1 :end1 4))
 447 (test (string-equal "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil))
 448 (test (string-equal "abxyz" "xyabz" :end1 2 :start2 2 :end2 4))
 449 (test (not (string-equal "love" "hate")))
 450 (test (string-equal "xyz" "XYZ"))
 451 (test (not (string-equal 'love 'hate)))
 452 (test (not (string-equal 'peace 'war)))
 453 (test (string-equal 'love 'love))
 454 (test (string-equal #\a #\a))
 455 (test (not (string-equal #\a #\b)))
 456 (test (not (string-equal #\z #\a)))
 457
 458
 459 (test (not (string-not-equal "" "")))
 460 ;; (test (not (string-not-equal (make-array 0 :element-type 'character)
 461 ;;                     (make-array 0 :element-type 'base-char))))
 462 (test (eql (string-not-equal "abc" "") 0))
 463 (test (eql (string-not-equal "" "abc") 0))
 464 (test (not (string-not-equal "A" "a")))
 465 (test (not (string-not-equal "abc" "xyz" :start1 3 :start2 3)))
 466 (test (not (string-not-equal "abc" "xyz" :start1 1 :end1 1 :start2 0 :end2 0)))
 467 (test (not (string-not-equal "axyza" "xyz" :start1 1 :end1 4)))
 468 (test (not (string-not-equal "axyza" "xyz" :start1 1 :end1 4 :start2 0 :end2 nil)))
 469 (test (not (string-not-equal "abxyz" "xyabz" :end1 2 :start2 2 :end2 4)))
 470 (test (eql (string-not-equal "love" "hate") 0))
 471 (test (not (string-not-equal "love" "loVe")))
 472 (test (not (string-not-equal "life" "death" :start1 3 :start2 1 :end2 2)))
 473 (test (not (string-not-equal "abcxyz" "ABCxyZ" :start1 3 :start2 3)))
 474 (test (not (string-not-equal "abcxyz" "ABCxyZ" :start1 3 :end1 nil :start2 3 :end2 nil)))
 475 (test (eql (string-not-equal "abcxyz" "ABCxyZ" :end1 nil :start2 3 :end2 3) 0))
 476 (test (eql (string-not-equal "abc" "abcxyz") 3))
 477 (test (eql (string-not-equal "abcxyz" "abc") 3))
 478 (test (eql (string-not-equal "abcxyz" "") 0))
 479 (test (not (string-not-equal "AbcDef" "cdef" :start1 2)))
 480 (test (not (string-not-equal "cdef" "AbcDef" :start2 2)))
 481 (test (not (string-not-equal "ABC" "abc")))
 482 (test (= (string-not-equal 'love 'hate) 0))
 483 (test (= (string-not-equal 'peace 'war) 0))
 484 (test (not (string-not-equal 'love 'love)))
 485 (test (not (string-not-equal #\a #\a)))
 486 (test (= (string-not-equal #\a #\b) 0))
 487 (test (= (string-not-equal #\z #\a) 0))
 488
 489
 490 (test (not (string-lessp "" "")))
 491 (test (not (string-lessp "dog" "dog")))
 492 (test (not (string-lessp " " " ")))
 493 (test (not (string-lessp "abc" "")))
 494 (test (eql (string-lessp "" "abc") 0))
 495 (test (eql (string-lessp "ab" "abc") 2))
 496 (test (not (string-lessp "abc" "ab")))
 497 (test (eql (string-lessp "aaa" "aba") 1))
 498 (test (not (string-lessp "aba" "aaa")))
 499 (test (not (string-lessp "my cat food" "your dog food" :start1 6 :start2 8)))
 500 (test (not (string-lessp "cat food 2 dollars" "dog food 3 dollars"
 501                    :start1 3 :end1 9 :start2 3 :end2 9)))
 502 (test (eql (string-lessp "xyzabc" "abcd" :start1 3) 6))
 503 (test (eql (string-lessp "abc" "abc" :end1 1) 1))
 504 (test (eql (string-lessp "xyzabc" "abc" :start1 3 :end1 5) 5))
 505 (test (eql (string-lessp "xyz" "abcxyzXYZ" :start2 3) 3))
 506 (test (not (string-lessp "abc" "abcxyz" :end2 3)))
 507 (test (eql (string-lessp "xyz" "abcxyz" :end1 2 :start2 3) 2))
 508 (test (not (string-lessp "xyzabc" "abcdef" :start1 3 :end2 3)))
 509 (test (eql (string-lessp "aaaa" "z") 0))
 510 (test (eql (string-lessp "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
 511 (test (eql (string-lessp "pppTTTaTTTqqq" "pTTTxTTT"
 512                    :start1 6 :end1 7
 513                    :start2 4 :end2 5) 6))
 514 ;; (test (not (string-lessp (make-array 0 :element-type 'character)
 515 ;;                 (make-array 0 :element-type 'base-char))))
 516 (test (and (not (string-lessp "abc" "ABC"))
 517      (not (string-lessp "ABC" "abc"))))
 518 (test (not (string-lessp 'love 'hate)))
 519 (test (= (string-lessp 'peace 'war) 0))
 520 (test (not (string-lessp 'love 'love)))
 521 (test (not (string-lessp #\a #\a)))
 522 (test (= (string-lessp #\a #\b) 0))
 523 (test (not (string-lessp #\z #\a)))
 524
 525
 526 (test (not (string-greaterp "" "")))
 527 (test (not (string-greaterp "dog" "dog")))
 528 (test (not (string-greaterp " " " ")))
 529 (test (eql (string-greaterp "abc" "") 0))
 530 (test (not (string-greaterp "" "abc")))
 531 (test (not (string-greaterp "ab" "abc")))
 532 (test (eql (string-greaterp "abc" "ab") 2))
 533 (test (eql (string-greaterp "aba" "aaa") 1))
 534 (test (not (string-greaterp "aaa" "aba")))
 535 (test (not (string-greaterp "my cat food" "your dog food" :start1 6 :start2 8)))
 536 (test (not (string-greaterp "cat food 2 dollars" "dog food 3 dollars"
 537                       :start1 3 :end1 9 :start2 3 :end2 9)))
 538 (test (eql (string-greaterp "xyzabcde" "abcd" :start1 3) 7))
 539 (test (not (string-greaterp "abc" "abc" :end1 1)))
 540 (test (eql (string-greaterp "xyzabc" "a" :start1 3 :end1 5) 4))
 541 (test (eql (string-greaterp "xyzXYZ" "abcxyz" :start2 3) 3))
 542 (test (eql (string-greaterp "abcxyz" "abcxyz" :end2 3) 3))
 543 (test (not (string-greaterp "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
 544 (test (not (string-greaterp "xyzabc" "abcdef" :start1 3 :end2 3)))
 545 (test (eql (string-greaterp "z" "aaaa") 0))
 546 (test (eql (string-greaterp "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
 547 (test (eql (string-greaterp "pppTTTxTTTqqq" "pTTTaTTT"
 548                       :start1 6 :end1 7
 549                       :start2 4 :end2 5) 6))
 550 ;; (test (not (string-greaterp (make-array 0 :element-type 'character)
 551 ;;                    (make-array 0 :element-type 'base-char))))
 552 (test (and (not (string-greaterp "abc" "ABC"))
 553      (not (string-greaterp "ABC" "abc"))))
 554 (test (= (string-greaterp 'love 'hate) 0))
 555 (test (not (string-greaterp 'peace 'war)))
 556 (test (not (string-greaterp 'love 'love)))
 557 (test (not (string-greaterp #\a #\a)))
 558 (test (not (string-greaterp #\a #\b)))
 559 (test (= (string-greaterp #\z #\a) 0))
 560
 561
 562 (test (eql (string-not-greaterp "" "") 0))
 563 (test (eql (string-not-greaterp "dog" "dog") 3))
 564 (test (eql (string-not-greaterp " " " ") 1))
 565 (test (not (string-not-greaterp "abc" "")))
 566 (test (eql (string-not-greaterp "ab" "abc") 2))
 567 (test (eql (string-not-greaterp "aaa" "aba") 1))
 568 (test (not (string-not-greaterp "aba" "aaa")))
 569 (test (eql (string-not-greaterp "my cat food" "your dog food" :start1 6 :start2 8) 11))
 570 (test (eql (string-not-greaterp "cat food 2 dollars" "dog food 3 dollars"
 571                           :start1 3 :end1 9 :start2 3 :end2 9) 9))
 572 (test (eql (string-not-greaterp "xyzabc" "abcd" :start1 3) 6))
 573 (test (eql (string-not-greaterp "abc" "abc" :end1 1) 1))
 574 (test (eql (string-not-greaterp "xyzabc" "abc" :start1 3 :end1 5) 5))
 575 (test (eql (string-not-greaterp "xyz" "abcxyzXYZ" :start2 3) 3))
 576 (test (eql (string-not-greaterp "abc" "abcxyz" :end2 3) 3))
 577 (test (eql (string-not-greaterp "xyz" "abcxyz" :end1 2 :start2 3) 2))
 578 (test (eql (string-not-greaterp "xyzabc" "abcdef" :start1 3 :end2 3) 6))
 579 (test (eql (string-not-greaterp "aaaa" "z") 0))
 580 (test (eql (string-not-greaterp "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
 581 (test (eql (string-not-greaterp "pppTTTaTTTqqq" "pTTTxTTT"
 582                           :start1 6 :end1 7
 583                           :start2 4 :end2 5) 6))
 584 ;; (test (eql (string-not-greaterp (make-array 0 :element-type 'character)
 585 ;;                        (make-array 0 :element-type 'base-char)) 0))
 586 (test (and (eql (string-not-greaterp "abc" "ABC") 3)
 587      (eql (string-not-greaterp "ABC" "abc") 3)))
 588 (test (not (string-not-greaterp 'love 'hate)))
 589 (test (= (string-not-greaterp 'peace 'war) 0))
 590 (test (= (string-not-greaterp 'love 'love) 4))
 591 (test (= (string-not-greaterp #\a #\a) 1))
 592 (test (= (string-not-greaterp #\a #\b) 0))
 593 (test (not (string-not-greaterp #\z #\a)))
 594
 595
 596 (test (eql (string-not-lessp "" "") 0))
 597 (test (eql (string-not-lessp "dog" "dog") 3))
 598 (test (eql (string-not-lessp " " " ") 1))
 599 (test (eql (string-not-lessp "abc" "") 0))
 600 (test (not (string-not-lessp "" "abc")))
 601 (test (not (string-not-lessp "ab" "abc")))
 602 (test (eql (string-not-lessp "abc" "ab") 2))
 603 (test (eql (string-not-lessp "aba" "aaa") 1))
 604 (test (not (string-not-lessp "aaa" "aba")))
 605 (test (eql (string-not-lessp "my cat food" "your dog food" :start1 6 :start2 8) 11))
 606 (test (eql (string-not-lessp "cat food 2 dollars" "dog food 3 dollars"
 607                        :start1 3 :end1 9 :start2 3 :end2 9) 9))
 608 (test (eql (string-not-lessp "xyzabcde" "abcd" :start1 3) 7))
 609 (test (not (string-not-lessp "abc" "abc" :end1 1)))
 610 (test (eql (string-not-lessp "xyzabc" "a" :start1 3 :end1 5) 4))
 611 (test (eql (string-not-lessp "xyzXYZ" "abcxyz" :start2 3) 3))
 612 (test (eql (string-not-lessp "abcxyz" "abcxyz" :end2 3) 3))
 613 (test (not (string-not-lessp "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
 614 (test (eql (string-not-lessp "xyzabc" "abcdef" :start1 3 :end2 3) 6))
 615 (test (eql (string-not-lessp "z" "aaaa") 0))
 616 (test (eql (string-not-lessp "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
 617 (test (eql (string-not-lessp "pppTTTxTTTqqq" "pTTTaTTT"
 618                        :start1 6 :end1 7
 619                        :start2 4 :end2 5) 6))
 620 ;; (test (eql (string-not-lessp (make-array 0 :element-type 'character)
 621 ;;                     (make-array 0 :element-type 'base-char)) 0))
 622 (test (and (eql (string-not-lessp "abc" "ABC") 3)
 623      (eql (string-not-lessp "ABC" "abc") 3)))
 624 (test (= (string-not-lessp 'love 'hate) 0))
 625 (test (not (string-not-lessp 'peace 'war)))
 626 (test (= (string-not-lessp 'love 'love) 4))
 627 (test (= (string-not-lessp #\a #\a) 1))
 628 (test (not (string-not-lessp #\a #\b)))
 629 (test (= (string-not-lessp #\z #\a) 0))
 630
 631
 632
 633 (test (stringp "aaaaaa"))
 634 (test (stringp (make-array 0 :element-type 'character)))
 635 ;; (test (stringp (make-array 0 :element-type 'base-char)))
 636 ;; JSCL: an array of STANDARD-CHAR isn't a STRINGP yet, either
 637 ;; (test (stringp (make-array 0 :element-type 'standard-char)))
 638 (test (not (stringp #\a)))
 639 (test (not (stringp 'a)))
 640 (test (not (stringp '(string))))
 641
 642 (test (string= (make-string 3 :initial-element #\a) "aaa"))
 643 ;; JSCL: no SCHAR, so disabled
 644 ;; (test (let ((str (make-string 3)))
 645 ;;   (and (simple-string-p str)
 646 ;;        (setf (schar str 0) #\x)
 647 ;;        (setf (schar str 1) #\y)
 648 ;;        (setf (schar str 2) #\z)
 649 ;;        (string= str "xyz"))))
 650 ;; JSCL: #\Space isn't read correctly yet
 651 ;; (test (string= (make-string 1 :initial-element #\Space) " "))
 652 (test (string= (make-string 0) ""))
 653
 654 ;; JSCL: BUG?: this barfs inside the JS function xstring(), and i don't know why.
 655 ;; (test (subtypep (upgraded-array-element-type
 656 ;;         (array-element-type (make-string 3 :element-type 'standard-char)))
 657 ;;        'character))