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

fix a bug in the module lexer; it was returning the wrong length for the tokens

Browse Source 
it creates when the #lang line isn't well-formed (eg "#lang racke").

closes PR 12399

original commit: 11994bd4f8ea60b5a19ae1f1129bc5c072f3311f
This commit is contained in:
Robby Findler 2011-11-28 21:12:04 -06:00
parent d3dc21e2d3
commit e526d30337
1 changed files with 314 additions and 313 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
collects/framework/private/color.rkt
View File

@ -290,12 +290,12 @@ added get-regions
(sync-invalid ls))))
(define/private (re-tokenize ls in in-start-pos in-lexer-mode enable-suspend)
(let-values ([(lexeme type data new-token-start new-token-end backup-delta new-lexer-mode)
(begin
(enable-suspend #f)
(begin0
(get-token in in-start-pos in-lexer-mode)
(enable-suspend #t)))])
;(define-values (_line1 _col1 pos-before) (port-next-location in))
(define-values (lexeme type data new-token-start new-token-end backup-delta new-lexer-mode)
(get-token in in-start-pos in-lexer-mode))
;(define-values (_line2 _col2 pos-after) (port-next-location in))
(enable-suspend #t)
(unless (eq? 'eof type)
(unless (exact-nonnegative-integer? new-token-start)
(error 'color:text<%> "expected an exact nonnegative integer for the token start, got ~e" new-token-start))
@ -306,9 +306,15 @@ added get-regions
(unless (0 . < . (- new-token-end new-token-start))
(error 'color:text<%> "expected the distance between the start and end position for each token to be positive, but start was ~e and end was ~e" new-token-start new-token-end))
(enable-suspend #f)
#; (printf "~a at ~a to ~a\n" lexeme (+ in-start-pos (sub1 new-token-start))
#; (printf "~s at ~a to ~a\n" lexeme (+ in-start-pos (sub1 new-token-start))
(+ in-start-pos (sub1 new-token-end)))
(let ((len (- new-token-end new-token-start)))
#;
(unless (= len (- pos-after pos-before))
;; this check requires the two calls to port-next-location to be also uncommented
;; when this check fails, bad things can happen non-deterministically later on
(eprintf "pos changed bad ; len ~s pos-before ~s pos-after ~s (token ~s mode ~s)\n"
len pos-before pos-after lexeme new-lexer-mode))
(set-lexer-state-current-pos! ls (+ len (lexer-state-current-pos ls)))
(set-lexer-state-current-lexer-mode! ls new-lexer-mode)
(sync-invalid ls)
@ -330,7 +336,7 @@ added get-regions
#; (show-tree (lexer-state-tokens ls))
(send (lexer-state-parens ls) add-token data len)
(cond
((and (not (send (lexer-state-invalid-tokens ls) is-empty?))
[(and (not (send (lexer-state-invalid-tokens ls) is-empty?))
(= (lexer-state-invalid-tokens-start ls)
(lexer-state-current-pos ls))
(equal? new-lexer-mode
@ -341,10 +347,10 @@ added get-regions
(insert-last! (lexer-state-tokens ls)
(lexer-state-invalid-tokens ls))
(set-lexer-state-invalid-tokens-start! ls +inf.0)
(enable-suspend #t))
(else
(enable-suspend #t)]
[else
(enable-suspend #t)
(re-tokenize ls in in-start-pos new-lexer-mode enable-suspend)))))))
(re-tokenize ls in in-start-pos new-lexer-mode enable-suspend)]))))
(define/private (show-tree t)
(printf "Tree:\n")
@ -448,9 +454,6 @@ added get-regions
(coroutine
(λ (enable-suspend)
(parameterize ((port-count-lines-enabled #t))
(when (getenv "PLTDRDRTEST")
(printf "colorer-driver: lexer-states ~s\n" lexer-states)
(printf "colorer-driver: text ~s\n" (send this get-text)))
(for-each
(lambda (ls)
(re-tokenize ls
@ -470,8 +473,6 @@ added get-regions
(with-handlers ((exn:fail?
(λ (exn)
(parameterize ((print-struct #t))
(when (getenv "PLTDRDRTEST")
(printf "colorer-driver: error ~a\n" (and (exn? exn) (exn-message exn))))
((error-display-handler)
(format "exception in colorer thread: ~s" exn)
exn))