1 ;;;; This software is part of the SBCL system. See the README file for
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
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.
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
)))))
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))
26 (hash (make-hash-table :test
'equal
)))
27 (setf (gethash a hash
) t
)
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
))))
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))))
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
47 (let ((win 0) (n-trials 10) (prev (sb-impl::address-based-counter-val
)))
49 (declare (notinline cons
)) ; it's flushable, but don't flush it
51 (let ((ptr (sb-impl::address-based-counter-val
)))
52 (when (= ptr
(1+ prev
))
55 ;; GC could occur in here. Just check that 9 out of 10 trials succeed.
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
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.
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 ()
74 (let ((sxhash (sxhash v
))
78 (when (/= (sxhash v
) sxhash
)
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."
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
88 (with-test (:name
(sxhash :quality bit-vector
:dependent-on-final-bits
))
89 (let (;; Up to which length to test.
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
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)))))
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
))
108 (when (/= (sxhash v
) sxhash
)