source: trunk/source/tests/ansi-tests/subseq-aux.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: 6.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Tue Nov 26 20:01:27 2002
4;;;; Contains: Aux. functions for subseq tests
5
6(in-package :cl-test)
7
8(defun subseq-list.4-body ()
9  (block done
10    (let ((x (loop for i from 0 to 19 collect i)))
11      (loop
12       for i from 0 to 20 do
13       (loop
14        for j from i to 20 do
15        (let ((y (subseq x i j)))
16          (loop
17           for e in y and k from i to (1- j) do
18           (unless (eqlt e k) (return-from done nil)))))))
19    t))
20
21(defun subseq-list.5-body ()
22  (block done
23    (let ((x (loop for i from 0 to 29 collect i)))
24      (loop
25       for i from 0 to 30 do
26       (unless (equalt (subseq x i)
27                       (loop for j from i to 29 collect j))
28         (return-from done nil))))
29    t))
30
31(defun subseq-list.6-body ()
32  (let* ((x (make-list 100))
33         (z (loop for e on x collect e))
34         (y (subseq x 0)))
35    (loop
36     for e on x
37     and f on y
38     and g in z do
39     (when (or (not (eqt g e))
40               (not (eqlt (car e) (car f)))
41               (car e)
42               (eqt e f))
43       (return nil))
44     finally (return t))))
45
46(defun subseq-vector.1-body ()
47  (block nil
48  (let* ((x (make-sequence 'vector 10 :initial-element 'a))
49         (y (subseq x 4 8)))
50    (unless (every #'(lambda (e) (eqt e 'a)) x)
51      (return 1))
52    (unless (every #'(lambda (e) (eqt e 'a)) y)
53      (return 2))
54    (unless (eqlt (length x) 10) (return 3))
55    (unless (eqlt (length y) 4)  (return 4))
56    (loop for i from 0 to 9 do (setf (elt x i) 'b))
57    (unless (every #'(lambda (e) (eqt e 'a)) y)
58      (return 5))
59    (loop for i from 0 to 3 do (setf (elt y i) 'c))
60    (or
61     (not (not (every #'(lambda (e) (eqt e 'b)) x)))
62     6))))
63
64(defun subseq-vector.2-body ()
65  (block nil
66  (let* ((x (make-sequence '(vector fixnum) 10 :initial-element 1))
67         (y (subseq x 4 8)))
68    (unless (every #'(lambda (e) (eqlt e 1)) x)
69      (return 1))
70    (unless (every #'(lambda (e) (eqlt e 1)) y)
71      (return 2))
72    (unless (eqlt (length x) 10) (return 3))
73    (unless (eqlt (length y) 4)  (return 4))
74    (loop for i from 0 to 9 do (setf (elt x i) 2))
75    (unless (every #'(lambda (e) (eqlt e 1)) y)
76      (return 5))
77    (loop for i from 0 to 3 do (setf (elt y i) 3))
78    (or
79     (not (not (every #'(lambda (e) (eqlt e 2)) x)))
80     6))))
81
82(defun subseq-vector.3-body ()
83  (block nil
84  (let* ((x (make-sequence '(vector single-float) 10 :initial-element 1.0))
85         (y (subseq x 4 8)))
86    (unless (every #'(lambda (e) (= e 1.0)) x)
87      (return 1))
88    (unless (every #'(lambda (e) (= e 1.0)) y)
89      (return 2))
90    (unless (eqlt (length x) 10) (return 3))
91    (unless (eqlt (length y) 4)  (return 4))
92    (loop for i from 0 to 9 do (setf (elt x i) 2.0))
93    (unless (every #'(lambda (e) (= e 1.0)) y)
94      (return 5))
95    (loop for i from 0 to 3 do (setf (elt y i) 3.0))
96    (or
97     (not (not (every #'(lambda (e) (= e 2.0)) x)))
98     6))))
99
100(defun subseq-vector.4-body ()
101  (block nil
102  (let* ((x (make-sequence '(vector double-float) 10 :initial-element 1.0d0))
103         (y (subseq x 4 8)))
104    (unless (every #'(lambda (e) (= e 1.0)) x)
105      (return 1))
106    (unless (every #'(lambda (e) (= e 1.0)) y)
107      (return 2))
108    (unless (eqlt (length x) 10) (return 3))
109    (unless (eqlt (length y) 4)  (return 4))
110    (loop for i from 0 to 9 do (setf (elt x i) 2.0d0))
111    (unless (every #'(lambda (e) (= e 1.0)) y)
112      (return 5))
113    (loop for i from 0 to 3 do (setf (elt y i) 3.0d0))
114    (or
115     (not (not (every #'(lambda (e) (= e 2.0)) x)))
116     6))))
117
118(defun subseq-vector.5-body ()
119  (block nil
120  (let* ((x (make-sequence '(vector short-float) 10 :initial-element 1.0s0))
121         (y (subseq x 4 8)))
122    (unless (every #'(lambda (e) (= e 1.0)) x)
123      (return 1))
124    (unless (every #'(lambda (e) (= e 1.0)) y)
125      (return 2))
126    (unless (eqlt (length x) 10) (return 3))
127    (unless (eqlt (length y) 4)  (return 4))
128    (loop for i from 0 to 9 do (setf (elt x i) 2.0s0))
129    (unless (every #'(lambda (e) (= e 1.0)) y)
130      (return 5))
131    (loop for i from 0 to 3 do (setf (elt y i) 3.0s0))
132    (or
133     (not (not (every #'(lambda (e) (= e 2.0)) x)))
134     6))))
135
136(defun subseq-vector.6-body ()
137  (block nil
138  (let* ((x (make-sequence '(vector long-float) 10 :initial-element 1.0l0))
139         (y (subseq x 4 8)))
140    (unless (every #'(lambda (e) (= e 1.0)) x)
141      (return 1))
142    (unless (every #'(lambda (e) (= e 1.0)) y)
143      (return 2))
144    (unless (eqlt (length x) 10) (return 3))
145    (unless (eqlt (length y) 4)  (return 4))
146    (loop for i from 0 to 9 do (setf (elt x i) 2.0l0))
147    (unless (every #'(lambda (e) (= e 1.0)) y)
148      (return 5))
149    (loop for i from 0 to 3 do (setf (elt y i) 3.0l0))
150    (or
151     (not (not (every #'(lambda (e) (= e 2.0)) x)))
152     6))))
153
154(defun subseq-string.1-body ()
155  (let* ((s1 "abcdefgh")
156         (len (length s1)))
157    (loop for start from 0 below len
158          always
159          (string= (subseq s1 start)
160                   (coerce (loop for i from start to (1- len)
161                                 collect (elt s1 i))
162                           'string)))))
163
164(defun subseq-string.2-body ()
165  (let* ((s1 "abcdefgh")
166         (len (length s1)))
167    (loop for start from 0 below len
168          always
169          (loop for end from (1+ start) to len
170                always
171                (string= (subseq s1 start end)
172                         (coerce (loop for i from start below end
173                                       collect (elt s1 i))
174                                 'string))))))
175
176(defun subseq-string.3-body ()
177  (let* ((s1 (make-array '(10) :initial-contents "abcdefghij"
178                         :fill-pointer 8
179                         :element-type 'character))
180         (len (length s1)))
181    (and
182     (eqlt len 8)
183     (loop for start from 0 below len
184          always
185          (string= (subseq s1 start)
186                   (coerce (loop for i from start to (1- len)
187                                 collect (elt s1 i))
188                           'string)))
189     (loop for start from 0 below len
190           always
191           (loop for end from (1+ start) to len
192                 always
193                 (string= (subseq s1 start end)
194                          (coerce (loop for i from start below end
195                                        collect (elt s1 i))
196                                  'string)))))))
197(defun subseq-bit-vector.1-body ()
198  (let* ((s1 #*11001000)
199         (len (length s1)))
200    (loop for start from 0 below len
201          always
202          (equalp (subseq s1 start)
203                  (coerce (loop for i from start to (1- len)
204                                collect (elt s1 i))
205                          'bit-vector)))))
206
207(defun subseq-bit-vector.2-body ()
208  (let* ((s1 #*01101011)
209         (len (length s1)))
210    (loop for start from 0 below len
211          always
212          (loop for end from (1+ start) to len
213                always
214                (equalp (subseq s1 start end)
215                        (coerce (loop for i from start below end
216                                      collect (elt s1 i))
217                                'bit-vector))))))
218
219(defun subseq-bit-vector.3-body ()
220  (let* ((s1 (make-array '(10) :initial-contents #*1101100110
221                         :fill-pointer 8
222                         :element-type 'bit))
223         (len (length s1)))
224    (and
225     (eqlt len 8)
226     (loop for start from 0 below len
227          always
228          (equalp (subseq s1 start)
229                  (coerce (loop for i from start to (1- len)
230                                collect (elt s1 i))
231                          'bit-vector)))
232     (loop for start from 0 below len
233           always
234           (loop for end from (1+ start) to len
235                 always
236                 (equalp (subseq s1 start end)
237                         (coerce (loop for i from start below end
238                                       collect (elt s1 i))
239                                 'bit-vector)))))))
Note: See TracBrowser for help on using the repository browser.