From 106e91b038191cec3271413a7a2bdd8317352277 Mon Sep 17 00:00:00 2001 From: Marco Baringer Date: Sat, 9 Feb 2013 12:08:27 +0100 Subject: [PATCH] Added simple rt compability layer (RT api backed by fiveam's explainers) --- fiveam-rt.asd | 12 +++++++++++ src/rt.lisp | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 75 insertions(+) create mode 100644 fiveam-rt.asd create mode 100644 src/rt.lisp diff --git a/fiveam-rt.asd b/fiveam-rt.asd new file mode 100644 index 0000000..1ad096a --- /dev/null +++ b/fiveam-rt.asd @@ -0,0 +1,12 @@ +;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- + +(defsystem :fiveam-it + :author "Edward Marco Baringer " + + :depends-on (:fiveam) + :pathname "src/" + :components ((:file "rt"))) + +;;;;@include "src/package.lisp" + +;;;;@include "t/example.lisp" diff --git a/src/rt.lisp b/src/rt.lisp new file mode 100644 index 0000000..66b2ba4 --- /dev/null +++ b/src/rt.lisp @@ -0,0 +1,63 @@ +(defpackage :fiveam.rt + (:use :fiveam :common-lisp) + (:export #:deftest + #:*test* + #:do-test + #:*do-tests-when-defined* + #:get-test + #:rem-test + #:rem-all-tests + #:do-tests + #:pending-tests + #:continue-testing)) + +(in-package :fiveam.rt) + +(fiveam:def-suite :rt + :description "Suite holding all tests defined via the RT compatability layer.") + +(defvar *test* nil) + +(defvar *tests* '()) + +(defvar *do-tests-when-defined* nil) + +(defmacro deftest (name form &rest values) + `(progn + (push (list ',name ',form (list ,@values)) *tests*) + (def-test ,name () + (is-true (every #'equal (multiple-value-list ,name) (list ,@values)))) + (when *do-tests-when-defined* + (do-test ',name)) + (setf *test* ',name))) + +(defun do-test (&optional (name *test*)) + (setf *test* name) + (let ((results (run name))) + (if (every #'fiveam::test-passed-p result) + name + (progn + (explain (make-instance 'fiveam::detailed-text-explainer) results) + nil)))) + +(defun get-test (&optional (name *test*)) + (find name *tests* :test #'eql :key #'first)) + +(defun rem-test (&optional (name *test*)) + (if (get-test name) + (progn + (setf *tests* (delete name *tests* :test #'eql :key #'first)) + (remhash name (fiveam::tests (get-test :rt))) + name) + nil)) + +(defun rem-all-tests () + (clrhash (fiveam::tests (get-test :rt))) + (setf *tests* '())) + +(defun do-tests (&optional (out *standard-output*)) + (loop + for test in *tests* + nconc (run (get-test (first test))) into results + finally (explain (make-instance 'fiveam::detailed-text-explainer) results) + finally (return (every #'fiveam::test-passed-p results)))) -- 1.7.10.4