From 496331498f980355324cb483137801a5f8ef8082 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 19 Mar 2013 16:04:24 -0500 Subject: [PATCH] add some random testing into the lexer option contract --- collects/syntax-color/lexer-contract.rkt | 41 ++++++++++++++++++++++-- 1 file changed, 38 insertions(+), 3 deletions(-) diff --git a/collects/syntax-color/lexer-contract.rkt b/collects/syntax-color/lexer-contract.rkt index d67a8dcf10..e6d0da4eef 100644 --- a/collects/syntax-color/lexer-contract.rkt +++ b/collects/syntax-color/lexer-contract.rkt @@ -23,9 +23,44 @@ [end (start type) (end/c start type)] [backup exact-nonnegative-integer?] [new-mode any/c]))) - #:tester (λ (x) (and (procedure? x) - (or (procedure-arity-includes? x 1) - (procedure-arity-includes? x 3)))))) + #:tester (λ (lexer) (and (procedure? lexer) + (or (procedure-arity-includes? lexer 1) + (procedure-arity-includes? lexer 3)) + (try-some-random-streams lexer))))) + +(define (try-some-random-streams lexer) + (define 3ary-lexer + (cond + [(procedure-arity-includes? lexer 1) + (λ (in offset mode) + (define-values (txt type paren start end) (lexer in)) + (values txt type paren start end 0 #f))] + [else lexer])) + (for ([x (in-range 10)]) + (define size (random 100)) + (define (pick-one . args) + (list-ref args (random (length args)))) + (define (quash-backslash-r c) + ;; it isn't clear the spec is right in + ;; the case of \r\n combinations, so we + ;; punt for now + (if (equal? c #\return) #\newline c)) + (define s (build-string + size + (λ (c) + (quash-backslash-r + (case (random 3) + [(0) (pick-one #\space #\) #\( #\@ #\{ #\} #\" #\λ #\Σ #\nul)] + [(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) (cond