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

auto-open top-level test suites in rackunit gui

Browse Source 
Merge to release branch
(cherry picked from commit e3c02f7072)
This commit is contained in:
Ryan Culpepper 2011-02-03 16:53:49 -07:00
parent 6eedd57f8b
commit 968eb41475
1 changed files with 14 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/rackunit/private/gui/view.rkt
View File

@ -222,19 +222,22 @@ still be there, just not visible?
;; Construction
;; create-view-link : result<%> suite-result<%>/#f-> item
;; create-view-link : result<%> suite-result<%>/#f-> void
(define/public (create-view-link model parent)
(let ([parent-link
(if parent
(get-view-link parent)
this)])
(initialize-view-link (cond [(is-a? model suite<%>)
(send parent-link new-list)]
[(is-a? model case<%>)
(send parent-link new-item)])
model)))
(let* ([parent-link
(if parent
(get-view-link parent)
this)]
[view-link
(cond [(is-a? model suite<%>)
(send parent-link new-list)]
[(is-a? model case<%>)
(send parent-link new-item)])])
(initialize-view-link view-link model)
(when (and (is-a? model suite<%>) (not parent))
(send view-link open))))
;; initialize-view-link : result<%> (U compound-item% item%) -> item
;; initialize-view-link : result<%> (U compound-item% item%) -> void
(define/private (initialize-view-link item model)
(set-view-link model item)
(send item user-data model)