diff --git a/test/script-support.lisp b/test/script-support.lisp index e0cf6b5..5f6e750 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -46,6 +46,7 @@ Some constraints: (defvar *debug-asdf* nil) (defvar *quit-when-done* t) +(defvar *test-name* nil) (defun verbose (&optional (verbose t) (print verbose)) (setf *load-verbose* verbose *compile-verbose* verbose) @@ -208,8 +209,9 @@ Some constraints: (defun assert-compare-helper (op qx qy x y) (unless (funcall op x y) - (error "These two expressions fail comparison with ~S:~% ~ + (error "~@[On sub-test ~a.~%~]These two expressions fail comparison with ~S:~% ~ ~S evaluates to ~S~% ~S evaluates to ~S~%" + *test-name* op qx x qy y))) (defmacro assert-equal (x y) diff --git a/test/test-encodings.script b/test/test-encodings.script index 3977c69..398b273 100644 --- a/test/test-encodings.script +++ b/test/test-encodings.script @@ -19,7 +19,7 @@ #+sbcl sb-impl::*default-external-format* #-(or clozure sbcl) (error "can't determine default external-format"))))) -(defmacro with-encoding-test ((encoding &key (op 'load-source-op) (path "lambda")) def-test-system &body body) +(defmacro with-encoding-test ((name encoding &key (op 'load-source-op) (path "lambda")) def-test-system &body body) (let ((sys (second def-test-system))) `(with-asdf-cache (:override t) (format t "~&Test ~A: should be ~A~%" ',sys ',encoding) @@ -33,10 +33,11 @@ ,@(when op `((operate ',op ',(second def-test-system)))) ,@body + (let ((*test-name* ,(format nil "Encoding test ~a" name))) (eval `(assert-equal (string-char-codes ,*lambda-string*) - (expected-char-codes ',',encoding)))))) + (expected-char-codes ',',encoding))))))) -(with-encoding-test (:utf-8) +(with-encoding-test (explicit-u8 :utf-8) (def-test-system :test-encoding-explicit-u8 :components ((:file "lambda" :encoding :utf-8)))) @@ -74,46 +75,46 @@ (load-system :asdf-encodings) #-lispworks -(with-encoding-test (:latin-2) +(with-encoding-test (implicit-autodetect :latin-2) (def-test-system :test-encoding-implicit-autodetect :components ((:file "lambda")))) #+sbcl -(with-encoding-test (:koi8-r) +(with-encoding-test (explicit-koi8-r :koi8-r) (def-test-system :test-encoding-explicit-koi8-r :components ((:file "lambda" :encoding :koi8-r)))) -(with-encoding-test (:utf-8) +(with-encoding-test (file-encoding-u8 :utf-8) (def-test-system :test-file-encoding-u8 :encoding :latin-1 :components ((:file "lambda" :encoding :utf-8)))) -(with-encoding-test (:latin-1) +(with-encoding-test (file-encoding-latin-1 :latin-1) (def-test-system :test-file-encoding-l1 :encoding :utf-8 :components ((:file "lambda" :encoding :latin-1)))) -(with-encoding-test (:utf-8 :op load-source-op) +(with-encoding-test (encoding-u8 :utf-8 :op load-source-op) (def-test-system :test-system-encoding-u8 :encoding :utf-8 :components ((:file "lambda")))) -(with-encoding-test (:utf-8 :op load-op) +(with-encoding-test (encoding-u8-load-op :utf-8 :op load-op) (def-test-system :test-system-encoding-u8-load-op :encoding :utf-8 :components ((:file "lambda")))) -(with-encoding-test (:latin-1) +(with-encoding-test (system-latin-1 :latin-1) (def-test-system :test-system-encoding-l1 :encoding :latin-1 :components ((:file "lambda")))) #-ecl-bytecmp -(with-encoding-test (:latin-1 :op load-op) +(with-encoding-test (system-latin-1-load-op :latin-1 :op load-op) (def-test-system :test-system-encoding-l1-load-op :encoding :latin-1 :components ((:file "lambda")))) -(with-encoding-test (:utf-8 :path ("foo" "lambda")) +(with-encoding-test (module-encoding-u8 :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")) +(with-encoding-test (module-encoding-latin-1 :latin-1 :path ("foo" "lambda")) (def-test-system :test-module-encoding-l1 :encoding :utf-8 :components