subseq-aux.lsp 7.82 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Nov 26 20:01:27 2002
;;;; Contains: Aux. functions for subseq tests

(in-package :cl-test)

8
(defun subseq-list.4-body ()
9 10 11 12 13
  (block done
    (let ((x (loop for i from 0 to 19 collect i)))
      (loop
       for i from 0 to 20 do
       (loop
sds's avatar
sds committed
14 15 16 17 18
        for j from i to 20 do
        (let ((y (subseq x i j)))
          (loop
           for e in y and k from i to (1- j) do
           (unless (eqlt e k) (return-from done nil)))))))
19 20
    t))

21
(defun subseq-list.5-body ()
22 23 24 25 26
  (block done
    (let ((x (loop for i from 0 to 29 collect i)))
      (loop
       for i from 0 to 30 do
       (unless (equalt (subseq x i)
sds's avatar
sds committed
27 28
                       (loop for j from i to 29 collect j))
         (return-from done nil))))
29 30
    t))

31
(defun subseq-list.6-body ()
32
  (let* ((x (make-list 100))
sds's avatar
sds committed
33 34
         (z (loop for e on x collect e))
         (y (subseq x 0)))
35 36 37 38 39
    (loop
     for e on x
     and f on y
     and g in z do
     (when (or (not (eqt g e))
sds's avatar
sds committed
40 41 42
               (not (eqlt (car e) (car f)))
               (car e)
               (eqt e f))
43 44 45
       (return nil))
     finally (return t))))

