;; -*- compile-command: "guile -L . pq-test.scm"; -*-
(use-modules (srfi srfi-64)
             (ice-9 q)
             (pq))


(test-begin "harness")


(test-equal "make-pq returns empty queue"
  '(() . #f)
  (make-pq))

(test-assert "make-pq returns a pq"
  (pq? (make-pq)))

;; A queue is implemented as a cons cell, the car
;; containing a list of queued elements, and the
;; cdr being the last cell in that list (for ease
;; of enqueuing).
(define simple-queue '((#\b #\c #\e #\f #\g #\h) #\h))
(define priority-queue '(((#\c . 7) (#\e . 6) (#\f . 4)) (#\f . 4)))

(test-assert "queue is not a priority-queue no pair"
  (not (pq? simple-queue)))

(test-assert "queue is not a priority-queue missing number"
  (not (pq? '(((#\c . 7) (#\e . #\g) (#\f . 4)) (#\f . 4)))))

(test-assert "queue is not a priority-queue misordered"
  (not (pq? '(((#\c . 7) (#\e . 6) (#\f . 4)) (#\f . 5)))))

(test-assert "mature priority-queue is a priority queue"
  (pq? priority-queue))

(test-error "q-ref empty q"
            #t
            (q-ref (make-q) 1))

(test-error "q-ref overflow"
            #t
            (q-ref simple-queue 6))

(test-error "q-ref underflow"
            #t
            (q-ref simple-queue -1))

(test-equal "q-ref retrieve last"
  #\h
  (q-ref simple-queue 5))

(test-equal "q-ref retrieve first"
  #\b
  (q-ref simple-queue 0))

(test-equal "q-ref retrieve third"
  #\e
  (q-ref simple-queue 2))

(test-error "q-insert oob"
            #t
            (q-insert! (make-q) 1 #\x))

(test-equal "q-insert empty q"
  '((#\x) #\x)
  (q-insert! (make-q) 0 #\x))

;;;; test-equal results in a segfault, but
;;;; hand-testing shows my procedure is correct
;;;; perhaps there is a bug in test-equal?
;; (test-equal "q-insert last q"
;;   '((#\b #\c #\e #\f #\g #\h #\i) #\i)
;;   (q-insert! simple-queue 6 #\i))

(test-equal "q-insert first q"
  '((#\a #\b #\c #\e #\f #\g #\h) #\h)
  (q-insert! simple-queue 0 #\a))

(test-equal "q-insert fourth q"
  '((#\a #\b #\c #\d #\e #\f #\g #\h) #\h)
  (q-insert! simple-queue 3 #\d))

(test-equal "pq-push! empty queue"
  '(((#\x . 3)) (#\x . 3))
  (pq-push! (make-pq) #\x 3))

(test-equal "pq-push! highest first double"
  '(((#\x . 3) (#\y . 1)) (#\y . 1))
  (let ((my-pq (make-pq)))
    (begin (pq-push! my-pq #\x 3)
           (pq-push! my-pq #\y 1))))

(test-equal "pq-push! lowest first double"
  '(((#\x . 3) (#\y . 1)) (#\y . 1))
  (let ((my-pq (make-pq)))
    (begin (pq-push! my-pq #\y 1)
           (pq-push! my-pq #\x 3))))

(test-equal "pq-push! highest priority"
  '(((#\a . 11) (#\c . 7) (#\e . 6) (#\f . 4)) (#\f . 4))
  (begin (pq-push! priority-queue #\a 11)))

(test-equal "pq-push! lowest priority"
  '(((#\a . 11) (#\c . 7) (#\e . 6) (#\f . 4) (#\g . 3)) (#\g . 3))
  (begin (pq-push! priority-queue #\g 3)))

(test-equal "pq-push! second priority"
  '(((#\a . 11) (#\b . 9) (#\c . 7) (#\e . 6) (#\f . 4) (#\g . 3)) (#\g . 3))
  (begin (pq-push! priority-queue #\b 9)))

;; implementation breaks ties by inserting new element before
(test-equal "pq-push! tied priority"
  '(((#\a . 11) (#\b . 9) (#\c . 7) (#\d . 6) (#\e . 6) (#\f . 4) (#\g . 3)) (#\g . 3))
  (begin (pq-push! priority-queue #\d 6)))

(test-error "pq-pop! empty queue"
            #t
            (pq-pop! (make-pq)))

(test-equal "pq-pop! single element"
  '(#\x . 3)
  (pq-pop! (pq-push! (make-pq) #\x 3)))

(test-equal "pq-pop! mature priority queue"
  '(#\a . 11)
  (pq-pop! priority-queue))

(test-equal "pq-pop! removed element"
  '(#\b . 9)
  (pq-pop! priority-queue))

(test-equal "pq-length empty queue"
  0
  (pq-length (make-pq)))

(test-equal "pq-length mature priority queue"
  5
  (pq-length priority-queue))

(test-assert "pq-empty? true"
  (pq-empty? (make-pq)))

(test-assert "pq-empty? false"
  (not (pq-empty? priority-queue)))

(test-error "pq-front! empty queue"
            #t
            (pq-front (make-pq)))

(test-equal "pq-front! single element"
  '(#\x . 3)
  (pq-front (pq-push! (make-pq) #\x 3)))

(test-equal "pq-front! mature priority queue"
  '(#\c . 7)
  (pq-front priority-queue))

(test-equal "pq-front! did not remove element"
  '(#\c . 7)
  (pq-front priority-queue))

(test-error "pq-rear! empty queue"
            #t
            (pq-rear (make-pq)))

(test-equal "pq-rear! single element"
  '(#\x . 3)
  (pq-rear (pq-push! (make-pq) #\x 3)))

(test-equal "pq-rear! mature priority queue"
  '(#\g . 3)
  (pq-rear priority-queue))

(test-equal "pq-rear! did not remove element"
  '(#\g . 3)
  (pq-rear priority-queue))



(test-end "harness")