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

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

View File

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

View File

@ -27,7 +27,7 @@
;; tests : (listof test)
(define tests
(list
(build-test "12345"
'(("12345" constant)))
(build-test "'abcdef"
@ -549,7 +549,21 @@
(list '((10 18) (20 27))
'((28 55) (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))"
'(("(" default-color)
("module" imported-syntax)