46
(defun subseq-vector.1-body ()
47 48
  (block nil
  (let* ((x (make-sequence 'vector 10 :initial-element 'a))
sds's avatar
sds committed
49
         (y (subseq x 4 8)))
50 51 52 53 54 55
    (unless (every #'(lambda (e) (eqt e 'a)) x)
      (return 1))
    (unless (every #'(lambda (e) (eqt e 'a)) y)
      (return 2))
    (unless (eqlt (length x) 10) (return 3))
    (unless (eqlt (length y) 4)  (return 4))
56
    (loop for i from 0 to 9 do (setf (elt x i) 'b))
57 58
    (unless (every #'(lambda (e) (eqt e 'a)) y)
      (return 5))
59
    (loop for i from 0 to 3 do (setf (elt y i) 'c))
60 61 62 63
    (or
     (not (not (every #'(lambda (e) (eqt e 'b)) x)))
     6))))

64
(defun subseq-vector.2-body ()
65 66
  (block nil
  (let* ((x (make-sequence '(vector fixnum) 10 :initial-element 1))
sds's avatar
sds committed
67
         (y (subseq x 4 8)))
68 69 70 71 72 73
    (unless (every #'(lambda (e) (eqlt e 1)) x)
      (return 1))
    (unless (every #'(lambda (e) (eqlt e 1)) y)
      (return 2))
    (unless (eqlt (length x) 10) (return 3))
    (unless (eqlt (length y) 4)  (return 4))
74
    (loop for i from 0 to 9 do (setf (elt x i) 2))
75 76
    (unless (every #'(lambda (e) (eqlt e 1)) y)
      (return 5))
77
    (loop for i from 0 to 3 do (setf (elt y i) 3))
78 79 80 81
    (or
     (not (not (every #'(lambda (e) (eqlt e 2)) x)))
     6))))

82
(defun subseq-vector.3-body ()
83 84
  (block nil
  (let* ((x (make-sequence '(vector single-float) 10 :initial-element 1.0))
sds's avatar
sds committed
85
         (y (subseq x 4 8)))
86 87 88 89 90 91
    (unless (every #'(lambda (e) (= e 1.0)) x)
      (return 1))
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 2))
    (unless (eqlt (length x) 10) (return 3))
    (unless (eqlt (length y) 4)  (return 4))
92
    (loop for i from 0 to 9 do (setf (elt x i) 2.0))
93 94
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 5))
95
    (loop for i from 0 to 3 do (setf (elt y i) 3.0))
96 97 98 99
    (or
     (not (not (every #'(lambda (e) (= e 2.0)) x)))
     6))))

100
(defun subseq-vector.4-body ()
101 102
  (block nil
  (let* ((x (make-sequence '(vector double-float) 10 :initial-element 1.0d0))
sds's avatar
sds committed
103
         (y (subseq x 4 8)))
104 105 106 107 108 109
    (unless (every #'(lambda (e) (= e 1.0)) x)
      (return 1))
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 2))
    (unless (eqlt (length x) 10) (return 3))
    (unless (eqlt (length y) 4)  (return 4))
110
    (loop for i from 0 to 9 do (setf (elt x i) 2.0d0))
111 112
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 5))
113
    (loop for i from 0 to 3 do (setf (elt y i) 3.0d0))
114 115 116 117
    (or
     (not (not (every #'(lambda (e) (= e 2.0)) x)))
     6))))

118
(defun subseq-vector.5-body ()
119 120
  (block nil
  (let* ((x (make-sequence '(vector short-float) 10 :initial-element 1.0s0))
sds's avatar
sds committed
121
         (y (subseq x 4 8)))
122 123 124 125 126 127
    (unless (every #'(lambda (e) (= e 1.0)) x)
      (return 1))
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 2))
    (unless (eqlt (length x) 10) (return 3))
    (unless (eqlt (length y) 4)  (return 4))
128
    (loop for i from 0 to 9 do (setf (elt x i) 2.0s0))
129 130
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 5))
131
    (loop for i from 0 to 3 do (setf (elt y i) 3.0s0))
132 133 134 135
    (or
     (not (not (every #'(lambda (e) (= e 2.0)) x)))
     6))))

136
(defun subseq-vector.6-body ()
137 138
  (block nil
  (let* ((x (make-sequence '(vector long-float) 10 :initial-element 1.0l0))
sds's avatar
sds committed
139
         (y (subseq x 4 8)))
140 141 142 143 144 145
    (unless (every #'(lambda (e) (= e 1.0)) x)
      (return 1))
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 2))
    (unless (eqlt (length x) 10) (return 3))
    (unless (eqlt (length y) 4)  (return 4))
146
    (loop for i from 0 to 9 do (setf (elt x i) 2.0l0))
147 148
    (unless (every #'(lambda (e) (= e 1.0)) y)
      (return 5))
149
    (loop for i from 0 to 3 do (setf (elt y i) 3.0l0))
150 151 152 153
    (or
     (not (not (every #'(lambda (e) (= e 2.0)) x)))
     6))))

154
(defun subseq-string.1-body ()
155
  (let* ((s1 "abcdefgh")
sds's avatar
sds committed
156
         (len (length s1)))
157
    (loop for start from 0 below len
sds's avatar
sds committed
158 159 160 161 162
          always
          (string= (subseq s1 start)
                   (coerce (loop for i from start to (1- len)
                                 collect (elt s1 i))
                           'string)))))
163

164
(defun subseq-string.2-body ()
165
  (let* ((s1 "abcdefgh")
sds's avatar
sds committed
166
         (len (length s1)))
167
    (loop for start from 0 below len
sds's avatar
sds committed
168 169 170 171 172 173 174
          always
          (loop for end from (1+ start) to len
                always
                (string= (subseq s1 start end)
                         (coerce (loop for i from start below end
                                       collect (elt s1 i))
                                 'string))))))
175

176
(defun subseq-string.3-body ()
177
  (let* ((s1 (make-array '(10) :initial-contents "abcdefghij"
sds's avatar
sds committed
178 179 180
                         :fill-pointer 8
                         :element-type 'character))
         (len (length s1)))
181 182 183
    (and
     (eqlt len 8)
     (loop for start from 0 below len
sds's avatar
sds committed
184 185 186 187 188
          always
          (string= (subseq s1 start)
                   (coerce (loop for i from start to (1- len)
                                 collect (elt s1 i))
                           'string)))
189
     (loop for start from 0 below len
sds's avatar
sds committed
190 191 192 193 194 195 196
           always
           (loop for end from (1+ start) to len
                 always
                 (string= (subseq s1 start end)
                          (coerce (loop for i from start below end
                                        collect (elt s1 i))
                                  'string)))))))
197
(defun subseq-bit-vector.1-body ()
198
  (let* ((s1 #*11001000)
sds's avatar
sds committed
199
         (len (length s1)))
200
    (loop for start from 0 below len
sds's avatar
sds committed
201 202 203 204 205
          always
          (equalp (subseq s1 start)
                  (coerce (loop for i from start to (1- len)
                                collect (elt s1 i))
                          'bit-vector)))))
206

207
(defun subseq-bit-vector.2-body ()
208
  (let* ((s1 #*01101011)
sds's avatar
sds committed
209
         (len (length s1)))
210
    (loop for start from 0 below len
sds's avatar
sds committed
211 212 213 214 215 216 217
          always
          (loop for end from (1+ start) to len
                always
                (equalp (subseq s1 start end)
                        (coerce (loop for i from start below end
                                      collect (elt s1 i))
                                'bit-vector))))))
218

219
(defun subseq-bit-vector.3-body ()
220
  (let* ((s1 (make-array '(10) :initial-contents #*1101100110
sds's avatar
sds committed
221 222 223
                         :fill-pointer 8
                         :element-type 'bit))
         (len (length s1)))
224 225 226
    (and
     (eqlt len 8)
     (loop for start from 0 below len
sds's avatar
sds committed
227 228 229 230 231
          always
          (equalp (subseq s1 start)
                  (coerce (loop for i from start to (1- len)
                                collect (elt s1 i))
                          'bit-vector)))
232
     (loop for start from 0 below len
sds's avatar
sds committed
233 234 235 236 237 238 239
           always
           (loop for end from (1+ start) to len
                 always
                 (equalp (subseq s1 start end)
                         (coerce (loop for i from start below end
                                       collect (elt s1 i))
                                 'bit-vector)))))))