source: project/release/4/queues/tests/run.scm @ 31138

(use queues)



(define-syntax assert-error
  (syntax-rules ()
    ((_ expr)
     (assert (handle-exceptions _ #t expr #f)))))


;; Queues.

;; These are tested extensively (and probably still not enough)
;; because of the strange dealings with the front and end lists stored
;; internally.  If we run into errors, add more regression tests here.

(let ((q (make-queue)))
  (assert (queue? q))
  (assert (queue-empty? q))
  (assert (= 0 (queue-length q)))
  (assert (null? (queue->list q)))
  (assert-error (queue-first q))
  (assert-error (queue-last q))
  (assert-error (queue-remove! q))

  (queue-add! q 'foo)
  (assert (eq? 'foo (queue-first q)))
  (assert (eq? 'foo (queue-last q)))
  (assert (not (queue-empty? q)))
  (assert (= (queue-length q) 1))
  (let ((l1 (queue->list q))
        (l2 (queue->list q)))
    (assert (equal? l1 '(foo)))
    (assert (equal? l2 '(foo)))
    (assert (not (eq? l1 l2)))          ; Do not share memory

    (queue-add! q 'end)

    (queue-push-back! q 'front)

    (assert (equal? l1 '(foo))))      ; Does not share memory w/ queue
  (assert (equal? (queue->list q) '(front foo end)))

  (assert (eq? 'front (queue-remove! q)))
  (assert (eq? 'foo (queue-first q)))
  (assert (eq? 'end (queue-last q)))

  (queue-push-back-list! q '(one two))
  (assert (equal? (queue->list q) '(one two foo end)))
  (assert (= 4 (queue-length q)))

  (assert (eq? 'one (queue-remove! q)))
  (assert (eq? 'two (queue-remove! q)))
  (assert (= 2 (queue-length q)))
  (assert (eq? 'foo (queue-first q)))
  (assert (eq? 'end (queue-last q)))
  (assert (not (queue-empty? q)))

  (assert (eq? 'foo (queue-remove! q)))
  (assert (eq? 'end (queue-first q)))
  (assert (eq? 'end (queue-last q)))
  (assert (= (queue-length q) 1))
  (assert (not (queue-empty? q)))

  (assert (eq? 'end (queue-remove! q)))
  (assert (queue-empty? q))
  (assert (= (queue-length q) 0))
  (assert-error (queue-first q))
  (assert-error (queue-last q))
  (assert-error (queue-remove! q)))

(let ((q (list->queue (list 'one 'two))))
  (assert (queue? q))
  (assert (not (queue-empty? q)))
  (assert (= (queue-length q) 2))
  (assert (eq? 'one (queue-first q)))
  (assert (eq? 'two (queue-last q)))

  (assert (eq? 'one (queue-remove! q)))
  (assert (eq? 'two (queue-first q)))
  (assert (eq? 'two (queue-last q)))
  (assert (= (queue-length q) 1))
  (assert (not (queue-empty? q)))

  (assert (eq? 'two (queue-remove! q)))
  (assert-error (queue-first q))
  (assert-error (queue-last q))
  (assert (= (queue-length q) 0))
  (assert (queue-empty? q)))

(let ((q (list->queue (list 'one))))
  (assert (queue? q))
  (assert (not (queue-empty? q)))
  (assert (= (queue-length q) 1))
  (assert (eq? 'one (queue-first q)))
  (assert (eq? 'one (queue-last q)))

  (queue-push-back! q 'zero)
  (assert (eq? 'zero (queue-first q)))
  (assert (eq? 'one (queue-last q)))

  (queue-add! q 'two)
  (assert (eq? 'zero (queue-first q)))
  (assert (eq? 'two (queue-last q)))

  (queue-add! q 'three)
  (assert (eq? 'zero (queue-first q)))
  (assert (eq? 'three (queue-last q)))
  (assert (equal? '(zero one two three) (queue->list q)))

  (assert (eq? 'zero (queue-remove! q)))
  (assert (eq? 'one (queue-first q)))
  (assert (eq? 'three (queue-last q)))
  (assert (= (queue-length q) 3))
  (assert (not (queue-empty? q)))

  (assert (eq? 'one (queue-remove! q)))
  (assert (eq? 'two (queue-remove! q)))
  (assert (eq? 'three (queue-remove! q)))
  (assert-error (queue-first q))
  (assert-error (queue-last q))
  (assert (= (queue-length q) 0))
  (assert (queue-empty? q)))