Re: [Scheme-reports] programs and cond-expand

I used a different approach. I use a procedure very like load, but that handles (must-equal <result> <expr>) and (must-raise <exception> <expr>) specially. Using this approach, I could start testing before I had syntax-rules working, and even before I had all that much of a scheme system working.

Right now, that procedure is written in C, but I am in the process of making it a scheme program, and making my tests compatible with (chibi test).

The specification for (interaction-environment) says that it "returns a specifier for a mutable environment..." Does it return the same environment every time that it is called? Does it return the same environment as
that used by load? must-raise can easily be transformed to (test-error (eval '(lambda () expr) (interaction-environment))) but the following example will not work if interaction-environment does not return the same environment as load -- assuming the tests are run by load. And I don't think the following example will work at all if the tests are run as a program, assuming the must-raise to test-error transformation.

(define (l x y) x)
(must-raise (assertion-violation l) (l 3))
(must-raise (assertion-violation l) (l 3 4 5))

Here is an R7RS program which will handle testing with must-equal and must-raise. It does not check for a specific exception being raised because that is implementation specific.
;;
;; A program to run the tests.
;;
;; <scheme> runtests.scm <test> ...
;;

(import (scheme base))
(import (scheme cxr))
(import (scheme eval))
(import (scheme file))
(import (scheme process-context))
(import (scheme read))
(import (scheme repl))
(import (scheme write))

(define pass-count 0)
(define fail-count 0)

(define (run-tests lst)
    (define (fail obj ret)
        (set! fail-count (+ fail-count 1))
        (display "failed: ")
        (write obj)
        (display ": ")
        (write ret)
        (newline))
    (let ((env (interaction-environment)))
        (define (test-must-equal obj)
            (let ((ret (eval (caddr obj) env)))
                (if (equal? (cadr obj) ret)
                    (set! pass-count (+ pass-count 1))
                    (fail obj ret))))
        (define (test-must-raise obj)
            (guard (exc
                ((error-object? exc) (set! pass-count (+ pass-count 1)))
                (else (fail obj exc)))
                (eval (caddr obj) env)
                (fail obj "no exception raised")))
        (define (test port)
            (let ((obj (read port)))
                (if (not (eof-object? obj))
                    (begin
                        (cond
                            ((and (pair? obj) (eq? (car obj) 'must-equal))
                                (test-must-equal obj))
                            ((and (pair? obj) (eq? (car obj) 'must-raise))
                                (test-must-raise obj))
                            (else (eval obj env)))
                        (test port)))))
        (if (not (null? lst))
            (begin
                (display (car lst))
                (newline)
                (call-with-port (open-input-file (car lst)) test)
                (run-tests (cdr lst))))))

(run-tests (cdr (command-line)))
(display "pass: ") (display pass-count) (display " fail: ") (display fail-count) (newline)

On 10/24/2013 5:48 PM, Alex Shinn wrote: