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

change HtDP tester to check #%module-begin effect

Browse Source 
svn: r1542
This commit is contained in:
Matthew Flatt 2005-12-06 21:29:24 +00:00
parent 3fae8822a3
commit e0eb139f42
2 changed files with 28 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/tests/mzscheme/advanced.ss
View File

@ -49,12 +49,17 @@
(test 2 'begin (begin 1 2))
(test 3 'begin (begin 1 2 3))
(htdp-top (define ex 12))
(htdp-test 13 'begin+set! (begin (set! ex 13) ex))
(htdp-test 12 'begin+set! (begin 12 ex))
(htdp-top-pop 1)
(htdp-syntax-test #'begin0)
(htdp-syntax-test #'(begin0))
(test 1 'begin0 (begin0 1))
(test 2 'begin0 (begin0 2 1))
(test 3 'begin0 (begin0 3 2 1))
(htdp-test 1 'begin0 (begin0 1))
(htdp-test 2 'begin0 (begin0 2 1))
(htdp-test 3 'begin0 (begin0 3 2 1))
(htdp-syntax-test #'set!)
(htdp-syntax-test #'(set!))

21
collects/tests/mzscheme/htdp-test.ss
View File

@ -21,10 +21,29 @@
(and (exn:fail:syntax? x)
(regexp-match rx (exn-message x)))))]))
(require (rename mzscheme mz-let let))
(define-syntax (htdp-test stx)
(syntax-case stx ()
[(_ expect f . args)
#'(do-htdp-test #'(test expect f . args) #f #f)]))
#'(begin
(do-htdp-test #'(test expect f . args) #f #f)
(htdp-try-direct-module f . args))]))
(define-syntax (htdp-try-direct-module stx)
(syntax-case stx ()
[(_ 'nm expr)
;; double-check that there's no error, at least,
;; when using the real module-begin:
#'(mz-let ([name (gensym)])
(eval
#`(module #,name #,current-htdp-lang
#,@body-accum
expr))
(dynamic-require name #f))]
[_
(printf "~s\n" (syntax-object->datum stx))
#'(void)]))
(define (htdp-string-to-pred exn?/rx)
(if (string? exn?/rx)