X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Fexternal-format.impure.lisp;h=cff240a2737b9a00b25bcbb35c45d5454459064d;hb=07d6dd986728e8ea781954f5a3c2799ff0418ecb;hp=09953f341441c14f644405e32255f79cc0407fcc;hpb=9f29c03145c7fdefc5f54939d67ee8e00cd85f14;p=sbcl.git diff --git a/tests/external-format.impure.lisp b/tests/external-format.impure.lisp index 09953f3..cff240a 100644 --- a/tests/external-format.impure.lisp +++ b/tests/external-format.impure.lisp @@ -211,6 +211,16 @@ (let ((char (read-char s))) (assert (= (char-code (eval char)) #xB0)))) (delete-file "external-format-test.txt") + +(let* ((koi8-r-codes (coerce '(240 210 201 215 197 212 33) '(vector (unsigned-byte 8)))) + (uni-codes #(1055 1088 1080 1074 1077 1090 33)) + + (string (octets-to-string koi8-r-codes :external-format :koi8-r)) + (uni-decoded (map 'vector #'char-code string))) + (assert (equalp (map 'vector #'char-code (octets-to-string koi8-r-codes :external-format :koi8-r)) + uni-codes)) + (assert (equalp (string-to-octets (map 'string #'code-char uni-codes) :external-format :koi8-r) + koi8-r-codes))) ;;; tests of FILE-STRING-LENGTH (let ((standard-characters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!$\"'(),_-./:;?+<=>#%&*@[\\]{|}`^~")) @@ -245,4 +255,30 @@ (write-string string s) (assert (= (file-position s) (+ position string-length)))))) -;;;; success \ No newline at end of file + +;;; See sbcl-devel "Subject: Bug in FILE-POSITION on UTF-8-encoded files" +;;; by Lutz Euler on 2006-03-05 for more details. +(with-test (:name (:file-position :utf-8) + :fails-on :sbcl) + (let ((path "external-format-test.txt")) + (with-open-file (s path + :direction :output + :if-exists :supersede + :element-type '(unsigned-byte 8)) + ;; Write #\*, encoded in UTF-8, to the file. + (write-byte 42 s) + ;; Append #\adiaeresis, encoded in UTF-8, to the file. + (write-sequence '(195 164) s)) + (with-open-file (s path :external-format :utf-8) + (read-char s) + (let ((pos (file-position s)) + (char (read-char s))) + (format t "read character with code ~a successfully from file position ~a~%" + (char-code char) pos) + (file-position s pos) + (format t "set file position back to ~a, trying to read-char again~%" pos) + (let ((new-char (read-char s))) + (assert (char= char new-char))))) + (values))) + +;;;; success