stable-sort.lsp 6.25 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Wed Aug 28 21:00:44 2002
;;;; Contains: Tests for STABLE-SORT

(in-package :cl-test)

(deftest stable-sort-list.1
  (let ((a (list 1 4 2 5 3)))
    (stable-sort a #'<))
  (1 2 3 4 5))

(deftest stable-sort-list.2
  (let ((a (list 1 4 2 5 3)))
    (stable-sort a #'< :key #'-))
  (5 4 3 2 1))

(deftest stable-sort-list.3
  (let ((a (list 1 4 2 5 3)))
    (stable-sort a #'(lambda (x y) nil))
    (stable-sort a #'<))
  (1 2 3 4 5))

(deftest stable-sort-list.4
  (let ((a (copy-seq '((1 a) (2 a) (1 b) (2 b) (1 c) (2 c)))))
    (stable-sort a #'(lambda (x y) (< (car x) (car y)))))
  ((1 a) (1 b) (1 c) (2 a) (2 b) (2 c)))

(deftest stable-sort-list.5
  (let ((a (reverse (copy-seq '((1 a) (2 a) (1 b) (2 b) (1 c) (2 c))))))
    (stable-sort a #'(lambda (x y) (< (car x) (car y)))))
  ((1 c) (1 b) (1 a) (2 c) (2 b) (2 a)))

(deftest stable-sort-vector.1
  (let ((a (copy-seq #(1 4 2 5 3))))
    (stable-sort a #'<))
  #(1 2 3 4 5))

(deftest stable-sort-vector.2
  (let ((a (copy-seq #(1 4 2 5 3))))
    (stable-sort a #'< :key #'-))
  #(5 4 3 2 1))

(deftest stable-sort-vector.3
  (let ((a (copy-seq #(1 4 2 5 3))))
    (stable-sort a #'(lambda (x y) nil))
    (stable-sort a #'<))
  #(1 2 3 4 5))

50 51
(deftest stable-sort-vector.4
  (let ((a (make-array 10 :initial-contents '(10 40 20 50 30 15 45 25 55 35)
sds's avatar
sds committed
52
                       :fill-pointer 5)))
53 54 55
    (stable-sort a #'<))
  #(10 20 30 40 50))

56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
;;; FIXME Add random test similar to sort.5 here

(deftest stable-sort-vector.6
  (do-special-integer-vectors
   (v #(1 4 7 3 2 6 5) nil)
   (let ((sv (stable-sort v #'<)))
     (assert (equalp sv #(1 2 3 4 5 6 7)))))
  nil)

(deftest stable-sort-vector.7
  (do-special-integer-vectors
   (v #(0 1 1 0 1 1 0 1 0) nil)
   (let ((sv (stable-sort v #'<)))
     (assert (equalp sv #(0 0 0 0 1 1 1 1 1)))))
  nil)

(deftest stable-sort-vector.8
  (do-special-integer-vectors
   (v #(0 -1 -1 0 -1 -1 0 -1 0) nil)
   (let ((sv (stable-sort v #'>)))
     (assert (equalp sv #(0 0 0 0 -1 -1 -1 -1 -1)))))
  nil)

(deftest stable-sort-vector.9
  (let* ((ivals '(1 4 7 3 2 6 5))
sds's avatar
sds committed
81 82
         (sivals '(1 2 3 4 5 6 7))
         (len (length ivals)))
83
    (loop for etype in '(short-float single-float double-float long-float rational)
sds's avatar
sds committed
84 85 86 87 88 89 90
          for vals = (loop for i in ivals collect (coerce i etype))
          for svals = (loop for i in sivals collect (coerce i etype))
          for vec = (make-array len :element-type etype :initial-contents vals)
          for svec = (stable-sort vec #'<)
          unless (and (eql (length svec) len)
                      (every #'eql svals svec))
          collect (list etype vals svec)))
91 92 93 94
  nil)

(deftest stable-sort-vector.10
  (let* ((ivals '(1 4 7 3 2 6 5))
sds's avatar
sds committed
95 96
         (sivals '(1 2 3 4 5 6 7))
         (len (length ivals)))
97
    (loop for cetype in '(short-float single-float double-float long-float rational)
sds's avatar
sds committed
98 99 100 101 102 103 104 105 106 107
          for etype = `(complex ,cetype)
          for vals = (loop for i in ivals collect (complex (coerce i cetype)
                                                           (coerce (- i) cetype)))
          for svals = (loop for i in sivals collect (complex (coerce i cetype)
                                                             (coerce (- i) cetype)))
          for vec = (make-array len :element-type etype :initial-contents vals)
          for svec = (stable-sort vec #'(lambda (x y) (< (abs x) (abs y))))
          unless (and (eql (length svec) len)
                      (every #'eql svals svec))
          collect (list etype vals svec)))
108 109 110 111
  nil)

;;; Bit vectors

112 113 114 115 116 117 118 119 120 121 122
(deftest stable-sort-bit-vector.1
  (let ((a (copy-seq #*10011101)))
    (stable-sort a #'<))
  #*00011111)

(deftest stable-sort-bit-vector.2
  (let ((a (copy-seq #*10011101)))
    (values (stable-sort a #'< :key #'-) a))
  #*11111000
  #*11111000)

123 124
(deftest stable-sort-bit-vector.3
  (let ((a (make-array 10 :initial-contents '(1 0 0 1 1 1 1 0 1 1)
sds's avatar
sds committed
125 126
                       :element-type 'bit
                       :fill-pointer 5)))
127 128 129
    (stable-sort a #'<))
  #*00111)

130 131 132 133 134 135 136 137
(deftest stable-sort-string.1
  (let ((a (copy-seq "10011101")))
    (values (stable-sort a #'char<) a))
  "00011111"
  "00011111")

(deftest stable-sort-string.2
  (let ((a (copy-seq "10011101")))
138
    (values (stable-sort a #'char<
sds's avatar
sds committed
139
                         :key #'(lambda (c) (if (eql c #\0) #\1 #\0))) a))
140 141 142
  "11111000"
  "11111000")

143
(deftest stable-sort-string.3
144
  (let ((a (make-array 10 :initial-contents "1001111011"
sds's avatar
sds committed
145 146
                       :element-type 'character
                       :fill-pointer 5)))
147 148 149
    (stable-sort a #'char<))
  "00111")

150 151 152 153 154 155 156 157
(deftest stable-sort-string.4
  (do-special-strings
   (s "aebdc" nil)
   (let ((s2 (stable-sort s #'char<)))
     (assert (eq s s2))
     (assert (string= s2 "abcde"))))
  nil)

158 159 160 161 162 163
;;; Order of evaluation tests

(deftest stable-sort.order.1
  (let ((i 0) x y)
    (values
     (stable-sort (progn (setf x (incf i)) (list 1 7 3 2))
sds's avatar
sds committed
164
                  (progn (setf y (incf i)) #'<))
165 166 167 168 169 170 171
     i x y))
  (1 2 3 7) 2 1 2)

(deftest stable-sort.order.2
  (let ((i 0) x y z)
    (values
     (stable-sort (progn (setf x (incf i)) (list 1 7 3 2))
sds's avatar
sds committed
172 173
                  (progn (setf y (incf i)) #'<)
                  :key (progn (setf z (incf i)) #'-))
174 175 176 177
     i x y z))
  (7 3 2 1) 3 1 2 3)


178
;;; Error cases
179

180
(deftest stable-sort.error.1
181 182
  (signals-error (stable-sort) program-error)
  t)
183

184
(deftest stable-sort.error.2
185 186
  (signals-error (stable-sort nil) program-error)
  t)
187

188
(deftest stable-sort.error.3
189 190
  (signals-error (stable-sort nil #'< :key) program-error)
  t)
191

192
(deftest stable-sort.error.4
193 194
  (signals-error (stable-sort nil #'< 'bad t) program-error)
  t)
195

196
(deftest stable-sort.error.5
197 198
  (signals-error (stable-sort nil #'< 'bad t :allow-other-keys nil) program-error)
  t)
199

200
(deftest stable-sort.error.6
201 202
  (signals-error (stable-sort nil #'< 1 2) program-error)
  t)
203 204

(deftest stable-sort.error.7
205 206
  (signals-error (stable-sort (list 1 2 3 4) #'identity) program-error)
  t)
207 208

(deftest stable-sort.error.8
209 210
  (signals-error (stable-sort (list 1 2 3 4) #'< :key #'cons) program-error)
  t)
211 212

(deftest stable-sort.error.9
213 214
  (signals-error (stable-sort (list 1 2 3 4) #'< :key #'car) type-error)
  t)
215 216

(deftest stable-sort.error.10
217 218
  (signals-error (stable-sort (list 1 2 3 4) #'elt) type-error)
  t)
219 220 221 222

(deftest stable-sort.error.11
  (check-type-error #'(lambda (x) (stable-sort x #'<)) #'sequencep)
  nil)