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