sxhash.lsp 9.01 KB
Newer Older
1 2 3 4 5 6 7 8
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Nov 28 21:18:12 2003
;;;; Contains: Tests of SXHASH

(in-package :cl-test)

(deftest sxhash.1
9
  (check-predicate #'(lambda (x) (typep (sxhash x) '(and unsigned-byte fixnum))))
10 11 12 13
  nil)

(deftest sxhash.2
  (loop for i from 0 below 256
sds's avatar
sds committed
14 15 16 17 18
        for c = (code-char i)
        when (and c
                  (not (= (sxhash (string c))
                          (sxhash (string c)))))
        collect c)
19 20 21 22 23 24 25 26
  nil)

(deftest sxhash.3
  (=t (sxhash "") (sxhash (copy-seq "")))
  t)

(deftest sxhash.4
  (loop for bv1 in '(#* #*0 #*1 #*01 #*00 #*10 #*11
sds's avatar
sds committed
27 28 29 30 31 32 33 34 35
                        #*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)))
36 37 38 39
  t)

(deftest sxhash.5
  (let ((s1 "abcd")
sds's avatar
sds committed
40 41 42
        (s2 (make-array 10 :element-type 'character
                        :initial-contents "abcdefghij"
                        :fill-pointer 4)))
43
    (and (equalt s1 s2)
sds's avatar
sds committed
44
         (=t (sxhash s1) (sxhash s2))))
45 46 47 48
  t)

(deftest sxhash.6
  (let ((s1 #*01101)
sds's avatar
sds committed
49 50 51
        (s2 (make-array 10 :element-type 'bit
                        :initial-contents #*0110111101
                        :fill-pointer 5)))
52
    (and (equalt s1 s2)
sds's avatar
sds committed
53
         (=t (sxhash s1) (sxhash s2))))
54 55 56 57
  t)

(deftest sxhash.7
  (let* ((a (make-array 10 :initial-element nil))
sds's avatar
sds committed
58
         (sx1 (sxhash a)))
59 60 61
    (setf (aref a 4) 'x)
    (let ((sx2 (sxhash a)))
      (and (typep sx1 '(and unsigned-byte fixnum))
sds's avatar
sds committed
62
           (eqlt sx1 sx2))))
63 64 65
  t)

(deftest sxhash.8
66
  :notes (:nil-vectors-are-strings)
67
  (eqlt (sxhash (make-array 0 :element-type nil))
sds's avatar
sds committed
68
        (sxhash ""))
69 70 71 72
  t)

(deftest sxhash.9
  (let ((s1 (make-array 5 :element-type 'base-char :initial-contents "abcde"))
sds's avatar
sds committed
73
        (s2 (copy-seq "abcde")))
74 75 76 77 78
    (eqlt (sxhash s1) (sxhash s2)))
  t)

(deftest sxhash.10
  (let ((s1 "abcd")
sds's avatar
sds committed
79 80 81
        (s2 (make-array 10 :element-type 'base-char
                        :initial-contents "abcdefghij"
                        :fill-pointer 4)))
82
    (and (equalt s1 s2)
sds's avatar
sds committed
83
         (=t (sxhash s1) (sxhash s2))))
84 85 86 87
  t)

(deftest sxhash.11
  (let* ((x (cons 'a 'b))
sds's avatar
sds committed
88 89
         (sx1 (sxhash x))
         (sx2 (sxhash '(a . b))))
90 91
    (setf (car x) 'c)
    (let* ((sx3 (sxhash x))
sds's avatar
sds committed
92
           (sx4 (sxhash '(c . b))))
93
      (and (=t sx1 sx2)
sds's avatar
sds committed
94
           (=t sx3 sx4))))
95 96 97 98
  t)

(deftest sxhash.12
  (let ((x (1+ most-positive-fixnum))
sds's avatar
sds committed
99
        (y (1+ most-positive-fixnum)))
100 101 102 103 104
    (=t (sxhash x) (sxhash y)))
  t)

(deftest sxhash.13
  (let ((sx1 (sxhash (make-symbol "FOO")))
sds's avatar
sds committed
105
        (sx2 (sxhash (make-symbol "FOO"))))
106
    (and (typep sx1 '(and unsigned-byte fixnum))
sds's avatar
sds committed
107
         (eqlt sx1 sx2)))
108 109
  t)

110 111
;; (deftest sxhash.14
;;  (let ((sx1 (sxhash :foo))
sds's avatar
sds committed
112
;;      (sx2 (sxhash '#:foo)))
113
;;    (and (typep sx1 '(and unsigned-byte fixnum))
sds's avatar
sds committed
114
;;       (eqlt sx1 sx2)))
115 116 117 118
;;  t)

(deftest sxhash.15
  (let* ((package-name
sds's avatar
sds committed
119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
          (loop for i from 0
                for name = (format nil "PACKAGE-~A" i)
                for package = (find-package name)
                unless package do (return name)))
         (sx1
          (let* ((package (make-package package-name :nicknames nil :use nil))
                 (symbol (intern "FOO" package)))
            (prog1
               (sxhash symbol)
              (delete-package package))))
         (sx2
          (let* ((package (make-package package-name :nicknames nil :use nil))
                 (symbol (intern "FOO" package)))
            (prog1
               (sxhash symbol)
              (delete-package package)))))
135 136 137 138 139 140
    (assert (typep sx1 '(and unsigned-byte fixnum)))
    (if (= sx1 sx2) :good (list sx1 sx2)))
  :good)

(deftest sxhash.16
  (let ((c1 (list 'a))
sds's avatar
sds committed
141
        (c2 (list 'a)))
142 143 144
    (setf (cdr c1) c1)
    (setf (cdr c2) c2)
    (let ((sx1 (sxhash c1))
sds's avatar
sds committed
145
          (sx2 (sxhash c2)))
146
      (or (eqlt sx1 sx2) (list sx1 sx2))))
147 148
  t)

149 150 151
;;; Since similarity of numbers is 'same type and same mathematical value',
;;; and since sxhash must produce the same value for similar numeric arguments,
;;; (sxhash 0.0) and (sxhash -0.0) must be eql for all float types.
152
;;; This may be a spec bug, so I've added a note.
153 154

(deftest sxhash.17
155
  :notes (:negative-zero-is-similar-to-positive-zero)
156
  (loop for c1 in '(0.0s0 0.0f0 0.0d0 0.0l0)
sds's avatar
sds committed
157 158 159 160 161 162 163 164 165
        for c2 in '(-0.0s0 -0.0f0 -0.0d0 -0.0l0)
        for t1 = (type-of c1)
        for t2 = (type-of c2)
        for sx1 = (sxhash c1)
        for sx2 = (sxhash c2)
        unless (or (not (subtypep t1 t2))
                   (not (subtypep t2 t1))
                   (eql sx1 sx2))
        collect (list c1 c2 sx1 sx2))
166 167 168
  nil)

(deftest sxhash.18
169
  :notes (:negative-zero-is-similar-to-positive-zero)
170
  (loop for r1 in '(0.0s0 0.0f0 0.0d0 0.0l0)
sds's avatar
sds committed
171 172 173 174 175 176 177 178 179 180 181
        for c1 = (complex r1)
        for r2 in '(-0.0s0 -0.0f0 -0.0d0 -0.0l0)
        for c2 = (complex r2)
        for t1 = (type-of c1)
        for t2 = (type-of c2)
        for sx1 = (sxhash c1)
        for sx2 = (sxhash c2)
        unless (or (not (subtypep t1 t2))
                   (not (subtypep t2 t1))
                   (eql sx1 sx2))
        collect (list c1 c2 sx1 sx2))
182 183 184
  nil)

(deftest sxhash.19
185
  :notes (:negative-zero-is-similar-to-positive-zero)
186
  (loop for r1 in '(0.0s0 0.0f0 0.0d0 0.0l0)
sds's avatar
sds committed
187 188 189 190 191 192 193 194 195 196 197
        for c1 = (complex 0 r1)
        for r2 in '(-0.0s0 -0.0f0 -0.0d0 -0.0l0)
        for c2 = (complex 0 r2)
        for t1 = (type-of c1)
        for t2 = (type-of c2)
        for sx1 = (sxhash c1)
        for sx2 = (sxhash c2)
        unless (or (not (subtypep t1 t2))
                   (not (subtypep t2 t1))
                   (eql sx1 sx2))
        collect (list c1 c2 sx1 sx2))
198 199
  nil)

pfdietz's avatar
pfdietz committed
200 201 202
;;; Similar pathnames have the same hash
(deftest sxhash.20
  (let* ((pathspec "sxhash.lsp")
sds's avatar
sds committed
203 204
         (sx1 (sxhash (pathname (copy-seq pathspec))))
         (sx2 (sxhash (pathname (copy-seq pathspec)))))
pfdietz's avatar
pfdietz committed
205
    (if (and (typep sx1 '(and fixnum unsigned-byte))
sds's avatar
sds committed
206 207
             (eql sx1 sx2))
        :good
pfdietz's avatar
pfdietz committed
208 209 210 211 212 213
      (list sx1 sx2)))
  :good)

;;; Similarity for strings
(deftest sxhash.21
  (let* ((s1 "abc")
sds's avatar
sds committed
214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
         (s2 (make-array '(3) :element-type 'character
                         :initial-contents s1))
         (s3 (make-array '(3) :element-type 'base-char
                         :initial-contents s1))
         (s4 (make-array '(3) :element-type 'standard-char
                         :initial-contents s1))
         (s5 (make-array '(3) :element-type 'character
                         :adjustable t
                         :initial-contents "abc"))
         (s6 (make-array '(5) :element-type 'character
                         :fill-pointer 3
                         :initial-contents "abcde"))
         (s7 (make-array '(3) :element-type 'character
                         :displaced-to s2
                         :displaced-index-offset 0))
         (s8 (make-array '(3) :element-type 'character
                         :displaced-to (make-array '(7) :element-type 'character
                                                   :initial-contents "xxabcyy")
                         :displaced-index-offset 2))
         (strings (list s1 s2 s3 s4 s5 s6 s7 s8))
         (hashes (mapcar #'sxhash strings)))
pfdietz's avatar
pfdietz committed
235
    (if (and (every #'(lambda (h) (typep h '(and unsigned-byte fixnum))) hashes)
sds's avatar
sds committed
236 237
             (not (position (car hashes) hashes :test #'/=)))
        :good
pfdietz's avatar
pfdietz committed
238 239 240 241 242 243
      hashes))
  :good)

;;; Similarity for bit vectors
(deftest sxhash.22
  (let* ((bv1 #*010)
sds's avatar
sds committed
244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260
         (bv2 (make-array '(3) :element-type 'bit
                         :initial-contents bv1))
         (bv5 (make-array '(3) :element-type 'bit
                         :adjustable t
                         :initial-contents bv1))
         (bv6 (make-array '(5) :element-type 'bit
                         :fill-pointer 3
                         :initial-contents #*01010))
         (bv7 (make-array '(3) :element-type 'bit
                         :displaced-to bv2
                         :displaced-index-offset 0))
         (bv8 (make-array '(3) :element-type 'bit
                         :displaced-to (make-array '(7) :element-type 'bit
                                                   :initial-contents #*1101001)
                         :displaced-index-offset 2))
         (bit-vectors (list bv1 bv2 bv5 bv6 bv7 bv8))
         (hashes (mapcar #'sxhash bit-vectors)))
pfdietz's avatar
pfdietz committed
261
    (if (and (every #'(lambda (h) (typep h '(and unsigned-byte fixnum))) hashes)
sds's avatar
sds committed
262 263
             (not (position (car hashes) hashes :test #'/=)))
        :good
pfdietz's avatar
pfdietz committed
264 265 266
      hashes))
  :good)

267 268 269 270 271 272
;;; The hash of a symbol does not change when its package changes
(deftest sxhash.23
  (progn
    (safely-delete-package "A")
    (defpackage "A" (:use))
    (let* ((pkg (find-package "A"))
sds's avatar
sds committed
273 274
           (sym (intern "FOO" pkg))
           (hash (sxhash sym)))
275 276
      (unintern sym pkg)
      (let ((hash2 (sxhash sym)))
sds's avatar
sds committed
277 278
        (if (eql hash hash2) nil (list hash hash2)))))
  nil)
279

280 281 282
;;; Error cases

(deftest sxhash.error.1
283 284
  (signals-error (sxhash) program-error)
  t)
285 286

(deftest sxhash.error.2
287 288
  (signals-error (sxhash nil nil) program-error)
  t)