Permalink
Browse files

Splitting the monolitic module test-grid into: testsuites, agent, blo…

…bstore, data, admin, reporting, utils. The modules are mostly formed, although some functions an variables are not in right places yet.
  • Loading branch information...
1 parent 5b39e50 commit 18d52c3ca19d47d077bf0a7175456ce2faf04d2e @avodonosov avodonosov committed Aug 1, 2012
Showing with 194 additions and 268 deletions.
  1. +14 −11 admin/import-test-result-emails.lisp
  2. +10 −10 agent/agent.lisp
  3. +8 −8 agent/perform-test-run.lisp
  4. +3 −3 agent/persistence.lisp
  5. +4 −4 agent/proc-run-libtest.lisp
  6. +1 −1 agent/with-response-file.lisp
  7. 0 { → data}/db.lisp
  8. +32 −31 reporting/reporting.lisp
  9. +1 −1 test-grid-admin.asd
  10. +3 −1 test-grid-agent.asd
  11. +11 −0 test-grid-data.asd
  12. +1 −3 test-grid-reporting.asd
  13. +5 −9 test-grid-tests.asd
  14. +44 −44 test-grid-tests.lisp
  15. +18 −0 test-grid-testsuites.asd
  16. +11 −0 test-grid-utils.asd
  17. +0 −22 test-grid.asd
  18. 0 { → testsuites}/apis-of-test-frameworks/api-dsl.asd
  19. 0 { → testsuites}/apis-of-test-frameworks/api-dsl.lisp
  20. 0 { → testsuites}/apis-of-test-frameworks/eos-api-impl.asd
  21. 0 { → testsuites}/apis-of-test-frameworks/eos-api-impl.lisp
  22. 0 { → testsuites}/apis-of-test-frameworks/eos-api.asd
  23. 0 { → testsuites}/apis-of-test-frameworks/eos-api.lisp
  24. 0 { → testsuites}/apis-of-test-frameworks/fiveam-api-impl.asd
  25. 0 { → testsuites}/apis-of-test-frameworks/fiveam-api-impl.lisp
  26. 0 { → testsuites}/apis-of-test-frameworks/fiveam-api.asd
  27. 0 { → testsuites}/apis-of-test-frameworks/fiveam-api.lisp
  28. 0 { → testsuites}/apis-of-test-frameworks/lift-api-impl.asd
  29. 0 { → testsuites}/apis-of-test-frameworks/lift-api-impl.lisp
  30. 0 { → testsuites}/apis-of-test-frameworks/lift-api.asd
  31. 0 { → testsuites}/apis-of-test-frameworks/lift-api.lisp
  32. 0 { → testsuites}/apis-of-test-frameworks/rt-api-impl.asd
  33. 0 { → testsuites}/apis-of-test-frameworks/rt-api-impl.lisp
  34. 0 { → testsuites}/apis-of-test-frameworks/rt-api.asd
  35. 0 { → testsuites}/apis-of-test-frameworks/rt-api.lisp
  36. 0 { → testsuites}/apis-of-test-frameworks/stefil-api-impl.asd
  37. 0 { → testsuites}/apis-of-test-frameworks/stefil-api-impl.lisp
  38. 0 { → testsuites}/apis-of-test-frameworks/stefil-api.asd
  39. 0 { → testsuites}/apis-of-test-frameworks/stefil-api.lisp
  40. 0 { → testsuites}/sample-test-suites/eos-sample-test-suite.asd
  41. 0 { → testsuites}/sample-test-suites/eos-sample-test-suite.lisp
  42. 0 { → testsuites}/sample-test-suites/fiveam-sample-test-suite.asd
  43. 0 { → testsuites}/sample-test-suites/fiveam-sample-test-suite.lisp
  44. 0 { → testsuites}/sample-test-suites/lift-sample-test-suite.asd
  45. 0 { → testsuites}/sample-test-suites/lift-sample-test-suite.lisp
  46. 0 { → testsuites}/sample-test-suites/rt-sample-test-suite.asd
  47. 0 { → testsuites}/sample-test-suites/rt-sample-test-suite.lisp
  48. 0 { → testsuites}/sample-test-suites/stefil-sample-test-suite.asd
  49. 0 { → testsuites}/sample-test-suites/stefil-sample-test-suite.lisp
  50. +24 −118 test-grid.lisp → testsuites/testsuites.lisp
  51. +4 −2 { → utils}/utils.lisp
