Add :application-type parameter for save-lisp-and-die on Windows.
[sbcl.git] / tests / external-format.impure.lisp
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
5 ;;;; users.
6
7 ;;;; This software is part of the SBCL system. See the README file for
8 ;;;; more information.
9 ;;;;
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
12 ;;;; from CMU CL.
13 ;;;;
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.
17
18 (defmacro do-external-formats ((xf &optional result) &body body)
19   (let ((nxf (gensym)))
20     `(loop for ,nxf being the hash-values of sb-impl::*external-formats*
21         do (let ((,xf (first (sb-impl::ef-names ,nxf))))
22              ,@body))))
23
24 (defvar *test-path* "external-format-test.tmp")
25
26 (with-test (:name :end-of-file)
27   (do-external-formats (xf)
28     (with-open-file (s #-win32 "/dev/null" #+win32 "nul" :direction :input :external-format xf)
29       (assert (eq (read-char s nil s) s)))))
30
31 ;;; Test standard character read-write equivalency over all external formats.
32 (macrolet
33     ((frob ()
34        (let ((tests nil))
35          (do-external-formats (xf)
36            (pushnew `(with-test (:name (:standard-character :read-write-equivalency ,xf))
37                        (let ((standard-characters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!$\"'(),_-./:;?+<=>#%&*@[\\]{|}`^~"))
38                          (with-open-file (s *test-path* :direction :output
39                                             :if-exists :supersede :external-format ,xf)
40                            (loop for character across standard-characters
41                                  do (write-char character s)))
42                          (with-open-file (s *test-path* :direction :input
43                                             :external-format ,xf)
44                            (loop for character across standard-characters
45                                  do (let ((got (read-char s)))
46                                       (unless (eql character got)
47                                         (error "wanted ~S, got ~S" character got)))))))
48                     tests :key #'cadr :test #'equal))
49          `(progn ,@tests))))
50   (frob))
51
52 (delete-file *test-path*)
53 #-sb-unicode
54 (progn
55   (test-util:report-test-status)
56   (sb-ext:exit :code 104))
57
58 ;;; Test UTF-8 writing and reading of 1, 2, 3 and 4 octet characters with
59 ;;; all possible offsets. Tests for buffer edge bugs. fd-stream buffers are
60 ;;; 4096 wide.
61 (dotimes (width-1 4)
62   (let ((character (code-char (elt '(1 #x81 #x801 #x10001) width-1))))
63     (dotimes (offset (+ width-1 1))
64       (with-open-file (s *test-path* :direction :output
65                        :if-exists :supersede :external-format :utf-8)
66         (dotimes (n offset)
67           (write-char #\a s))
68         (dotimes (n (+ 4 sb-impl::+bytes-per-buffer+))
69           (write-char character s)))
70       (with-open-file (s *test-path* :direction :input
71                        :external-format :utf-8)
72         (dotimes (n offset)
73           (assert (eql (read-char s) #\a)))
74         (dotimes (n (+ 4 sb-impl::+bytes-per-buffer+))
75           (let ((got (read-char s)))
76             (unless (eql got character)
77               (error "wanted ~S, got ~S (~S)" character got n))))
78         (assert (eql (read-char s nil s) s))))))
79
80 ;;; Test character decode restarts.
81 (with-open-file (s *test-path* :direction :output
82                  :if-exists :supersede :element-type '(unsigned-byte 8))
83   (write-byte 65 s)
84   (write-byte 66 s)
85   (write-byte #xe0 s)
86   (write-byte 67 s))
87 (with-open-file (s *test-path* :direction :input
88                  :external-format :utf-8)
89   (let ((count 0))
90     (handler-bind
91         ((sb-int:character-decoding-error #'(lambda (decoding-error)
92                                               (declare (ignore decoding-error))
93                                               (when (> (incf count) 1)
94                                                 (error "too many errors"))
95                                               (invoke-restart
96                                                'sb-int:attempt-resync))))
97       (assert (equal (read-line s nil s) "ABC"))
98       (assert (equal (read-line s nil s) s)))))
99 (with-open-file (s *test-path* :direction :input
100                  :external-format :utf-8)
101   (let ((count 0))
102     (handler-bind
103         ((sb-int:character-decoding-error #'(lambda (decoding-error)
104                                               (declare (ignore decoding-error))
105                                               (when (> (incf count) 1)
106                                                 (error "too many errors"))
107                                               (invoke-restart
108                                                'sb-int:force-end-of-file))))
109       (assert (equal (read-line s nil s) "AB"))
110       (setf count 0)
111       (assert (equal (read-line s nil s) s)))))
112
113 ;;; And again with more data to account for buffering (this was briefly)
114 ;;; broken in early 0.9.6.
115 (with-open-file (s *test-path* :direction :output
116                  :if-exists :supersede :element-type '(unsigned-byte 8))
117   (let ((a (make-array 50
118                        :element-type '(unsigned-byte 64)
119                        :initial-contents (map 'list #'char-code
120                                               "1234567890123456789012345678901234567890123456789."))))
121     (setf (aref a 49) (char-code #\Newline))
122     (dotimes (i 40)
123       (write-sequence a s))
124     (write-byte #xe0 s)
125     (dotimes (i 40)
126       (write-sequence a s))))
127 (with-test (:name (:character-decode-large :attempt-resync))
128   (with-open-file (s *test-path* :direction :input
129                      :external-format :utf-8)
130     (let ((count 0))
131       (handler-bind
132           ((sb-int:character-decoding-error (lambda (decoding-error)
133                                               (declare (ignore decoding-error))
134                                               (when (> (incf count) 1)
135                                                 (error "too many errors"))
136                                               (invoke-restart
137                                                'sb-int:attempt-resync)))
138            ;; The failure mode is an infinite loop, add a timeout to
139            ;; detetct it.
140            (sb-ext:timeout (lambda () (error "Timeout"))))
141         (sb-ext:with-timeout 5
142           (dotimes (i 80)
143             (assert (equal (read-line s nil s)
144                            "1234567890123456789012345678901234567890123456789"))))))))
145
146 (with-test (:name (:character-decode-large :force-end-of-file))
147   (with-open-file (s *test-path* :direction :input
148                      :external-format :utf-8)
149     (let ((count 0))
150       (handler-bind
151           ((sb-int:character-decoding-error (lambda (decoding-error)
152                                               (declare (ignore decoding-error))
153                                               (when (> (incf count) 1)
154                                                 (error "too many errors"))
155                                               (invoke-restart
156                                                'sb-int:force-end-of-file)))
157            ;; The failure mode is an infinite loop, add a timeout to detetct it.
158            (sb-ext:timeout (lambda () (error "Timeout"))))
159         (sb-ext:with-timeout 5
160           (dotimes (i 40)
161             (assert (equal (read-line s nil s)
162                            "1234567890123456789012345678901234567890123456789")))
163           (setf count 0)
164           (assert (equal (read-line s nil s) s)))))))
165
166 ;;; Test character encode restarts.
167 (with-open-file (s *test-path* :direction :output
168                  :if-exists :supersede :external-format :latin-1)
169   (handler-bind
170       ((sb-int:character-encoding-error #'(lambda (encoding-error)
171                                             (declare (ignore encoding-error))
172                                             (invoke-restart
173                                              'sb-impl::output-nothing))))
174     (write-char #\A s)
175     (write-char #\B s)
176     (write-char (code-char 322) s)
177     (write-char #\C s)))
178 (with-open-file (s *test-path* :direction :input
179                  :external-format :latin-1)
180   (assert (equal (read-line s nil s) "ABC"))
181   (assert (equal (read-line s nil s) s)))
182
183 (with-open-file (s *test-path* :direction :output
184                  :if-exists :supersede :external-format :latin-1)
185   (handler-bind
186       ((sb-int:character-encoding-error #'(lambda (encoding-error)
187                                             (declare (ignore encoding-error))
188                                             (invoke-restart
189                                              'sb-impl::output-nothing))))
190     (let ((string (make-array 4 :element-type 'character
191                               :initial-contents `(#\A #\B ,(code-char 322)
192                                                       #\C))))
193       (write-string string s))))
194 (with-open-file (s *test-path* :direction :input
195                  :external-format :latin-1)
196   (assert (equal (read-line s nil s) "ABC"))
197   (assert (equal (read-line s nil s) s)))
198
199 ;;; Test skipping character-decode-errors in comments.
200 (let ((s (open "external-format-test.lisp" :direction :output
201                :if-exists :supersede :external-format :latin-1)))
202   (unwind-protect
203        (progn
204          (write-string ";;; ABCD" s)
205          (write-char (code-char 233) s)
206          (terpri s)
207          (close s)
208          (compile-file "external-format-test.lisp" :external-format :utf-8))
209     (delete-file s)
210     (let ((p (probe-file (compile-file-pathname "external-format-test.lisp"))))
211       (when p
212         (delete-file p)))))
213
214 \f
215 ;;;; KOI8-R external format
216 (with-open-file (s *test-path* :direction :output
217                  :if-exists :supersede :external-format :koi8-r)
218   (write-char (code-char #xB0) s)
219   (assert (eq
220            (handler-case
221                (progn
222                  (write-char (code-char #xBAAD) s)
223                  :bad)
224              (sb-int:character-encoding-error ()
225                :good))
226            :good)))
227 (with-open-file (s *test-path* :direction :input
228                  :element-type '(unsigned-byte 8))
229   (let ((byte (read-byte s)))
230     (assert (= (eval byte) #x9C))))
231 (with-open-file (s *test-path* :direction :input
232                  :external-format :koi8-r)
233   (let ((char (read-char s)))
234     (assert (= (char-code (eval char)) #xB0))))
235 (delete-file *test-path*)
236
237 (let* ((koi8-r-codes (coerce '(240 210 201 215 197 212 33) '(vector (unsigned-byte 8))))
238        (uni-codes #(1055 1088 1080 1074 1077 1090 33))
239
240        (string (octets-to-string koi8-r-codes :external-format :koi8-r))
241        (uni-decoded (map 'vector #'char-code string)))
242   (assert (equalp (map 'vector #'char-code (octets-to-string koi8-r-codes :external-format :koi8-r))
243                   uni-codes))
244   (assert (equalp (string-to-octets (map 'string #'code-char uni-codes) :external-format :koi8-r)
245                   koi8-r-codes)))
246 \f
247 ;;; tests of FILE-STRING-LENGTH
248 (let ((standard-characters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!$\"'(),_-./:;?+<=>#%&*@[\\]{|}`^~"))
249   (do-external-formats (xf)
250     (with-open-file (s *test-path* :direction :output
251                        :external-format xf)
252       (loop for x across standard-characters
253             for position = (file-position s)
254             for char-length = (file-string-length s x)
255             do (write-char x s)
256             do (assert (= (file-position s) (+ position char-length))))
257       (let ((position (file-position s))
258             (string-length (file-string-length s standard-characters)))
259         (write-string standard-characters s)
260         (assert (= (file-position s) (+ position string-length)))))
261     (delete-file *test-path*)))
262
263 (let ((char-codes '(0 1 255 256 511 512 1023 1024 2047 2048 4095 4096
264                     8191 8192 16383 16384 32767 32768 65535 65536 131071
265                     131072 262143 262144)))
266   (with-open-file (s *test-path* :direction :output
267                      :external-format :utf-8)
268     (dolist (code char-codes)
269       (let* ((char (code-char code))
270              (position (file-position s))
271              (char-length (file-string-length s char)))
272         (write-char char s)
273         (assert (= (file-position s) (+ position char-length)))))
274     (let* ((string (map 'string #'code-char char-codes))
275            (position (file-position s))
276            (string-length (file-string-length s string)))
277       (write-string string s)
278       (assert (= (file-position s) (+ position string-length))))))
279 \f
280
281 ;;; See sbcl-devel "Subject: Bug in FILE-POSITION on UTF-8-encoded files"
282 ;;; by Lutz Euler on 2006-03-05 for more details.
283 (with-test (:name (:file-position :utf-8))
284   (let ((path *test-path*))
285     (with-open-file (s path
286                        :direction :output
287                        :if-exists :supersede
288                        :element-type '(unsigned-byte 8))
289       ;; Write #\*, encoded in UTF-8, to the file.
290       (write-byte 42 s)
291       ;; Append #\adiaeresis, encoded in UTF-8, to the file.
292       (write-sequence '(195 164) s))
293     (with-open-file (s path :external-format :utf-8)
294       (read-char s)
295       (let ((pos (file-position s))
296             (char (read-char s)))
297         (format t "read character with code ~a successfully from file position ~a~%"
298                 (char-code char) pos)
299         (file-position s pos)
300         (format t "set file position back to ~a, trying to read-char again~%" pos)
301         (let ((new-char (read-char s)))
302           (assert (char= char new-char)))))
303     (values)))
304 (delete-file *test-path*)
305
306 ;;; We used to call STREAM-EXTERNAL-FORMAT on the stream in the error
307 ;;; when printing a coding error, but that didn't work if the stream
308 ;;; was closed by the time the error was printed.  See sbcl-devel
309 ;;; "Subject: Printing coding errors for closed streams" by Zach Beane
310 ;;; on 2008-10-16 for more info.
311 (with-test (:name (:character-coding-error-stream-external-format))
312   (flet ((first-file-character ()
313            (with-open-file (stream *test-path* :external-format :utf-8)
314              (read-char stream))))
315     (with-open-file (stream *test-path*
316                             :direction :output
317                             :if-exists :supersede
318                             :element-type '(unsigned-byte 8))
319       (write-byte 192 stream))
320     (princ-to-string (nth-value 1 (ignore-errors (first-file-character))))))
321 (delete-file *test-path*)
322
323 ;;; External format support in SB-ALIEN
324
325 (with-test (:name (:sb-alien :vanilla))
326   (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup)
327       c-string
328     (str c-string))
329   (assert (equal "foo" (strdup "foo"))))
330
331 (with-test (:name (:sb-alien :utf-8 :utf-8))
332   (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup)
333       (c-string :external-format :utf-8)
334     (str (c-string :external-format :utf-8)))
335   (assert (equal "foo" (strdup "foo"))))
336
337 (with-test (:name (:sb-alien :latin-1 :utf-8))
338   (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup)
339       (c-string :external-format :latin-1)
340     (str (c-string :external-format :utf-8)))
341   (assert (= (length (strdup (string (code-char 246))))
342              2)))
343
344 (with-test (:name (:sb-alien :utf-8 :latin-1))
345   (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup)
346       (c-string :external-format :utf-8)
347     (str (c-string :external-format :latin-1)))
348   (assert (equal (string (code-char 228))
349                  (strdup (concatenate 'string
350                                       (list (code-char 195))
351                                       (list (code-char 164)))))))
352
353 (with-test (:name (:sb-alien :ebcdic :ebcdic))
354   (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup)
355       (c-string :external-format :ebcdic-us)
356     (str (c-string :external-format :ebcdic-us)))
357   (assert (equal "foo" (strdup "foo"))))
358
359 (with-test (:name (:sb-alien :latin-1 :ebcdic))
360   (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup)
361       (c-string :external-format :latin-1)
362     (str (c-string :external-format :ebcdic-us)))
363   (assert (not (equal "foo" (strdup "foo")))))
364
365 (with-test (:name (:sb-alien :simple-base-string))
366   (define-alien-routine (#-win32 "strdup" #+win32 "_strdup" strdup)
367       (c-string :external-format :ebcdic-us
368                 :element-type base-char)
369     (str (c-string :external-format :ebcdic-us)))
370   (assert (typep (strdup "foo") 'simple-base-string)))
371
372 (with-test (:name (:input-replacement :at-end-of-file))
373   (dotimes (i 256)
374     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
375       (write-byte i s))
376     (handler-bind ((sb-int:character-decoding-error
377                     (lambda (c)
378                       (invoke-restart 'sb-impl::input-replacement #\?))))
379       (with-open-file (s *test-path* :external-format :utf-8)
380         (cond
381           ((char= (read-char s) #\?)
382            (assert (or (= i (char-code #\?)) (> i 127))))
383           (t (assert (and (not (= i (char-code #\?))) (< i 128)))))))))
384
385 (with-test (:name (:unibyte-invalid-codepoints :cp857))
386   (dotimes (i 256)
387     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
388       (write-byte i s))
389     (with-open-file (s *test-path* :external-format :cp857)
390       (handler-case (read-char s)
391         (error () (assert (member i '(#xd5 #xe7 #xf2))))
392         (:no-error (char) (assert (not (member i '(#xd5 #xe7 #xf2)))))))))
393 (delete-file *test-path*)
394
395 (with-test (:name (:unibyte-input-replacement :cp857))
396   (dotimes (i 256)
397     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
398       (write-byte i s))
399     (with-open-file (s *test-path* :external-format '(:cp857 :replacement #\?))
400       (let ((char (read-char s)))
401         (cond
402           ((eq char #\?)
403            (assert (member i `(,(char-code #\?) #xd5 #xe7 #xf2))))
404           (t (assert (not (member i `(,(char-code #\?) #xd5 #xe7 #xf2))))))))))
405 (delete-file *test-path*)
406
407 (with-test (:name (:unibyte-output-replacement :cp857))
408   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:cp857 :replacement #\?))
409     (dotimes (i 256)
410       (write-char (code-char i) s)))
411   (with-open-file (s *test-path* :external-format '(:cp857))
412     (let ((string (make-string 256)))
413       (read-sequence string s)
414       (dotimes (i 128)
415         (assert (= (char-code (char string i)) i)))
416       (assert (= 38 (count #\? string :start 128))))))
417 (delete-file *test-path*)
418
419 (with-test (:name (:unibyte-input-replacement :ascii))
420   (dotimes (i 256)
421     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
422       (write-byte i s))
423     (with-open-file (s *test-path* :external-format '(:ascii :replacement #\?))
424       (let ((char (read-char s)))
425         (cond
426           ((eq char #\?)
427            (assert (or (= i (char-code #\?)) (> i 127))))
428           (t (assert (and (< i 128) (not (= i (char-code #\?)))))))))))
429 (delete-file *test-path*)
430
431 (with-test (:name (:unibyte-output-replacement :ascii))
432   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:ascii :replacement #\?))
433     (dotimes (i 256)
434       (write-char (code-char i) s)))
435   (with-open-file (s *test-path* :external-format '(:ascii))
436     (let ((string (make-string 256)))
437       (read-sequence string s)
438       (dotimes (i 128)
439         (assert (= (char-code (char string i)) i)))
440       (assert (= 128 (count #\? string :start 128))))))
441 (delete-file *test-path*)
442
443 (with-test (:name (:unibyte-input-replacement :latin-1))
444   (dotimes (i 256)
445     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
446       (write-byte i s))
447     (with-open-file (s *test-path* :external-format '(:latin-1 :replacement #\?))
448       (let ((char (read-char s)))
449         (assert (= (char-code char) i))))))
450 (delete-file *test-path*)
451
452 (with-test (:name (:unibyte-output-replacement :latin-1))
453   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-1 :replacement #\?))
454     (dotimes (i 257)
455       (write-char (code-char i) s)))
456   (with-open-file (s *test-path* :external-format '(:latin-1))
457     (let ((string (make-string 257)))
458       (read-sequence string s)
459       (dotimes (i 256)
460         (assert (= (char-code (char string i)) i)))
461       (assert (char= #\? (char string 256))))))
462 (delete-file *test-path*)
463 \f
464 ;;; latin-2 tests
465 (with-test (:name (:unibyte-input-replacement :latin-2))
466   (dotimes (i 256)
467     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
468       (write-byte i s))
469     (with-open-file (s *test-path* :external-format '(:latin-2 :replacement #\?))
470       (let ((char (read-char s)))
471         (cond
472           ((< i #xa1) (assert (= (char-code char) i)))
473           ;; FIXME: more tests
474           )))))
475 (delete-file *test-path*)
476
477 (with-test (:name (:unibyte-output-replacement :latin-2))
478   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-2 :replacement #\?))
479     (dotimes (i 256)
480       (write-char (code-char i) s)))
481   (with-open-file (s *test-path* :external-format '(:latin-2))
482     (let ((string (make-string 256)))
483       (read-sequence string s)
484       (dotimes (i #xa1)
485         (assert (= (char-code (char string i)) i)))
486       (assert (= 57 (count #\? string :start #xa1))))))
487 (delete-file *test-path*)
488 \f
489 ;;; latin-3 tests
490 (with-test (:name (:unibyte-input-replacement :latin-3))
491   (dotimes (i 256)
492     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
493       (write-byte i s))
494     (with-open-file (s *test-path* :external-format '(:latin-3 :replacement #\?))
495       (let ((char (read-char s)))
496         (cond
497           ((eq char #\?)
498            (assert #1=(or (= i (char-code #\?))
499                           (member i '(#xa5 #xae #xbe #xc3 #xd0 #xe3 #xf0)))))
500           (t (assert (not #1#))))))))
501 (delete-file *test-path*)
502
503 (with-test (:name (:unibyte-output-replacement :latin-3))
504   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-3 :replacement #\?))
505     (dotimes (i 256)
506       (write-char (code-char i) s)))
507   (with-open-file (s *test-path* :external-format '(:latin-3))
508     (let ((string (make-string 256)))
509       (read-sequence string s)
510       (dotimes (i #xa1)
511         (assert (= (char-code (char string i)) i)))
512       (assert (= 35 (count #\? string :start #xa1))))))
513 (delete-file *test-path*)
514 \f
515 ;;; latin-4 tests
516 (with-test (:name (:unibyte-input-replacement :latin-4))
517   (dotimes (i 256)
518     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
519       (write-byte i s))
520     (with-open-file (s *test-path* :external-format '(:latin-4 :replacement #\?))
521       (let ((char (read-char s)))
522         (cond
523           ((< i #xa1) (assert (= (char-code char) i)))
524           ;; FIXME: more tests
525           )))))
526 (delete-file *test-path*)
527
528 (with-test (:name (:unibyte-output-replacement :latin-4))
529   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-4 :replacement #\?))
530     (dotimes (i 256)
531       (write-char (code-char i) s)))
532   (with-open-file (s *test-path* :external-format '(:latin-4))
533     (let ((string (make-string 256)))
534       (read-sequence string s)
535       (dotimes (i #xa1)
536         (assert (= (char-code (char string i)) i)))
537       (assert (= 50 (count #\? string :start #xa1))))))
538 (delete-file *test-path*)
539 \f
540 ;;; iso-8859-5 tests
541 (with-test (:name (:unibyte-input-replacement :iso-8859-5))
542   (dotimes (i 256)
543     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
544       (write-byte i s))
545     (with-open-file (s *test-path* :external-format '(:iso-8859-5 :replacement #\?))
546       (let ((char (read-char s)))
547         (cond
548           ((= (char-code char) i)
549            (assert (or (< i #xa1) (= i #xad))))
550           (t (assert (and (>= i #xa1) (/= i #xad)))))))))
551 (delete-file *test-path*)
552
553 (with-test (:name (:unibyte-output-replacement :iso-8859-5))
554   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:iso-8859-5 :replacement #\?))
555     (dotimes (i 256)
556       (write-char (code-char i) s)))
557   (with-open-file (s *test-path* :external-format '(:iso-8859-5))
558     (let ((string (make-string 256)))
559       (read-sequence string s)
560       (dotimes (i #xa1)
561         (assert (= (char-code (char string i)) i)))
562       (assert (= 93 (count #\? string :start #xa1))))))
563 (delete-file *test-path*)
564 \f
565 ;;; iso-8859-6 tests
566 (with-test (:name (:unibyte-input-replacement :iso-8859-6))
567   (dotimes (i 256)
568     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
569       (write-byte i s))
570     (with-open-file (s *test-path* :external-format '(:iso-8859-6 :replacement #\?))
571       (let ((char (read-char s)))
572         (cond
573           ((eq char #\?)
574            (assert #1=(or (= i (char-code #\?))
575                           (<= #xa1 i #xa3) (<= #xa5 i #xab) (<= #xae i #xba)
576                           (<= #xbc i #xbe) (= i #xc0) (<= #xdb i #xdf)
577                           (<= #xf3 i))))
578           (t (assert (not #1#))))))))
579 (delete-file *test-path*)
580
581 (with-test (:name (:unibyte-output-replacement :iso-8859-6))
582   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:iso-8859-6 :replacement #\?))
583     (dotimes (i 256)
584       (write-char (code-char i) s)))
585   (with-open-file (s *test-path* :external-format '(:iso-8859-6))
586     (let ((string (make-string 256)))
587       (read-sequence string s)
588       (dotimes (i #xa1)
589         (assert (= (char-code (char string i)) i)))
590       (assert (= 93 (count #\? string :start #xa1))))))
591 (delete-file *test-path*)
592 \f
593 ;;; iso-8859-7 tests
594 (with-test (:name (:unibyte-input-replacement :iso-8859-7))
595   (dotimes (i 256)
596     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
597       (write-byte i s))
598     (with-open-file (s *test-path* :external-format '(:iso-8859-7 :replacement #\?))
599       (let ((char (read-char s)))
600         (cond
601           ((eq char #\?)
602            (assert #1=(or (= i (char-code #\?))
603                           (member i '(#xa4 #xa5 #xaa #xae #xd2 #xff)))))
604           (t (assert (not #1#))))))))
605 (delete-file *test-path*)
606
607 (with-test (:name (:unibyte-output-replacement :iso-8859-7))
608   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:iso-8859-7 :replacement #\?))
609     (dotimes (i 256)
610       (write-char (code-char i) s)))
611   (with-open-file (s *test-path* :external-format '(:iso-8859-7))
612     (let ((string (make-string 256)))
613       (read-sequence string s)
614       (dotimes (i #xa1)
615         (assert (= (char-code (char string i)) i)))
616       (assert (= 80 (count #\? string :start #xa1))))))
617 (delete-file *test-path*)
618 \f
619 ;;; iso-8859-8 tests
620 (with-test (:name (:unibyte-input-replacement :iso-8859-8))
621   (dotimes (i 256)
622     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
623       (write-byte i s))
624     (with-open-file (s *test-path* :external-format '(:iso-8859-8 :replacement #\?))
625       (let ((char (read-char s)))
626         (cond
627           ((eq char #\?)
628            (assert #1=(or (= i (char-code #\?))
629                           (= i #xa1) (<= #xbf i #xde) (>= i #xfb))))
630           (t (assert (not  #1#))))))))
631 (delete-file *test-path*)
632
633 (with-test (:name (:unibyte-output-replacement :iso-8859-8))
634   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:iso-8859-8 :replacement #\?))
635     (dotimes (i 256)
636       (write-char (code-char i) s)))
637   (with-open-file (s *test-path* :external-format '(:iso-8859-8))
638     (let ((string (make-string 256)))
639       (read-sequence string s)
640       (dotimes (i #xa1)
641         (assert (= (char-code (char string i)) i)))
642       (assert (= 67 (count #\? string :start #xa1))))))
643 (delete-file *test-path*)
644 \f
645 ;;; latin-5 tests
646 (with-test (:name (:unibyte-input-replacement :latin-5))
647   (dotimes (i 256)
648     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
649       (write-byte i s))
650     (with-open-file (s *test-path* :external-format '(:latin-5 :replacement #\?))
651       (let ((char (read-char s)))
652         (assert (or (and (= (char-code char) i)
653                          (not (member i '(#xd0 #xdd #xde #xf0 #xfd #xfe))))
654                     (and (member i '(#xd0 #xdd #xde #xf0 #xfd #xfe))
655                          (not (char= char #\?)))))))))
656 (delete-file *test-path*)
657
658 (with-test (:name (:unibyte-output-replacement :latin-5))
659   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-5 :replacement #\?))
660     (dotimes (i 256)
661       (write-char (code-char i) s)))
662   (with-open-file (s *test-path* :external-format '(:latin-5))
663     (let ((string (make-string 256)))
664       (read-sequence string s)
665       (dotimes (i #xd0)
666         (assert (= (char-code (char string i)) i)))
667       (assert (= 6 (count #\? string :start #xd0))))))
668 (delete-file *test-path*)
669 \f
670 ;;; latin-6 tests
671 (with-test (:name (:unibyte-input-replacement :latin-6))
672   (dotimes (i 256)
673     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
674       (write-byte i s))
675     (with-open-file (s *test-path* :external-format '(:latin-6 :replacement #\?))
676       (let ((char (read-char s)))
677         (assert (or (= (char-code char) i)
678                     (and (<= #xa1 i #xff)
679                          (not (char= char #\?)))))))))
680 (delete-file *test-path*)
681
682 (with-test (:name (:unibyte-output-replacement :latin-6))
683   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-6 :replacement #\?))
684     (dotimes (i 256)
685       (write-char (code-char i) s)))
686   (with-open-file (s *test-path* :external-format '(:latin-6))
687     (let ((string (make-string 256)))
688       (read-sequence string s)
689       (dotimes (i #xa1)
690         (assert (= (char-code (char string i)) i)))
691       (assert (= 46 (count #\? string :start #xa1))))))
692 (delete-file *test-path*)
693 \f
694 ;;; iso-8859-11 tests
695 (with-test (:name (:unibyte-input-replacement :iso-8859-11))
696   (dotimes (i 256)
697     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
698       (write-byte i s))
699     (with-open-file (s *test-path* :external-format '(:iso-8859-11 :replacement #\?))
700       (let ((char (read-char s)))
701         (cond
702           ((eq char #\?)
703            (assert (member i #1=`(,(char-code #\?) #xdb #xdc #xdd #xde #xfc #xfd #xfe #xff))))
704           (t (assert (not (member i #1#)))))))))
705 (delete-file *test-path*)
706
707 (with-test (:name (:unibyte-output-replacement :iso-8859-11))
708   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:iso-8859-11 :replacement #\?))
709     (dotimes (i 256)
710       (write-char (code-char i) s)))
711   (with-open-file (s *test-path* :external-format '(:iso-8859-11))
712     (let ((string (make-string 256)))
713       (read-sequence string s)
714       (dotimes (i #xa1)
715         (assert (= (char-code (char string i)) i)))
716       (assert (= 95 (count #\? string :start #xa1))))))
717 (delete-file *test-path*)
718 \f
719 ;;; latin-7 tests
720 (with-test (:name (:unibyte-input-replacement :latin-7))
721   (dotimes (i 256)
722     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
723       (write-byte i s))
724     (with-open-file (s *test-path* :external-format '(:latin-7 :replacement #\?))
725       (let ((char (read-char s)))
726         (assert (or (= (char-code char) i)
727                     (and (<= #xa1 i #xff)
728                          (not (char= char #\?)))))))))
729 (delete-file *test-path*)
730
731 (with-test (:name (:unibyte-output-replacement :latin-7))
732   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-7 :replacement #\?))
733     (dotimes (i 256)
734       (write-char (code-char i) s)))
735   (with-open-file (s *test-path* :external-format '(:latin-7))
736     (let ((string (make-string 256)))
737       (read-sequence string s)
738       (dotimes (i #xa1)
739         (assert (= (char-code (char string i)) i)))
740       (dolist (i '(#xd8 #xc6 #xf8 #xe6))
741         (assert (char/= (char string i) #\?)))
742       (assert (= 52 (count #\? string :start #xa1))))))
743 (delete-file *test-path*)
744 \f
745 ;;; latin-8 tests
746 (with-test (:name (:unibyte-input-replacement :latin-8))
747   (dotimes (i 256)
748     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
749       (write-byte i s))
750     (with-open-file (s *test-path* :external-format '(:latin-8 :replacement #\?))
751       (let ((char (read-char s)))
752         (assert (or (= (char-code char) i)
753                     (and (<= #xa1 i #xfe)
754                          (not (char= char #\?)))))))))
755 (delete-file *test-path*)
756
757 (with-test (:name (:unibyte-output-replacement :latin-8))
758   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-8 :replacement #\?))
759     (dotimes (i 256)
760       (write-char (code-char i) s)))
761   (with-open-file (s *test-path* :external-format '(:latin-8))
762     (let ((string (make-string 256)))
763       (read-sequence string s)
764       (dotimes (i #xa1)
765         (assert (= (char-code (char string i)) i)))
766       (assert (= 31 (count #\? string :start #xa1))))))
767 (delete-file *test-path*)
768 \f
769 ;;; latin-9 tests
770 (with-test (:name (:unibyte-input-replacement :latin-9))
771   (dotimes (i 256)
772     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
773       (write-byte i s))
774     (with-open-file (s *test-path* :external-format '(:latin-9 :replacement #\?))
775       (let ((char (read-char s)))
776         (assert (or (and (= (char-code char) i)
777                          (not (member i '(#xa4 #xa6 #xa8 #xb4 #xb8 #xbc #xbd #xbe))))
778                     (and (member i '(#xa4 #xa6 #xa8 #xb4 #xb8 #xbc #xbd #xbe))
779                          (not (char= char #\?)))))))))
780 (delete-file *test-path*)
781
782 (with-test (:name (:unibyte-output-replacement :latin-9))
783   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-9 :replacement #\?))
784     (dotimes (i 256)
785       (write-char (code-char i) s)))
786   (with-open-file (s *test-path* :external-format '(:latin-9))
787     (let ((string (make-string 256)))
788       (read-sequence string s)
789       (dotimes (i #xa4)
790         (assert (= (char-code (char string i)) i)))
791       (assert (= 8 (count #\? string :start #xa4))))))
792 (delete-file *test-path*)
793 \f
794 ;;; koi8-r tests
795 (with-test (:name (:unibyte-input-replacement :koi8-r))
796   (dotimes (i 256)
797     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
798       (write-byte i s))
799     (with-open-file (s *test-path* :external-format '(:koi8-r :replacement #\?))
800       (let ((char (read-char s)))
801         (cond ((= (char-code char) i)
802                (assert (< i 128)))
803               (t (assert (> i 127))))))))
804 (delete-file *test-path*)
805
806 (with-test (:name (:unibyte-output-replacement :koi8-r))
807   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:koi8-r :replacement #\?))
808     (dotimes (i 256)
809       (write-char (code-char i) s)))
810   (with-open-file (s *test-path* :external-format '(:koi8-r))
811     (let ((string (make-string 256)))
812       (read-sequence string s)
813       (dotimes (i #x80)
814         (assert (= (char-code (char string i)) i)))
815       (assert (= 122 (count #\? string :start #x80))))))
816 (delete-file *test-path*)
817 \f
818 ;;; koi8-u tests
819 (with-test (:name (:unibyte-input-replacement :koi8-u))
820   (dotimes (i 256)
821     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
822       (write-byte i s))
823     (with-open-file (s *test-path* :external-format '(:koi8-u :replacement #\?))
824       (let ((char (read-char s)))
825         (cond ((= (char-code char) i)
826                (assert (< i 128)))
827               (t (assert (> i 127))))))))
828 (delete-file *test-path*)
829
830 (with-test (:name (:unibyte-output-replacement :koi8-u))
831   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:koi8-u :replacement #\?))
832     (dotimes (i 256)
833       (write-char (code-char i) s)))
834   (with-open-file (s *test-path* :external-format '(:koi8-u))
835     (let ((string (make-string 256)))
836       (read-sequence string s)
837       (dotimes (i #x80)
838         (assert (= (char-code (char string i)) i)))
839       (assert (= 122 (count #\? string :start #x80))))))
840 (delete-file *test-path*)
841 \f
842 ;;; x-mac-cyrillic tests
843 (with-test (:name (:unibyte-input-replacement :x-mac-cyrillic))
844   (dotimes (i 256)
845     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
846       (write-byte i s))
847     (with-open-file (s *test-path* :external-format '(:x-mac-cyrillic :replacement #\?))
848       (let ((char (read-char s)))
849         (cond ((= (char-code char) i)
850                (assert (or (< i 128) (member i '(#xa2 #xa3 #xa9 #xb1 #xb5)))))
851               (t (assert (and (> i 127)
852                               (not (member i '(#xa2 #xa3 #xa9 #xb1 #xb5)))))))))))
853 (delete-file *test-path*)
854
855 (with-test (:name (:unibyte-output-replacement :x-mac-cyrillic))
856   (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:x-mac-cyrillic :replacement #\?))
857     (dotimes (i 256)
858       (write-char (code-char i) s)))
859   (with-open-file (s *test-path* :external-format '(:x-mac-cyrillic))
860     (let ((string (make-string 256)))
861       (read-sequence string s)
862       (dotimes (i #x80)
863         (assert (= (char-code (char string i)) i)))
864       (assert (= 113 (count #\? string :start #x80))))))
865 (delete-file *test-path*)
866 \f
867 ;;; ucs-2 tests
868 (with-test (:name (:multibyte :ucs2le))
869   (let* ((size 120)
870          (array (map-into (make-array size :element-type '(unsigned-byte 16))
871                           (lambda () (random #x10000)))))
872     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
873       (dotimes (i size)
874         (write-byte (ldb (byte 8 0) (aref array i)) s)
875         (write-byte (ldb (byte 8 8) (aref array i)) s)))
876     (with-open-file (s *test-path* :external-format :ucs2le)
877       (let ((string (make-string size)))
878         (read-sequence string s)
879         (dotimes (i size)
880           (assert (= (char-code (char string i)) (aref array i))))))))
881
882 (with-test (:name (:multibyte :ucs2be))
883   (let* ((size 120)
884          (array (map-into (make-array size :element-type '(unsigned-byte 16))
885                           (lambda () (random #x10000)))))
886     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
887       (dotimes (i size)
888         (write-byte (ldb (byte 8 8) (aref array i)) s)
889         (write-byte (ldb (byte 8 0) (aref array i)) s)))
890     (with-open-file (s *test-path* :external-format :ucs2be)
891       (let ((string (make-string size)))
892         (read-sequence string s)
893         (dotimes (i size)
894           (assert (= (char-code (char string i)) (aref array i))))))))
895
896 (with-test (:name (:multibyte :output-replacement :ucs2le))
897   (let* ((size 1200)
898          (string (map-into (make-string size)
899                            (lambda () (code-char (random #x10000))))))
900     (setf (char string 0) (code-char #x10001)
901           (char string (1- size)) (code-char #x10002))
902     (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:ucs2le :replacement #\replacement_character))
903       (write-string string s))
904     (with-open-file (s *test-path* :external-format :ucs2le)
905       (let ((new (make-string size)))
906         (read-sequence new s)
907         (assert (char= (char new 0) #\replacement_character))
908         (assert (char= (char new (1- size)) #\replacement_character))
909         (assert (string= string new :start1 1 :start2 1 :end1 (1- size) :end2 (1- size)))))))
910
911 (with-test (:name (:multibyte :output-replacement :ucs2be))
912   (let* ((size 1200)
913          (string (map-into (make-string size)
914                            (lambda () (code-char (random #x10000))))))
915     (setf (char string 0) (code-char #x10001)
916           (char string (1- size)) (code-char #x10002))
917     (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:ucs2be :replacement #\replacement_character))
918       (write-string string s))
919     (with-open-file (s *test-path* :external-format :ucs2be)
920       (let ((new (make-string size)))
921         (read-sequence new s)
922         (assert (char= (char new 0) #\replacement_character))
923         (assert (char= (char new (1- size)) #\replacement_character))
924         (assert (string= string new :start1 1 :start2 1 :end1 (1- size) :end2 (1- size)))))))
925
926 (with-test (:name (:multibyte :input-replacement :ucs4le))
927   (let ((octets (coerce '(0 1 1 0 1 0 0 1) '(vector (unsigned-byte 8)))))
928     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
929       (write-sequence octets s))
930     (with-open-file (s *test-path* :external-format '(:ucs4le :replacement #\replacement_character))
931       (let ((string (read-line s)))
932         (assert (char= (char string 0) (code-char #x10100)))
933         (assert (char= (char string 1) #\replacement_character))))))
934
935 (with-test (:name (:multibyte :input-replacement :ucs4le))
936   (let ((octets (coerce '(0 1 1 0 1 0 0 1) '(vector (unsigned-byte 8)))))
937     (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
938       (write-sequence octets s))
939     (with-open-file (s *test-path* :external-format '(:ucs4be :replacement #\replacement_character))
940       (let ((string (read-line s)))
941         (assert (char= (char string 0) (code-char #x10100)))
942         (assert (char= (char string 1) #\replacement_character))))))
943 \f
944 ;;; utf tests
945 (with-test (:name (:utf-16le :roundtrip))
946   (let ((string (map 'string 'code-char '(#x20 #x200 #x2000 #xfffd #x10fffd))))
947     (with-open-file (s *test-path* :direction :output :if-exists :supersede
948                        :external-format :utf-16le)
949       (write-string string s))
950     (with-open-file (s *test-path* :external-format :utf-16le)
951       (assert (string= string (read-line s))))))
952 (with-test (:name (:utf-16be :roundtrip))
953   (let ((string (map 'string 'code-char '(#x20 #x200 #x2000 #xfffd #x10fffd))))
954     (with-open-file (s *test-path* :direction :output :if-exists :supersede
955                        :external-format :utf-16be)
956       (write-string string s))
957     (with-open-file (s *test-path* :external-format :utf-16be)
958       (assert (string= string (read-line s))))))
959 (with-test (:name (:utf-16le :encoding-error))
960   (let ((string (map 'string 'code-char '(#x20 #xfffe #xdc00 #xd800 #x1fffe #x20))))
961     (with-open-file (s *test-path* :direction :output :if-exists :supersede
962                        :external-format '(:utf-16le :replacement #\?))
963       (write-string string s))
964     (with-open-file (s *test-path* :external-format :utf-16le)
965       (assert (string= " ???? " (read-line s))))))
966 (with-test (:name (:utf-16be :encoding-error))
967   (let ((string (map 'string 'code-char '(#x20 #xfffe #xdc00 #xd800 #x1fffe #x20))))
968     (with-open-file (s *test-path* :direction :output :if-exists :supersede
969                        :external-format '(:utf-16be :replacement #\?))
970       (write-string string s))
971     (with-open-file (s *test-path* :external-format :utf-16be)
972       (assert (string= " ???? " (read-line s))))))
973
974 (with-test (:name (:utf-32le :roundtrip))
975   (let ((string (map 'string 'code-char '(#x20 #x200 #x2000 #xfffd #x10fffd))))
976     (with-open-file (s *test-path* :direction :output :if-exists :supersede
977                        :external-format :utf-32le)
978       (write-string string s))
979     (with-open-file (s *test-path* :external-format :utf-32le)
980       (assert (string= string (read-line s))))))
981 (with-test (:name (:utf-32be :roundtrip))
982   (let ((string (map 'string 'code-char '(#x20 #x200 #x2000 #xfffd #x10fffd))))
983     (with-open-file (s *test-path* :direction :output :if-exists :supersede
984                        :external-format :utf-32be)
985       (write-string string s))
986     (with-open-file (s *test-path* :external-format :utf-32be)
987       (assert (string= string (read-line s))))))
988 (with-test (:name (:utf-32le :encoding-error))
989   (let ((string (map 'string 'code-char '(#x20 #xfffe #xdc00 #xd800 #x1fffe #x20))))
990     (with-open-file (s *test-path* :direction :output :if-exists :supersede
991                        :external-format '(:utf-32le :replacement #\?))
992       (write-string string s))
993     (with-open-file (s *test-path* :external-format :utf-32le)
994       (assert (string= " ???? " (read-line s))))))
995 (with-test (:name (:utf-32be :encoding-error))
996   (let ((string (map 'string 'code-char '(#x20 #xfffe #xdc00 #xd800 #x1fffe #x20))))
997     (with-open-file (s *test-path* :direction :output :if-exists :supersede
998                        :external-format '(:utf-32be :replacement #\?))
999       (write-string string s))
1000     (with-open-file (s *test-path* :external-format :utf-32be)
1001       (assert (string= " ???? " (read-line s))))))
1002
1003 (with-test (:name :invalid-external-format :fails-on :win32)
1004   (labels ((test-error (e)
1005              (assert (typep e 'error))
1006              (unless (equal "Undefined external-format: :BAD-FORMAT"
1007                             (princ-to-string e))
1008                (error "Bad error:~%  ~A" e)))
1009            (test (direction)
1010              (test-error
1011               (handler-case
1012                   (open "/dev/null" :direction direction :external-format :bad-format
1013                         :if-exists :overwrite)
1014                 (error (e) e)))))
1015     (test :input)
1016     (test :output)
1017     (test :io)
1018     (test-error
1019      (handler-case
1020          (run-program "sh" '() :input :stream :external-format :bad-format)
1021        (error (e) e)))
1022     (test-error
1023      (handler-case
1024          (string-to-octets "foobar" :external-format :bad-format)
1025        (error (e) e)))
1026     (test-error
1027      (let ((octets (string-to-octets "foobar" :external-format :latin1)))
1028        (handler-case
1029            (octets-to-string octets :external-format :bad-format)
1030          (error (e) e))))))
1031
1032 (with-test (:name :lp713063)
1033   (with-open-file (f *test-path*
1034                      :direction :output
1035                      :external-format '(:euc-jp :replacement #\?)
1036                      :if-exists :supersede)
1037     (write-string (make-string 3 :initial-element #\horizontal_bar) f))
1038   (assert (equal "???"
1039                  (with-open-file (f *test-path*
1040                                     :direction :input
1041                                     :external-format :euc-jp)
1042                    (read-line f))))
1043   (delete-file *test-path*))
1044 \f
1045 ;;;; success