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