diff --git a/ansi-tests/concatenate.lsp b/ansi-tests/concatenate.lsp index 267fda3f26ced0f9408992eace624767e82d81a3..5ae5436b0514bfa578479fd6ac660a9809302159 100644 --- a/ansi-tests/concatenate.lsp +++ b/ansi-tests/concatenate.lsp @@ -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 diff --git a/ansi-tests/merge.lsp b/ansi-tests/merge.lsp index ee7d21b9516a226d81d87f0af9fccbf61d36cbce..c285e07ccf65f36450e474be0c0940a86b42d126 100644 --- a/ansi-tests/merge.lsp +++ b/ansi-tests/merge.lsp @@ -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 diff --git a/ansi-tests/nsubstitute-if-not.lsp b/ansi-tests/nsubstitute-if-not.lsp index a18c7c102e6ab14a4c6ed7fa8036c2de16a4faaa..2cd632f8a09ac13140a2293a3bc9ec391adafa33 100644 --- a/ansi-tests/nsubstitute-if-not.lsp +++ b/ansi-tests/nsubstitute-if-not.lsp @@ -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) diff --git a/ansi-tests/nsubstitute-if.lsp b/ansi-tests/nsubstitute-if.lsp index 8f6debb68e369a872f5370378d1d02f3365112a2..d77798fe72b23ab88c3387dd1b4080098d900259 100644 --- a/ansi-tests/nsubstitute-if.lsp +++ b/ansi-tests/nsubstitute-if.lsp @@ -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") + +(deftest nsubstitute-if-string.29 + (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 :from-end t))) + result) + "zbzcb") + +(deftest nsubstitute-if-string.30 + (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 :count 1))) + result) + "zbacb") + +(deftest nsubstitute-if-string.31 + (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 :from-end t :count 1))) + result) + "abzcb") + + +;;; Tests on bit-vectors -(deftest nsubstitute-if-bitstring.1 +(deftest nsubstitute-if-bit-vector.1 (let* ((orig #*) (x (copy-seq orig)) (result (nsubstitute-if 0 (is-eq-p 1) x))) result) #*) -(deftest nsubstitute-if-bitstring.2 +(deftest nsubstitute-if-bit-vector.2 (let* ((orig #*) (x (copy-seq orig)) (result (nsubstitute-if 1 (is-eq-p 0) x))) result) #*) -(deftest nsubstitute-if-bitstring.3 +(deftest nsubstitute-if-bit-vector.3 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 0 (is-eq-p 1) x))) result) #*000000) -(deftest nsubstitute-if-bitstring.4 +(deftest nsubstitute-if-bit-vector.4 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 1 (is-eq-p 0) x))) result) #*111111) -(deftest nsubstitute-if-bitstring.5 +(deftest nsubstitute-if-bit-vector.5 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 1 (is-eq-p 0) x :start 1))) result) #*011111) -(deftest nsubstitute-if-bitstring.6 +(deftest nsubstitute-if-bit-vector.6 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 0 (is-eq-p 1) x :start 2 :end nil))) result) #*010000) -(deftest nsubstitute-if-bitstring.7 +(deftest nsubstitute-if-bit-vector.7 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 1 (is-eq-p 0) x :end 4))) result) #*111101) -(deftest nsubstitute-if-bitstring.8 +(deftest nsubstitute-if-bit-vector.8 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 0 (is-eq-p 1) x :end nil))) result) #*000000) -(deftest nsubstitute-if-bitstring.9 +(deftest nsubstitute-if-bit-vector.9 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 0 (is-eq-p 1) x :end 3))) result) #*000101) -(deftest nsubstitute-if-bitstring.10 +(deftest nsubstitute-if-bit-vector.10 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 0 (is-eq-p 1) x :start 2 :end 4))) result) #*010001) -(deftest nsubstitute-if-bitstring.11 +(deftest nsubstitute-if-bit-vector.11 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 1 (is-eq-p 0) x :start 2 :end 4))) result) #*011101) -(deftest nsubstitute-if-bitstring.12 +(deftest nsubstitute-if-bit-vector.12 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 1 (is-eq-p 0) x :count 1))) result) #*110101) -(deftest nsubstitute-if-bitstring.13 +(deftest nsubstitute-if-bit-vector.13 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 1 (is-eq-p 0) x :count 0))) result) #*010101) -(deftest nsubstitute-if-bitstring.14 +(deftest nsubstitute-if-bit-vector.14 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 1 (is-eq-p 0) x :count -1))) result) #*010101) -(deftest nsubstitute-if-bitstring.15 +(deftest nsubstitute-if-bit-vector.15 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 1 (is-eq-p 0) x :count 1 :from-end t))) result) #*010111) -(deftest nsubstitute-if-bitstring.16 +(deftest nsubstitute-if-bit-vector.16 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 1 (is-eq-p 0) x :count 0 :from-end t))) result) #*010101) -(deftest nsubstitute-if-bitstring.17 +(deftest nsubstitute-if-bit-vector.17 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 1 (is-eq-p 0) x :count -1 :from-end t))) result) #*010101) -(deftest nsubstitute-if-bitstring.18 +(deftest nsubstitute-if-bit-vector.18 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 1 (is-eq-p 0) x :count nil))) result) #*111111) -(deftest nsubstitute-if-bitstring.19 +(deftest nsubstitute-if-bit-vector.19 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute-if 1 (is-eq-p 0) x :count nil :from-end t))) result) #*111111) -(deftest nsubstitute-if-bitstring.20 +(deftest nsubstitute-if-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 +529,7 @@ (make-list (- 10 (+ i c)) :initial-element 0))))))) t) -(deftest nsubstitute-if-bitstring.21 +(deftest nsubstitute-if-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 @@ -531,16 +588,45 @@ result) "01a2342015") -(deftest nsubstitute-if-bitstring.26 +(deftest nsubstitute-if-bit-vector.26 (let* ((orig #*00111001011010110) (x (copy-seq orig)) (result (nsubstitute-if 1 (is-eq-p 1) x :key #'1+))) result) #*11111111111111111) -(deftest nsubstitute-if-bitstring.27 +(deftest nsubstitute-if-bit-vector.27 (let* ((orig #*00111001011010110) (x (copy-seq orig)) (result (nsubstitute-if 1 (is-eq-p 1) x :key #'1+ :start 1 :end 10))) result) #*01111111111010110) + +(deftest nsubstitute-if-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 1 #'zerop x))) + result) + #*11111) + +(deftest nsubstitute-if-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 1 #'zerop x :from-end t))) + result) + #*11111) + +(deftest nsubstitute-if-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 1 #'zerop x :count 1))) + result) + #*11011) + +(deftest nsubstitute-if-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 1 #'zerop x :from-end t :count 1))) + result) + #*01111) + diff --git a/ansi-tests/nsubstitute.lsp b/ansi-tests/nsubstitute.lsp index 28959c74e26072f6c07edc0b11aa6ea744dbed60..86bb0a716b9710a3250e6a346f0b6f121878c485 100644 --- a/ansi-tests/nsubstitute.lsp +++ b/ansi-tests/nsubstitute.lsp @@ -300,6 +300,34 @@ result) #(1 2 3 4 5 6 7 x 9)) +(deftest nsubstitute-vector.28 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute 'z 'a x))) + result) + #(z b z c b)) + +(deftest nsubstitute-vector.29 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute 'z 'a x :from-end t))) + result) + #(z b z c b)) + +(deftest nsubstitute-vector.30 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute 'z 'a x :count 1))) + result) + #(z b a c b)) + +(deftest nsubstitute-vector.31 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (nsubstitute 'z 'a x :from-end t :count 1))) + result) + #(a b z c b)) + ;;; Tests on strings (deftest nsubstitute-string.1 @@ -466,142 +494,171 @@ result) "1234567x9") -;;; Tests on bitstrings +(deftest nsubstitute-string.28 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute #\z #\a x))) + result) + "zbzcb") + +(deftest nsubstitute-string.29 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute #\z #\a x :from-end t))) + result) + "zbzcb") -(deftest nsubstitute-bitstring.1 +(deftest nsubstitute-string.30 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute #\z #\a x :count 1))) + result) + "zbacb") + +(deftest nsubstitute-string.31 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (nsubstitute #\z #\a x :from-end t :count 1))) + result) + "abzcb") + + +;;; Tests on bit-vectors + +(deftest nsubstitute-bit-vector.1 (let* ((orig #*) (x (copy-seq orig)) (result (nsubstitute 0 1 x))) result) #*) -(deftest nsubstitute-bitstring.2 +(deftest nsubstitute-bit-vector.2 (let* ((orig #*) (x (copy-seq orig)) (result (nsubstitute 1 0 x))) result) #*) -(deftest nsubstitute-bitstring.3 +(deftest nsubstitute-bit-vector.3 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 0 1 x))) result) #*000000) -(deftest nsubstitute-bitstring.4 +(deftest nsubstitute-bit-vector.4 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 1 0 x))) result) #*111111) -(deftest nsubstitute-bitstring.5 +(deftest nsubstitute-bit-vector.5 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 1 0 x :start 1))) result) #*011111) -(deftest nsubstitute-bitstring.6 +(deftest nsubstitute-bit-vector.6 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 0 1 x :start 2 :end nil))) result) #*010000) -(deftest nsubstitute-bitstring.7 +(deftest nsubstitute-bit-vector.7 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 1 0 x :end 4))) result) #*111101) -(deftest nsubstitute-bitstring.8 +(deftest nsubstitute-bit-vector.8 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 0 1 x :end nil))) result) #*000000) -(deftest nsubstitute-bitstring.9 +(deftest nsubstitute-bit-vector.9 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 0 1 x :end 3))) result) #*000101) -(deftest nsubstitute-bitstring.10 +(deftest nsubstitute-bit-vector.10 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 0 1 x :start 2 :end 4))) result) #*010001) -(deftest nsubstitute-bitstring.11 +(deftest nsubstitute-bit-vector.11 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 1 0 x :start 2 :end 4))) result) #*011101) -(deftest nsubstitute-bitstring.12 +(deftest nsubstitute-bit-vector.12 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 1 0 x :count 1))) result) #*110101) -(deftest nsubstitute-bitstring.13 +(deftest nsubstitute-bit-vector.13 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 1 0 x :count 0))) result) #*010101) -(deftest nsubstitute-bitstring.14 +(deftest nsubstitute-bit-vector.14 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 1 0 x :count -1))) result) #*010101) -(deftest nsubstitute-bitstring.15 +(deftest nsubstitute-bit-vector.15 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 1 0 x :count 1 :from-end t))) result) #*010111) -(deftest nsubstitute-bitstring.16 +(deftest nsubstitute-bit-vector.16 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 1 0 x :count 0 :from-end t))) result) #*010101) -(deftest nsubstitute-bitstring.17 +(deftest nsubstitute-bit-vector.17 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 1 0 x :count -1 :from-end t))) result) #*010101) -(deftest nsubstitute-bitstring.18 +(deftest nsubstitute-bit-vector.18 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 1 0 x :count nil))) result) #*111111) -(deftest nsubstitute-bitstring.19 +(deftest nsubstitute-bit-vector.19 (let* ((orig #*010101) (x (copy-seq orig)) (result (nsubstitute 1 0 x :count nil :from-end t))) result) #*111111) -(deftest nsubstitute-bitstring.20 +(deftest nsubstitute-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 @@ -615,7 +672,7 @@ (make-list (- 10 (+ i c)) :initial-element 0))))))) t) -(deftest nsubstitute-bitstring.21 +(deftest nsubstitute-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 @@ -629,7 +686,7 @@ (make-list (- 10 j) :initial-element 1))))))) t) -(deftest nsubstitute-bitstring.22 +(deftest nsubstitute-bit-vector.22 (let* ((orig #*0101010101) (x (copy-seq orig)) (c 0) @@ -637,7 +694,7 @@ result) #*0111110101) -(deftest nsubstitute-bitstring.23 +(deftest nsubstitute-bit-vector.23 (let* ((orig #*0101010101) (x (copy-seq orig)) (c 0) @@ -646,7 +703,7 @@ result) #*0111110101) -(deftest nsubstitute-bitstring.24 +(deftest nsubstitute-bit-vector.24 (let* ((orig #*0101010101) (x (copy-seq orig)) (c 0) @@ -655,7 +712,7 @@ result) #*0101011111) -(deftest nsubstitute-bitstring.25 +(deftest nsubstitute-bit-vector.25 (let* ((orig #*0101010101) (x (copy-seq orig)) (c 0) @@ -750,3 +807,31 @@ (result (nsubstitute #\a #\1 x :key #'nextdigit :test-not #'eq))) result) "0a0aaaa0aa") + +(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)) + (result (nsubstitute 1 0 x))) + result) + #*11111) + +(deftest nsubstitute-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 1 0 x :from-end t))) + result) + #*11111) + +(deftest nsubstitute-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 1 0 x :count 1))) + result) + #*11011) + +(deftest nsubstitute-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 1 0 x :from-end t :count 1))) + result) + #*01111) diff --git a/ansi-tests/substitute-if-not.lsp b/ansi-tests/substitute-if-not.lsp index a2c9d2cc6a29a63a384b2e145f9e849f9119e174..7d12e399224a591ec49fe53ff795b6c106fe6cb9 100644 --- a/ansi-tests/substitute-if-not.lsp +++ b/ansi-tests/substitute-if-not.lsp @@ -247,6 +247,36 @@ (make-array (- 10 j) :initial-element 'a)))))))) t) +(deftest substitute-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 (substitute-if-not 'z (is-not-eql-p 'a) x))) + result) + #(z b z c b)) + +(deftest substitute-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 (substitute-if-not 'z (is-not-eql-p 'a) x :from-end t))) + result) + #(z b z c b)) + +(deftest substitute-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 (substitute-if-not 'z (is-not-eql-p 'a) x :count 1))) + result) + #(z b a c b)) + +(deftest substitute-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 (substitute-if-not 'z (is-not-eql-p 'a) x + :from-end t :count 1))) + result) + #(a b z c b)) + + ;;; Tests on strings (deftest substitute-if-not-string.1 @@ -371,6 +401,37 @@ (make-array (- 10 j) :initial-element #\a)))))))) t) +(deftest substitute-if-not-string.28 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (substitute-if-not #\z (is-not-eql-p #\a) x))) + result) + "zbzcb") + +(deftest substitute-if-not-string.29 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (substitute-if-not #\z (is-not-eql-p #\a) x :from-end t))) + result) + "zbzcb") + +(deftest substitute-if-not-string.30 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (substitute-if-not #\z (is-not-eql-p #\a) x :count 1))) + result) + "zbacb") + +(deftest substitute-if-not-string.31 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (substitute-if-not #\z (is-not-eql-p #\a) x + :from-end t :count 1))) + result) + "abzcb") + + + ;;; Tests on bitstrings (deftest substitute-if-not-bitstring.1 @@ -621,3 +682,31 @@ (and (equalp orig x) result)) #*01111111111010110) + +(deftest substitute-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 (substitute-if-not 1 #'onep x))) + result) + #*11111) + +(deftest substitute-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 (substitute-if-not 1 #'onep x :from-end t))) + result) + #*11111) + +(deftest substitute-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 (substitute-if-not 1 #'onep x :count 1))) + result) + #*11011) + +(deftest substitute-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 (substitute-if-not 1 #'onep x :from-end t :count 1))) + result) + #*01111) diff --git a/ansi-tests/substitute-if.lsp b/ansi-tests/substitute-if.lsp index 3e0e807a21767377ac72b4b4afa9ec003dcb721d..46f2f2a06f8e8c641f60e71ce8cf0728d7c4243e 100644 --- a/ansi-tests/substitute-if.lsp +++ b/ansi-tests/substitute-if.lsp @@ -123,6 +123,7 @@ (make-list (- 10 j) :initial-element 'a)))))))) t) + ;;; Tests on vectors (deftest substitute-if-vector.1 @@ -179,17 +180,20 @@ #(a b a c)) (deftest substitute-if-vector.12 - (let ((x #(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count 1 :from-end t) x)) + (let ((x #(a b a c))) + (values (substitute-if 'b (is-eq-p 'a) x :count 1 :from-end t) x)) #(a b b c) #(a b a c)) (deftest substitute-if-vector.13 - (let ((x #(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count 0 :from-end t) x)) + (let ((x #(a b a c))) + (values (substitute-if 'b (is-eq-p 'a) x :count 0 :from-end t) x)) #(a b a c) #(a b a c)) (deftest substitute-if-vector.14 - (let ((x #(a b a c))) (values (substitute-if 'b (is-eq-p 'a) x :count -1 :from-end t) x)) + (let ((x #(a b a c))) + (values (substitute-if 'b (is-eq-p 'a) x :count -1 :from-end t) x)) #(a b a c) #(a b a c)) @@ -200,10 +204,12 @@ (x (copy-seq orig)) (y (substitute-if 'x (is-eq-p 'a) x :start i :end j))) (and (equalp orig x) - (equalp y (concatenate 'simple-vector - (make-array i :initial-element 'a) - (make-array (- j i) :initial-element 'x) - (make-array (- 10 j) :initial-element 'a))))))) + (equalp y + (concatenate + 'simple-vector + (make-array i :initial-element 'a) + (make-array (- j i) :initial-element 'x) + (make-array (- 10 j) :initial-element 'a))))))) t) (deftest substitute-if-vector.16 @@ -213,10 +219,12 @@ (x (copy-seq orig)) (y (substitute-if 'x (is-eq-p 'a) x :start i :end j :from-end t))) (and (equalp orig x) - (equalp y (concatenate 'simple-vector - (make-array i :initial-element 'a) - (make-array (- j i) :initial-element 'x) - (make-array (- 10 j) :initial-element 'a))))))) + (equalp y + (concatenate + 'simple-vector + (make-array i :initial-element 'a) + (make-array (- j i) :initial-element 'x) + (make-array (- 10 j) :initial-element 'a))))))) t) (deftest substitute-if-vector.17 @@ -225,12 +233,16 @@ (loop for c from 0 to (- j i) always (let* ((orig #(a a a a a a a a a a)) (x (copy-seq orig)) - (y (substitute-if 'x (is-eq-p 'a) x :start i :end j :count c))) + (y (substitute-if 'x (is-eq-p 'a) x + :start i :end j :count c))) (and (equalp orig x) - (equalp y (concatenate 'simple-vector - (make-array i :initial-element 'a) - (make-array c :initial-element 'x) - (make-array (- 10 (+ i c)) :initial-element 'a)))))))) + (equalp + y (concatenate + 'simple-vector + (make-array i :initial-element 'a) + (make-array c :initial-element 'x) + (make-array (- 10 (+ i c)) + :initial-element 'a)))))))) t) (deftest substitute-if-vector.18 @@ -239,14 +251,47 @@ (loop for c from 0 to (- j i) always (let* ((orig #(a a a a a a a a a a)) (x (copy-seq orig)) - (y (substitute-if 'x (is-eq-p 'a) x :start i :end j :count c :from-end t))) + (y (substitute-if 'x (is-eq-p 'a) x + :start i :end j :count c + :from-end t))) (and (equalp orig x) - (equalp y (concatenate 'simple-vector - (make-array (- j c) :initial-element 'a) - (make-array c :initial-element 'x) - (make-array (- 10 j) :initial-element 'a)))))))) + (equalp + y + (concatenate + 'simple-vector + (make-array (- j c) :initial-element 'a) + (make-array c :initial-element 'x) + (make-array (- 10 j) :initial-element 'a)))))))) t) +(deftest substitute-if-vector.28 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute-if 'z (is-eql-p 'a) x))) + result) + #(z b z c b)) + +(deftest substitute-if-vector.29 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute-if 'z (is-eql-p 'a) x :from-end t))) + result) + #(z b z c b)) + +(deftest substitute-if-vector.30 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute-if 'z (is-eql-p 'a) x :count 1))) + result) + #(z b a c b)) + +(deftest substitute-if-vector.31 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute-if 'z (is-eql-p 'a) x :from-end t :count 1))) + result) + #(a b z c b)) + ;;; Tests on strings (deftest substitute-if-string.1 @@ -335,12 +380,15 @@ (loop for j from i to 10 always (let* ((orig "aaaaaaaaaa") (x (copy-seq orig)) - (y (substitute-if #\x (is-eq-p #\a) x :start i :end j :from-end t))) + (y (substitute-if #\x (is-eq-p #\a) x + :start i :end j :from-end t))) (and (equalp orig x) - (equalp y (concatenate 'simple-string - (make-array i :initial-element #\a) - (make-array (- j i) :initial-element #\x) - (make-array (- 10 j) :initial-element #\a))))))) + (equalp y + (concatenate + 'simple-string + (make-array i :initial-element #\a) + (make-array (- j i) :initial-element #\x) + (make-array (- 10 j) :initial-element #\a))))))) t) (deftest substitute-if-string.17 @@ -349,12 +397,16 @@ (loop for c from 0 to (- j i) always (let* ((orig "aaaaaaaaaa") (x (copy-seq orig)) - (y (substitute-if #\x (is-eq-p #\a) x :start i :end j :count c))) + (y (substitute-if #\x (is-eq-p #\a) x + :start i :end j :count c))) (and (equalp orig x) - (equalp y (concatenate 'simple-string - (make-array i :initial-element #\a) - (make-array c :initial-element #\x) - (make-array (- 10 (+ i c)) :initial-element #\a)))))))) + (equalp y + (concatenate + 'simple-string + (make-array i :initial-element #\a) + (make-array c :initial-element #\x) + (make-array (- 10 (+ i c)) + :initial-element #\a)))))))) t) (deftest substitute-if-string.18 @@ -363,17 +415,50 @@ (loop for c from 0 to (- j i) always (let* ((orig "aaaaaaaaaa") (x (copy-seq orig)) - (y (substitute-if #\x (is-eq-p #\a) x :start i :end j :count c :from-end t))) + (y (substitute-if #\x (is-eq-p #\a) x + :start i :end j :count c + :from-end t))) (and (equalp orig x) - (equalp y (concatenate 'simple-string - (make-array (- j c) :initial-element #\a) - (make-array c :initial-element #\x) - (make-array (- 10 j) :initial-element #\a)))))))) + (equalp y (concatenate + 'simple-string + (make-array (- j c) :initial-element #\a) + (make-array c :initial-element #\x) + (make-array (- 10 j) + :initial-element #\a)))))))) t) -;;; Tests on bitstrings -(deftest substitute-if-bitstring.1 +(deftest substitute-if-string.28 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (substitute-if #\z (is-eql-p #\a) x))) + result) + "zbzcb") + +(deftest substitute-if-string.29 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (substitute-if #\z (is-eql-p #\a) x :from-end t))) + result) + "zbzcb") + +(deftest substitute-if-string.30 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (substitute-if #\z (is-eql-p #\a) x :count 1))) + result) + "zbacb") + +(deftest substitute-if-string.31 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (substitute-if #\z (is-eql-p #\a) x :from-end t :count 1))) + result) + "abzcb") + +;;; Tests on bit-vectors + +(deftest substitute-if-bit-vector.1 (let* ((orig #*) (x (copy-seq orig)) (result (substitute-if 0 (is-eq-p 1) x))) @@ -381,7 +466,7 @@ result)) #*) -(deftest substitute-if-bitstring.2 +(deftest substitute-if-bit-vector.2 (let* ((orig #*) (x (copy-seq orig)) (result (substitute-if 1 'zerop x))) @@ -389,7 +474,7 @@ result)) #*) -(deftest substitute-if-bitstring.3 +(deftest substitute-if-bit-vector.3 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 0 (is-eq-p 1) x))) @@ -397,7 +482,7 @@ result)) #*000000) -(deftest substitute-if-bitstring.4 +(deftest substitute-if-bit-vector.4 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 1 #'zerop x))) @@ -405,7 +490,7 @@ result)) #*111111) -(deftest substitute-if-bitstring.5 +(deftest substitute-if-bit-vector.5 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 1 #'zerop x :start 1))) @@ -413,7 +498,7 @@ result)) #*011111) -(deftest substitute-if-bitstring.6 +(deftest substitute-if-bit-vector.6 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 0 (is-eq-p 1) x :start 2 :end nil))) @@ -421,7 +506,7 @@ result)) #*010000) -(deftest substitute-if-bitstring.7 +(deftest substitute-if-bit-vector.7 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 1 #'zerop x :end 4))) @@ -429,7 +514,7 @@ result)) #*111101) -(deftest substitute-if-bitstring.8 +(deftest substitute-if-bit-vector.8 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 0 (is-eq-p 1) x :end nil))) @@ -437,7 +522,7 @@ result)) #*000000) -(deftest substitute-if-bitstring.9 +(deftest substitute-if-bit-vector.9 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 0 (is-eq-p 1) x :end 3))) @@ -445,7 +530,7 @@ result)) #*000101) -(deftest substitute-if-bitstring.10 +(deftest substitute-if-bit-vector.10 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 0 (is-eq-p 1) x :start 2 :end 4))) @@ -453,7 +538,7 @@ result)) #*010001) -(deftest substitute-if-bitstring.11 +(deftest substitute-if-bit-vector.11 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 1 #'zerop x :start 2 :end 4))) @@ -461,7 +546,7 @@ result)) #*011101) -(deftest substitute-if-bitstring.12 +(deftest substitute-if-bit-vector.12 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 1 #'zerop x :count 1))) @@ -469,7 +554,7 @@ result)) #*110101) -(deftest substitute-if-bitstring.13 +(deftest substitute-if-bit-vector.13 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 1 #'zerop x :count 0))) @@ -477,7 +562,7 @@ result)) #*010101) -(deftest substitute-if-bitstring.14 +(deftest substitute-if-bit-vector.14 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 1 #'zerop x :count -1))) @@ -485,7 +570,7 @@ result)) #*010101) -(deftest substitute-if-bitstring.15 +(deftest substitute-if-bit-vector.15 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 1 #'zerop x :count 1 :from-end t))) @@ -493,7 +578,7 @@ result)) #*010111) -(deftest substitute-if-bitstring.16 +(deftest substitute-if-bit-vector.16 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 1 #'zerop x :count 0 :from-end t))) @@ -501,7 +586,7 @@ result)) #*010101) -(deftest substitute-if-bitstring.17 +(deftest substitute-if-bit-vector.17 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 1 #'zerop x :count -1 :from-end t))) @@ -509,7 +594,7 @@ result)) #*010101) -(deftest substitute-if-bitstring.18 +(deftest substitute-if-bit-vector.18 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 1 #'zerop x :count nil))) @@ -517,7 +602,7 @@ result)) #*111111) -(deftest substitute-if-bitstring.19 +(deftest substitute-if-bit-vector.19 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute-if 1 #'zerop x :count nil :from-end t))) @@ -525,7 +610,7 @@ result)) #*111111) -(deftest substitute-if-bitstring.20 +(deftest substitute-if-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 @@ -540,7 +625,7 @@ (make-list (- 10 (+ i c)) :initial-element 0)))))))) t) -(deftest substitute-if-bitstring.21 +(deftest substitute-if-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 @@ -606,7 +691,7 @@ result)) "01a2342015") -(deftest substitute-if-bitstring.26 +(deftest substitute-if-bit-vector.26 (let* ((orig #*00111001011010110) (x (copy-seq orig)) (result (substitute-if 1 (is-eq-p 1) x :key #'1+))) @@ -614,10 +699,38 @@ result)) #*11111111111111111) -(deftest substitute-if-bitstring.27 +(deftest substitute-if-bit-vector.27 (let* ((orig #*00111001011010110) (x (copy-seq orig)) (result (substitute-if 1 (is-eq-p 1) x :key #'1+ :start 1 :end 10))) (and (equalp orig x) result)) #*01111111111010110) + +(deftest substitute-if-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 (substitute-if 1 #'zerop x))) + result) + #*11111) + +(deftest substitute-if-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 (substitute-if 1 #'zerop x :from-end t))) + result) + #*11111) + +(deftest substitute-if-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 (substitute-if 1 #'zerop x :count 1))) + result) + #*11011) + +(deftest substitute-if-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 (substitute-if 1 #'zerop x :from-end t :count 1))) + result) + #*01111) diff --git a/ansi-tests/substitute.lsp b/ansi-tests/substitute.lsp index 66654e68f59e8ffe08e85f0ed03bb01c9a35653c..d344b3878eda04e4609fcf3866118e8398f844af 100644 --- a/ansi-tests/substitute.lsp +++ b/ansi-tests/substitute.lsp @@ -407,6 +407,34 @@ result)) #((a 1) (a 10) (a 3) (a 10) (a 10) (a 6) (a 10))) +(deftest substitute-vector.28 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute 'z 'a x))) + result) + #(z b z c b)) + +(deftest substitute-vector.29 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute 'z 'a x :from-end t))) + result) + #(z b z c b)) + +(deftest substitute-vector.30 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute 'z 'a x :count 1))) + result) + #(z b a c b)) + +(deftest substitute-vector.31 + (let* ((x (make-array '(10) :initial-contents '(a b a c b a d e a f) + :fill-pointer 5)) + (result (substitute 'z 'a x :from-end t :count 1))) + result) + #(a b z c b)) + ;;; Tests on strings (deftest substitute-string.1 @@ -626,9 +654,37 @@ result)) "0a0aaaa0aa") -;;; Tests on bitstrings - -(deftest substitute-bitstring.1 +(deftest substitute-string.28 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (substitute #\z #\a x))) + result) + "zbzcb") + +(deftest substitute-string.29 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (substitute #\z #\a x :from-end t))) + result) + "zbzcb") + +(deftest substitute-string.30 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (substitute #\z #\a x :count 1))) + result) + "zbacb") + +(deftest substitute-string.31 + (let* ((x (make-array '(10) :initial-contents (coerce "abacbadeaf" 'list) + :fill-pointer 5 :element-type 'character)) + (result (substitute #\z #\a x :from-end t :count 1))) + result) + "abzcb") + +;;; Tests on bit-vectors + +(deftest substitute-bit-vector.1 (let* ((orig #*) (x (copy-seq orig)) (result (substitute 0 1 x))) @@ -636,7 +692,7 @@ result)) #*) -(deftest substitute-bitstring.2 +(deftest substitute-bit-vector.2 (let* ((orig #*) (x (copy-seq orig)) (result (substitute 1 0 x))) @@ -644,7 +700,7 @@ result)) #*) -(deftest substitute-bitstring.3 +(deftest substitute-bit-vector.3 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 0 1 x))) @@ -652,7 +708,7 @@ result)) #*000000) -(deftest substitute-bitstring.4 +(deftest substitute-bit-vector.4 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 1 0 x))) @@ -660,7 +716,7 @@ result)) #*111111) -(deftest substitute-bitstring.5 +(deftest substitute-bit-vector.5 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 1 0 x :start 1))) @@ -668,7 +724,7 @@ result)) #*011111) -(deftest substitute-bitstring.6 +(deftest substitute-bit-vector.6 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 0 1 x :start 2 :end nil))) @@ -676,7 +732,7 @@ result)) #*010000) -(deftest substitute-bitstring.7 +(deftest substitute-bit-vector.7 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 1 0 x :end 4))) @@ -684,7 +740,7 @@ result)) #*111101) -(deftest substitute-bitstring.8 +(deftest substitute-bit-vector.8 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 0 1 x :end nil))) @@ -692,7 +748,7 @@ result)) #*000000) -(deftest substitute-bitstring.9 +(deftest substitute-bit-vector.9 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 0 1 x :end 3))) @@ -700,7 +756,7 @@ result)) #*000101) -(deftest substitute-bitstring.10 +(deftest substitute-bit-vector.10 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 0 1 x :start 2 :end 4))) @@ -708,7 +764,7 @@ result)) #*010001) -(deftest substitute-bitstring.11 +(deftest substitute-bit-vector.11 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 1 0 x :start 2 :end 4))) @@ -716,7 +772,7 @@ result)) #*011101) -(deftest substitute-bitstring.12 +(deftest substitute-bit-vector.12 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 1 0 x :count 1))) @@ -724,7 +780,7 @@ result)) #*110101) -(deftest substitute-bitstring.13 +(deftest substitute-bit-vector.13 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 1 0 x :count 0))) @@ -732,7 +788,7 @@ result)) #*010101) -(deftest substitute-bitstring.14 +(deftest substitute-bit-vector.14 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 1 0 x :count -1))) @@ -740,7 +796,7 @@ result)) #*010101) -(deftest substitute-bitstring.15 +(deftest substitute-bit-vector.15 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 1 0 x :count 1 :from-end t))) @@ -748,7 +804,7 @@ result)) #*010111) -(deftest substitute-bitstring.16 +(deftest substitute-bit-vector.16 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 1 0 x :count 0 :from-end t))) @@ -756,7 +812,7 @@ result)) #*010101) -(deftest substitute-bitstring.17 +(deftest substitute-bit-vector.17 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 1 0 x :count -1 :from-end t))) @@ -764,7 +820,7 @@ result)) #*010101) -(deftest substitute-bitstring.18 +(deftest substitute-bit-vector.18 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 1 0 x :count nil))) @@ -772,7 +828,7 @@ result)) #*111111) -(deftest substitute-bitstring.19 +(deftest substitute-bit-vector.19 (let* ((orig #*010101) (x (copy-seq orig)) (result (substitute 1 0 x :count nil :from-end t))) @@ -780,7 +836,7 @@ result)) #*111111) -(deftest substitute-bitstring.20 +(deftest substitute-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 @@ -795,7 +851,7 @@ (make-list (- 10 (+ i c)) :initial-element 0)))))))) t) -(deftest substitute-bitstring.21 +(deftest substitute-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 @@ -810,7 +866,7 @@ (make-list (- 10 j) :initial-element 1)))))))) t) -(deftest substitute-bitstring.22 +(deftest substitute-bit-vector.22 (let* ((orig #*0101010101) (x (copy-seq orig)) (c 0) @@ -819,7 +875,7 @@ result)) #*0111110101) -(deftest substitute-bitstring.23 +(deftest substitute-bit-vector.23 (let* ((orig #*0101010101) (x (copy-seq orig)) (c 0) @@ -829,7 +885,7 @@ result)) #*0111110101) -(deftest substitute-bitstring.24 +(deftest substitute-bit-vector.24 (let* ((orig #*0101010101) (x (copy-seq orig)) (c 0) @@ -839,7 +895,7 @@ result)) #*0101011111) -(deftest substitute-bitstring.25 +(deftest substitute-bit-vector.25 (let* ((orig #*0101010101) (x (copy-seq orig)) (c 0) @@ -850,7 +906,7 @@ result)) #*0101011111) -(deftest substitute-bitstring.26 +(deftest substitute-bit-vector.26 (let* ((orig #*00111001011010110) (x (copy-seq orig)) (result (substitute 1 1 x :key #'1+))) @@ -858,7 +914,7 @@ result)) #*11111111111111111) -(deftest substitute-bitstring.27 +(deftest substitute-bit-vector.27 (let* ((orig #*00111001011010110) (x (copy-seq orig)) (result (substitute 1 1 x :key #'1+ :start 1 :end 10))) @@ -866,7 +922,7 @@ result)) #*01111111111010110) -(deftest substitute-bitstring.28 +(deftest substitute-bit-vector.28 (let* ((orig #*00111001011010110) (x (copy-seq orig)) (result (substitute 0 1 x :key #'1+ :test (complement #'eq)))) @@ -874,10 +930,38 @@ result)) #*00000000000000000) -(deftest substitute-bitstring.29 +(deftest substitute-bit-vector.29 (let* ((orig #*00111001011010110) (x (copy-seq orig)) (result (substitute 0 1 x :key #'1+ :test-not #'eq))) (and (equalp orig x) result)) #*00000000000000000) + +(deftest substitute-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 (substitute 1 0 x))) + result) + #*11111) + +(deftest substitute-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 (substitute 1 0 x :from-end t))) + result) + #*11111) + +(deftest substitute-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 (substitute 1 0 x :count 1))) + result) + #*11011) + +(deftest substitute-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 (substitute 1 0 x :from-end t :count 1))) + result) + #*01111)