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

fixed bug in syntax checker; now works with only require spec

Browse Source 
svn: r376
This commit is contained in:
Robby Findler 2005-07-13 15:57:22 +00:00
parent 78bad3ef90
commit d277160879
2 changed files with 28 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/drscheme/syncheck.ss
View File

@ -49,7 +49,6 @@ If the namespace does not, they are colored the unbound color.
syncheck:add-mouse-over-status syncheck:add-mouse-over-status
syncheck:add-jump-to-definition syncheck:add-jump-to-definition
syncheck:sort-bindings-table syncheck:sort-bindings-table
syncheck:get-bindings-table
syncheck:jump-to-next-bound-occurrence syncheck:jump-to-next-bound-occurrence
syncheck:jump-to-binding-occurrence syncheck:jump-to-binding-occurrence
syncheck:jump-to-definition syncheck:jump-to-definition
@ -57,7 +56,8 @@ If the namespace does not, they are colored the unbound color.
syncheck:clear-highlighting syncheck:clear-highlighting
syncheck:button-callback syncheck:button-callback
syncheck:add-to-cleanup-texts syncheck:add-to-cleanup-texts
syncheck:error-report-visible? ;syncheck:error-report-visible? ;; test suite uses this one.
;syncheck:get-bindings-table ;; test suite uses this one.
syncheck:clear-error-message syncheck:clear-error-message
hide-error-report hide-error-report
@ -1855,14 +1855,16 @@ If the namespace does not, they are colored the unbound color.
;; trim-require-prefix : syntax -> syntax ;; trim-require-prefix : syntax -> syntax
(define (trim-require-prefix require-spec) (define (trim-require-prefix require-spec)
(let loop ([stx require-spec]) (syntax-case require-spec (prefix all-except rename only)
(syntax-case stx (prefix all-except rename) [(prefix identifier module-name)
[(prefix identifier module-name) (loop (syntax module-name))] (syntax module-name)]
[(all-except module-name identifer ...) [(all-except module-name identifer ...)
(loop (syntax module-name))] (syntax module-name)]
[(rename module-name local-identifer exported-identifer) [(only module-name identifer ...)
(loop (syntax module-name))] (syntax module-name)]
[_ stx]))) [(rename module-name local-identifer exported-identifer)
(syntax module-name)]
[_ require-spec]))
;; add-binders : syntax id-set -> void ;; add-binders : syntax id-set -> void
;; transforms an argument list into a bunch of symbols/symbols ;; transforms an argument list into a bunch of symbols/symbols

18
collects/tests/drscheme/syncheck-test.ss
View File

@ -27,7 +27,7 @@
;; tests : (listof test) ;; tests : (listof test)
(define tests (define tests
(list (list
(build-test "12345" (build-test "12345"
'(("12345" constant))) '(("12345" constant)))
(build-test "'abcdef" (build-test "'abcdef"
@ -549,7 +549,21 @@
(list '((10 18) (20 27)) (list '((10 18) (20 27))
'((28 55) (73 80) (81 86)) '((28 55) (73 80) (81 86))
'((56 71) (73 80) (81 86)))) '((56 71) (73 80) (81 86))))
(build-test "(module m mzscheme (require (only (lib \"list.ss\") foldr) (only (lib \"list.ss\") foldl)) foldl foldr)"
'(("(" default-color)
("module" imported-syntax)
(" m mzscheme (" default-color)
("require" imported-syntax)
(" (only (lib \"list.ss\") foldr) (only (lib \"list.ss\") foldl)) " default-color)
("foldl" imported-variable)
(" " default-color)
("foldr" imported-variable)
(")" default-color))
(list '((10 18) (20 27))
'((28 56) (87 92) (93 98))
'((57 85) (87 92) (93 98))))
(build-test "(module m mzscheme (require (lib \"etc.ss\")) (rec f 1))" (build-test "(module m mzscheme (require (lib \"etc.ss\")) (rec f 1))"
'(("(" default-color) '(("(" default-color)
("module" imported-syntax) ("module" imported-syntax)