X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fexternal-format.impure.lisp;h=c86b6ef2fb0070813c897d53dde46116cbb6371b;hb=aede5ac0bbafc2ec5ef5044a51e47a9e10963d54;hp=2cadc0ce121583d2ba566ee3ee13aa25d2931340;hpb=b41f8c974ccfba8a59ec2a6af843e8869e14be5f;p=sbcl.git diff --git a/tests/external-format.impure.lisp b/tests/external-format.impure.lisp index 2cadc0c..c86b6ef 100644 --- a/tests/external-format.impure.lisp +++ b/tests/external-format.impure.lisp @@ -10,7 +10,7 @@ ;;;; While most of SBCL is derived from the CMU CL system, the test ;;;; files (like this one) were written from scratch after the fork ;;;; from CMU CL. -;;;; +;;;; ;;;; This software is in the public domain and is provided with ;;;; absolutely no warranty. See the COPYING and CREDITS files for ;;;; more information. @@ -19,7 +19,7 @@ (let ((nxf (gensym))) `(dolist (,nxf sb-impl::*external-formats* ,result) (let ((,xf (first (first ,nxf)))) - ,@body)))) + ,@body)))) (do-external-formats (xf) (with-open-file (s "/dev/null" :direction :input :external-format xf) @@ -29,13 +29,19 @@ (let ((standard-characters "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!$\"'(),_-./:;?+<=>#%&*@[\\]{|}`^~")) (do-external-formats (xf) (with-open-file (s "external-format-test.txt" :direction :output - :if-exists :supersede :external-format xf) + :if-exists :supersede :external-format xf) (loop for character across standard-characters - do (write-char character s))) + do (write-char character s))) (with-open-file (s "external-format-test.txt" :direction :input - :external-format xf) + :external-format xf) (loop for character across standard-characters - do (assert (eql (read-char s) character)))))) + do (assert (eql (read-char s) character)))))) + +(delete-file "external-format-test.txt") +#-sb-unicode +(progn + (test-util:report-test-status) + (sb-ext:quit :unix-status 104)) ;;; Test UTF-8 writing and reading of 1, 2, 3 and 4 octet characters with ;;; all possible offsets. Tests for buffer edge bugs. fd-stream buffers are @@ -44,93 +50,114 @@ (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 - :if-exists :supersede :external-format :utf-8) - (dotimes (n offset) - (write-char #\a s)) - (dotimes (n 4097) - (write-char character s))) + :if-exists :supersede :external-format :utf-8) + (dotimes (n offset) + (write-char #\a s)) + (dotimes (n 4097) + (write-char character s))) (with-open-file (s "external-format-test.txt" :direction :input - :external-format :utf-8) - (dotimes (n offset) - (assert (eql (read-char s) #\a))) - (dotimes (n 4097) - (assert (eql (read-char s) character))) - (assert (eql (read-char s nil s) s)))))) + :external-format :utf-8) + (dotimes (n offset) + (assert (eql (read-char s) #\a))) + (dotimes (n 4097) + (assert (eql (read-char s) character))) + (assert (eql (read-char s nil s) s)))))) ;;; Test character decode restarts. (with-open-file (s "external-format-test.txt" :direction :output - :if-exists :supersede :element-type '(unsigned-byte 8)) + :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 - :external-format :utf-8) + :external-format :utf-8) (handler-bind ((sb-int:character-decoding-error #'(lambda (decoding-error) - (declare (ignore decoding-error)) - (invoke-restart - 'sb-int:attempt-resync)))) + (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)))) (with-open-file (s "external-format-test.txt" :direction :input - :external-format :utf-8) + :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)))) + (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)))) ;;; Test character encode restarts. (with-open-file (s "external-format-test.txt" :direction :output - :if-exists :supersede :external-format :latin-1) + :if-exists :supersede :external-format :latin-1) (handler-bind ((sb-int:character-encoding-error #'(lambda (encoding-error) - (declare (ignore encoding-error)) - (invoke-restart - 'sb-impl::output-nothing)))) + (declare (ignore encoding-error)) + (invoke-restart + 'sb-impl::output-nothing)))) (write-char #\A s) (write-char #\B s) (write-char (code-char 322) s) (write-char #\C s))) (with-open-file (s "external-format-test.txt" :direction :input - :external-format :latin-1) + :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 - :if-exists :supersede :external-format :latin-1) + :if-exists :supersede :external-format :latin-1) (handler-bind ((sb-int:character-encoding-error #'(lambda (encoding-error) - (declare (ignore encoding-error)) - (invoke-restart - 'sb-impl::output-nothing)))) + (declare (ignore encoding-error)) + (invoke-restart + 'sb-impl::output-nothing)))) (let ((string (make-array 4 :element-type 'character - :initial-contents `(#\A #\B ,(code-char 322) - #\C)))) + :initial-contents `(#\A #\B ,(code-char 322) + #\C)))) (write-string string s)))) (with-open-file (s "external-format-test.txt" :direction :input - :external-format :latin-1) + :external-format :latin-1) (assert (equal (read-line s nil s) "ABC")) (assert (equal (read-line s nil s) s))) ;;; Test skipping character-decode-errors in comments. (let ((s (open "external-format-test.lisp" :direction :output - :if-exists :supersede :external-format :latin-1))) + :if-exists :supersede :external-format :latin-1))) (unwind-protect (progn - (write-string ";;; ABCD" s) - (write-char (code-char 233) s) - (terpri s) - (close s) - (compile-file "external-format-test.lisp" :external-format :utf-8)) + (write-string ";;; ABCD" s) + (write-char (code-char 233) s) + (terpri s) + (close s) + (compile-file "external-format-test.lisp" :external-format :utf-8)) (delete-file s) (let ((p (probe-file (compile-file-pathname "external-format-test.lisp")))) (when p - (delete-file p))))) + (delete-file p))))) -(delete-file "external-format-test.txt") + +;;;; KOI8-R external format +(with-open-file (s "external-format-test.txt" :direction :output + :if-exists :supersede :external-format :koi8-r) + (write-char (code-char #xB0) s) + (assert (eq + (handler-case + (progn + (write-char (code-char #xBAAD) s) + :bad) + (sb-int:character-encoding-error () + :good)) + :good))) +(with-open-file (s "external-format-test.txt" :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 + :external-format :koi8-r) + (let ((char (read-char s))) + (assert (= (char-code (eval char)) #xB0)))) -(sb-ext:quit :unix-status 104) + +(delete-file "external-format-test.txt")