syntax-color/lexer-contract: make random-test failure declare itself

Random tests that are implciitly injected into a program should
declare themselves as such when they fail. Otherwise, random
crashes are really confusing.
This commit is contained in:
Matthew Flatt 2014-10-20 14:18:08 -05:00
parent 66729a4473
commit a1bac35b60

View File

@ -33,32 +33,47 @@
(define-values (txt type paren start end) (lexer in)) (define-values (txt type paren start end) (lexer in))
(values txt type paren start end 0 #f))] (values txt type paren start end 0 #f))]
[else lexer])) [else lexer]))
(for ([x (in-range 10)]) (define initial-state (pseudo-random-generator->vector
(define size (random 100)) (current-pseudo-random-generator)))
(define (quash-backslash-r c) (with-handlers ([exn:fail?
;; it isn't clear the spec is right in (lambda (exn)
;; the case of \r\n combinations, so we (raise
;; punt for now (make-exn
(if (equal? c #\return) #\newline c)) (format (string-append "try-some-random-streams:"
(define s (build-string " random testing of lexer failed\n"
size " lexer: ~e\n"
(λ (c) " pseudo-random state: ~s\n"
(quash-backslash-r " error message: ~s")
(case (random 3) lexer
[(0) initial-state
(define s " ()@{}\"λΣ\0") (exn-message exn))
(string-ref s (random (string-length s)))] (exn-continuation-marks exn))))])
[(1 2) (for ([x (in-range 10)])
(integer->char (random 255))]))))) (define size (random 100))
(define in (open-input-string s)) (define (quash-backslash-r c)
(port-count-lines! in) ;; it isn't clear the spec is right in
(let loop ([mode #f][offset 0]) ;; the case of \r\n combinations, so we
(define-values (txt type paren start end backup new-mode) ;; punt for now
(3ary-lexer in offset mode)) (if (equal? c #\return) #\newline c))
(cond (define s (build-string
[(equal? type 'eof) #t] size
[(< end size) (loop new-mode end)] (λ (c)
[else #f])))) (quash-backslash-r
(case (random 3)
[(0)
(define s " ()@{}\"λΣ\0")
(string-ref s (random (string-length s)))]
[(1 2)
(integer->char (random 255))])))))
(define in (open-input-string s))
(port-count-lines! in)
(let loop ([mode #f][offset 0])
(define-values (txt type paren start end backup new-mode)
(3ary-lexer in offset mode))
(cond
[(equal? type 'eof) #t]
[(< end size) (loop new-mode end)]
[else #f])))))
(define (end/c start type) (define (end/c start type)
(cond (cond