Overview
| Comment: | Partial implementation of test steps as text box |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
ea880f01b97697a3bc398dfdc1b935fe |
| User & Date: | matt on 2011-09-12 06:51:50 |
| Other Links: | manifest | tags |
Context
|
2011-09-12
| ||
| 07:04 | Merged in rollup branch check-in: 7a69e38634 user: matt tags: trunk | |
| 06:51 | Partial implementation of test steps as text box check-in: ea880f01b9 user: matt tags: trunk | |
| 00:05 | Rollup to test_data completed. Rebuild db reworked check-in: d406fee8c4 user: matt tags: trunk, v1.24 | |
Changes
Modified dashboard-tests.scm from [563dea2bd2] to [f142c4ac47].
| ︙ | ︙ | |||
346 347 348 349 350 351 352 | (iup:hbox (iup:button "View Log" #:action viewlog #:size "120x") (iup:button "Start Xterm" #:action xterm #:size "120x") (iup:button "Close" #:action (lambda (x)(exit)) #:size "120x"))) (set-fields-panel test-id testdat) (iup:frame #:title "Test Steps" | | | | | > > > > > | | 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 | (iup:hbox (iup:button "View Log" #:action viewlog #:size "120x") (iup:button "Start Xterm" #:action xterm #:size "120x") (iup:button "Close" #:action (lambda (x)(exit)) #:size "120x"))) (set-fields-panel test-id testdat) (iup:frame #:title "Test Steps" (let ((stepsdat ;;(iup:label "Test steps ........................................." ;; #:expand "YES" ;; #:size "200x150" ;; #:alignment "ALEFT:ATOP"))) (iup:textbox #:action (lambda (obj char val) #f) #:expand "YES" #:multiline "YES" #:font "Courier New, -10"))) (hash-table-set! widgets "Test Steps" (lambda (testdat) (let* ((currval (iup:attribute stepsdat "VALUE")) ;; "TITLE")) (fmtstr "~25a~10a~10a~15a~20a") (comprsteps (db:get-steps-table db test-id)) (newval (string-intersperse (append (list (format #f fmtstr "Stepname" "Start" "End" "Status" "Time") (format #f fmtstr "========" "=====" "======" "======" "==========")) |
| ︙ | ︙ | |||
376 377 378 379 380 381 382 | (sort (hash-table-values comprsteps) (lambda (a b) (if (and (number? a)(number? b)) (< (vector-ref a 1)(vector-ref b 1)) #t))))) "\n"))) (if (not (equal? currval newval)) | | | 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 |
(sort (hash-table-values comprsteps)
(lambda (a b)
(if (and (number? a)(number? b))
(< (vector-ref a 1)(vector-ref b 1))
#t)))))
"\n")))
(if (not (equal? currval newval))
(iup:attribute-set! stepsdat "VALUE" newval ))))) ;; "TITLE" newval)))))
stepsdat)))))
(iup:show self)
(iup:callback-set! *tim* "ACTION_CB"
(lambda (x)
;; Now start keeping the gui updated from the db
(refreshdat) ;; update from the db here
;(thread-suspend! other-thread)
|
| ︙ | ︙ |
Modified db.scm from [dacaca63c6] to [d2c04b8411].
| ︙ | ︙ | |||
645 646 647 648 649 650 651 652 653 654 655 656 657 658 |
(lambda (id test-id stepname state status event-time)
(set! res (cons (vector id test-id stepname state status event-time) res)))
db
"SELECT id,test_id,stepname,state,status,event_time FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
test-id)
(reverse res)))
;; get a pretty table to summarize steps
;;
(define (db:get-steps-table db test-id)
(let ((steps (db:get-steps-for-test db test-id)))
;; organise the steps for better readability
(let ((res (make-hash-table)))
(for-each
| > > > > > > > > | 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 |
(lambda (id test-id stepname state status event-time)
(set! res (cons (vector id test-id stepname state status event-time) res)))
db
"SELECT id,test_id,stepname,state,status,event_time FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC;
test-id)
(reverse res)))
;;
(define (make-db:steps-table)(make-vector 5))
(define-inline (db:steps-table-get-stepname vec) (vector-ref vec 0))
(define-inline (db:steps-table-get-start vec) (vector-ref vec 1))
(define-inline (db:steps-table-get-end vec) (vector-ref vec 2))
(define-inline (db:steps-table-get-status vec) (vector-ref vec 3))
(define-inline (db:steps-table-get-runtime vec) (vector-ref vec 4))
;; get a pretty table to summarize steps
;;
(define (db:get-steps-table db test-id)
(let ((steps (db:get-steps-for-test db test-id)))
;; organise the steps for better readability
(let ((res (make-hash-table)))
(for-each
|
| ︙ | ︙ |
Modified server.scm from [f6c984417d] to [9b405ea575].
| ︙ | ︙ | |||
43 44 45 46 47 48 49 | (tcp-listen (rpc:default-server-port)))) (define (server:client-setup db) (let* ((hostinfo (db:get-var db "SERVER")) (hostdat (if hostinfo (string-split hostinfo ":"))) (host (if hostinfo (car hostdat))) (port (if (and hostinfo (> (length hostdat) 1))(cadr hostdat) #f))) | | < < < < < < < < | 43 44 45 46 47 48 49 50 |
(tcp-listen (rpc:default-server-port))))
(define (server:client-setup db)
(let* ((hostinfo (db:get-var db "SERVER"))
(hostdat (if hostinfo (string-split hostinfo ":")))
(host (if hostinfo (car hostdat)))
(port (if (and hostinfo (> (length hostdat) 1))(cadr hostdat) #f)))
(set! *runremote* (vector host port))))
|