edward

 1(import r7rs test (edward parse))
 2
 3(define (%test-parse parser input)
 4  (define (parse-with-error parser stream)
 5    (call-with-parse parser stream 0
 6                     (lambda (r s i fk)
 7                       (if (parse-stream-end? s i)
 8                         r
 9                         (fk s i "incomplete parse")))
10                     (lambda (s i reason) (error reason))))
11
12  (let* ((stream (string->parse-stream input))
13         (result (parse-with-error parser stream)))
14    result))
15
16(define (test-parse expected parser input)
17  (test expected (%test-parse parser input)))
18
19(define (test-parse-error desc expected parser input)
20  (let ((r (call-with-current-continuation
21             (lambda (k)
22               (with-exception-handler
23                 (lambda (e) (k e))
24                 (lambda ( ) (k (%test-parse parser input))))))))
25    (test desc expected
26      (if (error-object? r)
27        (error-object-message r))))) ;; (not (error-object? r)) → undefined
28
29;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30
31(include-relative "parse-addr.scm")
32(include-relative "parse-cmd.scm")
33(include-relative "replace.scm")
34(include-relative "buffer.scm")
35(include-relative "util.scm")
36
37;; Exit with non-zero exit status if some test failed.
38(test-exit)