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

fixed PR 8133

Browse Source 
svn: r3420
This commit is contained in:
Robby Findler 2006-06-20 03:48:56 +00:00
parent de6afca593
commit f052bbb28b
2 changed files with 41 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/drscheme/syncheck.ss
View File

@ -1879,7 +1879,7 @@ If the namespace does not, they are colored the unbound color.
;; extract-provided-vars : syntax -> (listof syntax[identifier])
(define (extract-provided-vars stx)
(syntax-case stx (rename struct all-from all-from-except)
(syntax-case* stx (rename struct all-from all-from-except) symbolic-compare?
[identifier
(identifier? (syntax identifier))
(list (syntax identifier))]
@ -1898,9 +1898,9 @@ If the namespace does not, they are colored the unbound color.
null]))
;; trim-require-prefix : syntax -> syntax
;; trim-require-prefix : syntax -> syntax
(define (trim-require-prefix require-spec)
(syntax-case require-spec (prefix all-except rename only)
(syntax-case* require-spec (prefix all-except rename only) symbolic-compare?
[(prefix identifier module-name)
(syntax module-name)]
[(all-except module-name identifer ...)
@ -1911,6 +1911,8 @@ If the namespace does not, they are colored the unbound color.
(syntax module-name)]
[_ require-spec]))
(define (symbolic-compare? x y) (eq? (syntax-e x) (syntax-e y)))
;; add-binders : syntax id-set -> void
;; transforms an argument list into a bunch of symbols/symbols
;; and puts them into the id-set

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

@ -28,6 +28,42 @@
(define tests
(list
;; the next two tests are new, complex ones that need to
;; move to the bottom of the test file, when the rest of these
;; tests are cleaned up.
;; right now, there is a bug that causes lots of tests to fail for a stupid reason
(build-test "(module m mzscheme (define-syntax rename #f) (require (rename mzscheme ++ +)))"
'(("(" default-color)
("module" imported-identifier)
(" m mzscheme (" default-color)
("define-syntax" imported-identifier)
(" " default-color)
("rename" lexically-bound-identifier)
(" #f) (" default-color)
("require" imported-identifier)
(" (rename mzscheme ++ +)))" default-color))
(list '((10 18) (20 33) (46 53))
'((54 76) (20 33) (46 53))))
(build-test "(module m mzscheme (define-syntax rename #f) (define f 1) (provide (rename f g)))"
'(("(" default-color)
("module" imported-identifier)
(" m mzscheme (" default-color)
("define-syntax" imported-identifier)
(" " default-color)
("rename" lexically-bound-identifier)
(" #f) (" default-color)
("define" imported-identifier)
(" " default-color)
("f" lexically-bound-identifier)
(" 1) (" default-color)
("provide" imported-identifier)
(" (rename f g)))" default-color))
(list '((10 18) (20 33) (46 52) (59 66))
'((53 54) (75 76))))
(build-test "12345"
'(("12345" constant)))
(build-test "'abcdef"