guile18/test-suite/tests/sort.test

   1 ;;;; sort.test --- tests Guile's sort functions    -*- scheme -*-
   2 ;;;; Copyright (C) 2003, 2006, 2007 Free Software Foundation, Inc.
   3 ;;;;
   4 ;;;; This program is free software; you can redistribute it and/or modify
   5 ;;;; it under the terms of the GNU General Public License as published by
   6 ;;;; the Free Software Foundation; either version 2, or (at your option)
   7 ;;;; any later version.
   8 ;;;;
   9 ;;;; This program is distributed in the hope that it will be useful,
  10 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;;;; GNU General Public License for more details.
  13 ;;;;
  14 ;;;; You should have received a copy of the GNU General Public License
  15 ;;;; along with this software; see the file COPYING.  If not, write to
  16 ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  17 ;;;; Boston, MA 02110-1301 USA
  18
  19 (use-modules (test-suite lib))
  20
  21 (define (randomize-vector! v n)
  22   (array-index-map! v (lambda (i) (random n)))
  23   v)
  24
  25 (with-test-prefix "sort"
  26
  27   (pass-if-exception "less function taking less than two arguments"
  28     exception:wrong-type-arg
  29     (sort '(1 2) (lambda (x) #t)))
  30
  31   (pass-if-exception "less function taking more than two arguments"
  32     exception:wrong-type-arg
  33     (sort '(1 2) (lambda (x y z) z)))
  34
  35   (pass-if "sort!"
  36     (let ((v (randomize-vector! (make-vector 1000) 1000)))
  37       (sorted? (sort! v <) <)))
  38
  39   (pass-if "sort! of non-contigous vector"
  40     (let* ((a (make-array 0 1000 3))
  41            (v (make-shared-array a (lambda (i) (list i 0)) 1000)))
  42       (randomize-vector! v 1000)
  43       (sorted? (sort! v <) <)))
  44
  45   (pass-if "sort! of negative-increment vector"
  46     (let* ((a (make-array 0 1000 3))
  47            (v (make-shared-array a (lambda (i) (list (- 999 i) 0)) 1000)))
  48       (randomize-vector! v 1000)
  49       (sorted? (sort! v <) <)))
  50
  51   (pass-if "stable-sort!"
  52     (let ((v (randomize-vector! (make-vector 1000) 1000)))
  53       (sorted? (stable-sort! v <) <)))
  54
  55   (pass-if "stable-sort! of non-contigous vector"
  56     (let* ((a (make-array 0 1000 3))
  57            (v (make-shared-array a (lambda (i) (list i 0)) 1000)))
  58       (randomize-vector! v 1000)
  59       (sorted? (stable-sort! v <) <)))
  60
  61   (pass-if "stable-sort! of negative-increment vector"
  62     (let* ((a (make-array 0 1000 3))
  63            (v (make-shared-array a (lambda (i) (list (- 999 i) 0)) 1000)))
  64       (randomize-vector! v 1000)
  65       (sorted? (stable-sort! v <) <))))
  66
  67
  68 ;;;
  69 ;;; stable-sort
  70 ;;;
  71
  72 (with-test-prefix "stable-sort"
  73
  74   ;; in guile 1.8.0 and 1.8.1 this test failed, an empty list provoked a
  75   ;; wrong-type-arg exception (where it shouldn't)
  76   (pass-if "empty list"
  77     (eq? '() (stable-sort '() <))))
  78