Parser bug correction
svn: r10903
This commit is contained in:
Kathy Gray
parent
8e4647cd6c
commit
ba1a6f86e9
|
|
@ -342,7 +342,9 @@
|
|||
(fail-res input
|
||||
(make-options-fail
|
||||
(rank-choice (map fail-type-chance fails))
|
||||
last-src
|
||||
(if (equal? last-src (list 1 0 1 0))
|
||||
(map fail-type-src fails)
|
||||
last-src)
|
||||
seq-name
|
||||
(rank-choice (map fail-type-used fails))
|
||||
(rank-choice (map fail-type-may-use fails)) fails)))]
|
||||
|
|
@ -465,17 +467,17 @@
|
|||
(cond
|
||||
[(and (repeat-res? look-back)
|
||||
(fail-type? (repeat-res-stop look-back))
|
||||
(>= (fail-type-chance (repeat-res-stop look-back))
|
||||
(> (fail-type-chance (repeat-res-stop look-back))
|
||||
(fail-type-chance fail)))
|
||||
(repeat-res-stop look-back)]
|
||||
[(and (choice-res? look-back)
|
||||
(choice-res-errors look-back)
|
||||
(>= (fail-type-chance (choice-res-errors look-back))
|
||||
(> (fail-type-chance (choice-res-errors look-back))
|
||||
(fail-type-chance fail)))
|
||||
(choice-res-errors look-back)]
|
||||
[(and (res? look-back)
|
||||
(fail-type? (res-possible-error look-back))
|
||||
(>= (fail-type-chance (res-possible-error look-back))
|
||||
(> (fail-type-chance (res-possible-error look-back))
|
||||
(fail-type-chance fail)))
|
||||
(res-possible-error look-back)]
|
||||
[else #f])]
|
||||
|
|
@ -553,7 +555,7 @@
|
|||
(printf "opt-fails ~a~n" opt-fails))
|
||||
(if pos-fail
|
||||
(make-options-fail (rank-choice (map fail-type-chance opt-fails))
|
||||
#f
|
||||
(map fail-type-src opt-fails)
|
||||
name
|
||||
(rank-choice (map fail-type-used opt-fails))
|
||||
(rank-choice (map fail-type-may-use opt-fails))
|
||||
|
|
|
|||
|
|
@ -18,7 +18,12 @@
|
|||
(define (fail-type->message fail-type message-to-date)
|
||||
(let* ([name (fail-type-name fail-type)]
|
||||
[a (a/an name)]
|
||||
[msg (lambda (m) (make-err m (fail-type-src fail-type)))])
|
||||
[msg (lambda (m)
|
||||
(make-err m
|
||||
(if (and (list? (fail-type-src fail-type))
|
||||
(list? (car (fail-type-src fail-type))))
|
||||
(car (fail-type-src fail-type))
|
||||
(fail-type-src fail-type))))])
|
||||
#;(printf "fail-type->message ~a~n" fail-type)
|
||||
(cond
|
||||
[(terminal-fail? fail-type)
|
||||
|
|
|
|||
|
|
@ -280,6 +280,7 @@
|
|||
|
||||
(define (variable-declaration type expr share-type? end? name)
|
||||
(let* ([var-name (string-append name " declaration")]
|
||||
[no-share (sequence (type (^ identifier)) id var-name)]
|
||||
[init (sequence ((^ identifier) EQUAL expr) id var-name)]
|
||||
[f (choose (identifier init) var-name)]
|
||||
[s&e (sequence (type (comma-sep f name)) id var-name)]
|
||||
|
|
@ -293,6 +294,9 @@
|
|||
[expr (choose (e base) var-name)]
|
||||
[else base])])
|
||||
(cond
|
||||
[(and end? (not share-type?) expr)
|
||||
(sequence ((^ no-share) (choose (SEMI_COLON (sequence (EQUAL expr SEMI_COLON) id (string-append name " initialization")))))
|
||||
id var-name)]
|
||||
[end? (sequence (decl SEMI_COLON) id (string-append name " definition"))]
|
||||
[else decl])))
|
||||
)
|
||||
|
|
|
|||
|
|
@ -315,8 +315,7 @@
|
|||
(ormap (lambda (e-v) (java-equal? test-val e-v null null 0.001 #t))
|
||||
expected-vals))]
|
||||
[res-list (list range test-val)])
|
||||
(if
|
||||
(in-check-mutate?)
|
||||
(if (in-check-mutate?)
|
||||
(stored-checks (cons (list (and (not fail?) result) 'check-rand info res-list src test-obj)
|
||||
(stored-checks)))
|
||||
(report-check-result (and (not fail?) result) 'check-rand info res-list src test-obj))
|
||||
|
|
@ -362,11 +361,11 @@
|
|||
src))))
|
||||
|
||||
(define (compose-message test-obj check-kind info values mutate-message)
|
||||
(letrec ((test-format (construct-info-msg info))
|
||||
(eval-exception-raised? #f)
|
||||
(comp-exception-raised? #f)
|
||||
(exception-not-error? #f)
|
||||
(formatted-values (map (lambda (v)
|
||||
(letrec ([test-format (construct-info-msg info)]
|
||||
[eval-exception-raised? #f]
|
||||
[comp-exception-raised? #f]
|
||||
[exception-not-error? #f]
|
||||
[formatted-values (map (lambda (v)
|
||||
(cond
|
||||
[(and (pair? v) (eq? (car v) exception))
|
||||
(if (equal? (cadddr v) "eval")
|
||||
|
|
@ -374,18 +373,22 @@
|
|||
(set! comp-exception-raised? #t))
|
||||
(set! exception-not-error? (cadr v))
|
||||
(send test-obj format-value (caddr v))]
|
||||
[else (send test-obj format-value v)])) values))
|
||||
(expected-format
|
||||
[(pair? v)
|
||||
(map (lambda (v) (send test-obj format-value v)) v)]
|
||||
[else (send test-obj format-value v)])) values)]
|
||||
[expected-format
|
||||
(case check-kind
|
||||
((check-expect check-by) "to produce ")
|
||||
((check-rand) "to produce one of ")
|
||||
((check-catch) "to throw an instance of "))))
|
||||
((check-catch) "to throw an instance of "))])
|
||||
(cond
|
||||
[(not (eq? 'check-by check-kind))
|
||||
(append (list (if mutate-message mutate-message "check expected ")
|
||||
test-format
|
||||
expected-format
|
||||
(first formatted-values))
|
||||
expected-format)
|
||||
(if (eq? 'check-rand check-kind)
|
||||
(list-format (first formatted-values))
|
||||
(list (first formatted-values)))
|
||||
(case check-kind
|
||||
((check-expect)
|
||||
(append (if (= (length formatted-values) 3)
|
||||
|
|
@ -427,6 +430,20 @@
|
|||
" to compare to " (first formatted-values)
|
||||
" using " (third formatted-values)
|
||||
". This value did not match the expectation.")])))
|
||||
|
||||
(define (list-format l)
|
||||
(cond
|
||||
[(= (length l) 1) l]
|
||||
[(= (length l) 2) (list (car l) "or" (cadr l))]
|
||||
[else
|
||||
(letrec ([ins
|
||||
(lambda (l)
|
||||
(cond
|
||||
[(null? l) l]
|
||||
[(null? (cdr l)) (list " or" (car l))]
|
||||
[else
|
||||
(cons (car l) (cons "," (ins (cdr l))))]))])
|
||||
(ins l))]))
|
||||
|
||||
;construct-info-msg (list symbol string ...) -> string
|
||||
(define (construct-info-msg info)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user