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

...

Browse Source 
svn: r15301
This commit is contained in:
John Clements 2009-06-26 18:24:51 +00:00
parent 6964afbf36
commit 7e7c5441eb
2 changed files with 7 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/tests/stepper/test-engine.ss
View File

@ -172,7 +172,7 @@
(error-display-handler current-error-display-handler))) (error-display-handler current-error-display-handler)))
;; call-iter-on-each : (-> syntax?) (syntax? (-> 'a) -> 'a) -> void/c ;; call-iter-on-each : (-> syntax?) (syntax? (-> 'a) -> 'a) -> void/c
;; call the given iter on each syntax-object in turn (iter bounces control) ;; call the given iter on each syntax in turn (iter bounces control)
;; back to us by calling the followup-thunk. ;; back to us by calling the followup-thunk.
(define (call-iter-on-each stx-thunk iter) (define (call-iter-on-each stx-thunk iter)
(let* ([next (stx-thunk)] (let* ([next (stx-thunk)]
@ -194,8 +194,8 @@
(andmap (lambda (fn expected name) (andmap (lambda (fn expected name)
(unless (list? (fn actual)) (unless (list? (fn actual))
(warn 'compare-steps "not a list: ~v" (warn 'compare-steps "not a list: ~v"
(syntax-object->hilite-datum (fn actual)))) (syntax->hilite-datum (fn actual))))
(noisy-equal? (map syntax-object->hilite-datum (noisy-equal? (map syntax->hilite-datum
(fn actual)) (fn actual))
expected expected
name)) name))
@ -208,7 +208,7 @@
(string-contains (error-result-err-msg actual) err-msg))] (string-contains (error-result-err-msg actual) err-msg))]
[`(before-error ,before ,err-msg) [`(before-error ,before ,err-msg)
(and (before-error-result? actual) (and (before-error-result? actual)
(and (noisy-equal? (map syntax-object->hilite-datum (and (noisy-equal? (map syntax->hilite-datum
(before-error-result-pre-exps actual)) (before-error-result-pre-exps actual))
before before
'before) 'before)
@ -228,8 +228,8 @@
(map (lambda (fn) (map (lambda (fn)
(unless (list? (fn r)) (unless (list? (fn r))
(warn 'show-result "not a list: ~v" (warn 'show-result "not a list: ~v"
(syntax-object->hilite-datum (fn r)))) (syntax->hilite-datum (fn r))))
(map syntax-object->hilite-datum (map syntax->hilite-datum
(fn r))) (fn r)))
(list before-after-result-pre-exps (list before-after-result-pre-exps
before-after-result-post-exps))) before-after-result-post-exps)))

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

@ -3,7 +3,7 @@
(require stepper/private/model-settings (require stepper/private/model-settings
(prefix-in m: "language-level-model.ss") (prefix-in m: "language-level-model.ss")
"test-engine.ss" "test-engine.ss"
#;"test-abbrev.ss" "test-abbrev.ss"
;; for xml testing: ;; for xml testing:
;; mzlib/class ;; mzlib/class