test-tqueue.ss
#lang scheme/base


(require "tqueue.ss"
         (planet "test.ss" ("schematics" "schemeunit.plt" 2 8))
         (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2 8)))

(provide test-topological-queue)

(define (test)
  (test/text-ui test-topological-queue))

(define test-topological-queue
  (test-suite
   "test-topological-queue.ss"
   (test-case
    "c depends on b, b depends on a"
    (let ([tqueue (new-tqueue)])
      (tqueue-add! tqueue 'a '())
      (check-eq? (tqueue-get tqueue) 'a)
      (tqueue-add! tqueue 'b '(a))
      (check-false (tqueue-try-get tqueue))
      (tqueue-add! tqueue 'c '(b))
      (check-false (tqueue-try-get tqueue))
      (tqueue-satisfy! tqueue 'a)
      
      (check-eq? (tqueue-try-get tqueue) 'b)
      (tqueue-satisfy! tqueue 'b)
      (check-eq? (tqueue-try-get tqueue) 'c)))
   
   
   (test-case
    "'b' depends on 'a' and 'c'"
    (let ([tqueue (new-tqueue)])
      (tqueue-add! tqueue 'a '())
      (tqueue-add! tqueue 'c '())
      (tqueue-add! tqueue 'b '(a c))
      
      (check-eq? (tqueue-get tqueue) 'a)
      (check-eq? (tqueue-get tqueue) 'c)
      (check-false (tqueue-try-get tqueue))
      (tqueue-satisfy! tqueue 'a)
      (check-false (tqueue-try-get tqueue))
      (tqueue-satisfy! tqueue 'c)
      (check-eq? (tqueue-get tqueue) 'b)))
   
   
   (test-case
    "'b' depends on 'a' and 'c' again"
    (let ([tqueue (new-tqueue)])
      (tqueue-satisfy! tqueue 'a)
      (tqueue-satisfy! tqueue 'c)
      (tqueue-add! tqueue 'b '(a c))
      (check-eq? (tqueue-get tqueue) 'b)))))