Overview
Comment: | Converted test steps to matrix, added browsing of log |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | development | v1.5414 |
Files: | files | file ages | folders |
SHA1: |
d187e07c8beebe3b9587119a93b8e9c9 |
User & Date: | mrwellan on 2013-04-17 15:28:46 |
Other Links: | branch diff | manifest | tags |
Context
2013-04-22
| ||
16:38 | Fixed issue with server record not reflecting actual server when have port collisions. check-in: 99ca17a0cc user: mrwellan tags: development, v1.5415 | |
2013-04-19
| ||
00:33 | Starting on dashboard run control panel check-in: b504d0edc5 user: matt tags: runcontrol | |
2013-04-17
| ||
15:28 | Converted test steps to matrix, added browsing of log check-in: d187e07c8b user: mrwellan tags: development, v1.5414 | |
08:51 | bumped version check-in: f8584f2d62 user: icfadm tags: development, v1.5413 | |
Changes
Modified dashboard-tests.scm from [9eaeae0a21] to [b247a10977].
︙ | ︙ | |||
268 269 270 271 272 273 274 | (exit 1)) (let* ((run-id (if testdat (db:test-get-run_id testdat) #f)) (keydat (if testdat (open-run-close db:get-key-val-pairs #f run-id) #f)) (rundat (if testdat (open-run-close db:get-run-info #f run-id) #f)) (runname (if testdat (db:get-value-by-header (db:get-row rundat) (db:get-header rundat) "runname") #f)) | | | 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 | (exit 1)) (let* ((run-id (if testdat (db:test-get-run_id testdat) #f)) (keydat (if testdat (open-run-close db:get-key-val-pairs #f run-id) #f)) (rundat (if testdat (open-run-close db:get-run-info #f run-id) #f)) (runname (if testdat (db:get-value-by-header (db:get-row rundat) (db:get-header rundat) "runname") #f)) (teststeps (if testdat (db:get-compressed-steps test-id) '())) (logfile "/this/dir/better/not/exist") (rundir logfile) (testfullname (if testdat (db:test-get-fullname testdat) "Gathering data ...")) (testname (if testdat (db:test-get-testname testdat) "n/a")) (testmeta (if testdat (let ((tm (open-run-close db:testmeta-get-record #f testname))) (if tm tm (make-db:testmeta))) |
︙ | ︙ | |||
307 308 309 310 311 312 313 | (need-update (or (and (> curr-mod-time db-mod-time) (> (current-seconds) (+ last-update 2))) ;; every two seconds if db touched request-update)) (newtestdat (if need-update (open-run-close db:get-test-info-by-id #f test-id)))) (cond ((and need-update newtestdat) (set! testdat newtestdat) | | | > > | 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 | (need-update (or (and (> curr-mod-time db-mod-time) (> (current-seconds) (+ last-update 2))) ;; every two seconds if db touched request-update)) (newtestdat (if need-update (open-run-close db:get-test-info-by-id #f test-id)))) (cond ((and need-update newtestdat) (set! testdat newtestdat) (set! teststeps (db:get-compressed-steps 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)) ;; (debug:print 0 "INFO: teststeps=" (intersperse teststeps "\n ")) ) (need-update ;; if this was true and yet there is no data .... (db:test-set-testname! testdat "DEAD OR DELETED TEST")))))) (widgets (make-hash-table)) (meta-widgets (make-hash-table)) (self #f) (store-label (lambda (name lbl cmd) (hash-table-set! widgets name |
︙ | ︙ | |||
389 390 391 392 393 394 395 | (iup:button "Run Test" #:action run-test #:size "80x") (iup:button "Clean Test" #:action remove-test #:size "80x") (iup:button "Close" #:action (lambda (x)(exit)) #:size "80x")) (apply iup:hbox (list command-text-box command-launch-button)))) (set-fields-panel test-id testdat) | | | | | < < < < | | | | | | > | > | > > | | | | | | | | < | | | | > > > > | < < < < < | > > > > | | < > | < < < < | < < | > | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > | | 391 392 393 394 395 396 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 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 | (iup:button "Run Test" #:action run-test #:size "80x") (iup:button "Clean Test" #:action remove-test #:size "80x") (iup:button "Close" #:action (lambda (x)(exit)) #:size "80x")) (apply iup:hbox (list command-text-box command-launch-button)))) (set-fields-panel test-id testdat) (let ((tabs (iup:tabs ;; Replace here with matrix (let ((steps-matrix (iup:matrix #:font "Courier New, -8" #:expand "YES" #:scrollbar "YES" #:numcol 6 #:numlin 30 #:numcol-visible 6 #:numlin-visible 5 #:click-cb (lambda (obj lin col status) (if (equal? col 6) (let ((fname (iup:attribute obj (conc lin ":" col)))) (viewlog fname) (print "obj: " obj " lin: " lin " col: " col " status: " status))))) )) ;; (let loop ((count 0)) ;; (iup:attribute-set! steps-matrix "FITTOTEXT" (conc "L" count)) ;; (if (< count 30) ;; (loop (+ count 1)))) (iup:attribute-set! steps-matrix "0:1" "Step Name") (iup:attribute-set! steps-matrix "0:2" "Start") (iup:attribute-set! steps-matrix "0:3" "End") (iup:attribute-set! steps-matrix "WIDTH3" "50") (iup:attribute-set! steps-matrix "0:4" "Status") (iup:attribute-set! steps-matrix "WIDTH4" "50") (iup:attribute-set! steps-matrix "0:5" "Duration") (iup:attribute-set! steps-matrix "0:6" "Log File") (iup:attribute-set! steps-matrix "ALIGNMENT1" "ALEFT") ;; (iup:attribute-set! steps-matrix "FIXTOTEXT" "C1") (iup:attribute-set! steps-matrix "RESIZEMATRIX" "YES") (let ((proc (lambda (testdat) (if (not (null? teststeps)) (let loop ((hed (car teststeps)) (tal (cdr teststeps)) (rownum 1) (colnum 1)) (let ((val (vector-ref hed (- colnum 1)))) (iup:attribute-set! steps-matrix (conc rownum ":" colnum)(if val (conc val) "")) (if (< colnum 6) (loop hed tal rownum (+ colnum 1)) (if (not (null? tal)) (loop (car tal)(cdr tal)(+ rownum 1) 1))))))))) (hash-table-set! widgets "StepsMatrix" proc) (proc testdat)) steps-matrix) ;; populate the Test Data panel (iup:frame #:title "Test Data" (let ((test-data (iup:textbox ;; #:action (lambda (obj char val) ;; #f) #:expand "YES" #:multiline "YES" #:font "Courier New, -10" #:size "100x100"))) (hash-table-set! widgets "Test Data" (lambda (testdat) ;; (let* ((currval (iup:attribute test-data "VALUE")) ;; "TITLE")) (fmtstr "~10a~10a~10a~10a~7a~7a~6a~6a~a") ;; category,variable,value,expected,tol,units,type,comment (newval (string-intersperse (append (list (format #f fmtstr "Category" "Variable" "Value" "Expected" "Tol" "Status" "Units" "Type" "Comment") (format #f fmtstr "========" "========" "=====" "========" "===" "======" "=====" "====" "=======")) (map (lambda (x) (format #f fmtstr (db:test-data-get-category x) (db:test-data-get-variable x) (db:test-data-get-value x) (db:test-data-get-expected x) (db:test-data-get-tol x) (db:test-data-get-status x) (db:test-data-get-units x) (db:test-data-get-type x) (db:test-data-get-comment x))) (open-run-close db:read-test-data #f test-id "%"))) "\n"))) (if (not (equal? currval newval)) (iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval))))) test-data))))) (iup:attribute-set! tabs "TABTITLE0" "Steps") (iup:attribute-set! tabs "TABTITLE1" "Test Data") tabs)))) (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) ;; update the gui elements here |
︙ | ︙ |
Modified db.scm from [597b101439] to [a540e1036f].
︙ | ︙ | |||
1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 | ;; organise the steps for better readability (let ((res (make-hash-table))) (for-each (lambda (step) (debug:print 6 "step=" step) (let ((record (hash-table-ref/default res (db:step-get-stepname step) ;; stepname start end status (vector (db:step-get-stepname step) "" "" "" "" "")))) (debug:print 6 "record(before) = " record "\nid: " (db:step-get-id step) "\nstepname: " (db:step-get-stepname step) "\nstate: " (db:step-get-state step) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 | ;; organise the steps for better readability (let ((res (make-hash-table))) (for-each (lambda (step) (debug:print 6 "step=" step) (let ((record (hash-table-ref/default res (db:step-get-stepname step) ;; stepname start end status Duration Logfile (vector (db:step-get-stepname step) "" "" "" "" "")))) (debug:print 6 "record(before) = " record "\nid: " (db:step-get-id step) "\nstepname: " (db:step-get-stepname step) "\nstate: " (db:step-get-state step) "\nstatus: " (db:step-get-status step) "\ntime: " (db:step-get-event_time 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))) (if (> (string-length (db:step-get-logfile step)) 0) (vector-set! record 5 (db:step-get-logfile step)))) ((end) (vector-set! record 2 (any->number (db:step-get-event_time step))) (vector-set! record 3 (db:step-get-status step)) (vector-set! record 4 (let ((startt (any->number (vector-ref record 1))) (endt (any->number (vector-ref record 2)))) (debug:print 4 "record[1]=" (vector-ref record 1) ", startt=" startt ", endt=" endt ", get-status: " (db:step-get-status step)) (if (and (number? startt)(number? endt)) (seconds->hr-min-sec (- endt startt)) "-1"))) (if (> (string-length (db:step-get-logfile step)) 0) (vector-set! record 5 (db:step-get-logfile step)))) (else (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) (debug:print 6 "record(after) = " record "\nid: " (db:step-get-id step) "\nstepname: " (db:step-get-stepname step) "\nstate: " (db:step-get-state step) "\nstatus: " (db:step-get-status step) "\ntime: " (db:step-get-event_time step)))) ;; (else (vector-set! record 1 (db:step-get-event_time step))) (sort steps (lambda (a b) (cond ((< (db:step-get-event_time a)(db:step-get-event_time b)) #t) ((eq? (db:step-get-event_time a)(db:step-get-event_time b)) (< (db:step-get-id a) (db:step-get-id b))) (else #f))))) res))) ;; get a pretty table to summarize steps ;; (define (db:get-steps-table-list 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 (lambda (step) (debug:print 6 "step=" step) (let ((record (hash-table-ref/default res (db:step-get-stepname step) ;; stepname start end status (vector (db:step-get-stepname step) "" "" "" "" "")))) (debug:print 6 "record(before) = " record "\nid: " (db:step-get-id step) "\nstepname: " (db:step-get-stepname step) "\nstate: " (db:step-get-state step) |
︙ | ︙ | |||
1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 | (cond ((< (db:step-get-event_time a)(db:step-get-event_time b)) #t) ((eq? (db:step-get-event_time a)(db:step-get-event_time b)) (< (db:step-get-id a) (db:step-get-id b))) (else #f))))) res))) ;;====================================================================== ;; M I S C M A N A G E M E N T I T E M S ;;====================================================================== ;; the new prereqs calculation, looks also at itempath if specified ;; all prereqs must be met: ;; if prereq test with itempath='' is COMPLETED and PASS, WARN, CHECK, or WAIVED then prereq is met | > > > > > > > > > > > > > > > > > > > > > > > > > > | 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 | (cond ((< (db:step-get-event_time a)(db:step-get-event_time b)) #t) ((eq? (db:step-get-event_time a)(db:step-get-event_time b)) (< (db:step-get-id a) (db:step-get-id b))) (else #f))))) res))) (define (db:get-compressed-steps test-id) (let* ((comprsteps (open-run-close db:get-steps-table #f test-id))) (map (lambda (x) ;; take advantage of the \n on time->string (vector (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) ;; status (vector-ref x 4) (vector-ref x 5))) ;; time delta (sort (hash-table-values comprsteps) (lambda (a b) (let ((time-a (vector-ref a 1)) (time-b (vector-ref b 1))) (if (and (number? time-a)(number? time-b)) (if (< time-a time-b) #t (if (eq? time-a time-b) (string<? (conc (vector-ref a 2)) (conc (vector-ref b 2))) #f)) (string<? (conc time-a)(conc time-b))))))))) ;;====================================================================== ;; M I S C M A N A G E M E N T I T E M S ;;====================================================================== ;; the new prereqs calculation, looks also at itempath if specified ;; all prereqs must be met: ;; if prereq test with itempath='' is COMPLETED and PASS, WARN, CHECK, or WAIVED then prereq is met |
︙ | ︙ |
Modified megatest-version.scm from [d449b746cd] to [139eab9acd].
1 2 3 4 5 | ;; Always use two digit decimal ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. (declare (unit megatest-version)) | | | 1 2 3 4 5 6 7 | ;; Always use two digit decimal ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. (declare (unit megatest-version)) (define megatest-version 1.5414) |
Modified tests/fullrun/megatest.config from [63f2370192] to [c5fdf7800f].
︙ | ︙ | |||
55 56 57 58 59 60 61 | # XTERM [system xterm] # RUNDEAD [system exit 56] [server] # If the server can't be started on this port it will try the next port until # it succeeds | | | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | # XTERM [system xterm] # RUNDEAD [system exit 56] [server] # If the server can't be started on this port it will try the next port until # it succeeds port 8099 # This server will keep running this number of hours after last access. # Three minutes is 0.05 hours timeout 0.05 ## disks are: ## name host:/path/to/area |
︙ | ︙ |