racket/collects/tests/drracket/syncheck-direct.rkt
Robby Findler 00d3f72f21 fix up a few bugs, improve the docs, and start a test suite for the
new check syntax direct-to-traversal api
2011-08-14 14:32:45 -05:00

69 lines
2.1 KiB
Racket

#lang racket/base
(require drracket/check-syntax
racket/class
rackunit)
(check-true
(let ()
(define add-arrow-called? #f)
(define annotations
(new (class (annotations-mixin object%)
(super-new)
(define/override (syncheck:find-source-object stx)
(if (eq? 'the-source (syntax-source stx))
'yep
#f))
(define/override (syncheck:add-arrow . args)
(set! add-arrow-called? #t)))))
(define-values (add-syntax done)
(make-traversal (make-base-namespace)
(current-directory)))
(parameterize ([current-annotations annotations]
[current-namespace (make-base-namespace)])
(add-syntax (expand
(read-syntax
'the-source
(open-input-string
(format "~s"
`(module m racket/base
(define x 4)
x
(let ([y 1]) y)))))))
(done))
add-arrow-called?))
(check-true
(let ()
(define add-arrow-called? #f)
(define annotations
(new (class (annotations-mixin object%)
(super-new)
(define/override (syncheck:find-source-object stx)
(if (eq? 'the-source (syntax-source stx))
'yep
#f))
(define/override (syncheck:add-arrow . args)
(set! add-arrow-called? #t)))))
(define-values (add-syntax done)
(make-traversal (make-base-namespace) #f))
(parameterize ([current-annotations annotations]
[current-namespace (make-base-namespace)])
(add-syntax (expand
(read-syntax
'the-source
(open-input-string
(format "~s"
`(module m racket/base
(define x 4)
x
(let ([y 1]) y)))))))
(done))
add-arrow-called?))