suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

racket/slice, expand raco test, remove begin-for-testing

Browse Source
This commit is contained in:
Jay McCarthy 2012-03-09 19:51:42 -07:00
parent b73444a0f3
commit f8325776cf
8 changed files with 111 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/compiler/commands/test.rkt
View File

@ -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))

3
collects/meta/props
View File

@ -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" *)

47
collects/racket/slice.rkt Normal file
View File

@ -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)

70
collects/racket/submodule.rkt
View File

@ -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)

11
collects/scribblings/raco/test.scrbl
View File

@ -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.}
]

28
collects/scribblings/reference/syntax.scrbl
View File

@ -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]}

18
collects/tests/racket/slice.rkt Normal file
View File

@ -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))

52
collects/tests/racket/submodule.rkt
View File

@ -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))