;
; Verifying the sfht package
;


(require-extension test random-swb iset sfht)
(import test random-swb iset sfht)


(define (++ x) (fx+ 1 x))
(define (-- x) (fx- x 1))

(define min-key 1) 
(define max-key 100)
	   
(define sfht (make-sfht 100000 0.0001 
			(lambda (i) (make-swb-random-state i (fx+ i 17)))
			swb:random!
			integer->bit-vector 
			(compose (lambda (x) (if x 1 0)) bit-vector-ref)
			bit-vector-length))

(define compute-assoc (lambda (key) (cons key (++ key))))

(test-group  "sfht test"
	   
  (test-assert (sfht 'empty?))
  (test-assert (zero? (sfht 'size)))
	   
  (do ((i min-key (++ i))) ((> i max-key))
    (test-assert (not ((sfht 'put!) i (cdr (compute-assoc i)))))
    (test  (compute-assoc i) ((sfht 'get) i)))

  (test  (++ (- max-key min-key)) (sfht 'size))
  (test-assert (not (sfht 'empty?)))
  
  (test   (compute-assoc (++ min-key)) ((sfht 'get) (++ min-key)))
  (test   (compute-assoc (++ min-key)) ((sfht 'get) (++ min-key) #f))
	   
  (test-assert (not ((sfht 'get) (-- min-key) #f)))

  (sfht 'clear!)
	   
  (test-assert (sfht 'empty?))
  (test-assert (zero? (sfht 'size)))
	   
   (do ((i max-key (-- i))) ((< i min-key))
     (test-assert (not ((sfht 'put!) i (cdr (compute-assoc i)))))
     (test (compute-assoc i) ((sfht 'get) i) )
     (test-assert ((sfht 'delete!) i)))
				 
  
  (test-assert (zero? (sfht 'size)))
	   
  
  (do ((i min-key) (j max-key) (direction #t (not direction)))
      ((< j i))
    (cond
     (direction
      (test-assert (not ((sfht 'put!) i (cdr (compute-assoc i)))))
      (set! i (++ i)))
     (else
      (test-assert (not ((sfht 'put!) j (cdr (compute-assoc j)))))
      (set! j (-- j)))))

  (do ((i min-key (++ i))) ((> i max-key))
    (test (compute-assoc i) ((sfht 'get) i) ))

)