Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 1142 lines (985 sloc) 43.836 kB
5be7639 @avodonosov first commit
avodonosov authored
1 (defpackage #:test-grid (:use :cl))
2
3 (in-package #:test-grid)
4
5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6
7 #|
8
9 TODO:
10 - information about test run:
11 + lisp-version-string,
12 + lib-world,
13 - author contact (get it from some settings file),
14 + date,
15 + run-duration
16 + organize database file format
17 + better decision for library name representation.
18 This representation is used in the:
19 - libtest method parameter (eql specialized)
20 - in the database and testrun datastructure.
21 Possible alternatives:
22 a keyword
23 good for READ (package independent),
24 good for EQL specializer
25 good for GETF when working with the database
26 a symbol from the test-grid package
27 - good for EQL specializer
28 - package dependent in READ
29 - good for GETF when working with the database
30 - adds one more (unnecessary) way to represent a library
31 in addition the specified for ASDF and Quicklisp
32 or a downcased string
33 - needs special handling in libtest eql specialization
34 - good ro READ (package independent)
35 - needs care to work with GETF when working with the database
06cb006 @avodonosov fixed some typos in the TODO comment
avodonosov authored
36 + Generate a sufficiently large database so that we can
5be7639 @avodonosov first commit
avodonosov authored
37 evaluate our reporting solution. We may generate
06cb006 @avodonosov fixed some typos in the TODO comment
avodonosov authored
38 fake test results programmatically to make this task
5be7639 @avodonosov first commit
avodonosov authored
39 easier.
40 - simpliest reporting to allow overview of library test statuses
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored
41 - Test Runs report: every test run as a row in a table
5be7639 @avodonosov first commit
avodonosov authored
42 + legend or a tooltip in the report for test statuses
43 + color for statuses
ec59872 @avodonosov TODO comment about finalizing the terminology about our main data obj…
avodonosov authored
44 + use the online blob URL in the report
fa1c4e1 @avodonosov Pivot reports. First working version; no comments, data cell is rende…
avodonosov authored
45 - A pivot -like table report of library test results, allowing
95e993b @avodonosov updated the main TODO comment.
avodonosov authored
46 rows/columns to be any of quicklisp distro, lisp version
47 library name. With grouping and sorging.
48 + CSV export of the database to use it then with spreadsheets,
49 google fusion tables, etc. Initial intent
50 was to format it as a pivot for various projections
51 (by quicklisp releases, by platform, etc).
52 But neither google docs spreadsheet, nor google fusion
53 table allow as to format results as we want
54 (the main problem, it is impossible to use
55 a custom aggregation function for pivot
56 cells, because standard aggregation functions
57 are numeric, but we want a report cell
58 to represent test result(s) for a particular
59 library, i.e. :ok, :fail, :no-resource).
5be7639 @avodonosov first commit
avodonosov authored
60 5h
06cb006 @avodonosov fixed some typos in the TODO comment
avodonosov authored
61 - an informer which may be embedded into a library
62 project page, with reports about the test statuses
5be7639 @avodonosov first commit
avodonosov authored
63 for this single library on various platforms with
64 various quicklisp versions
65 - simple UI (command line) with guiding messages
66 for the user who runs the tests. Spend as little
67 efforts as possible on this task, to release quickly.
68 4h
69 - readme with explanation of the project goal and
70 how to use it
71 5h
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored
72 - change db format
c023819 @avodonosov test run as plist (:descr <descr> :run-results <run-results>) instead…
avodonosov authored
73 + test run as plist (:descr <descr> :run-results <run-results>)
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored
74 instead of just (<descr> <run-results>)
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored
75 + run-results as a list instead of plist; libname
76 which was a plist key is now a property of the lib-result
77 object. It is more convenient for standard mapping functions,
78 instead of current do-lib-results.
5be7639 @avodonosov first commit
avodonosov authored
79 - add more libraries: total number of 20 libraries
80 is enough for the beginning
81 - when loading of a library or library test system
82 fails, ensure we have the error description in the output
83 0.5h
84 - The "thank you" message: where exactly to submit test results?
85 Specify an email or issue tracker of the cl-test-grid project.
86 - how to store public (central) database and failed library
87 outputs (files).
88 An appealing way is to store it in the same git repository
89 on github, but with the std-out files the repository will
90 quickly grow to an unconvenient size (for new people the
91 checkout procedure will be too long to be considered
92 convenient)
93 5h
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored
94 - run the tests on all the implementations available for us.
5be7639 @avodonosov first commit
avodonosov authored
95 ==================================================
96 ========== Milestone: release 0 ============
97 ==================================================
ec59872 @avodonosov TODO comment about finalizing the terminology about our main data obj…
avodonosov authored
98 - finalize the terminology we use in the code
99 to refer our main data:
100 - test status for a particular library
101 - library test result object (includes the status
102 as well as log length, the key of the log
103 in the online blob store, probably the
104 library test duration)
105 - list of library test results in a particular test
106 run
107 - test run description, consists of lisp name,
108 libraries set (think quicklisp distro),
109 the user contacts, total test run duration,
110 etc.
5be7639 @avodonosov first commit
avodonosov authored
111 + more abstract accessor to parts of DB info instead of
112 getf by properties: run-descr, run-results.
113 1h
114 + safe-read database
115 + create a project with asdf system
116 0.5h
117 + DB file path based on the asdf system location
118 0.5h
119 + accumulate failed library output
120 1h
121 - DB file formatting should be equal in all lisps,
122 so that diff shows only new records.
123 (use pprint ?)
124 4h
125 - a way to specify lib-wold as a quicklisp version with some
126 library versions overriden (checkout this particular
127 libraries from the scm), so that library author can quickly
128 get test result for his changes (fixes) in scm.
129 An implementation idea to consider: almost every scm allows
130 to download asnapshot via http, so the quicklisp http machinery may
131 be reused here, whithout running a shell command for
132 checkout.
133 24h
134 - should we save library log to a file only if the tests failed,
135 or always? (now we save log in any case)
136 - During run-libtests, probably we should redirect the library
137 output to file directly, without caching it in memory
138 - it is more convenient when you are watching the testing
139 process, you can observe the file being populated with
140 logs (because some libraries, like flexi-streams, take
141 time about minute to finish, and if during this minute
142 nithing happens it is not user-friendly)
143 |#
144
145 (defgeneric libtest (library-name)
146 (:documentation "Define a method for this function
b279089 @avodonosov Fixed return value of the run-testlibs - if logs upload to the blobst…
avodonosov authored
147 with LIBRARY-NAME eql-specialized for for every library added
5be7639 @avodonosov first commit
avodonosov authored
148 to the test grid.
149
150 The method should run test suite and return the resulting
151 status. Status is one of three values:
152 :OK - all tests passed,
153 :FAIL - some test failed,
154 :NO-RESOURCE - test suite can not be run because some required
155 resource is absent in the environment. For example, CFFI library
156 test suite needs a small C library compiled to DLL. User must
157 do it manually. In case the DLL is absent, the LIBTEST method
158 for CFFI returns :NO-RESOURCE.
159
160 For convenience, T may be returned instead of :OK and NIL instead of :FAIL."))
161
162 (defun normalize-status (status)
163 "Normilzies test resul status - converts T to :OK and NIL to :FAIL."
164 (case status
165 ((t :ok) :ok)
166 ((nil :fail) :fail)
167 (otherwise status)))
168
169 (defparameter *all-libs* '(:alexandria :babel :trivial-features :cffi :cl-ppcre :usocket :flexi-streams :bordeaux-threads)
170 "All the libraries currently supported by the test-grid.")
171
172 (defun clean-rt ()
173 "Helper function to assist running test suites created using the RT
174 test framework. The problem is that RT uses global storage for all
175 the tests; in result if we previously loaded any test system,
176 after loading another test system the global test RT test suite
177 contains the tests of _both_ libraries."
178 (let ((rem-all-tests (and (find-package '#:rt)
179 (find-symbol (symbol-name '#:rem-all-tests) '#:rt))))
180 (when rem-all-tests (funcall rem-all-tests))))
181
182 (defmethod libtest ((library-name (eql :alexandria)))
183
184 ;; The test framework used: rt.
185 (clean-rt)
186 (asdf:clear-system :alexandria-tests)
187
188 (quicklisp:quickload :alexandria-tests)
189
190 (flet (
191 ;; the run-tests local function is copy/pasted
192 ;; from alexandria-tests.asd
193 (run-tests (&rest args)
194 (apply (intern (string '#:run-tests) '#:alexandria-tests) args)))
195
196 (let ((a (run-tests :compiled nil))
197 (b (run-tests :compiled t)))
198 (and a b))))
199
200 (defmethod libtest ((library-name (eql :babel)))
201
202 ;; The test framework used: stefil.
203
204 (quicklisp:quickload :babel-tests)
205
206 (let ((result (funcall (intern (string '#:run) '#:babel-tests))))
207 (zerop
208 (length (funcall (intern (string '#:failure-descriptions-of) '#:hu.dwim.stefil)
209 result)))))
210
211 (defmethod libtest ((library-name (eql :trivial-features)))
212
213 ;; The test framework used: rt.
214 (clean-rt)
215 (asdf:clear-system :trivial-features-tests)
216
217 (quicklisp:quickload :trivial-features-tests)
218
219 ;; copy/past from trivial-features-tests.asd
220 (let ((*package* (find-package 'trivial-features-tests)))
221 (funcall (find-symbol (symbol-name '#:do-tests)))))
222
223 (defmethod libtest ((library-name (eql :cffi)))
224
225 ;; The test framework used: rt.
226 (clean-rt)
227 (asdf:clear-system :cffi-tests)
228
229 (handler-case (quicklisp:quickload :cffi-tests)
230 ;; CFFI tests work with a small test C
231 ;; library. The user is expected to compile
232 ;; the library. If the library is not available,
233 ;; CFFI tests signal cffi:load-foreign-library-error.
234 (t (e)
235 (when (eq (type-of e)
236 (find-symbol (symbol-name '#:load-foreign-library-error) '#:cffi))
237 (return-from libtest :no-resource))))
238
239 (flet (
240 ;; copy/paste from cffi-tests.asd
241 (run-tests (&rest args)
242 (apply (intern (string '#:run-cffi-tests) '#:cffi-tests) args)))
243
244 (let ((a (run-tests :compiled nil))
245 (b (run-tests :compiled t)))
246 (and a b))))
247
248 (defmethod libtest ((library-name (eql :cl-ppcre)))
249
250 ;; The test framework used: custom.
251
252 ;; Workaround the quicklisp issue #225 -
253 ;; https://github.com/quicklisp/quicklisp-projects/issues/225 -
254 ;; first load cl-ppcre-unicode, because otherwise
255 ;; current quicklisp can not find cl-ppcre-unicode-test
256 (quicklisp:quickload :cl-ppcre-unicode)
257 (quicklisp:quickload :cl-ppcre-unicode-test)
258
259 ;; copy/paste from cl-ppcre-unicode.asd
260 (funcall (intern (symbol-name :run-all-tests) (find-package :cl-ppcre-test))
261 :more-tests (intern (symbol-name :unicode-test) (find-package :cl-ppcre-test))))
262
263 (defmethod libtest ((library-name (eql :usocket)))
264
265 ;; The test framework used: rt.
266 (clean-rt)
267 (asdf:clear-system :usocket-test)
268
269 ; (asdf:operate 'asdf:load-op :usocket-test :force t)
270
271 (quicklisp:quickload :usocket-test)
272
273 ;; TODO: usocket test suite might need manual configuration,
274 ;; see their README. Distinguish the case
275 ;; when the manual configuration hasn't been
276 ;; performed and return :no-resource status.
277 ;;
278 ;; (setf usocket-test::*common-lisp-net*
279 ;; (or usocket-test::*common-lisp-net*
280 ;; "74.115.254.14"))
281
282 ;; copy/paste from usocket-test.asd
283 (funcall (intern "DO-TESTS" "USOCKET-TEST")))
284
285
286 (defmethod libtest ((library-name (eql :flexi-streams)))
287
288 ;; The test framework used: custom.
289
290 (quicklisp:quickload :flexi-streams-test)
291
292 ;; copy/paste from flexi-streams.asd
293 (funcall (intern (symbol-name :run-all-tests)
294 (find-package :flexi-streams-test))))
295
296 (defmethod libtest ((library-name (eql :bordeaux-threads)))
297
298 ;; The test framework used: fiveam.
299
300 (quicklisp:quickload :bordeaux-threads-test)
301
302 (let ((results (funcall (intern (string '#:run) :fiveam)
303 :bordeaux-threads))
304 (test-failure-type (intern (string '#:test-failure) :fiveam)))
305
306 (zerop (count-if (lambda (res)
307 (typep res test-failure-type))
308 results))))
309
310 (defun run-libtest (lib)
311 (let* ((orig-std-out *standard-output*)
312 (buf (make-string-output-stream))
313 (*standard-output* buf)
314 (*error-output* buf))
315
b279089 @avodonosov Fixed return value of the run-testlibs - if logs upload to the blobst…
avodonosov authored
316 (format orig-std-out
317 "Running tests for library ~A. *STANDARD-OUTPUT* and *ERROR-OUTPUT* are redirected.~%"
5be7639 @avodonosov first commit
avodonosov authored
318 lib)
319 (finish-output orig-std-out)
320
321 (let ((status (handler-case (normalize-status (libtest lib))
322 (t () :fail))))
323 (when (eq :fail status)
324 (format t "~A tests failed." lib))
325 (let ((output (get-output-stream-string buf)))
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored
326 (list :libname lib
327 :status status :output output
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored
328 :log-char-length (length output))))))
5be7639 @avodonosov first commit
avodonosov authored
329
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored
330 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
331 ;; Utils
332 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
333 (defun do-plist-impl (plist handler)
334 (do* ((cur-pos plist (cddr cur-pos))
335 (prop (first cur-pos) (first cur-pos))
336 (val (second cur-pos) (second cur-pos)))
337 ((null prop))
338 (funcall handler prop val)))
339
340 (defmacro do-plist ((key val plist &optional result) &body body)
341 `(block nil
342 (do-plist-impl ,plist (lambda (,key ,val) ,@body))
343 ,result))
344
345 (defun plist-comparator (&rest props-and-preds)
346 (lambda (plist-a plist-b)
347 (do-plist (prop pred props-and-preds)
348 ;; iterate over all the property/predicate pairs
349 ;; "compare" the values of the current property
350 ;; in both plists
351 (let ((val-a (getf plist-a prop))
352 (val-b (getf plist-b prop)))
353 (if (funcall pred val-a val-b)
354 (return t))
355 ;; Ok, val-a is not less than val-b (as defined by our predicate).
356 ;; Lets check if they are equal. If the reverse comparation [val-b less val-a]
357 ;; is also false, then they are equal, and we proceed to the next
358 ;; property/predicate pair.
359 (when (funcall pred val-b val-a)
360 (return nil))))))
361
362 ;; examples:
363 #|
364 (let ((less (plist-comparator :a '< :b 'string<)))
365 (and (funcall less '(:a 1 :b "x") '(:a 2 :b "y"))
366 (funcall less '(:a 2 :b "x") '(:a 2 :b "y"))
367 (not (funcall less '(:a 3 :b "x") '(:a 2 :b "y")))))
368
369 (equalp
370 (sort '((:a 1 :b "x")
371 (:a 2 :b "y")
372 (:a 2 :b "y")
373 (:a 3 :b "z"))
374 (plist-comparator :a '< :b 'string<))
375 '((:A 1 :B "x") (:A 2 :B "y") (:A 2 :B "y") (:A 3 :B "z")))
376 |#
377
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored
378 (defun getter (prop)
379 #'(lambda (plist)
380 (getf plist prop)))
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored
381
fa1c4e1 @avodonosov Pivot reports. First working version; no comments, data cell is rende…
avodonosov authored
382 (defun list< (predicates l1 l2)
383 "Compares two lists L1 and L2 of equal lenght,
384 using for every pair of elements a corresponding predicate
385 from the PREDICATES list (of the same length). Returns
386 T if L1 is less than (according the PREDICATES) L2.
387 Othersise returns NIL."
388 (if (null predicates)
389 nil
390 (let ((pred (car predicates))
391 (elem1 (car l1))
392 (elem2 (car l2)))
393 (if (funcall pred elem1 elem2)
394 t
395 ;; Ok, elem1 is not less than elem2 (as defined by our predicate).
396 ;; Lets check if they are equal. If the reverse comparation [elem2 less elem1]
397 ;; is also false, then they are equal, and we proceed to the next
398 ;; property/predicate pair.
399 (if (funcall pred elem2 elem1)
400 nil
401 (list< (cdr predicates)
402 (cdr l1)
403 (cdr l2)))))))
404
405 #|
406 Examples:
407
408 (and
409 (list< '(< <) '(1 2) '(2 2))
410 (not (list< '(< <) '(1 2) '(1 2)))
411 (list< '(< <) '(1 2) '(1 3))
412 (not (list< '(string< string<)
413 '("quicklisp-fake-2011-00-02" "ccl-fake-1")
414 '("quicklisp-fake-2011-00-01" "clisp-fake-1"))))
415 |#
416
417 (defun hash-table-keys (hash-table)
418 (let (keys)
419 (maphash #'(lambda (key val)
420 (declare (ignore val))
421 (push key keys))
422 hash-table)
423 keys))
424
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored
425 ;; copy/paste from
426 ;; http://www.gigamonkeys.com/book/practical-an-mp3-browser.html
427 (defmacro with-safe-io-syntax (&body body)
428 `(with-standard-io-syntax
429 (let ((*read-eval* nil))
430 ,@body)))
431
432 (defun safe-read (&rest args)
433 (with-safe-io-syntax (apply #'read args)))
434
435 (defun safe-read-file (file)
436 (with-open-file (in file
437 :direction :input
438 :element-type 'character ;'(unsigned-byte 8) + flexi-stream
439 )
440 (safe-read in)))
441
442 ;; copy/paste from
443 ;; http://cl-user.net/asp/-1MB/sdataQ0mpnsnLt7msDQ3YNypX8yBX8yBXnMq=/sdataQu3F$sSHnB==
444 (defun file-string (path)
445 "Sucks up an entire file from PATH into a freshly-allocated string,
446 returning two values: the string and the number of bytes read."
447 (with-open-file (s path)
448 (let* ((len (file-length s))
449 (data (make-string len)))
450 (values data (read-sequence data s)))))
451
452 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1195d22 @avodonosov Fix the last merge
avodonosov authored
453 ;; Settings
454 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
455 (defun get-settings-file()
456 (merge-pathnames (user-homedir-pathname) "cl-test-grid-settings.lisp"))
457
458 (defun prompt-for-email ()
459 (format *query-io* "~a: " "Please enter your email for questions about this, test, your environment, adds")
460 (force-output *query-io*)
461 (string-trim " " (read-line *query-io*)))
462
463 (defun get-use-email ()
464 (handler-case
465 (when (string= "" (getf (safe-read-file (get-settings-file)) :user-email))
466 (format t "Warning! You don't entered your email~%"))
467 (t ()
468 (progn
469 (write-to-file (list :user-email (prompt-for-email)) (get-settings-file))))))
470
471 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4cea853 @avodonosov Use ql:quickload instead of asdf:operate when loading the GAE blobsto…
avodonosov authored
472 ;; Test Runs
473 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5be7639 @avodonosov first commit
avodonosov authored
474
475 (defun run-descr (run)
476 "The description part of the test run."
c023819 @avodonosov test run as plist (:descr <descr> :run-results <run-results>) instead…
avodonosov authored
477 (getf run :descr))
5be7639 @avodonosov first commit
avodonosov authored
478
479 (defun run-results (run)
480 "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
481 (getf run :results))
5be7639 @avodonosov first commit
avodonosov authored
482
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored
483 (defun (setf run-results) (new-run-results test-run)
c023819 @avodonosov test run as plist (:descr <descr> :run-results <run-results>) instead…
avodonosov authored
484 (setf (getf test-run :results) new-run-results))
485
486 (defun make-run (description lib-results)
487 (list :descr description :results lib-results))
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored
488
5be7639 @avodonosov first commit
avodonosov authored
489 (defun fmt-time (universal-time &optional destination)
490 "The preferred time format used in the cl-test-grid project."
491 (multiple-value-bind (sec min hour date month year)
492 (decode-universal-time universal-time 0)
493 (funcall #'format
494 destination
495 "~2,'0D~2,'0D~2,'0D~2,'0D~2,'0D~2,'0D"
496 year month date hour min sec)))
497
498 (defun make-run-descr ()
499 "Generate a description for a test run which might be
500 performed in the current lisp system."
501 (list :lisp (asdf::implementation-identifier)
502 :lib-world (format nil "quicklisp ~A"
503 (ql-dist:version (ql-dist:dist "quicklisp")))
504 :time (get-universal-time)
505 :run-duration :unknown
506 :contact (list :email "avodonosov@yandex.ru")))
507
508 (defun name-run-directory (run-descr)
509 "Generate name for the directory where test run
510 data (libraries test suites output and the run results) will be saved."
511 (format nil
512 "~A-~A"
513 (fmt-time (getf run-descr :time))
514 (getf run-descr :lisp)))
515
516 (defun test-output-base-dir ()
517 (merge-pathnames "test-runs/"
518 test-grid-config:*src-base-dir*))
519
520 (defun run-directory (run-descr)
521 (merge-pathnames (make-pathname
522 :directory (list :relative (name-run-directory run-descr))
523 :name nil
524 :type nil)
525 (test-output-base-dir)))
526
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored
527 (defun lib-log-file (test-run-directory lib-name)
528 (merge-pathnames (string-downcase lib-name)
529 test-run-directory))
530
5be7639 @avodonosov first commit
avodonosov authored
531 (defun save-lib-log (lib-name log test-run-directory)
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored
532 (let ((lib-log-file (lib-log-file test-run-directory lib-name)))
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored
533 (with-open-file (out lib-log-file
534 :direction :output
535 :if-exists :overwrite
536 :if-does-not-exist :create)
537 (write-sequence log out))))
5be7639 @avodonosov first commit
avodonosov authored
538
539 (defun write-to-file (obj file)
540 "Write to file the lisp object OBJ in a format acceptable to READ."
541 (with-open-file (out file
542 :direction :output
543 :if-exists :supersede
544 :if-does-not-exist :create)
545 (pprint obj out))
546 obj)
547
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored
548 (defun run-info-file (test-run-directory)
549 (merge-pathnames "test-run-info.lisp"
550 test-run-directory))
551
5be7639 @avodonosov first commit
avodonosov authored
552 (defun save-run-info (test-run directory)
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored
553 (let ((run-file (run-info-file directory)))
554 (write-to-file test-run run-file)))
555
556 (defun gae-blobstore-dir ()
557 (merge-pathnames "gae-blobstore/lisp-client/" test-grid-config:*src-base-dir*))
558
559 (defparameter *gae-blobstore-base-url* "http://cl-test-grid.appspot.com")
560
561 (defun get-blobstore ()
562 (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
563 (ql:quickload '#:test-grid-gae-blobstore)
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored
564 (funcall (intern (string '#:make-blob-store) '#:test-grid-gae-blobstore)
565 :base-url *gae-blobstore-base-url*))
566
567 (defun submit-logs (test-run-dir)
568 (let* ((blobstore (get-blobstore))
569 (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
570 ;; prepare parameters for the SUBMIT-FILES blobstore function
571 (submit-params (mapcar #'(lambda (lib-result)
572 (let ((libname (getf lib-result :libname)))
573 (cons libname
574 (lib-log-file test-run-dir libname))))
575 (run-results run-info))))
576 ;; submit files to the blobstore and receive
577 ;; their blobkeys in response
578 (let ((libname-to-blobkey-alist
579 (test-grid-blobstore:submit-files blobstore
580 submit-params)))
a8e8a13 @avodonosov Implemented online storage for libraries test logs, hosted on Google …
avodonosov authored
581 ;; Now store the blobkeys for every library in the run-info.
582 ;; Note, we destructively modify parts of the previously
583 ;; read run-info.
584 (flet ((get-blob-key (lib)
585 (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
586 (error "blobstore didn't returned blob key for the log of the ~A libary" lib))))
587 (setf (run-results run-info)
588 (mapcar #'(lambda (lib-result)
589 (setf (getf lib-result :log-blob-key)
590 (get-blob-key (getf lib-result :libname)))
591 lib-result)
592 (run-results run-info))))
593 ;; finally, save the updated run-info with blobkeys
594 ;; to the file. Returns the run-info.
595 (save-run-info run-info test-run-dir))))
596
5be7639 @avodonosov first commit
avodonosov authored
597 (defun run-libtests (&optional (libs *all-libs*))
598 (let* ((run-descr (make-run-descr))
599 (run-dir (run-directory run-descr))
600 (lib-results))
601 (ensure-directories-exist run-dir)
602 (dolist (lib libs)
603 (let ((lib-result (run-libtest lib)))
604 (save-lib-log lib (getf lib-result :output) run-dir)
605 (remf lib-result :output)
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored
606 (push lib-result lib-results)))
5be7639 @avodonosov first commit
avodonosov authored
607 (setf (getf run-descr :run-duration)
608 (- (get-universal-time)
609 (getf run-descr :time)))
c023819 @avodonosov test run as plist (:descr <descr> :run-results <run-results>) instead…
avodonosov authored
610 (let ((run (make-run run-descr lib-results)))
5be7639 @avodonosov first commit
avodonosov authored
611 (save-run-info run run-dir)
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored
612 (format t "The test results were saved to this directory: ~%~A.~%"
613 (truename run-dir))
5bffbe5 @avodonosov fixed regresson introduced when implementing GAE blobstore: the funct…
avodonosov authored
614 (format t "~%Submitting libraries test logs to the online blobstore...~%")
615 (handler-case
b279089 @avodonosov Fixed return value of the run-testlibs - if logs upload to the blobst…
avodonosov authored
616 (progn
617 (setf run (submit-logs run-dir))
5bffbe5 @avodonosov fixed regresson introduced when implementing GAE blobstore: the funct…
avodonosov authored
618 (format t "The log files are successfully uploaded to the online blobstore.
1195d22 @avodonosov Fix the last merge
avodonosov authored
619
620 Please submit the test run results file
621 ~A
622 to the cl-test-grid issue tracker:
623 https://github.com/cl-test-grid/cl-test-grid/issues
624
625 (we are working on automating the test results upload).~%"
b279089 @avodonosov Fixed return value of the run-testlibs - if logs upload to the blobst…
avodonosov authored
626 (truename (run-info-file run-dir))))
5bffbe5 @avodonosov fixed regresson introduced when implementing GAE blobstore: the funct…
avodonosov authored
627 (t (e) (format t "Error occured while uploading the libraries test logs to the online store: ~A: ~A.
1195d22 @avodonosov Fix the last merge
avodonosov authored
628 Please submit manually the full content of the results directory
629 ~A
630 to the cl-test-grid issue tracker:
631 https://github.com/cl-test-grid/cl-test-grid/issues~%"
5bffbe5 @avodonosov fixed regresson introduced when implementing GAE blobstore: the funct…
avodonosov authored
632 (type-of e)
633 e
634 (truename run-dir))))
635 (format t "~%Thank you for the participation!~%")
636 run)))
efe7ab8 @d35h added function get-user-email. reads from file if file is absent then…
d35h authored
637
5be7639 @avodonosov first commit
avodonosov authored
638 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
639 ;; Database
640 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
641 (defparameter *db* '(:version 0 :runs ()))
642
643 (defvar *standard-db-file*
644 (merge-pathnames "db.lisp"
645 test-grid-config:*src-base-dir*))
646
647 (defun add-run (run-info &optional (db *db*))
648 (push run-info (getf db :runs)))
649
85e3774 @avodonosov Store the reports generated in the repository, in the directory repor…
avodonosov authored
650 (defun save-db (&optional (db *db*) (stream-or-path *standard-db-file*))
5be7639 @avodonosov first commit
avodonosov authored
651 (with-open-file (out stream-or-path
652 :direction :output
653 :element-type 'character ;'(unsigned-byte 8) + flexi-stream
654 :if-exists :overwrite
655 :if-does-not-exist :create)
656 (write db :stream out)))
657
658 (defun read-db (&optional (stream-or-path *standard-db-file*))
659 (with-open-file (in stream-or-path
660 :direction :input
661 :element-type 'character ;'(unsigned-byte 8) + flexi-stream
662 )
663 (safe-read in)))
664
665 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
666 ;; Reports
667 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
668
669 (defun generate-fake-run-results ()
670 "Generate fake test run result enought to test our reports."
671 (flet ((random-status ()
672 (let ((r (random 1.0)))
673 (cond ((< r 0.43)
674 :ok)
675 ((< r 0.86)
676 :fail)
677 (t :no-resource)))))
678 (let ((runs '()))
679 (dolist (lisp '("sbcl-fake-1" "sbcl-fake-2" "clisp-fake-1" "ccl-fake-1" "abcl-fake-2"))
680 (dolist (lib-world '("quicklisp-fake-2011-00-01" "quicklisp-fake-2011-00-02" "quicklisp-fake-2011-00-03"))
681 (let ((run-descr (list :lisp lisp
682 :lib-world lib-world
683 :time (get-universal-time)
684 :run-duration (+ 100 (random 90))
685 :contact (list :email
686 (nth (random 3) '("avodonosov@yandex.ru"
687 "other-user@gmail.com"
688 "foo@gmail.com")))))
689 (lib-results '()))
690 (dolist (lib *all-libs*)
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored
691 (push (list :libname lib :status (random-status) :log-char-length 50)
692 lib-results))
c023819 @avodonosov test run as plist (:descr <descr> :run-results <run-results>) instead…
avodonosov authored
693 (push (make-run run-descr lib-results) runs))))
5be7639 @avodonosov first commit
avodonosov authored
694 runs)))
695
00e5da5 @avodonosov more correct name for the summary-table report: test-runs-report
avodonosov authored
696 (defvar *test-runs-report-template*
697 (merge-pathnames "test-runs-report-template.html"
5be7639 @avodonosov first commit
avodonosov authored
698 test-grid-config:*src-base-dir*))
00e5da5 @avodonosov more correct name for the summary-table report: test-runs-report
avodonosov authored
699
5be7639 @avodonosov first commit
avodonosov authored
700 (defun vertical-html (libname)
701 (let ((maybeBr "")
702 (libname (string libname)))
703 (with-output-to-string (out)
704 (loop for char across libname
705 do (princ maybeBr out)
706 (princ (if (char= char #\-) #\| char) out)
707 (setf maybeBr "<br/>")))))
708
709 ;; example:
710 #|
711 (string= (vertical-html "cl-abc")
712 "c<br/>l<br/>|<br/>a<br/>b<br/>c")
713 |#
714
ec59872 @avodonosov TODO comment about finalizing the terminology about our main data obj…
avodonosov authored
715 ;; todo: this should be a blobstore method, but
716 ;; until we move the reporting to a separate
717 ;; asdf system, we don't want the dependency
718 ;; on blobstore here.
719 (defun blob-uri (blob-key)
720 (format nil "~A/blob?key=~A"
721 *gae-blobstore-base-url* blob-key))
722
723 (defun lib-log-local-uri (test-run lib-result)
724 (format nil "file://~A~A"
5be7639 @avodonosov first commit
avodonosov authored
725 (run-directory (run-descr test-run))
ec59872 @avodonosov TODO comment about finalizing the terminology about our main data obj…
avodonosov authored
726 (string-downcase (getf lib-result :libname))))
727
728 (defun lib-log-uri (test-run lib-result)
729 (let ((blob-key (getf lib-result :log-blob-key)))
730 (if blob-key
731 (blob-uri blob-key)
732 "javascript:alert('The blobstore key is not specified, seems like the library log was not submitted to the online storage')")))
5be7639 @avodonosov first commit
avodonosov authored
733
734 (defun single-letter-status (normalized-status)
735 (case normalized-status
736 (:ok "O")
737 (:fail "F")
738 (:no-resource "R")
739 (otherwise normalized-status)))
740
741 (defun status-css-class (normalized-status)
742 (case normalized-status
743 (:ok "ok-status")
744 (:fail "fail-status")
745 (:no-resource "no-resource-status")
746 (otherwise "")))
49f4d4c @d35h add function export-to-csv
d35h authored
747
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored
748 (defun render-single-letter-status (test-run lib-test-result)
5be7639 @avodonosov first commit
avodonosov authored
749 (let ((status (normalize-status (getf lib-test-result :status))))
750 (format nil "<a class=\"test-status ~A\" href=\"~A\">~A</a>"
751 (status-css-class status)
ec59872 @avodonosov TODO comment about finalizing the terminology about our main data obj…
avodonosov authored
752 (lib-log-uri test-run lib-test-result)
5be7639 @avodonosov first commit
avodonosov authored
753 (single-letter-status status))))
754
5f37895 @avodonosov more correct name for the summary-table report: test-runs-report
avodonosov authored
755 (defun test-runs-table-html (&optional
756 (db *db*)
757 (status-renderer 'render-single-letter-status))
5be7639 @avodonosov first commit
avodonosov authored
758 (with-output-to-string (out)
759 (write-line "<table cellspacing=\"1\" class=\"tablesorter\">" out)
760
761 (princ "<thead><tr style=\"vertical-align: bottom;\"><th>Lib World</th><th>Lisp</th><th>Runner</th>" out)
762 (dolist (lib *all-libs*)
763 (format out "<th>~A</th>" (vertical-html lib)))
764 (write-line "</tr></thead>" out)
765
766 (write-line "<tbody>" out)
767 (dolist (run (getf db :runs))
768 (let ((run-descr (run-descr run))
769 (lib-statuses (run-results run)))
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored
770 (format out "<tr><td>~A</td><td>~A</td><td>~A</td>"
771 (getf run-descr :lib-world)
772 (getf run-descr :lisp)
773 (getf (getf run-descr :contact) :email))
774 (dolist (lib *all-libs*)
775 (format out "<td>~A</td>"
776 (funcall status-renderer run (find lib lib-statuses
777 :key (getter :libname)))))
778 (write-line "</tr>" out)))
5be7639 @avodonosov first commit
avodonosov authored
779 (write-line "</tbody>" out)
780 (write-line "</table>" out)))
781
5f37895 @avodonosov more correct name for the summary-table report: test-runs-report
avodonosov authored
782 (defun fmt-test-runs-report (html-table)
00e5da5 @avodonosov more correct name for the summary-table report: test-runs-report
avodonosov authored
783 (let* ((template (file-string *test-runs-report-template*))
5be7639 @avodonosov first commit
avodonosov authored
784 (placeholder "{THE-TABLE}")
785 (pos (or (search placeholder template)
786 (error "Can't find the placeholder ~A in the report template file ~A" placeholder *report-template*))))
787 (concatenate 'string
788 (subseq template 0 pos)
789 html-table
790 (subseq template (+ pos (length placeholder))))))
791
5f37895 @avodonosov more correct name for the summary-table report: test-runs-report
avodonosov authored
792 (defun test-runs-report (&optional (db *db*))
793 (fmt-test-runs-report (test-runs-table-html db)))
794
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored
795 (defun export-to-csv (out &optional (db *db*))
796 (format out "Lib World,Lisp,Runner,LibName,Status~%")
49f4d4c @d35h add function export-to-csv
d35h authored
797 (dolist (run (getf db :runs))
9dd75c2 @avodonosov data format: instead of storing librari name as a key for the library…
avodonosov authored
798 (let ((run-descr (run-descr run)))
799 (dolist (lib-result (run-results run))
800 (format out "~a,~a,~a,~a,~a~%"
801 (getf run-descr :lib-world)
802 (getf run-descr :lisp)
803 (getf (getf run-descr :contact) :email)
804 (string-downcase (getf lib-result :libname))
805 (getf lib-result :status))))))
49f4d4c @d35h add function export-to-csv
d35h authored
806
fa1c4e1 @avodonosov Pivot reports. First working version; no comments, data cell is rende…
avodonosov authored
807 ;; ========= Pivot Reports ==================
808
809 (defun build-joined-index (db)
810 (let ((all-results (make-hash-table :test 'equal)))
811 (dolist (run (getf db :runs))
812 (let* ((run-descr (run-descr run))
813 (lisp (getf run-descr :lisp))
814 (lib-world (getf run-descr :lib-world)))
815 (dolist (lib-result (run-results run))
816 (let ((libname (getf lib-result :libname)))
817 (push lib-result
818 (gethash (list lisp lib-world libname) all-results))))))
819 all-results))
820
821
822 #|
823 HTML table properties:
824 - rows and cols are not equal: html tables are row-first - TR includes TDs
825
826 Only the deepest level row and col fields will have corresponding
827 TR and TD cells in the table data (we do not consider the table
828 column headers now).
829
830 And the TD cells are included in a TR.
831
832 Algorithm sketch:
833 Iterate over all row properties and their values in rows.
834 For every deepest level combination create a TR (if
835 any values exist for this combination).
836
837 Iterate over all the col properties and their values.
838 For every deepest level combination create a TD.
839
840 partitioning structure
841 -----------------------------
842 field1 | field2
843 -----------------------------
844 field1 val1 (count)
845 field2 val1 (count)
846 field2 val2 (count)
847 field1 val2 (count)
848 field2 val1 (count)
849 field2 val3 (count)
850 field1 val3 (count)
851 field2 val2 (count)
852
853
854 <tr> <td> <td> <td>
855 <tr> <td> <td>
856 <tr> <td>
857 <tr> <td> <td>
858 <tr> <td> <td>
859 <tr> <td>
860 <tr> <td> <td> <td>
861 <tr> <td> <td>
862 <tr> <td> <td> <td>
863 <tr> <td> <td>
864 <tr> <td>
865
866 |#
867
868 (defun make-fields-values-setter (fields)
869 "Creates a function which destructively modifies
870 the specified fields in the index key passed to it
871 as a parameter"
872 (let ((index-key-setters (list :lisp #'(lambda (index-key lisp)
873 (setf (first index-key) lisp))
874 :lib-world #'(lambda (index-key lib-world)
875 (setf (second index-key) lib-world))
876 :libname #'(lambda (index-key libname)
877 (setf (third index-key) libname)))))
878 (flet ((field-setter (field)
879 (or (getf index-key-setters field)
880 (error "field ~A is unknown" field))))
881 (let ((setters (mapcar #'field-setter fields)))
882 #'(lambda (index-key field-vals)
883 (mapc #'(lambda (setter field-val)
884 (funcall setter index-key field-val))
885 setters
886 field-vals)
887 index-key)))))
888
889 (defun make-fields-values-getter (fields)
890 (let ((index-key-getters (list :lisp #'first
891 :lib-world #'second
892 :libname #'third)))
893 (flet ((field-getter (field)
894 (or (getf index-key-getters field)
895 (error "field ~A is unknown" field))))
896 (let ((getters (mapcar #'field-getter fields)))
897 #'(lambda (index-key)
898 (mapcar #'(lambda (getter)
899 (funcall getter index-key))
900 getters))))))
901
902 (defun calc-rows-and-cols (joined-index rows-fields cols-fields)
903 (let ((rows-fields-getter (make-fields-values-getter rows-fields))
904 (rows-fields-setter (make-fields-values-setter rows-fields))
905 (rows (make-hash-table :test #'equal))
906 (cols-fields-getter (make-fields-values-getter cols-fields))
907 (cols-fields-setter (make-fields-values-setter cols-fields))
908 (cols (make-hash-table :test #'equal)))
909 (maphash #'(lambda (index-key index-value)
910 (declare (ignore index-value))
911 (setf (gethash (funcall rows-fields-getter index-key)
912 rows)
913 t)
914 (setf (gethash (funcall cols-fields-getter index-key)
915 cols)
916 t))
917 joined-index)
918 (values (hash-table-keys rows)
919 (hash-table-keys cols)
920 #'(lambda (index-key row-addr col-addr)
921 (funcall rows-fields-setter index-key row-addr)
922 (funcall cols-fields-setter index-key col-addr)))))
923
924 (defstruct (header-print-helper :conc-name)
925 (span 0 :type fixnum)
926 (printed nil))
927
928 (defun subaddrs (row-address)
929 (nreverse (maplist #'reverse (reverse row-address))))
930
931 (defun calc-spans (row-or-col-addrs)
932 (let ((helpers (make-hash-table :test #'equal)))
933 (dolist (row-or-col-addr row-or-col-addrs)
934 (dolist (subaddr (subaddrs row-or-col-addr))
935 (let ((helper (or (gethash subaddr helpers)
936 (setf (gethash subaddr helpers)
937 (make-header-print-helper)))))
938 (incf (span helper)))))
939 helpers))
940
941
942 ;; generate fake database content to test reporting
943 (setf (getf *db* :runs) (generate-fake-run-results))
944
945 (defun print-row-header (row-addr row-spans out)
946 (dolist (subaddr (subaddrs row-addr))
947 (let ((helper (gethash subaddr row-spans)))
948 (when (not (printed helper))
949 (format out "<td rowspan=\"~A\">~A</td>" (span helper) (car (last subaddr)))
950 (setf (printed helper) t)))))
951
952 (defun print-table-headers (row-field-count col-field-count cols out)
953 (let ((col-spans (calc-spans cols)))
954 (dotimes (header-row-num col-field-count)
955 (princ "<tr>" out)
956 (dotimes (row-header row-field-count)
957 (princ "<td>&nbsp;</td>" out))
958 (dolist (col-addr cols)
959 (let* ((cell-addr (subseq col-addr 0 (1+ header-row-num)))
960 (helper (gethash cell-addr col-spans)))
961 (when (not (printed helper))
962 (format out "<td colspan=\"~A\">~A</td>" (span helper) (car (last cell-addr)))
963 (setf (printed helper) t))))
964 (format out "</tr>~%"))))
965
966 (defun pivot-table-html (out
967 joined-index
968 row-fields row-fields-sort-predicates
969 col-fields col-fields-sort-predicates)
970 (princ "<table border=\"1\">" out)
971 (let (rows
972 cols
973 index-key-setter
974 (row-comparator #'(lambda (rowa rowb)
975 (list< row-fields-sort-predicates
976 rowa rowb)))
977 (col-comparator #'(lambda (cola colb)
978 (list< col-fields-sort-predicates
979 cola colb))))
980
981 (setf (values rows cols index-key-setter)
982 (calc-rows-and-cols joined-index row-fields col-fields))
983
984 (setf rows (sort rows row-comparator)
985 cols (sort cols col-comparator))
986
987 (print-table-headers (length row-fields) (length col-fields) cols out)
988 (let ((row-spans (calc-spans rows))
989 (index-key (make-sequence 'list (+ (length row-fields)
990 (length col-fields)))))
991 (dolist (row rows)
992 (princ "<tr>" out)
993 (print-row-header row row-spans out)
994 (dolist (col cols)
995 (funcall index-key-setter index-key row col)
996 (let ((data (gethash index-key joined-index)))
997 (format out "<td>~A</td>" data)))
998 (format out "</tr>~%"))))
999 (princ "</table>" out))
1000
1001 (defun print-pivot-reports (db)
1002 (let ((joined-index (build-joined-index db))
1003 (reports-dir (reports-dir)))
1004 (flet ((print-report (filename
1005 row-fields row-fields-sort-predicates
1006 col-fields col-fields-sort-predicates)
1007 (with-open-file (out (merge-pathnames filename reports-dir)
1008 :direction :output
1009 :element-type 'character ;'(unsigned-byte 8) + flexi-stream
1010 :if-exists :supersede
1011 :if-does-not-exist :create)
1012 (pivot-table-html out
1013 joined-index
1014 row-fields row-fields-sort-predicates
1015 col-fields col-fields-sort-predicates))))
1016
1017 (print-report "pivot_ql_lisp-lib.html"
1018 '(:lib-world) (list #'string<)
1019 '(:lisp :libname) (list #'string< #'string<))
1020 (print-report "pivot_ql_lib-lisp.html"
1021 '(:lib-world) (list #'string<)
1022 '(:libname :lisp) (list #'string< #'string<))
1023
1024 (print-report "pivot_lisp_lib-ql.html"
1025 '(:lisp) (list #'string<)
1026 '(:libname :lib-world) (list #'string< #'string<))
1027 (print-report "pivot_lisp_ql-lib.html"
1028 '(:lisp) (list #'string<)
1029 '(:lib-world :libname) (list #'string< #'string<))
1030
1031 (print-report "pivot_lib_lisp-ql.html"
1032 '(:libname) (list #'string<)
1033 '(:lisp :lib-world) (list #'string< #'string<))
1034 (print-report "pivot_lib_ql-lisp.html"
1035 '(:libname) (list #'string<)
1036 '(:lib-world :lisp) (list #'string< #'string<))
1037
1038 (print-report "pivot_ql-lisp_lib.html"
1039 '(:lib-world :lisp) (list #'string<)
1040 '(:libname) (list #'string< #'string<))
1041 (print-report "pivot_ql-lib_lisp.html"
1042 '(:lib-world :libname) (list #'string<)
1043 '(:lisp) (list #'string< #'string<))
1044
1045 (print-report "pivot_lisp-lib_ql.html"
1046 '(:lisp :libname) (list #'string<)
1047 '(:lib-world) (list #'string< #'string<))
1048 (print-report "pivot_lisp-ql_lib.html"
1049 '(:lisp :lib-world) (list #'string<)
1050 '(:libname) (list #'string< #'string<))
1051
1052 (print-report "pivot_lib-lisp_ql.html"
1053 '(:libname :lisp) (list #'string<)
1054 '(:lib-world) (list #'string< #'string<))
1055 (print-report "pivot_lib-ql_lisp.html"
1056 '(:libname :lib-world) (list #'string<)
1057 '(:lisp) (list #'string< #'string<)))))
1058
85e3774 @avodonosov Store the reports generated in the repository, in the directory repor…
avodonosov authored
1059 (defun generate-reports (&optional (db *db*))
1060
1061 (with-open-file (out (merge-pathnames "test-runs-report.html"
1062 (reports-dir))
1063 :direction :output
1064 :if-exists :supersede
1065 :if-does-not-exist :create)
1066 (write-sequence (test-runs-report) out))
1067
1068 (with-open-file (out (merge-pathnames "export.csv"
1069 (reports-dir))
1070 :direction :output
1071 :if-exists :supersede
1072 :if-does-not-exist :create)
fa1c4e1 @avodonosov Pivot reports. First working version; no comments, data cell is rende…
avodonosov authored
1073 (export-to-csv out))
1074
1075 (print-pivot-reports db))
85e3774 @avodonosov Store the reports generated in the repository, in the directory repor…
avodonosov authored
1076
1077 (defun reports-dir ()
1078 (merge-pathnames "reports-generated/"
1079 test-grid-config:*src-base-dir*))
1080
5be7639 @avodonosov first commit
avodonosov authored
1081 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1082
1083 #|
1084
1085 Quicklisp download statistics:
1086
1087 http://blog.quicklisp.org/2010/11/project-download-statistics.html
1088
1089 colunmns: download count, has common-lisp test suite
1090
1091 714 + alexandria
1092 596 + babel
1093 520 + trivial-features
1094 503 + cffi
1095 450 + cl-ppcre
1096 423 - trivial-gray-streams
1097 404 + usocket
1098 403 + flexi-streams
1099 398 + bordeaux-threads
1100 393 - slime
1101 386 cl+ssl
1102 371 chunga
1103 370 cl-base64
1104 361 cl-fad
1105 339 md5
1106 327 quicklisp-slime-helper
1107 323 trivial-backtrace
1108 321 rfc2388
1109 317 hunchentoot
1110 293 salza2
1111 289 puri
1112 285 closer-mop
1113 225 anaphora
1114 224 parenscript
1115 221 cl-who
1116 207 trivial-garbage
1117 201 iterate
1118 193 cl-vectors
1119 190 zpng
1120 177 asdf-system-connections
1121 174 zpb-ttf
1122 173 uffi
1123 173 metabang-bind
1124 170 split-sequence
1125 164 vecto
1126 163 cl-json
1127 162 cl-containers
1128 161 metatilities-base
1129 159 fare-utils
1130 156 weblocks
1131 156 fare-matcher
1132 148 drakma
1133 144 cl-cont
1134 143 closure-common
1135 140 moptilities
1136 138 f-underscore
1137 137 trivial-timeout
1138 136 metatilities
1139 135 clsql
1140 133 cxml
1141 |#
Something went wrong with that request. Please try again.