1.0.32.21: compress most unibyte-external-format definitions
[sbcl.git] / tests / external-format.impure.lisp
index ee8aed1..9311320 100644 (file)
       (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*)
+\f
+;;; 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*)
+\f
+;;; 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*)
+\f
+;;; 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*)
+\f
+;;; 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*)
+\f
+;;; 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*)
+\f
+;;; 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*)
+\f
+;;; 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*)
+\f
+;;; 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*)
+\f
+;;; 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*)
+\f
+;;; 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*)
+\f
+;;; 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*)
+\f
+;;; 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*)
+\f
+;;; 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*)
+\f
+;;; 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*)
+\f
+;;; 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*)
+\f
+;;; 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*)
+\f
 ;;;; success