├── .gitignore ├── LICENSE ├── README.md ├── self-test.lisp ├── should-test.asd ├── should-test.lisp └── xunit.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.fasl 3 | \#* 4 | .\#* 5 | *.log 6 | .* 7 | !.gitignore 8 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2009-2012 Vsevolod Dyomkin 2 | 3 | Permission is hereby granted, free of charge, to any person 4 | obtaining a copy of this software and associated documentation 5 | files (the "Software"), to deal in the Software without 6 | restriction, including without limitation the rights to use, 7 | copy, modify, merge, publish, distribute, sublicense, and/or sell 8 | copies of the Software, and to permit persons to whom the 9 | Software is furnished to do so, subject to the following 10 | conditions: 11 | 12 | Except as contained in this notice, the name(s) of the above 13 | copyright holders shall not be used in advertising or otherwise 14 | to promote the sale, use or other dealings in this Software 15 | without prior written authorization. 16 | 17 | The above copyright notice and this permission notice shall be 18 | included in all copies or substantial portions of the Software. 19 | 20 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 21 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES 22 | OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 23 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 24 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 25 | WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 26 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 27 | OTHER DEALINGS IN THE SOFTWARE. 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # SHOULD-TEST - a Common Lisp Testing Library 2 | 3 | (you should test even Common Lisp code sometimes) 4 | 5 | `SHOULD-TEST` is a minimal yet feature-rich Common Lisp test framework. 6 | 7 | `SHOULD-TEST` is methodology-agnostic and non-opinionated, 8 | i.e. it doesn't care what kind of test approach you'd like to take 9 | (like unit testing, random testing a la quickcheck or something else). 10 | 11 | 12 | It's just built from first principles to facilitate the following activities: 13 | 14 | - defining and running arbitrary tests 15 | - analyzing the test output 16 | - piping the test output to upstream systems, like CI 17 | (by supporting common protocols, such as xUnit - available,- and TAP - coming soon) 18 | 19 | The library is at the rather early stages of its development, 20 | but it's actively used in the support of [RUTILS][rutils], [CL-REDIS][cl-redis], 21 | and some of my in-house projects. 22 | 23 | ## Usage 24 | 25 | ### Defining tests 26 | 27 | Test are defined with `deftest`: 28 | 29 | (deftest some-fn () 30 | (should be = 1 (some-fn 2)) 31 | (should be = 2 (some-fn 1))) 32 | 33 | Being run, `deftest` returns either `T` or `NIL` as primary value. 34 | Secondary and third values in case of `NIL` are lists of: 35 | 36 | - all failed assertions returned by individual assertions 37 | - and all uncaught errors signalled inside assertions 38 | 39 | `should` is a macro that takes care of checking assertions. 40 | If the assertion doesn't hold, `should` signals a condition of types 41 | `should-failed` or `should-erred` which are aggregated by `deftest`. 42 | 43 | Also, `should` returns either `T` or 44 | `NIL` and a list of a failed expression with expected and actual outputs as values. 45 | 46 | Under the hood it calls the generic function `should-check` 47 | and passes it a keyword produced from the first symbol (in this case, `:be`), 48 | a test predicate (here, `'=`), and a tested expression as thunk 49 | (here it will be e.g. `(lambda () (some-fn 1))`), and expected results if any. 50 | If multiple expected results are given, like in 51 | `(should be eql nil #{:failed 1} (some-other-fn :dummy))`, 52 | it means that multiple `values` are expected. 53 | As you see, the keyword and test predicate are passed unevaluated, 54 | so you can't use expressions here. 55 | 56 | The pre-defined types of assertions are `be`, `signal` and `print-to`. 57 | They check correspondingly: 58 | 59 | - `be` - that some predicate holds 60 | - `signal` - some condition is signalled 61 | - `print-to` - some text is printed to the following stream 62 | 63 | Obviously, it's possible to define more assertion types 64 | as methods of `should-check` generic function. 65 | 66 | `deftest` and `should` write summary of test results to `*test-output*` 67 | (by default bound to `*standard-output*`). 68 | The var `*verbose*` (default `T`) controls if the summary contains 69 | full failure reports or just test names. 70 | 71 | Tests are defined as lambda-functions attached to a symbol's `test` property, 72 | so `(deftest some-fn ...` will do the following: 73 | 74 | (setf (get some-fn 'test) 75 | (lambda () ...)) 76 | 77 | 78 | ### Running tests 79 | 80 | To run the tests, use `test`. Without arguments, it runs all the tests 81 | in the current package. Given a `:package` argument it will do the same 82 | for that package, and given a `:test` argument it will run that individual test. 83 | 84 | In case of individual test's failure it will return `NIL` 85 | and a list of failed assertions and a list of assertions, 86 | that triggered uncaught errors. 87 | 88 | In case of failed test of a package it will return `NIL` 89 | and 2 hash-tables holding the same lists as above keyed by failed test's names. 90 | 91 | As you see, the system uses a somewhat recursive protocol for test results: 92 | 93 | - at the lowest level `should` returns `T` or `NIL` 94 | and signals information about the failed assertion 95 | - this information is aggregated by `deftest` which will return 96 | aggregate information about all the failed assertions in the hash-table 97 | - at the highest level `test` will once again aggregate information 98 | over all tests 99 | 100 | So the structure of the summary, returned from `test`, will be the following: 101 | 102 | #{ 103 | failed-test-1 ((failed-assertion-1 expected actual) 104 | (failed-assertion-2 ... 105 | failed-test-2 ... 106 | } 107 | 108 | (`#{}` are [RUTILS][rutils] literal hash-table delimiters) 109 | 110 | There's also `:failed` key to `test` that will re-test only tests 111 | which failed at their last run. 112 | 113 | ### Usage patterns 114 | 115 | As `SHOULD-TEST` is agnostic, it doesn't impose any restrictions on 116 | how each individual project organizes its tests. Yet, having established 117 | patterns and best-practices never hearts. This section collects some of them. 118 | 119 | There's no restriction on naming tests. Though it seems like a good approach 120 | to name them the same as functions they test. As for generic functions, 121 | it, probably, makes sense to have different tests for different methods. 122 | In this case I add some suffix to the test's name to indicate which method 123 | is tested (like `transform-string` for one of the methods of gf `transform` 124 | that is specialized for the `string` class of arguments). 125 | 126 | As for code organization, I use the following directory structure 127 | of the typical project: 128 | 129 | 130 | /project-root 131 | |----src 132 | | `----module 133 | | `-----file.lisp 134 | `----test 135 | |----some-general-tests.lisp 136 | `----module 137 | `-----file-test.lisp 138 | 139 | I also usually place the tests in the same package as the code they test 140 | but protect them with `#+dev` guard, so that in production environment 141 | they are not compiled and loaded altogether. 142 | 143 | [ASDF][asdf] provides a way to define the standard for testing a system 144 | that can be invoked with `asdf:test-system`. 145 | The easiest way to hook into this facility is to define the following method 146 | for `asdf:test-op` somewhere either in `package.lisp` or in some common file in 147 | the `test` module (in the example above: `some-general-tests.lisp`): 148 | 149 | (defmethod asdf:perform ((o asdf:test-op) 150 | (s (eql (asdf:find-system )))) 151 | (asdf:load-system ) 152 | (st:test :package )) 153 | t) 154 | 155 | 156 | ## Quickstart 157 | 158 | As the project just got started it's not in [quicklisp][ql]. 159 | So to add it as an ASDF-dependency you have manually download/clone the project. 160 | The other option is to just take the file `src/should-test.lisp` 161 | and drop it into your project. It's designed to be self-contained: 162 | it contains the package definition 163 | and implements the core features of the framework. 164 | 165 | ### Requirements 166 | 167 | - [RUTILS][rutils] (available through [quicklisp][ql]) 168 | 169 | 170 | ## Self-testing 171 | 172 | There's a minimal test suite defined in `src/self-test.lisp`. 173 | The test suite is also hooked to `asdf:test-op` for the `should-test` system. 174 | 175 | 176 | ## License 177 | 178 | Copyright (c) 2013-2015 Vsevolod Dyomkin 179 | 180 | Permission is hereby granted, free of charge, to any person 181 | obtaining a copy of this software and associated documentation 182 | files (the "Software"), to deal in the Software without 183 | restriction, including without limitation the rights to use, 184 | copy, modify, merge, publish, distribute, sublicense, and/or sell 185 | copies of the Software, and to permit persons to whom the 186 | Software is furnished to do so, subject to the following 187 | conditions: 188 | 189 | Except as contained in this notice, the name(s) of the above 190 | copyright holders shall not be used in advertising or otherwise 191 | to promote the sale, use or other dealings in this Software 192 | without prior written authorization. 193 | 194 | The above copyright notice and this permission notice shall be 195 | included in all copies or substantial portions of the Software. 196 | 197 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 198 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES 199 | OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 200 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 201 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 202 | WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 203 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 204 | OTHER DEALINGS IN THE SOFTWARE. 205 | 206 | 207 | [ql]: http://quicklisp.org 208 | [asdf]: http://common-lisp.net/project/asdf 209 | [rutils]: http://github.com/vseloved/rutils 210 | [cl-redis]: http://github.com/vseloved/cl-redis 211 | -------------------------------------------------------------------------------- /self-test.lisp: -------------------------------------------------------------------------------- 1 | ;;;;; SHOULD-TEST self-test suite 2 | ;;;;; (c) 2013 Vsevolod Dyomkin 3 | 4 | (in-package #:should-test) 5 | (named-readtables:in-readtable rutils-readtable) 6 | 7 | (defmethod asdf:perform ((o asdf:test-op) 8 | (s (eql (asdf:find-system :should-test)))) 9 | (asdf:load-system :should-test) 10 | (let ((*verbose* nil)) 11 | (test :package :should-test)) 12 | t) 13 | 14 | 15 | (deftest deftest () 16 | (should be true 17 | (progn (deftest foo ()) 18 | (get 'foo 'test))) 19 | (should be null 20 | (progn (deftest foo ()) 21 | (get 'foo 'test)))) 22 | 23 | 24 | (deftest undeftest () 25 | (should be true 26 | (progn (deftest foo0 ()) 27 | (undeftest 'foo0))) 28 | (should be null 29 | (undeftest 'foo0))) 30 | 31 | (deftest test () 32 | (should signal should-test-error 33 | (let ((*test-output* (make-broadcast-stream))) 34 | (test :test (gensym)))) 35 | (should be true 36 | (let ((*test-output* (make-broadcast-stream))) 37 | (test :test 'deftest))) 38 | (should be true 39 | (test :package :cl)) ;; no tests defined for CL package 40 | (should be null 41 | (handler-case (unwind-protect 42 | (let ((*test-output* (make-broadcast-stream))) 43 | (deftest foo1 () (should be null t)) 44 | (test :test 'foo1)) 45 | (undeftest 'foo1)) 46 | (should-failed ()))) 47 | (should be true 48 | (let ((*test-output* (make-broadcast-stream))) 49 | (deftest foo2 () 50 | (let ((bar t)) 51 | (+ 1 2) 52 | (should be true bar))) 53 | (prog1 (test :test 'foo2) 54 | (undeftest 'foo2))))) 55 | 56 | (deftest should-be () 57 | (let ((*test-output* (make-broadcast-stream))) 58 | (should be null 59 | (handler-case (should be eql nil t) 60 | (should-checked () nil))))) 61 | 62 | (deftest should-signal () 63 | (let ((*test-output* (make-broadcast-stream))) 64 | (should signal simple-error 65 | (error "Error")))) 66 | 67 | (deftest should-print-to () 68 | (let ((*verbose* t)) 69 | (should print-to *test-output* 70 | "(PRINC bar) FAIL 71 | expect: \"foo\" 72 | actual: \"bar\" 73 | " 74 | (handler-case 75 | (should print-to *standard-output* "foo" (princ "bar")) 76 | (should-checked () nil))))) 77 | -------------------------------------------------------------------------------- /should-test.asd: -------------------------------------------------------------------------------- 1 | ;;;; SHOULD-TEST system definition 2 | ;;;; (c) 2013-2015 Vsevolod Dyomkin 3 | 4 | (asdf:defsystem #:should-test 5 | :version "1.0.0" 6 | :author "Vsevolod Dyomkin " 7 | :maintainer "Vsevolod Dyomkin " 8 | :licence "MIT" 9 | :description "Minimal yet feature-rich Common Lisp test framework." 10 | :depends-on (#:rutils #:local-time #:osicat #:cl-ppcre) 11 | :serial t 12 | :components ((:file "should-test") 13 | (:file "self-test") 14 | (:file "xunit"))) 15 | -------------------------------------------------------------------------------- /should-test.lisp: -------------------------------------------------------------------------------- 1 | ;;;;; SHOULD-TEST core: package definition and main functions 2 | ;;;;; (c) 2013-2018 Vsevolod Dyomkin 3 | 4 | (cl:defpackage #:should-test 5 | (:nicknames #:st) 6 | (:use #:common-lisp #:rtl #:local-time) 7 | (:export #:deftest 8 | #:should 9 | #:should-check 10 | #:should-checked 11 | #:should-erred 12 | #:should-failed 13 | #:should-format 14 | #:should-test-error 15 | #:should-test-redefinition-warning 16 | #:test 17 | #:undeftest 18 | 19 | #:*test-output* 20 | #:*verbose* 21 | 22 | #:*xml-output* 23 | #:test-for-xunit)) 24 | 25 | (in-package #:should-test) 26 | (named-readtables:in-readtable rutils-readtable) 27 | 28 | 29 | (defvar *test-output* *standard-output* 30 | "Stream to print test results.") 31 | 32 | (defparameter *verbose* t) 33 | 34 | (define-condition should-test-error (simple-error) ()) 35 | (define-condition should-checked () 36 | ((rez :initarg :rez :reader should-checked-rez))) 37 | (define-condition should-failed (should-checked) ()) 38 | (define-condition should-erred (should-checked) ()) 39 | 40 | (define-condition should-test-redefinition-warning (style-warning) 41 | ((name :initarg :name)) 42 | (:report (lambda (c stream) 43 | (format stream "Redefining test: ~A" (slot-value c 'name))))) 44 | 45 | 46 | (defmacro deftest (name () &body body) 47 | "Define a NAMEd test which is a function 48 | that treats each form in its BODY as an assertion to be checked 49 | and prints some information to the output. 50 | The result of this function is a boolean indicating 51 | if any of the assertions has failed. 52 | In case of failure second value is a list of failure descriptions, 53 | returned from assertions, 54 | and the third value is a list of uncaught errors if any." 55 | (with-gensyms (failed erred) 56 | `(progn 57 | (when (get ',name 'test) 58 | (warn 'should-test-redefinition-warning :name ',name)) 59 | (setf (get ',name 'test) 60 | (lambda () 61 | (format *test-output* "Test ~A: " ',name) 62 | (let (,failed ,erred) 63 | (handler-bind 64 | ((should-failed #`(push (should-checked-rez %) ,failed)) 65 | (should-erred #`(push (should-checked-rez %) ,erred))) 66 | ,@body) 67 | (if (or ,failed ,erred) 68 | (progn 69 | (format *test-output* " FAILED~%") 70 | (values nil 71 | ,failed 72 | ,erred)) 73 | (progn 74 | (format *test-output* " OK~%") 75 | t)))))))) 76 | 77 | (defun undeftest (name) 78 | "Remove test from symbol NAME." 79 | (when (get name 'test) 80 | (not (void (get name 'test))))) 81 | 82 | 83 | (defun test (&key (package *package*) test failed) 84 | "Run a scpecific TEST or all tests defined in PACKAGE (defaults to current). 85 | 86 | Returns T if all tests pass or 3 values: 87 | 88 | - NIL 89 | - a hash-table of failed tests with their failed assertions' lists 90 | - a hash-table of tests that have signalled uncaught errors with these errors 91 | 92 | If FAILED is set reruns only tests failed at last run." 93 | (if test 94 | (if-it (get test 'test) 95 | (funcall it) 96 | (error 'should-test-error 97 | :format-control (fmt "No test defined for ~A" test))) 98 | (let ((failures (make-hash-table)) 99 | (errors (make-hash-table))) 100 | (dolist (sym (package-internal-symbols package)) 101 | (when-it (and (or (not failed) 102 | (get sym 'test-failed)) 103 | (get sym 'test)) 104 | (mv-bind (success? failed erred) (funcall it) 105 | (if success? 106 | (setf (get sym 'test-failed) nil) 107 | (progn 108 | (setf (get sym 'test-failed) t) 109 | (when failed 110 | (set# sym failures failed)) 111 | (when erred 112 | (set# sym errors erred))))))) 113 | (or (zerop (+ (hash-table-count failures) 114 | (hash-table-count errors))) 115 | (values nil 116 | failures 117 | errors))))) 118 | 119 | (defmacro should (key test &rest expected-and-testee) 120 | "Define an individual test from: 121 | 122 | - a comparison TEST 123 | - EXPECTED values 124 | - an operation that needs to be tested (TESTEE) 125 | 126 | KEY is used to determine, which kind of results processing is needed 127 | (implemented by generic function SHOULD-CHECK methods). 128 | The simplest key is BE that just checks for equality. 129 | Another pre-defined key is SIGNAL, which intercepts conditions." 130 | (with-gensyms (success? failed e) 131 | (mv-bind (expected operation) (butlast2 expected-and-testee) 132 | `(handler-case 133 | (mv-bind (,success? ,failed) 134 | (should-check ,(mkeyw key) ',test 135 | (lambda () ,operation) ,@expected) 136 | (or (when ,success? 137 | (signal 'should-checked) 138 | t) 139 | (when *verbose* 140 | (format *test-output* 141 | "~&~A FAIL~%expect:~{ ~A~}~%actual:~{ ~A~}~%" 142 | ',operation 143 | (if ',expected 144 | (mapcar #'should-format (list ,@expected)) 145 | (list (should-format ',test))) 146 | (mklist (should-format ,failed)))) 147 | (signal 'should-failed :rez ,failed) 148 | (values nil 149 | (list ',operation ',expected ,failed)))) 150 | (error (,e) 151 | (when *verbose* 152 | (format *test-output* "~&~A FAIL~%error: ~A~%" 153 | ',operation (should-format ,e))) 154 | (signal 'should-erred :rez ,e)))))) 155 | 156 | 157 | 158 | (defgeneric should-check (key test fn &rest expected) 159 | (:documentation 160 | "Specific processing for SHOULD based on KEY. 161 | FN's output values are matched to EXPECTED values (if they are given). 162 | Up to 2 values are returned: 163 | 164 | - if the test passed (T or NIL) 165 | - in case of failure - actual result")) 166 | 167 | (defmethod should-check ((key (eql :be)) test fn &rest expected) 168 | (let ((rez (multiple-value-list (funcall fn)))) 169 | (or (if expected 170 | (and (>= (length rez) (length expected)) 171 | (every test rez (mklist expected))) 172 | (every test rez)) 173 | (values nil 174 | rez)))) 175 | 176 | (defmethod should-check ((key (eql :signal)) test fn &rest expected) 177 | (declare (ignore expected)) 178 | (handler-case (progn (funcall fn) 179 | (values nil 180 | nil)) 181 | (condition (c) 182 | (or (eql (mkeyw test) (mkeyw (class-name (class-of c)))) 183 | (values nil 184 | c))))) 185 | 186 | (defmethod should-check ((key (eql :print-to)) stream-sym fn &rest expected) 187 | (let ((original-value (symbol-value stream-sym))) 188 | (unwind-protect 189 | (progn (setf (symbol-value stream-sym) 190 | (make-string-output-stream)) 191 | (funcall fn) 192 | (let ((rez (get-output-stream-string (symbol-value stream-sym)))) 193 | (or (string= (first expected) rez) 194 | (values nil 195 | rez)))) 196 | (setf (symbol-value stream-sym) original-value)))) 197 | 198 | (defgeneric should-format (obj) 199 | (:documentation "Format appropriately for test output.") 200 | (:method :around (obj) 201 | (let ((*print-length* 3)) (call-next-method))) 202 | (:method (obj) 203 | (handler-case (fmt "~S" obj) 204 | (error () (fmt "~A" obj)))) 205 | (:method ((obj hash-table)) 206 | (with-output-to-string (out) (print-ht obj out))) 207 | (:method ((obj list)) 208 | (cond ((null obj) 209 | (fmt "NIL")) 210 | ((listp (cdr obj)) 211 | (mapcar #'should-format obj)) 212 | (t (fmt "(~A . ~A)" 213 | (should-format (car obj)) (should-format (cdr obj))))))) 214 | -------------------------------------------------------------------------------- /xunit.lisp: -------------------------------------------------------------------------------- 1 | ;;; (c) 2013-2015 Vsevolod Dyomkin 2 | 3 | (in-package #:should-test) 4 | (named-readtables:in-readtable rutils-readtable) 5 | 6 | (defparameter *xml-output* *standard-output*) 7 | 8 | (defun xml-escape (value) 9 | (macrolet ((replace-all (text &rest from-to-pairs) 10 | (if (endp from-to-pairs) 11 | text 12 | `(ppcre:regex-replace-all 13 | ,(caar from-to-pairs) 14 | (replace-all ,text ,@(cdr from-to-pairs)) 15 | ,(cdar from-to-pairs))))) 16 | (let ((value (princ-to-string value))) 17 | (replace-all value 18 | ("<" . "<") 19 | (">" . ">") 20 | ("'" . "'") 21 | ("\"" . """) 22 | ("&" . "&"))))) 23 | 24 | (defmacro xml (tag &rest attrs-&-body) 25 | `(progn (write-string ,(fmt "<~(~A~)" tag) *xml-output*) 26 | ,@(loop :for (attr val) :on (butlast attrs-&-body) :by #'cddr :collect 27 | `(when ,val 28 | (format *xml-output* ,(fmt " ~(~A~)=\"~~A\"" attr) 29 | (xml-escape ,val)))) 30 | ,(if (oddp (length attrs-&-body)) 31 | `(progn (write-char #\> *xml-output*) 32 | (when-it ,(last1 attrs-&-body) 33 | (write-string (xml-escape it) *xml-output*)) 34 | (write-string ,(fmt "" tag) *xml-output*)) 35 | `(write-string " />" *xml-output*)))) 36 | 37 | (defun test-for-xunit (out &rest args &key id (package *package*) test) 38 | "Like TEST but writes xunit-style XML test report to OUT." 39 | (let ((*xml-output* out) 40 | (start-ts (local-time:now)) 41 | (*test-output* (make-string-output-stream)) 42 | (*error-output* (make-string-output-stream))) 43 | (mv-bind (success? failures errors) (apply 'test args) 44 | (let ((tests (when test (list test))) 45 | (now (local-time:now))) 46 | (unless tests 47 | (do-symbols (sym package) 48 | (when-it (and (eql (symbol-package sym) (find-package package)) 49 | (get sym 'test)) 50 | (push it tests))) 51 | (reversef tests)) 52 | (unless id 53 | (write-line "" *xml-output*)) 54 | (xml :testsuite 55 | :tests (length tests) 56 | :failures (if failures (hash-table-count failures) 0) 57 | :errors (if errors (hash-table-count errors) 0) 58 | :hostname (osicat-posix:gethostname) 59 | :name (fmt "~A~@[:~A~]" package test) 60 | :time (coerce (* (local-time:timestamp-difference now start-ts) 61 | 1000) 62 | 'float) 63 | :timestamp (slice (local-time:to-rfc3339-timestring now) 64 | 0 19) ; till seconds 65 | (progn 66 | (xml :properties nil) 67 | (dolist (test tests) 68 | (let ((failure (when failures (get# test failures))) 69 | (error (when errors (get# test errors)))) 70 | (xml :testcase :classname (package-name package) 71 | :name test :time "0" 72 | (cond 73 | (failure (xml :failure :type "failure" failure)) 74 | (error (xml :error :type "error" error)))))) 75 | (xml :system-out (get-output-stream-string *test-output*)) 76 | (xml :system-err (get-output-stream-string *error-output*)))))))) 77 | --------------------------------------------------------------------------------