62 lines
1.9 KiB
Scheme
62 lines
1.9 KiB
Scheme
(use-modules (algorithms priority-queue)
|
|
(quickcheck)
|
|
(quickcheck arbitrary)
|
|
(quickcheck property)
|
|
(srfi srfi-26)
|
|
(srfi srfi-64))
|
|
|
|
(define $integers ($list $integer))
|
|
|
|
(define ensure-min-priority-queue-order
|
|
(property
|
|
((integers $integers))
|
|
(let ((q (make-priority-queue #:cmp <)))
|
|
(for-each (cute pq-push! q <>) integers)
|
|
(equal? (pq-drain! q) (sort integers <)))))
|
|
|
|
(define ensure-min-abs-priority-queue-order
|
|
(property
|
|
((integers $integers))
|
|
(let ((q (make-priority-queue #:cmp < #:priority abs)))
|
|
(for-each (cute pq-push! q <>) integers)
|
|
;; Can't use equal? for this test as two elements with the same absolute
|
|
;; value might appear in a different order.
|
|
(sorted? (pq-drain! q) (lambda (x y) (< (abs x) (abs y)))))))
|
|
|
|
(define ensure-max-priority-queue-order
|
|
(property
|
|
((integers $integers))
|
|
(let ((q (make-priority-queue #:cmp >)))
|
|
(for-each (cute pq-push! q <>) integers)
|
|
(equal? (pq-drain! q) (sort integers >)))))
|
|
|
|
(define ensure-max-abs-priority-queue-order
|
|
(property
|
|
((integers $integers))
|
|
(let ((q (make-priority-queue #:cmp > #:priority abs)))
|
|
(for-each (cute pq-push! q <>) integers)
|
|
;; Can't use equal? for this test as two elements with the same absolute
|
|
;; value might appear in a different order.
|
|
(sorted? (pq-drain! q) (lambda (x y) (> (abs x) (abs y)))))))
|
|
|
|
(test-begin "min-priority-queue-order")
|
|
|
|
(quickcheck ensure-min-priority-queue-order)
|
|
|
|
(test-end "min-priority-queue-order")
|
|
|
|
(test-begin "max-priority-queue-order")
|
|
|
|
(quickcheck ensure-max-priority-queue-order)
|
|
|
|
(test-end "max-priority-queue-order")
|
|
|
|
(test-begin "min-abs-priority-queue-order")
|
|
|
|
(quickcheck ensure-min-abs-priority-queue-order)
|
|
|
|
(test-end "min-abs-priority-queue-order")
|
|
|
|
(test-begin "max-abs-priority-queue-order")
|
|
(quickcheck ensure-max-abs-priority-queue-order)
|
|
(test-end "max-abs-priority-queue-order")
|