diff --git a/rackunit-doc/rackunit/scribblings/filtering-tests.scrbl b/rackunit-doc/rackunit/scribblings/filtering-tests.scrbl new file mode 100644 index 0000000..89e4540 --- /dev/null +++ b/rackunit-doc/rackunit/scribblings/filtering-tests.scrbl @@ -0,0 +1,57 @@ +#lang scribble/manual + +@(require (for-label racket/base syntax/srcloc) + scribble/example) + +@(define e (make-base-eval '(require rackunit))) + +@title[#:tag "filtering-tests"]{Filtering Tests with Command-line Arguments} + +RackUnit supports test filtering so that one may run one test or a handful of +tests out of a given set. This can be accomplished by using command-line +arguments. Before each check is run, RackUnit will use the value of +@racket[current-command-line-arguments] to construct a list of names, files, +and lines to run. + +@examples[#:eval e + (parameterize ([current-command-line-arguments (vector "foo")]) + (with-check-info (['name 'foo]) + (check-equal? 1 2)) + (check-equal? 2 3))] + +In the above example, the former test runs because its @racket['name] field +matches with the value specified on the command line. The latter test is +skipped. + +Multiple names can also be specified. Names are treated as regular expressions, +and tests will be run if they match any of the names specified on the command +line. + +@examples[#:eval e + (parameterize ([current-command-line-arguments (vector "foo" "bar")]) + (with-check-info (['name 'foo]) + (check-equal? 1 2)) + (with-check-info (['name 'bar]) + (check-equal? 2 3)))] + +Filtering by file or line number works similarly, and uses the syntax +file:@italic{} or line:@italic{}. + +@examples[#:eval e + (parameterize ([current-command-line-arguments (vector "line:2")]) + (check-equal? 1 2))] + +@examples[#:eval e + (parameterize ([current-command-line-arguments (vector "line:1")]) + (check-equal? 2 3))] + +Name, file, and line specifiers can be combined to create more specific filters. + +@racketblock[(define loc (list (string->path "baz.rkt") 5 0 #f #f)) + (parameterize ([current-command-line-arguments (vector "foo" "file:bar.rkt" "line:5")]) + (with-check-info (['name 'foo] + ['location (location-info loc)]) + (check-equal? 1 2)))] + +The above example is not run because, even though the test name and line number +are correct, the file names do not match. diff --git a/rackunit-doc/rackunit/scribblings/rackunit.scrbl b/rackunit-doc/rackunit/scribblings/rackunit.scrbl index b4758e1..f3dfc08 100644 --- a/rackunit-doc/rackunit/scribblings/rackunit.scrbl +++ b/rackunit-doc/rackunit/scribblings/rackunit.scrbl @@ -15,6 +15,7 @@ from novices to experts. @include-section["quick-start.scrbl"] @include-section["philosophy.scrbl"] @include-section["api.scrbl"] +@include-section["filtering-tests.scrbl"] @include-section["utils.scrbl"] @include-section["internals.scrbl"] @include-section["release-notes.scrbl"] diff --git a/rackunit-lib/rackunit/private/check-info.rkt b/rackunit-lib/rackunit/private/check-info.rkt index 4162a4e..5863d9a 100644 --- a/rackunit-lib/rackunit/private/check-info.rkt +++ b/rackunit-lib/rackunit/private/check-info.rkt @@ -17,6 +17,7 @@ [info-value->string (-> any/c string?)] [check-info-mark symbol?] [check-info-stack (continuation-mark-set? . -> . (listof check-info?))] + [current-check-info (-> (listof check-info?))] [with-check-info* ((listof check-info?) (-> any) . -> . any)]) with-check-info) @@ -58,6 +59,10 @@ (hash-set! ht (check-info-name x) (cons i x))) (map cdr (sort (hash-map ht (λ (k v) v)) < #:key car)))) +;; Shorthand to get the current check-info. +(define (current-check-info) + (check-info-stack (current-continuation-marks))) + ;; with-check-info* : (list-of check-info) thunk -> any (define (with-check-info* info thunk) (define current-marks diff --git a/rackunit-lib/rackunit/private/check.rkt b/rackunit-lib/rackunit/private/check.rkt index 6a86449..de47b94 100644 --- a/rackunit-lib/rackunit/private/check.rkt +++ b/rackunit-lib/rackunit/private/check.rkt @@ -97,6 +97,57 @@ (exn-continuation-marks exn) (exn:test:check-stack exn)))) +(define (get-filters) + (for/fold ([names null] [files null] [lines null]) + ([arg (vector->list (current-command-line-arguments))]) + (cond + [(regexp-match-exact? #rx"[Ff][Ii][Ll][Ee]:.+" arg) + (define new-files (cons (regexp (substring arg 5)) files)) + (values names new-files lines)] + [(regexp-match-exact? #rx"[Ll][Ii][Nn][Ee]:.+" arg) + (define line-num (string->number (substring arg 5))) + (define new-lines (if line-num (cons line-num lines) lines)) + (values names files new-lines)] + [else (values (cons (regexp arg) names) files lines)]))) + +(struct test-filter (names files lines)) +(define current-filters #f) +(define last-cmd-args #f) + +(define (maybe-load-filters!) + (define cmd-args (current-command-line-arguments)) + (unless (and current-filters (eq? last-cmd-args cmd-args)) + (set! last-cmd-args cmd-args) + (define-values (new-names new-files new-lines) (get-filters)) + (set! current-filters (test-filter new-names new-files new-lines))) + (void)) + +(define (arguments-say-to-run) + (maybe-load-filters!) + (define names-to-run (test-filter-names current-filters)) + (define files-to-run (test-filter-files current-filters)) + (define lines-to-run (test-filter-lines current-filters)) + (define name + (symbol->string + (check-info-value + (findf (lambda (info) (eq? (check-info-name info) 'name)) + (current-check-info))))) + (define location + (location-info-value + (check-info-value + (findf (lambda (info) (eq? (check-info-name info) 'location)) + (current-check-info))))) + (define file (if (path? (car location)) (path->string (car location)) "")) + (define line (cadr location)) + (and (or (null? files-to-run) + (ormap (lambda (file-rex) (regexp-match? file-rex file)) + files-to-run)) + (or (null? lines-to-run) + (ormap (lambda (ln) (equal? ln line)) lines-to-run)) + (or (null? names-to-run) + (ormap (lambda (name-rex) (regexp-match? name-rex name)) + names-to-run)))) + (define-syntax (define-check stx) (syntax-case stx () ((define-check (name formal ...) body ...) @@ -113,14 +164,16 @@ ((current-check-around) (lambda () (with-check-info* - (list* (make-check-name (quote name)) - (make-check-location location) - (make-check-expression expression) - (make-check-params (list formal ...)) - (if message - (list (make-check-message message)) - null)) - (lambda () (begin0 (let () body ...) (test-log! #t)))))) + (list* (make-check-name (quote name)) + (make-check-location location) + (make-check-expression expression) + (make-check-params (list formal ...)) + (if message + (list (make-check-message message)) + null)) + (lambda () + (when (arguments-say-to-run) + (begin0 (let () body ...) (test-log! #t))))))) ;; All checks should return (void). (void)))] diff --git a/rackunit-test/tests/rackunit/arg-forwarding-test.rkt b/rackunit-test/tests/rackunit/arg-forwarding-test.rkt new file mode 100644 index 0000000..43d911a --- /dev/null +++ b/rackunit-test/tests/rackunit/arg-forwarding-test.rkt @@ -0,0 +1,72 @@ +#lang racket/base + +(require rackunit + syntax/parse/define + racket/format + (for-syntax racket/base + syntax/location)) + +(define-syntax (current-file-name stx) + (with-syntax ([file (syntax-source-file-name stx)]) + (syntax-case stx () + [_ #'file]))) + +(define-syntax (current-line-number stx) + (with-syntax ([line (syntax-line stx)]) + (syntax-case stx () + [_ #'line]))) + +(define-simple-macro (with-cmd (args ...) e) + (parameterize ([current-command-line-arguments (vector args ...)]) + (let () e))) + +(define-simple-macro (run-test (args ...) e) + (with-cmd (args ...) + (let ([result (open-output-string)]) + (parameterize ([current-error-port result]) + (begin e (get-output-string result)))))) + +(define-simple-macro (check-error (args ...) e) + (when (zero? (string-length (run-test (args ...) e))) + (eprintf "TEST FAILED: (check-error ~s ~a)\n" + (map ~a (list args ...)) (quote e)))) + +(define-simple-macro (check-no-error (args ...) e) + (let ([result (run-test (args ...) e)]) + (unless (zero? (string-length result)) + (eprintf "TEST FAILED: (check-no-error ~s ~a)\n~a\n" + (map ~a (list args ...)) (quote e) result)))) + +(define FILE-NAME (path->string (current-file-name))) + +(module+ test + ;; Define args for correct and incorrect file names. + (define file-name-arg (format "file:~a" FILE-NAME)) + (define wrong-file-name-arg + (format "file:~a" + (list->string (map (compose integer->char add1 char->integer) + (string->list FILE-NAME))))) + ;; Define test. + (define (go) + (with-check-info (['name 'foo]) + (check-equal? 1 2))) (define GO-LINE (current-line-number)) ;; Keep this on same line! + ;; Define args for correct and incorrect line numbers. + (define go-line-num-arg (format "line:~a" GO-LINE)) + (define wrong-go-line-num-arg (format "line:~a" (+ GO-LINE 100))) + + (check-error ("foo") (go)) + (check-no-error ("baz") (go)) + (check-error ("foo" "baz") (go)) + (check-error ("foo" file-name-arg) (go)) + (check-error ("foo" go-line-num-arg) (go)) + (check-no-error ("foo" wrong-file-name-arg) (go)) + (check-no-error ("foo" wrong-go-line-num-arg) (go)) + (check-no-error ("foo" file-name-arg wrong-go-line-num-arg) (go)) + (check-no-error ("foo" wrong-file-name-arg go-line-num-arg) (go)) + + (define (go2) + (check-equal? 2 3)) + + (check-error () (go2)) + (check-no-error ("foo") (go2)) + )