write-sequence.lsp 7.89 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5 6 7 8 9 10 11
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Wed Jan 21 04:07:58 2004
;;;; Contains: Tests of WRITE-SEQUENCE

(in-package :cl-test)

(defmacro def-write-sequence-test (name input args &rest expected)
  `(deftest ,name
     (let ((s ,input))
       (with-output-to-string
sds's avatar
sds committed
12 13
         (os)
         (assert (eq (write-sequence s os ,@args) s))))
pfdietz's avatar
pfdietz committed
14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
     ,@expected))

;;; on strings

(def-write-sequence-test write-sequence.string.1 "abcde" () "abcde")
(def-write-sequence-test write-sequence.string.2 "abcde" (:start 1) "bcde")
(def-write-sequence-test write-sequence.string.3 "abcde" (:end 3) "abc")
(def-write-sequence-test write-sequence.string.4 "abcde"
  (:start 1 :end 4) "bcd")
(def-write-sequence-test write-sequence.string.5 "abcde" (:end nil) "abcde")
(def-write-sequence-test write-sequence.string.6 "abcde" (:start 3 :end 3) "")
(def-write-sequence-test write-sequence.string.7 "abcde"
  (:end nil :start 1) "bcde")
(def-write-sequence-test write-sequence.string.8 "abcde"
  (:allow-other-keys nil) "abcde")
(def-write-sequence-test write-sequence.string.9 "abcde"
  (:allow-other-keys t :foo nil) "abcde")
(def-write-sequence-test write-sequence.string.10 "abcde"
  (:allow-other-keys t :allow-other-keys nil :foo nil) "abcde")
(def-write-sequence-test write-sequence.string.11 "abcde"
  (:bar 'x :allow-other-keys t) "abcde")
(def-write-sequence-test write-sequence.string.12 "abcde"
  (:start 1 :end 4 :start 2 :end 3) "bcd")
(def-write-sequence-test write-sequence.string.13 "" () "")

39 40 41
(defmacro def-write-sequence-special-test (name string args expected)
  `(deftest ,name
     (let ((str ,string)
sds's avatar
sds committed
42
           (expected ,expected))
43
       (do-special-strings
sds's avatar
sds committed
44 45 46 47 48
        (s str nil)
        (let ((out (with-output-to-string
                     (os)
                     (assert (eq (write-sequence s os ,@args) s)))))
          (assert (equal out expected)))))
49 50 51 52
     nil))

(def-write-sequence-special-test write-sequence.string.14 "12345" () "12345")
(def-write-sequence-special-test write-sequence.string.15 "12345" (:start 1 :end 3) "23")
pfdietz's avatar
pfdietz committed
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118

;;; on lists

