test-encodings.script 3.73 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
;;; -*- Lisp -*-
(load "script-support.lisp")
(load-asdf)

(defparameter *lambda-string* nil)

(defun string-char-codes (s)
  (loop :for c :across s :collect (char-code c)))

(defun expected-char-codes (x)
  #-asdf-unicode '(#xCE #xBB)
  #+asdf-unicode
  (ecase x
    (:utf-8 '(955))
    ((:latin1 :latin-1) '(206 187))
    ((:latin2 :latin-2) '(206 357))
    ((:latin3 :latin-3) '(206 287))
    (:koi8-r '(1085 9577))
    (:default (expected-char-codes
               #+clozure ccl:*default-external-format*
               #+sbcl sb-impl::*default-external-format*
               #-(or clozure sbcl) (error "can't determine default external-format")))))

(defmacro with-test ((encoding &key (op 'asdf:load-source-op) (path "lambda")) defsystem &body body)
  (let ((sys (second defsystem)))
    `(progn
       (format t "~&Test ~A: should be ~A~%" ',sys ',encoding)
28
       (setf *lambda-string* nil)
29
       ,defsystem
30 31 32 33 34 35
       (let ((c (asdf:find-component ',sys ',path)))
         (assert-equal (asdf:component-encoding c) ',encoding)
         (loop :for o :in (asdf:output-files (asdf::make-operation 'asdf:compile-op) c)
               :do (asdf::delete-file-if-exists o)))
       ,@(when op
           `((asdf:operate ',op ',(second defsystem))))
36
       ,@body
37 38
       (eval `(assert-equal (string-char-codes ,*lambda-string*)
                            (expected-char-codes ',',encoding))))))
39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90

(quit-on-error

  (with-test (:utf-8)
    (defsystem :test-encoding-explicit-u8
      :components ((:file "lambda" :encoding :utf-8))))

  #+(and asdf-unicode (or clozure sbcl))
  (progn
    #+clozure (setf ccl:*default-external-format* :latin3)
    #+sbcl (setf sb-impl::*default-external-format* :latin-3)
    (with-test (:default)
      (defsystem :test-encoding-explicit-default
        :components ((:file "lambda" :encoding :default))))
    (with-test (:default)
      (defsystem :test-encoding-implicit-default
        :components ((:file "lambda")))))

  #+asdf-unicode
  (progn
    ;; BEWARE: For testing purposes, we assume ASDF-ENCODINGS is under the same root as ASDF.
    (pushnew (asdf::subpathname *asdf-directory* "../asdf-encodings/") asdf:*central-registry*)
    (asdf:load-system :asdf-encodings)
    #-lispworks
    (with-test (:latin-2)
      (defsystem :test-encoding-implicit-autodetect
        :components ((:file "lambda"))))
    #+sbcl
    (with-test (:koi8-r)
      (defsystem :test-encoding-explicit-koi8-r
        :components ((:file "lambda" :encoding :koi8-r)))))

  (with-test (:utf-8)
    (defsystem :test-file-encoding-u8
      :encoding :latin-1
      :components ((:file "lambda" :encoding :utf-8))))
  (with-test (:latin-1)
    (defsystem :test-file-encoding-l1
      :encoding :utf-8
      :components ((:file "lambda" :encoding :latin-1))))
  (with-test (:utf-8 :op asdf:load-source-op)
    (defsystem :test-system-encoding-u8
      :encoding :utf-8
      :components ((:file "lambda"))))
  (with-test (:utf-8 :op asdf:load-op)
    (defsystem :test-system-encoding-u8-load-op
      :encoding :utf-8
      :components ((:file "lambda"))))
  (with-test (:latin-1)
    (defsystem :test-system-encoding-l1
      :encoding :latin-1
      :components ((:file "lambda"))))
91
  #-ecl-bytecmp
92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
  (with-test (:latin-1 :op asdf:load-op)
    (defsystem :test-system-encoding-l1-load-op
      :encoding :latin-1
      :components ((:file "lambda"))))
  (with-test (:utf-8 :path ("foo" "lambda"))
    (defsystem :test-module-encoding-u8
      :encoding :latin-1
      :components
      ((:module "foo" :pathname "" :encoding :utf-8
        :components ((:file "lambda"))))))
  (with-test (:latin-1 :path ("foo" "lambda"))
    (defsystem :test-module-encoding-l1
      :encoding :utf-8
      :components
      ((:module "foo" :pathname "" :encoding :latin-1
        :components ((:file "lambda"))))))
  t)