From f548505897b346e860d45e64db638d33b0d3cb08 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sat, 29 Nov 2003 20:38:03 +0000 Subject: [PATCH] Add tests for with-hash-table-iterator, sxhash --- ansi-tests/load-hash-tables.lsp | 3 +- ansi-tests/sxhash.lsp | 127 +++++++++++++++++++++ ansi-tests/with-hash-table-iterator.lsp | 146 ++++++++++++++++++++++++ 3 files changed, 275 insertions(+), 1 deletion(-) create mode 100644 ansi-tests/sxhash.lsp create mode 100644 ansi-tests/with-hash-table-iterator.lsp diff --git a/ansi-tests/load-hash-tables.lsp b/ansi-tests/load-hash-tables.lsp index 236efe3b..c7c61ef3 100644 --- a/ansi-tests/load-hash-tables.lsp +++ b/ansi-tests/load-hash-tables.lsp @@ -12,4 +12,5 @@ (load "remhash.lsp") (load "clrhash.lsp") (load "maphash.lsp") - +(load "with-hash-table-iterator.lsp") +(load "sxhash.lsp") diff --git a/ansi-tests/sxhash.lsp b/ansi-tests/sxhash.lsp new file mode 100644 index 00000000..e3d8c0a6 --- /dev/null +++ b/ansi-tests/sxhash.lsp @@ -0,0 +1,127 @@ +;-*- 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) diff --git a/ansi-tests/with-hash-table-iterator.lsp b/ansi-tests/with-hash-table-iterator.lsp new file mode 100644 index 00000000..adc6789e --- /dev/null +++ b/ansi-tests/with-hash-table-iterator.lsp @@ -0,0 +1,146 @@ +;-*- 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 -- GitLab