Merge branch 'hashtables'
[jscl.git] / 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))