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

Getting source of error into test reports

Browse Source 
svn: r11333
This commit is contained in:
Kathy Gray 2008-08-19 17:03:40 +00:00
parent b8147e1e2e
commit b0aeb1d259
6 changed files with 28 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/lang/htdp-langs.ss
View File

@ -39,7 +39,7 @@
stepper/private/shared
(only-in test-engine/scheme-gui make-formatter)
(only-in test-engine/scheme-tests scheme-test-data test-format test-execute)
(only-in test-engine/scheme-tests scheme-test-data scheme-error-handler test-format test-execute)
(lib "test-engine/test-display.scm")
)
@ -176,6 +176,7 @@
(namespace-attach-module drs-namespace scheme-test-module-name)
(namespace-require scheme-test-module-name)
(scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace test-display%))
(scheme-error-handler teaching-languages-error-display-handler)
(test-execute (get-preference 'tests:enable? (lambda () #t)))
(test-format (make-formatter (lambda (v o) (render-value/format v settings o 40))))
)))

4
collects/profj/libs/java/runtime.ss
View File

@ -341,7 +341,7 @@
(third current-check)
(fourth current-check)
mutate-msg-prefix)
(fifth current-check))))
(fifth current-check) #f)))
(report-results (cdr checks)))))
result-value)))
@ -358,7 +358,7 @@
(send test-obj
check-failed
(compose-message test-obj check-kind info values #f)
src))))
src #f))))
(define (compose-message test-obj check-kind info values mutate-message)
(letrec ([test-format (construct-info-msg info)]

1
collects/profj/tool.ss
View File

@ -845,6 +845,7 @@
#f
`(parse-java-interactions ,(parse-interactions port name level) ,name)
#f)))))))
(define/public (front-end/finished-complete-program settings) (void))
(define (get-defn-editor port-name)
(let* ([dr-frame (and (drscheme:rep:current-rep)

4
collects/test-engine/java-tests.scm
View File

@ -170,13 +170,13 @@
(inner (void) complete-testcase pass?))
(define/public (get-current-testcase) current-testcase)
(define/augment (check-failed msg src)
(define/augment (check-failed msg src exn)
(when current-testcase
(set-tc-stat-checks!
current-testcase
(cons (make-failed-check src msg)
(tc-stat-checks current-testcase))))
(inner (void) check-failed msg src))
(inner (void) check-failed msg src exn))
(define/public (format-value value)
(make-java-snip value (make-format-style #t 'field #f)))

27
collects/test-engine/scheme-tests.ss
View File

@ -38,14 +38,14 @@
(define-struct check-fail (src))
;; (make-unexpected-error src string)
(define-struct (unexpected-error check-fail) (expected message))
;; (make-unexpected-error src string exn)
(define-struct (unexpected-error check-fail) (expected message exn))
;; (make-unequal src scheme-val scheme-val)
(define-struct (unequal check-fail) (test actual))
;; (make-outofrange src scheme-val scheme-val inexact)
(define-struct (outofrange check-fail) (test actual range))
;; (make-incorrect-error src string)
(define-struct (incorrect-error check-fail) (expected message))
;; (make-incorrect-error src string exn)
(define-struct (incorrect-error check-fail) (expected message exn))
;; (make-expected-error src string scheme-val)
(define-struct (expected-error check-fail) (message value))
@ -158,13 +158,14 @@
(lambda (e)
(or (equal? (exn-message e) error)
(make-incorrect-error src error
(exn-message e))))])
(exn-message e) e)))])
(let ([test-val (test)])
(make-expected-error src error test-val)))])
(if (check-fail? result)
(begin
(send (send test-info get-info) check-failed
(check->message result) (check-fail-src result))
(check->message result) (check-fail-src result)
(and (incorrect-error? result) (incorrect-error-exn result)))
(list 'check-error-failed
(if (expected-error? result)
(expected-error-message result)
@ -185,16 +186,17 @@
;; (scheme-val scheme-val scheme-val -> check-fail)
;; ( -> scheme-val) scheme-val scheme-val object symbol? -> void
(define (run-and-check check maker test expect range src test-info kind)
(match-let ([(list result result-val)
(match-let ([(list result result-val exn?)
(with-handlers ([exn? (lambda (e)
#;((error-display-handler) (exn-message e) e)
(list (make-unexpected-error src expect
(exn-message e)) 'error))])
(exn-message e) e) 'error e))])
(let ([test-val (test)])
(cond [(check expect test-val range) (list #t test-val)]
(cond [(check expect test-val range) (list #t test-val #f)]
[else
(list (maker src test-val expect range) test-val)])))])
(list (maker src test-val expect range) test-val #f)])))])
(cond [(check-fail? result)
(send (send test-info get-info) check-failed (check->message result) (check-fail-src result))
(send (send test-info get-info) check-failed (check->message result) (check-fail-src result) exn?)
(render-for-stepper/fail result expect range kind)]
[else
;; I'd like to pass the actual, but I don't have it.
@ -288,6 +290,7 @@
(define (insert-test test-info test) (send test-info add-test test))
(define scheme-test-data (make-parameter (list #f #f #f)))
(define scheme-error-handler (make-parameter (error-display-handler)))
(define scheme-test%
(class* test-engine% ()
@ -312,4 +315,4 @@
(test)
(inner (void) run-test test))))
(provide scheme-test-data test-format test-execute test-silence)
(provide scheme-test-data test-format test-execute test-silence scheme-error-handler)

12
collects/test-engine/test-info.scm
View File

@ -4,8 +4,8 @@
(provide (all-defined-out))
;; (make-failed-check src (listof (U string snip%)))
(define-struct failed-check (src msg))
;; (make-failed-check src (listof (U string snip%)) (U #f exn))
(define-struct failed-check (src msg exn))
(define test-info-base%
(class* object% ()
@ -41,11 +41,11 @@
(set! total-tsts (add1 total-tsts))
(inner (void) add-test))
;; check-failed: (list (U string snip%)) src -> void
(define/pubment (check-failed msg src)
;; check-failed: (list (U string snip%)) src (U exn false) -> void
(define/pubment (check-failed msg src exn?)
(set! failed-cks (add1 failed-cks))
(set! failures (cons (make-failed-check src msg) failures))
(inner (void) check-failed msg src))
(set! failures (cons (make-failed-check src msg exn?) failures))
(inner (void) check-failed msg src exn?))
(define/pubment (test-failed failed-info)
(set! failed-tsts (add1 failed-tsts))