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

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

closes PR 12399

collects/framework/private/color.rkt

@@ -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
+      ;(define-values (_line1 _col1 pos-before) (port-next-location in))
-                       (get-token in in-start-pos in-lexer-mode)
+      (define-values (lexeme type data new-token-start new-token-end backup-delta new-lexer-mode) 
-                       (enable-suspend #t)))])
+        (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))
+             (enable-suspend #t)]
-             (else
+            [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))

collects/syntax-color/module-lexer.rkt

@@ -75,7 +75,7 @@ to delegate to the scheme-lexer (in the 'no-lang-line mode).
            ;; sync ports
            (for ([i (in-range (file-position in) (file-position p))])
              (read-byte-or-special in))
-           (values lexeme 'error data 1 (+ end-pos 1) 0 'no-lang-line)]
+           (values lexeme 'error data 1 end-pos 0 'no-lang-line)]
           [else 
            (for ([i (in-range (file-position in) (file-position lexer-port))])
              (read-byte-or-special in))

collects/tests/syntax-color/module-lexer.rkt

@@ -62,7 +62,7 @@
               `(("#lang" other 1 25 #f)
                 (,eof eof 25 25 ((proc scribble-lexer) . #f))))
 (check-equal? (lex "#lang at-exp racket/baseBOGUS" #t)
-              `(("#lang at-exp" error 1 31 #f)
+              `(("#lang at-exp" error 1 30 #f)
                 (,eof eof #f #f no-lang-line)))
 (check same?
        (lex "#lang at-exp racket/base\n1\n" #t)