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