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