;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; This file is part of ICCLE2. ; ; ICCLE2 is free software: you can redistribute it and/or modify ; it under the terms of the GNU General Public License as published by ; the Free Software Foundation, either version 3 of the License, or ; (at your option) any later version. ; ; ICCLE2 is distributed in the hope that it will be useful, ; but WITHOUT ANY WARRANTY; without even the implied warranty of ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ; GNU General Public License for more details. ; ; You should have received a copy of the GNU General Public License ; along with ICCLE2. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; From Peter Seiblel's excellent text: http://gigamonkeys.com/book (defparameter *test-name* nil) (defparameter *all-tests* nil) (defmacro run-tests (&body body) `(progn (make) (tests-reset) ,@body (tests-report))) (defun tests () (run-tests (dolist (one (reverse *all-tests*)) (funcall one)))) (defmacro deftest (name parameters &body body) `(progn (setf *all-tests* (remove-duplicates (cons ',name *all-tests*))) (defun ,name ,parameters (let ((*test-name* (append *test-name* (list ',name)))) ,@body)))) (defmacro check (&body forms) `(combine-results ,@(loop for f in forms collect `(report-result ,f ',f)))) (defmacro with-gensyms ((&rest names) &body body) `(let ,(loop for n in names collect `(,n (make-symbol ,(string n)))) ,@body)) (defmacro combine-results (&body forms) (with-gensyms (result) `(let ((,result t)) ,@(loop for f in forms collect `(unless ,f (setf ,result nil))) ,result))) (let ((passes 0) (fails 0)) (defun tests-reset() (setf passes 0) (setf fails 0)) (defun tests-report () (if (zerop (+ passes fails)) (format t "~%no tests~%") (format t "~%~%PASSES: ~a (~a %)~%FAILS : ~a~%" passes (* 100 (/ passes (+ passes fails))) fails)) (>= passes fails)) (defun report-result (result form) (if result (and (incf passes) (format t "~%pass ... ~a" *test-name*)) (and (incf fails) (format t "~%fail ... ~a: ~a" *test-name* form))) result) )