pairing-heap-test.ss
#|  pairing-heap-test.ss: Test suite for pairing-heap.ss.
    Copyright (C) Will M. Farr <farr@mit.edu>

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Lesser General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU Lesser General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
|#

(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))))))))