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

Puts the test display on drscheme's eventspace, even when we don't have a rep yet

Browse Source 
Doesn't make a link when there's no editor to link to

svn: r9636
This commit is contained in:
Kathy Gray 2008-05-03 23:17:59 +00:00
parent 7cd9e25970
commit a48f4923b6
2 changed files with 27 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
collects/test-engine/test-display.scm
View File

@ -129,18 +129,19 @@
(send text insert m))
(let ((start (send text get-end-position)))
(send text insert (format-src dest))
(send text set-clickback
start (send text get-end-position)
(lambda (t s e) (highlight-check-error dest src-editor))
#f #f)
(let ([end (send text get-end-position)]
[c (new style-delta%)])
(send text insert " ")
(send text change-style
(make-object style-delta% 'change-underline #t)
start end #f)
(send c set-delta-foreground "royalblue")
(send text change-style c start end #f))))
(when (and src-editor current-rep)
(send text set-clickback
start (send text get-end-position)
(lambda (t s e) (highlight-check-error dest src-editor))
#f #f)
(let ([end (send text get-end-position)]
[c (new style-delta%)])
(send text insert " ")
(send text change-style
(make-object style-delta% 'change-underline #t)
start end #f)
(send c set-delta-foreground "royalblue")
(send text change-style c start end #f)))))
(define (format-src src)
(let ([src-file car]
@ -151,8 +152,10 @@
[(symbol? (src-file src)) (string-append " At ")]
[(path? (src-file src)) (string-append " In " (path->string (src-file src)) " at ")]
[(is-a? (src-file src) editor<%>) " At "])
"line " (number->string (src-line src))
" column " (number->string (src-col src)))))
"line " (cond [(src-line src) => number->string]
[else "(unknown)"])
" column " (cond [(src-col src) => number->string]
[else "(unknown)"]))))
(define (highlight-check-error srcloc src-editor)
(let* ([src-pos cadddr]

17
collects/test-engine/test-engine.scm
View File

@ -142,13 +142,16 @@
(fprintf port "This program should be tested.~n"))
(define/public (display-results rep event-space)
(send test-display install-info test-info)
(if (and rep event-space)
(parameterize ([(dynamic-require 'scheme/gui 'current-eventspace)
event-space])
((dynamic-require 'scheme/gui 'queue-callback)
(lambda () (send rep display-test-results test-display))))
(send test-display display-results)))
(cond
[(and rep event-space)
(parameterize ([(dynamic-require 'scheme/gui 'current-eventspace)
event-space])
((dynamic-require 'scheme/gui 'queue-callback)
(lambda () (send rep display-test-results test-display))))]
[event-space
(parameterize ([(dynamic-require 'scheme/gui 'current-eventspace) event-space])
((dynamic-require 'scheme/gui 'queue-callback) (lambda () (send test-display display-results))))]
[else (send test-display display-results)]))
(define/pubment (initialize-test test)
(inner (void) initialize-test test))