Commit 6386f0cd authored by pfdietz's avatar pfdietz

Finished covering the sequence functions on arrays with fill pointers.

parent 9d8f07d1
......@@ -113,6 +113,77 @@
(concatenate 'null 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
(deftest concatenate-error.1
......
......@@ -74,7 +74,7 @@
(1 2 3))
(deftest merge-list.13
(let ((x #()) (y (list 1 2 3)))
(let ((x (vector)) (y (list 1 2 3)))
(merge 'list x y #'<))
(1 2 3))
......@@ -84,7 +84,7 @@
(1 2 3))
(deftest merge-list.15
(let ((x #()) (y (list 1 2 3)))
(let ((x (vector)) (y (list 1 2 3)))
(merge 'list y x #'<))
(1 2 3))
......@@ -159,7 +159,7 @@
#(1 2 3))
(deftest merge-vector.13
(let ((x #()) (y (list 1 2 3)))
(let ((x (vector)) (y (list 1 2 3)))
(merge 'vector x y #'<))
#(1 2 3))
......@@ -169,10 +169,34 @@
#(1 2 3))
(deftest merge-vector.15
(let ((x #()) (y (list 1 2 3)))
(let ((x (vector)) (y (list 1 2 3)))
(merge 'vector y x #'<))
#(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
(deftest merge-string.1
......@@ -250,12 +274,12 @@
"123")
(deftest merge-string.13
(let ((x #()) (y (list #\1 #\2 #\3)))
(let ((x (vector)) (y (list #\1 #\2 #\3)))
(merge 'string x y #'char<))
"123")
(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<))
"123")
......@@ -265,125 +289,178 @@
"123")
(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<))
"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
(deftest merge-bitvector.1
(deftest merge-bit-vector.1
(let ((x (list 0 0 1 1 1))
(y (list 0 0 0 1 1)))
(merge 'bit-vector x y #'<))
#*0000011111)
(deftest merge-bitvector.2
(deftest merge-bit-vector.2
(let ((x nil)
(y (list 0 0 0 1 1)))
(merge 'bit-vector x y #'<))
#*00011)
(deftest merge-bitvector.3
(deftest merge-bit-vector.3
(let ((x nil)
(y (list 0 0 0 1 1)))
(merge 'bit-vector y x #'<))
#*00011)
(deftest merge-bitvector.4
(deftest merge-bit-vector.4
(merge 'bit-vector nil nil #'<)
#*)
(deftest merge-bitvector.5
(deftest merge-bit-vector.5
(let ((x (vector 0 0 1 1 1))
(y (list 0 0 0 1 1)))
(merge 'bit-vector x y #'<))
#*0000011111)
(deftest merge-bitvector.5a
(deftest merge-bit-vector.5a
(let ((x (copy-seq #*00111))
(y (list 0 0 0 1 1)))
(merge 'bit-vector x y #'<))
#*0000011111)
(deftest merge-bitvector.5b
(deftest merge-bit-vector.5b
(let ((x (list 0 0 1 1 1))
(y (copy-seq #*00011)))
(merge 'bit-vector x y #'<))
#*0000011111)
(deftest merge-bitvector.5c
(deftest merge-bit-vector.5c
(let ((x (copy-seq #*00111))
(y (copy-seq #*00011)))
(merge 'bit-vector x y #'<))
#*0000011111)
(deftest merge-bitvector.5d
(deftest merge-bit-vector.5d
(let ((x (copy-seq #*11111))
(y (copy-seq #*00000)))
(merge 'bit-vector x y #'<))
#*0000011111)
(deftest merge-bitvector.5e
(deftest merge-bit-vector.5e
(let ((x (copy-seq #*11111))
(y (copy-seq #*00000)))
(merge 'bit-vector y x #'<))
#*0000011111)
(deftest merge-bitvector.6
(deftest merge-bit-vector.6
(let ((x (list 0 0 1 1 1))
(y (vector 0 0 0 1 1)))
(merge 'bit-vector x y #'<))
#*0000011111)
(deftest merge-bitvector.7
(deftest merge-bit-vector.7
(let ((x (vector 0 0 1 1 1))
(y (vector 0 0 0 1 1)))
(merge 'bit-vector x y #'<))
#*0000011111)
(deftest merge-bitvector.8
(deftest merge-bit-vector.8
(let ((x (list 1 1 1 0 0))
(y (list 1 1 0 0 0)))
(merge 'bit-vector x y #'< :key #'-))
#*1111100000)
(deftest merge-bitvector.9
(deftest merge-bit-vector.9
(let ((x (list 0 0 1 1 1))
(y (list 0 0 0 1 1)))
(merge 'bit-vector x y #'< :key nil))
#*0000011111)
(deftest merge-bitvector.10
(deftest merge-bit-vector.10
(let ((x (list 0 0 1 1 1))
(y (list 0 0 0 1 1)))
(merge 'bit-vector x y '<))
#*0000011111)
(deftest merge-bitvector.11
(deftest merge-bit-vector.11
(let ((x (copy-seq #*)) (y (copy-seq #*)))
(merge 'bit-vector x y #'<))
#*)
(deftest merge-bitvector.12
(deftest merge-bit-vector.12
(let ((x (copy-seq #*)) (y (copy-seq #*011)))
(merge 'bit-vector x y #'<))
#*011)
(deftest merge-bitvector.13
(deftest merge-bit-vector.13
(let ((x (copy-seq #*)) (y (list 0 1 1)))
(merge 'bit-vector x y #'<))
#*011)
(deftest merge-bitvector.14
(deftest merge-bit-vector.14
(let ((x nil) (y (vector 0 1 1)))
(merge 'bit-vector y x #'<))
#*011)
(deftest merge-bitvector.15
(deftest merge-bit-vector.15
(let ((x (copy-seq #*)) (y (list 0 1 1)))
(merge 'bit-vector y x #'<))
#*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)
(deftest merge-cons.1
......
......@@ -215,6 +215,35 @@
(make-array (- 10 j) :initial-element 'a)))))))
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
(deftest nsubstitute-if-not-string.1
......@@ -323,142 +352,172 @@
(make-array (- 10 j) :initial-element #\a)))))))
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 #*)
(x (copy-seq orig))
(result (nsubstitute-if-not 0 (is-not-eq-p 1) x)))
result)
#*)
(deftest nsubstitute-if-not-bitstring.2
(deftest nsubstitute-if-not-bit-vector.2
(let* ((orig #*)
(x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x)))
result)
#*)
(deftest nsubstitute-if-not-bitstring.3
(deftest nsubstitute-if-not-bit-vector.3
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 0 (is-not-eq-p 1) x)))
result)
#*000000)
(deftest nsubstitute-if-not-bitstring.4
(deftest nsubstitute-if-not-bit-vector.4
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x)))
result)
#*111111)
(deftest nsubstitute-if-not-bitstring.5
(deftest nsubstitute-if-not-bit-vector.5
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x :start 1)))
result)
#*011111)
(deftest nsubstitute-if-not-bitstring.6
(deftest nsubstitute-if-not-bit-vector.6
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 0 (is-not-eq-p 1) x :start 2 :end nil)))
result)
#*010000)
(deftest nsubstitute-if-not-bitstring.7
(deftest nsubstitute-if-not-bit-vector.7
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x :end 4)))
result)
#*111101)
(deftest nsubstitute-if-not-bitstring.8
(deftest nsubstitute-if-not-bit-vector.8
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 0 (is-not-eq-p 1) x :end nil)))
result)
#*000000)
(deftest nsubstitute-if-not-bitstring.9
(deftest nsubstitute-if-not-bit-vector.9
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 0 (is-not-eq-p 1) x :end 3)))
result)
#*000101)
(deftest nsubstitute-if-not-bitstring.10
(deftest nsubstitute-if-not-bit-vector.10
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 0 (is-not-eq-p 1) x :start 2 :end 4)))
result)
#*010001)
(deftest nsubstitute-if-not-bitstring.11
(deftest nsubstitute-if-not-bit-vector.11
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x :start 2 :end 4)))
result)
#*011101)
(deftest nsubstitute-if-not-bitstring.12
(deftest nsubstitute-if-not-bit-vector.12
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count 1)))
result)
#*110101)
(deftest nsubstitute-if-not-bitstring.13
(deftest nsubstitute-if-not-bit-vector.13
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count 0)))
result)
#*010101)
(deftest nsubstitute-if-not-bitstring.14
(deftest nsubstitute-if-not-bit-vector.14
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count -1)))
result)
#*010101)
(deftest nsubstitute-if-not-bitstring.15
(deftest nsubstitute-if-not-bit-vector.15
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count 1 :from-end t)))
result)
#*010111)
(deftest nsubstitute-if-not-bitstring.16
(deftest nsubstitute-if-not-bit-vector.16
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count 0 :from-end t)))
result)
#*010101)
(deftest nsubstitute-if-not-bitstring.17
(deftest nsubstitute-if-not-bit-vector.17
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count -1 :from-end t)))
result)
#*010101)
(deftest nsubstitute-if-not-bitstring.18
(deftest nsubstitute-if-not-bit-vector.18
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count nil)))
result)
#*111111)
(deftest nsubstitute-if-not-bitstring.19
(deftest nsubstitute-if-not-bit-vector.19
(let* ((orig #*010101)
(x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 0) x :count nil :from-end t)))
result)
#*111111)
(deftest nsubstitute-if-not-bitstring.20
(deftest nsubstitute-if-not-bit-vector.20
(loop for i from 0 to 9 always
(loop for j from i to 10 always
(loop for c from 0 to (- j i) always
......@@ -472,7 +531,7 @@
(make-list (- 10 (+ i c)) :initial-element 0)))))))
t)
(deftest nsubstitute-if-not-bitstring.21
(deftest nsubstitute-if-not-bit-vector.21
(loop for i from 0 to 9 always
(loop for j from i to 10 always
(loop for c from 0 to (- j i) always
......@@ -532,16 +591,44 @@
result)
"01a2342015")
(deftest nsubstitute-if-not-bitstring.26
(deftest nsubstitute-if-not-bit-vector.26
(let* ((orig #*00111001011010110)
(x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 1) x :key #'1+)))
result)
#*11111111111111111)
(deftest nsubstitute-if-not-bitstring.27
(deftest nsubstitute-if-not-bit-vector.27
(let* ((orig #*00111001011010110)
(x (copy-seq orig))
(result (nsubstitute-if-not 1 (is-not-eq-p 1) x :key #'1+ :start 1 :end 10)))
result)
#*01111111111010110)
(deftest nsubstitute-if-not-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))
(result (nsubstitute-if-not 1 #'onep x)))
result)
#*11111)
(deftest nsubstitute-if-not-bit-vector.31
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
:fill-pointer 5 :element-type 'bit))
(result (nsubstitute-if-not 1 #'onep x :from-end t)))
result)
#*11111)
(deftest nsubstitute-if-not-bit-vector.32
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
:fill-pointer 5 :element-type 'bit))
(result (nsubstitute-if-not 1 #'onep x :count 1)))
result)
#*11011)
(deftest nsubstitute-if-not-bit-vector.33
(let* ((x (make-array '(10) :initial-contents '(0 1 0 1 1 0 1 1 0 1)
:fill-pointer 5 :element-type 'bit))
(result (nsubstitute-if-not 1 #'onep x :from-end t :count 1)))
result)
#*01111)
......@@ -215,6 +215,34 @@
(make-array (- 10 j) :initial-element 'a)))))))
t)
(deftest nsubstitute-if-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 'z (is-eql-p 'a) x)))
result)
#(z b z c b))
(deftest nsubstitute-if-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 'z (is-eql-p 'a) x :from-end t)))
result)
#(z b z c b))
(deftest nsubstitute-if-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 'z (is-eql-p 'a) x :count 1)))
result)
#(z b a c b))
(deftest nsubstitute-if-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 'z (is-eql-p 'a) x :from-end t :count 1)))
result)
#(a b z c b))
;;; Tests on strings
(deftest nsubstitute-if-string.1
......@@ -323,142 +351,171 @@
(make-array (- 10 j) :initial-element #\a)))))))
t)
;;; Tests on bitstrings
(deftest nsubstitute-if-string.28
(let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list)
:fill-pointer 5 :element-type 'character))
(result (nsubstitute-if #\z (is-eql-p #\a) x)))
result)
"zbzcb")