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

add some debugging information into the module language test suite

Browse Source 
specifically, when tests fail and there is an error icon in the REPL,
then go find the stack associated with it and print it out
This commit is contained in:
Robby Findler 2014-04-18 06:36:58 -05:00
parent cfb45e91e3
commit 9d9a1cd054
2 changed files with 28 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
pkgs/drracket-pkgs/drracket-test/tests/drracket/private/module-lang-test-utils.rkt
View File

@ -115,6 +115,19 @@
get-text
(send interactions-text paragraph-start-position output-start-paragraph)
(send interactions-text paragraph-end-position para-before-prompt))))))
(define stacks
(queue-callback/res
(λ ()
(let loop ([snip (send interactions-text find-first-snip)])
(cond
[(not snip) '()]
[else
(cond
[(method-in-interface? 'get-stacks (object-interface snip))
(define-values (s1 s2) (send snip get-stacks))
(list* s1 s2 (loop (send snip next)))]
[else
(loop (send snip next))])])))))
(define output-passed?
(let ([r (test-result test)])
((cond [(string? r) string=?]
@ -127,7 +140,15 @@
(test-definitions test)
(or (test-interactions test) 'no-interactions)
(test-result test)
text))
text)
(unless (null? stacks)
(eprintf "stacks from error message:")
(for ([stack (in-list stacks)])
(when stack
(eprintf "\n----\n")
(for ([frame (in-list stack)])
(eprintf " ~s\n" frame))
(eprintf "---\n")))))
(cond
[(eq? (test-error-ranges test) 'dont-test)
(void)]

6
pkgs/drracket-pkgs/drracket/drracket/private/debug.rkt
View File

@ -208,9 +208,14 @@ profile todo:
(class clickable-image-snip%
(inherit get-callback)
(define/public (get-image-name) filename)
(define stack1 #f)
(define stack2 #f)
(define/public (set-stacks s1 s2) (set! stack1 s1) (set! stack2 s2))
(define/public (get-stacks) (values stack1 stack2))
(define/override (copy)
(let ([n (new note%)])
(send n set-callback (get-callback))
(send n set-stacks stack1 stack2)
n))
(super-make-object bitmap))])
note%)))
@ -492,6 +497,7 @@ profile todo:
(let ([note% (if (mf-bday?) mf-note% bug-note%)])
(when note%
(let ([note (new note%)])
(send note set-stacks cms1 cms2)
(send note set-callback (λ (snp) (show-backtrace-window/edition-pairs/two msg cms1 editions1 cms2 editions2 defs ints)))
(write-special note (current-error-port))
(display #\space (current-error-port)))))))