X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Foctets.pure.lisp;h=e78e2db29493630e035897f45f7713a9df480093;hb=13909586f2c9f3397c3a276c7b6f92d62089f9e2;hp=4bf7f18b5ff44e8b3e55a3dbcafddf7b5b1821e8;hpb=75476d1d19ac3d7239c8963a498c447a8368433d;p=sbcl.git diff --git a/tests/octets.pure.lisp b/tests/octets.pure.lisp index 4bf7f18..e78e2db 100644 --- a/tests/octets.pure.lisp +++ b/tests/octets.pure.lisp @@ -51,7 +51,8 @@ (ensure-roundtrip-utf8 () (let ((string (make-string char-code-limit))) (dotimes (i char-code-limit) - (setf (char string i) (code-char i))) + (unless (<= #xd800 i #xdfff) + (setf (char string i) (code-char i)))) (let ((string2 (octets-to-string (string-to-octets string :external-format :utf8) :external-format :utf8))) @@ -131,12 +132,21 @@ (utf8-decode-tests #(#xe0 #xa0 #x80) "?") ; #x800 (utf8-decode-tests #(#xef #xbf #xbf) "?") ; #xffff (utf8-decode-tests #(#xf0 #x90 #x80 #x80) "?")) ; #x10000 - (utf8-decode-tests #(#xf4 #x90 #x80 #x80) "?") ; #x110000 - (utf8-decode-tests #(#xf7 #xbf #xbf #xbf) "?") ; #x1fffff - (utf8-decode-tests #(#xf8 #x88 #x80 #x80 #x80) "?") ; #x200000 - (utf8-decode-tests #(#xfb #xbf #xbf #xbf #xbf) "?") ; #x3ffffff - (utf8-decode-tests #(#xfc #x84 #x80 #x80 #x80 #x80) "?") ; #x4000000 - (utf8-decode-tests #(#xfd #xbf #xbf #xbf #xbf #xbf) "?") ; #x7fffffff + #+nil ; old, 6-byte UTF-8 definition + (progn + (utf8-decode-tests #(#xf4 #x90 #x80 #x80) "?") ; #x110000 + (utf8-decode-tests #(#xf7 #xbf #xbf #xbf) "?") ; #x1fffff + (utf8-decode-tests #(#xf8 #x88 #x80 #x80 #x80) "?") ; #x200000 + (utf8-decode-tests #(#xfb #xbf #xbf #xbf #xbf) "?") ; #x3ffffff + (utf8-decode-tests #(#xfc #x84 #x80 #x80 #x80 #x80) "?") ; #x4000000 + (utf8-decode-tests #(#xfd #xbf #xbf #xbf #xbf #xbf) "?")) ; #x7fffffff + (progn ; new, 4-byte (maximum #x10ffff) UTF-8 definition + (utf8-decode-tests #(#xf4 #x90) "??") ; #x110000 + (utf8-decode-tests #(#xf7 #xbf #xbf #xbf) "????") ; #x1fffff + (utf8-decode-tests #(#xf8 #x88 #x80 #x80 #x80) "?????") ; #x200000 + (utf8-decode-tests #(#xfb #xbf #xbf #xbf #xbf) "?????") ; #x3ffffff + (utf8-decode-tests #(#xfc #x84 #x80 #x80 #x80 #x80) "??????") ; #x4000000 + (utf8-decode-tests #(#xfd #xbf #xbf #xbf #xbf #xbf) "??????")) ; #x7fffffff ;; Unexpected continuation bytes (utf8-decode-tests #(#x80) "?") @@ -178,19 +188,24 @@ ;; Otherwise incomplete sequences (last continuation byte missing) (utf8-decode-tests #0=#(#xc0) "?") - (utf8-decode-tests #1=#(#xe0 #x80) "?") - (utf8-decode-tests #2=#(#xf0 #x80 #x80) "?") + (utf8-decode-tests #1=#(#xe0 #xa0) "?") + (utf8-decode-tests #2=#(#xf0 #x90 #x80) "?") + #+nil (utf8-decode-tests #3=#(#xf8 #x80 #x80 #x80) "?") + #+nil (utf8-decode-tests #4=#(#xfc #x80 #x80 #x80 #x80) "?") (utf8-decode-tests #5=#(#xdf) "?") (utf8-decode-tests #6=#(#xef #xbf) "?") + #+nil (utf8-decode-tests #7=#(#xf7 #xbf #xbf) "?") + #+nil (utf8-decode-tests #8=#(#xfb #xbf #xbf #xbf) "?") + #+nil (utf8-decode-tests #9=#(#xfd #xbf #xbf #xbf #xbf) "?") ;; All ten previous tests concatenated - (utf8-decode-tests (concatenate 'vector #0# #1# #2# #3# #4# #5# #6# #7# #8# #9#) - "??????????") + (utf8-decode-tests (concatenate 'vector #0# #1# #2# #5# #6#) + "?????") ;; Random impossible bytes (utf8-decode-tests #(#xfe) "?") @@ -198,25 +213,25 @@ (utf8-decode-tests #(#xfe #xfe #xff #xff) "????") ;; Overlong sequences - / - (utf8-decode-tests #(#xc0 #xaf) "?") - (utf8-decode-tests #(#xe0 #x80 #xaf) "?") - (utf8-decode-tests #(#xf0 #x80 #x80 #xaf) "?") - (utf8-decode-tests #(#xf8 #x80 #x80 #x80 #xaf) "?") - (utf8-decode-tests #(#xfc #x80 #x80 #x80 #x80 #xaf) "?") + (utf8-decode-tests #(#xc0 #xaf) "??") + (utf8-decode-tests #(#xe0 #x80 #xaf) "???") + (utf8-decode-tests #(#xf0 #x80 #x80 #xaf) "????") + (utf8-decode-tests #(#xf8 #x80 #x80 #x80 #xaf) "?????") + (utf8-decode-tests #(#xfc #x80 #x80 #x80 #x80 #xaf) "??????") ;; Overlong sequences - #\Rubout - (utf8-decode-tests #(#xc1 #xbf) "?") - (utf8-decode-tests #(#xe0 #x9f #xbf) "?") - (utf8-decode-tests #(#xf0 #x8f #xbf #xbf) "?") - (utf8-decode-tests #(#xf8 #x87 #xbf #xbf #xbf) "?") - (utf8-decode-tests #(#xfc #x83 #xbf #xbf #xbf #xbf) "?") + (utf8-decode-tests #(#xc1 #xbf) "??") + (utf8-decode-tests #(#xe0 #x9f #xbf) "???") + (utf8-decode-tests #(#xf0 #x8f #xbf #xbf) "????") + (utf8-decode-tests #(#xf8 #x87 #xbf #xbf #xbf) "?????") + (utf8-decode-tests #(#xfc #x83 #xbf #xbf #xbf #xbf) "??????") ;; Overlong sequences - #\Null - (utf8-decode-tests #(#xc0 #x80) "?") - (utf8-decode-tests #(#xe0 #x80 #x80) "?") - (utf8-decode-tests #(#xf0 #x80 #x80 #x80) "?") - (utf8-decode-tests #(#xf8 #x80 #x80 #x80 #x80) "?") - (utf8-decode-tests #(#xfc #x80 #x80 #x80 #x80 #x80) "?") + (utf8-decode-tests #(#xc0 #x80) "??") + (utf8-decode-tests #(#xe0 #x80 #x80) "???") + (utf8-decode-tests #(#xf0 #x80 #x80 #x80) "????") + (utf8-decode-tests #(#xf8 #x80 #x80 #x80 #x80) "?????") + (utf8-decode-tests #(#xfc #x80 #x80 #x80 #x80 #x80) "??????") ;; Not testing surrogates & characters #xFFFE, #xFFFF; they're ;; perfectly good sbcl chars even if they're not actually ISO 10646 @@ -236,14 +251,16 @@ :external-format :utf-8))) (assert (equalp #() (string-to-octets (make-array 5 :element-type nil) :start 3 :end 3 :external-format :utf-8))) +(assert (equalp #(0) (string-to-octets (make-array 5 :element-type nil) + :start 3 :end 3 :null-terminate t + :external-format :utf-8))) ;;; whoops: the iso-8859-2 format referred to an undefined symbol. #+sb-unicode (assert (equalp #(251) (string-to-octets (string (code-char 369)) :external-format :latin-2))) -#+sb-unicode -(with-test (:name (:euc-jp :decoding-errors)) +(with-test (:name (:euc-jp :decoding-errors) :skipped-on '(not :sb-unicode)) (handler-bind ((sb-int:character-decoding-error (lambda (c) (use-value #\? c)))) (assert (string= "?{?" @@ -251,3 +268,131 @@ (coerce #(182 123 253 238) '(vector (unsigned-byte 8))) :external-format :euc-jp))))) +(with-test (:name (:utf-8 :surrogates :encoding-errors) :skipped-on '(not :sb-unicode)) + (handler-bind ((sb-int:character-encoding-error + (lambda (c) (use-value #\? c)))) + (assert (equalp (string-to-octets (string (code-char #xd800)) + :external-format :utf-8) + (vector (char-code #\?)))))) +(with-test (:name (:utf-8 :surrogates :decoding-errors) :skipped-on '(not :sb-unicode)) + (handler-bind ((sb-int:character-decoding-error + (lambda (c) (use-value #\? c)))) + (assert (find #\? (octets-to-string + (coerce #(237 160 128) '(vector (unsigned-byte 8))) + :external-format :utf-8))))) + +(with-test (:name (:ucs-2 :out-of-range :encoding-errors) :skipped-on '(not :sb-unicode)) + (handler-bind ((sb-int:character-encoding-error + (lambda (c) (use-value "???" c)))) + (assert (equalp (string-to-octets (string (code-char #x10001)) + :external-format :ucs-2le) + #(63 0 63 0 63 0)))) + (handler-bind ((sb-int:character-encoding-error + (lambda (c) (use-value "???" c)))) + (assert (equalp (string-to-octets (string (code-char #x10001)) + :external-format :ucs-2be) + #(0 63 0 63 0 63))))) + +(with-test (:name (:ucs-4 :out-of-range :decoding-errors) :skipped-on '(not :sb-unicode)) + (handler-bind ((sb-int:character-decoding-error + (lambda (c) (use-value "???" c)))) + (assert (equalp (octets-to-string (coerce '(1 2 3 4) '(vector (unsigned-byte 8))) + :external-format :ucs-4le) + "???"))) + (assert (equalp (octets-to-string (coerce '(#xff #xff #x10 #x00) '(vector (unsigned-byte 8))) + :external-format :ucs-4le) + (string (code-char #x10ffff)))) + (handler-bind ((sb-int:character-decoding-error + (lambda (c) (use-value "???" c)))) + (assert (equalp (octets-to-string (coerce '(1 2 3 4) '(vector (unsigned-byte 8))) + :external-format :ucs-4be) + "???")) + (assert (equalp (octets-to-string (coerce '(#x00 #x10 #xff #xff) '(vector (unsigned-byte 8))) + :external-format :ucs-4be) + (string (code-char #x10ffff)))))) + +(with-test (:name (:utf-16le :ensure-roundtrip) :skipped-on '(not :sb-unicode)) + (flet ((enc (x) + (string-to-octets x :external-format :utf-16le)) + (dec (x) + (octets-to-string (coerce x '(vector (unsigned-byte 8))) + :external-format :utf-16le))) + (let ((string (map 'string 'code-char + '(#x20 #x200 #x2000 #x10000 #x10401 #x10fffd))) + (octets #(#x20 0 0 #x2 0 #x20 0 #xd8 0 #xdc 1 #xd8 1 #xdc #xff #xdb #xfd #xdf))) + (assert (equalp (enc string) octets)) + (assert (equalp (dec octets) string))))) + +(with-test (:name (:utf-16le :encoding-error) :skipped-on '(not :sb-unicode)) + (flet ((enc (x) + (string-to-octets x :external-format '(:utf-16le :replacement #\?))) + (dec (x) + (octets-to-string (coerce x '(vector (unsigned-byte 8))) + :external-format :utf-16le))) + (let ((string (map 'string 'code-char '(#xd800 #xdc00 #xfffe #x10ffff)))) + (assert (equalp (enc string) #(63 0 63 0 63 0 63 0)))))) + +(with-test (:name (:utf-16be :ensure-roundtrip) :skipped-on '(not :sb-unicode)) + (flet ((enc (x) + (string-to-octets x :external-format :utf-16be)) + (dec (x) + (octets-to-string (coerce x '(vector (unsigned-byte 8))) + :external-format :utf-16be))) + (let ((string (map 'string 'code-char + '(#x20 #x200 #x2000 #x10000 #x10401 #x10fffd))) + (octets #(0 #x20 #x2 0 #x20 0 #xd8 0 #xdc 0 #xd8 1 #xdc 1 #xdb #xff #xdf #xfd))) + (assert (equalp (enc string) octets)) + (assert (equalp (dec octets) string))))) + +(with-test (:name (:utf-16be :encoding-error) :skipped-on '(not :sb-unicode)) + (flet ((enc (x) + (string-to-octets x :external-format '(:utf-16be :replacement #\?))) + (dec (x) + (octets-to-string (coerce x '(vector (unsigned-byte 8))) + :external-format :utf-16be))) + (let ((string (map 'string 'code-char '(#xd800 #xdc00 #xfffe #x10ffff)))) + (assert (equalp (enc string) #(0 63 0 63 0 63 0 63)))))) + + +(with-test (:name (:utf-32le :ensure-roundtrip) :skipped-on '(not :sb-unicode)) + (flet ((enc (x) + (string-to-octets x :external-format :utf-32le)) + (dec (x) + (octets-to-string (coerce x '(vector (unsigned-byte 8))) + :external-format :utf-32le))) + (let ((string (map 'string 'code-char + '(#x20 #x200 #x2000 #x10000 #x10401 #x10fffd))) + (octets #(#x20 0 0 0 0 #x2 0 0 0 #x20 0 0 0 0 1 0 1 4 1 0 #xfd #xff #x10 0))) + (assert (equalp (enc string) octets)) + (assert (equalp (dec octets) string))))) + +(with-test (:name (:utf-32le :encoding-error) :skipped-on '(not :sb-unicode)) + (flet ((enc (x) + (string-to-octets x :external-format '(:utf-32le :replacement #\?))) + (dec (x) + (octets-to-string (coerce x '(vector (unsigned-byte 8))) + :external-format :utf-32le))) + (let ((string (map 'string 'code-char '(#xd800 #xdc00 #xfffe #x10ffff)))) + (assert (equalp (enc string) #(63 0 0 0 63 0 0 0 63 0 0 0 63 0 0 0)))))) + + +(with-test (:name (:utf-32be :ensure-roundtrip) :skipped-on '(not :sb-unicode)) + (flet ((enc (x) + (string-to-octets x :external-format :utf-32be)) + (dec (x) + (octets-to-string (coerce x '(vector (unsigned-byte 8))) + :external-format :utf-32be))) + (let ((string (map 'string 'code-char + '(#x20 #x200 #x2000 #x10000 #x10401 #x10fffd))) + (octets #(0 0 0 #x20 0 0 #x2 0 0 0 #x20 0 0 1 0 0 0 1 4 1 0 #x10 #xff #xfd))) + (assert (equalp (enc string) octets)) + (assert (equalp (dec octets) string))))) + +(with-test (:name (:utf-32be :encoding-error) :skipped-on '(not :sb-unicode)) + (flet ((enc (x) + (string-to-octets x :external-format '(:utf-32be :replacement #\?))) + (dec (x) + (octets-to-string (coerce x '(vector (unsigned-byte 8))) + :external-format :utf-32be))) + (let ((string (map 'string 'code-char '(#xd800 #xdc00 #xfffe #x10ffff)))) + (assert (equalp (enc string) #(0 0 0 63 0 0 0 63 0 0 0 63 0 0 0 63))))))