X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fexternal-format.impure.lisp;h=96c86082569dd9113b7043db656df5a3535bf5a8;hb=168b9114fdaae539f840cf80b5b023d330239353;hp=99e2bdafe3983af7e594ca8cd0014acc2084a1f3;hpb=e7ef1082bd3e7f3851de9d90c5dbddf226a71382;p=sbcl.git

diff --git a/tests/external-format.impure.lisp b/tests/external-format.impure.lisp
index 99e2bda..96c8608 100644
--- a/tests/external-format.impure.lisp
+++ b/tests/external-format.impure.lisp
@@ -17,9 +17,9 @@
 
 (defmacro do-external-formats ((xf &optional result) &body body)
   (let ((nxf (gensym)))
-    `(dolist (,nxf sb-impl::*external-formats* ,result)
-       (let ((,xf (first (first ,nxf))))
-         ,@body))))
+    `(loop for ,nxf being the hash-values of sb-impl::*external-formats*
+        do (let ((,xf (first (sb-impl::ef-names ,nxf))))
+             ,@body))))
 
 (defvar *test-path* "external-format-test.tmp")
 
@@ -78,22 +78,29 @@
   (write-byte 67 s))
 (with-open-file (s *test-path* :direction :input
                  :external-format :utf-8)
-  (handler-bind
-      ((sb-int:character-decoding-error #'(lambda (decoding-error)
-                                            (declare (ignore decoding-error))
-                                            (invoke-restart
-                                             'sb-int:attempt-resync))))
-    (assert (equal (read-line s nil s) "ABC"))
-    (assert (equal (read-line s nil s) s))))
+  (let ((count 0))
+    (handler-bind
+        ((sb-int:character-decoding-error #'(lambda (decoding-error)
+                                              (declare (ignore decoding-error))
+                                              (when (> (incf count) 1)
+                                                (error "too many errors"))
+                                              (invoke-restart
+                                               'sb-int:attempt-resync))))
+      (assert (equal (read-line s nil s) "ABC"))
+      (assert (equal (read-line s nil s) s)))))
 (with-open-file (s *test-path* :direction :input
                  :external-format :utf-8)
-  (handler-bind
-      ((sb-int:character-decoding-error #'(lambda (decoding-error)
-                                            (declare (ignore decoding-error))
-                                            (invoke-restart
-                                             'sb-int:force-end-of-file))))
-    (assert (equal (read-line s nil s) "AB"))
-    (assert (equal (read-line s nil s) s))))
+  (let ((count 0))
+    (handler-bind
+        ((sb-int:character-decoding-error #'(lambda (decoding-error)
+                                              (declare (ignore decoding-error))
+                                              (when (> (incf count) 1)
+                                                (error "too many errors"))
+                                              (invoke-restart
+                                               'sb-int:force-end-of-file))))
+      (assert (equal (read-line s nil s) "AB"))
+      (setf count 0)
+      (assert (equal (read-line s nil s) s)))))
 
 ;;; And again with more data to account for buffering (this was briefly)
 ;;; broken in early 0.9.6.
@@ -112,40 +119,41 @@
 (with-test (:name (:character-decode-large :attempt-resync))
   (with-open-file (s *test-path* :direction :input
                      :external-format :utf-8)
-    (handler-bind
-        ((sb-int:character-decoding-error #'(lambda (decoding-error)
+    (let ((count 0))
+      (handler-bind
+          ((sb-int:character-decoding-error (lambda (decoding-error)
                                               (declare (ignore decoding-error))
+                                              (when (> (incf count) 1)
+                                                (error "too many errors"))
                                               (invoke-restart
                                                'sb-int:attempt-resync)))
-         ;; The failure mode is an infinite loop, add a timeout to detetct it.
-         (sb-ext:timeout (lambda () (error "Timeout"))))
-      (sb-ext:with-timeout 5
-        (dotimes (i 80)
-          (assert (equal (read-line s nil s)
-                         "1234567890123456789012345678901234567890123456789")))))))
-
-(with-test (:name (:character-decode-large :force-end-of-file)
-            :fails-on :sbcl)
-  (error "We can't reliably test this due to WITH-TIMEOUT race condition")
-  ;; This test will currently fail. But sometimes it will fail in
-  ;; ungracefully due to the WITH-TIMEOUT race mentioned above. This
-  ;; rightfully confuses some people, so we'll skip running the code
-  ;; for now. -- JES, 2006-01-27
-  #+nil
+           ;; The failure mode is an infinite loop, add a timeout to
+           ;; detetct it.
+           (sb-ext:timeout (lambda () (error "Timeout"))))
+        (sb-ext:with-timeout 5
+          (dotimes (i 80)
+            (assert (equal (read-line s nil s)
+                           "1234567890123456789012345678901234567890123456789"))))))))
+
+(with-test (:name (:character-decode-large :force-end-of-file))
   (with-open-file (s *test-path* :direction :input
                      :external-format :utf-8)
-    (handler-bind
-        ((sb-int:character-decoding-error #'(lambda (decoding-error)
+    (let ((count 0))
+      (handler-bind
+          ((sb-int:character-decoding-error (lambda (decoding-error)
                                               (declare (ignore decoding-error))
+                                              (when (> (incf count) 1)
+                                                (error "too many errors"))
                                               (invoke-restart
                                                'sb-int:force-end-of-file)))
-         ;; The failure mode is an infinite loop, add a timeout to detetct it.
-         (sb-ext:timeout (lambda () (error "Timeout"))))
-      (sb-ext:with-timeout 5
-        (dotimes (i 80)
-          (assert (equal (read-line s nil s)
-                         "1234567890123456789012345678901234567890123456789")))
-        (assert (equal (read-line s nil s) s))))))
+           ;; The failure mode is an infinite loop, add a timeout to detetct it.
+           (sb-ext:timeout (lambda () (error "Timeout"))))
+        (sb-ext:with-timeout 5
+          (dotimes (i 40)
+            (assert (equal (read-line s nil s)
+                           "1234567890123456789012345678901234567890123456789")))
+          (setf count 0)
+          (assert (equal (read-line s nil s) s)))))))
 
 ;;; Test character encode restarts.
 (with-open-file (s *test-path* :direction :output
@@ -294,9 +302,9 @@
 ;;; on 2008-10-16 for more info.
 (with-test (:name (:character-coding-error-stream-external-format))
   (flet ((first-file-character ()
-           (with-open-file (stream *test-file* :external-format :utf-8)
+           (with-open-file (stream *test-path* :external-format :utf-8)
              (read-char stream))))
-    (with-open-file (stream *test-file*
+    (with-open-file (stream *test-path*
                             :direction :output
                             :if-exists :supersede
                             :element-type '(unsigned-byte 8))
@@ -345,4 +353,635 @@
     (str (c-string :external-format :ebcdic-us)))
   (assert (typep (strdup "foo") 'simple-base-string)))
 
+(with-test (:name (:input-replacement :at-end-of-file))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (handler-bind ((sb-int:character-decoding-error
+                    (lambda (c)
+                      (invoke-restart 'sb-impl::input-replacement #\?))))
+      (with-open-file (s *test-path* :external-format :utf-8)
+        (cond
+          ((char= (read-char s) #\?)
+           (assert (or (= i (char-code #\?)) (> i 127))))
+          (t (assert (and (not (= i (char-code #\?))) (< i 128)))))))))
+
+(with-test (:name (:unibyte-invalid-codepoints :cp857))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format :cp857)
+      (handler-case (read-char s)
+        (error () (assert (member i '(#xd5 #xe7 #xf2))))
+        (:no-error (char) (assert (not (member i '(#xd5 #xe7 #xf2)))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-input-replacement :cp857))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:cp857 :replacement #\?))
+      (let ((char (read-char s)))
+        (cond
+          ((eq char #\?)
+           (assert (member i `(,(char-code #\?) #xd5 #xe7 #xf2))))
+          (t (assert (not (member i `(,(char-code #\?) #xd5 #xe7 #xf2))))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :cp857))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:cp857 :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:cp857))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i 128)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 38 (count #\? string :start 128))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-input-replacement :ascii))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:ascii :replacement #\?))
+      (let ((char (read-char s)))
+        (cond
+          ((eq char #\?)
+           (assert (or (= i (char-code #\?)) (> i 127))))
+          (t (assert (and (< i 128) (not (= i (char-code #\?)))))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :ascii))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:ascii :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:ascii))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i 128)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 128 (count #\? string :start 128))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-input-replacement :latin-1))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:latin-1 :replacement #\?))
+      (let ((char (read-char s)))
+        (assert (= (char-code char) i))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :latin-1))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-1 :replacement #\?))
+    (dotimes (i 257)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:latin-1))
+    (let ((string (make-string 257)))
+      (read-sequence string s)
+      (dotimes (i 256)
+        (assert (= (char-code (char string i)) i)))
+      (assert (char= #\? (char string 256))))))
+(delete-file *test-path*)
+
+;;; latin-2 tests
+(with-test (:name (:unibyte-input-replacement :latin-2))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:latin-2 :replacement #\?))
+      (let ((char (read-char s)))
+        (cond
+          ((< i #xa1) (assert (= (char-code char) i)))
+          ;; FIXME: more tests
+          )))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :latin-2))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-2 :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:latin-2))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #xa1)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 57 (count #\? string :start #xa1))))))
+(delete-file *test-path*)
+
+;;; latin-3 tests
+(with-test (:name (:unibyte-input-replacement :latin-3))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:latin-3 :replacement #\?))
+      (let ((char (read-char s)))
+        (cond
+          ((eq char #\?)
+           (assert #1=(or (= i (char-code #\?))
+                          (member i '(#xa5 #xae #xbe #xc3 #xd0 #xe3 #xf0)))))
+          (t (assert (not #1#))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :latin-3))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-3 :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:latin-3))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #xa1)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 35 (count #\? string :start #xa1))))))
+(delete-file *test-path*)
+
+;;; latin-4 tests
+(with-test (:name (:unibyte-input-replacement :latin-4))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:latin-4 :replacement #\?))
+      (let ((char (read-char s)))
+        (cond
+          ((< i #xa1) (assert (= (char-code char) i)))
+          ;; FIXME: more tests
+          )))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :latin-4))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-4 :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:latin-4))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #xa1)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 50 (count #\? string :start #xa1))))))
+(delete-file *test-path*)
+
+;;; iso-8859-5 tests
+(with-test (:name (:unibyte-input-replacement :iso-8859-5))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:iso-8859-5 :replacement #\?))
+      (let ((char (read-char s)))
+        (cond
+          ((= (char-code char) i)
+           (assert (or (< i #xa1) (= i #xad))))
+          (t (assert (and (>= i #xa1) (/= i #xad)))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :iso-8859-5))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:iso-8859-5 :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:iso-8859-5))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #xa1)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 93 (count #\? string :start #xa1))))))
+(delete-file *test-path*)
+
+;;; iso-8859-6 tests
+(with-test (:name (:unibyte-input-replacement :iso-8859-6))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:iso-8859-6 :replacement #\?))
+      (let ((char (read-char s)))
+        (cond
+          ((eq char #\?)
+           (assert #1=(or (= i (char-code #\?))
+                          (<= #xa1 i #xa3) (<= #xa5 i #xab) (<= #xae i #xba)
+                          (<= #xbc i #xbe) (= i #xc0) (<= #xdb i #xdf)
+                          (<= #xf3 i))))
+          (t (assert (not #1#))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :iso-8859-6))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:iso-8859-6 :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:iso-8859-6))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #xa1)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 93 (count #\? string :start #xa1))))))
+(delete-file *test-path*)
+
+;;; iso-8859-7 tests
+(with-test (:name (:unibyte-input-replacement :iso-8859-7))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:iso-8859-7 :replacement #\?))
+      (let ((char (read-char s)))
+        (cond
+          ((eq char #\?)
+           (assert #1=(or (= i (char-code #\?))
+                          (member i '(#xa4 #xa5 #xaa #xae #xd2 #xff)))))
+          (t (assert (not #1#))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :iso-8859-7))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:iso-8859-7 :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:iso-8859-7))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #xa1)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 80 (count #\? string :start #xa1))))))
+(delete-file *test-path*)
+
+;;; iso-8859-8 tests
+(with-test (:name (:unibyte-input-replacement :iso-8859-8))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:iso-8859-8 :replacement #\?))
+      (let ((char (read-char s)))
+        (cond
+          ((eq char #\?)
+           (assert #1=(or (= i (char-code #\?))
+                          (= i #xa1) (<= #xbf i #xde) (>= i #xfb))))
+          (t (assert (not  #1#))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :iso-8859-8))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:iso-8859-8 :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:iso-8859-8))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #xa1)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 67 (count #\? string :start #xa1))))))
+(delete-file *test-path*)
+
+;;; latin-5 tests
+(with-test (:name (:unibyte-input-replacement :latin-5))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:latin-5 :replacement #\?))
+      (let ((char (read-char s)))
+        (assert (or (and (= (char-code char) i)
+                         (not (member i '(#xd0 #xdd #xde #xf0 #xfd #xfe))))
+                    (and (member i '(#xd0 #xdd #xde #xf0 #xfd #xfe))
+                         (not (char= char #\?)))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :latin-5))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-5 :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:latin-5))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #xd0)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 6 (count #\? string :start #xd0))))))
+(delete-file *test-path*)
+
+;;; latin-6 tests
+(with-test (:name (:unibyte-input-replacement :latin-6))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:latin-6 :replacement #\?))
+      (let ((char (read-char s)))
+        (assert (or (= (char-code char) i)
+                    (and (<= #xa1 i #xff)
+                         (not (char= char #\?)))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :latin-6))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-6 :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:latin-6))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #xa1)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 46 (count #\? string :start #xa1))))))
+(delete-file *test-path*)
+
+;;; iso-8859-11 tests
+(with-test (:name (:unibyte-input-replacement :iso-8859-11))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:iso-8859-11 :replacement #\?))
+      (let ((char (read-char s)))
+        (cond
+          ((eq char #\?)
+           (assert (member i #1=`(,(char-code #\?) #xdb #xdc #xdd #xde #xfc #xfd #xfe #xff))))
+          (t (assert (not (member i #1#)))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :iso-8859-11))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:iso-8859-11 :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:iso-8859-11))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #xa1)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 95 (count #\? string :start #xa1))))))
+(delete-file *test-path*)
+
+;;; latin-7 tests
+(with-test (:name (:unibyte-input-replacement :latin-7))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:latin-7 :replacement #\?))
+      (let ((char (read-char s)))
+        (assert (or (= (char-code char) i)
+                    (and (<= #xa1 i #xff)
+                         (not (char= char #\?)))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :latin-7))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-7 :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:latin-7))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #xa1)
+        (assert (= (char-code (char string i)) i)))
+      (dolist (i '(#xd8 #xc6 #xf8 #xe6))
+        (assert (char/= (char string i) #\?)))
+      (assert (= 52 (count #\? string :start #xa1))))))
+(delete-file *test-path*)
+
+;;; latin-8 tests
+(with-test (:name (:unibyte-input-replacement :latin-8))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:latin-8 :replacement #\?))
+      (let ((char (read-char s)))
+        (assert (or (= (char-code char) i)
+                    (and (<= #xa1 i #xfe)
+                         (not (char= char #\?)))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :latin-8))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-8 :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:latin-8))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #xa1)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 31 (count #\? string :start #xa1))))))
+(delete-file *test-path*)
+
+;;; latin-9 tests
+(with-test (:name (:unibyte-input-replacement :latin-9))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:latin-9 :replacement #\?))
+      (let ((char (read-char s)))
+        (assert (or (and (= (char-code char) i)
+                         (not (member i '(#xa4 #xa6 #xa8 #xb4 #xb8 #xbc #xbd #xbe))))
+                    (and (member i '(#xa4 #xa6 #xa8 #xb4 #xb8 #xbc #xbd #xbe))
+                         (not (char= char #\?)))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :latin-9))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:latin-9 :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:latin-9))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #xa4)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 8 (count #\? string :start #xa4))))))
+(delete-file *test-path*)
+
+;;; koi8-r tests
+(with-test (:name (:unibyte-input-replacement :koi8-r))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:koi8-r :replacement #\?))
+      (let ((char (read-char s)))
+        (cond ((= (char-code char) i)
+               (assert (< i 128)))
+              (t (assert (> i 127))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :koi8-r))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:koi8-r :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:koi8-r))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #x80)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 122 (count #\? string :start #x80))))))
+(delete-file *test-path*)
+
+;;; koi8-u tests
+(with-test (:name (:unibyte-input-replacement :koi8-u))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:koi8-u :replacement #\?))
+      (let ((char (read-char s)))
+        (cond ((= (char-code char) i)
+               (assert (< i 128)))
+              (t (assert (> i 127))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :koi8-u))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:koi8-u :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:koi8-u))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #x80)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 122 (count #\? string :start #x80))))))
+(delete-file *test-path*)
+
+;;; x-mac-cyrillic tests
+(with-test (:name (:unibyte-input-replacement :x-mac-cyrillic))
+  (dotimes (i 256)
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-byte i s))
+    (with-open-file (s *test-path* :external-format '(:x-mac-cyrillic :replacement #\?))
+      (let ((char (read-char s)))
+        (cond ((= (char-code char) i)
+               (assert (or (< i 128) (member i '(#xa2 #xa3 #xa9 #xb1 #xb5)))))
+              (t (assert (and (> i 127)
+                              (not (member i '(#xa2 #xa3 #xa9 #xb1 #xb5)))))))))))
+(delete-file *test-path*)
+
+(with-test (:name (:unibyte-output-replacement :x-mac-cyrillic))
+  (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:x-mac-cyrillic :replacement #\?))
+    (dotimes (i 256)
+      (write-char (code-char i) s)))
+  (with-open-file (s *test-path* :external-format '(:x-mac-cyrillic))
+    (let ((string (make-string 256)))
+      (read-sequence string s)
+      (dotimes (i #x80)
+        (assert (= (char-code (char string i)) i)))
+      (assert (= 113 (count #\? string :start #x80))))))
+(delete-file *test-path*)
+
+;;; ucs-2 tests
+(with-test (:name (:multibyte :ucs2le))
+  (let* ((size 120)
+         (array (map-into (make-array size :element-type '(unsigned-byte 16))
+                          (lambda () (random #x10000)))))
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (dotimes (i size)
+        (write-byte (ldb (byte 8 0) (aref array i)) s)
+        (write-byte (ldb (byte 8 8) (aref array i)) s)))
+    (with-open-file (s *test-path* :external-format :ucs2le)
+      (let ((string (make-string size)))
+        (read-sequence string s)
+        (dotimes (i size)
+          (assert (= (char-code (char string i)) (aref array i))))))))
+
+(with-test (:name (:multibyte :ucs2be))
+  (let* ((size 120)
+         (array (map-into (make-array size :element-type '(unsigned-byte 16))
+                          (lambda () (random #x10000)))))
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (dotimes (i size)
+        (write-byte (ldb (byte 8 8) (aref array i)) s)
+        (write-byte (ldb (byte 8 0) (aref array i)) s)))
+    (with-open-file (s *test-path* :external-format :ucs2be)
+      (let ((string (make-string size)))
+        (read-sequence string s)
+        (dotimes (i size)
+          (assert (= (char-code (char string i)) (aref array i))))))))
+
+(with-test (:name (:multibyte :output-replacement :ucs2le))
+  (let* ((size 1200)
+         (string (map-into (make-string size)
+                           (lambda () (code-char (random #x10000))))))
+    (setf (char string 0) (code-char #x10001)
+          (char string (1- size)) (code-char #x10002))
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:ucs2le :replacement #\replacement_character))
+      (write-string string s))
+    (with-open-file (s *test-path* :external-format :ucs2le)
+      (let ((new (make-string size)))
+        (read-sequence new s)
+        (assert (char= (char new 0) #\replacement_character))
+        (assert (char= (char new (1- size)) #\replacement_character))
+        (assert (string= string new :start1 1 :start2 1 :end1 (1- size) :end2 (1- size)))))))
+
+(with-test (:name (:multibyte :output-replacement :ucs2be))
+  (let* ((size 1200)
+         (string (map-into (make-string size)
+                           (lambda () (code-char (random #x10000))))))
+    (setf (char string 0) (code-char #x10001)
+          (char string (1- size)) (code-char #x10002))
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format '(:ucs2be :replacement #\replacement_character))
+      (write-string string s))
+    (with-open-file (s *test-path* :external-format :ucs2be)
+      (let ((new (make-string size)))
+        (read-sequence new s)
+        (assert (char= (char new 0) #\replacement_character))
+        (assert (char= (char new (1- size)) #\replacement_character))
+        (assert (string= string new :start1 1 :start2 1 :end1 (1- size) :end2 (1- size)))))))
+
+(with-test (:name (:multibyte :input-replacement :ucs4le))
+  (let ((octets (coerce '(0 1 1 0 1 0 0 1) '(vector (unsigned-byte 8)))))
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-sequence octets s))
+    (with-open-file (s *test-path* :external-format '(:ucs4le :replacement #\replacement_character))
+      (let ((string (read-line s)))
+        (assert (char= (char string 0) (code-char #x10100)))
+        (assert (char= (char string 1) #\replacement_character))))))
+
+(with-test (:name (:multibyte :input-replacement :ucs4le))
+  (let ((octets (coerce '(0 1 1 0 1 0 0 1) '(vector (unsigned-byte 8)))))
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (write-sequence octets s))
+    (with-open-file (s *test-path* :external-format '(:ucs4be :replacement #\replacement_character))
+      (let ((string (read-line s)))
+        (assert (char= (char string 0) (code-char #x10100)))
+        (assert (char= (char string 1) #\replacement_character))))))
+
+;;; utf tests
+(with-test (:name (:utf-16le :roundtrip))
+  (let ((string (map 'string 'code-char '(#x20 #x200 #x2000 #xfffd #x10fffd))))
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede
+                       :external-format :utf-16le)
+      (write-string string s))
+    (with-open-file (s *test-path* :external-format :utf-16le)
+      (assert (string= string (read-line s))))))
+(with-test (:name (:utf-16be :roundtrip))
+  (let ((string (map 'string 'code-char '(#x20 #x200 #x2000 #xfffd #x10fffd))))
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede
+                       :external-format :utf-16be)
+      (write-string string s))
+    (with-open-file (s *test-path* :external-format :utf-16be)
+      (assert (string= string (read-line s))))))
+(with-test (:name (:utf-16le :encoding-error))
+  (let ((string (map 'string 'code-char '(#x20 #xfffe #xdc00 #xd800 #x1fffe #x20))))
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede
+                       :external-format '(:utf-16le :replacement #\?))
+      (write-string string s))
+    (with-open-file (s *test-path* :external-format :utf-16le)
+      (assert (string= " ???? " (read-line s))))))
+(with-test (:name (:utf-16be :encoding-error))
+  (let ((string (map 'string 'code-char '(#x20 #xfffe #xdc00 #xd800 #x1fffe #x20))))
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede
+                       :external-format '(:utf-16be :replacement #\?))
+      (write-string string s))
+    (with-open-file (s *test-path* :external-format :utf-16be)
+      (assert (string= " ???? " (read-line s))))))
+
+(with-test (:name (:utf-32le :roundtrip))
+  (let ((string (map 'string 'code-char '(#x20 #x200 #x2000 #xfffd #x10fffd))))
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede
+                       :external-format :utf-32le)
+      (write-string string s))
+    (with-open-file (s *test-path* :external-format :utf-32le)
+      (assert (string= string (read-line s))))))
+(with-test (:name (:utf-32be :roundtrip))
+  (let ((string (map 'string 'code-char '(#x20 #x200 #x2000 #xfffd #x10fffd))))
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede
+                       :external-format :utf-32be)
+      (write-string string s))
+    (with-open-file (s *test-path* :external-format :utf-32be)
+      (assert (string= string (read-line s))))))
+(with-test (:name (:utf-32le :encoding-error))
+  (let ((string (map 'string 'code-char '(#x20 #xfffe #xdc00 #xd800 #x1fffe #x20))))
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede
+                       :external-format '(:utf-32le :replacement #\?))
+      (write-string string s))
+    (with-open-file (s *test-path* :external-format :utf-32le)
+      (assert (string= " ???? " (read-line s))))))
+(with-test (:name (:utf-32be :encoding-error))
+  (let ((string (map 'string 'code-char '(#x20 #xfffe #xdc00 #xd800 #x1fffe #x20))))
+    (with-open-file (s *test-path* :direction :output :if-exists :supersede
+                       :external-format '(:utf-32be :replacement #\?))
+      (write-string string s))
+    (with-open-file (s *test-path* :external-format :utf-32be)
+      (assert (string= " ???? " (read-line s))))))
+
 ;;;; success