diff --git a/collects/compiler/commands/info.rkt b/collects/compiler/commands/info.rkt index e20ae53b7d..7d97e9d09c 100644 --- a/collects/compiler/commands/info.rkt +++ b/collects/compiler/commands/info.rkt @@ -6,6 +6,7 @@ ("pack" compiler/commands/pack "pack files/collections into a .plt archive" 10) ("unpack" compiler/commands/unpack "unpack files/collections from a .plt archive" 10) ("decompile" compiler/commands/decompile "decompile bytecode" #f) + ("test" compiler/commands/test "run all tests associated with a set of paths" #f) ("expand" compiler/commands/expand "macro-expand source" #f) ("distribute" compiler/commands/exe-dir "prepare executable(s) in a directory for distribution" #f) ("ctool" compiler/commands/ctool "compile and link C-based extensions" #f) diff --git a/collects/compiler/commands/test.rkt b/collects/compiler/commands/test.rkt new file mode 100644 index 0000000000..52a92bec9e --- /dev/null +++ b/collects/compiler/commands/test.rkt @@ -0,0 +1,28 @@ +#lang racket/base +(require racket/cmdline + racket/match + racket/path + raco/command-name) + +(define do-test + (match-lambda + [(? string? s) + (do-test (string->path s))] + [(? path? p) + (cond + [(directory-exists? p) + (for-each + (λ (dp) + (do-test (build-path p dp))) + (directory-list p))] + [(file-exists? p) + (define mod `(submod (file ,(path->string p)) test)) + (when (module-declared? mod #t) + (dynamic-require mod #f))] + [else + (error 'test "Given path ~e does not exist" p)])])) + +(command-line + #:program (short-program+command-name) + #:args files+directories + (for-each do-test files+directories)) diff --git a/collects/meta/props b/collects/meta/props index c1bc1c217a..9252119bde 100755 --- a/collects/meta/props +++ b/collects/meta/props @@ -604,6 +604,7 @@ path/s is either such a string or a list of them. "collects/compiler/commands/exe.rkt" drdr:command-line #f "collects/compiler/commands/make.rkt" drdr:command-line (mzc *) "collects/compiler/commands/pack.rkt" drdr:command-line #f +"collects/compiler/commands/test.rkt" responsible (jay) "collects/compiler/demodularizer" responsible (jay) "collects/compiler/demodularizer/batch.rkt" drdr:command-line #f "collects/compiler/demodularizer/prims.rkt" drdr:command-line #f @@ -1178,6 +1179,7 @@ path/s is either such a string or a list of them. "collects/racket/match" responsible (samth) "collects/racket/match.rkt" responsible (samth) "collects/racket/place" responsible (tewk) +"collects/racket/submodule.rkt" responsible (jay) "collects/racklog" responsible (jay) "collects/rackunit" responsible (jay noel ryanc) "collects/rackunit/gui.rkt" responsible (ryanc) drdr:command-line (gracket-text "-t" *) diff --git a/collects/racket/submodule.rkt b/collects/racket/submodule.rkt new file mode 100644 index 0000000000..880aa43b46 --- /dev/null +++ b/collects/racket/submodule.rkt @@ -0,0 +1,70 @@ +#lang racket/base +(require (for-syntax racket/base)) + +(begin-for-syntax + (define module->submodule->stxs-box (make-hash)) + (define (lang=? x y) + (cond + [(and (identifier? x) + (identifier? y)) + (free-identifier=? x y)] + [(and (not (syntax->datum x)) + (not (syntax->datum y))) + #t] + [else + #f])) + (define (get-stxs-box the-submodule-stx lang-stx) + (define the-module (syntax-source-module the-submodule-stx)) + (define submodule->stxs-box + (hash-ref! module->submodule->stxs-box the-module make-hash)) + (define the-submodule-id + (syntax->datum the-submodule-stx)) + (define lang-stx*stxs-box + (hash-ref! submodule->stxs-box the-submodule-id + (λ () + (when lang-stx + (syntax-local-lift-module-end-declaration + (quasisyntax/loc the-submodule-stx + (define-module #,the-submodule-stx)))) + (cons lang-stx (box null))))) + (values (car lang-stx*stxs-box) + (cdr lang-stx*stxs-box)))) + +(define-syntax (module** stx) + (syntax-case stx () + [(_ the-submodule lang e ...) + (begin + ;; This looks it up the first time and is allowed to create a + ;; list if necessary + (define-values (lang-should-be _) + (get-stxs-box #'the-submodule #'lang)) + (unless (lang=? #'lang lang-should-be) + (raise-syntax-error 'module** (format "All occurrences of module** for the same submodule should use the same language position; given ~e, where previous use had ~e" #'lang lang-should-be))) + #'(begin-for-syntax + (define-values (_ stxs-box) + (get-stxs-box #'the-submodule #f)) + (set-box! stxs-box + (append (unbox stxs-box) + (syntax->list #'(e ...))))))])) + +(define-syntax (define-module stx) + (syntax-case stx () + [(_ the-submodule) + (begin + (define-values (lang-stx stxs-box) + (get-stxs-box #'the-submodule #f)) + (quasisyntax/loc #'the-submodule + (module* the-submodule #,lang-stx + #,@(unbox stxs-box))))])) + +(define-syntax-rule (define-shorthand when-testing test) + (define-syntax (when-testing stx) + (syntax-case stx () + [(_ e (... ...)) + (quasisyntax/loc stx + (module** #,(datum->syntax stx 'test) #f + e (... ...)))]))) +(define-shorthand when-testing test) + +(provide module** + when-testing) diff --git a/collects/scribblings/raco/raco.scrbl b/collects/scribblings/raco/raco.scrbl index 9196ef811c..6acec51856 100644 --- a/collects/scribblings/raco/raco.scrbl +++ b/collects/scribblings/raco/raco.scrbl @@ -26,4 +26,5 @@ a typical Racket installation. @include-section["decompile.scrbl"] @include-section["demod.scrbl"] @include-section["ctool.scrbl"] +@include-section["test.scrbl"] @include-section["command.scrbl"] diff --git a/collects/scribblings/raco/test.scrbl b/collects/scribblings/raco/test.scrbl new file mode 100644 index 0000000000..cff0e17d09 --- /dev/null +++ b/collects/scribblings/raco/test.scrbl @@ -0,0 +1,12 @@ +#lang scribble/doc +@(require scribble/manual + "common.rkt" + (for-label racket/runtime-path + launcher/launcher)) + +@title[#:tag "test"]{@exec{raco test}: Run tests} + +The @exec{raco test} command requires and runs the @racket['test] +submodules associated with paths given on the command line. When a +path refers to a directory, the tool recursively discovers all +internal files and inspects them as well. diff --git a/collects/scribblings/reference/syntax.scrbl b/collects/scribblings/reference/syntax.scrbl index fa5f57b749..cb74684f3e 100644 --- a/collects/scribblings/reference/syntax.scrbl +++ b/collects/scribblings/reference/syntax.scrbl @@ -11,6 +11,7 @@ racket/package racket/splicing racket/runtime-path + racket/submodule racket/performance-hint)) @(define require-eval (make-base-eval)) @@ -313,12 +314,32 @@ The @racket[#%module-begin] form of @racketmodname[racket/base] wraps every top-level expression to print non-@|void-const| results using @racket[current-print].} - @defform[(#%plain-module-begin form ...)]{ Legal only in a @tech{module begin context}, and handled by the @racket[module] and @racket[module*] forms.} + +@;------------------------------------------------------------------------ +@subsection[#:tag "submodule"]{Submodule helpers: @racket[module**]} + +@note-lib-only[racket/submodule] + +@defform*[((module** id module-path form ...) + (module** id #f form ...))]{ + +Like @racket[module*], but multiple occurrences of @racket[module**] +defining the same @tech{submodule} will be spliced together into a +single module at the end of the enclosing module. Each occurrence must +use the same form for the initial bindings of the submodule. } + +@defform[(when-testing form ...)]{ + + An abbreviation of @racket[(module** test #f form ...)]; useful for + embedding tests while spreading them throughout your + modules. Cooperates with @exec{raco test}. +} + @;------------------------------------------------------------------------ @section[#:tag '("require" "provide")]{Importing and Exporting: @racket[require] and @racket[provide]} diff --git a/collects/tests/compiler/test/a.rkt b/collects/tests/compiler/test/a.rkt new file mode 100644 index 0000000000..a8b4a5e6f7 --- /dev/null +++ b/collects/tests/compiler/test/a.rkt @@ -0,0 +1,4 @@ +#lang racket/base +(error 'dont-run) +(module test racket/base + (printf "a\n")) diff --git a/collects/tests/compiler/test/b.rkt b/collects/tests/compiler/test/b.rkt new file mode 100644 index 0000000000..dc1a6edb80 --- /dev/null +++ b/collects/tests/compiler/test/b.rkt @@ -0,0 +1,4 @@ +#lang racket/base +(error 'dont-run) +(module test racket/base + (printf "b\n")) diff --git a/collects/tests/compiler/test/d/c.rkt b/collects/tests/compiler/test/d/c.rkt new file mode 100644 index 0000000000..892e318617 --- /dev/null +++ b/collects/tests/compiler/test/d/c.rkt @@ -0,0 +1,4 @@ +#lang racket/base +(error 'dont-run) +(module test racket/base + (printf "c\n")) diff --git a/collects/tests/compiler/test/d/d.rkt b/collects/tests/compiler/test/d/d.rkt new file mode 100644 index 0000000000..7bc35af1c4 --- /dev/null +++ b/collects/tests/compiler/test/d/d.rkt @@ -0,0 +1 @@ +#lang racket/base diff --git a/collects/tests/racket/submodule.rkt b/collects/tests/racket/submodule.rkt new file mode 100644 index 0000000000..e330fe0851 --- /dev/null +++ b/collects/tests/racket/submodule.rkt @@ -0,0 +1,52 @@ +#lang racket/base + +(module fac1 racket/base + (printf "fac1 running\n") + (require racket/submodule) + (define (! n) + (if (zero? n) + 1 + (* n (! (sub1 n))))) + (module** test #f + (printf "fac1 testing\n") + (require rackunit) + (check-equal? (! 0) 1)) + (module** test #f + (check-equal? (! 1) 1) + (check-equal? (! 5) 120))) + +(require (submod 'fac1 test)) + +(module fac2 racket/base + (printf "fac2 running\n") + (require racket/submodule) + (define (! n) + (if (zero? n) + 1 + (* n (! (sub1 n))))) + (when-testing + (printf "fac2 testing\n") + (require rackunit) + (check-equal? (! 0) 1)) + (when-testing + (check-equal? (! 1) 1) + (check-equal? (! 5) 120))) + +(require (submod 'fac2 test)) + +(module fac3 racket/base + (printf "fac3 running\n") + (require racket/submodule) + (define (! n) + (if (zero? n) + 1 + (* n (! (sub1 n))))) + (module** test #f + (printf "fac3 testing\n") + (require rackunit) + (check-equal? (! 0) 1)) + (when-testing + (check-equal? (! 1) 1) + (check-equal? (! 5) 120))) + +(require (submod 'fac3 test))