;;;; While most of SBCL is derived from the CMU CL system, the test
;;;; files (like this one) were written from scratch after the fork
;;;; from CMU CL.
-;;;;
+;;;;
;;;; This software is in the public domain and is provided with
;;;; absolutely no warranty. See the COPYING and CREDITS files for
;;;; more information.
(in-package :cl-user)
+(use-package :test-util)
+(use-package :assertoid)
+
(defstruct foo)
(defstruct bar x y)
(declare (notinline complex float coerce + - expt))
(flet ((make-sxhash-subtests ()
(list (cons 0 1)
- (list 0 1)
- (cons 1 0)
- (cons (cons 1 0) (cons 0 0))
- (cons (list 1 0) (list 0 0))
- (list (cons 1 0) (list 0 0))
- (list (cons 0 1) (list 0 0))
- (list (cons 0 0) (cons 1 0))
- (list (cons 0 0) (cons 0 1))
-
- 44 (float 44) (coerce 44 'double-float)
- -44 (float -44) (coerce -44 'double-float)
- 0 (float 0) (coerce 0 'double-float)
- -0 (- (float 0)) (- (coerce 0 'double-float))
- -121 (float -121) (coerce -121 'double-float)
- 3/4 (float 3/4) (coerce 3/4 'double-float)
- -3/4 (float -3/4) (coerce -3/4 'double-float)
- 45 (float 45) (coerce 45 'double-float)
- 441/10 (float 441/10) (coerce (float 441/10) 'double-float)
-
- (expt 2 33) (expt 2.0 33) (expt 2.0d0 33)
- (- (expt 1/2 50)) (- (expt 0.5 50)) (- (expt 0.5d0 50))
- (+ (expt 1/2 50)) (+ (expt 0.5 50)) (+ (expt 0.5d0 50))
-
- (complex 1.0 2.0) (complex 1.0d0 2.0)
- (complex 1.5 -3/2) (complex 1.5 -1.5d0)
-
- #\x #\X #\*))
- (make-psxhash-extra-subtests ()
- (list (copy-seq "")
- (copy-seq #*)
- (copy-seq #())
- (copy-seq ())
- (copy-seq '(()))
- (copy-seq #(()))
- (copy-seq '(#()))
- (make-array 3 :fill-pointer 0)
- (make-array 7 :fill-pointer 0 :element-type 'bit)
- (make-array 8 :fill-pointer 0 :element-type 'character)
- (vector (cons 1 0) (cons 0 0))
- (vector (cons 0 1) (cons 0 0))
- (vector (cons 0 0) (cons 1 0))
- (vector (cons 0 0) (cons 0 1))
- (vector (cons 1 0) (cons 0 0))
- (vector (cons 0 1) (cons 0 0))
- (vector (list 0 0) (cons 1 0))
- (vector (list 0 0) (list 0 1))
- (vector (vector 1 0) (list 0 0))
- (vector (vector 0 1) (list 0 0))
- (vector (vector 0 0) (list 1 0))
- (vector (vector 0 0) (list 0 1))
- (vector #*00 #*10)
- (vector (vector 0 0) (list 0 1.0d0))
- (vector (vector -0.0d0 0) (list 1.0 0))
- (vector 1 0 1 0)
- (vector 0 0 0)
- (copy-seq #*1010)
- (copy-seq #*000)
- (replace (make-array 101
- :element-type 'bit
- :fill-pointer 4)
- #*1010)
- (replace (make-array 14
- :element-type '(unsigned-byte 8)
- :fill-pointer 3)
- #*000)
- (replace (make-array 14
- :element-type t
- :fill-pointer 3)
- #*000)
- (copy-seq "abc")
- (copy-seq "ABC")
- (copy-seq "aBc")
- (copy-seq "abcc")
- (copy-seq "1001")
- 'abc
- (vector #\a #\b #\c)
- (vector 'a 'b 'c)
- (vector "A" 'b 'c)
- (replace (make-array 14
- :element-type 'character
- :fill-pointer 3)
- "aBc")
- (replace (make-array 11
- :element-type 'character
- :fill-pointer 4)
- "1001")
- (replace (make-array 12
- :element-type 'bit
- :fill-pointer 4)
- #*1001)
- (replace (make-array 13
- :element-type t
- :fill-pointer 4)
- "1001")
- (replace (make-array 13
- :element-type t
- :fill-pointer 4)
- #*1001)
- ;; FIXME: What about multi-dimensional arrays, hmm?
-
- (make-hash-table)
- (make-hash-table :test 'equal)
-
- (make-foo)
- (make-bar)
- (make-bar :x (list 1))
- (make-bar :y (list 1))))
- (t->boolean (x) (if x t nil)))
+ (list 0 1)
+ (cons 1 0)
+ (cons (cons 1 0) (cons 0 0))
+ (cons (list 1 0) (list 0 0))
+ (list (cons 1 0) (list 0 0))
+ (list (cons 0 1) (list 0 0))
+ (list (cons 0 0) (cons 1 0))
+ (list (cons 0 0) (cons 0 1))
+
+ 44 (float 44) (coerce 44 'double-float)
+ -44 (float -44) (coerce -44 'double-float)
+ 0 (float 0) (coerce 0 'double-float)
+ -0 (- (float 0)) (- (coerce 0 'double-float))
+ -121 (float -121) (coerce -121 'double-float)
+ 3/4 (float 3/4) (coerce 3/4 'double-float)
+ -3/4 (float -3/4) (coerce -3/4 'double-float)
+ 45 (float 45) (coerce 45 'double-float)
+ 441/10 (float 441/10) (coerce (float 441/10) 'double-float)
+
+ (expt 2 33) (expt 2.0 33) (expt 2.0d0 33)
+ (- (expt 1/2 50)) (- (expt 0.5 50)) (- (expt 0.5d0 50))
+ (+ (expt 1/2 50)) (+ (expt 0.5 50)) (+ (expt 0.5d0 50))
+
+ (complex 1.0 2.0) (complex 1.0d0 2.0)
+ (complex 1.5 -3/2) (complex 1.5 -1.5d0)
+
+ #\x #\X #\*
+
+ (copy-seq "foo") (copy-seq "foobar") (copy-seq "foobarbaz")
+
+ (copy-seq #*)
+ (copy-seq #*0) (copy-seq #*1)
+ (copy-seq #*00) (copy-seq #*10)
+ (copy-seq #*01) (copy-seq #*11)
+ (copy-seq #*10010) (copy-seq #*100101) (bit-not #*01101)
+ (make-array 6 :fill-pointer 6
+ :element-type 'bit :initial-contents #*100101)
+
+ #'allocate-instance #'no-applicable-method))
+ (make-psxhash-extra-subtests ()
+ (list (copy-seq "")
+ (copy-seq #*)
+ (copy-seq #())
+ (copy-seq ())
+ (copy-seq '(()))
+ (copy-seq #(()))
+ (copy-seq '(#()))
+ (make-array 3 :fill-pointer 0)
+ (make-array 7 :fill-pointer 0 :element-type 'bit)
+ (make-array 8 :fill-pointer 0 :element-type 'character)
+ (vector (cons 1 0) (cons 0 0))
+ (vector (cons 0 1) (cons 0 0))
+ (vector (cons 0 0) (cons 1 0))
+ (vector (cons 0 0) (cons 0 1))
+ (vector (cons 1 0) (cons 0 0))
+ (vector (cons 0 1) (cons 0 0))
+ (vector (list 0 0) (cons 1 0))
+ (vector (list 0 0) (list 0 1))
+ (vector (vector 1 0) (list 0 0))
+ (vector (vector 0 1) (list 0 0))
+ (vector (vector 0 0) (list 1 0))
+ (vector (vector 0 0) (list 0 1))
+ (vector #*00 #*10)
+ (vector (vector 0 0) (list 0 1.0d0))
+ (vector (vector -0.0d0 0) (list 1.0 0))
+ (vector 1 0 1 0)
+ (vector 0 0 0)
+ (copy-seq #*1010)
+ (copy-seq #*000)
+ (replace (make-array 101
+ :element-type 'bit
+ :fill-pointer 4)
+ #*1010)
+ (replace (make-array 14
+ :element-type '(unsigned-byte 8)
+ :fill-pointer 3)
+ #*000)
+ (replace (make-array 14
+ :element-type t
+ :fill-pointer 3)
+ #*000)
+ (copy-seq "abc")
+ (copy-seq "ABC")
+ (copy-seq "aBc")
+ (copy-seq "abcc")
+ (copy-seq "1001")
+ 'abc
+ (vector #\a #\b #\c)
+ (vector 'a 'b 'c)
+ (vector "A" 'b 'c)
+ (replace (make-array 14
+ :element-type 'character
+ :fill-pointer 3)
+ "aBc")
+ (replace (make-array 11
+ :element-type 'character
+ :fill-pointer 4)
+ "1001")
+ (replace (make-array 12
+ :element-type 'bit
+ :fill-pointer 4)
+ #*1001)
+ (replace (make-array 13
+ :element-type t
+ :fill-pointer 4)
+ "1001")
+ (replace (make-array 13
+ :element-type t
+ :fill-pointer 4)
+ #*1001)
+ ;; FIXME: What about multi-dimensional arrays, hmm?
+
+ (make-hash-table)
+ (make-hash-table :test 'equal)
+
+ (make-foo)
+ (make-bar)
+ (make-bar :x (list 1))
+ (make-bar :y (list 1))))
+ (t->boolean (x) (if x t nil)))
(let* (;; Note:
- ;; * The APPEND noise here is to help more strenuously test
- ;; not-EQ-but-EQUAL and not-EQ-but-EQUALP cases.
- ;; * It seems not to be worth the hassle testing SXHASH on
- ;; values whose structure isn't understood by EQUAL, since
- ;; we get too many false positives "SXHASHes are equal even
- ;; though values aren't EQUAL, what a crummy hash function!"
- ;; FIXME: Or am I misunderstanding the intent of the
- ;; the SXHASH specification? Perhaps SXHASH is supposed to
- ;; descend into the structure of objects even when EQUAL
- ;; doesn't, in order to avoid hashing together things which
- ;; are guaranteed not to be EQUAL? The definition of SXHASH
- ;; seems to leave this completely unspecified: should
- ;; "well-distributed" depend on substructure that EQUAL
- ;; ignores? For our internal hash tables, the stricter
- ;; descend-into-the-structure behavior might improve
- ;; performance even though it's not specified by ANSI. But
- ;; is it reasonable for users to expect it? Hmm..
- (sxhash-tests (append (make-sxhash-subtests)
- (make-sxhash-subtests)))
- (psxhash-tests (append sxhash-tests
- (make-psxhash-extra-subtests)
- (make-psxhash-extra-subtests))))
+ ;; * The APPEND noise here is to help more strenuously test
+ ;; not-EQ-but-EQUAL and not-EQ-but-EQUALP cases.
+ ;; * It seems not to be worth the hassle testing SXHASH on
+ ;; values whose structure isn't understood by EQUAL, since
+ ;; we get too many false positives "SXHASHes are equal even
+ ;; though values aren't EQUAL, what a crummy hash function!"
+ ;; FIXME: Or am I misunderstanding the intent of the
+ ;; the SXHASH specification? Perhaps SXHASH is supposed to
+ ;; descend into the structure of objects even when EQUAL
+ ;; doesn't, in order to avoid hashing together things which
+ ;; are guaranteed not to be EQUAL? The definition of SXHASH
+ ;; seems to leave this completely unspecified: should
+ ;; "well-distributed" depend on substructure that EQUAL
+ ;; ignores? For our internal hash tables, the stricter
+ ;; descend-into-the-structure behavior might improve
+ ;; performance even though it's not specified by ANSI. But
+ ;; is it reasonable for users to expect it? Hmm..
+ (sxhash-tests (append (make-sxhash-subtests)
+ (make-sxhash-subtests)))
+ (psxhash-tests (append sxhash-tests
+ (make-psxhash-extra-subtests)
+ (make-psxhash-extra-subtests))))
;; Check that SXHASH compiler transforms give the same results
;; as the out-of-line version of SXHASH.
(let* ((fundef `(lambda ()
- (list ,@(mapcar (lambda (value)
- `(sxhash ',value))
- sxhash-tests))))
- (fun (compile nil fundef)))
- (assert (equal (funcall fun)
- (mapcar #'sxhash sxhash-tests))))
+ (list ,@(mapcar (lambda (value)
+ `(sxhash ',value))
+ sxhash-tests))))
+ (fun (compile nil fundef)))
+ (assert (equal (funcall fun)
+ (mapcar #'sxhash sxhash-tests))))
;; Note: The tests for SXHASH-equality iff EQUAL and
;; PSXHASH-equality iff EQUALP could fail because of an unlucky
;; random collision. That's not very likely (since there are
;; that the SXHASH distribution changes, not once every time the
;; tests are run.)
(dolist (i sxhash-tests)
- (unless (typep (sxhash i) '(and fixnum unsigned-byte))
- (error "bad SXHASH behavior for ~S" i))
- (dolist (j sxhash-tests)
- (unless (eq (t->boolean (equal i j))
- (t->boolean (= (sxhash i) (sxhash j))))
- ;; (If you get a surprising failure here, maybe you were
- ;; just very unlucky; see the notes above.)
- (error "bad SXHASH behavior for ~S ~S" i j))))
+ (declare (notinline funcall))
+ (unless (typep (funcall #'sxhash i) '(and fixnum unsigned-byte))
+ (error "bad SXHASH behavior for ~S" i))
+ (dolist (j sxhash-tests)
+ (unless (or (eq (t->boolean (equal i j))
+ (t->boolean (= (sxhash i) (sxhash j))))
+ (and (typep i 'number)
+ (typep j 'number)
+ (= i j)
+ (subtypep (type-of i) (type-of j))
+ (subtypep (type-of j) (type-of i))))
+ ;; (If you get a surprising failure here, maybe you were
+ ;; just very unlucky; see the notes above.)
+ (error "bad SXHASH behavior for ~S ~S" i j))))
(dolist (i psxhash-tests)
- (unless (typep (sb-int:psxhash i) '(and fixnum unsigned-byte))
- (error "bad PSXHASH behavior for ~S" i))
- (dolist (j psxhash-tests)
- (unless (eq (t->boolean (equalp i j))
- (t->boolean (= (sb-int:psxhash i) (sb-int:psxhash j))))
- ;; (If you get a surprising failure here, maybe you were
- ;; just very unlucky; see the notes above.)
- (error "bad PSXHASH behavior for ~S ~S" i j))))
+ (unless (typep (sb-int:psxhash i) '(and fixnum unsigned-byte))
+ (error "bad PSXHASH behavior for ~S" i))
+ (dolist (j psxhash-tests)
+ (unless (eq (t->boolean (equalp i j))
+ (t->boolean (= (sb-int:psxhash i) (sb-int:psxhash j))))
+ ;; (If you get a surprising failure here, maybe you were
+ ;; just very unlucky; see the notes above.)
+ (error "bad PSXHASH behavior for ~S ~S" i j))))
)))
;;; As of sbcl-0.6.12.10, writing hash tables readably should work.
(original-keys '(1 10 11 400030002 -100000000)))
(dolist (key original-keys)
(setf (gethash key original-ht)
- (expt key 4)))
+ (expt key 4)))
(let* ((written-ht (with-output-to-string (s)
- (write original-ht :stream s :readably t)))
- (read-ht (with-input-from-string (s written-ht)
- (read s))))
+ (write original-ht :stream s :readably t)))
+ (read-ht (with-input-from-string (s written-ht)
+ (read s))))
(assert (= (hash-table-count read-ht)
- (hash-table-count original-ht)
- (length original-keys)))
+ (hash-table-count original-ht)
+ (length original-keys)))
(assert (eql (hash-table-test original-ht) (hash-table-test read-ht)))
(assert (eql (hash-table-size original-ht) (hash-table-size read-ht)))
(dolist (key original-keys)
(assert (eql (gethash key read-ht)
- (gethash key original-ht))))))
+ (gethash key original-ht))))))
+
+;;; NIL is both SYMBOL and LIST
+(dolist (fun '(sxhash sb-impl::psxhash))
+ (assert (= (eval `(,fun nil))
+ (funcall fun nil)
+ (funcall (compile nil `(lambda (x)
+ (declare (symbol x))
+ (,fun x)))
+ nil)
+ (funcall (compile nil `(lambda (x)
+ (declare (list x))
+ (,fun x)))
+ nil)
+ (funcall (compile nil `(lambda (x)
+ (declare (null x))
+ (,fun x)))
+ nil))))
+
+;;; This test works reliably on non-conservative platforms and
+;;; somewhat reliably on conservative platforms with threads.
+(progn
+
+(defparameter *ht* nil)
+
+(defvar *cons-here*)
+
+(declaim (notinline args))
+(defun take (&rest args)
+ (declare (ignore args)))
+
+(defmacro alloc (&body body)
+ "Execute BODY and try to reduce the chance of leaking a conservative root."
+ #-sb-thread
+ `(multiple-value-prog1
+ (progn ,@body)
+ (loop repeat 20000 do (setq *cons-here* (cons nil nil)))
+ ;; KLUDGE: Clean the argument passing regs.
+ (apply #'take (loop repeat 36 collect #'cons)))
+ #+sb-thread
+ (let ((values (gensym))
+ (sem (gensym)))
+ `(let ((,sem (sb-thread::make-semaphore))
+ ,values)
+ (make-join-thread (lambda ()
+ (setq ,values
+ (multiple-value-list (progn ,@body)))
+ (sb-thread::signal-semaphore ,sem)))
+ (sb-thread::wait-on-semaphore ,sem)
+ (values-list ,values))))
+
+(with-test (:name (:hash-table :weakness :eql :numbers) :skipped-on '(and :c-stack-is-control-stack (not :sb-thread)))
+ (flet ((random-number ()
+ (random 1000)))
+ (loop for weakness in '(nil :key :value :key-and-value :key-or-value) do
+ (let* ((ht (make-hash-table :weakness weakness))
+ (n (alloc (loop repeat 1000
+ count (let ((key (random-number)))
+ (if (gethash key ht)
+ (setf (gethash key ht)
+ (random-number))))))))
+ (gc :full t)
+ (gc :full t)
+ (assert (= n (hash-table-count ht)))))))
+
+(defun add-removable-stuff (ht &key (n 100) (size 10))
+ (flet ((unique-object ()
+ (make-array size :fill-pointer 0)))
+ (loop for i below n do
+ (multiple-value-bind (key value)
+ (ecase (hash-table-weakness ht)
+ ((:key) (values (unique-object) i))
+ ((:value) (values i (unique-object)))
+ ((:key-and-value)
+ (if (zerop (random 2))
+ (values (unique-object) i)
+ (values i (unique-object))))
+ ((:key-or-value)
+ (values (unique-object) (unique-object))))
+ (setf (gethash key ht) value)))
+ (values)))
+
+(defun print-ht (ht &optional (stream t))
+ (format stream "Weakness: ~S~%" (sb-impl::hash-table-weakness ht))
+ (format stream "Table: ~S~%" (sb-impl::hash-table-table ht))
+ (format stream "Next: ~S~%" (sb-impl::hash-table-next-vector ht))
+ (format stream "Index: ~S~%" (sb-impl::hash-table-index-vector ht))
+ (format stream "Hash: ~S~%" (sb-impl::hash-table-hash-vector ht))
+ (force-output stream))
+
+(with-test (:name (:hash-table :weakness :removal) :skipped-on '(and :c-stack-is-control-stack (not :sb-thread)))
+ (loop for test in '(eq eql equal equalp) do
+ (format t "test: ~A~%" test)
+ (loop for weakness in '(:key :value :key-and-value :key-or-value)
+ do
+ (format t "weakness: ~A~%" weakness)
+ (let ((ht (make-hash-table :test 'equal :weakness weakness)))
+ (alloc (add-removable-stuff ht :n 117 :size 1))
+ (loop for i upfrom 0
+ do (format t "~A. count: ~A~%" i (hash-table-count ht))
+ (force-output)
+ until (zerop (hash-table-count ht))
+ do
+ (when (= i 10)
+ (print-ht ht)
+ #-(or x86 x86-64)
+ (assert nil)
+ ;; With conservative gc the test may not be
+ ;; bullet-proof so it's not an outright
+ ;; failure but a warning.
+ #+(or x86 x86-64)
+ (progn
+ (warn "Weak hash removal test failed for weakness ~A"
+ weakness)
+ (return)))
+ (gc :full t))))))
+
+(with-test (:name (:hash-table :weakness :string-interning) :skipped-on '(and :c-stack-is-control-stack (not :sb-thread)))
+ (let ((ht (make-hash-table :test 'equal :weakness :key))
+ (s "a"))
+ (setf (gethash s ht) s)
+ (assert (eq (gethash s ht) s))
+ (assert (eq (gethash (copy-seq s) ht) s))))
+
+;;; see if hash_vector is not written when there is none ...
+(with-test (:name (:hash-table :weakness :eq) :skipped-on '(and :c-stack-is-control-stack (not :sb-thread)))
+ (loop repeat 10 do
+ (let ((index (random 2000)))
+ (let ((first (+ most-positive-fixnum (mod (* index 31) 9)))
+ (n 50000))
+ (let ((hash-table (make-hash-table :weakness :key :test 'eq)))
+ (dotimes (i n)
+ (setf (gethash (+ first i) hash-table) i))
+ hash-table)))))
+
+;; used to crash in gc
+(with-test (:name (:hash-table :weakness :keep) :skipped-on '(and :c-stack-is-control-stack (not :sb-thread)))
+ (loop repeat 2 do
+ (let ((h1 (make-hash-table :weakness :key :test #'equal))
+ (keep ()))
+ (loop for i from 0 to 1000
+ for key = i
+ for value = (make-array 10000 :fill-pointer 0)
+ do
+ (push value keep)
+ (setf (gethash key h1) value))
+ (sb-ext:gc :full t))))
+
+)
+
+;;; DEFINE-HASH-TABLE-TEST
+
+(defstruct custom-hash-key name)
+(defun custom-hash-test (x y)
+ (equal (custom-hash-key-name x)
+ (custom-hash-key-name y)))
+(defun custom-hash-hash (x)
+ (sxhash (custom-hash-key-name x)))
+(define-hash-table-test custom-hash-test custom-hash-hash)
+(with-test (:name :define-hash-table-test.1)
+ (let ((table (make-hash-table :test 'custom-hash-test)))
+ (setf (gethash (make-custom-hash-key :name "foo") table) :foo)
+ (setf (gethash (make-custom-hash-key :name "bar") table) :bar)
+ (assert (eq :foo (gethash (make-custom-hash-key :name "foo") table)))
+ (assert (eq :bar (gethash (make-custom-hash-key :name "bar") table)))
+ (assert (eq 'custom-hash-test (hash-table-test table))))
+ (let ((table (make-hash-table :test #'custom-hash-test)))
+ (setf (gethash (make-custom-hash-key :name "foo") table) :foo)
+ (setf (gethash (make-custom-hash-key :name "bar") table) :bar)
+ (assert (eq :foo (gethash (make-custom-hash-key :name "foo") table)))
+ (assert (eq :bar (gethash (make-custom-hash-key :name "bar") table)))
+ (assert (eq 'custom-hash-test (hash-table-test table)))))
+
+
+(defun head-eql (x y)
+ (every #'eql (subseq x 0 3) (subseq y 0 3)))
+(define-hash-table-test head-eql
+ (lambda (x)
+ (logand most-positive-fixnum
+ (reduce #'+ (map 'list #'sxhash (subseq x 0 3))))))
+(with-test (:name :define-hash-table-test.2)
+ (let ((table (make-hash-table :test 'head-eql)))
+ (setf (gethash #(1 2 3 4) table) :|123|)
+ (setf (gethash '(2 3 4 7) table) :|234|)
+ (setf (gethash "foobar" table) :foo)
+ (assert (eq :|123| (gethash '(1 2 3 ! 6) table)))
+ (assert (eq :|234| (gethash #(2 3 4 0 2 1 a) table)))
+ (assert (eq :foo (gethash '(#\f #\o #\o 1 2 3) table)))
+ (assert (eq 'head-eql (hash-table-test table))))
+ (let ((table (make-hash-table :test #'head-eql)))
+ (setf (gethash #(1 2 3 4) table) :|123|)
+ (setf (gethash '(2 3 4 7) table) :|234|)
+ (setf (gethash "foobar" table) :foo)
+ (assert (eq :|123| (gethash '(1 2 3 ! 6) table)))
+ (assert (eq :|234| (gethash #(2 3 4 0 2 1 a) table)))
+ (assert (eq :foo (gethash '(#\f #\o #\o 1 2 3) table)))
+ (assert (eq 'head-eql (hash-table-test table)))))
+
+(with-test (:name :make-hash-table/hash-fun)
+ (let ((table (make-hash-table
+ :test #'=
+ :hash-function (lambda (x)
+ (sxhash (coerce (abs x) 'double-float))))))
+ (incf (gethash 1 table 0))
+ (incf (gethash 1.0f0 table))
+ (incf (gethash 1.0d0 table))
+ (incf (gethash (complex 1.0f0 0.0f0) table))
+ (incf (gethash (complex 1.0d0 0.0d0) table))
+ (assert (= 5 (gethash 1 table)))
+ (assert (eq '= (hash-table-test table)))))
;;; success
-(quit :unix-status 104)
projects / sbcl.git / blobdiff