From 0ac7cdde55cd9f8cfbd999cf7f7b7f96217e9dc9 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sat, 29 Nov 2003 02:01:36 +0000 Subject: [PATCH] Mostly hash table tests; some minor comment changes in rctest. --- ansi-tests/hash-table-aux.lsp | 93 +++++++++++++ ansi-tests/hash-table-count.lsp | 67 +++++++++ ansi-tests/hash-table-rehash-size.lsp | 49 +++++++ ansi-tests/hash-table-rehash-threshold.lsp | 43 ++++++ ansi-tests/hash-table-size.lsp | 22 +++ ansi-tests/hash-table-test.lsp | 52 +++++++ ansi-tests/load-hash-tables.lsp | 10 +- ansi-tests/make-hash-table.lsp | 152 ++++++++++++++++++++- ansi-tests/rctest/generator.lsp | 6 + 9 files changed, 492 insertions(+), 2 deletions(-) create mode 100644 ansi-tests/hash-table-aux.lsp create mode 100644 ansi-tests/hash-table-count.lsp create mode 100644 ansi-tests/hash-table-rehash-size.lsp create mode 100644 ansi-tests/hash-table-rehash-threshold.lsp create mode 100644 ansi-tests/hash-table-size.lsp create mode 100644 ansi-tests/hash-table-test.lsp diff --git a/ansi-tests/hash-table-aux.lsp b/ansi-tests/hash-table-aux.lsp new file mode 100644 index 00000000..88c53ae7 --- /dev/null +++ b/ansi-tests/hash-table-aux.lsp @@ -0,0 +1,93 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Sat Oct 4 09:24:24 2003 +;;;; Contains: Aux. functions for testing hash tables + +(in-package :cl-test) + +(eval-when (:load-toplevel :compile-toplevel :execute) + (compile-and-load "random-aux.lsp")) + +(defparameter *hash-table-test-iters* 1000) + +(defun test-hash-table-1 (&rest args) + (let ((table (apply #'make-hash-table args)) + (test (or (getf args :test) 'eql))) + (assert (member test '(eq eql equal equalp))) + (assert (hash-table-p table)) + (assert (typep table 'hash-table)) + ;; Build a hash table using the arguments in ARGS. + ;; Perform *hash-table-test-iters* iterations of + ;; random hash table operations + (let* ((universe-vec (coerce *universe* 'vector)) + ;; (universe-size (length universe-vec)) + (mapping nil) + (count 0)) + + (loop + for i from 0 below *hash-table-test-iters* + do (assert (eql (hash-table-count table) count)) + do (assert (let ((size (hash-table-size table))) + (and (integerp size) (>= size 0)))) + do + (flet ((%remove-pair + (rpair) + (decf count) + (let ((key (car rpair)) + (expected-value (cdr rpair))) + (multiple-value-bind (value present-p) + (gethash key table) + (assert present-p) + (assert (eql expected-value value)) + (setf mapping + (remove rpair mapping :count 1 :test 'eq))) + (assert (remhash key table)) + (multiple-value-bind (value present-p) + (gethash key table) + (assert (not present-p)) + (assert (null value)) + )))) + + (rcase + (1 ;; Insert + (let* ((new-elem (random-from-seq universe-vec)) + (pair (assoc new-elem mapping :test test))) + (cond + (pair + (multiple-value-bind + (value present-p) + (gethash new-elem table) + (assert present-p) + (assert (eql (cdr pair) value)) + (setf (cdr pair) i + (gethash new-elem table) i))) + (t + (assert + (equal (multiple-value-list (gethash new-elem table)) + '(nil nil))) + (incf count) + (push (cons new-elem i) mapping) + (setf (gethash new-elem table) i))))) + (1 ;; Delete element in the set + (when mapping + (%remove-pair (random-from-seq mapping)))) + (1 ;; Delete random element from universe + (let* ((key (random-from-seq universe-vec)) + (pair (assoc key mapping :test test))) + (cond + (pair (%remove-pair pair)) + (t + ;; Not present -- check that this is true + (assert (equal (multiple-value-list (gethash key table)) + '(nil nil))) + (assert (not (remhash key table))) + (assert (equal (multiple-value-list (gethash key table)) + '(nil nil))))) + )) + )))))) + + + + + + diff --git a/ansi-tests/hash-table-count.lsp b/ansi-tests/hash-table-count.lsp new file mode 100644 index 00000000..d74374ad --- /dev/null +++ b/ansi-tests/hash-table-count.lsp @@ -0,0 +1,67 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Nov 28 05:14:25 2003 +;;;; Contains: Tests of HASH-TABLE-COUNT + +(in-package :cl-test) + +(deftest hash-table-count.1 + (hash-table-count (make-hash-table)) + 0) + +(deftest hash-table-count.2 + (hash-table-count (make-hash-table :test 'eq)) + 0) + +(deftest hash-table-count.3 + (hash-table-count (make-hash-table :test 'eql)) + 0) + +(deftest hash-table-count.4 + (hash-table-count (make-hash-table :test 'equal)) + 0) + +(deftest hash-table-count.5 + (hash-table-count (make-hash-table :test 'equalp)) + 0) + +(deftest hash-table-count.6 + (hash-table-count (make-hash-table :test #'eq)) + 0) + +(deftest hash-table-count.7 + (hash-table-count (make-hash-table :test #'eql)) + 0) + +(deftest hash-table-count.8 + (hash-table-count (make-hash-table :test #'equal)) + 0) + +(deftest hash-table-count.9 + (hash-table-count (make-hash-table :test #'equalp)) + 0) + +(deftest hash-table-count.10 + (hash-table-count (let ((table (make-hash-table))) + (setf (gethash 'x table) 1) + table)) + 1) + +(deftest hash-table-count.11 + (let ((table (make-hash-table))) + (setf (gethash 'x table) 1) + (values (hash-table-count table) + (progn + (remhash 'x table) + (hash-table-count table)))) + 1 0) + +;; This function is mostly tested by calls to test-hash-table-1 + +(deftest hash-table-count.error.1 + (classify-error (hash-table-count)) + program-error) + +(deftest hash-table-count.error.2 + (classify-error (hash-table-count (make-hash-table) nil)) + program-error) diff --git a/ansi-tests/hash-table-rehash-size.lsp b/ansi-tests/hash-table-rehash-size.lsp new file mode 100644 index 00000000..9f8d7c23 --- /dev/null +++ b/ansi-tests/hash-table-rehash-size.lsp @@ -0,0 +1,49 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Nov 28 05:47:24 2003 +;;;; Contains: Tests for HASH-TABLE-REHASH-SIZE + +(in-package :cl-test) + +(deftest hash-table-rehash-size.1 + (typep* (hash-table-rehash-size (make-hash-table)) + '(or (integer 1 *) (float (1.0) *))) + t) + +(deftest hash-table-rehash-size.2 + (loop for test in '(eq eql equal equalp) + unless (typep* (hash-table-rehash-size (make-hash-table :test test)) + '(or (integer 1 *) (float (1.0) *))) + collect test) + nil) + +(deftest hash-table-rehash-size.3 + (loop for test in '(eq eql equal equalp) + for fn = (symbol-function test) + unless (typep* (hash-table-rehash-size (make-hash-table :test fn)) + '(or (integer 1 *) (float (1.0) *))) + collect test) + nil) + +(deftest hash-table-rehash-size.error.1 + (classify-error (hash-table-rehash-size)) + program-error) + +(deftest hash-table-rehash-size.error.2 + (classify-error (hash-table-rehash-size (make-hash-table) nil)) + program-error) + +(deftest hash-table-rehash-size.error.3 + (loop for x in *mini-universe* + unless (hash-table-p x) + unless (eq (eval `(classify-error (hash-table-rehash-size ',x))) + 'type-error) + collect x) + nil) + + + + + + + diff --git a/ansi-tests/hash-table-rehash-threshold.lsp b/ansi-tests/hash-table-rehash-threshold.lsp new file mode 100644 index 00000000..c6d3bca3 --- /dev/null +++ b/ansi-tests/hash-table-rehash-threshold.lsp @@ -0,0 +1,43 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Nov 28 05:52:52 2003 +;;;; Contains: Tests of HASH-TABLE-REHASH-THRESHOLD + +(in-package :cl-test) + +(deftest hash-table-rehash-threshold.1 + (typep* (hash-table-rehash-threshold (make-hash-table)) + '(real 0 1)) + t) + +(deftest hash-table-rehash-threshold.2 + (loop for test in '(eq eql equal equalp) + unless (typep* (hash-table-rehash-threshold (make-hash-table :test test)) + '(real 0 1)) + collect test) + nil) + +(deftest hash-table-rehash-threshold.3 + (loop for test in '(eq eql equal equalp) + for fn = (symbol-function test) + unless (typep* (hash-table-rehash-threshold (make-hash-table :test fn)) + '(real 0 1)) + collect test) + nil) + +(deftest hash-table-rehash-threshold.error.1 + (classify-error (hash-table-rehash-threshold)) + program-error) + +(deftest hash-table-rehash-threshold.error.2 + (classify-error (hash-table-rehash-threshold (make-hash-table) nil)) + program-error) + +(deftest hash-table-rehash-threshold.error.3 + (loop for x in *mini-universe* + unless (hash-table-p x) + unless (eq (eval `(classify-error (hash-table-rehash-threshold ',x))) + 'type-error) + collect x) + nil) + diff --git a/ansi-tests/hash-table-size.lsp b/ansi-tests/hash-table-size.lsp new file mode 100644 index 00000000..8a248ccb --- /dev/null +++ b/ansi-tests/hash-table-size.lsp @@ -0,0 +1,22 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Nov 28 05:23:45 2003 +;;;; Contains: Tests for HASH-TABLE-SIZE + +(in-package :cl-test) + +(deftest hash-table-size.error.1 + (classify-error (hash-table-size)) + program-error) + +(deftest hash-table-size.error.2 + (classify-error (hash-table-size (make-hash-table) nil)) + program-error) + +(deftest hash-table-size.error.3 + (loop for x in *mini-universe* + unless (hash-table-p x) + unless (eq (eval `(classify-error (hash-table-size ',x))) + 'type-error) + collect x) + nil) diff --git a/ansi-tests/hash-table-test.lsp b/ansi-tests/hash-table-test.lsp new file mode 100644 index 00000000..1c8d60fd --- /dev/null +++ b/ansi-tests/hash-table-test.lsp @@ -0,0 +1,52 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Fri Nov 28 05:56:22 2003 +;;;; Contains: Tests for HASH-TABLE-TEST + +(in-package :cl-test) + +(deftest hash-table-test.1 + (hash-table-test (make-hash-table)) + eql) + +(deftest hash-table-test.2 + (loop for test in '(eq eql equal equalp) + unless (eq (hash-table-test (make-hash-table :test test)) test) + collect test) + nil) + +(deftest hash-table-test.3 + (loop for test in '(eq eql equal equalp) + unless (eq (hash-table-test (make-hash-table + :test (symbol-function test))) + test) + collect test) + nil) + +(deftest hash-table-test.4 + (loop for test in '(eq eql equal equalp) + unless (eq (hash-table-test (make-hash-table + :test (eval `(function ,test)))) + test) + collect test) + nil) + +;;; Error cases + +(deftest hash-table-test.error.1 + (classify-error (hash-table-test)) + program-error) + +(deftest hash-table-test.error.2 + (classify-error (hash-table-test (make-hash-table) nil)) + program-error) + +(deftest hash-table-test.error.3 + (loop for x in *mini-universe* + unless (hash-table-p x) + unless (eq (eval `(classify-error (hash-table-test ',x))) + 'type-error) + collect x) + nil) + + diff --git a/ansi-tests/load-hash-tables.lsp b/ansi-tests/load-hash-tables.lsp index b0f2899b..47b5bdae 100644 --- a/ansi-tests/load-hash-tables.lsp +++ b/ansi-tests/load-hash-tables.lsp @@ -1,3 +1,11 @@ +(compile-and-load "hash-table-aux.lsp") + (load "hash-table.lsp") (load "make-hash-table.lsp") -(load "hash-table-p.lsp") \ No newline at end of file +(load "hash-table-p.lsp") +(load "hash-table-count.lsp") +(load "hash-table-size.lsp") +(load "hash-table-rehash-size.lsp") +(load "hash-table-rehash-threshold.lsp") +(load "hash-table-test.lsp") +(load "gethash.lsp") diff --git a/ansi-tests/make-hash-table.lsp b/ansi-tests/make-hash-table.lsp index db6e7a37..8b0e0bc0 100644 --- a/ansi-tests/make-hash-table.lsp +++ b/ansi-tests/make-hash-table.lsp @@ -5,6 +5,9 @@ (in-package :cl-test) +;; (eval-when (:load-toplevel :compile-toplevel :execute) +;; (compile-and-load "hash-table-aux.lsp")) + (deftest make-hash-table.1 (let ((ht (make-hash-table))) (values @@ -93,6 +96,153 @@ (hash-table-count ht))) t t 0) +(deftest make-hash-table.12 + (let ((ht (make-hash-table :rehash-size 1))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.13 + (let ((ht (make-hash-table :rehash-size 1000))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.14 + (let ((ht (make-hash-table :rehash-size (+ 1.0f0 single-float-epsilon)))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.15 + (let ((ht (make-hash-table :rehash-size 2.0))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.16 + (let ((ht (make-hash-table :rehash-threshold 0))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.17 + (let ((ht (make-hash-table :rehash-threshold 0.0s0))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.18 + (let ((ht (make-hash-table :rehash-threshold 0.0f0))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.19 + (let ((ht (make-hash-table :rehash-threshold 0.0d0))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.20 + (let ((ht (make-hash-table :rehash-threshold 0.0l0))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.21 + (let ((ht (make-hash-table :rehash-threshold 1/2))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.22 + (let ((ht (make-hash-table :rehash-threshold 0.1s0))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.23 + (let ((ht (make-hash-table :rehash-threshold 0.2f0))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.24 + (let ((ht (make-hash-table :rehash-threshold 0.8d0))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.25 + (let ((ht (make-hash-table :rehash-threshold 0.99f0))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.26 + (let ((ht (make-hash-table :rehash-threshold least-positive-short-float))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.27 + (let ((ht (make-hash-table :rehash-threshold least-positive-single-float))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.28 + (let ((ht (make-hash-table :rehash-threshold least-positive-double-float))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + +(deftest make-hash-table.29 + (let ((ht (make-hash-table :rehash-threshold least-positive-long-float))) + (values + (notnot (typep ht 'hash-table)) + (notnot (hash-table-p ht)) + (hash-table-count ht))) + t t 0) + + + + @@ -104,4 +254,4 @@ - + \ No newline at end of file diff --git a/ansi-tests/rctest/generator.lsp b/ansi-tests/rctest/generator.lsp index a7484f88..79d05222 100644 --- a/ansi-tests/rctest/generator.lsp +++ b/ansi-tests/rctest/generator.lsp @@ -12,6 +12,8 @@ for those classes.") (defgeneric prototype (class) + ;; Map a class to a prototype instance of the class. Cache using + ;; *prototype-class-table*. (:method ((class standard-class) &aux (name (class-name class))) (or (gethash name *prototype-class-table*) (setf (gethash name *prototype-class-table*) @@ -19,6 +21,10 @@ (:method ((class symbol)) (prototype (find-class class)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Generators are objects that are used to create random instances. + (defclass generator () ()) (defclass composite-generator (generator) -- GitLab