Overview
| Comment: | Added widgets for test control panel |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | development |
| Files: | files | file ages | folders |
| SHA1: |
2dd5efefd7d00d0254c3a56ec241f26d |
| User & Date: | matt on 2013-03-20 23:14:21 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-03-21
| ||
| 00:07 | Added widgets for test control panel check-in: 343014c543 user: matt tags: development | |
|
2013-03-20
| ||
| 23:14 | Added widgets for test control panel check-in: 2dd5efefd7 user: matt tags: development | |
| 21:23 | Light rearrangement and code cleanup check-in: 6694a9d305 user: matt tags: development | |
Changes
Modified newdashboard.scm from [5cd724371b] to [1cfebab497].
| ︙ | ︙ | |||
80 81 82 83 84 85 86 | (debug:setup) (define *tim* (iup:timer)) (define *ord* #f) | | > > > > > | 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | (debug:setup) (define *tim* (iup:timer)) (define *ord* #f) (define *data* (make-vector 10 #f)) (define-inline (dboard:data-get-runs vec) (vector-ref vec 0)) (define-inline (dboard:data-get-tests vec) (vector-ref vec 1)) (define-inline (dboard:data-get-runs-matrix vec) (vector-ref vec 2)) (define-inline (dboard:data-get-tests-tree vec) (vector-ref vec 3)) (define-inline (dboard:data-get-run-keys vec) (vector-ref vec 4)) (define-inline (dboard:data-get-curr-test-id vec) (vector-ref vec 5)) (define-inline (dboard:data-get-test-details vec) (vector-ref vec 6)) (define-inline (dboard:data-set-runs! vec val)(vector-set! vec 0 val)) (define-inline (dboard:data-set-tests! vec val)(vector-set! vec 1 val)) (define-inline (dboard:data-set-runs-matrix! vec val)(vector-set! vec 2 val)) (define-inline (dboard:data-set-tests-tree! vec val)(vector-set! vec 3 val)) (define-inline (dboard:data-set-run-keys! vec val)(vector-set! vec 4 val)) (define-inline (dboard:data-set-curr-test-id! vec val)(vector-set! vec 5 val)) (define-inline (dboard:data-set-test-details! vec val)(vector-set! vec 6 val)) (dboard:data-set-run-keys! *data* (make-hash-table)) (iup:attribute-set! *tim* "TIME" 300) (iup:attribute-set! *tim* "RUN" "YES") (define (message-window msg) |
| ︙ | ︙ | |||
398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 |
2
(append (take path ndepth)(list node-title)))))))))))
;;======================================================================
;; T E S T S
;;======================================================================
;; Test browser
(define (tests)
(iup:hbox
(let* ((tb (iup:treebox
#:selection-cb (lambda (obj id state)
(print "obj: " obj ", id: " id ", state: " state)
(print "path: " (tree-node->path obj id))))))
(iup:attribute-set! tb "VALUE" "0")
(iup:attribute-set! tb "NAME" "Runs")
(iup:attribute-set! tb "ADDEXPANDED" "NO")
(dboard:data-set-tests-tree! *data* tb)
tb)
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 |
2
(append (take path ndepth)(list node-title)))))))))))
;;======================================================================
;; T E S T S
;;======================================================================
(define (test-panel)
(let* (
(curr-row-num 0)
(viewlog (lambda (x)
(if (file-exists? logfile)
;(system (conc "firefox " logfile "&"))
(iup:send-url logfile)
(message-window (conc "File " logfile " not found")))))
(xterm (lambda (x)
(if (directory-exists? rundir)
(let ((shell (if (get-environment-variable "SHELL")
(conc "-e " (get-environment-variable "SHELL"))
"")))
(system (conc "cd " rundir
";xterm -T \"" (string-translate testfullname "()" " ") "\" " shell "&")))
(message-window (conc "Directory " rundir " not found")))))
(command-text-box (iup:textbox #:expand "HORIZONTAL" #:font "Courier New, -10"))
(command-launch-button (iup:button "Execute!" #:action (lambda (x)
(let ((cmd (iup:attribute command-text-box "VALUE")))
(system (conc cmd " &"))))))
(run-test (lambda (x)
(iup:attribute-set!
command-text-box "VALUE"
(conc "xterm -geometry 180x20 -e \"megatest -target " keystring " :runname " runname
" -runtests " (conc testname "/" (if (equal? item-path "")
"%"
item-path))
";echo Press any key to continue;bash -c 'read -n 1 -s'\""))))
(remove-test (lambda (x)
(iup:attribute-set!
command-text-box "VALUE"
(conc "xterm -geometry 180x20 -e \"megatest -remove-runs -target " keystring " :runname " runname
" -testpatt " (conc testname "/" (if (equal? item-path "")
"%"
item-path))
" -v;echo Press any key to continue;bash -c 'read -n 1 -s'\""))))
(run-info-matrix (iup:matrix
#:expand "YES"
;; #:scrollbar "YES"
#:numcol 1
#:numlin 5
#:numcol-visible 1
#:numlin-visible 5
#:click-cb (lambda (obj lin col status)
(print "obj: " obj " lin: " lin " col: " col " status: " status))))
(test-info-matrix (iup:matrix
#:expand "YES"
#:numcol 1
#:numlin 5
#:numcol-visible 1
#:numlin-visible 5))
(test-run-matrix (iup:matrix
#:expand "YES"
#:numcol 1
#:numlin 7
#:numcol-visible 1
#:numlin-visible 7))
(meta-dat-matrix (iup:matrix
#:expand "YES"
#:numcol 1
#:numlin 5
#:numcol-visible 1
#:numlin-visible 5))
(steps-matrix (iup:matrix
#:expand "YES"
#:numcol 1
#:numlin 20
#:numcol-visible 1
#:numlin-visible 8))
(data-matrix (iup:matrix
#:expand "YES"
#:numcol 1
#:numlin 20
#:numcol-visible 1
#:numlin-visible 8))
)
;;
(for-each
(lambda (mat)
;; (iup:attribute-set! mat "0:1" "Value")
;; (iup:attribute-set! mat "0:0" "Var")
(iup:attribute-set! mat "HEIGHT0" 0)
(iup:attribute-set! mat "ALIGNMENT1" "ALEFT")
(iup:attribute-set! mat "FIXTOTEXT" "C1")
(iup:attribute-set! mat "RESIZEMATRIX" "YES")
(iup:attribute-set! mat "WIDTH1" "120")
(iup:attribute-set! mat "WIDTH0" "100")
)
(list run-info-matrix test-info-matrix test-run-matrix meta-dat-matrix steps-matrix data-matrix))
(iup:vbox
(iup:hbox
run-info-matrix
test-info-matrix)
(iup:hbox
test-run-matrix
meta-dat-matrix)
(iup:vbox
(iup:vbox
(iup:hbox
(iup:button "View Log" #:action viewlog #:size "80x")
(iup:button "Start Xterm" #:action xterm #:size "80x")
(iup:button "Run Test" #:action run-test #:size "80x")
(iup:button "Clean Test" #:action remove-test #:size "80x"))
(apply
iup:hbox
(list command-text-box command-launch-button))))
(iup:vbox
(iup:tabs
steps-matrix
data-matrix)))))
;; Test browser
(define (tests)
(iup:hbox
(let* ((tb (iup:treebox
#:selection-cb (lambda (obj id state)
(print "obj: " obj ", id: " id ", state: " state)
(print "path: " (tree-node->path obj id))))))
(iup:attribute-set! tb "VALUE" "0")
(iup:attribute-set! tb "NAME" "Runs")
(iup:attribute-set! tb "ADDEXPANDED" "NO")
(dboard:data-set-tests-tree! *data* tb)
tb)
(test-panel)))
;;======================================================================
;; R U N C O N T R O L
;;======================================================================
;; Overall runs browser
;;
(define (runs)
|
| ︙ | ︙ | |||
464 465 466 467 468 469 470 | ;; 2. Update synchash to understand "get-runs", "get-tests" etc. ;; 3. Add extraction of filters to synchash calls ;; ;; Mode is 'full or 'incremental for full refresh or incremental refresh (define (run-update keys data runname keypatts testpatt states statuses mode) (let* (;; count and offset => #f so not used ;; the synchash calls modify the "data" hash | | > | > > | > > > > > | < < < | 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 |
;; 2. Update synchash to understand "get-runs", "get-tests" etc.
;; 3. Add extraction of filters to synchash calls
;;
;; Mode is 'full or 'incremental for full refresh or incremental refresh
(define (run-update keys data runname keypatts testpatt states statuses mode)
(let* (;; count and offset => #f so not used
;; the synchash calls modify the "data" hash
(get-runs-sig (conc (client:get-signature) " get-runs"))
(get-tests-sig (conc (client:get-signature) " get-tests"))
(get-details-sig (conc (client:get-signature) " get-test-details"))
(detail-test-id (dboard:data-get-curr-test-id *data*))
(run-changes (synchash:client-get 'db:get-runs get-runs-sig (length keypatts) data runname #f #f keypatts))
(test-detail-changes (if detail-test-id
(synchash:client-get 'db:get-test-info-by-id detail-test-id 0 data detail-test-id)
#f))
;; Now can calculate the run-ids
(run-hash (hash-table-ref/default data get-runs-sig #f))
(run-ids (if run-hash (filter number? (hash-table-keys run-hash)) '()))
(test-changes (synchash:client-get 'db:get-tests-for-runs-mindata get-tests-sig 0 data run-ids testpatt states statuses))
(runs-hash (hash-table-ref/default data get-runs-sig #f))
(header (hash-table-ref/default runs-hash "header" #f))
(run-ids (sort (filter number? (hash-table-keys runs-hash))
(lambda (a b)
(let* ((record-a (hash-table-ref runs-hash a))
(record-b (hash-table-ref runs-hash b))
(time-a (db:get-value-by-header record-a header "event_time"))
(time-b (db:get-value-by-header record-b header "event_time")))
(> time-a time-b)))
))
(runid-to-col (hash-table-ref *cachedata* "runid-to-col"))
(testname-to-row (hash-table-ref *cachedata* "testname-to-row"))
(colnum 1)
(rownum 0)) ;; rownum = 0 is the header
;; tests related stuff
;; (all-testnames (delete-duplicates (map db:test-get-testname test-changes))))
;; Given a run-id and testname/item_path calculate a cell R:C
;; NOTE: Also build the test tree browser and look up table
|
| ︙ | ︙ |