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:
parent
66729a4473
commit
a1bac35b60
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user