test-encodings.script 4.5 KB
Newer Older
1
;;; -*- Lisp -*-
2

3

4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

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

24 25
(defmacro with-encoding-test ((encoding &key (op 'asdf:load-source-op) (path "lambda")) def-test-system &body body)
  (let ((sys (second def-test-system)))
26 27
    `(progn
       (format t "~&Test ~A: should be ~A~%" ',sys ',encoding)
28
       (setf *lambda-string* nil)
29
       ,def-test-system
30 31 32 33 34
       (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
35
           `((asdf:operate ',op ',(second def-test-system))))
36
       ,@body
37 38
       (eval `(assert-equal (string-char-codes ,*lambda-string*)
                            (expected-char-codes ',',encoding))))))
39

40
(progn
41

42
  (with-encoding-test (:utf-8)
43
    (def-test-system :test-encoding-explicit-u8
44 45
      :components ((:file "lambda" :encoding :utf-8))))

46 47 48
  #-asdf-unicode
  (leave-test "No Unicode support to test on this lisp implementation" 0)

49 50 51
  #+abcl
  (leave-test "abcl is known to fail these tests. Go update asdf-encodings" 0)

52 53
  ;; NB: recent clozure can autodetect without asdf-encodings with :default (!)

Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
54
  #+sbcl
55 56
  (progn
    #+sbcl (setf sb-impl::*default-external-format* :latin-3)
57
    (with-encoding-test (:default)
58
      (def-test-system :test-encoding-explicit-default
59
        :components ((:file "lambda" :encoding :default))))
60
    (with-encoding-test (:default)
61
      (def-test-system :test-encoding-implicit-default
62 63
        :components ((:file "lambda")))))

64 65 66 67 68
  ;; Try to load asdf-encodings
  (setf *central-registry*
        (list *asdf-directory* ;; be sure that *OUR* asdf is first of any possible ASDF
              ;; try finding asdf-encodings it right next to asdf.
              (subpathname *asdf-directory* "../asdf-encodings/")))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
69
  (unless (find-system :asdf-encodings nil)
70 71 72 73 74 75 76
    ;; try harder by enabling the user's source-registry
    (initialize-source-registry ""))
  (unless (find-system :asdf-encodings nil)
    (leave-test "Couldn't find ASDF-ENCODINGS. Skipping the rest the test." 0))
  ;; Disable any user source registry.
  (initialize-source-registry `(:source-registry :ignore-inherited-configuration))

Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
77 78 79 80

  (asdf:load-system :asdf-encodings)
  #-lispworks
  (with-encoding-test (:latin-2)
81
    (def-test-system :test-encoding-implicit-autodetect
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
82 83 84
      :components ((:file "lambda"))))
  #+sbcl
  (with-encoding-test (:koi8-r)
85
    (def-test-system :test-encoding-explicit-koi8-r
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
86
      :components ((:file "lambda" :encoding :koi8-r))))
87

88
  (with-encoding-test (:utf-8)
89
    (def-test-system :test-file-encoding-u8
90 91
      :encoding :latin-1
      :components ((:file "lambda" :encoding :utf-8))))
92
  (with-encoding-test (:latin-1)
93
    (def-test-system :test-file-encoding-l1
94 95
      :encoding :utf-8
      :components ((:file "lambda" :encoding :latin-1))))
96
  (with-encoding-test (:utf-8 :op asdf:load-source-op)
97
    (def-test-system :test-system-encoding-u8
98 99
      :encoding :utf-8
      :components ((:file "lambda"))))
100
  (with-encoding-test (:utf-8 :op asdf:load-op)
101
    (def-test-system :test-system-encoding-u8-load-op
102 103
      :encoding :utf-8
      :components ((:file "lambda"))))
104
  (with-encoding-test (:latin-1)
105
    (def-test-system :test-system-encoding-l1
106 107
      :encoding :latin-1
      :components ((:file "lambda"))))
108
  #-ecl-bytecmp
109
  (with-encoding-test (:latin-1 :op asdf:load-op)
110
    (def-test-system :test-system-encoding-l1-load-op
111 112
      :encoding :latin-1
      :components ((:file "lambda"))))
113
  (with-encoding-test (:utf-8 :path ("foo" "lambda"))
114
    (def-test-system :test-module-encoding-u8
115 116 117 118
      :encoding :latin-1
      :components
      ((:module "foo" :pathname "" :encoding :utf-8
        :components ((:file "lambda"))))))
119
  (with-encoding-test (:latin-1 :path ("foo" "lambda"))
120
    (def-test-system :test-module-encoding-l1
121 122 123 124 125
      :encoding :utf-8
      :components
      ((:module "foo" :pathname "" :encoding :latin-1
        :components ((:file "lambda"))))))
  t)