test-encodings.script 3.64 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 28 29 30 31 32 33 34 35 36 37 38 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 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106
;;; -*- 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")))))

(defun reset-lambda ()
  (setf *lambda-string* nil)
  (asdf::delete-file-if-exists (asdf::compile-file-pathname* "lambda.lisp")))

(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)
       (reset-lambda)
       ,defsystem
       (assert-equal (asdf:component-encoding (asdf:find-component ',sys ',path)) ',encoding)
       ,@(when op `((asdf:operate ',op ',(second defsystem))))
       ,@body
       (eval `(assert-equal (string-char-codes ,*lambda-string*) (expected-char-codes ',',encoding))))))

(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"))))
  (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)