test/misc.lisp

   1 ;;;
   2 ;;; When I'll grow up, I'll be a complete test suite.
   3
   4 (deftest utf-8
   5     (flet ((doit (from below)
   6              (loop for code from from below below do
   7                   (when (and (code-char code)
   8                              (not (eql code #xfffe))
   9                              (not (eql code #xffff)))
  10                     (let* ((a (if (< code #x10000)
  11                                   (format nil "abc~C" (code-char code))
  12                                   (let* ((x (- code #x10000))
  13                                          (lo (ldb (byte 10 0) x))
  14                                          (hi (ldb (byte 10 10) x)))
  15                                     (format nil "abc~C~C"
  16                                             (code-char (logior #xD800 hi))
  17                                             (code-char
  18                                              (logior #xDC00 lo))))))
  19                            (b (cxml:utf8-string-to-rod
  20                                (cxml:rod-to-utf8-string
  21                                 a))))
  22                       (unless (string= a b)
  23                         (format t "FAIL: ~S ~A ~A~%"
  24                                 (code-char code)
  25                                 (map 'vector #'char-code a)
  26                                 (map 'vector #'char-code b))))))))
  27       (doit 32 #xD800)
  28       (doit #x10000 char-code-limit)
  29       (values)))
  30
  31 ;; <4824D34F.5000002@acceleration.net>
  32 (deftest chtml-encoding
  33   (with-output-to-string (stream)
  34    (let ((doc (dom:create-document
  35              'rune-dom:implementation
  36              nil nil
  37              (dom:create-document-type
  38               'rune-dom:implementation
  39               "html"
  40               "-//W3C//DTD XHTML 1.0 Transitional//EN"
  41               "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"))))
  42      (dom:map-document (chtml:make-character-stream-sink stream)
  43            doc
  44            :include-xmlns-attributes nil
  45            :include-doctype :full-internal-subset))))