Skip to content
Newer
Older
100644 1333 lines (1096 sloc) 51.4 KB
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: test-grid; Base: 10; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
1b1f4c2 @avodonosov Code to compare results for two quicklisp versions and find regressio…
avodonosov authored Feb 25, 2012
2
5be7639 @avodonosov first commit
avodonosov authored Nov 15, 2011
3 (defpackage #:test-grid (:use :cl))
4
5 (in-package #:test-grid)
6
7 (defgeneric libtest (library-name)
8 (:documentation "Define a method for this function
1b1f4c2 @avodonosov Code to compare results for two quicklisp versions and find regressio…
avodonosov authored Feb 25, 2012
9 with LIBRARY-NAME eql-specialized for for every library added
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
10 to the test grid.
11
12 The method should run test suite and return the resulting
1b1f4c2 @avodonosov Code to compare results for two quicklisp versions and find regressio…
avodonosov authored Feb 25, 2012
13 status. Status is one of these values:
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 13, 2012
14 :OK - all tests passed,
15 :FAIL - some test failed,
1b1f4c2 @avodonosov Code to compare results for two quicklisp versions and find regressio…
avodonosov authored Feb 25, 2012
16 :NO-RESOURCE - test suite can not be run because some required
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
17 resource is absent in the environment. For example, CFFI library
18 test suite needs a small C library compiled to DLL. User must
19 do it manually. In case the DLL is absent, the LIBTEST method
20 for CFFI returns :NO-RESOURCE.
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
21 Extended status in the form
f96b3bd @avodonosov The names of failed tests and known to fail tests are represented as …
avodonosov authored Feb 13, 2012
22 (:FAILED-TESTS <list of failed tests> :KNOWN-TO-FAIL <list of known failures>)
23 The test names in these lists are represented as downcased strings.
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
24
25 If any SERIOUS-CONDITION is signalled, this is considered a failure.
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
26
27 For convenience, T may be returned instead of :OK and NIL instead of :FAIL."))
28
29 (defun normalize-status (status)
30 "Normilzies test resul status - converts T to :OK and NIL to :FAIL."
31 (case status
32 ((t :ok) :ok)
33 ((nil :fail) :fail)
34 (otherwise status)))
35
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
37 ;; My Require
38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39
40 (defun require-impl (api)
41 "Loads an implementation of the specified API (if
42 it is not loaded yet).
43
44 Some of test-grid components have separate package
45 and ASDF system for API and separate package+ASDF
46 system for the implementation. This allows test-grid
47 to be compilable and (partially) opereable even
48 when some components are broken on particular lisp.
49
50 For these known test-grid componetns REQUIRE-IMPL loads
51 the implementation. Otherwise the API parameter is
52 just passed to the QUICKLISP:QUICKLOAD."
53 (setf api (string-downcase api))
548b28e @avodonosov Extended test status for the Lift test framework (used by 7 of the 23…
avodonosov authored Mar 9, 2012
54 (let* ((known-impls '(("rt-api" . "rt-api-impl")
b68a220 @avodonosov Implemented extended test statuses for the FiveAM test frameworkd (us…
avodonosov authored Mar 10, 2012
55 ("lift-api" . "lift-api-impl")
5466cd0 @avodonosov Extended tests statuses for the Eos test framework (used by parenscri…
avodonosov authored Mar 11, 2012
56 ("fiveam-api" . "fiveam-api-impl")
c8eb743 @avodonosov Extended test statuses for the Stefil test framework (used by babel).
avodonosov authored Mar 12, 2012
57 ("eos-api" . "eos-api-impl")
58 ("stefil-api" . "stefil-api-impl")))
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
59 (impl-asdf-system (or (cdr (assoc api known-impls :test #'string=))
60 api)))
61 (quicklisp:quickload impl-asdf-system)))
62
63 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
64 ;; LIBTEST implementations for particular libraries
65 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
66
3c9973a @avodonosov Added cl-annot
avodonosov authored Mar 19, 2012
67 (defparameter *all-libs*
a070f22 @avodonosov Added hu.dwim.stefil, kmrcl, cxml-stp, hu.dwim.walker, hu.dwim.defcla…
avodonosov authored Mar 30, 2012
68 '(:alexandria :babel :trivial-features :cffi
69 :cl-ppcre :usocket :flexi-streams :bordeaux-threads
70 :cl-base64 :cl-fad :trivial-backtrace :puri
71 :anaphora :parenscript :trivial-garbage :iterate
72 :metabang-bind :cl-json :cl-containers :metatilities-base
73 :cl-cont :moptilities :trivial-timeout :metatilities
74 :named-readtables :arnesi :local-time :s-xml
75 :iolib :cl-oauth :cl-routes :cl-unicode
76 :fiveam :trivial-utf-8 :yason :cl-annot
77 :cl-openid :split-sequence :cl-closure-template :cl-interpol
78 :trivial-shell :let-plus :data-sift :cl-num-utils
79 :ieee-floats :cl-project :trivial-http :cl-store
80 :hu.dwim.stefil :kmrcl :cxml-stp :hu.dwim.walker
81 :hu.dwim.defclass-star :bknr.datastore :yaclml :com.google.base
82 :external-program)
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
83 "All the libraries currently supported by the test-grid.")
84
df32b14 @avodonosov clean-rt function: little shorthand for (require-impl "rt-api") (rt-a…
avodonosov authored Mar 9, 2012
85 (defun clean-rt ()
86 (require-impl "rt-api")
87 (rt-api:clean))
88
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
89 (defun run-rt-test-suite()
90 (require-impl "rt-api")
91
92 (let (non-compiled-failures all-failures)
93
94 (rt-api:do-tests :compiled-p nil)
95 (setf non-compiled-failures (rt-api:failed-tests))
96
97 (rt-api:do-tests :compiled-p t)
98 (setf all-failures (union non-compiled-failures
99 (rt-api:failed-tests)))
100
f96b3bd @avodonosov The names of failed tests and known to fail tests are represented as …
avodonosov authored Feb 12, 2012
101 (list :failed-tests (mapcar #'string-downcase all-failures)
102 :known-to-fail (mapcar #'string-downcase (rt-api:known-to-fail)))))
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
103
548b28e @avodonosov Extended test status for the Lift test framework (used by 7 of the 23…
avodonosov authored Mar 8, 2012
104 (defun run-lift-test-suite (test-suite-name)
105 (require-impl "lift-api")
106 (let ((result (lift-api:run-test-suite test-suite-name)))
107 (list :failed-tests (lift-api:failed-tests result)
108 :known-to-fail (lift-api:known-to-fail test-suite-name))))
109
b68a220 @avodonosov Implemented extended test statuses for the FiveAM test frameworkd (us…
avodonosov authored Mar 10, 2012
110 (defun run-fiveam-test-suite (test-suite-spec)
111 (require-impl "fiveam-api")
112 (let ((result (fiveam-api:run-test-suite test-suite-spec)))
113 (list :failed-tests (fiveam-api:failed-tests result)
114 :known-to-fail '())))
115
5466cd0 @avodonosov Extended tests statuses for the Eos test framework (used by parenscri…
avodonosov authored Mar 11, 2012
116 (defun run-eos-test-suites (&rest test-suite-specs)
117 (require-impl "eos-api")
118 (let ((result (apply #'eos-api:run-test-suites test-suite-specs)))
119 (list :failed-tests (eos-api:failed-tests result)
120 :known-to-fail '())))
121
c8eb743 @avodonosov Extended test statuses for the Stefil test framework (used by babel).
avodonosov authored Mar 12, 2012
122 (defun run-stefil-test-suite (test-suite-spec)
123 (require-impl "stefil-api")
124 (let ((result (stefil-api:run-test-suite test-suite-spec)))
125 (list :failed-tests (stefil-api:failed-tests result)
126 :known-to-fail '())))
127
f4df386 @avodonosov Added ieee-floats (now really added), cl-project, trivial-http, cl-store
avodonosov authored Mar 28, 2012
128 (defun running-cl-test-more-suite (project-name runner-function)
129 ;; cl-test-more test suites usually run tests the
130 ;; load time.
131 ;;
132 ;; cl-test-more produces text output in
133 ;; the TAP (Test Anhything Protocol),
134 ;; and does not produce any other programmaticaly
135 ;; inspectable value.
136 ;;
137 ;; We will intercept the test output, and
138 ;; interpret it according to the TAP
139 ;; format (we limit this by just
140 ;; looking for strings starting with "not ok"
141 ;; in the output).
142
143 ;; Intersepting cl-test-more TAP output
144 (quicklisp:quickload :cl-test-more)
145
146 (let ((test-output-buf (make-string-output-stream)))
147 (progv
148 (list (read-from-string "cl-test-more:*test-result-output*"))
01c0294 @avodonosov Fixed test output configuration in running-cl-test-more-suite
avodonosov authored Mar 29, 2012
149 (list (make-broadcast-stream *standard-output* test-output-buf))
f4df386 @avodonosov Added ieee-floats (now really added), cl-project, trivial-http, cl-store
avodonosov authored Mar 28, 2012
150 (funcall runner-function))
151
152 ;; Now look for a strting starting from "not ok"
153 ;; in the test output
154 (with-input-from-string (test-output (get-output-stream-string test-output-buf))
155 (do ((line (read-line test-output nil) (read-line test-output nil)))
156 ((null line))
157 (when (starts-with line "not ok")
158 (format t "---------------------------------------------------------------------------~%")
159 (format t "~A test suite has a test failure; the first TAP output failure string:~%~A"
160 project-name line)
161 (return-from running-cl-test-more-suite :fail))))
162 :ok))
163
a070f22 @avodonosov Added hu.dwim.stefil, kmrcl, cxml-stp, hu.dwim.walker, hu.dwim.defcla…
avodonosov authored Mar 30, 2012
164 (defun combine-extended-libresult (libresult-a libresult-b)
165 (list :failed-tests (union (getf libresult-a :failed-tests)
166 (getf libresult-b :failed-tests)
167 :test #'string=)
168 :known-to-fail (union (getf libresult-a :known-to-fail)
169 (getf libresult-b :known-to-fail)
170 :test #'string=)))
171
172 (assert (let ((combined (combine-extended-libresult '(:failed-tests ("a" "b")
173 :known-to-fail ("c"))
174 '(:failed-tests ("a2" "c2")
175 :known-to-fail ("b2")))))
176 (and (set= '("a" "b" "a2" "c2")
177 (getf combined :failed-tests)
178 :test #'string=)
179 (set= '("c" "b2")
180 (getf combined :known-to-fail)
181 :test #'string=))))
182
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
183 (defmethod libtest ((library-name (eql :alexandria)))
184
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
185 ; We keep the below hardcoded failure in case we want to test
759a7fa @avodonosov Uncomented ECL hardcoded failure for alexandria tests because we are …
avodonosov authored Jan 11, 2012
186 ; the ECL 11.1.1 release (until new release is out).
187 ; It is commented out or uncommented depending on what
9cfb9be @avodonosov Comment out hardcoded failure for alexandria on ECL - will retest mor…
avodonosov authored Feb 25, 2012
188 ; ECL release we are going to test.
759a7fa @avodonosov Uncomented ECL hardcoded failure for alexandria tests because we are …
avodonosov authored Jan 11, 2012
189
9cfb9be @avodonosov Comment out hardcoded failure for alexandria on ECL - will retest mor…
avodonosov authored Feb 25, 2012
190 ;; #+ecl
191 ;; (progn
192 ;; (format t "ECL 11.1.1 has bug causing a stack overflow on alexandria tests. http://sourceforge.net/tracker/?func=detail&aid=3463131&group_id=30035&atid=398053~%")
193 ;; (return-from libtest :fail))
dbb49e6 @avodonosov Workaround for non-recoverable stack overflow when running alexandria…
avodonosov authored Jan 9, 2012
194
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
195 ;; The test framework used: rt.
df32b14 @avodonosov clean-rt function: little shorthand for (require-impl "rt-api") (rt-a…
avodonosov authored Mar 8, 2012
196 (clean-rt)
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
197 (asdf:clear-system :alexandria-tests)
198 (quicklisp:quickload :alexandria-tests)
199
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
200 (run-rt-test-suite))
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
201
202 (defmethod libtest ((library-name (eql :babel)))
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
203
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
204 ;; The test framework used: stefil.
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
205
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
206 (quicklisp:quickload :babel-tests)
c8eb743 @avodonosov Extended test statuses for the Stefil test framework (used by babel).
avodonosov authored Mar 12, 2012
207 (run-stefil-test-suite (intern (string '#:babel-tests) '#:babel-tests)))
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
208
209 (defmethod libtest ((library-name (eql :trivial-features)))
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
210
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
211 ;; The test framework used: rt.
df32b14 @avodonosov clean-rt function: little shorthand for (require-impl "rt-api") (rt-a…
avodonosov authored Mar 8, 2012
212 (clean-rt)
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
213 (asdf:clear-system :trivial-features-tests)
214
ca7947b @avodonosov closes #2 - load cffi-grovel explicitly before loading trivial-featur…
avodonosov authored Jan 6, 2012
215 ;; Load cffi-grovel which is used in trivial-features-tests.asd,
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
216 ;; but not in the asdf:defsystem macro (issue #2).
ca7947b @avodonosov closes #2 - load cffi-grovel explicitly before loading trivial-featur…
avodonosov authored Jan 6, 2012
217 (quicklisp:quickload :cffi-grovel)
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
218 (quicklisp:quickload :trivial-features-tests)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
219
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
220 (run-rt-test-suite))
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
221
222 (defmethod libtest ((library-name (eql :cffi)))
223
224 ;; The test framework used: rt.
df32b14 @avodonosov clean-rt function: little shorthand for (require-impl "rt-api") (rt-a…
avodonosov authored Mar 8, 2012
225 (clean-rt)
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
226 (asdf:clear-system :cffi-tests)
227
ff09cf0 @avodonosov Workaround for quicklisp bug #55 - inability to load cffi-tests. quic…
avodonosov authored Mar 13, 2012
228 ;; Workaround for the quicklisp bug #55
229 ;; (https://github.com/quicklisp/quicklisp-client/issues/55)
09b1cb7 @avodonosov Added cl-oauth, cl-routes, cl-unicode, fiveam, trivial-utf-8, yason.
avodonosov authored Mar 18, 2012
230 (ql:quickload :cffi)
ff09cf0 @avodonosov Workaround for quicklisp bug #55 - inability to load cffi-tests. quic…
avodonosov authored Mar 12, 2012
231 (let ((cffi-dir (make-pathname :name nil :type nil :defaults (ql-dist:find-asdf-system-file "cffi"))))
232 (pushnew cffi-dir asdf:*central-registry* :test #'equal))
233 ;; now (ql:quickload "cffi-tests") will work
234
cf836f1 @d35h Added function pivot-report-html and done some changes in style.css
d35h authored Dec 15, 2011
235 ;; CFFI tests work with a small test C library.
236 ;; The user is expected to compile the library manually.
237 ;; If the library is not available, CFFI tests
238 ;; signal cffi:load-foreign-library-error.
239 (handler-bind ((error #'(lambda (condition)
240 ;; Check if the error is a
241 ;; cffi:load-foreign-library-error.
242 ;; Take into account that it might
243 ;; be some other error which prevents
244 ;; even CFFI system to load,
245 ;; and therefore CFFI package may be
f5ce54d @avodonosov Fix typo in a comment.
avodonosov authored Mar 14, 2012
246 ;; absent. That's why use use ignore-errors
cf836f1 @d35h Added function pivot-report-html and done some changes in style.css
d35h authored Dec 15, 2011
247 ;; when looking for a symbol in the CFFI
248 ;; packge.
249 (when (eq (type-of condition)
250 (ignore-errors (find-symbol (symbol-name '#:load-foreign-library-error)
251 '#:cffi)))
252 ;; todo: add the full path to the 'test' directory,
253 ;; where user can find the scripts to compile
254 ;; the test C library, to the error message.
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
255 (format t
256 "~& An error occurred during (quicklisp:quickload :cffi-tests):~%~A~&This means the small C library used by CFFI tests is not available (probably you haven't compiled it). The compilation script for the library may be found in the 'test' directory in the CFFI distribution.~%"
cf836f1 @d35h Added function pivot-report-html and done some changes in style.css
d35h authored Dec 15, 2011
257 condition)
258 (return-from libtest :no-resource))
259 ;; resignal the condition
260 (error condition))))
261 (quicklisp:quickload :cffi-tests))
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
262 (run-rt-test-suite))
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
263
264 (defmethod libtest ((library-name (eql :cl-ppcre)))
265
ef38242 @avodonosov Workaround for ABCL problem with cl-ppcre tests (hanging for a long t…
avodonosov authored Jan 10, 2012
266 #+abcl
267 (progn
268 (format t "~&Due to ABCL bug #188 (http://trac.common-lisp.net/armedbear/ticket/188)~%")
78056ae @avodonosov Improved the log message about cl-ppcre failure on ABCL.
avodonosov authored Jan 10, 2012
269 (format t "cl-ppcre tests fail, repeating this error huge number of times, in result~%")
270 (format t "hanging for a long time and producing a huge log.")
ef38242 @avodonosov Workaround for ABCL problem with cl-ppcre tests (hanging for a long t…
avodonosov authored Jan 9, 2012
271 (return-from libtest :fail))
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
272
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
273 ;; The test framework used: custom.
274
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
275 ;; Workaround the quicklisp issue #225 -
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
276 ;; https://github.com/quicklisp/quicklisp-projects/issues/225 -
277 ;; first load cl-ppcre-unicode, because otherwise
278 ;; current quicklisp can not find cl-ppcre-unicode-test
279 (quicklisp:quickload :cl-ppcre-unicode)
280 (quicklisp:quickload :cl-ppcre-unicode-test)
281
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
282 ;; copy/paste from cl-ppcre-unicode.asd
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
283 (funcall (intern (symbol-name :run-all-tests) (find-package :cl-ppcre-test))
284 :more-tests (intern (symbol-name :unicode-test) (find-package :cl-ppcre-test))))
285
286 (defmethod libtest ((library-name (eql :usocket)))
287
e953421 @avodonosov Workaroudn for hanging usocket test suite on ABCL by hardcoding test …
avodonosov authored Jan 10, 2012
288 #+abcl
289 (progn
290 (format t "~&On ABCL abcl-1.0.0 the usocket test suite hangs (after producing significant~%")
291 (format t "number of errors/failures in the log). The last log message before it hangs is:~%")
292 (format t "USOCKET-TEST::WAIT-FOR-INPUT.3")
293 (return-from libtest :fail))
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
294
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
295 ;; The test framework used: rt.
df32b14 @avodonosov clean-rt function: little shorthand for (require-impl "rt-api") (rt-a…
avodonosov authored Mar 8, 2012
296 (clean-rt)
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
297 (asdf:clear-system :usocket-test)
298
299 ; (asdf:operate 'asdf:load-op :usocket-test :force t)
300
301 (quicklisp:quickload :usocket-test)
302
303 ;; TODO: usocket test suite might need manual configuration,
304 ;; see their README. Distinguish the case
305 ;; when the manual configuration hasn't been
306 ;; performed and return :no-resource status.
4055e27 @avodonosov Added cl-base64 to the tests.
avodonosov authored Nov 25, 2011
307 ;;
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
308 ;; (setf usocket-test::*common-lisp-net*
309 ;; (or usocket-test::*common-lisp-net*
310 ;; "74.115.254.14"))
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
311
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
312 (run-rt-test-suite))
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
313
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
314 (defmethod libtest ((library-name (eql :flexi-streams)))
315
316 ;; The test framework used: custom.
317
318 (quicklisp:quickload :flexi-streams-test)
319
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
320 ;; copy/paste from flexi-streams.asd
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
321 (funcall (intern (symbol-name :run-all-tests)
322 (find-package :flexi-streams-test))))
323
324 (defmethod libtest ((library-name (eql :bordeaux-threads)))
325
1d85bb0 @avodonosov hardcode failure of bordeaux-threads tests on CMUCL to workaround the…
avodonosov authored Jan 10, 2012
326 #+cmucl
327 (progn
97de4d3 @avodonosov Fix formatting in the log message when returing the hardcoded failure…
avodonosov authored Jan 10, 2012
328 (format t "~&On CMUCL bordeaux-threads test suite traps into some active~%")
329 (format t "deadlock, produces 8 MB of '.' symbols in log, constantly runs GC~%")
330 (format t "and finally dies when heap is exhausted.~%")
1d85bb0 @avodonosov hardcode failure of bordeaux-threads tests on CMUCL to workaround the…
avodonosov authored Jan 10, 2012
331 (return-from libtest :fail))
332
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
333 ;; The test framework used: fiveam.
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
334
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
335 (quicklisp:quickload :bordeaux-threads-test)
d4fc132 @avodonosov added cl-json
avodonosov authored Nov 29, 2011
336
b68a220 @avodonosov Implemented extended test statuses for the FiveAM test frameworkd (us…
avodonosov authored Mar 10, 2012
337 (run-fiveam-test-suite :bordeaux-threads))
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
338
4055e27 @avodonosov Added cl-base64 to the tests.
avodonosov authored Nov 24, 2011
339 (defmethod libtest ((library-name (eql :cl-base64)))
340
341 ;; The test framework used: ptester.
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
342
8339df1 @avodonosov closes #1 quicklisp can't load test asdf systems which do not have th…
avodonosov authored Jan 6, 2012
343 ;; Load cl-base64 first, because cl-base64-tests
344 ;; is defined in cl-base64.asd which confuses
345 ;; quicklisp (some versions of, see issue #1)
346 (quicklisp:quickload :cl-base64)
347
4055e27 @avodonosov Added cl-base64 to the tests.
avodonosov authored Nov 24, 2011
348 (quicklisp:quickload :cl-base64-tests)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
349
4055e27 @avodonosov Added cl-base64 to the tests.
avodonosov authored Nov 24, 2011
350 (funcall (intern (symbol-name '#:do-tests)
351 (find-package '#:cl-base64-tests))))
352
2c06f1a @avodonosov Added cl-fad
avodonosov authored Mar 16, 2012
353 (defmethod libtest ((library-name (eql :cl-fad)))
354
72c750d @avodonosov Added arnesi, local-time, s-xml
avodonosov authored Mar 16, 2012
355 ;; The test framework used: cl:assert.
2c06f1a @avodonosov Added cl-fad
avodonosov authored Mar 16, 2012
356
357 (quicklisp:quickload :cl-fad)
358 (load
359 (asdf:system-relative-pathname (asdf:find-system :cl-fad)
360 "test.lisp"))
361
362 ;; cl-fad test suite uses cl:assert.
363 ;; I.e. any test faifures are signaled as errors.
364 (handler-case
365 (progn
bdefd05 @avodonosov Added named-readtables
avodonosov authored Mar 16, 2012
366 (funcall (intern (symbol-name '#:test) '#:cl-fad-test))
2c06f1a @avodonosov Added cl-fad
avodonosov authored Mar 16, 2012
367 :ok)
368 (error (e)
369 (format t "cl-fad test suite failed with error: ~A" e)
370 :fail)))
371
7ab792d @avodonosov Added trivial-backtrace to the tests. (Always fails; it tries to crea…
avodonosov authored Nov 27, 2011
372 (defmethod libtest ((library-name (eql :trivial-backtrace)))
373 ;; The test framework used: lift.
374 (quicklisp:quickload :trivial-backtrace-test)
548b28e @avodonosov Extended test status for the Lift test framework (used by 7 of the 23…
avodonosov authored Mar 8, 2012
375 (run-lift-test-suite :trivial-backtrace-test))
7ab792d @avodonosov Added trivial-backtrace to the tests. (Always fails; it tries to crea…
avodonosov authored Nov 27, 2011
376
1639b53 @avodonosov Added puri. A typo fixed in the LIBTEST for trivial-backtrace. Decide…
avodonosov authored Nov 27, 2011
377 (defmethod libtest ((library-name (eql :puri)))
378
379 ;; The test framework used: ptester.
380
8339df1 @avodonosov closes #1 quicklisp can't load test asdf systems which do not have th…
avodonosov authored Jan 6, 2012
381 ;; Load puri first, because puri-tests
382 ;; is defined in puri.asd which confuses
383 ;; quicklisp (some versions of, see issue #1)
384 (quicklisp:quickload :puri)
385
1639b53 @avodonosov Added puri. A typo fixed in the LIBTEST for trivial-backtrace. Decide…
avodonosov authored Nov 27, 2011
386 (quicklisp:quickload :puri-tests)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
387
1639b53 @avodonosov Added puri. A typo fixed in the LIBTEST for trivial-backtrace. Decide…
avodonosov authored Nov 27, 2011
388 ;; copy/paste from puri.asd
389 (funcall (intern (symbol-name '#:do-tests)
390 (find-package :puri-tests))))
391
1d6be7b @avodonosov Added anaphora
avodonosov authored Nov 27, 2011
392 (defmethod libtest ((library-name (eql :anaphora)))
393
394 ;; The test framework used: rt.
df32b14 @avodonosov clean-rt function: little shorthand for (require-impl "rt-api") (rt-a…
avodonosov authored Mar 8, 2012
395 (clean-rt)
1d6be7b @avodonosov Added anaphora
avodonosov authored Nov 27, 2011
396 (asdf:clear-system :anaphora-test)
cf836f1 @d35h Added function pivot-report-html and done some changes in style.css
d35h authored Dec 15, 2011
397 ;; anaphora-test is defined in anaphora.asd,
398 ;; therefore to reload :anaphora-test
399 ;; we need to clean the :anaphora system too
400 (asdf:clear-system :anaphora)
1d6be7b @avodonosov Added anaphora
avodonosov authored Nov 27, 2011
401
8339df1 @avodonosov closes #1 quicklisp can't load test asdf systems which do not have th…
avodonosov authored Jan 6, 2012
402 ;; Load anaphora first, because anaphora-tests
403 ;; is defined in anaphora.asd which confuses
404 ;; quicklisp (some versions of, see issue #1)
405 (quicklisp:quickload :anaphora)
1d6be7b @avodonosov Added anaphora
avodonosov authored Nov 27, 2011
406 (quicklisp:quickload :anaphora-test)
407
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
408 (run-rt-test-suite))
1d6be7b @avodonosov Added anaphora
avodonosov authored Nov 27, 2011
409
44b1c75 @avodonosov Added parenscript
avodonosov authored Nov 27, 2011
410 (defmethod libtest ((library-name (eql :parenscript)))
411 ;; The test framework used: eos (similar to FiveAM).
412
cf836f1 @d35h Added function pivot-report-html and done some changes in style.css
d35h authored Dec 15, 2011
413 (quicklisp:quickload :parenscript.test)
414
44b1c75 @avodonosov Added parenscript
avodonosov authored Nov 27, 2011
415 ;; asdf:test-op is not provided for parenscript,
416 ;; only a separate package ps-test with public
417 ;; function run-tests.
418
5466cd0 @avodonosov Extended tests statuses for the Eos test framework (used by parenscri…
avodonosov authored Mar 11, 2012
419 ;; The test suites to run are taken from the
420 ;; the function run-tests in the file
421 ;; <parenscript sources>/t/test.lisp.
422 (run-eos-test-suites (intern (string '#:output-tests) :ps-test)
423 (intern (string '#:package-system-tests) :ps-test)
424 (intern (string '#:eval-tests) :ps-test)))
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
425
d7c17f3 @avodonosov Added trivial-garbage.
avodonosov authored Nov 27, 2011
426 (defmethod libtest ((library-name (eql :trivial-garbage)))
427
428 ;; The test framework used: rt.
df32b14 @avodonosov clean-rt function: little shorthand for (require-impl "rt-api") (rt-a…
avodonosov authored Mar 8, 2012
429 (clean-rt)
d7c17f3 @avodonosov Added trivial-garbage.
avodonosov authored Nov 27, 2011
430 (asdf:clear-system :trivial-garbage) ; yes, trivial-garbage but not trivial-garbage-tests,
431 ; because the trivial-garbage-tests system is defined
432 ; in the same trivial-garbage.asd and neither
433 ; asdf nor quicklisp can't find trivial-garbage-tests.
434
435 (quicklisp:quickload :trivial-garbage); trivial-garbage but not trivial-garbage-tests,
436 ; for the same reasons as explained above.
437 (asdf:operate 'asdf:load-op :trivial-garbage-tests)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
438
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
439 (run-rt-test-suite))
1d6be7b @avodonosov Added anaphora
avodonosov authored Nov 27, 2011
440
696936b @avodonosov Added iterate and metabang-bind.
avodonosov authored Nov 28, 2011
441 (defmethod libtest ((library-name (eql :iterate)))
442
443 ;; The test framework used: rt.
df32b14 @avodonosov clean-rt function: little shorthand for (require-impl "rt-api") (rt-a…
avodonosov authored Mar 8, 2012
444 (clean-rt)
696936b @avodonosov Added iterate and metabang-bind.
avodonosov authored Nov 28, 2011
445 (asdf:clear-system :iterate-tests)
446 (asdf:clear-system :iterate)
447
8339df1 @avodonosov closes #1 quicklisp can't load test asdf systems which do not have th…
avodonosov authored Jan 6, 2012
448 ;; Load iterate first, because iterate-tests
449 ;; is defined in iterate.asd which confuses
450 ;; quicklisp (some versions of, see issue #1)
451 (quicklisp:quickload :iterate)
696936b @avodonosov Added iterate and metabang-bind.
avodonosov authored Nov 28, 2011
452 (quicklisp:quickload :iterate-tests)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
453
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
454 (run-rt-test-suite))
696936b @avodonosov Added iterate and metabang-bind.
avodonosov authored Nov 28, 2011
455
456 (defmethod libtest ((library-name (eql :metabang-bind)))
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
457
696936b @avodonosov Added iterate and metabang-bind.
avodonosov authored Nov 28, 2011
458 ;; The test framework used: lift.
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
459
460 ;; metabang-bind-test includes binding syntax
d4fc132 @avodonosov added cl-json
avodonosov authored Nov 28, 2011
461 ;; for regular-expression and corresponding
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
462 ;; tests; but this functionality is only
d4fc132 @avodonosov added cl-json
avodonosov authored Nov 28, 2011
463 ;; loaded if cl-ppcre is loaded first.
464 ;; (this conditional loading is achieaved
465 ;; with asdf-system-connections).
696936b @avodonosov Added iterate and metabang-bind.
avodonosov authored Nov 28, 2011
466 (quicklisp:quickload :cl-ppcre)
467 (quicklisp:quickload :metabang-bind-test)
468
548b28e @avodonosov Extended test status for the Lift test framework (used by 7 of the 23…
avodonosov authored Mar 8, 2012
469 (run-lift-test-suite :metabang-bind-test))
696936b @avodonosov Added iterate and metabang-bind.
avodonosov authored Nov 28, 2011
470
d4fc132 @avodonosov added cl-json
avodonosov authored Nov 28, 2011
471 (defmethod libtest ((library-name (eql :cl-json)))
472 ;; The test framework used: fiveam.
cf836f1 @d35h Added function pivot-report-html and done some changes in style.css
d35h authored Dec 15, 2011
473 (let ((*trace-output* *standard-output*))
8339df1 @avodonosov closes #1 quicklisp can't load test asdf systems which do not have th…
avodonosov authored Jan 6, 2012
474
475 ;; Load cl-json first, because cl-json.tests
476 ;; is defined in cl-json.asd which confuses
477 ;; quicklisp (some versions of, see issue #1)
478 (quicklisp:quickload :cl-json)
479
cf836f1 @d35h Added function pivot-report-html and done some changes in style.css
d35h authored Dec 15, 2011
480 (quicklisp:quickload :cl-json.test)
b68a220 @avodonosov Implemented extended test statuses for the FiveAM test frameworkd (us…
avodonosov authored Mar 10, 2012
481 (run-fiveam-test-suite (intern (symbol-name '#:json) :json-test))))
d4fc132 @avodonosov added cl-json
avodonosov authored Nov 28, 2011
482
0fe5b33 @avodonosov added cl-containers
avodonosov authored Nov 29, 2011
483 (defmethod libtest ((library-name (eql :cl-containers)))
484 ;; The test framework used: lift.
485 (quicklisp:quickload :cl-containers-test)
548b28e @avodonosov Extended test status for the Lift test framework (used by 7 of the 23…
avodonosov authored Mar 8, 2012
486 (run-lift-test-suite :cl-containers-test))
d4fc132 @avodonosov added cl-json
avodonosov authored Nov 28, 2011
487
5f523a0 @avodonosov added metatilities-base cl-cont
avodonosov authored Nov 29, 2011
488 (defmethod libtest ((library-name (eql :metatilities-base)))
489 ;; The test framework used: lift.
490 (quicklisp:quickload :metatilities-base-test)
548b28e @avodonosov Extended test status for the Lift test framework (used by 7 of the 23…
avodonosov authored Mar 8, 2012
491 (run-lift-test-suite :metatilities-base-test))
5f523a0 @avodonosov added metatilities-base cl-cont
avodonosov authored Nov 29, 2011
492
493 (defmethod libtest ((library-name (eql :cl-cont)))
494 ;; The test framework used: rt.
df32b14 @avodonosov clean-rt function: little shorthand for (require-impl "rt-api") (rt-a…
avodonosov authored Mar 8, 2012
495 (clean-rt)
5f523a0 @avodonosov added metatilities-base cl-cont
avodonosov authored Nov 29, 2011
496 (asdf:clear-system :cl-cont-test)
497 (quicklisp:quickload :cl-cont-test)
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
498 (run-rt-test-suite))
5f523a0 @avodonosov added metatilities-base cl-cont
avodonosov authored Nov 29, 2011
499
efd325f @avodonosov added moptilities, trivial-timeout, metatilities
avodonosov authored Nov 29, 2011
500 (defmethod libtest ((library-name (eql :moptilities)))
501 ;; The test framework used: lift.
502 (quicklisp:quickload :moptilities-test)
548b28e @avodonosov Extended test status for the Lift test framework (used by 7 of the 23…
avodonosov authored Mar 8, 2012
503 (run-lift-test-suite :moptilities-test))
efd325f @avodonosov added moptilities, trivial-timeout, metatilities
avodonosov authored Nov 29, 2011
504
505 (defmethod libtest ((library-name (eql :trivial-timeout)))
506 ;; The test framework used: lift.
507 (quicklisp:quickload :trivial-timeout-test)
548b28e @avodonosov Extended test status for the Lift test framework (used by 7 of the 23…
avodonosov authored Mar 8, 2012
508 (run-lift-test-suite :trivial-timeout-test))
efd325f @avodonosov added moptilities, trivial-timeout, metatilities
avodonosov authored Nov 29, 2011
509
510 (defmethod libtest ((library-name (eql :metatilities)))
511 ;; The test framework used: lift.
512 (quicklisp:quickload :metatilities-test)
548b28e @avodonosov Extended test status for the Lift test framework (used by 7 of the 23…
avodonosov authored Mar 8, 2012
513 (run-lift-test-suite :metatilities-test))
efd325f @avodonosov added moptilities, trivial-timeout, metatilities
avodonosov authored Nov 29, 2011
514
bdefd05 @avodonosov Added named-readtables
avodonosov authored Mar 16, 2012
515 (defmethod libtest ((library-name (eql :named-readtables)))
516 ;; test framework used: customized RT
f3c35a9 @avodonosov More reliable ql:quickload - load the main ASDF system first, then lo…
avodonosov authored Mar 28, 2012
517 (quicklisp:quickload :named-readtables)
bdefd05 @avodonosov Added named-readtables
avodonosov authored Mar 16, 2012
518 (quicklisp:quickload :named-readtables-test)
519 (funcall (intern (symbol-name '#:do-tests) '#:named-readtables-test))
520 (list :failed-tests (funcall (intern (symbol-name '#:pending-tests)
521 '#:named-readtables-test))
522 :known-to-fail nil))
523
72c750d @avodonosov Added arnesi, local-time, s-xml
avodonosov authored Mar 16, 2012
524 (defmethod libtest ((library-name (eql :arnesi)))
525 ;; test framework used: FiveAM
526 (quicklisp:quickload :arnesi)
527 (quicklisp:quickload :arnesi.test)
528 (run-fiveam-test-suite :it.bese.arnesi))
529
530 (defmethod libtest ((library-name (eql :local-time)))
531 ;; test framework used: Stefil
532 (quicklisp:quickload :local-time.test)
533 (run-stefil-test-suite (intern (string '#:test) '#:local-time.test)))
534
535 (defmethod libtest ((library-name (eql :s-xml)))
536 ;; test framework used: cl:assert
537
538 (quicklisp:quickload :s-xml)
539
540 ;; s-xml test suite uses cl:assert, and all
541 ;; the assertsions are top level, i.e. executed
09b1cb7 @avodonosov Added cl-oauth, cl-routes, cl-unicode, fiveam, trivial-utf-8, yason.
avodonosov authored Mar 18, 2012
542 ;; immediatelly during the system load
72c750d @avodonosov Added arnesi, local-time, s-xml
avodonosov authored Mar 16, 2012
543 (handler-case
544 (progn
09b1cb7 @avodonosov Added cl-oauth, cl-routes, cl-unicode, fiveam, trivial-utf-8, yason.
avodonosov authored Mar 18, 2012
545 (asdf:operate 'asdf:load-op :s-xml.test :force t)
72c750d @avodonosov Added arnesi, local-time, s-xml
avodonosov authored Mar 16, 2012
546 :ok)
547 (error (e)
548 (format t "s-xml test suite failed with error: ~A" e)
549 :fail)))
550
525ac2f @avodonosov Added trivial-shell, let-plus, data-sift, cl-num-utils, ieee-floats
avodonosov authored Mar 28, 2012
551 (defun is-windows ()
552 (intersection '(:windows :win32 :win) *features*))
553
9c701f9 @avodonosov Added iolib.
avodonosov authored Mar 17, 2012
554 (defmethod libtest ((library-name (eql :iolib)))
555 ;; test framework used: FiveAM
556
525ac2f @avodonosov Added trivial-shell, let-plus, data-sift, cl-num-utils, ieee-floats
avodonosov authored Mar 28, 2012
557 (cond ((is-windows)
558 (format t "IOLib is not implemented for Windows.~%")
9c701f9 @avodonosov Added iolib.
avodonosov authored Mar 17, 2012
559 :no-resource)
560 (t
561 (quicklisp:quickload :iolib-tests)
562 (run-fiveam-test-suite :iolib))))
563
09b1cb7 @avodonosov Added cl-oauth, cl-routes, cl-unicode, fiveam, trivial-utf-8, yason.
avodonosov authored Mar 18, 2012
564 (defmethod libtest ((library-name (eql :cl-oauth)))
565 ;; test framework used: FiveAM
566
567 (quicklisp:quickload :cl-oauth)
568
569 ;; the code is based on the method
570 ;; (defmethod asdf:perform ((o asdf:test-op) (c (eql (asdf:find-system :cl-oauth))))
571 ;; from the cl-oauth sources
572
573 (let ((request-adapter-symbol (intern (symbol-name '#:*request-adapter*) :cl-oauth))
574 (init-test-request-adapter-symbol (intern (symbol-name '#:init-test-request-adapter) :oauth-test))
575 (oauth-test-suite-symbol (intern (symbol-name '#:oauth) :oauth-test)))
576
577 (let ((original-request-adapter (symbol-value request-adapter-symbol)))
578 (unwind-protect
579 (progn
580 (funcall init-test-request-adapter-symbol)
581 (run-fiveam-test-suite oauth-test-suite-symbol))
582 (setf (symbol-value request-adapter-symbol) original-request-adapter)))))
583
584 (defmethod libtest ((library-name (eql :cl-routes)))
585 ;; The test framework used: lift.
586 (quicklisp:quickload :routes)
587 (quicklisp:quickload :routes-test)
588 ;; good way to refre symbols, thanks cl-routes
589 (run-lift-test-suite (read-from-string "routes.test::routes-test")))
590
591 (defmethod libtest ((library-name (eql :cl-unicode)))
592 ;; The test framework used: custom.
f3c35a9 @avodonosov More reliable ql:quickload - load the main ASDF system first, then lo…
avodonosov authored Mar 28, 2012
593 (quicklisp:quickload :cl-unicode)
09b1cb7 @avodonosov Added cl-oauth, cl-routes, cl-unicode, fiveam, trivial-utf-8, yason.
avodonosov authored Mar 18, 2012
594 (quicklisp:quickload :cl-unicode-test)
595 (funcall (read-from-string "cl-unicode-test:run-all-tests")))
596
597 (defmethod libtest ((library-name (eql :fiveam)))
598 ;; test framework used: FiveAM
599 (quicklisp:quickload :fiveam)
600 (run-fiveam-test-suite :it.bese.fiveam))
601
602 (defmethod libtest ((library-name (eql :trivial-utf-8)))
603 ;; test framework used: cl:assert
604
605 (quicklisp:quickload :trivial-utf-8)
606
607 ;; trivial-utf-8-tests test suite uses cl:assert, and all
608 ;; the assertsions are top level, i.e. executed
609 ;; immediatelly during the system load
610 (handler-case
611 (progn
612 (asdf:operate 'asdf:load-op :trivial-utf-8-tests :force t)
613 :ok)
614 (error (e)
615 (format t "trivial-utf-8 test suite failed with error: ~A" e)
616 :fail)))
617
618 (defmethod libtest ((library-name (eql :yason)))
619 ;; test framework used: unit-test
636123d @avodonosov Handle the package name conflict between cl-json (package :json) and …
avodonosov authored Mar 18, 2012
620
621 ;; Handle package name conflict between cl-json
622 ;; and yason: the package of cl-json is named :json,
623 ;; the package of yason is named :yason, but has
624 ;; :json as a nickname.
625
626 ;; Temporary rename the :json package if it's loaded
627 (when (and (find-package :json)
628 ;; make sure it's found not by a nickname
629 (string= :json (package-name :json)))
630 (rename-package :json :json-temp-uinuque-name))
631
09b1cb7 @avodonosov Added cl-oauth, cl-routes, cl-unicode, fiveam, trivial-utf-8, yason.
avodonosov authored Mar 18, 2012
632 (quicklisp:quickload :yason)
636123d @avodonosov Handle the package name conflict between cl-json (package :json) and …
avodonosov authored Mar 18, 2012
633 ;; it doesn't provide an ASDF system for tests,
09b1cb7 @avodonosov Added cl-oauth, cl-routes, cl-unicode, fiveam, trivial-utf-8, yason.
avodonosov authored Mar 18, 2012
634 ;; load the test framework manually, and then
635 ;; the test.lisp file.
636 (quicklisp:quickload :unit-test)
637 (let* ((yason-dir (make-pathname :name nil :type nil :defaults (ql-dist:find-asdf-system-file "yason")))
638 (yason-test-file (merge-pathnames "test.lisp" yason-dir)))
639 (format t "loading ~A~%" yason-test-file)
640 (load yason-test-file))
636123d @avodonosov Handle the package name conflict between cl-json (package :json) and …
avodonosov authored Mar 18, 2012
641
642 ;; remove nicknames from the :yason package
643 (rename-package :yason :yason nil)
644 ;; rename :json back to it's original name
645 (when (find-package :json-temp-uinuque-name)
646 (rename-package :json-temp-uinuque-name :json))
647
3c9973a @avodonosov Added cl-annot
avodonosov authored Mar 18, 2012
648 ;; now run the tests. It returns a boolean
09b1cb7 @avodonosov Added cl-oauth, cl-routes, cl-unicode, fiveam, trivial-utf-8, yason.
avodonosov authored Mar 18, 2012
649 (funcall (read-from-string "unit-test:run-all-tests") :unit :yason))
650
3c9973a @avodonosov Added cl-annot
avodonosov authored Mar 18, 2012
651 (defmethod libtest ((library-name (eql :cl-annot)))
652 ;; test framework used: cl-test-more
f4df386 @avodonosov Added ieee-floats (now really added), cl-project, trivial-http, cl-store
avodonosov authored Mar 28, 2012
653 (running-cl-test-more-suite "cl-annot"
654 #'(lambda ()
655 ;; ensure it is reloaded, even if it was already loaded before
656 (asdf:clear-system :cl-annot)
657 (asdf:clear-system :cl-annot-test)
658 (quicklisp:quickload :cl-annot-test))))
3c9973a @avodonosov Added cl-annot
avodonosov authored Mar 18, 2012
659
f5e89b9 @avodonosov Added cl-openid
avodonosov authored Mar 19, 2012
660 (defmethod libtest ((library-name (eql :cl-openid)))
661 ;; test framework used: FiveAM
662 (ql:quickload :cl-openid)
663 (ql:quickload :cl-openid.test)
664 (run-fiveam-test-suite :cl-openid))
665
b607916 @avodonosov Added split-sequence, cl-closure-template, cl-interpol, lift
avodonosov authored Mar 27, 2012
666 (defmethod libtest ((library-name (eql :split-sequence)))
667 ;; test framework used: FiveAM
f3c35a9 @avodonosov More reliable ql:quickload - load the main ASDF system first, then lo…
avodonosov authored Mar 28, 2012
668 (ql:quickload :split-sequence)
b607916 @avodonosov Added split-sequence, cl-closure-template, cl-interpol, lift
avodonosov authored Mar 27, 2012
669 (ql:quickload :split-sequence-tests)
670 (run-fiveam-test-suite :split-sequence))
671
672 (defmethod libtest ((library-name (eql :cl-closure-template)))
673 ;; The test framework used: lift.
f3c35a9 @avodonosov More reliable ql:quickload - load the main ASDF system first, then lo…
avodonosov authored Mar 28, 2012
674 (ql:quickload :closure-template)
b607916 @avodonosov Added split-sequence, cl-closure-template, cl-interpol, lift
avodonosov authored Mar 27, 2012
675 (ql:quickload :closure-template-test)
676 (run-lift-test-suite (read-from-string "closure-template.test::closure-template-test")))
677
678 (defmethod libtest ((library-name (eql :cl-interpol)))
679 ;; The test framework used: custom.
f3c35a9 @avodonosov More reliable ql:quickload - load the main ASDF system first, then lo…
avodonosov authored Mar 28, 2012
680 (ql:quickload :cl-interpol)
b607916 @avodonosov Added split-sequence, cl-closure-template, cl-interpol, lift
avodonosov authored Mar 27, 2012
681 (ql:quickload :cl-interpol-test)
682 (funcall (read-from-string "cl-interpol-test:run-all-tests")))
683
a070f22 @avodonosov Added hu.dwim.stefil, kmrcl, cxml-stp, hu.dwim.walker, hu.dwim.defcla…
avodonosov authored Mar 30, 2012
684 ;; Decided not to add Lift now.
676c0f9 @avodonosov Removed lift test suite for now - it requires some investigation/effo…
avodonosov authored Mar 29, 2012
685 ;; See coverage.org for details.
686 ;;
687 ;; (defmethod libtest ((library-name (eql :lift)))
688 ;; ;; The test framework used: lift.
689 ;; (ql:quickload :lift)
690 ;; (ql:quickload :lift-test)
691 ;; (run-lift-test-suite (read-from-string "lift-test::lift-test")))
b607916 @avodonosov Added split-sequence, cl-closure-template, cl-interpol, lift
avodonosov authored Mar 27, 2012
692
525ac2f @avodonosov Added trivial-shell, let-plus, data-sift, cl-num-utils, ieee-floats
avodonosov authored Mar 28, 2012
693 (defmethod libtest ((library-name (eql :trivial-shell)))
694 ;; The test framework used: lift.
695 (cond ((is-windows)
696 (format t "trivial-shell is not implemented for Windows.~%")
697 :no-resource)
698 (t
f3c35a9 @avodonosov More reliable ql:quickload - load the main ASDF system first, then lo…
avodonosov authored Mar 28, 2012
699 (ql:quickload :trivial-shell)
525ac2f @avodonosov Added trivial-shell, let-plus, data-sift, cl-num-utils, ieee-floats
avodonosov authored Mar 28, 2012
700 (ql:quickload :trivial-shell-test)
701 (run-lift-test-suite (read-from-string "trivial-shell-test::trivial-shell-test")))))
702
703 (defmethod libtest ((library-name (eql :let-plus)))
704 ;; The test framework used: lift.
f3c35a9 @avodonosov More reliable ql:quickload - load the main ASDF system first, then lo…
avodonosov authored Mar 28, 2012
705 (ql:quickload :let-plus)
525ac2f @avodonosov Added trivial-shell, let-plus, data-sift, cl-num-utils, ieee-floats
avodonosov authored Mar 28, 2012
706 (ql:quickload :let-plus-tests)
707 (run-lift-test-suite (read-from-string "let-plus-tests::let-plus-tests")))
708
709 (defmethod libtest ((library-name (eql :data-sift)))
710 ;; The test framework used: lift.
f3c35a9 @avodonosov More reliable ql:quickload - load the main ASDF system first, then lo…
avodonosov authored Mar 28, 2012
711 (ql:quickload :data-sift)
525ac2f @avodonosov Added trivial-shell, let-plus, data-sift, cl-num-utils, ieee-floats
avodonosov authored Mar 28, 2012
712 (ql:quickload :data-sift-test)
713 (run-lift-test-suite (read-from-string "data-sift.test::data-sift-test")))
714
715 (defmethod libtest ((library-name (eql :cl-num-utils)))
716 ;; The test framework used: lift.
f3c35a9 @avodonosov More reliable ql:quickload - load the main ASDF system first, then lo…
avodonosov authored Mar 28, 2012
717 (ql:quickload :cl-num-utils)
525ac2f @avodonosov Added trivial-shell, let-plus, data-sift, cl-num-utils, ieee-floats
avodonosov authored Mar 28, 2012
718 (ql:quickload :cl-num-utils-tests)
719 (run-lift-test-suite (read-from-string "cl-num-utils-tests::cl-num-utils-tests")))
720
f4df386 @avodonosov Added ieee-floats (now really added), cl-project, trivial-http, cl-store
avodonosov authored Mar 28, 2012
721 (defmethod libtest ((library-name (eql :ieee-floats)))
722 ;; test framework used: FiveAM
f3c35a9 @avodonosov More reliable ql:quickload - load the main ASDF system first, then lo…
avodonosov authored Mar 28, 2012
723 (ql:quickload :ieee-floats)
f4df386 @avodonosov Added ieee-floats (now really added), cl-project, trivial-http, cl-store
avodonosov authored Mar 28, 2012
724 (ql:quickload :ieee-floats-tests)
725 (run-fiveam-test-suite :ieee-floats))
726
727 (defmethod libtest ((library-name (eql :cl-project)))
728 ;; test framework used: cl-test-more
729 (running-cl-test-more-suite "cl-project"
730 #'(lambda ()
f3c35a9 @avodonosov More reliable ql:quickload - load the main ASDF system first, then lo…
avodonosov authored Mar 28, 2012
731 (ql:quickload :cl-project)
f4df386 @avodonosov Added ieee-floats (now really added), cl-project, trivial-http, cl-store
avodonosov authored Mar 28, 2012
732 (ql:quickload :cl-project-test))))
733
734 (defmethod libtest ((library-name (eql :trivial-http)))
735 ;; The test framework used: lift.
f3c35a9 @avodonosov More reliable ql:quickload - load the main ASDF system first, then lo…
avodonosov authored Mar 28, 2012
736 (ql:quickload :trivial-http)
f4df386 @avodonosov Added ieee-floats (now really added), cl-project, trivial-http, cl-store
avodonosov authored Mar 28, 2012
737 (ql:quickload :trivial-http-test)
738 (run-lift-test-suite :trivial-http-test))
739
740 (defmethod libtest ((library-name (eql :cl-store)))
741
742 ;; The test framework used: rt.
743 (clean-rt)
744 (asdf:clear-system :cl-store)
745 (asdf:clear-system :cl-store-tests)
746
747 (ql:quickload :cl-store-tests)
748
749 (run-rt-test-suite))
750
a070f22 @avodonosov Added hu.dwim.stefil, kmrcl, cxml-stp, hu.dwim.walker, hu.dwim.defcla…
avodonosov authored Mar 30, 2012
751 (defmethod libtest ((library-name (eql :hu.dwim.stefil)))
752 ;; The test framework used: stefil.
753
754 (ql:quickload :hu.dwim.stefil.test)
755 (run-stefil-test-suite (read-from-string "hu.dwim.stefil.test::test")))
756
757 (defmethod libtest ((library-name (eql :kmrcl)))
758
759 ;; The test framework used: rt.
760 (clean-rt)
761 (asdf:clear-system :kmrcl-tests)
762
763 (ql:quickload :kmrcl-tests)
764
765 (run-rt-test-suite))
766
767 (defmethod libtest ((library-name (eql :cxml-stp)))
768
769 ;; The test framework used: rt.
770 (clean-rt)
771 (asdf:clear-system :cxml-stp)
772 (asdf:clear-system :cxml-stp-test)
773
774 (ql:quickload :cxml-stp)
775 (ql:quickload :cxml-stp-test)
776
777 (run-rt-test-suite))
778
779 (defmethod libtest ((library-name (eql :hu.dwim.walker)))
780 ;; The test framework used: stefil.
781 (ql:quickload :hu.dwim.walker.test)
782 (run-stefil-test-suite (read-from-string "hu.dwim.walker.test::test")))
783
784 (defmethod libtest ((library-name (eql :hu.dwim.defclass-star)))
785 ;; The test framework used: stefil.
786 (ql:quickload :hu.dwim.defclass-star.test)
787 (run-stefil-test-suite (read-from-string "hu.dwim.defclass-star.test::test")))
788
789 (defmethod libtest ((library-name (eql :bknr.datastore)))
790 ;; test framework used: FiveAM
791 (ql:quickload :bknr.datastore)
792 (ql:quickload :bknr.datastore.test)
793 (run-fiveam-test-suite :bknr.datastore))
794
795 (defmethod libtest ((library-name (eql :yaclml)))
796 ;; test framework used: FiveAM
797 (ql:quickload :yaclml)
798 (ql:quickload :yaclml.test)
799 (run-fiveam-test-suite :it.bese.yaclml))
800
801 (defmethod libtest ((library-name (eql :com.google.base)))
802 ;; The test framework used: stefil.
803 (ql:quickload :com.google.base-test)
804 (run-stefil-test-suite (read-from-string "com.google.base-test::test-base")))
805
806 (defmethod libtest ((library-name (eql :external-program)))
807 ;; test framework used: FiveAM
808 (when (is-windows)
809 (format t "The external-program test suite uses unix shell commands, like cd, which, and therefor can not be tested on Windows.")
810 (return-from libtest :no-resource))
811 (ql:quickload :external-program)
812 (ql:quickload :external-program-test)
813 (run-fiveam-test-suite (read-from-string "external-program-tests::tests")))
814
815 ;; see coverage.org for details why weblocks is not included into the test grid
816 ;;
817 ;; (defmethod libtest ((library-name (eql :weblocks)))
818 ;; ;; The test framework used: lift.
819 ;;
820 ;; (when (find-package :yason)
821 ;; (warn "Deleting package :yason and ASDF system :yason because weblocks depends on cl-json and cl-json has a package name conflict with yason (cl-json main package name is :json, and yason has nickname :json")
822 ;; (delete-package :yason)
823 ;; (asdf:clear-system :yason))
824 ;;
825 ;; (ql:quickload :weblocks-test)
826 ;; (ql:quickload :weblocks-store-test)
827 ;;
828 ;; (combine-extended-libresult (run-lift-test-suite :weblocks-suite)
829 ;; (run-lift-test-suite :store-suite)))
830
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored Nov 18, 2011
831 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
832 ;; Utils
833 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4ca87d1 @avodonosov Support extended test status in reports. Add the tests to git. Better…
avodonosov authored Feb 13, 2012
834
835 (defun set= (set-a set-b &key (test #'eql) key)
836 (null (set-exclusive-or set-a set-b :test test :key key)))
837
3c9973a @avodonosov Added cl-annot
avodonosov authored Mar 18, 2012
838 (defun starts-with (str prefix &key (test #'char=))
839 (let ((mismatch (mismatch str prefix :test test)))
840 (or (null mismatch)
841 (>= mismatch (length prefix)))))
842
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored Nov 18, 2011
843 (defun do-plist-impl (plist handler)
844 (do* ((cur-pos plist (cddr cur-pos))
845 (prop (first cur-pos) (first cur-pos))
846 (val (second cur-pos) (second cur-pos)))
847 ((null prop))
848 (funcall handler prop val)))
849
850 (defmacro do-plist ((key val plist &optional result) &body body)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
851 `(block nil
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored Nov 18, 2011
852 (do-plist-impl ,plist (lambda (,key ,val) ,@body))
853 ,result))
854
855 (defun plist-comparator (&rest props-and-preds)
856 (lambda (plist-a plist-b)
857 (do-plist (prop pred props-and-preds)
858 ;; iterate over all the property/predicate pairs
859 ;; "compare" the values of the current property
860 ;; in both plists
861 (let ((val-a (getf plist-a prop))
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
862 (val-b (getf plist-b prop)))
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored Nov 18, 2011
863 (if (funcall pred val-a val-b)
864 (return t))
865 ;; Ok, val-a is not less than val-b (as defined by our predicate).
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
866 ;; Lets check if they are equal. If the reverse comparation [val-b less val-a]
867 ;; is also false, then they are equal, and we proceed to the next
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored Nov 18, 2011
868 ;; property/predicate pair.
869 (when (funcall pred val-b val-a)
870 (return nil))))))
871
872 ;; examples:
873 #|
874 (let ((less (plist-comparator :a '< :b 'string<)))
875 (and (funcall less '(:a 1 :b "x") '(:a 2 :b "y"))
876 (funcall less '(:a 2 :b "x") '(:a 2 :b "y"))
877 (not (funcall less '(:a 3 :b "x") '(:a 2 :b "y")))))
878
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
879 (equalp
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored Nov 18, 2011
880 (sort '((:a 1 :b "x")
881 (:a 2 :b "y")
882 (:a 2 :b "y")
883 (:a 3 :b "z"))
884 (plist-comparator :a '< :b 'string<))
885 '((:A 1 :B "x") (:A 2 :B "y") (:A 2 :B "y") (:A 3 :B "z")))
886 |#
887
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored Nov 19, 2011
888 (defun getter (prop)
889 #'(lambda (plist)
890 (getf plist prop)))
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored Nov 18, 2011
891
fa1c4e1 @avodonosov Pivot reports. First working version; no comments, data cell is rende…
avodonosov authored Nov 24, 2011
892 (defun list< (predicates l1 l2)
893 "Compares two lists L1 and L2 of equal lenght,
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
894 using for every pair of elements a corresponding predicate
fa1c4e1 @avodonosov Pivot reports. First working version; no comments, data cell is rende…
avodonosov authored Nov 24, 2011
895 from the PREDICATES list (of the same length). Returns
896 T if L1 is less than (according the PREDICATES) L2.
897 Othersise returns NIL."
898 (if (null predicates)
899 nil
900 (let ((pred (car predicates))
901 (elem1 (car l1))
902 (elem2 (car l2)))
903 (if (funcall pred elem1 elem2)
904 t
905 ;; Ok, elem1 is not less than elem2 (as defined by our predicate).
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
906 ;; Lets check if they are equal. If the reverse comparation [elem2 less elem1]
907 ;; is also false, then they are equal, and we proceed to the next
fa1c4e1 @avodonosov Pivot reports. First working version; no comments, data cell is rende…
avodonosov authored Nov 24, 2011
908 ;; property/predicate pair.
909 (if (funcall pred elem2 elem1)
910 nil
911 (list< (cdr predicates)
912 (cdr l1)
913 (cdr l2)))))))
914
915 #|
916 Examples:
917
918 (and
919 (list< '(< <) '(1 2) '(2 2))
920 (not (list< '(< <) '(1 2) '(1 2)))
921 (list< '(< <) '(1 2) '(1 3))
922 (not (list< '(string< string<)
923 '("quicklisp-fake-2011-00-02" "ccl-fake-1")
924 '("quicklisp-fake-2011-00-01" "clisp-fake-1"))))
925 |#
926
927 (defun hash-table-keys (hash-table)
928 (let (keys)
929 (maphash #'(lambda (key val)
930 (declare (ignore val))
931 (push key keys))
932 hash-table)
933 keys))
934
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
935 ;; copy/paste from
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored Nov 18, 2011
936 ;; http://www.gigamonkeys.com/book/practical-an-mp3-browser.html
937 (defmacro with-safe-io-syntax (&body body)
938 `(with-standard-io-syntax
939 (let ((*read-eval* nil))
940 ,@body)))
941
942 (defun safe-read (&rest args)
943 (with-safe-io-syntax (apply #'read args)))
944
945 (defun safe-read-file (file)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
946 (with-open-file (in file
947 :direction :input
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored Nov 18, 2011
948 :element-type 'character ;'(unsigned-byte 8) + flexi-stream
949 )
950 (safe-read in)))
951
4de1294 @avodonosov Order of definitions: functon run-libtest is placed into the section …
avodonosov authored Jan 10, 2012
952 (defun write-to-file (obj file)
953 "Write to file the lisp object OBJ in a format acceptable to READ."
954 (with-open-file (out file
955 :direction :output
956 :if-exists :supersede
957 :if-does-not-exist :create)
958 (pprint obj out))
959 obj)
960
100ff20 @avodonosov Protect the function file-string from the bug on some lisps when the …
avodonosov authored Dec 28, 2011
961 ;; based on
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored Nov 18, 2011
962 ;; http://cl-user.net/asp/-1MB/sdataQ0mpnsnLt7msDQ3YNypX8yBX8yBXnMq=/sdataQu3F$sSHnB==
a305081 @avodonosov Library logs are writted directly to file, without intermediate buffe…
avodonosov authored Jan 10, 2012
963 ;; but fixed in respect to file-length returing file length in bytes
100ff20 @avodonosov Protect the function file-string from the bug on some lisps when the …
avodonosov authored Dec 28, 2011
964 ;; instead of characters (and violating the spec therefore) at least
965 ;; on CLISP 2.49 and ABCL 1.0.0.
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored Nov 18, 2011
966 (defun file-string (path)
967 "Sucks up an entire file from PATH into a freshly-allocated string,
968 returning two values: the string and the number of bytes read."
969 (with-open-file (s path)
970 (let* ((len (file-length s))
100ff20 @avodonosov Protect the function file-string from the bug on some lisps when the …
avodonosov authored Dec 28, 2011
971 (data (make-string len))
972 (char-len (read-sequence data s)))
ad58dfd @avodonosov Protect the function file-string from the bug on some lisps when the …
avodonosov authored Dec 29, 2011
973 (if (> len char-len)
100ff20 @avodonosov Protect the function file-string from the bug on some lisps when the …
avodonosov authored Dec 28, 2011
974 (setf data (subseq data 0 char-len)))
975 data)))
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored Nov 18, 2011
976
a305081 @avodonosov Library logs are writted directly to file, without intermediate buffe…
avodonosov authored Jan 9, 2012
977 (defun file-byte-length (path)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
978 (with-open-file (s path
a305081 @avodonosov Library logs are writted directly to file, without intermediate buffe…
avodonosov authored Jan 9, 2012
979 :direction :input
980 :element-type '(unsigned-byte 8))
981 (file-length s)))
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
982
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored Nov 18, 2011
983 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1195d22 @avodonosov Fix the last merge
avodonosov authored Nov 19, 2011
984 ;; Settings
985 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
0f16035 @d35h fixed return value of function get-user-email
d35h authored Nov 20, 2011
986
7ab53d9 @avodonosov Use defparameter instead of defconstant for +settings-file-name+ beca…
avodonosov authored Jan 3, 2012
987 (defparameter +settings-file-name+ "cl-test-grid-settings.lisp")
4b4ed04 @avodonosov When asking user for email, explain him more carefully how the email …
avodonosov authored Dec 31, 2011
988
1195d22 @avodonosov Fix the last merge
avodonosov authored Nov 18, 2011
989 (defun get-settings-file()
4b4ed04 @avodonosov When asking user for email, explain him more carefully how the email …
avodonosov authored Dec 30, 2011
990 (merge-pathnames (user-homedir-pathname) +settings-file-name+))
1195d22 @avodonosov Fix the last merge
avodonosov authored Nov 18, 2011
991
992 (defun prompt-for-email ()
4b4ed04 @avodonosov When asking user for email, explain him more carefully how the email …
avodonosov authored Dec 30, 2011
993 (format *query-io* "~&~%")
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
994 (format *query-io* "Please enter your email so that we know who is submitting the test results.~%")
4b4ed04 @avodonosov When asking user for email, explain him more carefully how the email …
avodonosov authored Dec 30, 2011
995 (format *query-io* "Also the email will be published in the online reports, and the library~%")
996 (format *query-io* "authors can later contact you in case of questions about this test run, ~%")
997 (format *query-io* "your environment, etc.~%~%")
998
e350d23 @avodonosov Suggest user to enter some nickname in case doesn't want to provide e…
avodonosov authored Jan 3, 2012
999 (format *query-io* "If you are strongly opposed to publishing you email, please type e.g. some nickname or just \"none\".~%~%")
4b4ed04 @avodonosov When asking user for email, explain him more carefully how the email …
avodonosov authored Dec 30, 2011
1000
1001 (format *query-io* "The value you enter will be saved and reused in the future. You can change~%")
1002 (format *query-io* "it in the file ~A in your home directory.~%~%" +settings-file-name+)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1003
4b4ed04 @avodonosov When asking user for email, explain him more carefully how the email …
avodonosov authored Dec 30, 2011
1004 (format *query-io* "email: ")
1005
8d47120 @d35h fixed text formatting
d35h authored Nov 28, 2011
1006 (force-output *query-io*)
1007 (string-trim " " (read-line *query-io*)))
1195d22 @avodonosov Fix the last merge
avodonosov authored Nov 18, 2011
1008
e2fbbf3 @d35h fixed function name get-user-email and now it returns user email
d35h authored Nov 19, 2011
1009 (defun get-user-email ()
8d47120 @d35h fixed text formatting
d35h authored Nov 28, 2011
1010 (let ((user-email nil))
0f16035 @d35h fixed return value of function get-user-email
d35h authored Nov 20, 2011
1011 (handler-case
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1012 (progn
1013 (setf user-email (getf (safe-read-file (get-settings-file))
4b4ed04 @avodonosov When asking user for email, explain him more carefully how the email …
avodonosov authored Dec 30, 2011
1014 :user-email))
1015 (if (zerop (length user-email))
1016 (warn "Empty email is specified in the settings file ~a~%" (get-settings-file))))
1017 (file-error ()
7b70188 @d35h fixed text formatting
d35h authored Nov 30, 2011
1018 (progn
4b4ed04 @avodonosov When asking user for email, explain him more carefully how the email …
avodonosov authored Dec 30, 2011
1019 (setf user-email (prompt-for-email))
1020 (write-to-file (list :user-email user-email)
8d47120 @d35h fixed text formatting
d35h authored Nov 28, 2011
1021 (get-settings-file)))))
1022 user-email))
0f16035 @d35h fixed return value of function get-user-email
d35h authored Nov 20, 2011
1023
1195d22 @avodonosov Fix the last merge
avodonosov authored Nov 18, 2011
1024 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored Nov 18, 2011
1025 ;; Test Runs
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
1026 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1027
1028 (defun run-descr (run)
1029 "The description part of the test run."
c023819 @avodonosov test run as plist (:descr <descr> :run-results <run-results>) instead…
avodonosov authored Nov 19, 2011
1030 (getf run :descr))
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1031
1032 (defun run-results (run)
1033 "The list of test suite statuses for every library in the specified test run."
c023819 @avodonosov test run as plist (:descr <descr> :run-results <run-results>) instead…
avodonosov authored Nov 19, 2011
1034 (getf run :results))
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1035
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored Nov 18, 2011
1036 (defun (setf run-results) (new-run-results test-run)
c023819 @avodonosov test run as plist (:descr <descr> :run-results <run-results>) instead…
avodonosov authored Nov 19, 2011
1037 (setf (getf test-run :results) new-run-results))
1038
1039 (defun make-run (description lib-results)
1040 (list :descr description :results lib-results))
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored Nov 18, 2011
1041
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1042 (defun fmt-time (universal-time &optional destination)
1043 "The preferred time format used in the cl-test-grid project."
1044 (multiple-value-bind (sec min hour date month year)
1045 (decode-universal-time universal-time 0)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1046 (funcall #'format
1047 destination
1048 "~2,'0D~2,'0D~2,'0D~2,'0D~2,'0D~2,'0D"
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1049 year month date hour min sec)))
1050
0a04998 @avodonosov Clarified a little bit more the comment about why hunchentoot is not …
avodonosov authored Nov 27, 2011
1051 (defun pretty-fmt-time (universal-time &optional destination)
1052 "The human-readable time format, used in reports."
1053 (multiple-value-bind (sec min hour date month year)
1054 (decode-universal-time universal-time 0)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1055 (funcall #'format
1056 destination
1057 "~2,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D:~2,'0D"
0a04998 @avodonosov Clarified a little bit more the comment about why hunchentoot is not …
avodonosov authored Nov 27, 2011
1058 year month date hour min sec)))
1059
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1060 (defun make-run-descr ()
1061 "Generate a description for a test run which might be
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1062 performed in the current lisp system."
1063 (list :lisp (asdf::implementation-identifier)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1064 :lib-world (format nil "quicklisp ~A"
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1065 (ql-dist:version (ql-dist:dist "quicklisp")))
1066 :time (get-universal-time)
1067 :run-duration :unknown
0f16035 @d35h fixed return value of function get-user-email
d35h authored Nov 20, 2011
1068 :contact (list :email (get-user-email))))
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1069
1070 (defun name-run-directory (run-descr)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1071 "Generate name for the directory where test run
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1072 data (libraries test suites output and the run results) will be saved."
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1073 (format nil
1074 "~A-~A"
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1075 (fmt-time (getf run-descr :time))
1076 (getf run-descr :lisp)))
1077
1078 (defun test-output-base-dir ()
1079 (merge-pathnames "test-runs/"
1080 test-grid-config:*src-base-dir*))
1081
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1082 (defun run-directory (run-descr)
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1083 (merge-pathnames (make-pathname
1084 :directory (list :relative (name-run-directory run-descr))
1085 :name nil
1086 :type nil)
1087 (test-output-base-dir)))
1088
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored Nov 18, 2011
1089 (defun lib-log-file (test-run-directory lib-name)
1090 (merge-pathnames (string-downcase lib-name)
1091 test-run-directory))
1092
4de1294 @avodonosov Order of definitions: functon run-libtest is placed into the section …
avodonosov authored Jan 9, 2012
1093 (defun print-log-header (libname run-descr stream)
1094 (let ((*print-case* :downcase) (*print-pretty* nil))
1095 (format stream "============================================================~%")
1096 (format stream " cl-test-grid test run~%")
1097 (format stream "------------------------------------------------------------~%")
1098 (format stream " library: ~A~%" libname)
1099 (format stream " lib-world: ~A~%" (getf run-descr :lib-world))
1100 (format stream " lisp: ~A~%" (getf run-descr :lisp))
1101 (format stream " *features*: ~A~%" (sort (copy-list *features*) #'string<))
1102 (format stream " contributor email: ~A~%" (getf (getf run-descr :contact) :email))
1103 (format stream " timestamp: ~A~%" (pretty-fmt-time (get-universal-time)))
1104 (format stream "============================================================~%~%")))
1105
1106 (defun print-log-footer (libname status stream)
1107 (let ((*print-case* :downcase))
1108 (fresh-line stream)
1109 (terpri stream)
1110 (format stream "============================================================~%")
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1111 (format stream " cl-test-grid status for ~A: ~A~%"
75246f4 @avodonosov Better formating of the test status in the test log: test names are s…
avodonosov authored Feb 16, 2012
1112 libname (print-test-status nil status))
4de1294 @avodonosov Order of definitions: functon run-libtest is placed into the section …
avodonosov authored Jan 9, 2012
1113 (format stream "============================================================~%")))
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1114
4de1294 @avodonosov Order of definitions: functon run-libtest is placed into the section …
avodonosov authored Jan 9, 2012
1115 (defun run-libtest (lib run-descr log-directory)
1116 (let (status
1117 (log-file (lib-log-file log-directory lib))
1118 (start-time (get-internal-real-time)))
1119 (with-open-file (log-stream log-file
1120 :direction :output
1121 :if-exists :overwrite
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
1122 :if-does-not-exist :create)
4de1294 @avodonosov Order of definitions: functon run-libtest is placed into the section …
avodonosov authored Jan 9, 2012
1123 (let* ((orig-std-out *standard-output*)
1124 (*standard-output* log-stream)
1125 (*error-output* log-stream))
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1126
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
1127 (format orig-std-out
4de1294 @avodonosov Order of definitions: functon run-libtest is placed into the section …
avodonosov authored Jan 9, 2012
1128 "Running tests for ~A. *STANDARD-OUTPUT* and *ERROR-OUTPUT* are redirected.~%"
1129 lib)
1130 (finish-output orig-std-out)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1131
4de1294 @avodonosov Order of definitions: functon run-libtest is placed into the section …
avodonosov authored Jan 9, 2012
1132 (print-log-header lib run-descr *standard-output*)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1133
4de1294 @avodonosov Order of definitions: functon run-libtest is placed into the section …
avodonosov authored Jan 9, 2012
1134 (setf status (handler-case
1135 (normalize-status (libtest lib))
1136 (serious-condition (condition) (progn
1137 (format t
1138 "~&Unhandled SERIOUS-CONDITION is signaled: ~A~%"
1139 condition)
1140 :fail))))
1141 (print-log-footer lib status *standard-output*)))
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1142
4de1294 @avodonosov Order of definitions: functon run-libtest is placed into the section …
avodonosov authored Jan 9, 2012
1143 (list :libname lib
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
1144 :status status
1145 :log-byte-length (file-byte-length log-file)
1146 :test-duration (/ (- (get-internal-real-time) start-time)
4de1294 @avodonosov Order of definitions: functon run-libtest is placed into the section …
avodonosov authored Jan 9, 2012
1147 internal-time-units-per-second))))
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1148
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored Nov 18, 2011
1149 (defun run-info-file (test-run-directory)
1150 (merge-pathnames "test-run-info.lisp"
1151 test-run-directory))
1152
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1153 (defun save-run-info (test-run directory)
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored Nov 18, 2011
1154 (let ((run-file (run-info-file directory)))
7ce3876 @avodonosov Pretty format the test-run-info.lisp file (when saving to file system…
avodonosov authored Feb 28, 2012
1155 (with-open-file (out run-file
1156 :direction :output
1157 :element-type 'character ;'(unsigned-byte 8) + flexi-stream
1158 :if-exists :supersede
1159 :if-does-not-exist :create)
1160 (print-test-run out test-run))))
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored Nov 18, 2011
1161
1162 (defun gae-blobstore-dir ()
1163 (merge-pathnames "gae-blobstore/lisp-client/" test-grid-config:*src-base-dir*))
1164
1165 (defparameter *gae-blobstore-base-url* "http://cl-test-grid.appspot.com")
1166
1167 (defun get-blobstore ()
1168 (pushnew (truename (gae-blobstore-dir)) asdf:*central-registry* :test #'equal)
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored Nov 18, 2011
1169 (ql:quickload '#:test-grid-gae-blobstore)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1170 (funcall (intern (string '#:make-blob-store) '#:test-grid-gae-blobstore)
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored Nov 18, 2011
1171 :base-url *gae-blobstore-base-url*))
1172
a4716b7 @avodonosov submit the test run info to the server.
avodonosov authored Dec 17, 2011
1173 (defun submit-logs (blobstore test-run-dir)
1174 (let* ((run-info (safe-read-file (run-info-file test-run-dir)))
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored Nov 19, 2011
1175 ;; prepare parameters for the SUBMIT-FILES blobstore function
1176 (submit-params (mapcar #'(lambda (lib-result)
1177 (let ((libname (getf lib-result :libname)))
1178 (cons libname
1179 (lib-log-file test-run-dir libname))))
1180 (run-results run-info))))
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1181 ;; submit files to the blobstore and receive
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored Nov 19, 2011
1182 ;; their blobkeys in response
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1183 (let ((libname-to-blobkey-alist
1184 (test-grid-blobstore:submit-files blobstore
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored Nov 19, 2011
1185 submit-params)))
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored Nov 18, 2011
1186 ;; Now store the blobkeys for every library in the run-info.
1187 ;; Note, we destructively modify parts of the previously
1188 ;; read run-info.
1189 (flet ((get-blob-key (lib)
1190 (or (cdr (assoc lib libname-to-blobkey-alist))
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored Nov 19, 2011
1191 (error "blobstore didn't returned blob key for the log of the ~A libary" lib))))
1192 (setf (run-results run-info)
1193 (mapcar #'(lambda (lib-result)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1194 (setf (getf lib-result :log-blob-key)
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored Nov 19, 2011
1195 (get-blob-key (getf lib-result :libname)))
1196 lib-result)
1197 (run-results run-info))))
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1198 ;; finally, save the updated run-info with blobkeys
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored Nov 19, 2011
1199 ;; to the file. Returns the run-info.
dfb4f65 @avodonosov Fix bug in test results submittions (due to recently introduced prett…
avodonosov authored Mar 6, 2012
1200 (save-run-info run-info test-run-dir)
1201 run-info)))
a4716b7 @avodonosov submit the test run info to the server.
avodonosov authored Dec 17, 2011
1202
1203 (defun submit-results (test-run-dir)
1204 (let* ((blobstore (get-blobstore))
1205 (run-info (submit-logs blobstore test-run-dir)))
1206 (format t "The log files are submitted. Submitting the test run info...~%")
1207 (test-grid-blobstore:submit-run-info blobstore run-info)
1208 (format t "Done. The test results are submitted. They will be reviewed by admin soon and added to the central database.~%")
1209 run-info))
a305081 @avodonosov Library logs are writted directly to file, without intermediate buffe…
avodonosov authored Jan 9, 2012
1210
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1211 (defun run-libtests (&optional (libs *all-libs*))
1212 (let* ((run-descr (make-run-descr))
1213 (run-dir (run-directory run-descr))
1214 (lib-results))
1215 (ensure-directories-exist run-dir)
1216 (dolist (lib libs)
a305081 @avodonosov Library logs are writted directly to file, without intermediate buffe…
avodonosov authored Jan 9, 2012
1217 (let ((lib-result (run-libtest lib run-descr run-dir)))
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored Nov 19, 2011
1218 (push lib-result lib-results)))
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1219 (setf (getf run-descr :run-duration)
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1220 (- (get-universal-time)
1221 (getf run-descr :time)))
c023819 @avodonosov test run as plist (:descr <descr> :run-results <run-results>) instead…
avodonosov authored Nov 19, 2011
1222 (let ((run (make-run run-descr lib-results)))
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1223 (save-run-info run run-dir)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1224 (format t "The test results were saved to this directory: ~%~A.~%"
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored Nov 19, 2011
1225 (truename run-dir))
38eb9ab @avodonosov Separate test runner and results submission to avoid submitting resul…
avodonosov authored Feb 14, 2012
1226 run-dir)))
1227
1228 (defun submit-test-run (test-run-dir)
1229 (format t "~%Submitting the test results to the server...~%")
1230 (handler-case (submit-results test-run-dir)
1231 (error (e) (format t "Error occured while uploading the test results to the server: ~A: ~A.
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1232 Please submit manually the full content of the results directory
1195d22 @avodonosov Fix the last merge
avodonosov authored Nov 18, 2011
1233 ~A
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1234 to the cl-test-grid issue tracker:
1195d22 @avodonosov Fix the last merge
avodonosov authored Nov 18, 2011
1235 https://github.com/cl-test-grid/cl-test-grid/issues~%"
38eb9ab @avodonosov Separate test runner and results submission to avoid submitting resul…
avodonosov authored Feb 14, 2012
1236 (type-of e)
1237 e
1238 (truename test-run-dir))))
1239 (format t "~%Thank you for the participation!~%"))
efe7ab8 @d35h added function get-user-email. reads from file if file is absent then…
d35h authored Nov 18, 2011
1240
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1241 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1242 ;; Database
1243 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1244 (defparameter *db* '(:version 0 :runs ()))
1245
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1246 (defvar *standard-db-file*
1247 (merge-pathnames "db.lisp"
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1248 test-grid-config:*src-base-dir*))
1249
1250 (defun add-run (run-info &optional (db *db*))
1251 (push run-info (getf db :runs)))
1252
f96b3bd @avodonosov The names of failed tests and known to fail tests are represented as …
avodonosov authored Feb 12, 2012
1253 (defun print-list-elements (destination list separator elem-printer)
9f304a6 @avodonosov print-list-elements: use the maybe-comma pattern
avodonosov authored Feb 5, 2012
1254 (let ((maybe-separator ""))
94d8414 @avodonosov Intermediate version of save-db
avodonosov authored Feb 5, 2012
1255 (dolist (elem list)
f96b3bd @avodonosov The names of failed tests and known to fail tests are represented as …
avodonosov authored Feb 12, 2012
1256 (format destination maybe-separator)
919fccf @avodonosov save-db: more simple and traditional parammeter passing to print-list…
avodonosov authored Feb 5, 2012
1257 (funcall elem-printer elem)
9f304a6 @avodonosov print-list-elements: use the maybe-comma pattern
avodonosov authored Feb 5, 2012
1258 (setf maybe-separator separator))))
94d8414 @avodonosov Intermediate version of save-db
avodonosov authored Feb 5, 2012
1259
f96b3bd @avodonosov The names of failed tests and known to fail tests are represented as …
avodonosov authored Feb 12, 2012
1260 (defun print-list (destination list separator elem-printer)
1261 (format destination "(")
1262 (print-list-elements destination list separator elem-printer)
1263 (format destination ")"))
1264
1265 (defun print-test-status (destination status)
1266 (etypecase status
1267 (symbol (format destination "~s" status))
1268 (list (progn
1269 (let ((dest (or destination (make-string-output-stream))))
1270 (flet ((test-name-printer (test-name)
1271 (format dest "~s" test-name)))
1272 (format dest "(:failed-tests ")
1273 (print-list dest (sort (copy-list (getf status :failed-tests))
1274 #'string<)
1275 " " #'test-name-printer)
1276 (format dest " :known-to-fail ")
1277 (print-list dest (sort (copy-list (getf status :known-to-fail))
1278 #'string<)
1279 " " #'test-name-printer)
1280 (format dest ")"))
1281 (if (null destination)
1282 (get-output-stream-string dest)
1283 nil))))))
1284
7ce3876 @avodonosov Pretty format the test-run-info.lisp file (when saving to file system…
avodonosov authored Feb 28, 2012
1285 (defun print-test-run (out test-run &optional (indent 0))
1286 (let ((descr (getf test-run :descr)))
1287 (format out
1288 "(:descr (:lisp ~s :lib-world ~s :time ~s :run-duration ~s :contact (:email ~s))~%"
1289 (getf descr :lisp)
1290 (getf descr :lib-world)
1291 (getf descr :time)
1292 (getf descr :run-duration)
1293 (getf (getf descr :contact) :email)))
c9a6888 @avodonosov Pretty format the test-run-info.lisp file (when saving to file system…
avodonosov authored Feb 29, 2012
1294 (format out "~v,0t:results (" (1+ indent))
7ce3876 @avodonosov Pretty format the test-run-info.lisp file (when saving to file system…
avodonosov authored Feb 28, 2012
1295 (print-list-elements out
1296 (sort (copy-list (getf test-run :results))
1297 #'string<
1298 :key #'(lambda (lib-result)
1299 (getf lib-result :libname)))
c9a6888 @avodonosov Pretty format the test-run-info.lisp file (when saving to file system…
avodonosov authored Feb 29, 2012
1300 (format nil "~~%~~~Dt" (+ indent 11))
7ce3876 @avodonosov Pretty format the test-run-info.lisp file (when saving to file system…
avodonosov authored Feb 28, 2012
1301 #'(lambda (lib-result)
1302 (format out
1303 "(:libname ~s :status ~a :test-duration ~s :log-byte-length ~s :log-blob-key ~s)"
1304 (getf lib-result :libname)
1305 (print-test-status nil (getf lib-result :status))
1306 (getf lib-result :test-duration)
1307 (getf lib-result :log-byte-length)
1308 (getf lib-result :log-blob-key))))
1309 (format out "))"))
1310
85e3774 @avodonosov Store the reports generated in the repository, in the directory repor…
avodonosov authored Nov 19, 2011
1311 (defun save-db (&optional (db *db*) (stream-or-path *standard-db-file*))
63b3e7e @avodonosov The result for test suites based on the RT framework include list of …
avodonosov authored Feb 12, 2012
1312 (with-open-file (out stream-or-path
1313 :direction :output
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1314 :element-type 'character ;'(unsigned-byte 8) + flexi-stream
94d8414 @avodonosov Intermediate version of save-db
avodonosov authored Feb 5, 2012
1315 :if-exists :supersede
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1316 :if-does-not-exist :create)
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1317 (format out "(:version ~a~%" (getf db :version))
e72feb9 @avodonosov save-db: fix indentation of the DB
avodonosov authored Feb 5, 2012
1318 (format out " :runs (")
7ce3876 @avodonosov Pretty format the test-run-info.lisp file (when saving to file system…
avodonosov authored Feb 28, 2012
1319 (print-list-elements out
1320 (getf db :runs)
1321 "~%~8t"
1322 #'(lambda (test-run)
c9a6888 @avodonosov Pretty format the test-run-info.lisp file (when saving to file system…
avodonosov authored Feb 29, 2012
1323 (print-test-run out test-run 8)))
85871ba in function save-db added formatting db.lisp's sturcture
unknown authored Jan 3, 2012
1324 (format out "))")))
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1325
1326 (defun read-db (&optional (stream-or-path *standard-db-file*))
2febb87 @avodonosov Delete trailing whitespaces from the code.
avodonosov authored Feb 25, 2012
1327 (with-open-file (in stream-or-path
1328 :direction :input
5be7639 @avodonosov first commit
avodonosov authored Nov 14, 2011
1329 :element-type 'character ;'(unsigned-byte 8) + flexi-stream
1330 )
1331 (safe-read in)))
1332
Something went wrong with that request. Please try again.