test-encodings.script 5 KB
Newer Older
1
;;; -*- Lisp -*-
2
(in-package :asdf-test)
Robert Goldman's avatar
Robert Goldman committed
3
4
5
6

(when (member :clisp *features*)
  (quit 0))

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
(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")))))

26
(defmacro with-encoding-test ((encoding &key (op 'load-source-op) (path "lambda")) def-test-system &body body)
27
  (let ((sys (second def-test-system)))
28
    `(with-asdf-session (:override t)
29
       (format t "~&Test ~A: should be ~A~%" ',sys ',encoding)
30
       (setf *lambda-string* nil)
31
       ,def-test-system
32
       (let ((c (find-component ',sys ',path)))
33
         ;; mlisp has an issue of :LATIN-2 vs :latin-2. Smooth things with string-equal.
34
35
36
         (assert-compare (string-equal (component-encoding c) ',encoding))
         (loop :for o :in (output-files 'compile-op c)
               :do (delete-file-if-exists o)))
37
       ,@(when op
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
38
           `((operate ',op ',(second def-test-system) :force t)))
39
       ,@body
40
41
       (eval `(assert-equal (string-char-codes ,*lambda-string*)
                            (expected-char-codes ',',encoding))))))
42

43
44
#-asdf-unicode
(leave-test "No Unicode support to test on this lisp implementation" 0)
45

46
#+abcl
47
48
(let* ((version (lisp-implementation-version))
       (version-nums (subseq version 0 (position-if-not (lambda (x) (find x "0123456789.")) version))))
49
50
  (when (version< version-nums "1.1.2")
    (leave-test "Your old ABCL is known to fail this test script, so skipping it." 0)))
51
52
53
54

(with-encoding-test (:utf-8)
  (def-test-system :test-encoding-explicit-u8
    :components ((:file "lambda" :encoding :utf-8))))
55

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

58
59
60
61
62
63
#+sbcl
(progn
  #+sbcl (setf sb-impl::*default-external-format* :latin-3)
  (with-encoding-test (:default)
    (def-test-system :test-encoding-explicit-default
      :components ((:file "lambda" :encoding :default))))
64
  (with-encoding-test (:utf-8)
65
    (def-test-system :test-encoding-implicit-default
Robert Goldman's avatar
Robert Goldman committed
66
67
68
69
70
        :components ((:file "lambda")))))

#+ecl
(unless (>= ext:+ecl-version-number+ 160000)
  (leave-test "This version of ECL is known to have broken encoding support" 0))
71
72
73
74

;; Try to load asdf-encodings
(setf *central-registry*
      (list *asdf-directory* ;; be sure that *OUR* asdf is first of any possible ASDF
75
            *uiop-directory* ;; be sure that ouir uiop is there, too.
76
            ;; try finding asdf-encodings it right next to asdf.
77
            (subpathname *asdf-directory* "ext/asdf-encodings/")))
78
79
80
81
82
83
84
85
86
(unless (find-system :asdf-encodings nil)
  ;; 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))


87
(load-system :asdf-encodings)
88

89
(with-expected-failure (#+lispworks "LispWorks doesn't have LATIN-2") ;; Check that it indeed still is broken before we punt.
90
91
92
93
  (with-encoding-test (:latin-2)
    (def-test-system :test-encoding-implicit-autodetect
      :components ((:file "lambda")))))

94
#+(or sbcl clasp)
95
96
97
98
(with-encoding-test (:koi8-r)
  (def-test-system :test-encoding-explicit-koi8-r
    :components ((:file "lambda" :encoding :koi8-r))))

99

100
101
102
103
104
105
106
107
(with-encoding-test (:utf-8)
  (def-test-system :test-file-encoding-u8
    :encoding :latin-1
    :components ((:file "lambda" :encoding :utf-8))))
(with-encoding-test (:latin-1)
  (def-test-system :test-file-encoding-l1
    :encoding :utf-8
    :components ((:file "lambda" :encoding :latin-1))))
108
(with-encoding-test (:utf-8 :op load-source-op)
109
110
111
  (def-test-system :test-system-encoding-u8
    :encoding :utf-8
    :components ((:file "lambda"))))
112
(with-encoding-test (:utf-8 :op load-op)
113
114
115
116
117
118
119
120
  (def-test-system :test-system-encoding-u8-load-op
    :encoding :utf-8
    :components ((:file "lambda"))))
(with-encoding-test (:latin-1)
  (def-test-system :test-system-encoding-l1
    :encoding :latin-1
    :components ((:file "lambda"))))
#-ecl-bytecmp
121
(with-encoding-test (:latin-1 :op load-op)
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
  (def-test-system :test-system-encoding-l1-load-op
    :encoding :latin-1
    :components ((:file "lambda"))))
(with-encoding-test (:utf-8 :path ("foo" "lambda"))
  (def-test-system :test-module-encoding-u8
    :encoding :latin-1
    :components
    ((:module "foo" :pathname "" :encoding :utf-8
      :components ((:file "lambda"))))))
(with-encoding-test (:latin-1 :path ("foo" "lambda"))
  (def-test-system :test-module-encoding-l1
    :encoding :utf-8
    :components
    ((:module "foo" :pathname "" :encoding :latin-1
      :components ((:file "lambda"))))))