Commit f5485058 authored by pfdietz's avatar pfdietz

Add tests for with-hash-table-iterator, sxhash

parent 4b3e98ce
......@@ -12,4 +12,5 @@
(load "remhash.lsp")
(load "clrhash.lsp")
(load "maphash.lsp")
(load "with-hash-table-iterator.lsp")
(load "sxhash.lsp")
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Fri Nov 28 21:18:12 2003
;;;; Contains: Tests of SXHASH
(in-package :cl-test)
(deftest sxhash.1
(loop for x in *universe*
for hash-code = (sxhash x)
unless (typep hash-code '(and unsigned-byte fixnum))
collect x)
nil)
(deftest sxhash.2
(loop for i from 0 below 256
for c = (code-char i)
when (and c
(not (= (sxhash (string c))
(sxhash (string c)))))
collect c)
nil)
(deftest sxhash.3
(=t (sxhash "") (sxhash (copy-seq "")))
t)
(deftest sxhash.4
(loop for bv1 in '(#* #*0 #*1 #*01 #*00 #*10 #*11
#*1100101101100 #*110010101011001011010000111001011)
for bv2 = (copy-seq bv1)
for sx1 = (sxhash bv1)
for sx2 = (sxhash bv2)
always (and (not (eq bv1 bv2))
(equal bv1 bv2)
(typep sx1 '(and unsigned-byte fixnum))
(typep sx2 '(and unsigned-byte fixnum))
(= sx1 sx2)))
t)
(deftest sxhash.5
(let ((s1 "abcd")
(s2 (make-array 10 :element-type 'character
:initial-contents "abcdefghij"
:fill-pointer 4)))
(and (equalt s1 s2)
(=t (sxhash s1) (sxhash s2))))
t)
(deftest sxhash.6
(let ((s1 #*01101)
(s2 (make-array 10 :element-type 'bit
:initial-contents #*0110111101
:fill-pointer 5)))
(and (equalt s1 s2)
(=t (sxhash s1) (sxhash s2))))
t)
(deftest sxhash.7
(let* ((a (make-array 10 :initial-element nil))
(sx1 (sxhash a)))
(setf (aref a 4) 'x)
(let ((sx2 (sxhash a)))
(and (typep sx1 '(and unsigned-byte fixnum))
(eqlt sx1 sx2))))
t)
(deftest sxhash.8
(eqlt (sxhash (make-array 0 :element-type nil))
(sxhash ""))
t)
(deftest sxhash.9
(let ((s1 (make-array 5 :element-type 'base-char :initial-contents "abcde"))
(s2 (copy-seq "abcde")))
(eqlt (sxhash s1) (sxhash s2)))
t)
(deftest sxhash.10
(let ((s1 "abcd")
(s2 (make-array 10 :element-type 'base-char
:initial-contents "abcdefghij"
:fill-pointer 4)))
(and (equalt s1 s2)
(=t (sxhash s1) (sxhash s2))))
t)
(deftest sxhash.11
(let* ((x (cons 'a 'b))
(sx1 (sxhash x))
(sx2 (sxhash '(a . b))))
(setf (car x) 'c)
(let* ((sx3 (sxhash x))
(sx4 (sxhash '(c . b))))
(and (=t sx1 sx2)
(=t sx3 sx4))))
t)
(deftest sxhash.12
(let ((x (1+ most-positive-fixnum))
(y (1+ most-positive-fixnum)))
(=t (sxhash x) (sxhash y)))
t)
(deftest sxhash.13
(let ((sx1 (sxhash (make-symbol "FOO")))
(sx2 (sxhash (make-symbol "FOO"))))
(and (typep sx1 '(and unsigned-byte fixnum))
(eqlt sx1 sx2)))
t)
(deftest sxhash.14
(let ((sx1 (sxhash :foo))
(sx2 (sxhash '#:foo)))
(and (typep sx1 '(and unsigned-byte fixnum))
(eqlt sx1 sx2)))
t)
;;; Error cases
(deftest sxhash.error.1
(classify-error (sxhash))
program-error)
(deftest sxhash.error.2
(classify-error (sxhash nil nil))
program-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Fri Nov 28 20:08:43 2003
;;;; Contains: Tests of WITH-HASH-TABLE-ITERATOR
(in-package :cl-test)
(deftest with-hash-table-iterator.1
(with-hash-table-iterator (x (make-hash-table)))
nil)
(deftest with-hash-table-iterator.2
(with-hash-table-iterator (x (make-hash-table)) (values)))
(deftest with-hash-table-iterator.3
(with-hash-table-iterator (x (make-hash-table)) (values 'a 'b 'c 'd))
a b c d)
(deftest with-hash-table-iterator.4
(with-hash-table-iterator
(%x (make-hash-table))
(%x))
nil)
(deftest with-hash-table-iterator.5
(let ((table (make-hash-table)))
(setf (gethash 'a table) 'b)
(with-hash-table-iterator
(%x table)
(multiple-value-bind (success-p key val)
(%x)
(values (notnot success-p) key val))))
t a b)
(deftest with-hash-table-iterator.6
(let ((table (make-hash-table)))
(setf (gethash 'a table) 'b)
(with-hash-table-iterator
(%x table)
(length (multiple-value-list (%x)))))
3)
(deftest with-hash-table-iterator.7
(let ((keys '("a" "b" "c" "d" "e")))
(loop for test in '(eq eql equal equalp)
for test-fn of-type function = (symbol-function test)
collect
(let ((table (make-hash-table :test test)))
(loop for k in keys
for i from 0
do (setf (gethash k table) i))
(let ((count 0) (found-keys))
(with-hash-table-iterator
(%x table)
(block done
(loop
(multiple-value-bind (success key val)
(%x)
(unless success (return-from done nil))
(incf count)
(push key found-keys)
(assert (= val (position key keys :test test-fn))))))
(and (= count (length keys))
(every test-fn
(sort (remove-duplicates found-keys :test test)
#'string<)
keys)
t))))))
(t t t t))
(deftest with-hash-table-iterator.8
(with-hash-table-iterator
(%x (make-hash-table))
(declare (optimize)))
nil)
(deftest with-hash-table-iterator.9
(with-hash-table-iterator
(%x (make-hash-table))
(macrolet
((expand-%x
(&environment env)
(let ((expanded-form (macroexpand '(%x) env)))
(if (equal expanded-form '(%x)) nil t))))
(expand-%x)))
t)
(deftest with-hash-table-iterator.10
(let ((table (make-hash-table)))
(loop for key from 1 to 100
for val from 101 to 200
do (setf (gethash key table) val))
(let ((pairs nil))
(with-hash-table-iterator
(%x table)
(loop
(multiple-value-bind (success key val)
(%x)
(unless success (return nil))
(remhash key table)
(push (cons key val) pairs))))
(assert (eql (length pairs) 100))
(setq pairs (sort pairs #'(lambda (p1 p2) (< (car p1) (car p2)))))
(values
(hash-table-count table)
(loop
for (key . val) in pairs
for expected-key from 1
for expected-val from 101
always (and (eql key expected-key)
(eql val expected-val))))))
0 t)
(deftest with-hash-table-iterator.11
(let ((table (make-hash-table)))
(loop for key from 1 to 100
for val from 101 to 200
do (setf (gethash key table) val))
(let ((pairs nil))
(with-hash-table-iterator
(%x table)
(loop
(multiple-value-bind (success key val)
(%x)
(unless success (return nil))
(setf (gethash key table) (+ 1000 val))
(push (cons key val) pairs))))
(assert (eql (length pairs) 100))
(setq pairs (sort pairs #'(lambda (p1 p2) (< (car p1) (car p2)))))
(values
(hash-table-count table)
(loop
for (key . val) in pairs
for expected-key from 1
for expected-val from 101
always (and (eql key expected-key)
(eql val expected-val)
(eql (gethash key table) (+ 1000 val))
)))))
100 t)
\ No newline at end of file
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