Commit 8f88d567 authored by pfdietz's avatar pfdietz

Added more tests for sequence functions on vectors with fill pointers.

parent cc5aac3f
......@@ -259,69 +259,92 @@
:end 7 :start 2 :from-end t)
1)
;;; tests on bitstrings
(deftest count-if-not-bitstring.1
(deftest count-if-not-nonsimple-vector.17
(flet ((%a (c) (not (eqt c 'a)))
(%f (c) (not (eqt c 'f))))
(let ((a (make-array 13 :initial-contents '(a b c d a e f a e f f a a)
:fill-pointer 9)))
(values (count-if-not #'%a a)
(count-if-not #'%a a :from-end t)
(count-if-not #'%f a)
(count-if-not #'%f a :from-end t)
)))
3 3 1 1)
;;; tests on bit-vectors
(deftest count-if-not-bit-vector.1
(count-if-not #'oddp #*001011101101)
5)
(deftest count-if-not-bitstring.2
(deftest count-if-not-bit-vector.2
(count-if-not #'identity #*001011101101)
0)
(deftest count-if-not-bitstring.3
(deftest count-if-not-bit-vector.3
(count-if-not #'(lambda (x) (break)) #*)
0)
(deftest count-if-not-bitstring.4
(deftest count-if-not-bit-vector.4
(count-if-not #'identity #*001011101101 :key #'zerop)
7)
(deftest count-if-not-bitstring.5
(deftest count-if-not-bit-vector.5
(count-if-not 'not #*001011101101 :key #'zerop)
5)
(deftest count-if-not-bitstring.6
(deftest count-if-not-bit-vector.6
(count-if-not #'not #*001011101101 :key 'zerop)
5)
(deftest count-if-not-bitstring.8
(deftest count-if-not-bit-vector.8
(count-if-not #'identity #*001011101101 :key 'oddp)
5)
(deftest count-if-not-bitstring.10
(deftest count-if-not-bit-vector.10
(count-if-not #'oddp #*001011101101 :key #'1+)
7)
(deftest count-if-not-bitstring.11
(deftest count-if-not-bit-vector.11
(let ((c 0))
(count-if-not #'oddp #*001011101101
:key #'(lambda (x) (+ x (incf c)))))
7)
(deftest count-if-not-bitstring.12
(deftest count-if-not-bit-vector.12
(let ((c 0))
(count-if-not #'oddp #*001011101101
:from-end t
:key #'(lambda (x) (+ x (incf c)))))
5)
(deftest count-if-not-bitstring.13
(deftest count-if-not-bit-vector.13
(count-if-not #'zerop #*0111011011100 :start 2)
7)
(deftest count-if-not-bitstring.14
(deftest count-if-not-bit-vector.14
(count-if-not #'zerop #*0111011011100 :end 7)
5)
(deftest count-if-not-bitstring.15
(deftest count-if-not-bit-vector.15
(count-if-not #'zerop #*0111011011100 :end 7 :start 2)
4)
(deftest count-if-not-bitstring.16
(deftest count-if-not-bit-vector.16
(count-if-not #'zerop #*0111011011100 :end 7 :start 2 :from-end t)
4)
(deftest count-if-not-bit-vector.17
(let ((a (make-array '(10) :initial-contents '(0 0 0 1 1 1 0 1 0 0)
:fill-pointer 5
:element-type 'bit)))
(and (bit-vector-p a)
(values (count-if-not #'zerop a)
(count-if-not #'oddp a)
(count-if-not #'zerop a :from-end t)
(count-if-not #'oddp a :from-end t))))
2 3 2 3)
;;; tests on strings
(deftest count-if-not-string.1
......@@ -382,6 +405,19 @@
"0111011011100" :end 7 :start 2 :from-end t)
4)
(deftest count-if-not-string.17
(flet ((%zerop (c) (eql c #\0))
(%onep (c) (eql c #\1)))
(let ((a (make-array '(10) :initial-contents (coerce "0001110100" 'list)
:fill-pointer 5
:element-type 'character)))
(and (stringp a)
(values (count-if-not #'%zerop a)
(count-if-not #'%onep a)
(count-if-not #'%zerop a :from-end t)
(count-if-not #'%onep a :from-end t)))))
2 3 2 3)
;;; Error tests
(deftest count-if-not-error.1
......
......@@ -183,157 +183,170 @@
(mismatch #(1 1 1 1 1 1 1) #(2 3 3) :from-end t :key 'evenp)
5)
(deftest mismatch-vector.23
(let ((a (make-array '(9) :initial-contents '(1 2 3 4 5 6 7 8 9)
:fill-pointer 5)))
(values
(mismatch '(1 2 3 4 5) a)
(mismatch '(1 2 3 4 5) a :from-end t)
(mismatch '(1 2 3 4) a)
(mismatch '(1 2 3 4 5 6) a)
(mismatch '(6 7 8 9) a :from-end t)
(mismatch '(2 3 4 5) a :from-end t)))
nil nil 4 5 4 0)
;;; tests on bit vectors
(deftest mismatch-bitvector.1
(deftest mismatch-bit-vector.1
(mismatch "" #*111)
0)
(deftest mismatch-bitvector.1a
(deftest mismatch-bit-vector.1a
(mismatch '() #*111)
0)
(deftest mismatch-bitvector.1b
(deftest mismatch-bit-vector.1b
(mismatch "" '(1 1 1))
0)
(deftest mismatch-bitvector.2
(deftest mismatch-bit-vector.2
(mismatch #*1010 #*)
0)
(deftest mismatch-bitvector.2a
(deftest mismatch-bit-vector.2a
(mismatch #*1010 '())
0)
(deftest mismatch-bitvector.2b
(deftest mismatch-bit-vector.2b
(mismatch '(1 0 1 0) #*)
0)
(deftest mismatch-bitvector.3
(deftest mismatch-bit-vector.3
(mismatch #*101 #*101)
nil)
(deftest mismatch-bitvector.4
(deftest mismatch-bit-vector.4
(mismatch #*101 #*100)
2)
(deftest mismatch-bitvector.5
(deftest mismatch-bit-vector.5
(mismatch #*101 #*01 :start1 1)
nil)
(deftest mismatch-bitvector.6
(deftest mismatch-bit-vector.6
(mismatch #*0110 #*0111 :start1 1 :start2 1)
3)
(deftest mismatch-bitvector.7
(deftest mismatch-bit-vector.7
(mismatch #*0110 #*0111 :start1 1 :start2 1 :end1 3 :end2 3)
nil)
(deftest mismatch-bitvector.7a
(deftest mismatch-bit-vector.7a
(mismatch '(0 1 1 0) #*0111 :start1 1 :start2 1 :end1 3 :end2 3)
nil)
(deftest mismatch-bitvector.7b
(deftest mismatch-bit-vector.7b
(mismatch #*0110 '(0 1 1 1) :start1 1 :start2 1 :end1 3 :end2 3)
nil)
(deftest mismatch-bitvector.8
(deftest mismatch-bit-vector.8
(mismatch #*1001 #*0110 :test #'(lambda (x y) (= x (- 1 y))))
nil)
(deftest mismatch-bitvector.8a
(deftest mismatch-bit-vector.8a
(mismatch #*1001 '(5 4 4 5) :test #'(lambda (x y) (= x (- y 4))))
nil)
(deftest mismatch-bitvector.9
(deftest mismatch-bit-vector.9
(mismatch #*1001 '(5 4 17 5) :test #'(lambda (x y) (= x (- y 4))))
2)
(deftest mismatch-bitvector.9a
(deftest mismatch-bit-vector.9a
(mismatch '(5 4 17 5) #*1001 :test #'(lambda (x y) (= y (- x 4))))
2)
(deftest mismatch-bitvector.9b
(deftest mismatch-bit-vector.9b
(mismatch #*0100 #*1001 :test #'(lambda (x y) (= x (- 1 y))))
2)
(deftest mismatch-bitvector.10
(deftest mismatch-bit-vector.10
(mismatch #*1001 '(10 11 4 123) :test-not #'(lambda (x y) (= x (- y 4))))
2)
(deftest mismatch-bitvector.10a
(deftest mismatch-bit-vector.10a
(mismatch #*1001 '(10 11 100 123) :test-not #'(lambda (x y) (= x (- y 4))))
nil)
(deftest mismatch-bitvector.11
(deftest mismatch-bit-vector.11
(mismatch #*1010 '(5 6 17 8) :key #'evenp)
nil)
(deftest mismatch-bitvector.11a
(deftest mismatch-bit-vector.11a
(mismatch '(5 6 17 8) #*1010 :key #'evenp)
nil)
(deftest mismatch-bitvector.11b
(deftest mismatch-bit-vector.11b
(mismatch #*0101 #*1010 :key #'evenp :test-not 'eq)
nil)
(deftest mismatch-bitvector.11c
(deftest mismatch-bit-vector.11c
(mismatch '(5 6 17 8) #*10101 :key #'evenp)
4)
(deftest mismatch-bitvector.11d
(deftest mismatch-bit-vector.11d
(mismatch '(5 6 17 8 100) #*1010 :key #'evenp)
4)
(deftest mismatch-bitvector.12
(deftest mismatch-bit-vector.12
(mismatch #*1010 #*1000 :key 'oddp)
2)
(deftest mismatch-bitvector.12a
(deftest mismatch-bit-vector.12a
(mismatch #*1010 '(5 6 8 8) :key 'oddp)
2)
(deftest mismatch-bitvector.12b
(deftest mismatch-bit-vector.12b
(mismatch '(5 6 8 8) #*1010 :key 'oddp)
2)
(deftest mismatch-bitvector.13
(deftest mismatch-bit-vector.13
(mismatch #*0001 #*0001 :test 'eq)
nil)
(deftest mismatch-bitvector.14
(deftest mismatch-bit-vector.14
(mismatch '#*10001 #*01110 :test-not 'eq)
nil)
(deftest mismatch-bitvector.15
(deftest mismatch-bit-vector.15
(mismatch #*00100010100 #*00110010000)
3)
(deftest mismatch-bitvector.16
(deftest mismatch-bit-vector.16
(mismatch #*00100010100 #*00110010000 :from-end t)
9)
(deftest mismatch-bitvector.17
(deftest mismatch-bit-vector.17
(mismatch #*001 #*0010010 :from-end t)
3)
(deftest mismatch-bitvector.18
(deftest mismatch-bit-vector.18
(mismatch #*0010010 #*001 :from-end t)
7)
(deftest mismatch-bitvector.19
(deftest mismatch-bit-vector.19
(mismatch #*000 #*11111011 :from-end t :test-not 'eq)
1)
(deftest mismatch-bitvector.20
(deftest mismatch-bit-vector.20
(mismatch #*1111111 '(2 3 3) :from-end t :key #'evenp)
5)
(deftest mismatch-bitvector.21
(deftest mismatch-bit-vector.21
(mismatch #*111 #*00000100 :from-end t :test-not #'equal)
1)
(deftest mismatch-bitvector.22
(deftest mismatch-bit-vector.22
(mismatch #*1111111 '(2 3 3) :from-end t :key 'evenp)
5)
......
......@@ -207,6 +207,16 @@
(7 7)
(nil)))
(deftest position-if-not-vector.13
(let ((a (make-array '(10) :initial-contents '(1 2 3 4 5 a b c d e)
:fill-pointer 5)))
(values
(position-if-not #'numberp a)
(position-if-not #'symbolp a)
(position-if-not #'numberp a :from-end t)
(position-if-not #'symbolp a :from-end t)))
nil 0 nil 4)
;;; Bit vector tests
(deftest position-if-not-bit-vector.1
......@@ -309,6 +319,17 @@
(7 7)
(nil)))
(deftest position-if-not-bit-vector.13
(let ((a (make-array '(10) :initial-contents '(1 1 1 1 1 0 0 0 0 0)
:fill-pointer 5
:element-type 'bit)))
(values
(position-if-not #'zerop a)
(position-if-not (complement #'zerop) a)
(position-if-not #'zerop a :from-end t)
(position-if-not (complement #'zerop) a :from-end t)))
0 nil 4 nil)
;;; string tests
(deftest position-if-not-string.1
......@@ -411,6 +432,18 @@
(7 7)
(nil)))
(deftest position-if-not-string.13
(let ((a (make-array '(10) :initial-contents (coerce "55555aaaaa" 'list)
:fill-pointer 5
:element-type 'character)))
(and (stringp a)
(values
(position-if-not #'digit-char-p a)
(position-if-not (complement #'digit-char-p) a)
(position-if-not #'digit-char-p a :from-end t)
(position-if-not (complement #'digit-char-p) a :from-end t))))
nil 0 nil 4)
;;; Error tests
(deftest position-if-not-error.1
......
......@@ -207,6 +207,14 @@
(7 7)
(nil)))
(deftest position-if-vector.11
(let ((a (make-array '(10) :initial-contents '(1 3 1 4 3 1 2 1 8 9)
:fill-pointer 5)))
(flet ((%f (x) (eql x 1)))
(values (position-if #'%f a)
(position-if #'%f a :from-end t))))
0 2)
;;; Bit vector tests
(deftest position-if-bit-vector.1
......@@ -309,6 +317,16 @@
(7 7)
(nil)))
(deftest position-if-bit-vector.13
(let ((a (make-array '(10) :initial-contents '(1 1 1 1 1 0 0 0 0 0)
:fill-pointer 5
:element-type 'bit)))
(values (position-if #'evenp a)
(position-if #'evenp a :from-end 'foo)
(position-if #'oddp a)
(position-if #'oddp a :from-end 'foo)))
nil nil 0 4)
;;; string tests
(deftest position-if-string.1
......@@ -411,6 +429,19 @@
(7 7)
(nil)))
(deftest position-if-string.13
(flet ((%f (c) (eql c #\0))
(%g (c) (eql c #\1)))
(let ((a (make-array '(10) :initial-contents
(coerce "1111100000" 'list())
:fill-pointer 5
:element-type 'character)))
(values (position-if #'%f a)
(position-if #'%f a :from-end 'foo)
(position-if #'%g a)
(position-if #'%g a :from-end 'foo))))
nil nil 0 4)
;;; Error tests
(deftest position-if-error.1
......
......@@ -297,6 +297,22 @@
:start 2 :from-end t)
4)
(deftest position-vector.29
(position 'a (make-array '(10) :initial-contents '(b b b b b a a a a a)
:fill-pointer 5))
nil)
(deftest position-vector.30
(position 'a (make-array '(10) :initial-contents '(b b b b a a a a a a)
:fill-pointer 5))
4)
(deftest position-vector.31
(position 'a (make-array '(10) :initial-contents '(b a b b a a a a a a)
:fill-pointer 5)
:from-end t)
4)
;;; tests on bit vectors
(deftest position-bit-vector.1
......@@ -436,6 +452,38 @@
:start 2 :from-end t)
8)
(deftest position-bit-vector.28
(position 0 (make-array '(10) :initial-contents '(1 1 1 1 1 0 0 0 0 0)
:element-type 'bit
:fill-pointer 5))
nil)
(deftest position-bit-vector.29
(position 0 (make-array '(10) :initial-contents '(1 1 1 1 1 0 0 0 0 0)
:element-type 'bit
:fill-pointer 5)
:from-end t)
nil)
(deftest position-bit-vector.30
(position 0 (make-array '(10) :initial-contents '(1 1 1 1 0 0 0 0 0 0)
:element-type 'bit
:fill-pointer 5))
4)
(deftest position-bit-vector.31
(position 0 (make-array '(10) :initial-contents '(0 1 0 1 0 0 0 0 0 0)
:element-type 'bit
:fill-pointer 5)
:from-end t)
4)
(deftest position-bit-vector.32
(position 0 (make-array '(10) :initial-contents '(1 0 1 1 0 0 0 0 0 0)
:element-type 'bit
:fill-pointer 5))
1)
;;; strings
(deftest position-string.1
......@@ -564,6 +612,32 @@
:start 0 :end 5 :from-end t)
4)
(deftest position-string.25
(position #\a (make-array '(10) :initial-contents (coerce "bbbbbaaaaa" 'list)
:element-type 'character
:fill-pointer 5))
nil)
(deftest position-string.26
(position #\a (make-array '(10) :initial-contents (coerce "bbbbbaaaaa" 'list)
:element-type 'character
:fill-pointer 5)
:from-end t)
nil)
(deftest position-string.27
(position #\a (make-array '(10) :initial-contents (coerce "bbbbaaaaaa" 'list)
:element-type 'character
:fill-pointer 5))
4)
(deftest position-string.28
(position #\a (make-array '(10) :initial-contents (coerce "babbaaaaaa" 'list)
:element-type 'character
:fill-pointer 5)
:from-end t)
4)
;;; Error tests
(deftest position-error.1
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Aug 25 13:06:54 2002
;;;; Contains: Tests for SEARCH on vectors
;;;; Contains: Tests for SEARCH on bit vectors
(in-package :cl-test)
......@@ -143,3 +143,34 @@
:test (complement #'eq))))))
collect pat))
nil)
(deftest search-bitvector.15
(let ((a (make-array '(10) :initial-contents '(0 1 1 0 0 0 1 0 1 1)
:fill-pointer 5
:element-type 'bit)))
(values
(search #*0 a)
(search #*0 a :from-end t)
(search #*01 a)
(search #*01 a :from-end t)
(search #*010 a)
(search #*010 a :from-end t)))
0 4 0 0 nil nil)
(deftest search-bitvector.16
(let ((pat (make-array '(3) :initial-contents '(0 1 0)
:fill-pointer 1))
(a #*01100))
(values
(search pat a)
(search pat a :from-end t)
(progn
(setf (fill-pointer pat) 2)
(search pat a))
(search pat a :from-end t)
(progn
(setf (fill-pointer pat) 3)
(search pat a))
(search pat a :from-end t)))
0 4 0 0 nil nil)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Aug 25 13:06:54 2002
;;;; Contains: Tests for SEARCH on vectors
;;;; Contains: Tests for SEARCH on strings
(in-package :cl-test)
......@@ -130,3 +130,34 @@
:test (complement #'eq))))))
collect pat))
nil)
(deftest search-string.15
(let ((a (make-array '(10) :initial-contents (coerce "abbaaababb" 'list)
:fill-pointer 5
:element-type 'character)))
(values
(search "a" a)
(search "a" a :from-end t)
(search "ab" a)
(search "ab" a :from-end t)
(search "aba" a)
(search "aba" a :from-end t)))
0 4 0 0 nil nil)
(deftest search-string.16
(let ((pat (make-array '(3) :initial-contents '(#\a #\b #\a)
:fill-pointer 1))
(a "abbaa"))
(values
(search pat a)
(search pat a :from-end t)
(progn
(setf (fill-pointer pat) 2)
(search pat a))
(search pat a :from-end t)
(progn
(setf (fill-pointer pat) 3)
(search pat a))
(search pat a :from-end t)))
0 4 0 0 nil nil)
......@@ -145,3 +145,32 @@
:test (complement #'eq))))))
collect pat))
nil)
(deftest search-vector.15
(let ((a (make-array '(10) :initial-contents '(a b b a a a b a b b)
:fill-pointer 5)))
(values
(search '(a) a)
(search '(a) a :from-end t)
(search '(a b) a)
(search '(a b) a :from-end t)
(search '(a b a) a)
(search '(a b a) a :from-end t)))
0 4 0 0 nil nil)
(deftest search-vector.16
(let ((pat (make-array '(3) :initial-contents '(a b a)
:fill-pointer 1))
(a #(a b b a a)))
(values
(search pat a)
(search pat a :from-end t)
(progn
(setf (fill-pointer pat) 2)
(search pat a))
(search pat a :from-end t)
(progn
(setf (fill-pointer pat) 3)
(search pat a))
(search pat a :from-end t)))
0 4 0 0 nil nil)
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