tests/hash.pure.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; While most of SBCL is derived from the CMU CL system, the test
   5 ;;;; files (like this one) were written from scratch after the fork
   6 ;;;; from CMU CL.
   7 ;;;;
   8 ;;;; This software is in the public domain and is provided with
   9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  10 ;;;; more information.
  11
  12 (in-package :cl-user)
  13
  14 ;;; +MAGIC-HASH-VECTOR-VALUE+ is used to mark empty entries in the slot
  15 ;;; HASH-VECTOR of hash tables. It must be a value outside of the range
  16 ;;; of SXHASH. The range of SXHASH is the non-negative fixnums.
  17 (assert (not (typep sb-impl::+magic-hash-vector-value+
  18                     '(and fixnum unsigned-byte))))
  19
  20 ;;; The return value of SXHASH on non-string/bitvector arrays should not
  21 ;;; change when the contents of the array change.
  22 (let* ((a (make-array '(1) :initial-element 1))
  23        (sxhash (sxhash a))
  24        (hash (make-hash-table :test 'equal)))
  25   (setf (gethash a hash) t)
  26   (setf (aref a 0) 0)
  27   (assert (= sxhash (sxhash a)))
  28   ;; Need to make another access to the hash to disable the last-seen-element
  29   ;; cache.
  30   (setf (gethash 'y hash) t)
  31   (assert (gethash a hash)))
  32
  33 ;;; Minimum quality checks
  34 (assert (/= (sxhash "foo") (sxhash "bar")))
  35 (assert (/= (sxhash (pathname "foo.txt")) (sxhash (pathname "bar.txt"))))
  36 (assert (/= (sxhash (list 1 2 3)) (sxhash (list 3 2 1))))
  37 (assert (/= (sxhash #*1010) (sxhash #*0101)))
  38
  39 (with-test (:name :address-based-hash-counter)
  40   ;; It doesn't particularly matter what ADDRESS-BASED-COUNTER-VAL returns,
  41   ;; but it's best to verify the assumption that each cons bumps the count by 1,
  42   ;; lest it be violated in a way that affects the quality of CTYPE hashes.
  43   (let ((win 0) (n-trials 10) (prev (sb-impl::address-based-counter-val)))
  44     (dotimes (i n-trials)
  45       (declare (notinline cons)) ; it's flushable, but don't flush it
  46       (cons 1 2)
  47       (let ((ptr (sb-impl::address-based-counter-val)))
  48         (when (= ptr (1+ prev))
  49           (incf win))
  50         (setq prev ptr)))
  51     ;; GC could occur in here. Just check that 9 out of 10 trials succeed.
  52     (assert (>= win 9))))