← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/subseq-aux.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/subseq-aux.lsp
 
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)))))))