Commit 6386f0cd authored by pfdietz's avatar pfdietz
Browse files

Finished covering the sequence functions on arrays with fill pointers.

parent 9d8f07d1
...@@ -113,6 +113,77 @@ ...@@ -113,6 +113,77 @@
(concatenate 'null nil nil) (concatenate 'null nil nil)
nil) nil)
;;; Tests on vectors with fill pointers
(deftest concatenate.25
(let ((x (make-array '(10) :initial-contents '(a b c d e f g h i j)
:fill-pointer 5)))
(concatenate 'list x x))
(a b c d e a b c d e))
(deftest concatenate.26
(let ((x (make-array '(10) :initial-contents '(a b c d e f g h i j)
:fill-pointer 5)))
(concatenate 'list x))
(a b c d e))
(deftest concatenate.27
(let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j)
:fill-pointer 5))
(result (concatenate 'vector x)))
(values (not (simple-vector-p result))
result))
nil
#(a b c d e))
(deftest concatenate.28
(let* ((x (make-array '(10) :initial-contents (coerce "abcdefghij" 'list)
:fill-pointer 5 :element-type 'character)))
(values
(concatenate 'string x '(#\z))
(concatenate 'string '(#\z) x)
(concatenate 'string x x)
(concatenate 'string x)
(not (simple-string-p (concatenate 'string x)))
))
"abcdez"
"zabcde"
"abcdeabcde"
"abcde"
nil)
(deftest concatenate.29
(let* ((x (make-array '(10) :initial-contents (coerce "abcdefghij" 'list)
:fill-pointer 5 :element-type 'base-char)))
(values
(concatenate 'string x '(#\z))
(concatenate 'string '(#\z) x)
(concatenate 'string x x)
(concatenate 'string x)
(not (simple-string-p (concatenate 'string x)))
))
"abcdez"
"zabcde"
"abcdeabcde"
"abcde"
nil)
(deftest concatenate.30
(let* ((x (make-array '(10) :initial-contents (coerce #*0110010111 'list)
:fill-pointer 5 :element-type 'bit)))
(values
(concatenate 'bit-vector x '(0))
(concatenate 'bit-vector '(0) x)
(concatenate 'bit-vector x x)
(concatenate 'bit-vector x)
(not (simple-bit-vector-p (concatenate 'bit-vector x)))
))
#*011000
#*001100
#*0110001100
#*01100
nil)
;;; Error tests ;;; Error tests
(deftest concatenate-error.1 (deftest concatenate-error.1
......
...@@ -74,7 +74,7 @@ ...@@ -74,7 +74,7 @@
(1 2 3)) (1 2 3))
(deftest merge-list.13 (deftest merge-list.13
(let ((x #()) (y (list 1 2 3))) (let ((x (vector)) (y (list 1 2 3)))
(merge 'list x y #'<)) (merge 'list x y #'<))
(1 2 3)) (1 2 3))
...@@ -84,7 +84,7 @@ ...@@ -84,7 +84,7 @@
(1 2 3)) (1 2 3))
(deftest merge-list.15 (deftest merge-list.15
(let ((x #()) (y (list 1 2 3))) (let ((x (vector)) (y (list 1 2 3)))
(merge 'list y x #'<)) (merge 'list y x #'<))
(1 2 3)) (1 2 3))
...@@ -159,7 +159,7 @@ ...@@ -159,7 +159,7 @@
#(1 2 3)) #(1 2 3))
(deftest merge-vector.13 (deftest merge-vector.13
(let ((x #()) (y (list 1 2 3))) (let ((x (vector)) (y (list 1 2 3)))
(merge 'vector x y #'<)) (merge 'vector x y #'<))
#(1 2 3)) #(1 2 3))
...@@ -169,10 +169,34 @@ ...@@ -169,10 +169,34 @@
#(1 2 3)) #(1 2 3))
(deftest merge-vector.15 (deftest merge-vector.15
(let ((x #()) (y (list 1 2 3))) (let ((x (vector)) (y (list 1 2 3)))
(merge 'vector y x #'<)) (merge 'vector y x #'<))
#(1 2 3)) #(1 2 3))
(deftest merge-vector.16
(let ((x (make-array '(10) :initial-contents '(2 5 8 9 11 12 14 15 18 30)
:fill-pointer 5))
(y (list 1 6 10)))
(merge 'vector x y #'<))
#(1 2 5 6 8 9 10 11))
(deftest merge-vector.16a
(let ((x (make-array '(10) :initial-contents '(2 5 8 9 11 12 14 15 18 30)
:fill-pointer 5))
(y (list 1 6 10)))
(merge 'vector y x #'<))
#(1 2 5 6 8 9 10 11))
(deftest merge-vector.17
(let* ((x (make-array '(10) :initial-contents '(2 5 8 9 11 12 14 15 18 30)
:fill-pointer 5))
(result (merge 'vector x () #'<)))
(values
(array-element-type result)
result))
t
#(2 5 8 9 11))
;;; Tests on strings ;;; Tests on strings
(deftest merge-string.1 (deftest merge-string.1
...@@ -250,12 +274,12 @@ ...@@ -250,12 +274,12 @@
"123") "123")
(deftest merge-string.13 (deftest merge-string.13
(let ((x #()) (y (list #\1 #\2 #\3))) (let ((x (vector)) (y (list #\1 #\2 #\3)))
(merge 'string x y #'char<)) (merge 'string x y #'char<))
"123") "123")
(deftest merge-string.13a (deftest merge-string.13a
(let ((x "") (y (list #\1 #\2 #\3))) (let ((x (copy-seq "")) (y (list #\1 #\2 #\3)))
(merge 'string x y #'char<)) (merge 'string x y #'char<))
"123") "123")
...@@ -265,125 +289,178 @@ ...@@ -265,125 +289,178 @@
"123") "123")
(deftest merge-string.14a (deftest merge-string.14a
(let ((x "") (y (vector #\1 #\2 #\3))) (let ((x (copy-seq "")) (y (vector #\1 #\2 #\3)))
(merge 'string y x #'char<)) (merge 'string y x #'char<))
"123") "123")
(deftest merge-string.15
(let* ((x (make-array '(10) :initial-contents (coerce "adgkmpruwv" 'list)
:fill-pointer 5 :element-type 'character))
(y (copy-seq "bci")))
(merge 'string x y #'char<))
"abcdgikm")
(deftest merge-string.16
(let* ((x (make-array '(10) :initial-contents (coerce "adgkmpruwv" 'list)
:fill-pointer 5 :element-type 'character))
(y (copy-seq "bci")))
(merge 'string y x #'char<))
"abcdgikm")
(deftest merge-string.17
(let* ((x (make-array '(10) :initial-contents (coerce "adgkmpruwv" 'list)
:fill-pointer 5 :element-type 'character)))
(merge 'string nil x #'char<))
"adgkm")
(deftest merge-string.18
(let* ((x (make-array '(10) :initial-contents (coerce "adgkmpruwv" 'list)
:fill-pointer 5 :element-type 'character)))
(merge 'string x nil #'char<))
"adgkm")
;;; Tests for bit vectors ;;; Tests for bit vectors
(deftest merge-bitvector.1 (deftest merge-bit-vector.1
(let ((x (list 0 0 1 1 1)) (let ((x (list 0 0 1 1 1))
(y (list 0 0 0 1 1))) (y (list 0 0 0 1 1)))
(merge 'bit-vector x y #'<)) (merge 'bit-vector x y #'<))
#*0000011111) #*0000011111)
(deftest merge-bitvector.2 (deftest merge-bit-vector.2
(let ((x nil) (let ((x nil)
(y (list 0 0 0 1 1))) (y (list 0 0 0 1 1)))
(merge 'bit-vector x y #'<)) (merge 'bit-vector x y #'<))
#*00011) #*00011)
(deftest merge-bitvector.3 (deftest merge-bit-vector.3
(let ((x nil) (let ((x nil)
(y (list 0 0 0 1 1))) (y (list 0 0 0 1 1)))
(merge 'bit-vector y x #'<)) (merge 'bit-vector y x #'<))
#*00011) #*00011)
(deftest merge-bitvector.4 (deftest merge-bit-vector.4
(merge 'bit-vector nil nil #'<) (merge 'bit-vector nil nil #'<)
#*) #*)
(deftest merge-bitvector.5 (deftest merge-bit-vector.5
(let ((x (vector 0 0 1 1 1)) (let ((x (vector 0 0 1 1 1))
(y (list 0 0 0 1 1))) (y (list 0 0 0 1 1)))
(merge 'bit-vector x y #'<)) (merge 'bit-vector x y #'<))
#*0000011111) #*0000011111)
(deftest merge-bitvector.5a (deftest merge-bit-vector.5a
(let ((x (copy-seq #*00111)) (let ((x (copy-seq #*00111))
(y (list 0 0 0 1 1))) (y (list 0 0 0 1 1)))
(merge 'bit-vector x y #'<)) (merge 'bit-vector x y #'<))
#*0000011111) #*0000011111)
(deftest merge-bitvector.5b (deftest merge-bit-vector.5b
(let ((x (list 0 0 1 1 1)) (let ((x (list 0 0 1 1 1))
(y (copy-seq #*00011))) (y (copy-seq #*00011)))
(merge 'bit-vector x y #'<)) (merge 'bit-vector x y #'<))
#*0000011111) #*0000011111)
(deftest merge-bitvector.5c (deftest merge-bit-vector.5c
(let ((x (copy-seq #*00111)) (let ((x (copy-seq #*00111))
(y (copy-seq #*00011))) (y (copy-seq #*00011)))
(merge 'bit-vector x y #'<)) (merge 'bit-vector x y #'<))
#*0000011111) #*0000011111)
(deftest merge-bitvector.5d (deftest merge-bit-vector.5d
(let ((x (copy-seq #*11111)) (let ((x (copy-seq #*11111))
(y (copy-seq #*00000))) (y (copy-seq #*00000)))
(merge 'bit-vector x y #'<)) (merge 'bit-vector x y #'<))
#*0000011111) #*0000011111)
(deftest merge-bitvector.5e (deftest merge-bit-vector.5e
(let ((x (copy-seq #*11111)) (let ((x (copy-seq #*11111))
(y (copy-seq #*00000))) (y (copy-seq #*00000)))
(merge 'bit-vector y x #'<)) (merge 'bit-vector y x #'<))
#*0000011111) #*0000011111)
(deftest merge-bitvector.6 (deftest merge-bit-vector.6
(let ((x (list 0 0 1 1 1)) (let ((x (list 0 0 1 1 1))
(y (vector 0 0 0 1 1))) (y (vector 0 0 0 1 1)))
(merge 'bit-vector x y #'<)) (merge 'bit-vector x y #'<))
#*0000011111) #*0000011111)
(deftest merge-bitvector.7 (deftest merge-bit-vector.7
(let ((x (vector 0 0 1 1 1)) (let ((x (vector 0 0 1 1 1))
(y (vector 0 0 0 1 1))) (y (vector 0 0 0 1 1)))
(merge 'bit-vector x y #'<)) (merge 'bit-vector x y #'<))
#*0000011111) #*0000011111)
(deftest merge-bitvector.8 (deftest merge-bit-vector.8
(let ((x (list 1 1 1 0 0)) (let ((x (list 1 1 1 0 0))
(y (list 1 1 0 0 0))) (y (list 1 1 0 0 0)))
(merge 'bit-vector x y #'< :key #'-)) (merge 'bit-vector x y #'< :key #'-))
#*1111100000) #*1111100000)
(deftest merge-bitvector.9 (deftest merge-bit-vector.9
(let ((x (list 0 0 1 1 1)) (let ((x (list 0 0 1 1 1))
(y (list 0 0 0 1 1))) (y (list 0 0 0 1 1)))
(merge 'bit-vector x y #'< :key nil)) (merge 'bit-vector x y #'< :key nil))
#*0000011111) #*0000011111)
(deftest merge-bitvector.10 (deftest merge-bit-vector.10
(let ((x (list 0 0 1 1 1)) (let ((x (list 0 0 1 1 1))
(y (list 0 0 0 1 1))) (y (list 0 0 0 1 1)))
(merge 'bit-vector x y '<)) (merge 'bit-vector x y '<))
#*0000011111) #*0000011111)
(deftest merge-bitvector.11 (deftest merge-bit-vector.11
(let ((x (copy-seq #*)) (y (copy-seq #*))) (let ((x (copy-seq #*)) (y (copy-seq #*)))
(merge 'bit-vector x y #'<)) (merge 'bit-vector x y #'<))
#*) #*)
(deftest merge-bitvector.12 (deftest merge-bit-vector.12
(let ((x (copy-seq #*)) (y (copy-seq #*011))) (let ((x (copy-seq #*)) (y (copy-seq #*011)))
(merge 'bit-vector x y #'<)) (merge 'bit-vector x y #'<))
#*011) #*011)
(deftest merge-bitvector.13 (deftest merge-bit-vector.13
(let ((x (copy-seq #*)) (y (list 0 1 1))) (let ((x (copy-seq #*)) (y (list 0 1 1)))
(merge 'bit-vector x y #'<)) (merge 'bit-vector x y #'<))
#*011) #*011)
(deftest merge-bitvector.14 (deftest merge-bit-vector.14
(let ((x nil) (y (vector 0 1 1))) (let ((x nil) (y (vector 0 1 1)))
(merge 'bit-vector y x #'<)) (merge 'bit-vector y x #'<))
#*011) #*011)
(deftest merge-bitvector.15 (deftest merge-bit-vector.15
(let ((x (copy-seq #*)) (y (list 0 1 1))) (let ((x (copy-seq #*)) (y (list 0 1 1)))
(merge 'bit-vector y x #'<)) (merge 'bit-vector y x #'<))
#*011) #*011)
(deftest merge-bit-vector.16
(let* ((x (make-array '(10) :initial-contents (coerce #*0001101010 'list)
:fill-pointer 5 :element-type 'bit))
(y (copy-seq #*001)))
(merge 'bit-vector x y #'<))
#*00000111)
(deftest merge-bit-vector.17
(let* ((x (make-array '(10) :initial-contents (coerce #*0001101010 'list)
:fill-pointer 5 :element-type 'bit))
(y (copy-seq #*001)))
(merge 'bit-vector y x #'<))
#*00000111)
(deftest merge-bit-vector.18
(let* ((x (make-array '(10) :initial-contents (coerce #*0001101010 'list)
:fill-pointer 5 :element-type 'bit)))
(merge 'bit-vector nil x #'<))
#*00011)
(deftest merge-bit-vector.19
(let* ((x (make-array '(10) :initial-contents (coerce #*0001101010 'list)
:fill-pointer 5 :element-type 'bit)))
(merge 'bit-vector x nil #'<))
#*00011)
;;; Cons (which is a recognizable subtype of list) ;;; Cons (which is a recognizable subtype of list)
(deftest merge-cons.1 (deftest merge-cons.1
......
...@@ -215,6 +215,35 @@ ...@@ -215,6 +215,35 @@
(make-array (- 10 j) :initial-element 'a))))))) (make-array (- 10 j) :initial-element 'a)))))))
t) t)
(deftest nsubstitute-if-not-vector.28
(let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
:fill-pointer 5))
(result (nsubstitute-if-not 'z (is-not-eql-p 'a) x)))
result)
#(z b z c b))
(deftest nsubstitute-if-not-vector.29
(let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
:fill-pointer 5))
(result (nsubstitute-if-not 'z (is-not-eql-p 'a) x :from-end t)))
result)
#(z b z c b))
(deftest nsubstitute-if-not-vector.30
(let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
:fill-pointer 5))
(result (nsubstitute-if-not 'z (is-not-eql-p 'a) x :count 1)))
result)
#(z b a c b))
(deftest nsubstitute-if-not-vector.31
(let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f)
:fill-pointer 5))
(result (nsubstitute-if-not 'z (is-not-eql-p 'a) x
:from-end t :count 1)))
result)
#(a b z c b))
;;; Tests on strings ;;; Tests on strings
(deftest nsubstitute-if-not-string.1 (deftest nsubstitute-if-not-string.1
...@@ -323,142 +352,172 @@ ...@@ -323,142 +352,172 @@
(make-array (- 10 j) :initial-element #\a))))))) (make-array (- 10 j) :initial-element #\a)))))))
t) t)
;;; Tests on bitstrings (deftest nsubstitute-if-not-string.28
(let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list)
:fill-pointer 5 :element-type 'character))
(result (nsubstitute-if-not #\z (is-not-eql-p #\a) x)))
result)
"zbzcb")
(deftest nsubstitute-if-not-string.29
(let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list)
:fill-pointer 5 :element-type 'character))
(result (nsubstitute-if-not #\z (is-not-eql-p #\a) x :from-end t)))
result)
"zbzcb")
(deftest nsubstitute-if-not-string.30
(let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list)
:fill-pointer 5 :element-type 'character))
(result (nsubstitute-if-not #\z (is-not-eql-p #\a) x :count 1)))
result)
"zbacb")
(deftest nsubstitute-if-not-bitstring.1 (deftest nsubstitute-if-not-string.31
(let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list)
:fill-pointer 5 :element-type 'character))
(result (nsubstitute-if-not #\z (is-not-eql-p #\a) x
:from-end t :count 1)))
result)
"abzcb")
;;; Tests on bit-vectors
(deftest nsubstitute-if-not-bit-vector.1
(let* ((orig #*) (let* ((orig #*)
(x (copy-seq orig)) (x (copy-seq orig))
(result (nsubstitute-if-not 0 (is-not-eq-p 1) x))) (result (nsubstitute-if-not 0 (is-not-eq-p 1) x)))
result) result)
#*) #*)
(deftest nsubstitute-if-not-bitstring.2 (deftest nsubstitute-if-not-bit-vector.2
(let* ((orig #*) (let* ((orig #*)
(x (copy-seq orig)) (x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x))) (result (nsubstitute-if-not 1 (is-not-eq-p 0) x)))
result) result)
#*) #*)
(deftest nsubstitute-if-not-bitstring.3 (deftest nsubstitute-if-not-bit-vector.3
(let* ((orig #*010101) (let* ((orig #*010101)
(x (copy-seq orig)) (x (copy-seq orig))
(result (nsubstitute-if-not 0 (is-not-eq-p 1) x))) (result (nsubstitute-if-not 0 (is-not-eq-p 1) x)))
result) result)
#*000000) #*000000)
(deftest nsubstitute-if-not-bitstring.4 (deftest nsubstitute-if-not-bit-vector.4
(let* ((orig #*010101) (let* ((orig #*010101)
(x (copy-seq orig)) (x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x))) (result (nsubstitute-if-not 1 (is-not-eq-p 0) x)))
result) result)
#*111111) #*111111)
(deftest nsubstitute-if-not-bitstring.5 (deftest nsubstitute-if-not-bit-vector.5
(let* ((orig #*010101) (let* ((orig #*010101)
(x (copy-seq orig)) (x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x :start 1))) (result (nsubstitute-if-not 1 (is-not-eq-p 0) x :start 1)))
result) result)
#*011111) #*011111)
(deftest nsubstitute-if-not-bitstring.6 (deftest nsubstitute-if-not-bit-vector.6
(let* ((orig #*010101) (let* ((orig #*010101)
(x (copy-seq orig)) (x (copy-seq orig))
(result (nsubstitute-if-not 0 (is-not-eq-p 1) x :start 2 :end nil))) (result (nsubstitute-if-not 0 (is-not-eq-p 1) x :start 2 :end nil)))
result) result)
#*010000) #*010000)
(deftest nsubstitute-if-not-bitstring.7 (deftest nsubstitute-if-not-bit-vector.7
(let* ((orig #*010101) (let* ((orig #*010101)
(x (copy-seq orig)) (x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x :end 4))) (result (nsubstitute-if-not 1 (is-not-eq-p 0) x :end 4)))
result) result)
#*111101) #*111101)
(deftest nsubstitute-if-not-bitstring.8 (deftest nsubstitute-if-not-bit-vector.8
(let* ((orig #*010101) (let* ((orig #*010101)
(x (copy-seq orig)) (x (copy-seq orig))
(result (nsubstitute-if-not 0 (is-not-eq-p 1) x :end nil))) (result (nsubstitute-if-not 0 (is-not-eq-p 1) x :end nil)))
result) result)
#*000000) #*000000)
(deftest nsubstitute-if-not-bitstring.9 (deftest nsubstitute-if-not-bit-vector.9
(let* ((orig #*010101) (let* ((orig #*010101)
(x (copy-seq orig)) (x (copy-seq orig))
(result (nsubstitute-if-not 0 (is-not-eq-p 1) x :end 3))) (result (nsubstitute-if-not 0 (is-not-eq-p 1) x :end 3)))
result) result)
#*000101) #*000101)
(deftest nsubstitute-if-not-bitstring.10