;;;; This file is for testing external-format functionality for UTF-8,
;;;; using test machinery which does not have side effects.  Note that
;;;; the tests here reach into unexported functionality, and should
;;;; not be used as a guide for users.

;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; 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.

(defvar *test-path* (scratch-file-name))

(macrolet ((input-test (inxf expected &environment env)
             `(progn
                (with-test (:name (,(macroexpand 'name env) :file ,inxf))
                  (with-open-file (s *test-path* :external-format ',inxf)
                    (let* ((string (make-string 20))
                           (count (read-sequence string s)))
                      (assert (equal (map 'list 'identity (subseq string 0 count)) ,expected)))))
                (with-test (:name (,(macroexpand 'name env) :octets ,inxf))
                  (let ((octets (coerce bytes '(simple-array (unsigned-byte 8) 1))))
                    (assert (equal (sb-ext:octets-to-string octets :external-format ',inxf)
                                   (coerce ,expected 'string)))))))
           (with-input-bytes ((id bytes) &body body)
             `(let ((bytes ,bytes))
                (with-open-file (s *test-path* :element-type '(unsigned-byte 8)
                                   :direction :output :if-exists :supersede)
                  (dolist (byte bytes)
                    (write-byte byte s)))
                (symbol-macrolet ((name ,id))
                  (macrolet ((test (inxf expected)
                               `(input-test ,inxf ,expected)))
                    ,@body))))
           (output-test (chars outxf expected &environment env)
             `(progn
                (with-open-file (s *test-path* :element-type 'character
                                   :external-format ',outxf
                                   :direction :output :if-exists :supersede)
                  (write-sequence ,chars s))
                (with-test (:name (,(macroexpand 'name env) :file ,outxf))
                  (with-open-file (s *test-path* :element-type '(unsigned-byte 8))
                    (let* ((vector (make-array 20 :element-type '(unsigned-byte 8)))
                           (count (read-sequence vector s)))
                      (assert (equal (map 'list 'identity (subseq vector 0 count)) ,expected)))))
                (with-test (:name (,(macroexpand 'name env) :octets string ,outxf))
                  (let* ((string (coerce chars 'string))
                         (octets (sb-ext:string-to-octets string :external-format ',outxf)))
                    (assert (typep octets '(simple-array (unsigned-byte 8) 1)))
                    (assert (equal (coerce octets 'list) ,expected))))
                (when (every (lambda (x) (typep x 'base-char)) chars)
                  (with-test (:name (,(macroexpand 'name env) :octets base-string ,outxf))
                    (let* ((string (coerce chars 'base-string))
                           (octets (sb-ext:string-to-octets string :external-format ',outxf)))
                      (assert (typep octets '(simple-array (unsigned-byte 8) 1)))
                      (assert (equal (coerce octets 'list) ,expected)))))))
           (with-output-characters ((id chars) &body body)
             `(let ((chars ,chars))
                (symbol-macrolet ((name ,id))
                  (macrolet ((test (outxf expected)
                               `(output-test chars ,outxf ,expected)))
                    ,@body)))))
  (with-input-bytes ((:input :lf :ascii) '(#x35 #x0a #x37))
    (test :utf-8 '(#\5 #\Newline #\7))
    (test (:utf-8 :newline :lf) '(#\5 #\Newline #\7))
    (test (:utf-8 :newline :cr) '(#\5 #\Newline #\7))
    (test (:utf-8 :newline :crlf) '(#\5 #\Newline #\7)))
  (with-output-characters ((:output :lf :ascii) '(#\5 #\Linefeed #\7))
    (test :utf-8 '(#x35 #x0a #x37))
    (test (:utf-8 :newline :lf) '(#x35 #x0a #x37))
    (test (:utf-8 :newline :cr) '(#x35 #x0d #x37))
    (test (:utf-8 :newline :crlf) '(#x35 #x0d #x0a #x37)))
  (with-input-bytes ((:input :cr :ascii) '(#x35 #x0d #x37))
    (test :utf-8 '(#\5 #\Return #\7))
    (test (:utf-8 :newline :lf) '(#\5 #\Return #\7))
    (test (:utf-8 :newline :cr) '(#\5 #\Newline #\7))
    (test (:utf-8 :newline :crlf) '(#\5 #\Return #\7)))
  (with-output-characters ((:output :cr :ascii) '(#\5 #\Return #\7))
    (test :utf-8 '(#x35 #x0d #x37))
    (test (:utf-8 :newline :lf) '(#x35 #x0d #x37))
    (test (:utf-8 :newline :cr) '(#x35 #x0d #x37))
    (test (:utf-8 :newline :crlf) '(#x35 #x0d #x37)))
  (with-input-bytes ((:input :crlf :ascii) '(#x35 #x0d #x0a #x37))
    (test :utf-8 '(#\5 #\Return #\Newline #\7))
    (test (:utf-8 :newline :lf) '(#\5 #\Return #\Newline #\7))
    (test (:utf-8 :newline :cr) '(#\5 #\Newline #\Newline #\7))
    (test (:utf-8 :newline :crlf) '(#\5 #\Newline #\7)))
  (with-output-characters ((:output :crlf :ascii) '(#\5 #\Return #\Linefeed #\7))
    (test :utf-8 '(#x35 #x0d #x0a #x37))
    (test (:utf-8 :newline :lf) '(#x35 #x0d #x0a #x37))
    (test (:utf-8 :newline :cr) '(#x35 #x0d #x0d #x37))
    (test (:utf-8 :newline :crlf) '(#x35 #x0d #x0d #x0a #x37)))
  (with-input-bytes ((:input :lf) '(#xc3 #xa9 #x0a #xc3 #xa8))
    (test :utf-8 '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Newline #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :lf) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Newline #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :cr) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Newline #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :crlf) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Newline #\LATIN_SMALL_LETTER_E_WITH_GRAVE)))
  (with-output-characters ((:output :lf) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Linefeed #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test :utf-8 '(#xc3 #xa9 #x0a #xc3 #xa8))
    (test (:utf-8 :newline :lf) '(#xc3 #xa9 #x0a #xc3 #xa8))
    (test (:utf-8 :newline :cr) '(#xc3 #xa9 #x0d #xc3 #xa8))
    (test (:utf-8 :newline :crlf) '(#xc3 #xa9 #x0d #x0a #xc3 #xa8)))
  (with-input-bytes ((:input :cr) '(#xc3 #xa9 #x0d #xc3 #xa8))
    (test :utf-8 '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Return #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :lf) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Return #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :cr) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Newline #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :crlf) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Return #\LATIN_SMALL_LETTER_E_WITH_GRAVE)))
  (with-output-characters ((:output :cr) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Return #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test :utf-8 '(#xc3 #xa9 #x0d #xc3 #xa8))
    (test (:utf-8 :newline :lf) '(#xc3 #xa9 #x0d #xc3 #xa8))
    (test (:utf-8 :newline :cr) '(#xc3 #xa9 #x0d #xc3 #xa8))
    (test (:utf-8 :newline :crlf) '(#xc3 #xa9 #x0d #xc3 #xa8)))
  (with-input-bytes ((:input :crlf) '(#xc3 #xa9 #x0d #x0a #xc3 #xa8))
    (test :utf-8 '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Return #\Newline #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :lf) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Return #\Newline #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :cr) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Newline #\Newline #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :crlf) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Newline #\LATIN_SMALL_LETTER_E_WITH_GRAVE)))
  (with-output-characters ((:output :crlf) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Return #\Linefeed #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test :utf-8 '(#xc3 #xa9 #x0d #x0a #xc3 #xa8))
    (test (:utf-8 :newline :lf) '(#xc3 #xa9 #x0d #x0a #xc3 #xa8))
    (test (:utf-8 :newline :cr) '(#xc3 #xa9 #x0d #x0d #xc3 #xa8))
    (test (:utf-8 :newline :crlf) '(#xc3 #xa9 #x0d #x0d #x0a #xc3 #xa8))))

(macrolet ((input-test (inxf expected &environment env)
             `(progn
                (with-test (:name (,(macroexpand 'name env) :file ,inxf))
                  (with-open-file (s *test-path* :external-format ',inxf)
                    (handler-bind ((sb-int:character-decoding-error
                                    (lambda (c) (use-value "" c))))
                      (let* ((string (make-string 20))
                             (count (read-sequence string s)))
                        (assert (equal (map 'list 'identity (subseq string 0 count)) ,expected))))))
                (with-test (:name (,(macroexpand 'name env) :octets ,inxf))
                  (handler-bind ((sb-int:character-decoding-error
                                  (lambda (c) (use-value "" c))))
                    (let ((octets (coerce bytes '(simple-array (unsigned-byte 8) 1))))
                      (assert (equal (sb-ext:octets-to-string octets :external-format ',inxf)
                                     (coerce ,expected 'string))))))))
           (with-input-bytes ((id bytes) &body body)
             `(let ((bytes ,bytes))
                (with-open-file (s *test-path* :element-type '(unsigned-byte 8)
                                   :direction :output :if-exists :supersede)
                  (dolist (byte bytes)
                    (write-byte byte s)))
                (symbol-macrolet ((name ,id))
                  (macrolet ((test (inxf expected)
                               `(input-test ,inxf ,expected)))
                    ,@body))))
           (output-test (chars outxf expected &environment env)
             `(progn
                (with-open-file (s *test-path* :element-type 'character
                                   :external-format ',outxf
                                   :direction :output :if-exists :supersede)
                  (handler-bind ((sb-int:character-encoding-error
                                  (lambda (c) (use-value "" c))))
                    (write-sequence ,chars s)))
                (with-test (:name (,(macroexpand 'name env) :file ,outxf))
                  (with-open-file (s *test-path* :element-type '(unsigned-byte 8))
                    (let* ((vector (make-array 20 :element-type '(unsigned-byte 8)))
                           (count (read-sequence vector s)))
                      (assert (equal (map 'list 'identity (subseq vector 0 count)) ,expected)))))
                (with-test (:name (,(macroexpand 'name env) :octets ,outxf))
                  (handler-bind ((sb-int:character-encoding-error
                                  (lambda (c) (use-value "" c))))
                    (let* ((string (coerce chars 'string))
                           (octets (sb-ext:string-to-octets string :external-format ',outxf)))
                      (assert (typep octets '(simple-array (unsigned-byte 8) 1)))
                      (assert (equal (coerce octets 'list) ,expected)))))))
           (with-output-characters ((id chars) &body body)
             `(let ((chars ,chars))
                (symbol-macrolet ((name ,id))
                  (macrolet ((test (outxf expected)
                               `(output-test chars ,outxf ,expected)))
                    ,@body)))))
  (with-input-bytes ((:input :invalid :crlf) (list #xc3 #xa9 #xff #x0d #x0a #xc3 #xa8))
    (test :utf-8 '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Return #\Linefeed #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :replacement #\?) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\? #\Return #\Linefeed #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :lf) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Return #\Linefeed #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :lf :replacement #\?) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\? #\Return #\Linefeed #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :cr) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Linefeed #\Linefeed #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :cr :replacement #\?) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\? #\Linefeed #\Linefeed #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :crlf) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Linefeed #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :crlf :replacement #\?) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\? #\Linefeed #\LATIN_SMALL_LETTER_E_WITH_GRAVE)))
  (with-input-bytes ((:input :multiple-invalid :crlf) (list #xc3 #xa9 #xff #x0d #x0a #xff #xff #xc3 #xa8))
    (test :utf-8 '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Return #\Linefeed #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :replacement #\?) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\? #\Return #\Linefeed #\? #\? #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :lf) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Return #\Linefeed #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :lf :replacement #\?) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\? #\Return #\Linefeed #\? #\? #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :cr) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Linefeed #\Linefeed #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :cr :replacement #\?) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\? #\Linefeed #\Linefeed #\? #\? #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :crlf) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Linefeed #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test (:utf-8 :newline :crlf :replacement #\?) '(#\LATIN_SMALL_LETTER_E_WITH_ACUTE #\? #\Linefeed #\? #\? #\LATIN_SMALL_LETTER_E_WITH_GRAVE)))
  #+sb-unicode
  (with-output-characters ((:output :invalid :lf) (list #\LATIN_SMALL_LETTER_E_WITH_ACUTE (code-char #xd800) #\Linefeed #\LATIN_SMALL_LETTER_E_WITH_GRAVE))
    (test :utf-8 '(#xc3 #xa9 #x0a #xc3 #xa8))
    (test (:utf-8 :replacement #\?) '(#xc3 #xa9 #x3f #x0a #xc3 #xa8))
    (test (:utf-8 :newline :lf) '(#xc3 #xa9 #x0a #xc3 #xa8))
    (test (:utf-8 :newline :lf :replacement #\?) '(#xc3 #xa9 #x3f #x0a #xc3 #xa8))
    (test (:utf-8 :newline :cr) '(#xc3 #xa9 #x0d #xc3 #xa8))
    (test (:utf-8 :newline :cr :replacement #\?) '(#xc3 #xa9 #x3f #x0d #xc3 #xa8))
    (test (:utf-8 :newline :crlf) '(#xc3 #xa9 #x0d #x0a #xc3 #xa8))
    (test (:utf-8 :newline :crlf :replacement #\?) '(#xc3 #xa9 #x3f #x0d #x0a #xc3 #xa8))))

(macrolet ((test (inxf expected &environment env)
             `(with-test (:name (,(macroexpand 'name env) ,inxf))
                (with-open-file (s *test-path* :external-format ',inxf)
                  (let* ((string (make-string 100000))
                         (count (read-sequence string s)))
                    (assert (equal (map 'list 'char-code (subseq string 0 count)) ,expected)))))
             `(with-test (:name (,(macroexpand 'name env) ,inxf :base-string))
                (with-open-file (s *test-path* :external-format ',inxf)
                  (let* ((string (make-string 100000 :element-type 'base-char))
                         (count (read-sequence string s)))
                    (assert (equal (map 'list 'char-code (subseq string 0 count)) ,expected))))))
           (with-test-file ((id bytes) &body body)
             `(progn
                (with-open-file (s *test-path* :element-type '(unsigned-byte 8)
                                   :direction :output :if-exists :supersede)
                  (dolist (byte ,bytes)
                    (write-byte byte s)))
                (symbol-macrolet ((name ,id))
                  ,@body)))
           (tests (size)
             `(progn
                (with-test-file ((:input :lf ,size) (contents ,size '(10)))
                  (test :utf-8 (contents ,size '(10)))
                  (test (:utf-8 :newline :lf) (contents ,size '(10)))
                  (test (:utf-8 :newline :cr) (contents ,size '(10)))
                  (test (:utf-8 :newline :crlf) (contents ,size '(10))))
                (with-test-file ((:input :cr ,size) (contents ,size '(13)))
                  (test :utf-8 (contents ,size '(13)))
                  (test (:utf-8 :newline :lf) (contents ,size '(13)))
                  (test (:utf-8 :newline :cr) (contents ,size '(10)))
                  (test (:utf-8 :newline :crlf) (contents ,size '(13))))
                (with-test-file ((:input :crlf ,size) (contents ,size '(13 10)))
                  (test :utf-8 (contents ,size '(13 10)))
                  (test (:utf-8 :newline :lf) (contents ,size '(13 10)))
                  (test (:utf-8 :newline :cr) (contents ,size '(10 10)))
                  (test (:utf-8 :newline :crlf) (contents ,(1- size) '(10)))))))
  (flet ((contents (size nl)
           (let ((bytes (make-array size :initial-element #x61)))
             (loop for x in nl
                   for j from (- (length bytes) (length nl))
                   do (setf (aref bytes j) x))
             (coerce bytes 'list))))
    (tests 2)

    (with-test (:name :ansi-stream-cin-buffer-length)
      (assert (= sb-impl::+ansi-stream-in-buffer-length+ 512)))

    (tests 511)
    (tests 512)
    (tests 513)

    ;; +ANSI-STREAM-IN-BUFFER-EXTRA+ is possibly also relevant.  Can't
    ;; test for it as the constant gets shaken out, but it's currently
    ;; 4.
    (tests 515)
    (tests 516)
    (tests 517)

    (tests #.(- sb-impl::+bytes-per-buffer+ 2))
    (tests #.(- sb-impl::+bytes-per-buffer+ 1))
    (tests #.sb-impl::+bytes-per-buffer+)
    (tests #.(+ sb-impl::+bytes-per-buffer+ 1))
    (tests #.(+ sb-impl::+bytes-per-buffer+ 3))))

(macrolet ((test (inxf expected &optional (unread-expected expected) &environment env)
             `(progn
                (with-test (:name (,(macroexpand 'name env) ,inxf))
                  (with-open-file (s *test-path* :external-format ',inxf)
                    (let ((actual
                           (cons (file-position s)
                                 (loop for char = (read-char s nil nil)
                                       while char
                                       collect (file-position s)))))
                      (assert (equal actual ,expected)))))
                (with-test (:name (,(macroexpand 'name env) unread-char ,inxf))
                  (with-open-file (s *test-path* :external-format ',inxf)
                    (assert (sb-impl::ansi-stream-cin-buffer s))
                    (let ((actual (loop for char = (read-char s nil nil)
                                        if (null char) collect (file-position s) and do (loop-finish)
                                        do (unread-char char s)
                                        collect (file-position s)
                                        do (read-char s))))
                      (assert (equal actual ,unread-expected)))))
                (with-test (:name (,(macroexpand 'name env) unread-char :io ,inxf))
                  (with-open-file (s *test-path* :external-format ',inxf
                                     :direction :io :if-exists :overwrite)
                    ;; if we reinstate in character buffers for :io character streams,
                    ;; make a stream that is unbuffered some other way
                    (assert (not (sb-impl::ansi-stream-cin-buffer s)))
                    (let ((actual (loop for char = (read-char s nil nil)
                                        if (null char) collect (file-position s) and do (loop-finish)
                                        do (unread-char char s)
                                        collect (file-position s)
                                        do (read-char s))))
                      (assert (equal actual ,unread-expected)))))))
           (with-test-file ((id bytes) &body body)
             `(progn
                (with-open-file (s *test-path* :element-type '(unsigned-byte 8)
                                   :direction :output :if-exists :supersede)
                  (dolist (byte ,bytes)
                    (write-byte byte s)))
                (symbol-macrolet ((name ,id))
                  ,@body))))
  (with-test-file ((file-position :lf) '(#xc3 #xa9 #x0a #xc3 #xa8 #x38 #x0a #x39 #x3a #x0a #x3b))
    (test :utf-8 '(0 2 3 5 6 7 8 9 10 11))
    (test (:utf-8 :newline :lf) '(0 2 3 5 6 7 8 9 10 11))
    (test (:utf-8 :newline :cr)  '(0 2 3 5 6 7 8 9 10 11))
    (test (:utf-8 :newline :crlf)  '(0 2 3 5 6 7 8 9 10 11)))
  (with-test-file ((file-position :cr) '(#xc3 #xa9 #x0d #xc3 #xa8 #x38 #x0d #x39 #x3a #x0d #x3b))
    (test :utf-8 '(0 2 3 5 6 7 8 9 10 11))
    (test (:utf-8 :newline :lf) '(0 2 3 5 6 7 8 9 10 11))
    (test (:utf-8 :newline :cr) '(0 2 3 5 6 7 8 9 10 11))
    (test (:utf-8 :newline :crlf) '(0 2 3 5 6 7 8 9 10 11)))
  (with-test-file ((file-position :crlf) '(#xc3 #xa9 #x0d #x0a #xc3 #xa8 #x38 #x0d #x0a #x39 #x3a #x0d #x0a #x3b))
    (test :utf-8 '(0 2 3 4 6 7 8 9 10 11 12 13 14))
    (test (:utf-8 :newline :lf) '(0 2 3 4 6 7 8 9 10 11 12 13 14))
    (test (:utf-8 :newline :cr) '(0 2 3 4 6 7 8 9 10 11 12 13 14))
    (test (:utf-8 :newline :crlf) '(0 2 4 6 7 9 10 11 13 14)))
  (with-test-file ((file-position :replacement character) '(#xc3 #xa9 #x0d #x0a #xff #xc3 #xa8 #xff #x0d #x0a))
    (test (:utf-8 :replacement #\?) '(0 2 3 4 5 7 8 9 10) '(0 2 3 5 5 8 8 9 10))
    (test (:utf-8 :newline :lf :replacement #\?) '(0 2 3 4 5 7 8 9 10) '(0 2 3 5 5 8 8 9 10))
    (test (:utf-8 :newline :cr :replacement #\?) '(0 2 3 4 5 7 8 9 10) '(0 2 3 5 5 8 8 9 10))
    (test (:utf-8 :newline :crlf :replacement #\?) '(0 2 4 5 7 8 10) '(0 2 5 5 8 8 10)))
  (with-test-file ((file-position :replacement string) '(#xc3 #xa9 #x0d #x0a #xff #xc3 #xa8 #xff #x0d #x0a))
    (test (:utf-8 :replacement "??") '(0 2 3 4 5 5 7 8 8 9 10) '(0 2 3 5 5 5 8 8 8 9 10))
    (test (:utf-8 :newline :lf :replacement "??") '(0 2 3 4 5 5 7 8 8 9 10) '(0 2 3 5 5 5 8 8 8 9 10))
    (test (:utf-8 :newline :cr :replacement "??") '(0 2 3 4 5 5 7 8 8 9 10) '(0 2 3 5 5 5 8 8 8 9 10))
    (test (:utf-8 :newline :crlf :replacement "??") '(0 2 4 5 5 7 8 8 10) '(0 2 5 5 5 8 8 8 10))))

(macrolet ((output-test (chars outxf expected &environment env)
             `(progn
                (with-test (:name (,(macroexpand 'name env) file-string-length ,outxf))
                  (let ((string (coerce ,chars 'string)))
                    (with-open-file (s *test-path* :element-type 'character
                                       :external-format ',outxf
                                       :direction :output :if-exists :supersede)
                      (handler-bind ((sb-int:character-encoding-error
                                      (lambda (c) (use-value "" c))))
                        (let ((pos (file-position s))
                              (len (file-string-length s string)))
                          (let ((actual
                                 (loop for index from 0 below (length string)
                                       for char = (char string index)
                                       for thislen = (file-string-length s char)
                                       for thisstringlen = (file-string-length s (subseq string index))
                                       if (null thisstringlen) do (assert (some 'null (subseq ,expected index))) else do (assert (notany 'null (subseq ,expected index)))
                                       collect thislen
                                       if (and (null len) thisstringlen) do (setf len (+ pos thisstringlen))
                                       if thisstringlen do (assert (= (+ pos thisstringlen) len))
                                       do (write-char char s)
                                       if thislen do (assert (= (+ pos thislen) (file-position s)))
                                       do (setf pos (file-position s)))))
                            (assert (equal actual ,expected))))))))))
           (with-output-characters ((id chars) &body body)
             `(let ((chars ,chars))
                (symbol-macrolet ((name ,id))
                  (macrolet ((test (outxf expected)
                               `(output-test chars ,outxf ,expected)))
                    ,@body)))))
  (with-output-characters ((:output :lf) (list #\5 #\LATIN_SMALL_LETTER_E_WITH_ACUTE #\Linefeed #\7))
    (test :utf-8 '(1 2 1 1))
    (test (:utf-8 :newline :lf) '(1 2 1 1))
    (test (:utf-8 :newline :cr) '(1 2 1 1))
    (test (:utf-8 :newline :crlf) '(1 2 2 1)))
  #+sb-unicode
  (with-output-characters ((:output :invalid :lf) (list #\5 #\LATIN_SMALL_LETTER_E_WITH_ACUTE (code-char #xdb00) #\Linefeed #\7))
    ;; A sufficiently-smart streams implementation could statically determine the lengths
    ;; of replacement characters given as part of the external format
    (test :utf-8 '(1 2 nil 1 1))
    (test (:utf-8 :replacement #\?) '(1 2 nil 1 1))
    (test (:utf-8 :newline :lf) '(1 2 nil 1 1))
    (test (:utf-8 :newline :lf :replacement #\?) '(1 2 nil 1 1))
    (test (:utf-8 :newline :cr) '(1 2 nil 1 1))
    (test (:utf-8 :newline :cr :replacement #\?) '(1 2 nil 1 1))
    (test (:utf-8 :newline :crlf) '(1 2 nil 2 1))
    (test (:utf-8 :newline :crlf :replacement #\?) '(1 2 nil 2 1))))

(with-test (:name (:lp-2054169 :lf))
  (let ((string (make-string 2048 :initial-element #\x)))
    (loop for x from 78 by 78 below 2048
          do (setf (aref string x) #\Newline))
    (setf (aref string 24) #\LATIN_SMALL_LETTER_E_WITH_ACUTE) ; 2-bytes in UTF-8
    (with-open-file (s *test-path* :direction :output :external-format :utf-8 :if-exists :supersede)
      (write-sequence string s))
    (with-open-file (s *test-path* :external-format :utf-8)
      (let ((positions
             (loop for n from 0
                   for pos = (file-position s)
                   for char = (read-char s nil nil)
                   collect pos
                   if (null char) do (loop-finish))))
        (assert (equal positions
                       (loop with pos = 0
                             for i from 0 to 2048
                             collect pos
                             if (and (> i 0) (= (mod i 78) 0)) do (incf pos 1)
                             else if (= i 24) do (incf pos 2)
                             else do (incf pos 1))))))))

(with-test (:name (:lp-2054169 :crlf))
  (let ((string (make-string 2048 :initial-element #\x)))
    (loop for x from 78 by 78 below 2048
          do (setf (aref string x) #\Newline))
    (setf (aref string 24) #\LATIN_SMALL_LETTER_E_WITH_ACUTE) ; 2-bytes in UTF-8
    (with-open-file (s *test-path* :direction :output
                       :external-format '(:utf-8 :newline :crlf) :if-exists :supersede)
      (write-sequence string s))
    (with-open-file (s *test-path* :external-format '(:utf-8 :newline :crlf))
      (let ((positions
             (loop for n from 0
                   for pos = (file-position s)
                   for char = (read-char s nil nil)
                   collect pos
                   if (null char) do (loop-finish))))
        (assert (equal positions
                       (loop with pos = 0
                             for i from 0 to 2048
                             collect pos
                             if (and (> i 0) (= (mod i 78) 0)) do (incf pos 2)
                             else if (= i 24) do (incf pos 2)
                             else do (incf pos 1))))))))
(delete-file *test-path*)

#+sb-unicode
(defun random-string (stringlen percent-ascii &aux (unicode (- 100 percent-ascii)))
  (let ((s (make-string stringlen)))
    (dotimes (i stringlen s)
      (setf (char s i)
            (code-char (if (< (random 100.0) unicode)
                           (loop (let ((c (max 1 (random char-code-limit))))
                                   (when (sb-unicode:scalar-p c) (return c))))
                           (max 1 (random 128))))))))

(with-test (:name :optimized-utf8-decoder
                  :skipped-on (:not :sb-unicode))
  ;; some tests need 100% ascii so that it hits the special case for base-string
  (dolist (percent-ascii '(100 50 10))
    (dotimes (i 1000)
      (let* ((string (random-string (random 1000) percent-ascii))
             (octets (string-to-octets string :null-terminate t))
             (readback1
              (sb-ext:octets-to-string octets :end (1- (length octets))))
             (readback2
              (sb-sys:with-pinned-objects (octets)
                (sb-unicode:utf8-decode-from-sap (sb-sys:vector-sap octets))))
             (readback3
              ;; doesn't take END or a displaced string. It could, but if you need
              ;; such capability, the SAP interface will do.
              (sb-unicode:utf8-decode-from-octets
               (subseq octets 0 (1- (length octets))))))
        (when (= percent-ascii 100)
          (assert (not (sb-kernel:simple-base-string-p readback1)))
          (assert (sb-kernel:simple-base-string-p readback2))
          (assert (sb-kernel:simple-base-string-p readback3)))
        (assert (string= string readback1))
        (assert (string= string readback2))
        (assert (string= string readback3))))))


(with-test (:name :utf8-strlen
            :skipped-on :interpreter)
  (flet ((test (bytes expected-length &optional expected-ascii-p (offset 0))
           (let ((bytes (coerce bytes '(vector (unsigned-byte 8)))))
             (sb-sys:with-pinned-objects (bytes)
               (multiple-value-bind (length ascii-p)
                   (sb-vm::simd-utf8-strlen (sb-sys:sap+ (sb-sys:vector-sap bytes) offset))
                 (unless (and (eql expected-length length)
                              (eql expected-ascii-p ascii-p))
                   (error "(sb-vm::simd-utf8-strlen (sb-sys:sap+ (sb-sys:vector-sap ~s) ~s)) => ~a, ~a; but ~a, ~a expected"
                          bytes offset length ascii-p
                          expected-length expected-ascii-p)))))))
    (test '(1 2 0 255 255) 2 t)
    (test (append (loop for i from 1 to 64 collect i) '(0 1 255)) 64 t)
    (test '(1 2 0 1 1 1) 2 t)
    (test '(0 0 1 2 0) 2 t 2)
    (test '(1 1 1 2 0) 2 t 2)
    (test '(255 255 1 127 0) 2 t 2)
    (test '(255 255 1 2 0) nil)
    (test '(255 255 1 2 0) nil)
    (test '(240 159 152 130 0) 1)
    (test '(1 240 159 152 130 0) 2)
    (test '(1 240 159 152 130 2 0) 3)
    (test '(65 195 132 226 130 172 240 159 152 130 0) 4)
    (test '(#xf4 #x8f #xbf #xbf 0) 1)
    (test '(#xe0 #xa0 #x80 0) 1)
    (test (append (loop for i from 1 to 61 collect i) '(240 159 152 130 0 255)) 62)
    (test (append (loop for i from 1 to 62 collect i) '(240 159 152 130 0 240)) 63)
    (test (append (loop for i from 1 to 63 collect i) '(240 159 152 130 0 250)) 64)
    (test (append (loop for i from 1 to 63 collect i) '(195 169 0 128)) 64)

    (test '(#xc0 #xaf 0) nil)
    (test '(#xe0 #x80 #x80 0) nil)
    (test '(#xf0 #x80 #x80 #x80 0) nil)
    (test '(#xed #xa0 #x80 0) nil)
    (test '(#xf4 #x90 #x80 #x80 0) nil)
    (test '(#x41 #xff #x42 0) nil)
    (test '(#x80 #x80 #x80 0) nil)
    (test '(#xe2 #x82 #x41 0) nil)
    (test '(#xf0 #x9f #x92 0) nil)))

#+sb-unicode
(with-test (:name :character-string-utf8-length)
  (flet ((test (chars expected-length &optional expected-ascii-p)
           (let ((string (map 'string #'code-char chars)))
             (multiple-value-bind (length ascii-p)
                 (sb-impl::simd-character-string-utf8-length string)
               (unless (and (eql expected-length length)
                            (eql expected-ascii-p ascii-p))
                 (error "(sb-impl::simd-character-string-utf8-length ~a) => ~a, ~a; but ~a, ~a expected"
                        string length ascii-p
                        expected-length expected-ascii-p))))))
    (test '(97 98 99 0) 4 t)
    (test '(97 224 225 226 227 228 229 65) 14)
    (test '(54620 0 24291 0 26085) 11)
    (test '(97 128077 98 9989 65039 65039 65039 65039 65039 65039 65039) 30)
    (test '(0 #xd800 1) nil)))

#+sb-unicode
(with-test (:name :output-to-c-string/utf-8/lf)
  (flet ((test (chars expected &optional error-p)
           (let ((string (map 'string #'code-char chars)))
             (multiple-value-bind (result error)
                 (ignore-errors (sb-impl::output-to-c-string/utf-8/lf string))
               (if error-p
                   (unless error
                     (error "(sb-impl::output-to-c-string/utf-8/lf ~a) => ~a; but an error is expected"
                            string result))
                   (unless (and (typep result '(simple-array (unsigned-byte 8) (*)))
                                (equalp result expected))
                     (error "(sb-impl::output-to-c-string/utf-8/lf ~a) => ~a; but ~a is expected"
                            chars result expected)))))))
    (test '(97 98 99)
          #(97 98 99 0))
    (test '(97 224 225 226 227 228 229 65)
          #(97 195 160 195 161 195 162 195 163 195 164 195 165 65 0))
    (test '(54620 0 24291 0 26085)
          #(237 149 156 0 229 187 163 0 230 151 165 0))
    (test '(97 128077 98 9989 65039 65039 65039 65039 65039 65039 65039)
          #(97 240 159 145 141 98 226 156 133 239 184 143 239 184 143 239 184 143 239 184 143 239 184 143 239 184 143 239 184 143 0))
    (test '(0 #xd800 1) nil t)))
