diff --git a/collects/compiler/commands/test.rkt b/collects/compiler/commands/test.rkt index 52a92bec9e..14b728d24e 100644 --- a/collects/compiler/commands/test.rkt +++ b/collects/compiler/commands/test.rkt @@ -4,25 +4,41 @@ racket/path raco/command-name) +(define submodule 'test) +(define run-anyways? #f) + (define do-test (match-lambda [(? string? s) (do-test (string->path s))] [(? path? p) + (define ps (path->string 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 + [(and (file-exists? p) + (regexp-match #rx"\\.rkt$" ps)) + (define fmod `(file ,ps)) + (define mod `(submod ,fmod ,submodule)) + (cond + [(module-declared? mod #t) + (dynamic-require mod #f)] + [(and run-anyways? (module-declared? fmod #t)) + (dynamic-require fmod #f)])] + [(not (file-exists? p)) (error 'test "Given path ~e does not exist" p)])])) (command-line #:program (short-program+command-name) + #:once-each + [("--submodule" "-s") submodule-str + "Determines which submodule to load" + (set! submodule (string->symbol submodule-str))] + [("--run-if-absent" "-r") + "When set, raco test will require the default module if the given submodule is not present." + (set! run-anyways? #t)] #:args files+directories (for-each do-test files+directories)) diff --git a/collects/meta/props b/collects/meta/props index 9252119bde..8586fb1d5f 100755 --- a/collects/meta/props +++ b/collects/meta/props @@ -1179,7 +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/racket/slice.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" *) @@ -1903,6 +1903,7 @@ path/s is either such a string or a list of them. "collects/tests/racket/struct.rktl" drdr:command-line (racket "-f" *) "collects/tests/racket/structlib.rktl" drdr:command-line (racket "-f" *) "collects/tests/racket/stx.rktl" drdr:command-line (racket "-f" *) +"collects/tests/racket/slice.rkt" responsible (jay) "collects/tests/racket/subprocess.rktl" drdr:command-line (racket "-f" *) drdr:random #t "collects/tests/racket/sync.rktl" drdr:command-line #f "collects/tests/racket/syntax-tests.rktl" drdr:command-line (racket "-f" *) diff --git a/collects/racket/slice.rkt b/collects/racket/slice.rkt new file mode 100644 index 0000000000..7c2f64b6e5 --- /dev/null +++ b/collects/racket/slice.rkt @@ -0,0 +1,47 @@ +#lang racket/base +(require (for-syntax racket/base)) + +(begin-for-syntax + (define module->submodule->stxs-box (make-weak-hash)) + (define (get-stxs-box the-submodule-stx lift?) + (define the-module (syntax-source-module the-submodule-stx)) + (define submodule->stxs-box + (hash-ref! module->submodule->stxs-box the-module make-weak-hasheq)) + (define the-submodule-id + (syntax->datum the-submodule-stx)) + (define stxs-box + (hash-ref! submodule->stxs-box the-submodule-id + (λ () + (when lift? + (syntax-local-lift-module-end-declaration + (quasisyntax/loc the-submodule-stx + (define-module #,the-submodule-stx)))) + (box null)))) + stxs-box)) + +(define-syntax (slice stx) + (syntax-case stx () + [(_ the-submodule e ...) + (identifier? #'the-submodule) + (begin + ;; This looks it up the first time and is allowed to create a + ;; list if necessary + (get-stxs-box #'the-submodule #t) + #'(begin-for-syntax + (define 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 stxs-box + (get-stxs-box #'the-submodule #f)) + (quasisyntax/loc #'the-submodule + (module* the-submodule #f + #,@(unbox stxs-box))))])) + +(provide slice) diff --git a/collects/racket/submodule.rkt b/collects/racket/submodule.rkt deleted file mode 100644 index 880aa43b46..0000000000 --- a/collects/racket/submodule.rkt +++ /dev/null @@ -1,70 +0,0 @@ -#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/test.scrbl b/collects/scribblings/raco/test.scrbl index cff0e17d09..5c988d7b0c 100644 --- a/collects/scribblings/raco/test.scrbl +++ b/collects/scribblings/raco/test.scrbl @@ -1,5 +1,6 @@ #lang scribble/doc @(require scribble/manual + scribble/bnf "common.rkt" (for-label racket/runtime-path launcher/launcher)) @@ -9,4 +10,12 @@ 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. +internal files that end in @filepath{.rkt} and inspects them as well. + +The @exec{raco test} command accepts a few flags: + +@itemize[ + @item{@DFlag{s} @nonterm{id} or @DFlag{submodule} @nonterm{id}--- Requires the submodule @nonterm{id} rather than @racket['test].} + + @item{@DFlag{r} or @DFlag{run-if-absent}--- Requires the default module if the given submodule is not present in a file.} +] diff --git a/collects/scribblings/reference/syntax.scrbl b/collects/scribblings/reference/syntax.scrbl index cb74684f3e..4661f9f95b 100644 --- a/collects/scribblings/reference/syntax.scrbl +++ b/collects/scribblings/reference/syntax.scrbl @@ -11,7 +11,7 @@ racket/package racket/splicing racket/runtime-path - racket/submodule + racket/slice racket/performance-hint)) @(define require-eval (make-base-eval)) @@ -321,24 +321,22 @@ Legal only in a @tech{module begin context}, and handled by the @;------------------------------------------------------------------------ -@subsection[#:tag "submodule"]{Submodule helpers: @racket[module**]} +@subsection[#:tag "slice"]{Slices: @racket[slice]} -@note-lib-only[racket/submodule] +@note-lib-only[racket/slice] -@defform*[((module** id module-path form ...) - (module** id #f form ...))]{ +@defform[(slice id 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. } +Declares a @tech{slice} of a @tech{submodule} named @racket[id]. -@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}. -} +A @deftech{slice} is a piece of a @tech{submodule}. Each slice of a +submodule is combined to form the entire submodule at +the end of the enclosing module. If there is only one slice, then +@racket[(slice id form ...)] is equivalent to @racket[(module* id #f +form ...)]. It is an error for a submodule to be defined using +@racket[slice] @emph{and} @racket[module] or @racket[module*]. That +is, if a submodule is made of slices, then it must be +made @emph{only} of slices. } @;------------------------------------------------------------------------ @section[#:tag '("require" "provide")]{Importing and Exporting: @racket[require] and @racket[provide]} diff --git a/collects/tests/racket/slice.rkt b/collects/tests/racket/slice.rkt new file mode 100644 index 0000000000..1073a41ec8 --- /dev/null +++ b/collects/tests/racket/slice.rkt @@ -0,0 +1,18 @@ +#lang racket/base + +(module fac1 racket/base + (printf "fac1 running\n") + (require racket/slice) + (define (! n) + (if (zero? n) + 1 + (* n (! (sub1 n))))) + (slice test + (printf "fac1 testing\n") + (require rackunit) + (check-equal? (! 0) 1)) + (slice test + (check-equal? (! 1) 1) + (check-equal? (! 5) 120))) + +(require (submod 'fac1 test)) diff --git a/collects/tests/racket/submodule.rkt b/collects/tests/racket/submodule.rkt deleted file mode 100644 index e330fe0851..0000000000 --- a/collects/tests/racket/submodule.rkt +++ /dev/null @@ -1,52 +0,0 @@ -#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))