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

add a unicode test to scheme-lexer.rkt

Browse Source 
and change the tests so they all run with port line
counting enabled (or else the unicode test fails)

adjust module-lexer.rkt tests so they can run in either
port-counting mode or not (but currently run them all in
port-counting mode because scheme-lexer doesn't work without it)

also make a first stab at what needs to change in the module
lexer to make it work in non port line-counting mode
This commit is contained in:
Robby Findler 2011-11-03 22:37:21 -05:00
parent 4314b2ac28
commit 65fd0234ad
3 changed files with 32 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/syntax-color/module-lexer.rkt
View File

@ -26,7 +26,9 @@ to delegate to the scheme-lexer (in the 'no-lang-line mode).
(cond
[(or (not mode) (eq? mode 'before-lang-line))
(define lexer-port (peeking-input-port in #:init-position (+ 1 (file-position in))))
(port-count-lines! lexer-port)
(let-values ([(line col pos) (port-next-location in)])
(when line
(port-count-lines! lexer-port)))
(set-port-next-location-from in lexer-port)
(define-values (lexeme type data new-token-start new-token-end) (scheme-lexer lexer-port))
(cond
@ -39,7 +41,9 @@ to delegate to the scheme-lexer (in the 'no-lang-line mode).
[else
;; look for #lang:
(define p (peeking-input-port in #:init-position (+ 1 (file-position in))))
(port-count-lines! p)
(let-values ([(line col pos) (port-next-location in)])
(when line
(port-count-lines! p)))
(set-port-next-location-from in p)
(define-values (_1 _2 start-pos) (port-next-location p))
(define get-info (with-handlers ([exn:fail? values]) (read-language p (λ () 'fail))))

20
collects/tests/syntax-color/module-lexer.rkt
View File

@ -2,9 +2,9 @@
(require syntax-color/module-lexer
rackunit)
(define (lex str)
(define (lex str count?)
(define p (open-input-string str))
(port-count-lines! p)
(when count? (port-count-lines! p))
(let loop ([mode #f]
[n 0])
(define-values (lexeme type data token-start token-end backup new-mode)
@ -35,37 +35,37 @@
(same? (cdr a) (cdr b)))]
[else (equal? a b)]))
(check-equal? (lex "#lang racket/base")
(check-equal? (lex "#lang racket/base" #t)
`(("#lang" other 1 18 #f)
(,eof eof #f #f (proc scheme-lexer))))
(check-equal? (lex "#lang racket/base\n1")
(check-equal? (lex "#lang racket/base\n1" #t)
`(("#lang" other 1 18 #f)
("\n" white-space 18 19 (proc scheme-lexer))
("1" constant 19 20 (proc scheme-lexer))
(,eof eof #f #f (proc scheme-lexer))))
(check-equal? (lex ";; αα\n")
(check-equal? (lex ";; αα\n" #t)
`(("; αα" comment 1 6 #f)
("\n" white-space 6 7 before-lang-line)
(,eof eof #f #f before-lang-line)))
(check-equal? (lex ";; ααα\n;; aaa\n")
(check-equal? (lex ";; ααα\n;; aaa\n" #t)
`(("; ααα" comment 1 7 #f)
("\n" white-space 7 8 before-lang-line)
("; aaa" comment 8 14 before-lang-line)
("\n" white-space 14 15 before-lang-line)
(,eof eof #f #f before-lang-line)))
(check-equal? (lex ";; a\n#lang racket/base")
(check-equal? (lex ";; a\n#lang racket/base" #t)
`(("; a" comment 1 5 #f)
("\n" white-space 5 6 before-lang-line)
("#lang" other 6 23 before-lang-line)
(,eof eof #f #f (proc scheme-lexer))))
(check-equal? (lex "#lang at-exp racket/base")
(check-equal? (lex "#lang at-exp racket/base" #t)
`(("#lang" other 1 25 #f)
(,eof eof 25 25 ((proc scribble-lexer) . #f))))
(check-equal? (lex "#lang at-exp racket/baseBOGUS")
(check-equal? (lex "#lang at-exp racket/baseBOGUS" #t)
`(("#lang at-exp" error 1 31 #f)
(,eof eof #f #f no-lang-line)))
(check same?
(lex "#lang at-exp racket/base\n1\n")
(lex "#lang at-exp racket/base\n1\n" #t)
`(("#lang" other 1 25 #f)
("\n" white-space 25 26 ((proc scribble-lexer) . #f))
("1" constant 26 27 ((proc scribble-lexer) . dont-care))

30
collects/tests/syntax-color/scheme-lexer.rkt
View File

@ -49,21 +49,22 @@
#'(test/proc line args ...))]))
(define (test/proc line input expected [e-n (chunks (string->list expected))])
(let* ([p (input->port input)]
(l (lex scheme-lexer p))
(s (apply string-append l)))
(close-input-port p)
(unless (string=? s expected)
(define p (input->port input))
(port-count-lines! p)
(define l (lex scheme-lexer p))
(define s (apply string-append l))
(close-input-port p)
(unless (string=? s expected)
(eprintf "test on line ~a failed:\n" line)
(eprintf " input : ~s\n" input)
(eprintf " output : ~s\n" s)
(eprintf " expected: ~s\n\n" expected))
(let ((a-n (length l)))
(unless (= e-n a-n)
(eprintf "test on line ~a failed:\n" line)
(eprintf " input : ~s\n" input)
(eprintf " output : ~s\n" s)
(eprintf " expected: ~s\n\n" expected))
(let ((a-n (length l)))
(unless (= e-n a-n)
(eprintf "test on line ~a failed:\n" line)
(eprintf " input : ~a\n" input)
(eprintf " expected: ~a tokens\n" e-n)
(eprintf " got : ~a tokens\n\n" a-n)))))
(eprintf " input : ~a\n" input)
(eprintf " expected: ~a tokens\n" e-n)
(eprintf " got : ~a tokens\n\n" a-n))))
(define (input->port input)
(let-values ([(in out) (make-pipe-with-specials)])
@ -442,6 +443,7 @@ end-string
"c i;;;;;; c ;;")
(test '(";a" 1 "b") ";;;;" 1) ;; a special comment
(test '(";a" 1 "b\n1" 1) ";;;; cn" 4)
(test ";αα" ";;;")
(test "#||#" ";;;;")
(test "#|#||#|#" ";;;;;;;;")