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

Fixes check syntax bug

Browse Source
This commit is contained in:
Casey Klein 2011-08-15 17:50:11 -05:00
parent a0f2db7574
commit 72059c908b
2 changed files with 30 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/drracket/private/syncheck/traversals.rkt
View File

@ -1228,14 +1228,15 @@
(when ed (when ed
(define pos (syntax-position var)) (define pos (syntax-position var))
(define span (syntax-span var)) (define span (syntax-span var))
(define start (- pos 1)) (when (and pos span)
(define fin (+ start span)) (define start (- pos 1))
(define loc (list ed start fin)) (define fin (+ start span))
(module-identifier-mapping-put! (define loc (list ed start fin))
id-to-sets (module-identifier-mapping-put!
var id-to-sets
(set-add (module-identifier-mapping-get id-to-sets var set) var
loc))))))) (set-add (module-identifier-mapping-get id-to-sets var set)
loc))))))))
(module-identifier-mapping-for-each (module-identifier-mapping-for-each
id-to-sets id-to-sets
(λ (id locs) (λ (id locs)

21
collects/tests/drracket/syncheck-direct.rkt
View File

@ -66,3 +66,24 @@
(let ([y 1]) y))))))) (let ([y 1]) y)))))))
(done)) (done))
add-arrow-called?)) add-arrow-called?))
(check-not-exn
(λ ()
(define annotations
(new (class (annotations-mixin object%)
(super-new)
(define/override (syncheck:find-source-object stx)
stx))))
(define base-namespace (make-base-namespace))
(define-values (add-syntax done)
(make-traversal base-namespace #f))
(parameterize ([current-annotations annotations]
[current-namespace base-namespace])
(eval '(require (for-syntax racket/base)))
(add-syntax
(expand
'(let-syntax ([m (λ (_) #`(let ([x 1]) x))])
(m))))
(done))))