Overview
| Comment: | more-refactoring-eh |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | refactor-dashboard |
| Files: | files | file ages | folders |
| SHA1: |
0a77e08281fc4dff9d944497cfbe0cd4 |
| User & Date: | mrwellan on 2011-06-26 14:45:04 |
| Other Links: | branch diff | manifest | tags |
Context
|
2011-06-26
| ||
| 16:00 | Sped up the left labels a bit check-in: 49eeb8afc8 user: mrwellan tags: refactor-dashboard | |
| 14:45 | more-refactoring-eh check-in: 0a77e08281 user: mrwellan tags: refactor-dashboard | |
| 14:14 | Refactored again (broke gui into pieces, IUP seems to be having problems with nested containers check-in: 30e0b9adfd user: mrwellan tags: refactor-dashboard | |
Changes
Modified dashboard-tests.scm from [0efdf685df] to [93db9f7715].
| ︙ | ︙ | |||
25 26 27 28 29 30 31 |
"Current state: "
"Current status: "
"Test comment: "
"Test id: "))
(list (iup:label "" #:expand "VERTICAL"))))
(apply iup:vbox ; #:expand "YES"
(list
| > | > > | > | 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 |
"Current state: "
"Current status: "
"Test comment: "
"Test id: "))
(list (iup:label "" #:expand "VERTICAL"))))
(apply iup:vbox ; #:expand "YES"
(list
(store-label "testname"
(iup:label (db:test-get-testname testdat) #:expand "HORIZONTAL")
(lambda (testdat)(db:test-get-testname testdat)))
(store-label "item-path"
(iup:label (db:test-get-item-path testdat) #:expand "HORIZONTAL")
(lambda (testdat)(db:test-get-item-path testdat)))
(store-label "teststate"
(iup:label (db:test-get-state testdat) #:expand "HORIZONTAL")
(lambda (testdat)
(db:test-get-state testdat)))
(let ((lbl (iup:label (db:test-get-status testdat) #:expand "HORIZONTAL")))
(hash-table-set! widgets "teststatus"
(lambda (testdat)
|
| ︙ | ︙ | |||
204 205 206 207 208 209 210 | (set! testdat newtestdat) (set! teststeps (db:get-steps-for-test db test-id)) (set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat))) (set! rundir (db:test-get-rundir testdat)) (set! testfullname (db:test-get-fullname testdat)) (mutex-unlock! mx1)) (begin | < | | 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 | (set! testdat newtestdat) (set! teststeps (db:get-steps-for-test db test-id)) (set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat))) (set! rundir (db:test-get-rundir testdat)) (set! testfullname (db:test-get-fullname testdat)) (mutex-unlock! mx1)) (begin (db:test-set-testname testdat "DEAD OR DELETED TEST")))))) (widgets (make-hash-table)) (self #f) (store-label (lambda (name lbl cmd) (hash-table-set! widgets name (lambda (testdat) (let ((newval (cmd testdat)) (oldval (iup:attribute lbl "TITLE"))) |
| ︙ | ︙ |
Modified dashboard.scm from [9dc30172fd] to [bb1818123a].
| ︙ | ︙ | |||
397 398 399 400 401 402 403 |
(get-environment-variable "DASHBOARDROWS"))))
(update-rundat "%" *num-runs* "%" "%"))
(set! *num-tests* (min (max (update-rundat "%" *num-runs* "%" "%") 8) 20)))
(define uidat #f)
;; (megatest-dashboard)
| | | | > > > | | 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 |
(get-environment-variable "DASHBOARDROWS"))))
(update-rundat "%" *num-runs* "%" "%"))
(set! *num-tests* (min (max (update-rundat "%" *num-runs* "%" "%") 8) 20)))
(define uidat #f)
;; (megatest-dashboard)
(define (run-update mtx1)
(let loop ((i 0))
(thread-sleep! 0.05)
(mutex-lock! mtx1)
(update-buttons uidat *num-runs* *num-tests*)
(mutex-unlock! mtx1)
(iup:main-loop-flush)
(mutex-lock! mtx1)
(update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs*
(hash-table-ref/default *searchpatts* "test-name" "%")
(hash-table-ref/default *searchpatts* "item-name" "%"))
(mutex-unlock! mtx1)
(loop i)))
(define *job* #f)
(cond
((args:get-arg "-run")
(let ((runid (string->number (args:get-arg "-run"))))
|
| ︙ | ︙ | |||
442 443 444 445 446 447 448 | ; (exit))) (examine-test *db* testid mx1))) (begin (print "ERROR: testid is not a number " (args:get-arg "-test")) (exit 1))))) (else (set! uidat (make-dashboard-buttons *num-runs* *num-tests* dbkeys)) | | | 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 |
; (exit)))
(examine-test *db* testid mx1)))
(begin
(print "ERROR: testid is not a number " (args:get-arg "-test"))
(exit 1)))))
(else
(set! uidat (make-dashboard-buttons *num-runs* *num-tests* dbkeys))
(set! *job* (lambda (mtx1)(run-update mtx1)))))
(let* ((mx1 (make-mutex))
(th2 (make-thread iup:main-loop))
(th1 (make-thread (*job* mx1))))
(thread-start! th1)
(thread-start! th2)
(thread-join! th2))
|
Modified db.scm from [49e9eed590] to [4531d1ac51].
| ︙ | ︙ | |||
191 192 193 194 195 196 197 198 199 200 201 202 203 204 |
(define-inline (db:test-get-rundir vec) (vector-ref vec 10))
(define-inline (db:test-get-item-path vec) (vector-ref vec 11))
(define-inline (db:test-get-run_duration vec) (vector-ref vec 12))
(define-inline (db:test-get-final_logf vec) (vector-ref vec 13))
(define-inline (db:test-get-comment vec) (vector-ref vec 14))
(define-inline (db:test-get-fullname vec)
(conc (db:test-get-testname vec) "/" (db:test-get-item-path vec)))
(define (db-get-tests-for-run db run-id . params)
(let ((res '())
(testpatt (if (or (null? params)(not (car params))) "%" (car params)))
(itempatt (if (> (length params) 1)(cadr params) "%")))
(sqlite3:for-each-row
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
| > > | 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 |
(define-inline (db:test-get-rundir vec) (vector-ref vec 10))
(define-inline (db:test-get-item-path vec) (vector-ref vec 11))
(define-inline (db:test-get-run_duration vec) (vector-ref vec 12))
(define-inline (db:test-get-final_logf vec) (vector-ref vec 13))
(define-inline (db:test-get-comment vec) (vector-ref vec 14))
(define-inline (db:test-get-fullname vec)
(conc (db:test-get-testname vec) "/" (db:test-get-item-path vec)))
(define-inline (db:test-set-testname vec val)(vector-set! vec 2 val))
(define (db-get-tests-for-run db run-id . params)
(let ((res '())
(testpatt (if (or (null? params)(not (car params))) "%" (car params)))
(itempatt (if (> (length params) 1)(cadr params) "%")))
(sqlite3:for-each-row
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
|
| ︙ | ︙ |