suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

optimistic merge

Browse Source 
svn: r8331
This commit is contained in:
John Clements 2008-01-15 06:36:30 +00:00
parent 2d79a5d789
commit b7fe6be3bf
1 changed files with 24 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/tests/stepper/through-tests.ss
View File

@ -28,6 +28,8 @@
(define display-only-errors (make-parameter #f)) (define display-only-errors (make-parameter #f))
(define error-has-occurred-box (make-parameter #f)) (define error-has-occurred-box (make-parameter #f))
(define show-all-steps (make-parameter #f))
(define (stream-ify expr-list iter) (define (stream-ify expr-list iter)
(lambda () (lambda ()
@ -51,15 +53,12 @@
"ran out of expected steps. Given result: ~v" result) "ran out of expected steps. Given result: ~v" result)
(begin (begin
(if (compare-steps result (car all-steps)) (if (compare-steps result (car all-steps))
(begin (when (and (show-all-steps) (not (display-only-errors)))
;; uncomment to see successful steps, too: (printf "test-sequence: steps match for expected result: ~v\n"
#;(printf "test-sequence: steps match for expected result: ~v\n" (car all-steps)))
(car all-steps))
(void))
(warn 'test-sequence (warn 'test-sequence
"steps do not match\n given: ~v\nexpected: ~v" "steps do not match\n given: ~v\nexpected: ~v"
result (car all-steps))) (show-result result) (car all-steps)))
(set! all-steps (cdr all-steps)))))] (set! all-steps (cdr all-steps)))))]
[program-expander [program-expander
(lambda (init iter) (lambda (init iter)
@ -71,7 +70,9 @@
(cons expr (read-loop)))))] (cons expr (read-loop)))))]
[exprs (wrap-in-module [exprs (wrap-in-module
exps namespace-spec teachpack-specs)]) exps namespace-spec teachpack-specs)])
((stream-ify exprs iter))))]) ((stream-ify (let ([ans exprs])
(printf "~s\n" ans)
ans) iter))))])
(let/ec escape (let/ec escape
(parameterize ([error-escape-handler (lambda () (escape (void)))]) (parameterize ([error-escape-handler (lambda () (escape (void)))])
(go program-expander receive-result render-settings (go program-expander receive-result render-settings
@ -186,10 +187,24 @@
'before) 'before)
(equal? err-msg (before-error-result-err-msg actual))))] (equal? err-msg (before-error-result-err-msg actual))))]
[`(finished-stepping) (finished-stepping? actual)] [`(finished-stepping) (finished-stepping? actual)]
[`(ignore) (warn 'compare-steps "ignoring one step")] [`(ignore) (warn 'compare-steps "ignoring one step") #t]
[else (begin (warn 'compare-steps [else (begin (warn 'compare-steps
"unexpected expected step type: ~v" expected) "unexpected expected step type: ~v" expected)
#f)])) #f)]))
;; used to display results in an error message
(define (show-result r)
(if (before-after-result? r)
(list 'before-after-result
(map (lambda (fn)
(unless (list? (fn r))
(warn 'show-result "not a list: ~v"
(syntax-object->hilite-datum (fn r))))
(map syntax-object->hilite-datum
(fn r)))
(list before-after-result-pre-exps
before-after-result-post-exps)))
r))
;; noisy-equal? : (any any . -> . boolean) ;; noisy-equal? : (any any . -> . boolean)
;; like equal?, but prints a noisy error message ;; like equal?, but prints a noisy error message
@ -1654,8 +1669,3 @@
) )
;; Local variables:
;; enable-local-eval: t
;; eval:(add-color-pattern "{[^{}]+}" '*/h404)
;; hide-local-variable-section: t
;; End: