1 files changed, 180 insertions, 0 deletions
diff --git a/priority-queue/pq-test.scm b/priority-queue/pq-test.scm
new file mode 100644
index 0000000..5491e64
--- /dev/null
+++ b/priority-queue/pq-test.scm
@@ -0,0 +1,180 @@
+;; -*- 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")