X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fexternal-format.impure.lisp;h=78285f71b05019c10a03fe2d62534323dc3ccdfe;hb=4363cb61eb8e2dc833070da398864a039210e1c8;hp=430078ba5961b88a716d57b62d5b67f6777d8b41;hpb=54b330585ed41edeb93a289f0e59aec67fa9ded9;p=sbcl.git diff --git a/tests/external-format.impure.lisp b/tests/external-format.impure.lisp index 430078b..78285f7 100644 --- a/tests/external-format.impure.lisp +++ b/tests/external-format.impure.lisp @@ -17,9 +17,11 @@ (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") (do-external-formats (xf) (with-open-file (s #-win32 "/dev/null" #+win32 "nul" :direction :input :external-format xf) @@ -28,16 +30,18 @@ ;;; Test standard character read-write equivalency over all external formats. (let ((standard-characters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!$\"'(),_-./:;?+<=>#%&*@[\\]{|}`^~")) (do-external-formats (xf) - (with-open-file (s "external-format-test.txt" :direction :output + (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 "external-format-test.txt" :direction :input + (with-open-file (s *test-path* :direction :input :external-format xf) (loop for character across standard-characters - do (assert (eql (read-char s) character)))))) + do (let ((got (read-char s))) + (unless (eql character got) + (error "wanted ~S, got ~S" character got))))))) -(delete-file "external-format-test.txt") +(delete-file *test-path*) #-sb-unicode (progn (test-util:report-test-status) @@ -49,28 +53,30 @@ (dotimes (width-1 4) (let ((character (code-char (elt '(1 #x81 #x801 #x10001) width-1)))) (dotimes (offset (+ width-1 1)) - (with-open-file (s "external-format-test.txt" :direction :output + (with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format :utf-8) (dotimes (n offset) (write-char #\a s)) - (dotimes (n 4097) + (dotimes (n (+ 4 sb-impl::+bytes-per-buffer+)) (write-char character s))) - (with-open-file (s "external-format-test.txt" :direction :input + (with-open-file (s *test-path* :direction :input :external-format :utf-8) (dotimes (n offset) (assert (eql (read-char s) #\a))) - (dotimes (n 4097) - (assert (eql (read-char s) character))) + (dotimes (n (+ 4 sb-impl::+bytes-per-buffer+)) + (let ((got (read-char s))) + (unless (eql got character) + (error "wanted ~S, got ~S (~S)" character got n)))) (assert (eql (read-char s nil s) s)))))) ;;; Test character decode restarts. -(with-open-file (s "external-format-test.txt" :direction :output +(with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8)) (write-byte 65 s) (write-byte 66 s) (write-byte #xe0 s) (write-byte 67 s)) -(with-open-file (s "external-format-test.txt" :direction :input +(with-open-file (s *test-path* :direction :input :external-format :utf-8) (handler-bind ((sb-int:character-decoding-error #'(lambda (decoding-error) @@ -79,7 +85,7 @@ 'sb-int:attempt-resync)))) (assert (equal (read-line s nil s) "ABC")) (assert (equal (read-line s nil s) s)))) -(with-open-file (s "external-format-test.txt" :direction :input +(with-open-file (s *test-path* :direction :input :external-format :utf-8) (handler-bind ((sb-int:character-decoding-error #'(lambda (decoding-error) @@ -91,7 +97,7 @@ ;;; And again with more data to account for buffering (this was briefly) ;;; broken in early 0.9.6. -(with-open-file (s "external-format-test.txt" :direction :output +(with-open-file (s *test-path* :direction :output :if-exists :supersede :element-type '(unsigned-byte 8)) (let ((a (make-array 50 :element-type '(unsigned-byte 64) @@ -104,7 +110,7 @@ (dotimes (i 40) (write-sequence a s)))) (with-test (:name (:character-decode-large :attempt-resync)) - (with-open-file (s "external-format-test.txt" :direction :input + (with-open-file (s *test-path* :direction :input :external-format :utf-8) (handler-bind ((sb-int:character-decoding-error #'(lambda (decoding-error) @@ -126,7 +132,7 @@ ;; rightfully confuses some people, so we'll skip running the code ;; for now. -- JES, 2006-01-27 #+nil - (with-open-file (s "external-format-test.txt" :direction :input + (with-open-file (s *test-path* :direction :input :external-format :utf-8) (handler-bind ((sb-int:character-decoding-error #'(lambda (decoding-error) @@ -142,7 +148,7 @@ (assert (equal (read-line s nil s) s)))))) ;;; Test character encode restarts. -(with-open-file (s "external-format-test.txt" :direction :output +(with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format :latin-1) (handler-bind ((sb-int:character-encoding-error #'(lambda (encoding-error) @@ -153,12 +159,12 @@ (write-char #\B s) (write-char (code-char 322) s) (write-char #\C s))) -(with-open-file (s "external-format-test.txt" :direction :input +(with-open-file (s *test-path* :direction :input :external-format :latin-1) (assert (equal (read-line s nil s) "ABC")) (assert (equal (read-line s nil s) s))) -(with-open-file (s "external-format-test.txt" :direction :output +(with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format :latin-1) (handler-bind ((sb-int:character-encoding-error #'(lambda (encoding-error) @@ -169,7 +175,7 @@ :initial-contents `(#\A #\B ,(code-char 322) #\C)))) (write-string string s)))) -(with-open-file (s "external-format-test.txt" :direction :input +(with-open-file (s *test-path* :direction :input :external-format :latin-1) (assert (equal (read-line s nil s) "ABC")) (assert (equal (read-line s nil s) s))) @@ -191,7 +197,7 @@ ;;;; KOI8-R external format -(with-open-file (s "external-format-test.txt" :direction :output +(with-open-file (s *test-path* :direction :output :if-exists :supersede :external-format :koi8-r) (write-char (code-char #xB0) s) (assert (eq @@ -202,15 +208,15 @@ (sb-int:character-encoding-error () :good)) :good))) -(with-open-file (s "external-format-test.txt" :direction :input +(with-open-file (s *test-path* :direction :input :element-type '(unsigned-byte 8)) (let ((byte (read-byte s))) (assert (= (eval byte) #x9C)))) -(with-open-file (s "external-format-test.txt" :direction :input +(with-open-file (s *test-path* :direction :input :external-format :koi8-r) (let ((char (read-char s))) (assert (= (char-code (eval char)) #xB0)))) -(delete-file "external-format-test.txt") +(delete-file *test-path*) (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)) @@ -225,7 +231,7 @@ ;;; tests of FILE-STRING-LENGTH (let ((standard-characters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!$\"'(),_-./:;?+<=>#%&*@[\\]{|}`^~")) (do-external-formats (xf) - (with-open-file (s "external-format-test.txt" :direction :output + (with-open-file (s *test-path* :direction :output :external-format xf) (loop for x across standard-characters for position = (file-position s) @@ -236,12 +242,12 @@ (string-length (file-string-length s standard-characters))) (write-string standard-characters s) (assert (= (file-position s) (+ position string-length))))) - (delete-file "external-format-test.txt"))) + (delete-file *test-path*))) (let ((char-codes '(0 1 255 256 511 512 1023 1024 2047 2048 4095 4096 8191 8192 16383 16384 32767 32768 65535 65536 131071 131072 262143 262144))) - (with-open-file (s "external-format-test.txt" :direction :output + (with-open-file (s *test-path* :direction :output :external-format :utf-8) (dolist (code char-codes) (let* ((char (code-char code)) @@ -259,7 +265,7 @@ ;;; 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)) - (let ((path "external-format-test.txt")) + (let ((path *test-path*)) (with-open-file (s path :direction :output :if-exists :supersede @@ -279,6 +285,24 @@ (let ((new-char (read-char s))) (assert (char= char new-char))))) (values))) +(delete-file *test-path*) + +;;; We used to call STREAM-EXTERNAL-FORMAT on the stream in the error +;;; when printing a coding error, but that didn't work if the stream +;;; was closed by the time the error was printed. See sbcl-devel +;;; "Subject: Printing coding errors for closed streams" by Zach Beane +;;; 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-path* :external-format :utf-8) + (read-char stream)))) + (with-open-file (stream *test-path* + :direction :output + :if-exists :supersede + :element-type '(unsigned-byte 8)) + (write-byte 192 stream)) + (princ-to-string (nth-value 1 (ignore-errors (first-file-character)))))) +(delete-file *test-path*) ;;; External format support in SB-ALIEN