(defvar *test-path* "external-format-test.tmp")
-(do-external-formats (xf)
- (with-open-file (s #-win32 "/dev/null" #+win32 "nul" :direction :input :external-format xf)
- (assert (eq (read-char s nil s) s))))
+(with-test (:name :end-of-file)
+ (do-external-formats (xf)
+ (with-open-file (s #-win32 "/dev/null" #+win32 "nul" :direction :input :external-format xf)
+ (assert (eq (read-char s nil s) s)))))
;;; Test standard character read-write equivalency over all external formats.
-(let ((standard-characters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!$\"'(),_-./:;?+<=>#%&*@[\\]{|}`^~"))
- (do-external-formats (xf)
- (with-open-file (s *test-path* :direction :output
- :if-exists :supersede :external-format xf)
- (loop for character across standard-characters
- do (write-char character s)))
- (with-open-file (s *test-path* :direction :input
- :external-format xf)
- (loop for character across standard-characters
- do (let ((got (read-char s)))
- (unless (eql character got)
- (error "wanted ~S, got ~S" character got)))))))
+(macrolet
+ ((frob ()
+ (let ((tests nil))
+ (do-external-formats (xf)
+ (pushnew `(with-test (:name (:standard-character :read-write-equivalency ,xf))
+ (let ((standard-characters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!$\"'(),_-./:;?+<=>#%&*@[\\]{|}`^~"))
+ (with-open-file (s *test-path* :direction :output
+ :if-exists :supersede :external-format ,xf)
+ (loop for character across standard-characters
+ do (write-char character s)))
+ (with-open-file (s *test-path* :direction :input
+ :external-format ,xf)
+ (loop for character across standard-characters
+ do (let ((got (read-char s)))
+ (unless (eql character got)
+ (error "wanted ~S, got ~S" character got)))))))
+ tests :key #'cadr :test #'equal))
+ `(progn ,@tests))))
+ (frob))
(delete-file *test-path*)
#-sb-unicode
(assert (= 113 (count #\? string :start #x80))))))
(delete-file *test-path*)
\f
+;;; 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))))))
+\f
+;;; 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))))))
+
+(with-test (:name :invalid-external-format)
+ (labels ((test-error (e)
+ (assert (typep e 'error))
+ (unless (equal "Undefined external-format: :BAD-FORMAT"
+ (princ-to-string e))
+ (error "Bad error:~% ~A" e)))
+ (test (direction)
+ (test-error
+ (handler-case
+ (open "/dev/null" :direction direction :external-format :bad-format
+ :if-exists :overwrite)
+ (error (e) e)))))
+ (test :input)
+ (test :output)
+ (test :io)
+ (test-error
+ (handler-case
+ (run-program "sh" '() :input :stream :external-format :bad-format)
+ (error (e) e)))
+ (test-error
+ (handler-case
+ (string-to-octets "foobar" :external-format :bad-format)
+ (error (e) e)))
+ (test-error
+ (let ((octets (string-to-octets "foobar" :external-format :latin1)))
+ (handler-case
+ (octets-to-string octets :external-format :bad-format)
+ (error (e) e))))))
+
+(with-test (:name :lp713063)
+ (with-open-file (f *test-path*
+ :direction :output
+ :external-format '(:euc-jp :replacement #\?)
+ :if-exists :supersede)
+ (write-string (make-string 3 :initial-element #\horizontal_bar) f))
+ (assert (equal "???"
+ (with-open-file (f *test-path*
+ :direction :input
+ :external-format :euc-jp)
+ (read-line f))))
+ (delete-file *test-path*))
+\f
;;;; success
projects / sbcl.git / blobdiff