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

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