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)