;;; 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.

(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)
))

(defun compute-max-psl (hashset)
  (reduce #'max
          (sb-impl::hss-psl-vector (sb-impl::hashset-storage hashset))))

(with-test (:name :array-type-hash-mixer)
  (let* ((hs sb-kernel::*array-type-hashset*)
         (pre (compute-max-psl hs)))
    (assert (<= pre 7))
    (dolist (spec *specifiers*)
      (test-util:opaque-identity (sb-kernel:specifier-type spec)))
    (let ((post (compute-max-psl hs)))
      (assert (<= (- post pre) 3)))))

(with-test (:name :numeric-type-hash-mixer)
  (let* ((hs sb-kernel::*numeric-type-hashset*)
         (pre (compute-max-psl hs)))
    (assert (<= pre 7))
    (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)))
      (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))))))

;(print sb-kernel::*xset-stable-hashes*)
(gc :full t)
#+sb-thread (sb-kernel:run-pending-finalizers)
(with-test (:name :xset-stable-hash-weakness)
  ;; 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.
  (assert (< (hash-table-count sb-kernel::*xset-stable-hashes*)
             100)))
