Commit 2b9ff565 authored by pfdietz's avatar pfdietz

More specialized string, vector tests

parent 9e1306f1
......@@ -194,6 +194,17 @@
(concatenate '(array nil (*)))
"")
(deftest concatenate.33
(do-special-strings
(s "abc" nil)
(assert (string= (concatenate 'string s s s) "abcabcabc"))
(assert (string= (concatenate 'string "xy" s) "xyabc"))
(assert (string= (concatenate 'simple-string s "z" s "w" s) "abczabcwabc"))
(assert (string= (concatenate 'base-string s "z" s "w" s) "abczabcwabc"))
(assert (string= (concatenate 'simple-base-string s "z" s "w" s) "abczabcwabc"))
(assert (string= (concatenate '(vector character) s "z" s "w" s) "abczabcwabc")))
nil)
(deftest concatenate.order.1
(let ((i 0) w x y z)
(values
......
......@@ -484,6 +484,11 @@
(nil #\6)
(#\6)))
(deftest find-if-not-string.19
(do-special-strings
(s "abc1def" nil)
(assert (eql (find-if-not #'alpha-char-p s) #\1)))
nil)
;;; Keyword tests
......
......@@ -507,6 +507,12 @@
))
#\2 #\4 #\1 #\5)
(deftest find-if-string.20
(do-special-strings
(s "123a456" nil)
(assert (eql (find-if #'alpha-char-p s) #\a)))
nil)
;;; Keyword tests
(deftest find-if.allow-other-keys.1
......
......@@ -781,6 +781,12 @@
(find #\k "abcdmnop" :test-not #'char>=)
#\m)
(deftest find-string.28
(do-special-strings
(s "abcdef" nil)
(assert (char= (find #\c s :test #'char<) #\d)))
nil)
;;; Test & test not
(defharmless find-list.test-and-test-not.1
......
......@@ -319,6 +319,36 @@
(merge 'string x nil #'char<))
"adgkm")
(deftest merge-string.19
(do-special-strings
(s "ace" nil)
(assert (string= (merge 'string s (copy-seq "bdf") #'char<) "abcdef")))
nil)
(deftest merge-string.20
(do-special-strings
(s "ace" nil)
(assert (string= (merge 'base-string (copy-seq "bdf") s #'char<) "abcdef")))
nil)
(deftest merge-string.21
(do-special-strings
(s "ace" nil)
(assert (string= (merge 'simple-string s (copy-seq "bdf") #'char<) "abcdef")))
nil)
(deftest merge-string.22
(do-special-strings
(s "ace" nil)
(assert (string= (merge 'simple-base-string s (copy-seq "bdf") #'char<) "abcdef")))
nil)
(deftest merge-string.23
(do-special-strings
(s "ace" nil)
(assert (string= (merge '(vector character) s (copy-seq "bdf") #'char<) "abcdef")))
nil)
;;; Tests for bit vectors
(deftest merge-bit-vector.1
......
......@@ -244,6 +244,20 @@
result)
#(a b z c b))
(deftest nsubstitute-if-not-vector.32
(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
(v2 (make-array '(8) :displaced-to v1
:displaced-index-offset 3)))
(nsubstitute-if-not 'x (is-not-eql-p 'c) v2 :count 1))
#(d a b x d a b c))
(deftest nsubstitute-if-not-vector.33
(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
(v2 (make-array '(8) :displaced-to v1
:displaced-index-offset 3)))
(nsubstitute-if-not 'x (is-not-eql-p 'c) v2 :count 1 :from-end t))
#(d a b c d a b x))
;;; Tests on strings
(deftest nsubstitute-if-not-string.1
......@@ -381,6 +395,24 @@
result)
"abzcb")
(deftest nsubstitute-if-not-string.32
(do-special-strings
(s "xyzabcxyzabc" nil)
(assert (string= (nsubstitute-if-not #\! (is-not-eql-p #\a) s) "xyz!bcxyz!bc")))
nil)
(deftest nsubstitute-if-not-string.33
(do-special-strings
(s "xyzabcxyzabc" nil)
(assert (string= (nsubstitute-if-not #\! (is-not-eql-p #\a) s :count 1) "xyz!bcxyzabc")))
nil)
(deftest nsubstitute-if-not-string.34
(do-special-strings
(s "xyzabcxyzabc" nil)
(assert (string= (nsubstitute-if-not #\! (is-not-eql-p #\a) s :count 1 :from-end t) "xyzabcxyz!bc")))
nil)
;;; Tests on bit-vectors
......
......@@ -243,6 +243,26 @@
result)
#(a b z c b))
(deftest nsubstitute-if-vector.32
(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
(v2 (make-array '(8) :displaced-to v1
:displaced-index-offset 3)))
(values
(nsubstitute-if 'x (is-eql-p 'c) v2 :count 1)
v1))
#(d a b x d a b c)
#(a b c d a b x d a b c d a b c d))
(deftest nsubstitute-if-vector.33
(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
(v2 (make-array '(8) :displaced-to v1
:displaced-index-offset 3)))
(values
(nsubstitute-if 'x (is-eql-p 'c) v2 :count 1 :from-end t)
v1))
#(d a b c d a b x)
#(a b c d a b c d a b x d a b c d))
;;; Tests on strings
(deftest nsubstitute-if-string.1
......@@ -379,6 +399,27 @@
result)
"abzcb")
(deftest nsubstitute-if-string.32
(do-special-strings
(s "xyzabcxyzabc" nil)
(assert (string= (nsubstitute-if #\! (is-eql-p #\a) s) "xyz!bcxyz!bc"))
(assert (string= s "xyz!bcxyz!bc")))
nil)
(deftest nsubstitute-if-string.33
(do-special-strings
(s "xyzabcxyzabc" nil)
(assert (string= (nsubstitute-if #\! (is-eql-p #\a) s :count 1) "xyz!bcxyzabc"))
(assert (string= s "xyz!bcxyzabc")))
nil)
(deftest nsubstitute-if-string.34
(do-special-strings
(s "xyzabcxyzabc" nil)
(assert (string= (nsubstitute-if #\! (is-eql-p #\a) s :count 1 :from-end t) "xyzabcxyz!bc"))
(assert (string= s "xyzabcxyz!bc")))
nil)
;;; Tests on bit-vectors
......
......@@ -805,6 +805,27 @@
result)
#((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10)))
(deftest nsubstitute-vector.32
(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
(v2 (make-array '(8) :displaced-to v1
:displaced-index-offset 3)))
(values
(nsubstitute 'x 'c v2 :count 1)
v1))
#(d a b x d a b c)
#(a b c d a b x d a b c d a b c d))
(deftest nsubstitute-vector.33
(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
(v2 (make-array '(8) :displaced-to v1
:displaced-index-offset 3)))
(values
(nsubstitute 'x 'c v2 :count 1 :from-end t)
v1))
#(d a b c d a b x)
#(a b c d a b c d a b x d a b c d))
(deftest nsubstitute-string.24
(let* ((orig "0102342015")
(x (copy-seq orig))
......@@ -833,6 +854,29 @@
result)
"0a0aaaa0aa")
(deftest nsubstitute-string.32
(do-special-strings
(s "xyzabcxyzabc" nil)
(assert (string= (nsubstitute #\! #\a s) "xyz!bcxyz!bc"))
(assert (string= s "xyz!bcxyz!bc")))
nil)
(deftest nsubstitute-string.33
(do-special-strings
(s "xyzabcxyzabc" nil)
(assert (string= (nsubstitute #\! #\a s :count 1) "xyz!bcxyzabc"))
(assert (string= s "xyz!bcxyzabc")))
nil)
(deftest nsubstitute-string.34
(do-special-strings
(s "xyzabcxyzabc" nil)
(assert (string= (nsubstitute #\! #\a s :count 1 :from-end t) "xyzabcxyz!bc"))
(assert (string= s "xyzabcxyz!bc")))
nil)
;;; More bit vector tests
(deftest nsubstitute-bit-vector.30
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
:fill-pointer 5 :element-type 'bit))
......
......@@ -323,6 +323,20 @@
(remove #\a (copy-seq "bcd") :count -1)
"bcd")
(deftest remove-string.4
(do-special-strings
(s "abcdbad" nil)
(let ((s2 (remove #\b s)))
(assert (equal (array-element-type s) (array-element-type s2)))
(assert (string= s2 "acdad")))
(let ((s2 (remove #\b s :count 1)))
(assert (equal (array-element-type s) (array-element-type s2)))
(assert (string= s2 "acdbad")))
(let ((s2 (remove #\b s :count 1 :from-end t)))
(assert (equal (array-element-type s) (array-element-type s2)))
(assert (string= s2 "abcdad"))))
nil)
(deftest delete-vector.1
(delete 'a (vector 'b 'c 'd))
#(b c d))
......@@ -347,6 +361,30 @@
(delete #\a (copy-seq "bcd") :count -1)
"bcd")
(deftest delete-string.4
(do-special-strings
(s "abcdbad" nil)
(let ((s2 (delete #\b s)))
(assert (equal (array-element-type s) (array-element-type s2)))
(assert (string= s2 "acdad"))))
nil)
(deftest delete-string.5
(do-special-strings
(s "abcdbad" nil)
(let ((s2 (delete #\b s :count 1)))
(assert (equal (array-element-type s) (array-element-type s2)))
(assert (string= s2 "acdbad"))))
nil)
(deftest delete-string.6
(do-special-strings
(s "abcdbad" nil)
(let ((s2 (delete #\b s :count 1 :from-end t)))
(assert (equal (array-element-type s) (array-element-type s2)))
(assert (string= s2 "abcdad"))))
nil)
(deftest remove-bit-vector.1
(remove 0 (copy-seq #*00011101101))
#*111111)
......@@ -865,3 +903,120 @@
(deftest delete.error.10
(signals-error (delete 'a (list 'a 'b 'c) :key #'car) type-error)
t)
;;; More specialized string tests
(deftest remove-if-string.1
(do-special-strings
(s "ab1c23def4" nil)
(let ((s2 (remove-if #'alpha-char-p s)))
(assert (equal (array-element-type s)
(array-element-type s2)))
(assert (string= s2 "1234"))
(assert (string= s "ab1c23def4"))))
nil)
(deftest remove-if-string.2
(do-special-strings
(s "ab1c23def4" nil)
(let ((s2 (remove-if #'alpha-char-p s :count 3)))
(assert (equal (array-element-type s)
(array-element-type s2)))
(assert (string= s2 "123def4"))
(assert (string= s "ab1c23def4"))))
nil)
(deftest remove-if-string.3
(do-special-strings
(s "ab1c23def4" nil)
(let ((s2 (remove-if #'alpha-char-p s :count 3 :from-end t)))
(assert (equal (array-element-type s)
(array-element-type s2)))
(assert (string= s2 "ab1c234"))
(assert (string= s "ab1c23def4"))))
nil)
(deftest remove-if-not-string.1
(do-special-strings
(s "ab1c23def4" nil)
(let ((s2 (remove-if-not #'digit-char-p s)))
(assert (equal (array-element-type s)
(array-element-type s2)))
(assert (string= s2 "1234"))
(assert (string= s "ab1c23def4"))))
nil)
(deftest remove-if-not-string.2
(do-special-strings
(s "ab1c23def4" nil)
(let ((s2 (remove-if-not #'digit-char-p s :count 3)))
(assert (equal (array-element-type s)
(array-element-type s2)))
(assert (string= s2 "123def4"))
(assert (string= s "ab1c23def4"))))
nil)
(deftest remove-if-not-string.3
(do-special-strings
(s "ab1c23def4" nil)
(let ((s2 (remove-if-not #'digit-char-p s :count 3 :from-end t)))
(assert (equal (array-element-type s)
(array-element-type s2)))
(assert (string= s2 "ab1c234"))
(assert (string= s "ab1c23def4"))))
nil)
(deftest delete-if-string.1
(do-special-strings
(s "ab1c23def4" nil)
(let ((s2 (delete-if #'alpha-char-p s)))
(assert (equal (array-element-type s)
(array-element-type s2)))
(assert (string= s2 "1234"))))
nil)
(deftest delete-if-string.2
(do-special-strings
(s "ab1c23def4" nil)
(let ((s2 (delete-if #'alpha-char-p s :count 3)))
(assert (equal (array-element-type s)
(array-element-type s2)))
(assert (string= s2 "123def4"))))
nil)
(deftest delete-if-string.3
(do-special-strings
(s "ab1c23def4" nil)
(let ((s2 (delete-if #'alpha-char-p s :count 3 :from-end t)))
(assert (equal (array-element-type s)
(array-element-type s2)))
(assert (string= s2 "ab1c234"))))
nil)
(deftest delete-if-not-string.1
(do-special-strings
(s "ab1c23def4" nil)
(let ((s2 (delete-if-not #'digit-char-p s)))
(assert (equal (array-element-type s)
(array-element-type s2)))
(assert (string= s2 "1234"))))
nil)
(deftest delete-if-not-string.2
(do-special-strings
(s "ab1c23def4" nil)
(let ((s2 (delete-if-not #'digit-char-p s :count 3)))
(assert (equal (array-element-type s)
(array-element-type s2)))
(assert (string= s2 "123def4"))))
nil)
(deftest delete-if-not-string.3
(do-special-strings
(s "ab1c23def4" nil)
(let ((s2 (delete-if-not #'digit-char-p s :count 3 :from-end t)))
(assert (equal (array-element-type s)
(array-element-type s2)))
(assert (string= s2 "ab1c234"))))
nil)
......@@ -586,6 +586,45 @@
t
"aabcef")
(deftest replace-string.22
(do-special-strings
(s "abcdefg" nil)
(assert (eq s (replace s "XYZ")))
(assert (string= s "XYZdefg")))
nil)
(deftest replace-string.23
(do-special-strings
(s "abcdefg" nil)
(assert (eq s (replace s "XYZ" :start1 1)))
(assert (string= s "aXYZefg")))
nil)
(deftest replace-string.24
(do-special-strings
(s "abcdefg" nil)
(assert (eq s (replace s "XYZ" :start1 1 :end2 2)))
(assert (string= s "aXYdefg")))
nil)
(deftest replace-string.25
(do-special-strings
(s "abcdefg" nil)
(assert (eq s (replace s "XYZ" :end1 2)))
(assert (string= s "XYcdefg")))
nil)
(deftest replace-string.26
(do-special-strings
(s "abcdefg" nil)
(assert (eq s (replace s "XYZ" :start2 1)))
(assert (string= s "YZcdefg")))
nil)
;;; Order of evaluation tests
(deftest replace.order.1
......
......@@ -276,6 +276,27 @@
result)
#(a b z c b))
(deftest substitute-if-not-vector.32
(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
(v2 (make-array '(8) :displaced-to v1
:displaced-index-offset 3)))
(values
(substitute-if-not 'x (is-not-eql-p 'c) v2 :count 1)
v1))
#(d a b x d a b c)
#(a b c d a b c d a b c d a b c d))
(deftest substitute-if-not-vector.33
(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
(v2 (make-array '(8) :displaced-to v1
:displaced-index-offset 3)))
(values
(substitute-if-not 'x (is-not-eql-p 'c) v2 :count 1 :from-end t)
v1))
#(d a b c d a b x)
#(a b c d a b c d a b c d a b c d))
;;; Tests on strings
......@@ -667,6 +688,15 @@
result))
"01a2342015")
(deftest substitute-if-not-string.26
(do-special-strings
(s "xyzabcxyzabc" nil)
(assert (string= (substitute-if-not #\! (is-not-eql-p #\a) s) "xyz!bcxyz!bc"))
(assert (string= (substitute-if-not #\! (is-not-eql-p #\a) s :count 1) "xyz!bcxyzabc"))
(assert (string= (substitute-if-not #\! (is-not-eql-p #\a) s :count 1 :from-end t) "xyzabcxyz!bc"))
(assert (string= s "xyzabcxyzabc")))
nil)
(deftest substitute-if-not-bitstring.26
(let* ((orig #*00111001011010110)
(x (copy-seq orig))
......
......@@ -292,6 +292,26 @@
result)
#(a b z c b))
(deftest substitute-if-vector.32
(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
(v2 (make-array '(8) :displaced-to v1
:displaced-index-offset 3)))
(values
(substitute-if 'x (is-eql-p 'c) v2 :count 1)
v1))
#(d a b x d a b c)
#(a b c d a b c d a b c d a b c d))
(deftest substitute-if-vector.33
(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
(v2 (make-array '(8) :displaced-to v1
:displaced-index-offset 3)))
(values
(substitute-if 'x (is-eql-p 'c) v2 :count 1 :from-end t)
v1))
#(d a b c d a b x)
#(a b c d a b c d a b c d a b c d))
;;; Tests on strings
(deftest substitute-if-string.1
......@@ -691,7 +711,18 @@
result))
"01a2342015")
(deftest substitute-if-bit-vector.26
(deftest substitute-if-string.26
(do-special-strings
(s "xyzabcxyzabc" nil)
(assert (string= (substitute-if #\! (is-eql-p #\a) s) "xyz!bcxyz!bc"))
(assert (string= (substitute-if #\! (is-eql-p #\a) s :count 1) "xyz!bcxyzabc"))
(assert (string= (substitute-if #\! (is-eql-p #\a) s :count 1 :from-end t) "xyzabcxyz!bc"))
(assert (string= s "xyzabcxyzabc")))
nil)
;;; More bit vector tests
(deftest substitute-if-bit-vector.22
(let* ((orig #*00111001011010110)
(x (copy-seq orig))
(result (substitute-if 1 (is-eql-p 1) x :key #'1+)))
......@@ -699,7 +730,7 @@
result))
#*11111111111111111)
(deftest substitute-if-bit-vector.27
(deftest substitute-if-bit-vector.23
(let* ((orig #*00111001011010110)
(x (copy-seq orig))
(result (substitute-if 1 (is-eql-p 1) x :key #'1+ :start 1 :end 10)))
......@@ -707,34 +738,36 @@
result))
#*01111111111010110)
(deftest substitute-if-bit-vector.30
(deftest substitute-if-bit-vector.24
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
:fill-pointer 5 :element-type 'bit))
(result (substitute-if 1 #'zerop x)))
result)
#*11111)
(deftest substitute-if-bit-vector.31
(deftest substitute-if-bit-vector.25
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
:fill-pointer 5 :element-type 'bit))
(result (substitute-if 1 #'zerop x :from-end t)))
result)
#*11111)
(deftest substitute-if-bit-vector.32
(deftest substitute-if-bit-vector.26
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
:fill-pointer 5 :element-type 'bit))
(result (substitute-if 1 #'zerop x :count 1)))
result)
#*11011)
(deftest substitute-if-bit-vector.33
(deftest substitute-if-bit-vector.27
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
:fill-pointer 5 :element-type 'bit))
(result (substitute-if 1 #'zerop x :from-end t :count 1)))
result)
#*01111)
;;; Order of evaluation tests
(deftest substitute-if.order.1
(let ((i 0) a b c d e f g h)
(values
......
......@@ -435,6 +435,26 @@
result)
#(a b z c b))
(deftest substitute-vector.32
(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
(v2 (make-array '(8) :displaced-to v1
:displaced-index-offset 3)))
(values
(substitute 'x 'c v2 :count 1)
v1))
#(d a b x d a b c)
#(a b c d a b c d a b c d a b c d))
(deftest substitute-vector.33
(let* ((v1 (copy-seq #(a b c d a b c d a b c d a b c d)))
(v2 (make-array '(8) :displaced-to v1
:displaced-index-offset 3)))
(values
(substitute 'x 'c v2 :count 1 :from-end t)
v1))
#(d a b c d a b x)
#(a b c d a b c d a b c d a b c d))
;;; Tests on strings
(deftest substitute-string.1
......@@ -682,6 +702,15 @@
result)
"abzcb")
(deftest substitute-string.32
(do-special-strings
(s "xyzabcxyzabc" nil)
(assert (string= (substitute #\! #\a s) "xyz!bcxyz!bc"))
(assert (string= (substitute #\! #\a s :count 1) "xyz!bcxyzabc"))
(assert (string= (substitute #\! #\a s :count 1 :from-end t) "xyzabcxyz!bc"))
(assert (string= s "xyzabcxyzabc")))
nil)
;;; Tests on bit-vectors
(deftest substitute-bit-vector.1
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment