← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/sort.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/sort.lsp
 
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-bit-vector.1
 
79
  (let ((a (copy-seq #*10011101)))
 
80
    (sort a #'<))
 
81
  #*00011111)
 
82
 
 
83
(deftest sort-bit-vector.2
 
84
  (let ((a (copy-seq #*10011101)))
 
85
    (values (sort a #'< :key #'-) a))
 
86
  #*11111000
 
87
  #*11111000)
 
88
 
 
89
(deftest sort-bit-vector.3
 
90
  (let ((a (make-array 10 :initial-contents '(1 0 0 1 1 1 1 0 1 1)
 
91
                       :element-type 'bit
 
92
                       :fill-pointer 5)))
 
93
    (sort a #'<))
 
94
  #*00111)
 
95
 
 
96
(deftest sort-string.1
 
97
  (let ((a (copy-seq "10011101")))
 
98
    (values (sort a #'char<) a))
 
99
  "00011111"
 
100
  "00011111")
 
101
 
 
102
(deftest sort-string.2
 
103
  (let ((a (copy-seq "10011101")))
 
104
    (values (sort a #'char< :key #'(lambda (c) (if (eql c #\0) #\1 #\0))) a))
 
105
  "11111000"
 
106
  "11111000")
 
107
 
 
108
(deftest sort-string.3
 
109
  (let ((a (make-array 10 :initial-contents "1001111011"
 
110
                       :element-type 'character
 
111
                       :fill-pointer 5)))
 
112
    (sort a #'char<))
 
113
  "00111")
 
114
 
 
115
;;; Order of evaluation tests
 
116
 
 
117
(deftest sort.order.1
 
118
  (let ((i 0) x y)
 
119
    (values
 
120
     (sort (progn (setf x (incf i)) (list 1 7 3 2))
 
121
           (progn (setf y (incf i)) #'<))
 
122
     i x y))
 
123
  (1 2 3 7) 2 1 2)
 
124
 
 
125
(deftest sort.order.2
 
126
  (let ((i 0) x y z)
 
127
    (values
 
128
     (sort (progn (setf x (incf i)) (list 1 7 3 2))
 
129
           (progn (setf y (incf i)) #'<)
 
130
           :key (progn (setf z (incf i)) #'-))
 
131
     i x y z))
 
132
  (7 3 2 1) 3 1 2 3)
 
133
 
 
134
 
 
135
;;; Error cases
 
136
 
 
137
(deftest sort.error.1
 
138
  (signals-error (sort) program-error)
 
139
  t)
 
140
 
 
141
(deftest sort.error.2
 
142
  (signals-error (sort nil) program-error)
 
143
  t)
 
144
 
 
145
(deftest sort.error.3
 
146
  (signals-error (sort nil #'< :key) program-error)
 
147
  t)
 
148
 
 
149
(deftest sort.error.4
 
150
  (signals-error (sort nil #'< 'bad t) program-error)
 
151
  t)
 
152
 
 
153
(deftest sort.error.5
 
154
  (signals-error (sort nil #'< 'bad t :allow-other-keys nil) program-error)
 
155
  t)
 
156
 
 
157
(deftest sort.error.6
 
158
  (signals-error (sort nil #'< 1 2) program-error)
 
159
  t)
 
160
 
 
161
(deftest sort.error.7
 
162
  (signals-error (sort (list 1 2 3 4) #'identity) program-error)
 
163
  t)
 
164
 
 
165
(deftest sort.error.8
 
166
  (signals-error (sort (list 1 2 3 4) #'< :key #'cons) program-error)
 
167
  t)
 
168
 
 
169
(deftest sort.error.9
 
170
  (signals-error (sort (list 1 2 3 4) #'< :key #'car) type-error)
 
171
  t)
 
172
 
 
173
(deftest sort.error.10
 
174
  (signals-error (sort (list 1 2 3 4) #'elt) type-error)
 
175
  t)