(module pairing-heap-test mzscheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(planet "text-ui.ss" ("schematics" "schemeunit.plt" 2))
"pairing-heap.ss"
(lib "unit.ss")
(lib "42.ss" "srfi")
(lib "67.ss" "srfi"))
(provide pairing-heap-test-suite)
(define-values/invoke-unit pairing-heap@
(import (rename compare^ (integer-compare compare)))
(export (rename pairing-heap^ (ph-min min))))
(define (int-heap-sort . ints)
(let loop ((h (apply heap ints))
(sorted-ints '()))
(if (empty? h)
(reverse sorted-ints)
(loop (remove-min h) (cons (ph-min h) sorted-ints)))))
(define pairing-heap-test-suite
(test-suite
"pairing-heap.ss test suite"
(test-case
"ad-hoc heap-sort works with heap."
(let ((ints (apply int-heap-sort (list-ec (:range i 10) (- (random 10) 5)))))
(check-true (apply chain<=? integer-compare ints))))
(test-case
"sort works on long lists"
(let* ((l (list-ec (:range i 10000) (- (random 10000) 5000)))
(sl (sort l)))
(check-true
(every?-ec (:parallel (:list e1 sl)
(:list e2 (cdr sl)))
(<=? integer-compare e1 e2)))))
(test-case
"sort works on long vectors"
(let* ((n 10000)
(v (vector-of-length-ec n (:range i n) (random n)))
(vs (sort v)))
(check-true
(every?-ec (:parallel (:vector e1 vs)
(:vector e2 (vector-of-length-ec (- n 1) (:range i 1 n) (vector-ref vs i))))
(<=? integer-compare e1 e2))))))))