diff options
Diffstat (limited to 'third_party/lisp/fiveam/t')
| -rw-r--r-- | third_party/lisp/fiveam/t/example.lisp | 126 | ||||
| -rw-r--r-- | third_party/lisp/fiveam/t/tests.lisp | 280 |
2 files changed, 0 insertions, 406 deletions
diff --git a/third_party/lisp/fiveam/t/example.lisp b/third_party/lisp/fiveam/t/example.lisp deleted file mode 100644 index c949511a28cd..000000000000 --- a/third_party/lisp/fiveam/t/example.lisp +++ /dev/null @@ -1,126 +0,0 @@ -;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- - -;;;; * FiveAM Example (poor man's tutorial) - -(asdf:oos 'asdf:load-op :fiveam) - -(defpackage :it.bese.fiveam.example - (:use :common-lisp - :it.bese.fiveam)) - -(in-package :it.bese.fiveam.example) - -;;;; First we need some functions to test. - -(defun add-2 (n) - (+ n 2)) - -(defun add-4 (n) - (+ n 4)) - -;;;; Now we need to create a test which makes sure that add-2 and add-4 -;;;; work as specified. - -;;;; we create a test named ADD-2 and supply a short description. -(test add-2 - "Test the ADD-2 function" ;; a short description - ;; the checks - (is (= 2 (add-2 0))) - (is (= 0 (add-2 -2)))) - -;;;; we can already run add-2. This will return the list of test -;;;; results, it should be a list of two test-passed objects. - -(run 'add-2) - -;;;; since we'd like to have some kind of readbale output we'll explain -;;;; the results - -(explain! (run 'add-2)) - -;;;; or we could do both at once: - -(run! 'add-2) - -;;;; So now we've defined and run a single test. Since we plan on -;;;; having more than one test and we'd like to run them together let's -;;;; create a simple test suite. - -(def-suite example-suite :description "The example test suite.") - -;;;; we could explictly specify that every test we create is in the the -;;;; example-suite suite, but it's easier to just change the default -;;;; suite: - -(in-suite example-suite) - -;;;; now we'll create a new test for the add-4 function. - -(test add-4 - (is (= 0 (add-4 -4)))) - -;;;; now let's run the test - -(run! 'add-4) - -;;;; we can get the same effect by running the suite: - -(run! 'example-suite) - -;;;; since we'd like both add-2 and add-4 to be in the same suite, let's -;;;; redefine add-2 to be in this suite: - -(test add-2 "Test the ADD-2 function" - (is (= 2 (add-2 0))) - (is (= 0 (add-2 -2)))) - -;;;; now we can run the suite and we'll see that both add-2 and add-4 -;;;; have been run (we know this since we no get 4 checks as opposed to -;;;; 2 as before. - -(run! 'example-suite) - -;;;; Just for fun let's see what happens when a test fails. Again we'll -;;;; redefine add-2, but add in a third, failing, check: - -(test add-2 "Test the ADD-2 function" - (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 10000) - (< split-point (length result)))) - (is (string= result (dummy-strcat (subseq result 0 split-point) - (subseq result split-point)))))) - -(test random-failure - (for-all ((result (gen-integer :min 0 :max 1))) - (is (plusp result)) - (is (= result 0)))) - -(run! 'example-suite) diff --git a/third_party/lisp/fiveam/t/tests.lisp b/third_party/lisp/fiveam/t/tests.lisp deleted file mode 100644 index ed1c565e7d4a..000000000000 --- a/third_party/lisp/fiveam/t/tests.lisp +++ /dev/null @@ -1,280 +0,0 @@ -;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- - -(in-package :it.bese.fiveam) - -(in-suite* :it.bese.fiveam) - -(def-suite test-suite :description "Suite for tests which should fail.") - -(defmacro with-test-results ((results test-name) &body body) - `(let ((,results (with-*test-dribble* nil (run ',test-name)))) - ,@body)) - -(def-fixture null-fixture () - `(progn ,@(&body))) - -;;;; Test the checks - -(def-test is1 (:suite test-suite) - (is (plusp 1)) - (is (< 0 1)) - (is (not (plusp -1))) - (is (not (< 1 0))) - (is-true t) - (is-false nil)) - -(def-test is2 (:suite test-suite :fixture null-fixture) - (is (plusp 0)) - (is (< 0 -1)) - (is (not (plusp 1))) - (is (not (< 0 1))) - (is-true nil) - (is-false t)) - -(def-test is (:profile t) - (with-test-results (results is1) - (is (= 6 (length results))) - (is (every #'test-passed-p results))) - (with-test-results (results is2) - (is (= 6 (length results))) - (is (every #'test-failure-p results)))) - -(def-test signals/finishes () - (signals error - (error "an error")) - (finishes - (signals error - (error "an error")))) - -(def-test pass () - (pass)) - -(def-test fail1 (:suite test-suite) - (fail "This is supposed to fail")) - -(def-test fail () - (with-test-results (results fail1) - (is (= 1 (length results))) - (is (test-failure-p (first results))))) - -;;;; non top level checks - -(def-test foo-bar () - (let ((state 0)) - (is (= 0 state)) - (is (= 1 (incf state))))) - -;;;; Test dependencies - -(def-test ok (:suite test-suite) - (pass)) - -(def-test not-ok (:suite test-suite) - (fail "This is supposed to fail.")) - -(def-test and1 (:depends-on (and ok not-ok) :suite test-suite) - (fail)) - -(def-test and2 (:depends-on (and ok) :suite test-suite) - (pass)) - -(def-test dep-and () - (with-test-results (results and1) - (is (= 3 (length results))) - ;; we should have one skippedw one failed and one passed - (is (some #'test-passed-p results)) - (is (some #'test-skipped-p results)) - (is (some #'test-failure-p results))) - (with-test-results (results and2) - (is (= 2 (length results))) - (is (every #'test-passed-p results)))) - -(def-test or1 (:depends-on (or ok not-ok) :suite test-suite) - (pass)) - -(def-test or2 (:depends-on (or not-ok ok) :suite test-suite) - (pass)) - -(def-test dep-or () - (with-test-results (results or1) - (is (= 2 (length results))) - (is (every #'test-passed-p results))) - (with-test-results (results or2) - (is (= 3 (length results))) - (is (= 2 (length (remove-if-not #'test-passed-p results)))))) - -(def-test not1 (:depends-on (not not-ok) :suite test-suite) - (pass)) - -(def-test not2 (:depends-on (not ok) :suite test-suite) - (fail)) - -(def-test not () - (with-test-results (results not1) - (is (= 2 (length results))) - (is (some #'test-passed-p results)) - (is (some #'test-failure-p results))) - (with-test-results (results not2) - (is (= 2 (length results))) - (is (some #'test-passed-p results)) - (is (some #'test-skipped-p results)))) - -(def-test nested-logic (:depends-on (and ok (not not-ok) (not not-ok)) - :suite test-suite) - (pass)) - -(def-test dep-nested () - (with-test-results (results nested-logic) - (is (= 3 (length results))) - (is (= 2 (length (remove-if-not #'test-passed-p results)))) - (is (= 1 (length (remove-if-not #'test-failure-p results)))))) - -(def-test circular-0 (:depends-on (and circular-1 circular-2 or1) - :suite test-suite) - (fail "we depend on a circular dependency, we should not be tested.")) - -(def-test circular-1 (:depends-on (and circular-2) - :suite test-suite) - (fail "we have a circular depednency, we should not be tested.")) - -(def-test circular-2 (:depends-on (and circular-1) - :suite test-suite) - (fail "we have a circular depednency, we should not be tested.")) - -(def-test circular () - (signals circular-dependency - (run 'circular-0)) - (signals circular-dependency - (run 'circular-1)) - (signals circular-dependency - (run 'circular-2))) - - -(defun stack-exhaust () - (declare (optimize (debug 3) (speed 0) (space 0) (safety 3))) - (cons 42 (stack-exhaust))) - -;; Disable until we determine on which implementations it's actually safe -;; to exhaust the stack. -#| -(def-test stack-exhaust (:suite test-suite) - (stack-exhaust)) - -(def-test test-stack-exhaust () - (with-test-results (results stack-exhaust) - (is (= 1 (length results))) - (is (test-failure-p (first results))))) -|# - -(def-suite before-test-suite :description "Suite for before test") - -(def-test before-0 (:suite before-test-suite) - (fail)) - -(def-test before-1 (:depends-on (:before before-0) - :suite before-test-suite) - (pass)) - -(def-suite before-test-suite-2 :description "Suite for before test") - -(def-test before-2 (:depends-on (:before before-3) - :suite before-test-suite-2) - (pass)) - -(def-test before-3 (:suite before-test-suite-2) - (pass)) - -(def-test before () - (with-test-results (results before-test-suite) - (is (some #'test-skipped-p results))) - - (with-test-results (results before-test-suite-2) - (is (every #'test-passed-p results)))) - - -;;;; dependencies with symbol -(def-test dep-with-symbol-first (:suite test-suite) - (pass)) - -(def-test dep-with-symbol-dependencies-not-met (:depends-on (not dep-with-symbol-first) - :suite test-suite) - (fail "Error in the test of the test, this should not ever happen")) - -(def-test dep-with-symbol-depends-on-ok (:depends-on dep-with-symbol-first :suite test-suite) - (pass)) - -(def-test dep-with-symbol-depends-on-failed-dependency (:depends-on dep-with-symbol-dependencies-not-met - :suite test-suite) - (fail "No, I should not be tested because I depend on a test that in its turn has a failed dependecy.")) - -(def-test dependencies-with-symbol () - (with-test-results (results dep-with-symbol-first) - (is (some #'test-passed-p results))) - - (with-test-results (results dep-with-symbol-depends-on-ok) - (is (some #'test-passed-p results))) - - (with-test-results (results dep-with-symbol-dependencies-not-met) - (is (some #'test-skipped-p results))) - - ;; No failure here, because it means the test was run. - (with-test-results (results dep-with-symbol-depends-on-failed-dependency) - (is (not (some #'test-failure-p results))))) - - -;;;; test for-all - -(def-test gen-integer () - (for-all ((a (gen-integer))) - (is (integerp a)))) - -(def-test for-all-guarded () - (for-all ((less (gen-integer)) - (more (gen-integer) (< less more))) - (is (< less more)))) - -(def-test gen-float () - (macrolet ((test-gen-float (type) - `(for-all ((unbounded (gen-float :type ',type)) - (bounded (gen-float :type ',type :bound 42))) - (is (typep unbounded ',type)) - (is (typep bounded ',type)) - (is (<= (abs bounded) 42))))) - (test-gen-float single-float) - (test-gen-float short-float) - (test-gen-float double-float) - (test-gen-float long-float))) - -(def-test gen-character () - (for-all ((c (gen-character))) - (is (characterp c))) - (for-all ((c (gen-character :code (gen-integer :min 32 :max 40)))) - (is (characterp c)) - (member c (list #\Space #\! #\" #\# #\$ #\% #\& #\' #\()))) - -(def-test gen-string () - (for-all ((s (gen-string))) - (is (stringp s))) - (for-all ((s (gen-string :length (gen-integer :min 0 :max 2)))) - (is (<= (length s) 2))) - (for-all ((s (gen-string :elements (gen-character :code (gen-integer :min 0 :max 0)) - :length (constantly 2)))) - (is (= 2 (length s))) - (is (every (curry #'char= #\Null) s)))) - -(defun dummy-mv-generator () - (lambda () - (list 1 1))) - -(def-test for-all-destructuring-bind () - (for-all (((a b) (dummy-mv-generator))) - (is (= 1 a)) - (is (= 1 b)))) - -(def-test return-values () - "Return values indicate test failures." - (is-true (with-*test-dribble* nil (explain! (run 'is1)))) - (is-true (with-*test-dribble* nil (run! 'is1))) - - (is-false (with-*test-dribble* nil (explain! (run 'is2)))) - (is-false (with-*test-dribble* nil (run! 'is2)))) |