;;;; test-suite/lib.scm --- generic support for testing
-;;;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006, 2007 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING. If not, write to
-;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-;;;; Boston, MA 02111-1307 USA
+;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;;;; Boston, MA 02110-1301 USA
(define-module (test-suite lib)
:use-module (ice-9 stack-catch)
:export (
;; Exceptions which are commonly being tested for.
+ exception:bad-variable
+ exception:missing-expression
exception:out-of-range exception:unbound-var
+ exception:used-before-defined
exception:wrong-num-args exception:wrong-type-arg
+ exception:numerical-overflow
+ exception:struct-set!-denied
+ exception:system-error
+ exception:miscellaneous-error
+ exception:string-contains-nul
;; Reporting passes and failures.
run-test
;; Naming groups of tests in a regular fashion.
with-test-prefix with-test-prefix* current-test-prefix
+ format-test-name
+
+ ;; Using the debugging evaluator.
+ with-debugging-evaluator with-debugging-evaluator*
;; Reporting results in various ways.
register-reporter unregister-reporter reporter-registered?
make-count-reporter print-counts
make-log-reporter
full-reporter
- user-reporter
- format-test-name))
+ user-reporter))
;;;; If you're using Emacs's Scheme mode:
;;;;
;;;; In that case, the test name is the list ("simple addition").
;;;;
+;;;; In the case of simple tests the expression that is tested would often
+;;;; suffice as a test name by itself. Therefore, the convenience macros
+;;;; pass-if and expect-fail provide a shorthand notation that allows to omit
+;;;; a test name in such cases.
+;;;;
+;;;; * (pass-if expression) is a short form for
+;;;; (run-test 'expression #t (lambda () expression))
+;;;; * (expect-fail expression) is a short form for
+;;;; (run-test 'expression #f (lambda () expression))
+;;;;
+;;;; For example:
+;;;;
+;;;; (pass-if (= 2 (+ 1 1)))
+;;;;
;;;; The WITH-TEST-PREFIX syntax and WITH-TEST-PREFIX* procedure establish
;;;; a prefix for the names of all tests whose results are reported
;;;; within their dynamic scope. For example:
;;;;
;;; Define some exceptions which are commonly being tested for.
+(define exception:bad-variable
+ (cons 'syntax-error "Bad variable"))
+(define exception:missing-expression
+ (cons 'misc-error "^missing or extra expression"))
(define exception:out-of-range
- (cons 'out-of-range "^Argument .*out of range"))
+ (cons 'out-of-range "^.*out of range"))
(define exception:unbound-var
(cons 'unbound-variable "^Unbound variable"))
+(define exception:used-before-defined
+ (cons 'unbound-variable "^Variable used before given a value"))
(define exception:wrong-num-args
(cons 'wrong-number-of-args "^Wrong number of arguments"))
(define exception:wrong-type-arg
- (cons 'wrong-type-arg "^Wrong type argument"))
+ (cons 'wrong-type-arg "^Wrong type"))
+(define exception:numerical-overflow
+ (cons 'numerical-overflow "^Numerical overflow"))
+(define exception:struct-set!-denied
+ (cons 'misc-error "^set! denied for field"))
+(define exception:system-error
+ (cons 'system-error ".*"))
+(define exception:miscellaneous-error
+ (cons 'misc-error "^.*"))
+
+;; as per throw in scm_to_locale_stringn()
+(define exception:string-contains-nul
+ (cons 'misc-error "^string contains #\\\\nul character"))
+
;;; Display all parameters to the default output port, followed by a newline.
(define (display-line . objs)
(if (and (null? rest) (pair? name))
;; presume this is a simple test, i.e. (pass-if (even? 2))
;; where the body should also be the name.
- `(run-test ,(with-output-to-string (lambda () (display name)))
- #t
- (lambda () ,name))
+ `(run-test ',name #t (lambda () ,name))
`(run-test ,name #t (lambda () ,@rest))))
;;; A short form for tests that are expected to fail, taken from Greg.
(if (and (null? rest) (pair? name))
;; presume this is a simple test, i.e. (expect-fail (even? 2))
;; where the body should also be the name.
- `(run-test ,(with-output-to-string (lambda () (display name)))
- #f
- (lambda () ,name))
+ `(run-test ',name #f (lambda () ,name))
`(run-test ,name #f (lambda () ,@rest))))
;;; A helper function to implement the macros that test for exceptions.
(string-match (cdr exception)
(apply simple-format #f message (car rest))))
#t)
+ ;; handle syntax errors which use `syntax-error' for key and don't
+ ;; yet format the message and args (we have to do it here).
+ ((and (eq? 'syntax-error (car exception))
+ (list? rest)
+ (string-match (cdr exception)
+ (apply simple-format #f message (car rest))))
+ #t)
;; unhandled; throw again
(else
(apply throw key proc message rest))))))))
(defmacro with-test-prefix (prefix . body)
`(with-test-prefix* ,prefix (lambda () ,@body)))
+;;; Call THUNK using the debugging evaluator.
+(define (with-debugging-evaluator* thunk)
+ (let ((dopts #f))
+ (dynamic-wind
+ (lambda ()
+ (set! dopts (debug-options))
+ (debug-enable 'debug))
+ thunk
+ (lambda ()
+ (debug-options dopts)))))
+
+;;; Evaluate BODY... using the debugging evaluator.
+(define-macro (with-debugging-evaluator . body)
+ `(with-debugging-evaluator* (lambda () ,@body)))
+
+
\f
;;;; REPORTERS
;;;;
HCoop / bpt / guile.git / blobdiff