From 00d3f72f210a3649b68945d0f3bf14da4d9bdd10 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sun, 14 Aug 2011 14:31:04 -0500 Subject: [PATCH] fix up a few bugs, improve the docs, and start a test suite for the new check syntax direct-to-traversal api --- collects/drracket/private/syncheck/intf.rkt | 4 +- .../drracket/private/syncheck/traversals.rkt | 2 +- collects/scribblings/tools/tools.scrbl | 15 ++-- collects/tests/drracket/syncheck-direct.rkt | 68 +++++++++++++++++++ 4 files changed, 81 insertions(+), 8 deletions(-) create mode 100644 collects/tests/drracket/syncheck-direct.rkt diff --git a/collects/drracket/private/syncheck/intf.rkt b/collects/drracket/private/syncheck/intf.rkt index 70c190e6e8..a5b9388d11 100644 --- a/collects/drracket/private/syncheck/intf.rkt +++ b/collects/drracket/private/syncheck/intf.rkt @@ -87,8 +87,8 @@ (mixin () (syncheck-annotations<%>) (define/public (syncheck:find-source-object stx) #f) (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-rename-menu text start-pos end-pos key id-as-sym id-sets rename-ht get-ids) (void)) + (define/public (syncheck:add-require-open-menu source start end key) (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-arrow start-text start-pos-left start-pos-right end-text end-pos-left end-pos-right diff --git a/collects/drracket/private/syncheck/traversals.rkt b/collects/drracket/private/syncheck/traversals.rkt index 3618a3cec0..0ab439db10 100644 --- a/collects/drracket/private/syncheck/traversals.rkt +++ b/collects/drracket/private/syncheck/traversals.rkt @@ -892,7 +892,7 @@ ;; finds the filename corresponding to the require in stx (define (get-require-filename datum user-namespace user-directory) (parameterize ([current-namespace user-namespace] - [current-directory user-directory] + [current-directory (or user-directory (current-directory))] [current-load-relative-directory user-directory]) (let* ([rkt-path/mod-path (with-handlers ([exn:fail? (λ (x) #f)]) diff --git a/collects/scribblings/tools/tools.scrbl b/collects/scribblings/tools/tools.scrbl index ef1de65992..bf34cfee28 100644 --- a/collects/scribblings/tools/tools.scrbl +++ b/collects/scribblings/tools/tools.scrbl @@ -619,9 +619,9 @@ Check Syntax is a part of the DrRacket collection, but is implemented via the to (-> void?))]{ 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 - syntax objects that make up a program (there will be only one if the program - is a module) and then the second one should be called to indicate there are no - more. + (fully expanded) syntax objects that make up a program (there will be only + one if the program is a module) and then the second one should be called to + indicate there are no more. The optional argument to the first function is called for each sequence 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 of the @racket[current-annotations] parameter is consulted and various 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<%>))]{ @@ -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<%>] with default behavior. Be sure to use this mixin to future-proof 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 @@ -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] 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-require-open-menu syncheck:add-docs-menu diff --git a/collects/tests/drracket/syncheck-direct.rkt b/collects/tests/drracket/syncheck-direct.rkt new file mode 100644 index 0000000000..6e7ab1a672 --- /dev/null +++ b/collects/tests/drracket/syncheck-direct.rkt @@ -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?))