Permalink
Browse files

Added clunit support to test-grid-testsuites. Adjusted cl-num-utils t…

…estsuite adapter (new version of cl-num-utils uses clunit instead of lift)
  • Loading branch information...
1 parent d7e2377 commit 5e91946782584f15ffcc72436efd4e4532b9898f @avodonosov avodonosov committed Mar 7, 2013
View
@@ -7,7 +7,7 @@
(asdf:defsystem #:test-grid-tests
:version "0.1.0"
:serial t
- :depends-on (#:test-grid-testsuites #:test-grid-reporting)
+ :depends-on (#:alexandria #:test-grid-testsuites #:test-grid-reporting)
:components ((:file "test-grid-tests")))
;; make sample test suites available to ASDF
View
@@ -1,5 +1,6 @@
(defpackage #:test-grid-tests
- (:use :cl))
+ (:use :cl)
+ (:export #:run-tests))
(in-package #:test-grid-tests)
@@ -10,62 +11,70 @@
(asdf:operate 'asdf:load-op :rt-sample-test-suite)
(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=))))
+ (and (alexandria:set-equal (getf status :failed-tests)
+ '("test-1" "test-4")
+ :test #'string=)
+ (alexandria:set-equal (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-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=))))
+ (and (alexandria:set-equal (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=)
+ (alexandria:set-equal (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-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=)
+ (and (alexandria:set-equal (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-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=)
+ (and (alexandria:set-equal (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-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=)
+ (let ((status (test-grid-testsuites::run-stefil-test-suite (read-from-string "stefil-sample-test-suite::sample-stefil-suite"))))
+ (and (alexandria:set-equal (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-clunit-api ()
+ (asdf:operate 'asdf:load-op :clunit-sample-test-suite)
+ (let ((status (test-grid-testsuites::run-clunit-test-suite (read-from-string "clunit-sample-test-suite::NumberSuite"))))
+ (and (alexandria:set-equal (getf status :failed-tests)
+ '("clunit-sample-test-suite::test-float1"
+ "clunit-sample-test-suite::test-int1")
+ :test #'string=)
(null (getf status :known-to-fail)))))
(defun test-aggregated-status ()
@@ -80,10 +89,12 @@
(eq :known-fail (test-grid-reporting::aggregated-status '(:failed-tests ("a") :known-to-fail ("a"))))
(eq :ok (test-grid-reporting::aggregated-status '(:failed-tests () :known-to-fail ())))))
-; to run the tests:
-(assert (and (test-rt-api)
- (test-lift-api)
- (test-fiveam-api)
- (test-eos-api)
- (test-stefil-api)
- (test-aggregated-status)))
+(defun run-tests ()
+ (format t "~&~%assert result: ~S"
+ (assert (and (test-rt-api)
+ (test-lift-api)
+ (test-fiveam-api)
+ (test-eos-api)
+ (test-stefil-api)
+ (test-clunit-api)
+ (test-aggregated-status)))))
View
@@ -11,7 +11,14 @@
(asdf:defsystem #:test-grid-testsuites
:version "0.3.1"
:serial t
- :depends-on (#:quicklisp #:test-grid-utils #:rt-api #:lift-api #:fiveam-api #:eos-api #:stefil-api)
+ :depends-on (#:quicklisp
+ #:test-grid-utils
+ #:rt-api
+ #:lift-api
+ #:fiveam-api
+ #:eos-api
+ #:stefil-api
+ #:clunit-api)
:components
((:module "testsuites"
:serial t
@@ -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 #:clunit-api-impl
+ :version "0.1.0"
+ :serial t
+ :depends-on (#:clunit-api)
+ :components ((:file "clunit-api-impl")))
@@ -0,0 +1,15 @@
+(defpackage #:clunit-api-impl
+ (:use #:cl :clunit-api))
+
+(in-package #:clunit-api-impl)
+
+(defun run-test-suite (test-suite-name)
+ (clunit:run-suite test-suite-name))
+
+(defun failed-tests (test-suite-result)
+ (mapcar (lambda (rep)
+ (let ((*package* (find-package '#:keyword)))
+ (format nil "~(~S~)" (slot-value rep 'clunit::test-name))))
+ (remove-if (lambda (rep)
+ (slot-value rep 'clunit::passed-p))
+ (slot-value test-suite-result 'clunit::test-reports))))
@@ -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 #:clunit-api
+ :version "0.1.0"
+ :serial t
+ :depends-on (#:api-dsl)
+ :components ((:file "clunit-api")))
@@ -0,0 +1,16 @@
+(defpackage #:clunit-api
+ (:use :cl #:api-dsl)
+ (:export #:run-test-suite
+ #:failed-tests))
+
+(in-package #:clunit-api)
+
+(proclfun run-test-suite ((test-suite-name symbol)) t
+ "Runs the clunit test suite specified by TEST-SUITE-NAME and
+returns an opaque result object. The result object may be passed
+to the FAILED-TESTS function to retreive the list of failed tests.")
+
+(proclfun failed-tests ((test-suite-result t)) list
+ "List of failed test names. Test names are downcased strings.
+The TEST-SUITE-RESULT parameter must be a result of the RUN-TEST-SUITE
+function.")
@@ -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 #:clunit-sample-test-suite
+ :version "0.1.0"
+ :serial t
+ :depends-on (#:clunit)
+ :components ((:file "clunit-sample-test-suite")))
@@ -0,0 +1,15 @@
+(defpackage #:clunit-sample-test-suite
+ (:use #:cl :clunit))
+
+(in-package #:clunit-sample-test-suite)
+
+(defsuite NumberSuite ())
+(defsuite FloatSuite (NumberSuite))
+(defsuite IntegerSuite (NumberSuite))
+(deftest test-int1 (IntegerSuite)
+ (assert-true (= 2 -2))
+ (assert-true (= 1 -1)))
+(deftest test-int2 (IntegerSuite)
+ (assert-true (= 2 2)))
+(deftest test-float1 (FloatSuite)
+ (assert-true (= 1.0 -1.0)))
View
@@ -62,7 +62,8 @@ just passed to the QUICKLISP:QUICKLOAD."
("lift-api" . "lift-api-impl")
("fiveam-api" . "fiveam-api-impl")
("eos-api" . "eos-api-impl")
- ("stefil-api" . "stefil-api-impl")))
+ ("stefil-api" . "stefil-api-impl")
+ ("clunit-api" . "clunit-api-impl")))
(impl-asdf-system (or (cdr (assoc api known-impls :test #'string=))
api)))
(quicklisp:quickload impl-asdf-system)))
@@ -132,6 +133,12 @@ just passed to the QUICKLISP:QUICKLOAD."
(list :failed-tests (stefil-api:failed-tests result)
:known-to-fail '())))
+(defun run-clunit-test-suite (test-suite-name)
+ (require-impl "clunit-api")
+ (let ((result (clunit-api:run-test-suite test-suite-name)))
+ (list :failed-tests (clunit-api:failed-tests result)
+ :known-to-fail '())))
+
(defun running-cl-test-more-suite (project-name runner-function)
;; cl-test-more test suites usually run tests during
;; the load time.
@@ -726,7 +733,11 @@ just passed to the QUICKLISP:QUICKLOAD."
;; The test framework used: lift.
(ql:quickload :cl-num-utils)
(ql:quickload :cl-num-utils-tests)
- (run-lift-test-suite (read-from-string "cl-num-utils-tests::cl-num-utils-tests")))
+ (if (member "lift"
+ (asdf::component-load-dependencies (asdf:find-system :cl-num-utils-tests))
+ :test #'string-equal)
+ (run-lift-test-suite (read-from-string "cl-num-utils-tests::cl-num-utils-tests"))
+ (run-clunit-test-suite (read-from-string "cl-num-utils-tests::tests"))))
(defmethod libtest ((library-name (eql :ieee-floats)))
;; test framework used: FiveAM

0 comments on commit 5e91946

Please sign in to comment.