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

fix syntax-disarm with a #f second argument

Browse Source
This commit is contained in:
Matthew Flatt 2014-12-09 19:34:33 -07:00
parent 8f4575eeec
commit d780930056
2 changed files with 25 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
pkgs/racket-test/tests/racket/stx.rktl
View File

@ -848,25 +848,29 @@
[(_ x) #'x]))
exn:fail:syntax?))
(let ([expr (expand-syntax #'++v)]
[disarm (lambda (stx)
(syntax-disarm stx (current-code-inspector)))])
(test expr syntax-protect expr)
(let ([new (syntax-protect #'no-marks)])
(test #t syntax? new)
(test 'no-marks syntax-e new))
(test #t (lambda (v) (and (syntax? v) (syntax-tainted? v)))
(syntax-case expr ()
[(beg id) #'beg]))
(test #t (lambda (v) (and (syntax? v) (not (syntax-tainted? v))))
(syntax-case (disarm expr) ()
[(beg id) #'beg]))
(test #t (lambda (v) (and (syntax? v) (syntax-tainted? v)))
(syntax-case (disarm (datum->syntax expr (syntax-e expr))) ()
[(beg id) #'beg]))
(test #t (lambda (v) (and (syntax? v) (not (syntax-tainted? v))))
(syntax-case (let ([expr (disarm expr)]) (datum->syntax expr (syntax-e expr))) ()
[(beg id) #'beg])))
(let ()
(define (test-disarm disarm)
(let ([expr (expand-syntax #'++v)])
(test expr syntax-protect expr)
(let ([new (syntax-protect #'no-marks)])
(test #t syntax? new)
(test 'no-marks syntax-e new))
(test #t (lambda (v) (and (syntax? v) (syntax-tainted? v)))
(syntax-case expr ()
[(beg id) #'beg]))
(test #t (lambda (v) (and (syntax? v) (not (syntax-tainted? v))))
(syntax-case (disarm expr) ()
[(beg id) #'beg]))
(test #t (lambda (v) (and (syntax? v) (syntax-tainted? v)))
(syntax-case (disarm (datum->syntax expr (syntax-e expr))) ()
[(beg id) #'beg]))
(test #t (lambda (v) (and (syntax? v) (not (syntax-tainted? v))))
(syntax-case (let ([expr (disarm expr)]) (datum->syntax expr (syntax-e expr))) ()
[(beg id) #'beg]))))
(test-disarm (lambda (stx)
(syntax-disarm stx (current-code-inspector))))
(test-disarm (lambda (stx)
(syntax-disarm stx #f))))
#;
(let ([expr (expand-syntax #'(++apply-to-d ack))])

4
racket/src/racket/src/syntax.c
View File

@ -8793,8 +8793,8 @@ static Scheme_Object *syntax_disarm(int argc, Scheme_Object **argv)
insp = argv[1];
} else
insp = scheme_false;
return scheme_stx_taint_disarm(argv[0], insp);
return scheme_syntax_taint_disarm(argv[0], insp);
}
static Scheme_Object *syntax_rearm(int argc, Scheme_Object **argv)