;;; Syntaxes for testing ;;; John David Stone ;;; Department of Computer Science ;;; Grinnell College ;;; created July 8, 1998 ;;; last revised December 28, 2016 (define-library (support testing) (export suite test) (import (scheme base) (scheme write)) (begin ;; ===== suite ======================================================== ;; The suite syntax takes a name, a parenthesis-enclosed sequence of ;; zero or more binding specifications, and zero or more ;; test-expressions (described below). It tallies and reports the ;; number of tests that succeeded and the number that failed. The ;; value of suite-expression is #t if none of the tests failed, #f if ;; one or more tests failed. (define-syntax suite (syntax-rules () ((suite name (setup-binding ...) test ...) (let ((successes 0) (failures 0) setup-binding ...) (if test (set! successes (+ successes 1)) (set! failures (+ failures 1))) ... (display successes) (display "-") (display failures) (display ": ") (display 'name) (newline) (zero? failures))))) ;; ===== test ========================================================= ;; The test syntax takes five subexpressions. ;; ;; * The first is an identifier indicating the nature of the ;; test to be conducted. ;; ;; * The second is an expression embodying the test: the values ;; of the expression are the results of the test. ;; ;; * The third is a numeral indicating how many results the ;; test should produce. ;; ;; * The fourth is a list of expressions, equal in number to ;; the value of the preceding numeral. The value of each ;; expression in the list is a predicate; the corresponding ;; result is required to satisfy this predicate. ;; ;; * The fifth, which is optional, is an expression of which ;; the value is a predicate. This predicate is applied to ;; all of the results, and they are required to satisfy it. (define-syntax test (syntax-rules () ((test name trial count (criterion ...) joint-criterion) (call-with-values (lambda () trial) (lambda results (if (and (= count (length results)) (let tl ((remaining-results results) (remaining-criteria (list criterion ...))) (or (null? remaining-results) (null? remaining-criteria) (and ((car remaining-criteria) (car remaining-results)) (tl (cdr remaining-results) (cdr remaining-criteria))))) (apply joint-criterion results)) #t (begin (display "*** Test ") (display 'name) (display " failed.") (newline) (display "--- Failing expression: ") (write 'trial) (newline) (do ((remaining-results results (cdr remaining-results)) (counter 0 (+ counter 1))) ((null? remaining-results)) (display "--- Result #") (display counter) (display ": ") (write (car remaining-results)) (newline)) #f))))) ((test name trial count (criterion ...)) (test name trial count (criterion ...) (lambda results #t))))))) ;;; copyright (C) 2011, 2016 John David Stone ;;; This program is free software. You may 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. A copy of the GNU General Public ;;; License is available on the World Wide Web at ;;; ;;; http://www.gnu.org/licenses/gpl.html ;;; ;;; This program 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.