(def-write-sequence-test write-sequence.list.1 (coerce "abcde" 'list)
  () "abcde")
(def-write-sequence-test write-sequence.list.2 (coerce "abcde" 'list)
  (:start 1) "bcde")
(def-write-sequence-test write-sequence.list.3 (coerce "abcde" 'list)
  (:end 3) "abc")
(def-write-sequence-test write-sequence.list.4 (coerce "abcde" 'list)
  (:start 1 :end 4) "bcd")
(def-write-sequence-test write-sequence.list.5 (coerce "abcde" 'list)
  (:end nil) "abcde")
(def-write-sequence-test write-sequence.list.6 (coerce "abcde" 'list)
  (:start 3 :end 3) "")
(def-write-sequence-test write-sequence.list.7 (coerce "abcde" 'list)
  (:end nil :start 1) "bcde")
(def-write-sequence-test write-sequence.list.8 () () "")


;;; on vectors

(def-write-sequence-test write-sequence.simple-vector.1
  (coerce "abcde" 'simple-vector) () "abcde")
(def-write-sequence-test write-sequence.simple-vector.2
  (coerce "abcde" 'simple-vector) (:start 1) "bcde")
(def-write-sequence-test write-sequence.simple-vector.3
  (coerce "abcde" 'simple-vector) (:end 3) "abc")
(def-write-sequence-test write-sequence.simple-vector.4
  (coerce "abcde" 'simple-vector) (:start 1 :end 4) "bcd")
(def-write-sequence-test write-sequence.simple-vector.5
  (coerce "abcde" 'simple-vector) (:end nil) "abcde")
(def-write-sequence-test write-sequence.simple-vector.6
  (coerce "abcde" 'simple-vector) (:start 3 :end 3) "")
(def-write-sequence-test write-sequence.simple-vector.7
  (coerce "abcde" 'simple-vector) (:end nil :start 1) "bcde")
(def-write-sequence-test write-sequence.simple-vector.8 #() () "")

;;; on vectors with fill pointers

(def-write-sequence-test write-sequence.fill-vector.1
  (make-array 10 :initial-contents "abcde     " :fill-pointer 5) () "abcde")
(def-write-sequence-test write-sequence.fill-vector.2
  (make-array 10 :initial-contents "abcde     " :fill-pointer 5)
  (:start 1) "bcde")
(def-write-sequence-test write-sequence.fill-vector.3
  (make-array 10 :initial-contents "abcde     " :fill-pointer 5)
  (:end 3) "abc")
(def-write-sequence-test write-sequence.fill-vector.4
  (make-array 10 :initial-contents "abcde     " :fill-pointer 5)
  (:start 1 :end 4) "bcd")
(def-write-sequence-test write-sequence.fill-vector.5
  (make-array 10 :initial-contents "abcde     " :fill-pointer 5)
  (:end nil) "abcde")
(def-write-sequence-test write-sequence.fill-vector.6
  (make-array 10 :initial-contents "abcde     " :fill-pointer 5)
  (:start 3 :end 3) "")
(def-write-sequence-test write-sequence.fill-vector.7
  (make-array 10 :initial-contents "abcde     " :fill-pointer 5)
  (:end nil :start 1) "bcde")

;;; on bit vectors

(defmacro def-write-sequence-bv-test (name input args expected)
  `(deftest ,name
     (let ((s ,input)
sds's avatar
sds committed
119
           (expected ,expected))
pfdietz's avatar
pfdietz committed
120
       (with-open-file
sds's avatar
sds committed
121 122 123 124
        (os "tmp.dat" :direction :output
            :element-type '(unsigned-byte 8)
            :if-exists :supersede)
         (assert (eq (write-sequence s os ,@args) s)))
pfdietz's avatar
pfdietz committed
125
       (with-open-file
sds's avatar
sds committed
126 127 128 129 130
        (is "tmp.dat" :direction :input
            :element-type '(unsigned-byte 8))
         (loop for i from 0 below (length expected)
               for e = (elt expected i)
               always (eql (read-byte is) e))))
pfdietz's avatar
pfdietz committed
131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174
     t))

(def-write-sequence-bv-test write-sequence.bv.1 #*00111010
  () #*00111010)
(def-write-sequence-bv-test write-sequence.bv.2 #*00111010
  (:start 1) #*0111010)
(def-write-sequence-bv-test write-sequence.bv.3 #*00111010
  (:end 5) #*00111)
(def-write-sequence-bv-test write-sequence.bv.4 #*00111010
  (:start 1 :end 6) #*01110)
(def-write-sequence-bv-test write-sequence.bv.5 #*00111010
  (:start 1 :end nil) #*0111010)
(def-write-sequence-bv-test write-sequence.bv.6 #*00111010
  (:start 1 :end nil :end 4) #*0111010)


;;; Error tests

(deftest write-sequence.error.1
  (signals-error (write-sequence) program-error)
  t)

(deftest write-sequence.error.2
  (signals-error (write-sequence "abcde") program-error)
  t)

(deftest write-sequence.error.3
  (signals-error (write-sequence '(#\a . #\b) *standard-output*) type-error)
  t)

(deftest write-sequence.error.4
  (signals-error (write-sequence #\a *standard-output*) type-error)
  t)

(deftest write-sequence.error.5
  (signals-error (write-sequence "ABC" *standard-output* :start -1) type-error)
  t)

(deftest write-sequence.error.6
  (signals-error (write-sequence "ABC" *standard-output* :start 'x) type-error)
  t)

(deftest write-sequence.error.7
  (signals-error (write-sequence "ABC" *standard-output* :start 0.0)
sds's avatar
sds committed
175
                 type-error)
pfdietz's avatar
pfdietz committed
176 177 178 179
  t)

(deftest write-sequence.error.8
  (signals-error (write-sequence "ABC" *standard-output* :end -1)
sds's avatar
sds committed
180
                 type-error)
pfdietz's avatar
pfdietz committed
181 182 183 184
  t)

(deftest write-sequence.error.9
  (signals-error (write-sequence "ABC" *standard-output* :end 'x)
sds's avatar
sds committed
185
                 type-error)
pfdietz's avatar
pfdietz committed
186 187 188 189
  t)

(deftest write-sequence.error.10
  (signals-error (write-sequence "ABC" *standard-output* :end 2.0)
sds's avatar
sds committed
190
                 type-error)
pfdietz's avatar
pfdietz committed
191 192 193 194
  t)

(deftest write-sequence.error.11
  (signals-error (write-sequence "abcde" *standard-output*
sds's avatar
sds committed
195
                                 :foo nil) program-error)
pfdietz's avatar
pfdietz committed
196
  t)
sds's avatar
sds committed
197

pfdietz's avatar
pfdietz committed
198 199
(deftest write-sequence.error.12
  (signals-error (write-sequence "abcde" *standard-output*
sds's avatar
sds committed
200 201
                                 :allow-other-keys nil :foo t)
                 program-error)
pfdietz's avatar
pfdietz committed
202 203 204 205
  t)

(deftest write-sequence.error.13
  (signals-error (write-sequence "abcde" *standard-output* :start)
sds's avatar
sds committed
206
                 program-error)
pfdietz's avatar
pfdietz committed
207
  t)
208 209 210

(deftest write-sequence.error.14
  (check-type-error #'(lambda (x) (write-sequence x *standard-output*))
sds's avatar
sds committed
211
                    #'sequencep)
212 213 214 215
  nil)

(deftest write-sequence.error.15
  (check-type-error #'(lambda (x) (write-sequence "abcde" *standard-output*
sds's avatar
sds committed
216 217
                                                  :start x))
                    (typef 'unsigned-byte))
218 219 220 221
  nil)

(deftest write-sequence.error.16
  (check-type-error #'(lambda (x) (write-sequence "abcde" *standard-output*
sds's avatar
sds committed
222 223
                                                  :end x))
                    (typef '(or null unsigned-byte)))
224 225
  nil)