source: trunk/source/tests/ansi-tests/stable-sort.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 5.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Wed Aug 28 21:00:44 2002
4;;;; Contains: Tests for STABLE-SORT
5
6(in-package :cl-test)
7
8(deftest stable-sort-list.1
9  (let ((a (list 1 4 2 5 3)))
10    (stable-sort a #'<))
11  (1 2 3 4 5))
12
13(deftest stable-sort-list.2
14  (let ((a (list 1 4 2 5 3)))
15    (stable-sort a #'< :key #'-))
16  (5 4 3 2 1))
17
18(deftest stable-sort-list.3
19  (let ((a (list 1 4 2 5 3)))
20    (stable-sort a #'(lambda (x y) nil))
21    (stable-sort a #'<))
22  (1 2 3 4 5))
23
24(deftest stable-sort-list.4
25  (let ((a (copy-seq '((1 a) (2 a) (1 b) (2 b) (1 c) (2 c)))))
26    (stable-sort a #'(lambda (x y) (< (car x) (car y)))))
27  ((1 a) (1 b) (1 c) (2 a) (2 b) (2 c)))
28
29(deftest stable-sort-list.5
30  (let ((a (reverse (copy-seq '((1 a) (2 a) (1 b) (2 b) (1 c) (2 c))))))
31    (stable-sort a #'(lambda (x y) (< (car x) (car y)))))
32  ((1 c) (1 b) (1 a) (2 c) (2 b) (2 a)))
33
34(deftest stable-sort-vector.1
35  (let ((a (copy-seq #(1 4 2 5 3))))
36    (stable-sort a #'<))
37  #(1 2 3 4 5))
38
39(deftest stable-sort-vector.2
40  (let ((a (copy-seq #(1 4 2 5 3))))
41    (stable-sort a #'< :key #'-))
42  #(5 4 3 2 1))
43
44(deftest stable-sort-vector.3
45  (let ((a (copy-seq #(1 4 2 5 3))))
46    (stable-sort a #'(lambda (x y) nil))
47    (stable-sort a #'<))
48  #(1 2 3 4 5))
49
50(deftest stable-sort-vector.4
51  (let ((a (make-array 10 :initial-contents '(10 40 20 50 30 15 45 25 55 35)
52                       :fill-pointer 5)))
53    (stable-sort a #'<))
54  #(10 20 30 40 50))
55
56;;; FIXME Add random test similar to sort.5 here
57
58(deftest stable-sort-vector.6
59  (do-special-integer-vectors
60   (v #(1 4 7 3 2 6 5) nil)
61   (let ((sv (stable-sort v #'<)))
62     (assert (equalp sv #(1 2 3 4 5 6 7)))))
63  nil)
64
65(deftest stable-sort-vector.7
66  (do-special-integer-vectors
67   (v #(0 1 1 0 1 1 0 1 0) nil)
68   (let ((sv (stable-sort v #'<)))
69     (assert (equalp sv #(0 0 0 0 1 1 1 1 1)))))
70  nil)
71
72(deftest stable-sort-vector.8
73  (do-special-integer-vectors
74   (v #(0 -1 -1 0 -1 -1 0 -1 0) nil)
75   (let ((sv (stable-sort v #'>)))
76     (assert (equalp sv #(0 0 0 0 -1 -1 -1 -1 -1)))))
77  nil)
78
79(deftest stable-sort-vector.9
80  (let* ((ivals '(1 4 7 3 2 6 5))
81         (sivals '(1 2 3 4 5 6 7))
82         (len (length ivals)))
83    (loop for etype in '(short-float single-float double-float long-float rational)
84          for vals = (loop for i in ivals collect (coerce i etype))
85          for svals = (loop for i in sivals collect (coerce i etype))
86          for vec = (make-array len :element-type etype :initial-contents vals)
87          for svec = (stable-sort vec #'<)
88          unless (and (eql (length svec) len)
89                      (every #'eql svals svec))
90          collect (list etype vals svec)))
91  nil)
92
93(deftest stable-sort-vector.10
94  (let* ((ivals '(1 4 7 3 2 6 5))
95         (sivals '(1 2 3 4 5 6 7))
96         (len (length ivals)))
97    (loop for cetype in '(short-float single-float double-float long-float rational)
98          for etype = `(complex ,cetype)
99          for vals = (loop for i in ivals collect (complex (coerce i cetype)
100                                                           (coerce (- i) cetype)))
101          for svals = (loop for i in sivals collect (complex (coerce i cetype)
102                                                             (coerce (- i) cetype)))
103          for vec = (make-array len :element-type etype :initial-contents vals)
104          for svec = (stable-sort vec #'(lambda (x y) (< (abs x) (abs y))))
105          unless (and (eql (length svec) len)
106                      (every #'eql svals svec))
107          collect (list etype vals svec)))
108  nil)
109
110;;; Bit vectors
111
112(deftest stable-sort-bit-vector.1
113  (let ((a (copy-seq #*10011101)))
114    (stable-sort a #'<))
115  #*00011111)
116
117(deftest stable-sort-bit-vector.2
118  (let ((a (copy-seq #*10011101)))
119    (values (stable-sort a #'< :key #'-) a))
120  #*11111000
121  #*11111000)
122
123(deftest stable-sort-bit-vector.3
124  (let ((a (make-array 10 :initial-contents '(1 0 0 1 1 1 1 0 1 1)
125                       :element-type 'bit
126                       :fill-pointer 5)))
127    (stable-sort a #'<))
128  #*00111)
129
130(deftest stable-sort-string.1
131  (let ((a (copy-seq "10011101")))
132    (values (stable-sort a #'char<) a))
133  "00011111"
134  "00011111")
135
136(deftest stable-sort-string.2
137  (let ((a (copy-seq "10011101")))
138    (values (stable-sort a #'char<
139                         :key #'(lambda (c) (if (eql c #\0) #\1 #\0))) a))
140  "11111000"
141  "11111000")
142
143(deftest stable-sort-string.3
144  (let ((a (make-array 10 :initial-contents "1001111011"
145                       :element-type 'character
146                       :fill-pointer 5)))
147    (stable-sort a #'char<))
148  "00111")
149
150(deftest stable-sort-string.4
151  (do-special-strings
152   (s "aebdc" nil)
153   (let ((s2 (stable-sort s #'char<)))
154     (assert (eq s s2))
155     (assert (string= s2 "abcde"))))
156  nil)
157
158;;; Order of evaluation tests
159
160(deftest stable-sort.order.1
161  (let ((i 0) x y)
162    (values
163     (stable-sort (progn (setf x (incf i)) (list 1 7 3 2))
164                  (progn (setf y (incf i)) #'<))
165     i x y))
166  (1 2 3 7) 2 1 2)
167
168(deftest stable-sort.order.2
169  (let ((i 0) x y z)
170    (values
171     (stable-sort (progn (setf x (incf i)) (list 1 7 3 2))
172                  (progn (setf y (incf i)) #'<)
173                  :key (progn (setf z (incf i)) #'-))
174     i x y z))
175  (7 3 2 1) 3 1 2 3)
176
177
178;;; Error cases
179
180(deftest stable-sort.error.1
181  (signals-error (stable-sort) program-error)
182  t)
183
184(deftest stable-sort.error.2
185  (signals-error (stable-sort nil) program-error)
186  t)
187
188(deftest stable-sort.error.3
189  (signals-error (stable-sort nil #'< :key) program-error)
190  t)
191
192(deftest stable-sort.error.4
193  (signals-error (stable-sort nil #'< 'bad t) program-error)
194  t)
195
196(deftest stable-sort.error.5
197  (signals-error (stable-sort nil #'< 'bad t :allow-other-keys nil) program-error)
198  t)
199
200(deftest stable-sort.error.6
201  (signals-error (stable-sort nil #'< 1 2) program-error)
202  t)
203
204(deftest stable-sort.error.7
205  (signals-error (stable-sort (list 1 2 3 4) #'identity) program-error)
206  t)
207
208(deftest stable-sort.error.8
209  (signals-error (stable-sort (list 1 2 3 4) #'< :key #'cons) program-error)
210  t)
211
212(deftest stable-sort.error.9
213  (signals-error (stable-sort (list 1 2 3 4) #'< :key #'car) type-error)
214  t)
215
216(deftest stable-sort.error.10
217  (signals-error (stable-sort (list 1 2 3 4) #'elt) type-error)
218  t)
219
220(deftest stable-sort.error.11
221  (check-type-error #'(lambda (x) (stable-sort x #'<)) #'sequencep)
222  nil)
Note: See TracBrowser for help on using the repository browser.