(require-library treaps simple-tests)

(import treaps simple-tests)

(compound-test (treaps)
  (define-test (treap)
    "MAKE A NEW EMPTY TREAP ..."
    (define trp (make-treap - string?))
    (treap? trp)
    (treap-empty? trp)
    ((treap-key? trp) 1)
    (eq? (treap-compare trp) -)
    (eq? (treap-value? trp) string?)
    "... AND POPULATE IT"
    (do ((n 0 (+ n 1)))
      ((= n 1000) trp)
      (let ((key (random 10000)))
        (treap-put! trp key (->string key))))
    (positive? (treap-size trp))
    (not (treap-empty? trp))
    "CHECK MIN AND MAX"
    (if (not (treap-get trp 0 #f))
      (not (treap-put! trp 0 "0"))
      (treap-put! trp 0 "0"))
    (equal? (treap-get-min trp) (cons 0 "0"))
    (not (treap-put! trp 10000 "10000"))
    (equal? (treap-get-max trp) (cons 10000 "10000"))
    (not (treap-get trp -5 #f))
    (if (not (treap-get trp 10 #f))
      (not (treap-put! trp 10 "10"))
      (treap-put! trp 10 "10"))
    (equal? (treap-get trp 10 #f) (cons 10 "10"))
    (treap-delete-min! trp)
    (not (treap-get trp 0 #f))
    (treap-delete! trp (car (treap-get-min trp)) #f)
    (treap-delete-max! trp)
    (not (treap-get trp 10000 #f))
    "INSERT AND DELETE A PAIR"
    (if (not (treap-get trp 10 #f))
      (not (treap-put! trp 10 "10"))
      (treap-put! trp 10 "10"))
    (equal? (treap-delete! trp 10 "not found") (cons 10 "10"))
    "TRY TO DELETE A NONEXISTING PAIR"
    (not (treap-delete! trp -10 #f))
    "CLEAR THE TREAP"
    (treap-clear! trp)
    (treap-empty? trp)
    (= (treap-size trp) 0)
    "POPULATE IT AGAIN WITH LESS PAIRS"
    (let loop ((n 100))
      (unless (fx= n 0)
        (let ((k (random 10000)))
          (treap-put! trp k (->string k)))
        (loop (fx- n 1))))
    (<= 0 (treap-size trp) 100)
    (not (treap-empty? trp))
    "CHECK THE TWO FOR-EACH ROUTINES"
    (define keys '())
    (treap-for-each-ascending trp
                              (lambda (pair)
                                (set! keys
                                  (cons (car pair) keys))))
    (apply > keys)
    (set! keys '())
    (treap-for-each-descending trp
                              (lambda (pair)
                                (set! keys
                                  (cons (car pair) keys))))
    (apply < keys)
    "IS DEPTH WORKING?"
    (positive? (treap-depth trp)))
  (treap)
  )