Add assert! macro with sub-expression introspection on failure
ober
fa407f86de6ccc65dd9a2f3a8a320cbdee45144d
--- a/lib/std/test.sls +++ b/lib/std/test.sls @@ -11,7 +11,8 @@ check-predicate check-exception check-output run-tests! run-test-suite! - test-begin! test-result test-report-summary!) + test-begin! test-result test-report-summary! + assert!) (import (chezscheme)) @@ -221,4 +222,59 @@ "~n~a: ~a checks, ~a failures, ~a errors~n" (test-result) *total-checks* *total-failures* *total-errors*)) + ;; --- assert! macro --- + ;; On failure, displays the expression and each sub-expression's value. + ;; Handles the common case: (assert! (op arg1 arg2 ...)) + ;; where each arg is evaluated, and on failure all arg values are shown. + ;; Also handles simple: (assert! expr) for non-compound expressions. + + (define (assert-fail! expr-str sub-exprs sub-vals) + (set! *total-checks* (+ *total-checks* 1)) + (set! *total-failures* (+ *total-failures* 1)) + (when *current-case* + (test-case-rec-checks-set! *current-case* + (+ (test-case-rec-checks *current-case*) 1)) + (test-case-rec-fail-set! *current-case* + (format "assert! failed: ~a" expr-str))) + (when *test-verbose* + (fprintf (current-error-port) " FAIL: ~a~n" expr-str) + (for-each + (lambda (se sv) + (fprintf (current-error-port) " ~a => ~s~n" se sv)) + sub-exprs sub-vals))) + + (define (assert-pass!) + (set! *total-checks* (+ *total-checks* 1)) + (when *current-case* + (test-case-rec-checks-set! *current-case* + (+ (test-case-rec-checks *current-case*) 1)))) + + (define-syntax assert! + (lambda (stx) + (syntax-case stx () + ;; Compound expression: (assert! (op arg1 arg2 ...)) + ;; We evaluate each argument, then apply the operator. + [(_ (op arg ...)) + (with-syntax ([(tmp ...) (generate-temporaries #'(arg ...))] + [(arg-str ...) (map (lambda (a) + (datum->syntax #'op + (format "~s" (syntax->datum a)))) + #'(arg ...))]) + #'(let ([tmp arg] ...) + (if (op tmp ...) + (assert-pass!) + (assert-fail! + (format "~s" '(op arg ...)) + (list arg-str ...) + (list tmp ...)))))] + ;; Simple expression: (assert! expr) + [(_ expr) + #'(let ([val expr]) + (if val + (assert-pass!) + (assert-fail! + (format "~s" 'expr) + '() + '())))]))) + ) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-assert.ss @@ -0,0 +1,119 @@ +#!chezscheme +;;; tests/test-assert.ss -- Tests for the assert! macro in (std test) + +(import (chezscheme) (std test)) + +(define pass 0) +(define fail 0) + +;; Helper: check if string s contains substring sub +(define (string-contains s sub) + (let ([slen (string-length s)] + [sublen (string-length sub)]) + (let loop ([i 0]) + (cond + [(> (+ i sublen) slen) #f] + [(string=? (substring s i (+ i sublen)) sub) i] + [else (loop (+ i 1))])))) + +(define-syntax verify + (syntax-rules () + [(_ name expr expected) + (let ([got expr]) + (if (equal? got expected) + (begin (set! pass (+ pass 1)) (printf " ok ~a~%" name)) + (begin (set! fail (+ fail 1)) + (printf "FAIL ~a: got ~s expected ~s~%" name got expected))))])) + +(printf "--- assert! macro tests ---~%~%") + +;; 1. Passing assertions should not produce failure output +(printf "~%-- Passing assertions --~%") + +(test-begin!) + +(assert! (= 1 1)) +(verify "pass-equal" (test-result) 'OK) + +(test-begin!) +(assert! (< 3 5)) +(verify "pass-less-than" (test-result) 'OK) + +(test-begin!) +(assert! (string=? "hello" "hello")) +(verify "pass-string-equal" (test-result) 'OK) + +;; 2. Simple true expression (non-compound) +(test-begin!) +(assert! #t) +(verify "pass-simple-true" (test-result) 'OK) + +;; 3. Passing assertion with sub-expressions +(test-begin!) +(let ([x 5] [y 3]) + (assert! (= (+ x y) 8))) +(verify "pass-subexpr" (test-result) 'OK) + +;; 4. Failing assertions should record failure +(printf "~%-- Failing assertions (expect FAIL output) --~%") + +(test-begin!) +(assert! (= 1 2)) +(verify "fail-recorded" (test-result) 'FAILURE) + +;; 5. Failing assertion with sub-expressions shows values +;; We capture stderr to verify the output +(test-begin!) +(let ([output (with-output-to-string + (lambda () + (parameterize ([current-error-port (current-output-port)]) + (let ([x 5] [y 3]) + (assert! (= (+ x 1) (* y 3)))))))]) + ;; Should mention the failing expression + (verify "fail-shows-expr" + (and (string-contains output "FAIL") + (string-contains output "(+ x 1)") + (string-contains output "(* y 3)") + #t) + #t) + ;; Should show the sub-expression values + (verify "fail-shows-value-6" + (and (string-contains output "6") #t) + #t) + (verify "fail-shows-value-9" + (and (string-contains output "9") #t) + #t)) + +;; 6. Failing simple (non-compound) assertion +(test-begin!) +(assert! #f) +(verify "fail-simple-false" (test-result) 'FAILURE) + +;; 7. Multiple assertions - mix of pass and fail +(test-begin!) +(assert! (= 2 2)) +(assert! (= 3 4)) +(verify "mixed-result" (test-result) 'FAILURE) + +;; 8. Assertion with more than 2 arguments to operator +(test-begin!) +(assert! (< 1 2 3)) +(verify "pass-three-args" (test-result) 'OK) + +(test-begin!) +(assert! (< 1 3 2)) +(verify "fail-three-args" (test-result) 'FAILURE) + +;; 9. Works inside test-case +(test-begin!) +(let ([suite (test-suite "assert-suite" + (test-case "passing assert" + (assert! (= 1 1))) + (test-case "failing assert" + (assert! (= 1 2))))]) + (let ([ok (run-test-suite! suite)]) + (verify "suite-with-assert" ok #f))) ;; should fail overall + +;; --- Summary --- +(printf "~%--- assert! tests: ~a passed, ~a failed ---~%" pass fail) +(when (> fail 0) (exit 1))