View
25 admin/import-test-result-emails.lisp
@@ -36,11 +36,11 @@
(length uids))
(defun save-letter-uids (letter-uids work-dir)
- (test-grid::write-to-file letter-uids (merge-pathnames "letter-uids.txt" work-dir))
+ (test-grid-utils::write-to-file letter-uids (merge-pathnames "letter-uids.txt" work-dir))
letter-uids)
(defun read-letter-uids (work-dir)
- (test-grid::safe-read-file (merge-pathnames "letter-uids.txt" work-dir)))
+ (test-grid-utils::safe-read-file (merge-pathnames "letter-uids.txt" work-dir)))
(defun save-string (str pathname)
(with-open-file (stream pathname
@@ -109,22 +109,25 @@ using SAVE-LETTER-UIDS function."
(setf (gethash lisp lisp-table) t)))
(defun print-commit-message (table)
- (dolist (contributor (sort (test-grid::hash-table-keys table) #'string<))
+ (dolist (contributor (sort (test-grid-utils::hash-table-keys table) #'string<))
(let ((lib-world-table (gethash contributor table)))
- (dolist (lib-world (sort (test-grid::hash-table-keys lib-world-table) #'string<))
+ (dolist (lib-world (sort (test-grid-utils::hash-table-keys lib-world-table) #'string<))
(format t "Test results for ~A and ~{~A~^, ~}. "
lib-world
- (sort (test-grid::hash-table-keys (gethash lib-world
+ (sort (test-grid-utils::hash-table-keys (gethash lib-world
lib-world-table))
#'string<))))
(format t "Contributed by ~A.~%" contributor)))
;;; End commit message helper.
+(defun src-dir()
+ (asdf:system-relative-pathname :test-grid-admin #P"admin/"))
+
(defparameter *host* "pop.yandex.ru")
(defparameter *user* "cl-test-grid")
-(defparameter *work-dir* (merge-pathnames "admin/mail-import-work-dir/"
- test-grid-config:*src-base-dir*))
+(defparameter *work-dir* (merge-pathnames "../work-dir/admin/mail-import/"
+ (src-dir)))
(defun import-test-result-emails (mailbox-password)
"Reads email notifications about new test results and
@@ -146,16 +149,16 @@ the procedure."
(let* ((attachment-files (get-all-attachments *host* *user* mailbox-password *work-dir*))
(submittions-info (make-submittions-info-table))
- (db (test-grid::read-db)) )
+ (db (test-grid-data::read-db)) )
(dolist (attachment-file attachment-files)
- (let* ((test-run-info (test-grid::safe-read-file attachment-file))
+ (let* ((test-run-info (test-grid-utils::safe-read-file attachment-file))
(descr (getf test-run-info :descr)))
- (test-grid::add-run test-run-info db)
+ (test-grid-data::add-run test-run-info db)
(add-submittions-info submittions-info
(getf (getf descr :contact) :email)
(getf descr :lib-world)
(getf descr :lisp))))
- (test-grid::save-db db)
+ (test-grid-data::save-db db)
(print-commit-message submittions-info)
(length attachment-files)))
View
20 agent/agent.lisp
@@ -12,19 +12,19 @@
(make-instance 'agent-impl))
;;; File system roots:
-(defun work-dir ()
- (merge-pathnames "work-dir/agent/"
- test-grid-config::*src-base-dir*))
-(defun src-dir ()
- "File system location of test-grid-agent source code"
- (merge-pathnames "agent/"
- test-grid-config::*src-base-dir*))
+(defun src-dir()
+ (asdf:system-relative-pathname :test-grid-agent #P"agent/"))
+
+(defun src-super-root()
+ (merge-pathnames "../" (src-dir)))
+
+(defun work-dir ()
+ (merge-pathnames "work-dir/agent/" (src-super-root)))
;;; Working directory structure
(defun test-output-base-dir ()
- (merge-pathnames "test-runs/"
- (work-dir)))
+ (merge-pathnames "test-runs/" (work-dir)))
(defun log-file ()
;; good thing about log4cl, it creates
@@ -192,7 +192,7 @@ the PREDICATE."
(log:info "Running tests for ~A" (implementation-identifier lisp))
(let ((results-dir (perform-test-run lib-world
lisp
- '(:alexandria) ;test-grid::*all-libs*
+ test-grid-testsuites::*all-libs*
(test-output-base-dir)
(user-email agent))))
(submit-test-run-results (blobstore agent) results-dir)
View
16 agent/perform-test-run.lisp
@@ -51,7 +51,7 @@ data (libraries test suites output and the run results) will be saved."
:element-type 'character ;'(unsigned-byte 8) + flexi-stream
:if-exists :supersede
:if-does-not-exist :create)
- (test-grid::print-test-run out test-run))))
+ (test-grid-data::print-test-run out test-run))))
(defun lib-log-file (test-run-directory lib-name)
(merge-pathnames (substitute #\- #\.
@@ -70,7 +70,7 @@ as hung, kill the lisp process and record a :FAIL
as the library test result.")
(defun proc-run-libtest (lisp-exe libname run-descr logfile asdf-output-dir)
- "Runs test-grid::run-libtest in a separate process and returns the result."
+ "Runs test-grid-testsuites::run-libtest in a separate process and returns the result."
(flet ((finish-test-log-with-failure (format-control &rest format-arguments)
;; Helper function to record failure status to the library
;; test log if the child lisp process running
@@ -85,7 +85,7 @@ as the library test result.")
:if-does-not-exist :create
:if-exists :append)
(apply #'format out format-control format-arguments)
- (test-grid::print-log-footer libname :fail out))))
+ (test-grid-testsuites::print-log-footer libname :fail out))))
(let ((start-time (get-internal-real-time))
(status (handler-case
(with-response-file (response-file)
@@ -114,7 +114,7 @@ as the library test result.")
(log:info "The ~A test suite status: ~S" libname status)
(list :libname libname
:status status
- :log-byte-length (test-grid::file-byte-length logfile)
+ :log-byte-length (test-grid-utils::file-byte-length logfile)
:test-duration (/ (- (get-internal-real-time) start-time)
internal-time-units-per-second)))))
@@ -140,13 +140,13 @@ as the library test result.")
run-dir)))
(defun submit-logs (blobstore test-run-dir)
- (let* ((run-info (test-grid::safe-read-file (run-info-file test-run-dir)))
+ (let* ((run-info (test-grid-utils::safe-read-file (run-info-file test-run-dir)))
;; prepare parameters for the SUBMIT-FILES blobstore function
(submit-params (mapcar #'(lambda (lib-result)
(let ((libname (getf lib-result :libname)))
(cons libname
(lib-log-file test-run-dir libname))))
- (test-grid::run-results run-info))))
+ (test-grid-data::run-results run-info))))
;; submit files to the blobstore and receive
;; their blobkeys in response
(let ((libname-to-blobkey-alist
@@ -158,12 +158,12 @@ as the library test result.")
(flet ((get-blob-key (lib)
(or (cdr (assoc lib libname-to-blobkey-alist))
(error "blobstore didn't returned blob key for the log of the ~A libary" lib))))
- (setf (test-grid::run-results run-info)
+ (setf (test-grid-data::run-results run-info)
(mapcar #'(lambda (lib-result)
(setf (getf lib-result :log-blob-key)
(get-blob-key (getf lib-result :libname)))
lib-result)
- (test-grid::run-results run-info))))
+ (test-grid-data::run-results run-info))))
;; finally, save the updated run-info with blobkeys
;; to the file. Returns the run-info.
(save-run-info run-info test-run-dir)
View
6 agent/persistence.lisp
@@ -29,14 +29,14 @@ exitst, loads the data saved there."))
(defun save (persistence)
;; todo: sort and newline for each record
- (test-grid::write-to-file (state persistence)
- (file persistence)))
+ (test-grid-utils::write-to-file (state persistence)
+ (file persistence)))
(defmethod init-persistence (file)
(let ((p (make-instance 'persistence :file file)))
(when (probe-file file)
(setf (state p)
- (test-grid::safe-read-file file)))
+ (test-grid-utils::safe-read-file file)))
p))
(defmethod get-agent-id ((persistence persistence))
View
8 agent/proc-run-libtest.lisp
@@ -2,7 +2,7 @@
;;;; Copyright (C) 2011 Anton Vodonosov (avodonosov@yandex.ru)
;;;; See LICENSE for details.
-;;;; This file is loaded into a child lisp process to run a test suite using test-grid::run-libtest.
+;;;; This file is loaded into a child lisp process to run a test suite using test-grid-testsuites::run-libtest.
(in-package :cl-user)
@@ -16,7 +16,7 @@
(load (merge-pathnames "proc-common.lisp" this-file-dir)))
-(ql:quickload :test-grid)
+(ql:quickload :test-grid-testsuites)
(defun setup-asdf-output-translations (private-quicklisp-dir asdf-output-root-dir)
;; Configure ASDF so that .fasl files from our private quicklisp
@@ -72,7 +72,7 @@
private-quicklisp-dir))
(libs-output-dir (merge-pathnames (make-pathname :directory '(:relative "private-quicklisp"))
asdf-output-root-dir))
- (test-grid-dir test-grid-config:*src-base-dir*)
+ (test-grid-dir (asdf:system-relative-pathname :test-grid-testsuites #P"../"))
(test-grid-output-dir (merge-pathnames (make-pathname :directory '(:relative "test-grid"))
asdf-output-root-dir)))
(asdf::defun* asdf:apply-output-translations (path)
@@ -93,5 +93,5 @@
(setup-asdf-output-translations (private-quicklisp-dir) asdf-output-root-dir)
- (let ((lib-result (test-grid::run-libtest libname run-descr logfile)))
+ (let ((lib-result (test-grid-testsuites::run-libtest libname run-descr logfile)))
(set-response response-file lib-result)))
View
2 agent/with-response-file.lisp
@@ -36,7 +36,7 @@
(response-file (workdir-file response-file-name)))
(unwind-protect (progn (funcall body-func response-file)
(handler-case
- (test-grid::safe-read-file response-file)
+ (test-grid-utils::safe-read-file response-file)
(serious-condition (condition)
(error 'no-response :cause condition
:format-control "Error reading response file ~A. Caused by serious condition \"~A\" of type ~A."
View
0 db.lisp → data/db.lisp
File renamed without changes.
View
63 reporting/reporting.lisp
@@ -1,21 +1,21 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: test-grid; Base: 10; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
+;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
+;;;; Copyright (C) 2011 Anton Vodonosov (avodonosov@yandex.ru)
+;;;; See LICENSE for details.
(defpackage #:test-grid-reporting
(:use :cl))
(in-package #:test-grid-reporting)
;; -------------- the reporting source code directory -----------;;
-
-(defun src-dir ()
- (merge-pathnames "reporting/"
- test-grid-config:*src-base-dir*))
+(defun src-dir()
+ (asdf:system-relative-pathname :test-grid-reporting #P"reporting/"))
;; ------ file system location for generated reports ------
(defun reports-dir ()
(merge-pathnames "reports-generated/"
- test-grid-config:*src-base-dir*))
+ (merge-pathnames #P"../" (src-dir))))
(defun with-report-file-impl (filename handler-func)
(let ((reports-dir (reports-dir)))
@@ -43,7 +43,7 @@
(subseq template (+ pos (length placeholder))))))
(defun fmt-template (file substitutions-alist)
- (let ((template (test-grid::file-string file)))
+ (let ((template (test-grid-utils::file-string file)))
(dolist (subst substitutions-alist)
(setf template (replace-str template (car subst) (cdr subst))))
template))
@@ -72,10 +72,10 @@
"other-user@gmail.com"
"foo@gmail.com")))))
(lib-results '()))
- (dolist (lib test-grid::*all-libs*)
+ (dolist (lib test-grid-testsuites::*all-libs*)
(push (list :libname lib :status (random-status) :log-char-length 50)
lib-results))
- (push (test-grid::make-run run-descr lib-results) runs))))
+ (push (test-grid-agent::make-run run-descr lib-results) runs))))
runs)))
;; ------ a lib result with a reference to it's test run ------
@@ -117,7 +117,8 @@
(defun lib-log-local-uri (joined-lib-result)
(format nil "file://~A~A"
- (test-grid::run-directory (test-grid::run-descr (test-run joined-lib-result)))
+ (test-grid-agent::run-directory (test-grid-data::run-descr (test-run joined-lib-result))
+ (test-grid-agent::test-output-base-dir))
(string-downcase (getf (lib-result joined-lib-result) :libname))))
(defun no-blob-key-js-alert (&rest unused-args)
@@ -144,7 +145,7 @@ values: :OK, :UNEXPECTED-OK, :FAIL, :NO-RESOURSE, :KNOWN-FAIL."
(if (null known-to-fail)
:ok
:unexpected-ok))
- ((test-grid::set= failed-tests known-to-fail :test #'string=)
+ ((test-grid-utils::set= failed-tests known-to-fail :test #'string=)
:known-fail)
(t :fail))))))
@@ -175,44 +176,44 @@ values: :OK, :UNEXPECTED-OK, :FAIL, :NO-RESOURSE, :KNOWN-FAIL."
(single-letter-status status)))))
(defun test-runs-table-html (&optional
- (db test-grid::*db*)
+ (db test-grid-data::*db*)
(status-renderer 'render-single-letter-status))
(with-output-to-string (out)
(write-line "<table cellspacing=\"1\" class=\"tablesorter\">" out)
(princ "<thead><tr style=\"vertical-align: bottom;\"><th>Start Time</th><th>Lib World</th><th>Lisp</th><th>Runner</th>" out)
- (dolist (lib test-grid::*all-libs*)
+ (dolist (lib test-grid-testsuites::*all-libs*)
(format out "<th>~A</th>" (vertical-html lib)))
(write-line "</tr></thead>" out)
(write-line "<tbody>" out)
(dolist (run (getf db :runs))
- (let ((run-descr (test-grid::run-descr run))
- (lib-statuses (test-grid::run-results run)))
+ (let ((run-descr (test-grid-data::run-descr run))
+ (lib-statuses (test-grid-data::run-results run)))
(format out "<tr><td>~A</td><td>~A</td><td>~A</td><td>~A</td>"
- (test-grid::pretty-fmt-time (getf run-descr :time))
+ (test-grid-testsuites::pretty-fmt-time (getf run-descr :time))
(getf run-descr :lib-world)
(getf run-descr :lisp)
(getf (getf run-descr :contact) :email))
- (dolist (lib test-grid::*all-libs*)
+ (dolist (lib test-grid-testsuites::*all-libs*)
(format out "<td>~A</td>"
(funcall status-renderer run (find lib lib-statuses
- :key (test-grid::getter :libname)))))
+ :key (test-grid-utils::getter :libname)))))
(write-line "</tr>" out)))
(write-line "</tbody>" out)
(write-line "</table>" out)))
-(defun test-runs-report (&optional (db test-grid::*db*))
+(defun test-runs-report (&optional (db test-grid-testsuites::*db*))
(fmt-template *test-runs-report-template*
`(("{THE-TABLE}" . ,(test-runs-table-html db))
- ("{TIME}" . ,(test-grid::pretty-fmt-time (get-universal-time))))))
+ ("{TIME}" . ,(test-grid-testsuites::pretty-fmt-time (get-universal-time))))))
;; ============== CSV export ==================
-(defun export-to-csv (out &optional (db test-grid::*db*))
+(defun export-to-csv (out &optional (db test-grid-data::*db*))
(format out "Lib World,Lisp,Runner,LibName,Status,TestDuration~%")
(dolist (run (getf db :runs))
- (let ((run-descr (test-grid::run-descr run)))
- (dolist (lib-result (test-grid::run-results run))
+ (let ((run-descr (test-grid-data::run-descr run)))
+ (dolist (lib-result (test-grid-data::run-results run))
(format out "~a,~a,~a,~a,~a,~a~%"
(getf run-descr :lib-world)
(getf run-descr :lisp)
@@ -255,7 +256,7 @@ values: :OK, :UNEXPECTED-OK, :FAIL, :NO-RESOURSE, :KNOWN-FAIL."
(defun do-results-impl (db handler)
"Handler is a function of two arguments: TEST-RUN and LIB-RESULT"
(dolist (test-run (getf db :runs))
- (dolist (lib-result (test-grid::run-results test-run))
+ (dolist (lib-result (test-grid-data::run-results test-run))
(funcall handler test-run lib-result))))
(defmacro do-results ((test-run-var lib-result-var db) &body body)
@@ -266,7 +267,7 @@ values: :OK, :UNEXPECTED-OK, :FAIL, :NO-RESOURSE, :KNOWN-FAIL."
(defun build-joined-index (db)
(let ((all-results (make-hash-table :test 'equal)))
(do-results (run lib-result db)
- (let* ((run-descr (test-grid::run-descr run))
+ (let* ((run-descr (test-grid-data::run-descr run))
(lisp (getf run-descr :lisp))
(lib-world (getf run-descr :lib-world))
(libname (getf lib-result :libname)))
@@ -367,7 +368,7 @@ returned list is specified by FIELDS."
distinct)
t))
joined-index)
- (test-grid::hash-table-keys distinct)))
+ (test-grid-utils::hash-table-keys distinct)))
;; Take into account the specifics of HTML tables - the
;; headers which group several rows or columns, will
@@ -554,10 +555,10 @@ Every subaddress represents some level of pivot groupping."
(princ "<table border=\"1\" class=test-table>" out)
(let* ((row-comparator #'(lambda (rowa rowb)
- (test-grid::list< row-fields-sort-predicates
+ (test-grid-utils::list< row-fields-sort-predicates
rowa rowb)))
(col-comparator #'(lambda (cola colb)
- (test-grid::list< col-fields-sort-predicates
+ (test-grid-utils::list< col-fields-sort-predicates
cola colb)))
(rows (sort (distinct-addresses joined-index row-fields)
row-comparator))
@@ -605,7 +606,7 @@ Every subaddress represents some level of pivot groupping."
(write-sequence (fmt-template *pivot-report-template*
`(("{THE-TABLE}" . ,table)
- ("{TIME}" . ,(test-grid::pretty-fmt-time (get-universal-time)))))
+ ("{TIME}" . ,(test-grid-testsuites::pretty-fmt-time (get-universal-time)))))
out)))
(defun print-pivot-reports (joined-index)
@@ -865,7 +866,7 @@ specified by QUICKLISP-NEW and QUICKLISP-OLD."
(funcall lib-world-setter* index-key (list lib-world))))
(lisp-getter (lambda (index-key) (car (funcall lisp-getter* index-key))))
(new-quicklisp-keys (remove quicklisp-new
- (test-grid::hash-table-keys db-index)
+ (test-grid-utils::hash-table-keys db-index)
:key lib-world-getter
:test (complement #'string=))))
(dolist (key new-quicklisp-keys)
@@ -941,7 +942,7 @@ specified by QUICKLISP-NEW and QUICKLISP-OLD."
;; =========== print all the reports at once =============
-(defun generate-reports (&optional (db test-grid::*db*))
+(defun generate-reports (&optional (db test-grid-data::*db*))
(with-report-file (out "test-runs-report.html")
(write-sequence (test-runs-report db) out))
View
2 test-grid-admin.asd
@@ -7,7 +7,7 @@
(asdf:defsystem #:test-grid-admin
:version "0.1.0"
:serial t
- :depends-on (#:test-grid #:cl-pop #:cl-mime #:cl-base64)
+ :depends-on (#:test-grid-data #:test-grid-utils #:cl-pop #:cl-mime #:cl-base64)
:components
((:module "admin"
:serial t
View
4 test-grid-agent.asd
@@ -11,7 +11,9 @@
(asdf:defsystem #:test-grid-agent
:version "1.0.1"
:serial t
- :depends-on (#:test-grid
+ :depends-on (#:test-grid-utils
+ #:test-grid-data
+ #:test-grid-testsuites
#:test-grid-blobstore
#:test-grid-gae-blobstore
#:alexandria
View
11 test-grid-data.asd
@@ -0,0 +1,11 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; -*-
+;;; Copyright (C) 2011 Anton Vodonosov (avodonosov@yandex.ru)
+;;; See LICENSE for details.
+
+(asdf:defsystem #:test-grid-data
+ :version "0.3.1"
+ :serial t
+ :components
+ ((:module "data"
+ :serial t
+ :components ((:file "data")))))
View
4 test-grid-reporting.asd
@@ -1,13 +1,11 @@
;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; -*-
-;;;
;;; Copyright (C) 2011 Anton Vodonosov (avodonosov@yandex.ru)
-;;;
;;; See LICENSE for details.
(asdf:defsystem #:test-grid-reporting
:version "0.1.0"
:serial t
- :depends-on (#:test-grid)
+ :depends-on (#:test-grid-data #:test-grid-utils #:test-grid-agent)
:components
((:module "reporting"
:serial t
View
14 test-grid-tests.asd
@@ -7,16 +7,12 @@
(asdf:defsystem #:test-grid-tests
:version "0.1.0"
:serial t
- :depends-on (#:test-grid #:test-grid-reporting)
+ :depends-on (#:test-grid-testsuites #:test-grid-reporting)
:components ((:file "test-grid-tests")))
-(defpackage #:test-grid-tests-config (:export #:*src-base-dir*))
-(defparameter test-grid-tests-config:*src-base-dir*
- (make-pathname :name nil :type nil :defaults *load-truename*))
-
;; make sample test suites available to ASDF
-(pushnew (merge-pathnames "sample-test-suites/"
- test-grid-tests-config:*src-base-dir*)
- asdf:*central-registry*
- :test #'equal)
+(let ((this-directory (make-pathname :name nil :type nil :defaults *load-truename*)))
+ (cl:pushnew (merge-pathnames #P"testsuites/sample-test-suites/" this-directory)
+ asdf:*central-registry*
+ :test #'equal))
View
88 test-grid-tests.lisp
@@ -4,68 +4,68 @@
(in-package #:test-grid-tests)
(defun test-rt-api ()
- (test-grid::clean-rt)
+ (test-grid-testsuites::clean-rt)
(asdf:clear-system :rt-sample-test-suite)
(asdf:operate 'asdf:load-op :rt-sample-test-suite)
- (let ((status (test-grid::run-rt-test-suite)))
- (and (test-grid::set= (getf status :failed-tests)
- '("test-1" "test-4")
- :test #'string=)
- (test-grid::set= (getf status :known-to-fail)
- '("test-3")
- :test #'string=))))
+ (let ((status (test-grid-testsuites::run-rt-test-suite)))
+ (and (test-grid-utils::set= (getf status :failed-tests)
+ '("test-1" "test-4")
+ :test #'string=)
+ (test-grid-utils::set= (getf status :known-to-fail)
+ '("test-3")
+ :test #'string=))))
(defun test-lift-api ()
(asdf:operate 'asdf:load-op :lift-sample-test-suite)
- (let ((status (test-grid::run-lift-test-suite :sample-lift-suite)))
- (and (test-grid::set= (getf status :failed-tests)
- '("sample-lift-suite.test-2"
- "sample-lift-suite.2-plus-2-is-3"
- "sample-lift-suite.expected-error-test"
- "sample-lift-suite.expected-failure-test"
- "sample-lift-suite.expected-problem-test"
- "sample-lift-suite.expected-error-but-fail-test")
- :test #'string=)
- (test-grid::set= (getf status :known-to-fail)
- '("sample-lift-suite.expected-error-test"
- "sample-lift-suite.expected-failure-test"
- "sample-lift-suite.expected-problem-test"
- "sample-lift-suite.unexpected-no-failure-test"
- "sample-lift-suite.unexpected-no-error-test"
- "sample-lift-suite.expected-error-but-fail-test")
- :test #'string=))))
+ (let ((status (test-grid-testsuites::run-lift-test-suite :sample-lift-suite)))
+ (and (test-grid-utils::set= (getf status :failed-tests)
+ '("sample-lift-suite.test-2"
+ "sample-lift-suite.2-plus-2-is-3"
+ "sample-lift-suite.expected-error-test"
+ "sample-lift-suite.expected-failure-test"
+ "sample-lift-suite.expected-problem-test"
+ "sample-lift-suite.expected-error-but-fail-test")
+ :test #'string=)
+ (test-grid-utils::set= (getf status :known-to-fail)
+ '("sample-lift-suite.expected-error-test"
+ "sample-lift-suite.expected-failure-test"
+ "sample-lift-suite.expected-problem-test"
+ "sample-lift-suite.unexpected-no-failure-test"
+ "sample-lift-suite.unexpected-no-error-test"
+ "sample-lift-suite.expected-error-but-fail-test")
+ :test #'string=))))
(defun test-fiveam-api ()
(asdf:operate 'asdf:load-op :fiveam-sample-test-suite)
- (let ((status (test-grid::run-fiveam-test-suite :sample-fiveam-suite)))
- (and (test-grid::set= (getf status :failed-tests)
- '("fiveam-sample-test-suite.error-test"
- "fiveam-sample-test-suite.fail-test")
- :test #'string=)
+ (let ((status (test-grid-testsuites::run-fiveam-test-suite :sample-fiveam-suite)))
+ (and (test-grid-utils::set= (getf status :failed-tests)
+ '("fiveam-sample-test-suite.error-test"
+ "fiveam-sample-test-suite.fail-test")
+ :test #'string=)
(null (getf status :known-to-fail)))))
(defun test-eos-api ()
(asdf:operate 'asdf:load-op :eos-sample-test-suite)
- (let ((status (test-grid::run-eos-test-suites :sample-eos-suite)))
- (and (test-grid::set= (getf status :failed-tests)
- '("eos-sample-test-suite.error-test"
- "eos-sample-test-suite.fail-test")
- :test #'string=)
+ (let ((status (test-grid-testsuites::run-eos-test-suites :sample-eos-suite)))
+ (and (test-grid-utils::set= (getf status :failed-tests)
+ '("eos-sample-test-suite.error-test"
+ "eos-sample-test-suite.fail-test")
+ :test #'string=)
(null (getf status :known-to-fail)))))
(defun test-stefil-api ()
(asdf:operate 'asdf:load-op :stefil-sample-test-suite)
- (let ((status (test-grid::run-stefil-test-suite (intern (string '#:sample-stefil-suite)
- '#:stefil-sample-test-suite))))
- (and (test-grid::set= (getf status :failed-tests)
- '("sample-stefil-suite.one-fail-test"
- "sample-stefil-suite.two-fails-test"
- "sample-stefil-suite.error-test"
- "sample-stefil-suite.all-fails-expected-test"
- "sample-stefil-suite.not-all-fails-expected-test")
- :test #'string=)
+ (let ((status (test-grid-testsuites::run-stefil-test-suite (intern (string '#:sample-stefil-suite)
+ '#:stefil-sample-test-suite))))
+ (and (test-grid-utils::set= (getf status :failed-tests)
+ '("sample-stefil-suite.one-fail-test"
+ "sample-stefil-suite.two-fails-test"
+ "sample-stefil-suite.error-test"
+ "sample-stefil-suite.all-fails-expected-test"
+ "sample-stefil-suite.not-all-fails-expected-test")
+ :test #'string=)
(null (getf status :known-to-fail)))))
(defun test-aggregated-status ()
View
18 test-grid-testsuites.asd
@@ -0,0 +1,18 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; -*-
+;;; Copyright (C) 2011 Anton Vodonosov (avodonosov@yandex.ru)
+;;; See LICENSE for details.
+
+;; make the subcomponents available to ASDF
+(let ((this-directory (make-pathname :name nil :type nil :defaults *load-truename*)))
+ (cl:pushnew (merge-pathnames #P"testsuites/apis-of-test-frameworks/" this-directory)
+ asdf:*central-registry*
+ :test #'equal))
+
+(asdf:defsystem #:test-grid-testsuites
+ :version "0.3.1"
+ :serial t
+ :depends-on (#:quicklisp #:test-grid-data #:test-grid-utils #:rt-api #:lift-api #:fiveam-api #:eos-api #:stefil-api)
+ :components
+ ((:module "testsuites"
+ :serial t
+ :components ((:file "testsuites")))))
View
11 test-grid-utils.asd
@@ -0,0 +1,11 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; -*-
+;;; Copyright (C) 2011 Anton Vodonosov (avodonosov@yandex.ru)
+;;; See LICENSE for details.
+
+(asdf:defsystem #:test-grid-utils
+ :version "0.3.1"
+ :serial t
+ :components
+ ((:module "utils"
+ :serial t
+ :components ((:file "utils")))))
View
22 test-grid.asd
@@ -1,22 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; -*-
-;;;
-;;; Copyright (C) 2011 Anton Vodonosov (avodonosov@yandex.ru)
-;;;
-;;; See LICENSE for details.
-
-(defpackage #:test-grid-config (:export #:*src-base-dir*))
-(defparameter test-grid-config:*src-base-dir*
- (make-pathname :name nil :type nil :defaults *load-truename*))
-
-;; make the subcomponents available to ASDF
-(cl:pushnew (merge-pathnames "apis-of-test-frameworks/"
- test-grid-config:*src-base-dir*)
- asdf:*central-registry*
- :test #'equal)
-
-(asdf:defsystem #:test-grid
- :version "0.3.1"
- :serial t
- :depends-on (#:quicklisp #:test-grid-blobstore #:rt-api #:lift-api #:fiveam-api #:eos-api #:stefil-api)
- :components ((:file "utils")
- (:file "test-grid")))
View
0 apis-of-test-frameworks/api-dsl.asd → ...uites/apis-of-test-frameworks/api-dsl.asd
File renamed without changes.
View
0 apis-of-test-frameworks/api-dsl.lisp → ...ites/apis-of-test-frameworks/api-dsl.lisp
File renamed without changes.
View
0 apis-of-test-frameworks/eos-api-impl.asd → .../apis-of-test-frameworks/eos-api-impl.asd
File renamed without changes.
View
0 apis-of-test-frameworks/eos-api-impl.lisp → ...apis-of-test-frameworks/eos-api-impl.lisp
File renamed without changes.
View
0 apis-of-test-frameworks/eos-api.asd → ...uites/apis-of-test-frameworks/eos-api.asd
File renamed without changes.
View
0 apis-of-test-frameworks/eos-api.lisp → ...ites/apis-of-test-frameworks/eos-api.lisp
File renamed without changes.
View
0 apis-of-test-frameworks/fiveam-api-impl.asd → ...is-of-test-frameworks/fiveam-api-impl.asd
File renamed without changes.
View
0 apis-of-test-frameworks/fiveam-api-impl.lisp → ...s-of-test-frameworks/fiveam-api-impl.lisp
File renamed without changes.
View
0 apis-of-test-frameworks/fiveam-api.asd → ...es/apis-of-test-frameworks/fiveam-api.asd
File renamed without changes.
View
0 apis-of-test-frameworks/fiveam-api.lisp → ...s/apis-of-test-frameworks/fiveam-api.lisp
File renamed without changes.
View
0 apis-of-test-frameworks/lift-api-impl.asd → ...apis-of-test-frameworks/lift-api-impl.asd
File renamed without changes.
View
0 apis-of-test-frameworks/lift-api-impl.lisp → ...pis-of-test-frameworks/lift-api-impl.lisp
File renamed without changes.
View
0 apis-of-test-frameworks/lift-api.asd → ...ites/apis-of-test-frameworks/lift-api.asd
File renamed without changes.
View
0 apis-of-test-frameworks/lift-api.lisp → ...tes/apis-of-test-frameworks/lift-api.lisp
File renamed without changes.
View
0 apis-of-test-frameworks/rt-api-impl.asd → ...s/apis-of-test-frameworks/rt-api-impl.asd
File renamed without changes.
View
0 apis-of-test-frameworks/rt-api-impl.lisp → .../apis-of-test-frameworks/rt-api-impl.lisp
File renamed without changes.
View
0 apis-of-test-frameworks/rt-api.asd → ...suites/apis-of-test-frameworks/rt-api.asd
File renamed without changes.
View
0 apis-of-test-frameworks/rt-api.lisp → ...uites/apis-of-test-frameworks/rt-api.lisp
File renamed without changes.
View
0 apis-of-test-frameworks/stefil-api-impl.asd → ...is-of-test-frameworks/stefil-api-impl.asd
File renamed without changes.
View
0 apis-of-test-frameworks/stefil-api-impl.lisp → ...s-of-test-frameworks/stefil-api-impl.lisp
File renamed without changes.
View
0 apis-of-test-frameworks/stefil-api.asd → ...es/apis-of-test-frameworks/stefil-api.asd
File renamed without changes.
View
0 apis-of-test-frameworks/stefil-api.lisp → ...s/apis-of-test-frameworks/stefil-api.lisp
File renamed without changes.
View
0 sample-test-suites/eos-sample-test-suite.asd → ...ple-test-suites/eos-sample-test-suite.asd
File renamed without changes.
View
0 ...le-test-suites/eos-sample-test-suite.lisp → ...le-test-suites/eos-sample-test-suite.lisp
File renamed without changes.
View
0 ...-test-suites/fiveam-sample-test-suite.asd → ...-test-suites/fiveam-sample-test-suite.asd
File renamed without changes.
View
0 ...test-suites/fiveam-sample-test-suite.lisp → ...test-suites/fiveam-sample-test-suite.lisp
File renamed without changes.
View
0 ...le-test-suites/lift-sample-test-suite.asd → ...le-test-suites/lift-sample-test-suite.asd
File renamed without changes.
View
0 ...e-test-suites/lift-sample-test-suite.lisp → ...e-test-suites/lift-sample-test-suite.lisp
File renamed without changes.
View
0 sample-test-suites/rt-sample-test-suite.asd → ...mple-test-suites/rt-sample-test-suite.asd
File renamed without changes.
View
0 sample-test-suites/rt-sample-test-suite.lisp → ...ple-test-suites/rt-sample-test-suite.lisp
File renamed without changes.
View
0 ...-test-suites/stefil-sample-test-suite.asd → ...-test-suites/stefil-sample-test-suite.asd
File renamed without changes.
View
0 ...test-suites/stefil-sample-test-suite.lisp → ...test-suites/stefil-sample-test-suite.lisp
File renamed without changes.
View
142 test-grid.lisp → testsuites/testsuites.lisp
@@ -1,8 +1,18 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: test-grid; Base: 10; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-
-(defpackage #:test-grid (:use :cl))
-
-(in-package #:test-grid)
+;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
+;;;; Copyright (C) 2011 Anton Vodonosov (avodonosov@yandex.ru)
+;;;; See LICENSE for details.
+
+(defpackage #:test-grid-testsuites
+ (:use :cl)
+ (:export ;; list of the libraries added to test-grid
+ #:*all-libst
+ ;; the generic function to be implemented for evey library
+ #:libtest
+ ;; wrapper around libtests, does some housekeeping
+ ;; (candidate to move to the agent module)
+ #:run-libtest))
+
+(in-package #:test-grid-testsuites)
(defgeneric libtest (library-name)
(:documentation "Define a method for this function
@@ -44,7 +54,7 @@ it is not loaded yet).
Some of test-grid components have separate package
and ASDF system for API and separate package+ASDF
system for the implementation. This allows test-grid
-to be compilable and (partially) opereable even
+to be compilable and (partialuly) opereable even
when some components are broken on particular lisp.
For these known test-grid componetns REQUIRE-IMPL loads
@@ -153,7 +163,7 @@ just passed to the QUICKLISP:QUICKLOAD."
(with-input-from-string (test-output (get-output-stream-string test-output-buf))
(do ((line (read-line test-output nil) (read-line test-output nil)))
((null line))
- (when (starts-with line "not ok")
+ (when (test-grid-utils::starts-with line "not ok")
(format t "---------------------------------------------------------------------------~%")
(format t "~A test suite has a test failure; the first TAP output failure string:~%~A"
project-name line)
@@ -172,12 +182,12 @@ just passed to the QUICKLISP:QUICKLOAD."
:known-to-fail ("c"))
'(:failed-tests ("a2" "c2")
:known-to-fail ("b2")))))
- (and (set= '("a" "b" "a2" "c2")
- (getf combined :failed-tests)
- :test #'string=)
- (set= '("c" "b2")
- (getf combined :known-to-fail)
- :test #'string=))))
+ (and (test-grid-utils:set= '("a" "b" "a2" "c2")
+ (getf combined :failed-tests)
+ :test #'string=)
+ (test-grid-utils:set= '("c" "b2")
+ (getf combined :known-to-fail)
+ :test #'string=))))
(defmethod libtest ((library-name (eql :alexandria)))
@@ -912,7 +922,7 @@ just passed to the QUICKLISP:QUICKLOAD."
(terpri stream)
(format stream "============================================================~%")
(format stream " cl-test-grid status for ~A: ~A~%"
- libname (print-test-status nil status))
+ libname (test-grid-data::print-test-status nil status))
(format stream "============================================================~%")))
(defun run-libtest (lib run-descr log-file)
@@ -962,107 +972,3 @@ just passed to the QUICKLISP:QUICKLOAD."
(print-log-footer lib status *standard-output*)))
status))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Database
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defparameter *db* '(:version 0 :runs ()))
-
-(defvar *standard-db-file*
- (merge-pathnames "db.lisp"
- test-grid-config:*src-base-dir*))
-
-(defun add-run (run-info &optional (db *db*))
- (push run-info (getf db :runs)))
-
-(defun print-list-elements (destination list separator elem-printer)
- (let ((maybe-separator ""))
- (dolist (elem list)
- (format destination maybe-separator)
- (funcall elem-printer elem)
- (setf maybe-separator separator))))
-
-(defun print-list (destination list separator elem-printer)
- (format destination "(")
- (print-list-elements destination list separator elem-printer)
- (format destination ")"))
-
-(defun print-test-status (destination status)
- (etypecase status
- (symbol (format destination "~s" status))
- (list (progn
- (let ((dest (or destination (make-string-output-stream))))
- (flet ((test-name-printer (test-name)
- (format dest "~s" test-name)))
- (format dest "(:failed-tests ")
- (print-list dest (sort (copy-list (getf status :failed-tests))
- #'string<)
- " " #'test-name-printer)
- (format dest " :known-to-fail ")
- (print-list dest (sort (copy-list (getf status :known-to-fail))
- #'string<)
- " " #'test-name-printer)
- (format dest ")"))
- (if (null destination)
- (get-output-stream-string dest)
- nil))))))
-
-(defun run-descr (run)
- "The description part of the test run."
- (getf run :descr))
-
-(defun run-results (run)
- "The list of test suite statuses for every library in the specified test run."
- (getf run :results))
-
-(defun (setf run-results) (new-run-results test-run)
- (setf (getf test-run :results) new-run-results))
-
-(defun print-test-run (out test-run &optional (indent 0))
- (let ((descr (getf test-run :descr)))
- (format out
- "(:descr (:lisp ~s :lib-world ~s :time ~s :run-duration ~s :contact (:email ~s))~%"
- (getf descr :lisp)
- (getf descr :lib-world)
- (getf descr :time)
- (getf descr :run-duration)
- (getf (getf descr :contact) :email)))
- (format out "~v,0t:results (" (1+ indent))
- (print-list-elements out
- (sort (copy-list (getf test-run :results))
- #'string<
- :key #'(lambda (lib-result)
- (getf lib-result :libname)))
- (format nil "~~%~~~Dt" (+ indent 11))
- #'(lambda (lib-result)
- (format out
- "(:libname ~s :status ~a :test-duration ~s :log-byte-length ~s :log-blob-key ~s)"
- (getf lib-result :libname)
- (print-test-status nil (getf lib-result :status))
- (getf lib-result :test-duration)
- (getf lib-result :log-byte-length)
- (getf lib-result :log-blob-key))))
- (format out "))"))
-
-(defun save-db (&optional (db *db*) (stream-or-path *standard-db-file*))
- (with-open-file (out stream-or-path
- :direction :output
- :element-type 'character ;'(unsigned-byte 8) + flexi-stream
- :if-exists :supersede
- :if-does-not-exist :create)
- (format out "(:version ~a~%" (getf db :version))
- (format out " :runs (")
- (print-list-elements out
- (getf db :runs)
- "~%~8t"
- #'(lambda (test-run)
- (print-test-run out test-run 8)))
- (format out "))")))
-
-(defun read-db (&optional (stream-or-path *standard-db-file*))
- (with-open-file (in stream-or-path
- :direction :input
- :element-type 'character ;'(unsigned-byte 8) + flexi-stream
- )
- (safe-read in)))
-
View
6 utils.lisp → utils/utils.lisp
@@ -1,8 +1,10 @@
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: test-grid; Base: 10; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
-(defpackage #:test-grid (:use :cl))
+(defpackage #:test-grid-utils
+ (:use :cl)
+ (:export #:set=))
-(in-package #:test-grid)
+(in-package #:test-grid-utils)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utils

0 comments on commit 18d52c3

Please sign in to comment.