1 ;;;; This file is for testing external-format functionality, using
2 ;;;; test machinery which might have side effects (e.g. executing
3 ;;;; DEFUN, writing files). Note that the tests here reach into
4 ;;;; unexported functionality, and should not be used as a guide for
7 ;;;; This software is part of the SBCL system. See the README file for
10 ;;;; While most of SBCL is derived from the CMU CL system, the test
11 ;;;; files (like this one) were written from scratch after the fork
14 ;;;; This software is in the public domain and is provided with
15 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
16 ;;;; more information.
18 (defmacro do-external-formats
((xf &optional result
) &body body
)
20 `(dolist (,nxf sb-impl
::*external-formats
* ,result
)
21 (let ((,xf
(first (first ,nxf
))))
24 (do-external-formats (xf)
25 (with-open-file (s "/dev/null" :direction
:input
:external-format xf
)
26 (assert (eq (read-char s nil s
) s
))))
28 ;;; Test standard character read-write equivalency over all external formats.
29 (let ((standard-characters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!$\"'(),_-./:;?+<=>#%&*@[\\]{|}`^~"))
30 (do-external-formats (xf)
31 (with-open-file (s "external-format-test.txt" :direction
:output
32 :if-exists
:supersede
:external-format xf
)
33 (loop for character across standard-characters
34 do
(write-char character s
)))
35 (with-open-file (s "external-format-test.txt" :direction
:input
37 (loop for character across standard-characters
38 do
(assert (eql (read-char s
) character
))))))
40 (delete-file "external-format-test.txt")
43 (test-util:report-test-status
)
44 (sb-ext:quit
:unix-status
104))
46 ;;; Test UTF-8 writing and reading of 1, 2, 3 and 4 octet characters with
47 ;;; all possible offsets. Tests for buffer edge bugs. fd-stream buffers are
50 (let ((character (code-char (elt '(1 #x81
#x801
#x10001
) width-1
))))
51 (dotimes (offset (+ width-1
1))
52 (with-open-file (s "external-format-test.txt" :direction
:output
53 :if-exists
:supersede
:external-format
:utf-8
)
57 (write-char character s
)))
58 (with-open-file (s "external-format-test.txt" :direction
:input
59 :external-format
:utf-8
)
61 (assert (eql (read-char s
) #\a)))
63 (assert (eql (read-char s
) character
)))
64 (assert (eql (read-char s nil s
) s
))))))
66 ;;; Test character decode restarts.
67 (with-open-file (s "external-format-test.txt" :direction
:output
68 :if-exists
:supersede
:element-type
'(unsigned-byte 8))
73 (with-open-file (s "external-format-test.txt" :direction
:input
74 :external-format
:utf-8
)
76 ((sb-int:character-decoding-error
#'(lambda (decoding-error)
77 (declare (ignore decoding-error
))
79 'sb-int
:attempt-resync
))))
80 (assert (equal (read-line s nil s
) "ABC"))
81 (assert (equal (read-line s nil s
) s
))))
82 (with-open-file (s "external-format-test.txt" :direction
:input
83 :external-format
:utf-8
)
85 ((sb-int:character-decoding-error
#'(lambda (decoding-error)
86 (declare (ignore decoding-error
))
88 'sb-int
:force-end-of-file
))))
89 (assert (equal (read-line s nil s
) "AB"))
90 (assert (equal (read-line s nil s
) s
))))
92 ;;; And again with more data to account for buffering (this was briefly)
93 ;;; broken in early 0.9.6.
94 (with-open-file (s "external-format-test.txt" :direction
:output
95 :if-exists
:supersede
:element-type
'(unsigned-byte 8))
96 (let ((a (make-array 50
97 :element-type
'(unsigned-byte 64)
98 :initial-contents
(map 'list
#'char-code
99 "1234567890123456789012345678901234567890123456789."))))
100 (setf (aref a
49) (char-code #\Newline
))
102 (write-sequence a s
))
105 (write-sequence a s
))))
106 (with-test (:name
(:character-decode-large
:attempt-resync
))
107 (with-open-file (s "external-format-test.txt" :direction
:input
108 :external-format
:utf-8
)
110 ((sb-int:character-decoding-error
#'(lambda (decoding-error)
111 (declare (ignore decoding-error
))
113 'sb-int
:attempt-resync
)))
114 ;; The failure mode is an infinite loop, add a timeout to detetct it.
115 (sb-ext:timeout
(lambda () (error "Timeout"))))
116 (sb-ext:with-timeout
5
118 (assert (equal (read-line s nil s
)
119 "1234567890123456789012345678901234567890123456789")))))))
120 (with-test (:name
(:character-decode-large
:force-end-of-file
)
122 (with-open-file (s "external-format-test.txt" :direction
:input
123 :external-format
:utf-8
)
125 ((sb-int:character-decoding-error
#'(lambda (decoding-error)
126 (declare (ignore decoding-error
))
128 'sb-int
:force-end-of-file
)))
129 ;; The failure mode is an infinite loop, add a timeout to detetct it.
130 (sb-ext:timeout
(lambda () (error "Timeout"))))
131 (sb-ext:with-timeout
5
133 (assert (equal (read-line s nil s
)
134 "1234567890123456789012345678901234567890123456789")))
135 (assert (equal (read-line s nil s
) s
))))))
137 ;;; Test character encode restarts.
138 (with-open-file (s "external-format-test.txt" :direction
:output
139 :if-exists
:supersede
:external-format
:latin-1
)
141 ((sb-int:character-encoding-error
#'(lambda (encoding-error)
142 (declare (ignore encoding-error
))
144 'sb-impl
::output-nothing
))))
147 (write-char (code-char 322) s
)
149 (with-open-file (s "external-format-test.txt" :direction
:input
150 :external-format
:latin-1
)
151 (assert (equal (read-line s nil s
) "ABC"))
152 (assert (equal (read-line s nil s
) s
)))
154 (with-open-file (s "external-format-test.txt" :direction
:output
155 :if-exists
:supersede
:external-format
:latin-1
)
157 ((sb-int:character-encoding-error
#'(lambda (encoding-error)
158 (declare (ignore encoding-error
))
160 'sb-impl
::output-nothing
))))
161 (let ((string (make-array 4 :element-type
'character
162 :initial-contents
`(#\A
#\B
,(code-char 322)
164 (write-string string s
))))
165 (with-open-file (s "external-format-test.txt" :direction
:input
166 :external-format
:latin-1
)
167 (assert (equal (read-line s nil s
) "ABC"))
168 (assert (equal (read-line s nil s
) s
)))
170 ;;; Test skipping character-decode-errors in comments.
171 (let ((s (open "external-format-test.lisp" :direction
:output
172 :if-exists
:supersede
:external-format
:latin-1
)))
175 (write-string ";;; ABCD" s
)
176 (write-char (code-char 233) s
)
179 (compile-file "external-format-test.lisp" :external-format
:utf-8
))
181 (let ((p (probe-file (compile-file-pathname "external-format-test.lisp"))))
186 ;;;; KOI8-R external format
187 (with-open-file (s "external-format-test.txt" :direction
:output
188 :if-exists
:supersede
:external-format
:koi8-r
)
189 (write-char (code-char #xB0
) s
)
193 (write-char (code-char #xBAAD
) s
)
195 (sb-int:character-encoding-error
()
198 (with-open-file (s "external-format-test.txt" :direction
:input
199 :element-type
'(unsigned-byte 8))
200 (let ((byte (read-byte s
)))
201 (assert (= (eval byte
) #x9C
))))
202 (with-open-file (s "external-format-test.txt" :direction
:input
203 :external-format
:koi8-r
)
204 (let ((char (read-char s
)))
205 (assert (= (char-code (eval char
)) #xB0
))))
208 (delete-file "external-format-test.txt")