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 (with-test (:name :magic-hash-vector-value)
  18   (assert (not (typep sb-impl::+magic-hash-vector-value+
  19                       '(and fixnum unsigned-byte)))))
  20
  21 ;;; The return value of SXHASH on non-string/bitvector arrays should not
  22 ;;; change when the contents of the array change.
  23 (with-test (:name (sxhash array :independent-of-contents))
  24   (let* ((a (make-array '(1) :initial-element 1))
  25          (sxhash (sxhash a))
  26          (hash (make-hash-table :test 'equal)))
  27     (setf (gethash a hash) t)
  28     (setf (aref a 0) 0)
  29     (assert (= sxhash (sxhash a)))
  30     ;; Need to make another access to the hash to disable the
  31     ;; last-seen-element cache.
  32     (setf (gethash 'y hash) t)
  33     (assert (gethash a hash))))
  34
  35 ;;; Minimum quality checks
  36 (with-test (:name (sxhash :quality :minimum))
  37   (assert (/= (sxhash "foo") (sxhash "bar")))
  38   (assert (/= (sxhash (pathname "foo.txt")) (sxhash (pathname "bar.txt"))))
  39   (assert (/= (sxhash (list 1 2 3)) (sxhash (list 3 2 1))))
  40   (assert (/= (sxhash #*1010) (sxhash #*0101))))
  41
  42 (with-test (:name :address-based-hash-counter)
  43   ;; It doesn't particularly matter what ADDRESS-BASED-COUNTER-VAL returns,
  44   ;; but it's best to verify the assumption that each cons bumps the count
  45   ;; by 1, lest it be violated in a way that affects the quality of CTYPE
  46   ;; hashes.
  47   (let ((win 0) (n-trials 10) (prev (sb-impl::address-based-counter-val)))
  48     (dotimes (i n-trials)
  49       (declare (notinline cons)) ; it's flushable, but don't flush it
  50       (cons 1 2)
  51       (let ((ptr (sb-impl::address-based-counter-val)))
  52         (when (= ptr (1+ prev))
  53           (incf win))
  54         (setq prev ptr)))
  55     ;; GC could occur in here. Just check that 9 out of 10 trials succeed.
  56     (assert (>= win 9))))
  57
  58 ;;; The value of SXHASH on bit-vectors of length a multiple of the word
  59 ;;; size didn't depend on the contents of the last word, specifically
  60 ;;; making it a constant for bit-vectors of length equal to the word
  61 ;;; size.
  62 ;;; Here we test that at least two different hash codes occur per length.
  63 (with-test (:name (sxhash :quality bit-vector :non-constant))
  64   (let (;; Up to which length to test.
  65         (max-length 200)
  66         ;; How many random bits to use before declaring a test failure.
  67         (random-bits-to-use 200))
  68     (loop for length from 1 to max-length do
  69           (let ((v (make-array length :element-type 'bit)))
  70             (flet ((randomize-v ()
  71                      (map-into v (lambda ()
  72                                    (random 2)))))
  73               (randomize-v)
  74               (let ((sxhash (sxhash v))
  75                     (random-bits-used 0))
  76                 (loop
  77                   (randomize-v)
  78                   (when (/= (sxhash v) sxhash)
  79                     (return))
  80                   (incf random-bits-used length)
  81                   (when (>= random-bits-used random-bits-to-use)
  82                     (error "SXHASH is constant on bit-vectors of length ~a."
  83                            length)))))))))
  84
  85 ;;; See the comment at the previous test.
  86 ;;; Here we test that the hash code depends on any of the last N-WORD-BITS
  87 ;;; bits.
  88 (with-test (:name (sxhash :quality bit-vector :dependent-on-final-bits))
  89   (let (;; Up to which length to test.
  90         (max-length 200)
  91         ;; How many random bits to use before declaring a test failure.
  92         (random-bits-to-use 200))
  93     ;; The previous test covers lengths up to the word size, so start
  94     ;; above that.
  95     (loop for length from (1+ sb-vm:n-word-bits) to max-length do
  96           (let ((v (make-array length :element-type 'bit :initial-element 0)))
  97             (flet ((randomize-v ()
  98                      (loop for i downfrom (1- length)
  99                            repeat sb-vm:n-word-bits
 100                            do (setf (aref v i) (random 2)))))
 101               (randomize-v)
 102               (let ((sxhash (sxhash v)))
 103                 (dotimes (i (ceiling random-bits-to-use sb-vm:n-word-bits)
 104                           (error "SXHASH on bit-vectors of length ~a ~
 105                                   does not depend on the final ~a bits."
 106                                  length sb-vm:n-word-bits))
 107                   (randomize-v)
 108                   (when (/= (sxhash v) sxhash)
 109                     (return)))))))))