mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
502 lines
16 KiB
Common Lisp
502 lines
16 KiB
Common Lisp
;;; This file is impure NOT because of its effects, but because of effects upon it
|
|
;;; from other tests- I don't want the type caches to have many extra lines
|
|
;;; in them at the start of the test.
|
|
|
|
(import '(sb-impl::hashset-storage
|
|
sb-impl::hashset-hash-function
|
|
sb-impl::hashset-test-function
|
|
sb-impl::hss-cells
|
|
sb-impl::hss-hash-vector
|
|
sb-impl::hss-psl-vector))
|
|
|
|
(defun hs-cells-mask (v) (- (length v) 4))
|
|
(defun hs-chain-terminator-p (x) (eq x 0))
|
|
|
|
(defun hashset-probing-sequence (hashset key)
|
|
(let* ((storage (hashset-storage hashset))
|
|
(cells (hss-cells storage))
|
|
(mask (hs-cells-mask cells))
|
|
(index (logand (funcall (hashset-hash-function hashset) key) mask))
|
|
(interval 1)
|
|
(sequence))
|
|
(loop
|
|
(push index sequence)
|
|
(let ((probed-key (aref cells index)))
|
|
(assert (not (hs-chain-terminator-p probed-key)))
|
|
(when (and probed-key (funcall (hashset-test-function hashset) probed-key key))
|
|
(return (nreverse sequence)))
|
|
(setq index (logand (+ index interval) mask))
|
|
(incf interval)))))
|
|
|
|
(defun compute-max-psl (hashset)
|
|
(reduce #'max (hss-psl-vector (hashset-storage hashset))))
|
|
|
|
(defun debug-probing (hashset &optional (detail t))
|
|
(let* ((storage (hashset-storage hashset))
|
|
(cells (hss-cells storage))
|
|
(psl (hss-psl-vector storage))
|
|
(mask (hs-cells-mask cells))
|
|
(histo (make-array 12 :initial-element 0)) ; should be enough for anyone
|
|
(n-elts 0)
|
|
(sum-psl 0)
|
|
(*print-pretty* nil))
|
|
(format t "Mask=~X, maxPSL=~D~%" mask (compute-max-psl hashset))
|
|
(dotimes (i (1+ mask))
|
|
(let ((key (aref cells i)))
|
|
(unless (or (null key) (hs-chain-terminator-p key))
|
|
(let* ((seq (hashset-probing-sequence hashset key))
|
|
(actual (length seq)))
|
|
(assert (= actual (aref psl i)))
|
|
(when detail (format t "~45a ~s~%" seq (sb-kernel:type-specifier key)))
|
|
(incf (aref histo (1- actual)))
|
|
(incf n-elts)
|
|
(incf sum-psl actual)))))
|
|
(format t "Histogram:")
|
|
(dotimes (i 12 (terpri)) (format t "~5d" (1+ i)))
|
|
(format t " ")
|
|
(dotimes (i 12 (terpri)) (format t "~5d" (aref histo i)))
|
|
(format t "Avg=~F~%" (/ sum-psl n-elts))))
|
|
|
|
(with-test (:name :exactly-one-null-type-instance)
|
|
(let ((null-instances))
|
|
(dolist (x (sb-vm:list-allocated-objects :all :test #'sb-kernel:member-type-p))
|
|
(let ((m (sb-kernel:member-type-members x)))
|
|
(when (and (sb-int:singleton-p m)
|
|
(eq nil (car m)))
|
|
(push x null-instances))))
|
|
(assert (sb-int:singleton-p null-instances))))
|
|
|
|
(defparameter *allstrings*
|
|
(map 'vector #'string
|
|
(remove 0 (sb-impl::symtbl-cells
|
|
(sb-impl::package-internal-symbols
|
|
(find-package "SB-C"))))))
|
|
|
|
(with-test (:name :member-type-hash-mixer)
|
|
;; not really a test of the mixer, just that we don't try
|
|
;; to hash-cons and then blow up on MEMBER types that contain
|
|
;; other than numbers and symbols.
|
|
(let ((nstrings (length *allstrings*))
|
|
(foo 0))
|
|
(dotimes (i 10000)
|
|
(let ((n (+ 2 (random 10)))
|
|
(strings))
|
|
(dotimes (i n)
|
|
(push (elt *allstrings* (random nstrings)) strings))
|
|
(let ((spec `(member ,@strings)))
|
|
(when (typep (elt *allstrings* (random nstrings)) spec)
|
|
(incf foo)))))))
|
|
|
|
(defvar *specifiers* '(
|
|
(ARRAY * (0 0 0 0 0 0 0 0))
|
|
(SIMPLE-BIT-VECTOR 16)
|
|
(ARRAY * (0 0 0 0 0))
|
|
(SIMPLE-BIT-VECTOR 5)
|
|
(BIT-VECTOR 0)
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 7) (10))
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 32) (10))
|
|
(SIMPLE-VECTOR 25)
|
|
(ARRAY * (0 0 0 0 * 0 0 0))
|
|
(VECTOR T 0)
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 16) (6))
|
|
(ARRAY T (0 0 *))
|
|
(SIMPLE-ARRAY SINGLE-FLOAT (5))
|
|
(ARRAY * (0 0 0 0 0 * 0 0))
|
|
(VECTOR * 0)
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 31) (4))
|
|
(SIMPLE-ARRAY FIXNUM (2))
|
|
(ARRAY T (2 2 2))
|
|
(ARRAY * (0 0 0 0 0 0 * 0))
|
|
(ARRAY T (0 * 0 0))
|
|
(ARRAY T (2 2))
|
|
(SIMPLE-ARRAY * (* 3))
|
|
(ARRAY T (0 * 0))
|
|
(ARRAY * (0 0 0 0 0 0 0 *))
|
|
(VECTOR SYMBOL 5)
|
|
(SIMPLE-ARRAY NIL (0))
|
|
(SIMPLE-ARRAY SYMBOL (*))
|
|
(SIMPLE-ARRAY T (0 0 0))
|
|
(SIMPLE-ARRAY FIXNUM NIL)
|
|
(VECTOR * 10)
|
|
(SIMPLE-ARRAY (SIGNED-BYTE 8) (2 2 2 2 2 2))
|
|
(SIMPLE-ARRAY BIT NIL)
|
|
(SIMPLE-ARRAY T (3 4))
|
|
(SIMPLE-ARRAY (SIGNED-BYTE 8) (2 2 2 2 2 2 2))
|
|
(VECTOR T 4)
|
|
(ARRAY * (0 0 0 0 0 0 0 0 0))
|
|
(SIMPLE-ARRAY CHARACTER (95))
|
|
(ARRAY * (* 0 0 0))
|
|
(ARRAY T (* * * *))
|
|
(ARRAY * (0 0 0 0 * 0 0 0 0))
|
|
(SIMPLE-ARRAY (SIGNED-BYTE 8) NIL)
|
|
(VECTOR T 3)
|
|
(ARRAY * (* 2))
|
|
(SIMPLE-ARRAY FIXNUM (2 2 2 2 2 2 2))
|
|
(ARRAY T (* *))
|
|
(ARRAY * (0 0 0 0 0 * 0 0 0))
|
|
(SIMPLE-ARRAY T (0 0))
|
|
(ARRAY * (* *))
|
|
(SIMPLE-ARRAY * (* 2))
|
|
(SIMPLE-VECTOR 512)
|
|
(SIMPLE-ARRAY CHARACTER (0))
|
|
(BIT-VECTOR 5)
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (2))
|
|
(SIMPLE-VECTOR 256)
|
|
(SIMPLE-ARRAY (SIGNED-BYTE 8) (2 2 2))
|
|
(ARRAY * (0 0 0 0 0 0 * 0 0))
|
|
(SIMPLE-ARRAY T (0 0 0 0 0 0))
|
|
(VECTOR * 8)
|
|
(ARRAY T (* 0))
|
|
(SIMPLE-ARRAY T (0 0 0 0 0 0 0))
|
|
(SIMPLE-ARRAY T (0 0 0 0 0 0 0 0))
|
|
(SIMPLE-VECTOR 2)
|
|
(ARRAY * (0 0 0 0 0 0 0 * 0))
|
|
(SIMPLE-ARRAY T (0 0 0 0 0))
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 4) (10))
|
|
(SIMPLE-ARRAY (SIGNED-BYTE 64) (10))
|
|
(SIMPLE-ARRAY FIXNUM (10))
|
|
(SIMPLE-ARRAY BIT (2 2 2))
|
|
(ARRAY T (* 3))
|
|
(ARRAY * (0 0 0 0 0 0 0 0 *))
|
|
(SIMPLE-ARRAY (SIGNED-BYTE 8) (2 2 2 2))
|
|
(SIMPLE-ARRAY T (4 10))
|
|
(ARRAY T (2 3))
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 15) (10))
|
|
(SIMPLE-ARRAY T (* *))
|
|
(ARRAY * (0 * 0 0))
|
|
(ARRAY T (0 0))
|
|
(SIMPLE-ARRAY * (3))
|
|
(SIMPLE-ARRAY (SIGNED-BYTE 8) (10))
|
|
(SIMPLE-ARRAY T (0 0 0 0))
|
|
(SIMPLE-ARRAY T (2 2 2 2))
|
|
(SIMPLE-ARRAY CHARACTER (5))
|
|
(SIMPLE-ARRAY * NIL)
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 16) (10))
|
|
(SIMPLE-ARRAY T (2 2 2 2 2))
|
|
(SIMPLE-BASE-STRING 3)
|
|
(SIMPLE-ARRAY T (3 *))
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 32) (4))
|
|
(SIMPLE-BIT-VECTOR 0)
|
|
(VECTOR CHARACTER 4)
|
|
(ARRAY * (0 0 * 0 0))
|
|
(ARRAY * (0 0 * 0 0 0))
|
|
(SIMPLE-ARRAY CHARACTER (1))
|
|
(ARRAY * (0 0 * 0 0 0 0))
|
|
(ARRAY T (0 * 0 0 0))
|
|
(ARRAY * (0 0 * 0 0 0 0 0))
|
|
(ARRAY T (0 * 0 0 0 0 0))
|
|
(ARRAY * (0 0 * 0 0 0 0 0 0))
|
|
(ARRAY T (0 * 0 0 0 0 0 0))
|
|
(ARRAY T (0 0 * 0))
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 64) (10))
|
|
(ARRAY T (0 * 0 0 0 0))
|
|
(SIMPLE-ARRAY CHARACTER (2 2))
|
|
(SIMPLE-BASE-STRING 10)
|
|
(SIMPLE-ARRAY T (* * * *))
|
|
(ARRAY T (0 * 0 0 0 0 0 0 0))
|
|
(SIMPLE-ARRAY * (5))
|
|
(SIMPLE-BIT-VECTOR 128)
|
|
(SIMPLE-ARRAY CHARACTER NIL)
|
|
(ARRAY * (3 4))
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 62) (1))
|
|
(ARRAY * (2 *))
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (2 2))
|
|
(ARRAY T (3 2))
|
|
(ARRAY T (0 0 0 0))
|
|
(SIMPLE-ARRAY CHARACTER (4))
|
|
(SIMPLE-VECTOR 28)
|
|
(ARRAY * (0 0 0 0))
|
|
(SIMPLE-ARRAY T (* 2))
|
|
(SIMPLE-ARRAY SYMBOL (5))
|
|
(ARRAY SYMBOL)
|
|
(SIMPLE-ARRAY FIXNUM (2 2 2 2))
|
|
(ARRAY * NIL)
|
|
(SIMPLE-ARRAY * (0 0 0))
|
|
(SIMPLE-ARRAY T (2 *))
|
|
(ARRAY * (3 *))
|
|
(ARRAY T (* * *))
|
|
(SIMPLE-BIT-VECTOR 2)
|
|
(ARRAY * (3 2))
|
|
(SIMPLE-ARRAY BASE-CHAR NIL)
|
|
(ARRAY T (3 *))
|
|
(ARRAY * (* 0))
|
|
(ARRAY T (0 0 0 0 0))
|
|
(ARRAY T (0 0 0 0 *))
|
|
(ARRAY T (0 0 0 0 0 0))
|
|
(ARRAY T (0 0 0 0 * 0))
|
|
(ARRAY T (0 0 0 0 0 *))
|
|
(ARRAY T (0 0 0 0 0 0 0))
|
|
(SIMPLE-ARRAY CHARACTER (2 2 2 2 2 2 2))
|
|
(SIMPLE-ARRAY BIT (2 2 2 2 2))
|
|
(SIMPLE-ARRAY BIT (2 2 2 2 2 2 2))
|
|
(SIMPLE-BIT-VECTOR 10)
|
|
(ARRAY T (0 0 0 0 * 0 0))
|
|
(ARRAY BIT NIL)
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 2) (128))
|
|
(SIMPLE-ARRAY * (0 0))
|
|
(SIMPLE-ARRAY * (1))
|
|
(SIMPLE-ARRAY CHARACTER (100000))
|
|
(ARRAY T (0 0 0 0 0 * 0))
|
|
(SIMPLE-ARRAY CHARACTER (256))
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (2 2 2 2 2 2 2))
|
|
(SIMPLE-ARRAY BIT (2 2 2 2))
|
|
(SIMPLE-VECTOR 6)
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (2 2 2 2 2))
|
|
(SIMPLE-ARRAY CHARACTER (10))
|
|
(ARRAY * (0 0 0 *))
|
|
(ARRAY T (0 0 0 0 0 0 *))
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (2 2 2 2 2 2))
|
|
(SIMPLE-VECTOR 1)
|
|
(VECTOR T 1)
|
|
(BASE-STRING 10)
|
|
(AND ARRAY (NOT SIMPLE-ARRAY))
|
|
(ARRAY * (0 0 0 * 0 0))
|
|
(ARRAY T (0 0 0 0 0 0 0 0))
|
|
(SIMPLE-ARRAY * (0 0 0 0 0))
|
|
(ARRAY * (0 0 0 * 0))
|
|
(SIMPLE-ARRAY * (0 0 0 0 0 0))
|
|
(SIMPLE-ARRAY BASE-CHAR (2 2 2 2 2))
|
|
(ARRAY * (0 0 0 * 0 0 0))
|
|
(SIMPLE-ARRAY * (0 0 0 0 0 0 0))
|
|
(SIMPLE-ARRAY BASE-CHAR (2 2 2 2 2 2))
|
|
(ARRAY T (0 0 0 0 * 0 0 0))
|
|
(ARRAY * (0 0 0 * 0 0 0 0))
|
|
(SIMPLE-ARRAY T (* * *))
|
|
(ARRAY * (* 0 0))
|
|
(SIMPLE-ARRAY BASE-CHAR (2 2 2 2 2 2 2))
|
|
(SIMPLE-ARRAY * (0 0 0 0 0 0 0 0))
|
|
(ARRAY * (0 0 0 * 0 0 0 0 0))
|
|
(ARRAY * (0 * 0))
|
|
(ARRAY T (0 0 0 0 0 * 0 0))
|
|
(SIMPLE-VECTOR 3)
|
|
(SIMPLE-ARRAY (SIGNED-BYTE 16) (10))
|
|
(ARRAY T (* 4))
|
|
(SIMPLE-ARRAY * (0))
|
|
(ARRAY * (0 0 *))
|
|
(VECTOR SYMBOL)
|
|
(VECTOR * 5)
|
|
(SIMPLE-ARRAY CHARACTER (6))
|
|
(ARRAY T (* 0 0 0 0))
|
|
(ARRAY T (0 *))
|
|
(ARRAY T (0 0 0 0 0 0 * 0))
|
|
(ARRAY T (* * * * *))
|
|
(ARRAY T (* * * * * *))
|
|
(ARRAY T (* 0 0 0 0 0 0))
|
|
(ARRAY T (* * * * * * *))
|
|
(SIMPLE-ARRAY SYMBOL)
|
|
(ARRAY T (* 0 0 0 0 0 0 0))
|
|
(ARRAY T (* 0 0 0))
|
|
(SIMPLE-ARRAY * (3 2))
|
|
(ARRAY T (* * * * * * * *))
|
|
(ARRAY T (* 0 0 0 0 0))
|
|
(ARRAY T (0 0 0 0 0 0 0 *))
|
|
(SIMPLE-BASE-STRING 2)
|
|
(SIMPLE-VECTOR 64)
|
|
(ARRAY T (* * * * * * * * *))
|
|
(SIMPLE-ARRAY * (0 0 0 0))
|
|
(ARRAY T (* 0 0 0 0 0 0 0 0))
|
|
(VECTOR CHARACTER 10)
|
|
(SIMPLE-ARRAY T (3 2))
|
|
(SIMPLE-ARRAY * (* *))
|
|
(BIT-VECTOR 10)
|
|
(SIMPLE-ARRAY BASE-CHAR (2 2 2))
|
|
(ARRAY T (0 0 0 0 0 0 0 0 0))
|
|
(SIMPLE-ARRAY (SIGNED-BYTE 8) (2))
|
|
(ARRAY T (0 0 * 0 0))
|
|
(ARRAY T (0 0 * 0 0 0))
|
|
(VECTOR * 3)
|
|
(ARRAY T (0 0 * 0 0 0 0))
|
|
(ARRAY * (0 0))
|
|
(ARRAY * (* 0 0 0 0 0))
|
|
(ARRAY T (0 0 * 0 0 0 0 0))
|
|
(ARRAY * (* 0 0 0 0))
|
|
(SIMPLE-ARRAY * (2 *))
|
|
(SIMPLE-ARRAY * (3 4))
|
|
(ARRAY T (0 0 * 0 0 0 0 0 0))
|
|
(SIMPLE-ARRAY FIXNUM (2 2))
|
|
(ARRAY T (0 0 0 0 * 0 0 0 0))
|
|
(ARRAY * (* 0 0 0 0 0 0 0))
|
|
(SIMPLE-ARRAY * (2))
|
|
(SIMPLE-ARRAY T (* * * * *))
|
|
(SIMPLE-ARRAY FUNCTION (256))
|
|
(ARRAY * (2 3))
|
|
(ARRAY * (* 0 0 0 0 0 0 0 0))
|
|
(ARRAY * (0 *))
|
|
(ARRAY T NIL)
|
|
(SIMPLE-ARRAY T (* * * * * *))
|
|
(SIMPLE-VECTOR 1024)
|
|
(ARRAY * (* 0 0 0 0 0 0))
|
|
(SIMPLE-VECTOR 37)
|
|
(SIMPLE-VECTOR 4)
|
|
(SIMPLE-ARRAY T (* * * * * * * *))
|
|
(ARRAY T (0 0 0 0 0 * 0 0 0))
|
|
(ARRAY T (0 0 0 *))
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) NIL)
|
|
(SIMPLE-ARRAY CHARACTER (2))
|
|
(SIMPLE-ARRAY T (* * * * * * *))
|
|
(VECTOR T 2)
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (2 2 2 2))
|
|
(SIMPLE-ARRAY * (10))
|
|
(VECTOR T 10)
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 63) (10))
|
|
(ARRAY T (3 4))
|
|
(SIMPLE-VECTOR 32)
|
|
(SIMPLE-ARRAY * (8))
|
|
(ARRAY * (0 * 0 0 0))
|
|
(ARRAY T (* 0 0))
|
|
(ARRAY T (0 0 0 0 0 0 * 0 0))
|
|
(SIMPLE-BIT-VECTOR 64)
|
|
(ARRAY * (0 * 0 0 0 0 0))
|
|
(ARRAY * (* 3))
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 62) (10))
|
|
(SIMPLE-ARRAY T (* 3))
|
|
(ARRAY * (0 * 0 0 0 0 0 0))
|
|
(SIMPLE-ARRAY * (2 3))
|
|
(SIMPLE-VECTOR 0)
|
|
(ARRAY T (0 0 0 * 0))
|
|
(SIMPLE-VECTOR 128)
|
|
(ARRAY * (0 * 0 0 0 0 0 0 0))
|
|
(ARRAY * (0 0 * 0))
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (8))
|
|
(SIMPLE-ARRAY (SIGNED-BYTE 32) (10))
|
|
(ARRAY T (0 0 0 * 0 0))
|
|
(ARRAY T (2 2 2 2 2 2 2))
|
|
(ARRAY T (0 0 0 0 0 0 0 * 0))
|
|
(SIMPLE-ARRAY DOUBLE-FLOAT (5))
|
|
(ARRAY T (2 2 2 2 2 2))
|
|
(SIMPLE-ARRAY CHARACTER (3))
|
|
(ARRAY T (0 0 0 * 0 0 0))
|
|
(ARRAY T (* 2))
|
|
(ARRAY * (0 * 0 0 0 0))
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 31) (10))
|
|
(SIMPLE-VECTOR 2048)
|
|
(SIMPLE-ARRAY T NIL)
|
|
(SIMPLE-ARRAY (SIGNED-BYTE 8) (2 2))
|
|
(ARRAY T (0 0 0 * 0 0 0 0))
|
|
(VECTOR * 1)
|
|
(ARRAY T (0 0 0))
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 2) (10))
|
|
(ARRAY * (0 0 0 0 *))
|
|
(ARRAY * (0 0 0 0 0 0))
|
|
(ARRAY T (0 0 0 * 0 0 0 0 0))
|
|
(ARRAY * (0 0 0 0 * 0))
|
|
(SIMPLE-ARRAY * (4))
|
|
(VECTOR (UNSIGNED-BYTE 8) 8)
|
|
(ARRAY * (0 0 0 0 0 *))
|
|
(ARRAY * (0 0 0 0 0 0 0))
|
|
(SIMPLE-ARRAY T (2 3))
|
|
(VECTOR * 2)
|
|
(ARRAY * (0 0 0))
|
|
(ARRAY * (0 0 0 0 * 0 0))
|
|
(SIMPLE-ARRAY * (3 *))
|
|
(ARRAY * (* 4))
|
|
(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (10))
|
|
(ARRAY * (0 0 0 0 0 * 0))
|
|
(ARRAY T (2 *))
|
|
(SIMPLE-VECTOR 10)
|
|
(VECTOR * 4)
|
|
(ARRAY * (0 0 0 0 0 0 *))
|
|
(SIMPLE-VECTOR 62)
|
|
))
|
|
|
|
(with-test (:name :array-type-hash-mixer
|
|
:skipped-on :gc-stress)
|
|
(let* ((hs sb-kernel::*array-type-hashset*)
|
|
(pre (compute-max-psl hs)))
|
|
(assert (<= pre 9))
|
|
(dolist (spec *specifiers*)
|
|
(test-util:opaque-identity (sb-kernel:specifier-type spec)))
|
|
(let ((post (compute-max-psl hs)))
|
|
(assert (<= (- post pre) 3)))))
|
|
|
|
(defun slurp-samples (pathname)
|
|
(with-open-file (f pathname)
|
|
(loop
|
|
(let ((line (read-line f nil)))
|
|
(unless line (return))
|
|
(sb-int:binding* (((nil end1) (read-from-string line))
|
|
((form2) (read-from-string line nil nil :start end1)))
|
|
(sb-kernel:specifier-type form2)))))) ; for effect (not flushable)
|
|
|
|
;; Slurping in the data posted to the "NUMERIC-TYPE-HASH-MIXER failures" discussion thread
|
|
;; in sbcl-devel gave me different probe sequences. I think this test is overly sensitive
|
|
;; to which cells get clobbered by GC.
|
|
;; (debug-probing sb-kernel::*numeric-type-hashset* nil)
|
|
;; Histogram: 1 2 3 4 5 6 7 8 9 10 11 12
|
|
;; 314 172 57 24 14 6 1 0 0 0 0 0
|
|
;; Avg=1.7653061
|
|
(with-test (:name :numeric-type-hash-mixer
|
|
:fails-on :ppc64
|
|
:skipped-on :gc-stress)
|
|
(let* ((hs sb-kernel::*numeric-union-type-hashset*)
|
|
;; Theoretically we should be more concerned with the _average_
|
|
;; number of probes assuming all keys are sought equally (which is seldom true),
|
|
;; but we do also want to constrain the worst-case number of probes.
|
|
;; Accept a pretty high number, though not ideal, to avoid test failure.
|
|
(acceptable-initial-max-psl 9)
|
|
(pre (compute-max-psl hs)))
|
|
(when (> pre acceptable-initial-max-psl)
|
|
(format t "~&Dumping ~S~%" 'sb-kernel::*numeric-union-type-hashset*)
|
|
(debug-probing hs))
|
|
(assert (<= pre acceptable-initial-max-psl))
|
|
(loop for i = 1 then (ash i 1)
|
|
for tp = `(real ,(- i) 0)
|
|
repeat 200
|
|
unless (and (not (typep (- -1 i) tp)) (typep (- i) tp)
|
|
(typep -1 tp) (typep 0 tp) (not (typep 1 tp))
|
|
(not (typep i tp)) (not (typep (1+ i) tp)))
|
|
collect (list i tp))
|
|
(let ((post (compute-max-psl hs)))
|
|
;; It should only be allowed to get worse by some small tolerance, but I'm
|
|
;; unsure what to constrain this to. Maybe compute a percentage change in
|
|
;; average number of probes before and after inserting synthetic entries?
|
|
;; And/or strongly reference all elements to hide effects of weak object smashing.
|
|
(assert (<= (- post pre) 2)))))
|
|
|
|
(defvar a "foo")
|
|
(defvar b '(nil t))
|
|
(defvar c #*101)
|
|
(with-test (:name :hash-cons-member-type)
|
|
(assert (eq (sb-kernel:specifier-type `(member ,a ,b ,c))
|
|
(sb-kernel:specifier-type `(member ,c ,a ,b))))
|
|
(assert (eq (sb-kernel:specifier-type `(member ,a ,b ,c))
|
|
(sb-kernel:specifier-type `(member ,b ,c ,a)))))
|
|
|
|
(with-test (:name :hash-cons-member-type-large)
|
|
(let ((numbers ; force the XSET to be represented as a hash-table
|
|
(loop for i below 30 collect (complex (coerce i 'single-float) i)))
|
|
(list '(thing)))
|
|
(assert (hash-table-p
|
|
(sb-kernel::xset-data
|
|
(sb-kernel::member-type-xset
|
|
(sb-kernel:specifier-type `(member ,@numbers))))))
|
|
(assert (eq (sb-kernel:specifier-type `(member ,a ,@numbers ,list))
|
|
(sb-kernel:specifier-type `(member ,list ,a ,@numbers))))))
|
|
|
|
(defvar *pre-gc-xset-stable-hash-count*
|
|
(hash-table-count sb-kernel::*xset-stable-hashes*))
|
|
;;; The fix for lp#2029306 significantly simplified the logic of scan_finalizers
|
|
;;; by avoiding use of weak pointers for objects in the live-and-moved state.
|
|
;;; This is not so bad, because an object being live means that adding another
|
|
;;; ref does not per se cause liveness to be preserved. However, the action of the
|
|
;;; finalizer thread is not immediate - it has move the to-be-rehashed items back
|
|
;;; into the weak table, and then another GC cycle is required to discover that the
|
|
;;; cons cells which held the rehash list became dead. Futhermore, to ensure that
|
|
;;; finalizers are run in time for this test to examine the expected state,
|
|
;;; we can "help" the finalizer thread by calling RUN-PENDING-FINALIZERS.
|
|
;;; This sequence yields a count of zero in the xset stable ID table for x86-64,
|
|
;;; but I have not tried the others, so I'm not asserting that it's zero.
|
|
(gc :full t)
|
|
(sb-kernel:run-pending-finalizers)
|
|
(gc :full t)
|
|
(sb-kernel:run-pending-finalizers)
|
|
#+sb-thread (sb-kernel:run-pending-finalizers)
|
|
(with-test (:name :xset-stable-hash-weakness
|
|
:skipped-on :gc-stress)
|
|
;; After running the :MEMBER-TYPE-HASH-MIXER test, there were >5000 entries
|
|
;; in the *XSET-STABLE-HASHES* table for me.
|
|
;; The preceding GC should have had some effect.
|
|
(let ((count (hash-table-count sb-kernel::*xset-stable-hashes*)))
|
|
(format t "::: NOTE: hash-table-count = ~D~%" count)
|
|
(assert (< count (/ *pre-gc-xset-stable-hash-count* 2)))))
|