Skip to content

HTTPS clone URL

Subversion checkout URL

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