Overview
| Comment: | Cleaned up the test steps display a bit more |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
55d1298d58a6dedc3ca9f1934faef6c7 |
| User & Date: | mrwellan on 2011-08-24 13:37:40 |
| Other Links: | manifest | tags |
Context
|
2011-08-24
| ||
| 16:08 | Added :units to display on dashboard check-in: b2e635cc07 user: mrwellan tags: trunk, v1.22 | |
| 13:37 | Cleaned up the test steps display a bit more check-in: 55d1298d58 user: mrwellan tags: trunk | |
| 12:50 | Merged rollup-runs branch into trunk check-in: ebea00e4bb user: mrwellan tags: trunk | |
Changes
Modified common.scm from [bee4649484] to [ccb841b77a].
| ︙ | ︙ | |||
126 127 128 129 130 131 132 133 134 135 136 137 138 139 |
(let* ((hrs (quotient secs 3600))
(min (quotient (- secs (* hrs 3600)) 60))
(sec (- secs (* hrs 3600)(* min 60))))
(conc (if (> hrs 0)(conc hrs "hr ") "")
(if (> min 0)(conc min "m ") "")
sec "s")))
;;======================================================================
;; Colors
;;======================================================================
(define (common:name->iup-color name)
(case (string->symbol (string-downcase name))
((red) "223 33 49")
| > > > > | 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 |
(let* ((hrs (quotient secs 3600))
(min (quotient (- secs (* hrs 3600)) 60))
(sec (- secs (* hrs 3600)(* min 60))))
(conc (if (> hrs 0)(conc hrs "hr ") "")
(if (> min 0)(conc min "m ") "")
sec "s")))
(define (seconds->time-string sec)
(time->string
(seconds->local-time sec) "%H:%M:%S"))
;;======================================================================
;; Colors
;;======================================================================
(define (common:name->iup-color name)
(case (string->symbol (string-downcase name))
((red) "223 33 49")
|
| ︙ | ︙ |
Modified dashboard-tests.scm from [46082f722f] to [73a59ec93f].
| ︙ | ︙ | |||
327 328 329 330 331 332 333 | #:title "Test Steps" (let ((stepsdat (iup:label "Test steps ........................................." #:expand "YES" #:size "200x150" #:alignment "ALEFT:ATOP"))) (hash-table-set! widgets "Test Steps" (lambda (testdat) (let* ((currval (iup:attribute stepsdat "TITLE")) | | > | | > > > > | > | > | | 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 |
#:title "Test Steps"
(let ((stepsdat (iup:label "Test steps ........................................."
#:expand "YES"
#:size "200x150"
#:alignment "ALEFT:ATOP")))
(hash-table-set! widgets "Test Steps" (lambda (testdat)
(let* ((currval (iup:attribute stepsdat "TITLE"))
(fmtstr "~25a~10a~10a~15a~20a")
(steps (db:get-steps-for-test db test-id))
;; organise the steps for better readability
(comprsteps (let ((res (make-hash-table)))
(for-each
(lambda (step)
(let ((record (hash-table-ref/default
res
(db:step-get-stepname step)
;; stepname start end status
(vector (db:step-get-stepname step) "" "" "" ""))))
(case (string->symbol (db:step-get-state step))
((start)(vector-set! record 1 (db:step-get-event_time step))
(vector-set! record 3 (if (equal? (vector-ref record 3) "")
(db:step-get-status step))))
((end) (vector-set! record 2 (db:step-get-event_time step))
(vector-set! record 3 (db:step-get-status step))
(vector-set! record 4 (let ((startt (vector-ref record 1))
(endt (vector-ref record 2)))
(if (and (number? startt)(number? endt))
(seconds->hr-min-sec (- endt startt)) "-1"))))
(else (vector-set! record 1 (db:step-get-event_time step)))
(vector-set! record 2 (db:step-get-state step))
(vector-set! record 3 (db:step-get-status step))
(vector-set! record 4 (db:step-get-event_time step)))
(hash-table-set! res (db:step-get-stepname step) record)))
steps)
res))
(newval (string-intersperse
(append
(list
(format #f fmtstr "Stepname" "Start" "End" "Status" "Time")
(format #f fmtstr "========" "=====" "======" "======" "=========="))
(map (lambda (x)
;; take advantage of the \n on time->string
(format #f fmtstr
(vector-ref x 0)
(let ((s (vector-ref x 1)))
(if (number? s)(seconds->time-string s) s))
(let ((s (vector-ref x 2)))
(if (number? s)(seconds->time-string s) s))
(vector-ref x 3)
(vector-ref x 4)))
(sort (hash-table-values comprsteps)
(lambda (a b)(< (vector-ref a 1)(vector-ref b 1))))))
"\n")))
(if (not (equal? currval newval))
(iup:attribute-set! stepsdat "TITLE" newval)))))
stepsdat)))))
(iup:show self)
(iup:callback-set! *tim* "ACTION_CB"
(lambda (x)
|
| ︙ | ︙ |
Modified db.scm from [aed40706ae] to [6ded946f86].
| ︙ | ︙ | |||
447 448 449 450 451 452 453 |
(define-inline (db:step-set-state! vec val)(vector-set! vec 3 val))
(define-inline (db:step-set-status! vec val)(vector-set! vec 4 val))
(define-inline (db:step-set-event_time! vec val)(vector-set! vec 5 val))
(define (db:step-get-time-as-string vec)
(seconds->time-string (db:step-get-event_time vec)))
| < < < < | 447 448 449 450 451 452 453 454 455 456 457 458 459 460 |
(define-inline (db:step-set-state! vec val)(vector-set! vec 3 val))
(define-inline (db:step-set-status! vec val)(vector-set! vec 4 val))
(define-inline (db:step-set-event_time! vec val)(vector-set! vec 5 val))
(define (db:step-get-time-as-string vec)
(seconds->time-string (db:step-get-event_time vec)))
;; db-get-test-steps-for-run
(define (db:get-steps-for-test db test-id)
(let ((res '()))
(sqlite3:for-each-row
(lambda (id test-id stepname state status event-time)
(set! res (cons (vector id test-id stepname state status event-time) res)))
db
|
| ︙ | ︙ |