Created
July 11, 2015 22:53
-
-
Save dastels/cf97e3a83f64e91041ed to your computer and use it in GitHub Desktop.
Common Lisp testing framework
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;; Common Lisp testing framework | |
;;; Copyright 2015 Dave Astels | |
;;; MIT License | |
(defvar number-of-tests 0) | |
(defvar number-of-failures 0) | |
(defvar failure-messages '()) | |
(defvar verbose-tests nil) | |
(defvar context-name "") | |
(defun reset-testing () | |
(setf number-of-tests 0) | |
(setf number-of-failures 0) | |
(setf number-of-errors 0) | |
(setf failure-messages '()) | |
(setf error-messages '()) | |
(setf verbose-tests nil)) | |
(defmacro context (label &rest body) | |
(if (not (or (symbolp label) (stringp label))) | |
(error "The label of a describe must be a symbol or string.") | |
`(progn (when verbose-tests | |
(format t "Context: ~A~%" ,label)) | |
(setf context-name ,label) | |
,@body))) | |
(defun log-pass (msg) | |
(setf number-of-tests (1+ number-of-tests)) | |
(when verbose-tests | |
(format t " ~A - ok~%" msg))) | |
(defun log-failure (prefix msg) | |
(setf number-of-failures (1+ number-of-failures)) | |
(let ((failure-message (format nil "~A: ~A - ~A" context-name prefix msg))) | |
(setf failure-messages (cons failure-message failure-messages)) | |
(when verbose-tests | |
(format t " ~A - failed: ~A~%" prefix msg)))) | |
(defmacro assert-true (sexpr) | |
`(let ((actual (eval ,sexpr)) | |
(msg (format nil "(assert-true ~A)" ',sexpr))) | |
(if actual | |
(log-pass msg) | |
(log-failure msg "expected true, but was false")))) | |
(defmacro assert-false (sexpr) | |
`(let ((actual (eval ,sexpr)) | |
(msg (format nil "(assert-false ~A)" ',sexpr))) | |
(if (not actual) | |
(log-pass msg) | |
(log-failure msg "expected false, but was true")))) | |
(defmacro assert-null (sexpr) | |
`(let ((actual (eval ,sexpr)) | |
(msg (format nil "(assert-null ~A)" ',sexpr))) | |
(if (null actual) | |
(log-pass msg) | |
(log-failure msg "expected null, but wasn't")))) | |
(defmacro assert-not-null (sexpr) | |
`(let ((actual (eval ,sexpr)) | |
(msg (format nil "(assert-not-null ~A)" ',sexpr))) | |
(if (not (null actual)) | |
(log-pass msg) | |
(log-failure msg "expected not null, but was")))) | |
(defmacro assert-eq (sexpr expected-sexpr) | |
`(let* ((actual ,sexpr) | |
(expected ,expected-sexpr) | |
(msg (format nil "(assert-eq ~A ~A)" ',sexpr ',expected-sexpr))) | |
(if (eq actual expected) | |
(log-pass msg) | |
(log-failure msg (format nil "expected ~A, but was ~A" expected actual))))) | |
(defmacro assert-neq (sexpr expected-sexpr) | |
`(let* ((actual ,sexpr) | |
(expected ,expected-sexpr) | |
(msg (format nil "(assert-neq ~A ~A)" ',sexpr ',expected-sexpr))) | |
(if (not (eq actual expected)) | |
(log-pass msg) | |
(log-failure msg (format nil "did not expect ~A, but it was" expected))))) | |
(defun run-tests (test-dir &optional (verbose nil)) | |
(setf failure-messages '()) | |
(setf verbose-tests verbose) | |
(mapcar #'load (cl-fad:list-directory test-dir)) | |
(format t "~%Failures:~%") | |
(mapcar (lambda (m) (format t " ~A~%" m)) | |
failure-messages)) | |
The body of a context can include any code; it's just Lisp code. That means you can use let to create local environments and set up the fixture/context by creating bindings in it.
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Sample test file:
(context "Sample test"
(assert-true (> 2 1))
(assert-true (> 2 2)))
Run tests via (in this case the above file):
(run-tests "/Users/dastels/Projects/Personal/common-lisp/6502/tests/")
Failures:
Sample test: (assert-true (> 2 2)) - expected true, was false
(NIL)
Same but with verbose output:
(run-tests "/Users/dastels/Projects/Personal/common-lisp/6502/tests/" t)
Context: Sample test
(assert-true (> 2 1)) - ok
(assert-true (> 2 2)) - failed: expected true, was false
Failures:
Sample test: (assert-true (> 2 2)) - expected true, was false
(NIL)