fix up a few bugs, improve the docs, and start a test suite for the
new check syntax direct-to-traversal api
This commit is contained in:
parent
fdcb22ea32
commit
00d3f72f21
|
@ -87,8 +87,8 @@
|
||||||
(mixin () (syncheck-annotations<%>)
|
(mixin () (syncheck-annotations<%>)
|
||||||
(define/public (syncheck:find-source-object stx) #f)
|
(define/public (syncheck:find-source-object stx) #f)
|
||||||
(define/public (syncheck:add-background-color source start end color) (void))
|
(define/public (syncheck:add-background-color source start end color) (void))
|
||||||
(define/public (syncheck:add-require-open-menu source color start end key) (void))
|
(define/public (syncheck:add-require-open-menu source start end key) (void))
|
||||||
(define/public (syncheck:add-rename-menu text start-pos end-pos key id-as-sym id-sets rename-ht get-ids) (void))
|
(define/public (syncheck:add-rename-menu id all-ids new-name-intereferes?) (void))
|
||||||
(define/public (syncheck:add-docs-menu text start-pos end-pos key the-label path tag) (void))
|
(define/public (syncheck:add-docs-menu text start-pos end-pos key the-label path tag) (void))
|
||||||
(define/public (syncheck:add-arrow start-text start-pos-left start-pos-right
|
(define/public (syncheck:add-arrow start-text start-pos-left start-pos-right
|
||||||
end-text end-pos-left end-pos-right
|
end-text end-pos-left end-pos-right
|
||||||
|
|
|
@ -892,7 +892,7 @@
|
||||||
;; finds the filename corresponding to the require in stx
|
;; finds the filename corresponding to the require in stx
|
||||||
(define (get-require-filename datum user-namespace user-directory)
|
(define (get-require-filename datum user-namespace user-directory)
|
||||||
(parameterize ([current-namespace user-namespace]
|
(parameterize ([current-namespace user-namespace]
|
||||||
[current-directory user-directory]
|
[current-directory (or user-directory (current-directory))]
|
||||||
[current-load-relative-directory user-directory])
|
[current-load-relative-directory user-directory])
|
||||||
(let* ([rkt-path/mod-path
|
(let* ([rkt-path/mod-path
|
||||||
(with-handlers ([exn:fail? (λ (x) #f)])
|
(with-handlers ([exn:fail? (λ (x) #f)])
|
||||||
|
|
|
@ -619,9 +619,9 @@ Check Syntax is a part of the DrRacket collection, but is implemented via the to
|
||||||
(-> void?))]{
|
(-> void?))]{
|
||||||
This function creates some local state about a traversal of syntax objects
|
This function creates some local state about a traversal of syntax objects
|
||||||
and returns two functions. The first one should be called with each of the
|
and returns two functions. The first one should be called with each of the
|
||||||
syntax objects that make up a program (there will be only one if the program
|
(fully expanded) syntax objects that make up a program (there will be only
|
||||||
is a module) and then the second one should be called to indicate there are no
|
one if the program is a module) and then the second one should be called to
|
||||||
more.
|
indicate there are no more.
|
||||||
|
|
||||||
The optional argument to the first function is called for each sequence
|
The optional argument to the first function is called for each sequence
|
||||||
of binding identifiers encountered in @racket[define-values], @racket[define-syntaxes],
|
of binding identifiers encountered in @racket[define-values], @racket[define-syntaxes],
|
||||||
|
@ -630,7 +630,8 @@ Check Syntax is a part of the DrRacket collection, but is implemented via the to
|
||||||
During the dynamic extent of the call to the two result functions, the value
|
During the dynamic extent of the call to the two result functions, the value
|
||||||
of the @racket[current-annotations] parameter is consulted and various
|
of the @racket[current-annotations] parameter is consulted and various
|
||||||
methods are invoked in the corresponding object (if any), to indicate
|
methods are invoked in the corresponding object (if any), to indicate
|
||||||
what has been found in the syntax object.
|
what has been found in the syntax object. These methods will only be called
|
||||||
|
if the syntax objects have source locations.
|
||||||
}
|
}
|
||||||
|
|
||||||
@defparam[current-annotations ca (or/c #f (is-a?/c syncheck-annotations<%>))]{
|
@defparam[current-annotations ca (or/c #f (is-a?/c syncheck-annotations<%>))]{
|
||||||
|
@ -760,6 +761,10 @@ Check Syntax is a part of the DrRacket collection, but is implemented via the to
|
||||||
Supplies all of the methods in @racket[syncheck-annotations<%>]
|
Supplies all of the methods in @racket[syncheck-annotations<%>]
|
||||||
with default behavior. Be sure to use this mixin to future-proof
|
with default behavior. Be sure to use this mixin to future-proof
|
||||||
your code and then override the methods you're interested in.
|
your code and then override the methods you're interested in.
|
||||||
|
|
||||||
|
The @racket[syncheck:find-source-object] method ignores its arguments
|
||||||
|
and returns @racket[#f];
|
||||||
|
all of the other methods ignore their arguments and return @racket[(void)].
|
||||||
}
|
}
|
||||||
|
|
||||||
@(define-syntax-rule
|
@(define-syntax-rule
|
||||||
|
@ -767,7 +772,7 @@ Check Syntax is a part of the DrRacket collection, but is implemented via the to
|
||||||
(begin @defidform[x]{Bound to an identifier created with @racket[define-local-member-name]
|
(begin @defidform[x]{Bound to an identifier created with @racket[define-local-member-name]
|
||||||
that is used in @racket[syncheck-annotations<%>].}
|
that is used in @racket[syncheck-annotations<%>].}
|
||||||
...))
|
...))
|
||||||
@syncheck-method-id[syncheck:find-source-editor
|
@syncheck-method-id[syncheck:find-source-object
|
||||||
syncheck:add-background-color
|
syncheck:add-background-color
|
||||||
syncheck:add-require-open-menu
|
syncheck:add-require-open-menu
|
||||||
syncheck:add-docs-menu
|
syncheck:add-docs-menu
|
||||||
|
|
68
collects/tests/drracket/syncheck-direct.rkt
Normal file
68
collects/tests/drracket/syncheck-direct.rkt
Normal file
|
@ -0,0 +1,68 @@
|
||||||
|
#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?))
|
Loading…
Reference in New Issue
Block a user