(:file "packages")
(:file "run" :depends-on ("packages" "classes" "test" "suite" "check"))
(:file "suite" :depends-on ("packages" "test" "classes"))
+ (:file "random-check" :depends-on ("packages" "check"))
(:file "test" :depends-on ("packages" "classes"))))
(:module :t
:components ((:file "suite")
;;;; which prints a human readable summary (number passed, number
;;;; failed, what failed and why, etc.) of a list of test results.
-(defmethod explain ((exp detailed-text-explainer) results &optional (stream *test-dribble*))
- "Given a list of test results report write to stream detailed
- human readable statistics regarding the results."
+(defmethod explain ((exp detailed-text-explainer) results
+ &optional (stream *test-dribble*) (recursive-depth 0))
+ #| "Given a list of test results report write to stream detailed
+ human readable statistics regarding the results." |#
(multiple-value-bind (num-checks passed num-passed passed%
skipped num-skipped skipped%
failed num-failed failed%
unknown num-unknown unknown%)
(partition-results results)
(declare (ignore passed))
- (when (zerop num-checks)
- (format stream "~%Didn't run anything...huh?")
- (return-from explain nil))
- (format stream "~%Did ~D check~P.~%"
- num-checks num-checks)
- (format stream " Pass: ~D (~2D%)~%" num-passed passed%)
- (format stream " Skip: ~D (~2D%)~%" num-skipped skipped%)
- (format stream " Fail: ~D (~2D%)~%" num-failed failed%)
- (when unknown
- (format stream " UNKNOWN RESULTS: ~D (~2D)~%" num-unknown unknown%))
- (terpri stream)
- (when failed
- (format stream "Failure Details:~%")
- (dolist (f failed)
- (format stream "~A ~@{[~A]~}: ~%"
- (name (test-case f))
- (description (test-case f)))
- (when (and *verbose-failures* (test-expr f))
- (format stream " ~S~%" (test-expr f)))
- (format stream " ~A.~%" (reason f)))
- (terpri stream))
- (when skipped
- (format stream "Skip Details:~%")
- (dolist (f skipped)
- (format stream "~A ~@{[~A]~}: ~%"
- (name (test-case f))
- (description (test-case f)))
- (format stream " ~A.~%" (reason f)))
- (terpri *test-dribble*))))
+ (flet ((output (&rest format-args)
+ (format stream "~&~vT" recursive-depth)
+ (apply #'format stream format-args)))
+
+ (when (zerop num-checks)
+ (output "Didn't run anything...huh?")
+ (return-from explain nil))
+ (output "Did ~D check~P.~%" num-checks num-checks)
+ (output " Pass: ~D (~2D%)~%" num-passed passed%)
+ (output " Skip: ~D (~2D%)~%" num-skipped skipped%)
+ (output " Fail: ~D (~2D%)~%" num-failed failed%)
+ (when unknown
+ (output " UNKNOWN RESULTS: ~D (~2D)~%" num-unknown unknown%))
+ (terpri stream)
+ (when failed
+ (output "Failure Details:~%")
+ (dolist (f failed)
+ (output "--------------------------------~%")
+ (output "~A ~@{[~A]~}: ~%"
+ (name (test-case f))
+ (description (test-case f)))
+ (output " ~A.~%" (reason f))
+ (when (for-all-test-failed-p f)
+ (output "Results collected with failure data:~%")
+ (explain exp (slot-value f 'result-list)
+ stream (+ 4 recursive-depth)))
+ (when (and *verbose-failures* (test-expr f))
+ (output " ~S~%" (test-expr f)))
+ (output "--------------------------------~%"))
+ (terpri stream))
+ (when skipped
+ (output "Skip Details:~%")
+ (dolist (f skipped)
+ (output "~A ~@{[~A]~}: ~%"
+ (name (test-case f))
+ (description (test-case f)))
+ (output " ~A.~%" (reason f)))
+ (terpri *test-dribble*)))))
-(defmethod explain ((exp simple-text-explainer) results &optional (stream *test-dribble*))
+(defmethod explain ((exp simple-text-explainer) results
+ &optional (stream *test-dribble*) (recursive-depth 0))
(multiple-value-bind (num-checks passed num-passed passed%
skipped num-skipped skipped%
failed num-failed failed%
unknown num-unknown unknown%)
(partition-results results)
(declare (ignore passed passed% skipped skipped% failed failed% unknown unknown%))
- (format stream "~&Ran ~D checks, ~D passed" num-checks num-passed)
+ (format stream "~&~vTRan ~D checks, ~D passed" recursive-depth num-checks num-passed)
(when (plusp num-skipped)
(format stream ", ~D skipped " num-skipped))
(format stream " and ~D failed.~%" num-failed)
(when (plusp num-unknown)
- (format stream "~D UNKNOWN RESULTS.~%" num-unknown))))
+ (format stream "~vT~D UNKNOWN RESULTS.~%" recursive-depth num-unknown))))
(defun partition-results (results-list)
(let ((num-checks (length results-list)))
#:pass
#:fail
#:*test-dribble*
+ #:for-all
+ #:gen-integer
+ #:gen-string
+ #:gen-character
;; running tests
#:run
#:run-all-tests
--- /dev/null
+;; -*- lisp -*-
+
+(in-package :it.bese.FiveAM)
+
+;;;; * Random (QuickCheck-ish) testing
+
+;;;; FiveAM provides the ability to automatically generate a
+;;;; collection of random input data for a specific test and run a
+;;;; test multiple times.
+
+;;;; Specification testing is done through the FOR-ALL macro. This
+;;;; macro will bind variables to random data and run a test body a
+;;;; certain number of times. Should the test body ever signal a
+;;;; failure we stop running and report what values of the variables
+;;;; caused the code to fail.
+
+(defmacro for-all (bindings &body body)
+ `(perform-random-testing
+ (list ,@(mapcar #'second bindings))
+ (lambda ,(mapcar #'first bindings)
+ (if (and ,@(delete-if #'null (mapcar #'third bindings)))
+ (progn ,@body)
+ (throw 'run-once
+ (list :guard-conditions-failed))))))
+
+(defun perform-random-testing (generators body)
+ (loop
+ with random-state = *random-state*
+ with total-counter = 1000
+ with counter = 100
+ until (zerop counter)
+ do (let ((result (perform-random-testing/run-once generators body)))
+ (ecase (first result)
+ (:pass
+ (decf counter)
+ (decf total-counter))
+ (:no-tests
+ (add-result 'for-all-test-no-tests
+ :reason "No tests"
+ :random-state random-state)
+ (return-from perform-random-testing nil))
+ (:guard-conditions-failed
+ (decf total-counter))
+ (:fail
+ (add-result 'for-all-test-failed
+ :reason "Found failing test data"
+ :random-state random-state
+ :failure-values (second result)
+ :result-list (third result))
+ (return-from perform-random-testing nil))))
+ finally (add-result 'for-all-test-passed)))
+
+(defun perform-random-testing/run-once (generators body)
+ (catch 'run-once
+ (bind-run-state ((result-list '()))
+ (let ((values (mapcar #'funcall generators)))
+ (apply body values)
+ (cond
+ ((null result-list)
+ (throw 'run-once (list :no-tests)))
+ ((every #'test-passed-p result-list)
+ (throw 'run-once (list :pass)))
+ ((notevery #'test-passed-p result-list)
+ (throw 'run-once (list :fail values result-list))))))))
+
+(defclass for-all-test-result ()
+ ((random-state :initarg :random-state)))
+
+(defclass for-all-test-passed (test-passed for-all-test-result)
+ ())
+
+(defclass for-all-test-failed (test-failure for-all-test-result)
+ ((failure-values :initarg :failure-values)
+ (result-list :initarg :result-list)))
+
+(defgeneric for-all-test-failed-p (object)
+ (:method ((object for-all-test-failed)) t)
+ (:method ((object t)) nil))
+
+(defclass for-all-test-no-tests (test-failure for-all-test-result)
+ ())
+
+(defmethod reason ((result for-all-test-failed))
+ (format nil "Falsafiable with ~S" (slot-value result 'failure-values)))
+
+;;;; ** Generators.
+
+;;;; Since this is random testing we need some way of creating random
+;;;; data to feed to our code. Generators are regular functions whcih
+;;;; create this random data.
+
+;;;; We provide a set of built-in generators.
+
+(defmacro defgenerator (name arguments &body body)
+ `(defun ,name ,arguments
+ (lambda () ,@body)))
+
+(defgenerator gen-integer (&key (max (1+ most-positive-fixnum))
+ (min (1+ most-negative-fixnum)))
+ (+ min (random (1+ (- max min)))))
+
+(defgenerator gen-character (&key (code (gen-integer :min 0 :max (1- char-code-limit))))
+ (code-char (funcall code)))
+
+(defun gen-string (&key
+ (length (gen-integer :min 0 :max 80))
+ (elements (gen-character))
+ (element-type 'character))
+ (lambda ()
+ (loop
+ with length = (funcall length)
+ with string = (make-string length :element-type element-type)
+ for index below length
+ do (setf (aref string index) (funcall elements))
+ finally (return string))))
+
+(defun gen-list (&key
+ (length (gen-integer :min 0 :max 10))
+ (elements (gen-integer :min -10 :max 10)))
+ (lambda ()
+ (loop
+ repeat (funcall length)
+ collect (funcall elements))))
+
+;;;; The trivial always-produce-the-same-thing generator is done using
+;;;; cl:constantly.
(is (= 2 (add-2 0)))
(is (= 0 (add-2 -2)))
(is (= 0 (add-2 0))))
+
+;; Finally let's try out the specification based testing.
+
+(defun dummy-add (a b)
+ (+ a b))
+
+(defun dummy-strcat (a b)
+ (concatenate 'string a b))
+
+(test dummy-add
+ (for-all ((a (gen-integer))
+ (b (gen-integer)))
+ ;; assuming we have an "oracle" to compare our function results to
+ ;; we can use it:
+ (is (= (+ a b) (dummy-add a b)))
+ ;; if we don't have an oracle (as in most cases) we just ensure
+ ;; that certain properties hold:
+ (is (= (dummy-add a b)
+ (dummy-add b a)))
+ (is (= a (dummy-add a 0)))
+ (is (= 0 (dummy-add a (- a))))
+ (is (< a (dummy-add a 1)))
+ (is (= (* 2 a) (dummy-add a a)))))
+
+(test dummy-strcat
+ (for-all ((result (gen-string))
+ (split-point (gen-integer :min 0 :max 80)
+ (< split-point (length result))))
+ (is (string= result (dummy-strcat (subseq result 0 split-point)
+ (subseq result split-point))))))
+
+(5am:run! 'dummy-strcat)
\ No newline at end of file
projects / fiveam.git / commitdiff