Commit f0e69341 authored by pfdietz's avatar pfdietz

Tests for bit-vector and simple-bit-vector types, vectorp, bit, and sbit. ...

Tests for bit-vector and simple-bit-vector types, vectorp, bit, and sbit.  More vector class-related tests.
parent d116d8ed
......@@ -103,17 +103,17 @@
;; If the array is a vector, check that...
((and (eql rank 1)
(cond
;; It's in type vector
;; ...It's in type vector
((not (typep a 'vector))
:fail-not-vector)
;; If the element type is a subtype of BIT, then it's a
;; ...If the element type is a subtype of BIT, then it's a
;; bit vector...
((and (subtypep 'bit element-type)
(subtypep element-type 'bit)
(or (not (bit-vector-p a))
(not (typep a 'bit-vector))))
:fail-not-bit-vector)
;; If not adjustable, fill pointered, or displaced,
;; ...If not adjustable, fill pointered, or displaced,
;; then it's a simple vector or simple bit vector
;; (if the element-type is appropriate)
((and (not adjustable)
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Jan 26 13:03:22 2003
;;;; Contains: Tests of type BIT-VECTOR
(in-package :cl-test)
(deftest bit-vector.1
(notnot-mv (find-class 'bit-vector))
t)
(deftest bit-vector.2
(notnot-mv (typep #* 'bit-vector))
t)
(deftest bit-vector.3
(notnot-mv (typep #*00101 'bit-vector))
t)
(deftest bit-vector.4
(typep #(0 1 1 1 0 0) 'bit-vector)
nil)
(deftest bit-vector.5
(typep "011100" 'bit-vector)
nil)
(deftest bit-vector.6
(typep 0 'bit-vector)
nil)
(deftest bit-vector.7
(typep 1 'bit-vector)
nil)
(deftest bit-vector.8
(typep nil 'bit-vector)
nil)
(deftest bit-vector.9
(typep 'x 'bit-vector)
nil)
(deftest bit-vector.10
(typep '(0 1 1 0) 'bit-vector)
nil)
(deftest bit-vector.11
(typep (make-array '(2 2) :element-type 'bit
:initial-element 0)
'bit-vector)
nil)
(deftest bit-vector.12
(notnot-mv (typep #* '(bit-vector *)))
t)
(deftest bit-vector.13
(notnot-mv (typep #*01101 '(bit-vector *)))
t)
(deftest bit-vector.14
(notnot-mv (typep #* '(bit-vector 0)))
t)
(deftest bit-vector.15
(typep #*01101 '(bit-vector 0))
nil)
(deftest bit-vector.16
(typep #* '(bit-vector 5))
nil)
(deftest bit-vector.17
(notnot-mv (typep #*01101 '(bit-vector 5)))
t)
;;; Tests of typep on the class named bit-vector
(deftest bit-vector.class.2
(notnot-mv (typep #* (find-class 'bit-vector)))
t)
(deftest bit-vector.class.3
(notnot-mv (typep #*00101 (find-class 'bit-vector)))
t)
(deftest bit-vector.class.4
(typep #(0 1 1 1 0 0) (find-class 'bit-vector))
nil)
(deftest bit-vector.class.5
(typep "011100" (find-class 'bit-vector))
nil)
(deftest bit-vector.class.6
(typep 0 (find-class 'bit-vector))
nil)
(deftest bit-vector.class.7
(typep 1 (find-class 'bit-vector))
nil)
(deftest bit-vector.class.8
(typep nil (find-class 'bit-vector))
nil)
(deftest bit-vector.class.9
(typep 'x (find-class 'bit-vector))
nil)
(deftest bit-vector.class.10
(typep '(0 1 1 0) (find-class 'bit-vector))
nil)
(deftest bit-vector.class.11
(typep (make-array '(2 2) :element-type 'bit
:initial-element 0)
(find-class 'bit-vector))
nil)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Jan 26 13:22:59 2003
;;;; Contains: Tests for accessor BIT
(in-package :cl-test)
(deftest bit.1
(bit #*0010 2)
1)
(deftest bit.2
(let ((a #*00000000))
(loop for i from 0 below (length a)
collect (let ((b (copy-seq a)))
(setf (bit b i) 1)
b)))
(#*10000000
#*01000000
#*00100000
#*00010000
#*00001000
#*00000100
#*00000010
#*00000001))
(deftest bit.3
(let ((a #*11111111))
(loop for i from 0 below (length a)
collect (let ((b (copy-seq a)))
(setf (bit b i) 0)
b)))
(#*01111111
#*10111111
#*11011111
#*11101111
#*11110111
#*11111011
#*11111101
#*11111110))
(deftest bit.4
(let ((a (make-array nil :element-type 'bit :initial-element 0)))
(values
(aref a)
(bit a)
(setf (bit a) 1)
(aref a)
(bit a)))
0 0 1 1 1)
(deftest bit.5
(let ((a (make-array '(1 1) :element-type 'bit :initial-element 0)))
(values
(aref a 0 0)
(bit a 0 0)
(setf (bit a 0 0) 1)
(aref a 0 0)
(bit a 0 0)))
0 0 1 1 1)
(deftest bit.6
(let ((a (make-array '(10 10) :element-type 'bit :initial-element 0)))
(values
(aref a 5 5)
(bit a 5 5)
(setf (bit a 5 5) 1)
(aref a 5 5)
(bit a 5 5)))
0 0 1 1 1)
;;; Check that the fill pointer is ignored
(deftest bit.7
(let ((a (make-array '(10) :initial-contents '(0 1 1 0 0 1 1 1 0 0)
:element-type 'bit
:fill-pointer 5)))
(values
(coerce a 'list)
(loop for i from 0 below 10 collect (bit a i))
(loop for i from 0 below 10
collect (setf (bit a i) (- 1 (bit a i))))
(coerce a 'list)
(loop for i from 0 below 10 collect (bit a i))
(fill-pointer a)))
(0 1 1 0 0)
(0 1 1 0 0 1 1 1 0 0)
(1 0 0 1 1 0 0 0 1 1)
(1 0 0 1 1)
(1 0 0 1 1 0 0 0 1 1)
5)
;;; Check that adjustability is not relevant
(deftest bit.8
(let ((a (make-array '(10) :initial-contents '(0 1 1 0 0 1 1 1 0 0)
:element-type 'bit
:adjustable t)))
(values
(coerce a 'list)
(loop for i from 0 below 10 collect (bit a i))
(loop for i from 0 below 10
collect (setf (bit a i) (- 1 (bit a i))))
(coerce a 'list)
(loop for i from 0 below 10 collect (bit a i))))
(0 1 1 0 0 1 1 1 0 0)
(0 1 1 0 0 1 1 1 0 0)
(1 0 0 1 1 0 0 0 1 1)
(1 0 0 1 1 0 0 0 1 1)
(1 0 0 1 1 0 0 0 1 1))
......@@ -139,6 +139,8 @@
(load "array-as-class.lsp")
(load "simple-array.lsp")
(load "simple-array-t.lsp")
(load "bit-vector.lsp")
(load "simple-bit-vector.lsp")
(load "make-array.lsp")
(load "adjustable-array-p.lsp")
(load "array-displacement.lsp")
......@@ -159,6 +161,9 @@
(load "vector-pop.lsp")
(load "vector-push.lsp")
(load "vector-push-extend.lsp")
(load "vectorp.lsp")
(load "bit.lsp")
(load "sbit.lsp")
;;; Tests of packages
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Jan 26 15:30:31 2003
;;;; Contains: Tests for SBIT
(in-package :cl-test)
(deftest sbit.1
(sbit #*0010 2)
1)
(deftest sbit.2
(let ((a #*00000000))
(loop for i from 0 below (length a)
collect (let ((b (copy-seq a)))
(setf (sbit b i) 1)
b)))
(#*10000000
#*01000000
#*00100000
#*00010000
#*00001000
#*00000100
#*00000010
#*00000001))
(deftest sbit.3
(let ((a #*11111111))
(loop for i from 0 below (length a)
collect (let ((b (copy-seq a)))
(setf (sbit b i) 0)
b)))
(#*01111111
#*10111111
#*11011111
#*11101111
#*11110111
#*11111011
#*11111101
#*11111110))
(deftest sbit.4
(let ((a (make-array nil :element-type 'bit :initial-element 0)))
(values
(aref a)
(sbit a)
(setf (sbit a) 1)
(aref a)
(sbit a)))
0 0 1 1 1)
(deftest sbit.5
(let ((a (make-array '(1 1) :element-type 'bit :initial-element 0)))
(values
(aref a 0 0)
(sbit a 0 0)
(setf (sbit a 0 0) 1)
(aref a 0 0)
(sbit a 0 0)))
0 0 1 1 1)
(deftest sbit.6
(let ((a (make-array '(10 10) :element-type 'bit :initial-element 0)))
(values
(aref a 5 5)
(sbit a 5 5)
(setf (sbit a 5 5) 1)
(aref a 5 5)
(sbit a 5 5)))
0 0 1 1 1)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Jan 26 13:12:07 2003
;;;; Contains: Tests for type SIMPLE-BIT-VECTOR
(in-package :cl-test)
(deftest simple-bit-vector.2
(notnot-mv (typep #* 'simple-bit-vector))
t)
(deftest simple-bit-vector.3
(notnot-mv (typep #*00101 'simple-bit-vector))
t)
(deftest simple-bit-vector.4
(typep #(0 1 1 1 0 0) 'simple-bit-vector)
nil)
(deftest simple-bit-vector.5
(typep "011100" 'simple-bit-vector)
nil)
(deftest simple-bit-vector.6
(typep 0 'simple-bit-vector)
nil)
(deftest simple-bit-vector.7
(typep 1 'simple-bit-vector)
nil)
(deftest simple-bit-vector.8
(typep nil 'simple-bit-vector)
nil)
(deftest simple-bit-vector.9
(typep 'x 'simple-bit-vector)
nil)
(deftest simple-bit-vector.10
(typep '(0 1 1 0) 'simple-bit-vector)
nil)
(deftest simple-bit-vector.11
(typep (make-array '(2 2) :element-type 'bit
:initial-element 0)
'simple-bit-vector)
nil)
(deftest simple-bit-vector.12
(notnot-mv (typep #* '(simple-bit-vector *)))
t)
(deftest simple-bit-vector.13
(notnot-mv (typep #*01101 '(simple-bit-vector *)))
t)
(deftest simple-bit-vector.14
(notnot-mv (typep #* '(simple-bit-vector 0)))
t)
(deftest simple-bit-vector.15
(typep #*01101 '(simple-bit-vector 0))
nil)
(deftest simple-bit-vector.16
(typep #* '(simple-bit-vector 5))
nil)
(deftest simple-bit-vector.17
(notnot-mv (typep #*01101 '(simple-bit-vector 5)))
t)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Jan 26 13:17:05 2003
;;;; Contains: Tests for VECTORP
(in-package :cl-test)
(deftest vectorp.1
(vectorp 1)
nil)
(deftest vectorp.2
(vectorp (1+ most-positive-fixnum))
nil)
(deftest vectorp.3
(vectorp #\a)
nil)
(deftest vectorp.4
(vectorp 10.0)
nil)
(deftest vectorp.5
(vectorp #'(lambda (x y) (cons y x)))
nil)
(deftest vectorp.6
(vectorp '(a b))
nil)
(deftest vectorp.7
(vectorp #0aT)
nil)
(deftest vectorp.8
(vectorp #2a((a b)(c d)))
nil)
(deftest vectorp.9
(notnot-mv (vectorp "abcd"))
t)
(deftest vectorp.10
(notnot-mv (vectorp #*))
t)
(deftest vectorp.11
(notnot-mv (vectorp #*1101))
t)
(deftest vectorp.12
(notnot-mv (vectorp ""))
t)
(deftest vectorp.13
(notnot-mv (vectorp #(1 2 3)))
t)
(deftest vectorp.14
(notnot-mv (vectorp #()))
t)
(deftest vectorp.15
(vectorp #b11010)
nil)
;;; Error tests
(deftest vectorp.error.1
(classify-error (vectorp))
program-error)
(deftest vectorp.error.2
(classify-error (vectorp #() #()))
program-error)
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