Overview
Comment: | Updated with latest changes from v1.64 |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.64-areas-dashboard |
Files: | files | file ages | folders |
SHA1: |
5a8ae7b6c46c5eb41fa04bf717a64c4b |
User & Date: | matt on 2017-08-03 22:26:54 |
Other Links: | branch diff | manifest | tags |
Context
2017-08-03
| ||
22:47 | Added mrmt.scm as part of moving to multi-area db connections for the multi-area dashboard check-in: 080afb1b2d user: matt tags: v1.64-areas-dashboard | |
22:26 | Updated with latest changes from v1.64 check-in: 5a8ae7b6c4 user: matt tags: v1.64-areas-dashboard | |
16:15 | Remove the added-on local access support in dashboard, rely instead on rmt built-in support. Improved the refresh button behavior. Added DEAD to statuses to clear in -rerun-clean. check-in: 3a8e2b2276 user: mrwellan tags: v1.64 | |
2017-08-01
| ||
04:57 | WIP check-in: a2115754e6 user: matt tags: v1.64-areas-dashboard | |
Changes
Modified Makefile from [f3a02cac17] to [44749d6be8].
︙ | ︙ | |||
232 233 234 235 236 237 238 | utils/mk_wrapper $(PREFIX) dboard $(PREFIX)/bin/dashboard chmod a+x $(PREFIX)/bin/dashboard $(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/dboard install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \ $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \ $(PREFIX)/bin/nbfind $(PREFIX)/bin/loadrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \ | | > | | 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 | utils/mk_wrapper $(PREFIX) dboard $(PREFIX)/bin/dashboard chmod a+x $(PREFIX)/bin/dashboard $(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/dboard install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \ $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \ $(PREFIX)/bin/nbfind $(PREFIX)/bin/loadrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \ $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil \ $(PREFIX)/bin/tcmt $(PREFIX)/share/db/mt-pg.sql # $(PREFIX)/bin/.$(ARCHSTR)/ndboard # $(PREFIX)/bin/newdashboard $(PREFIX)/bin/.$(ARCHSTR) : mkdir -p $(PREFIX)/bin/.$(ARCHSTR) mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/lib |
︙ | ︙ |
Modified dashboard-areas.scm from [9e4282d8cb] to [2d0c769b51].
1 2 3 4 5 6 7 8 | ;;====================================================================== ;; AREAS ;;====================================================================== (define (dashboard:areas-summary-updater commondat tabdat tb cell-lookup run-matrix) (dashboard:areas-do-update-rundat tabdat) ;; ) (dboard:areas-summary-control-panel-updater tabdat) (let* ((last-runs-update (dboard:tabdat-last-runs-update tabdat)) | < < | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | ;;====================================================================== ;; AREAS ;;====================================================================== (define (dashboard:areas-summary-updater commondat tabdat tb cell-lookup run-matrix) (dashboard:areas-do-update-rundat tabdat) ;; ) (dboard:areas-summary-control-panel-updater tabdat) (let* ((last-runs-update (dboard:tabdat-last-runs-update tabdat)) (runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)) (runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records (runs (vector-ref runs-dat 1)) (run-id (dboard:tabdat-curr-run-id tabdat)) (runs-hash (dashboard:areas-get-runs-hash tabdat)) ;; (runs-hash (let ((ht (make-hash-table))) ;; (for-each (lambda (run) ;; (hash-table-set! ht (db:get-value-by-header run runs-header "id") run)) |
︙ | ︙ | |||
230 231 232 233 234 235 236 | ;; this calls dboard:get-tests-for-run-duplicate for each run ;; ;; create a virtual table of all the tests ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) ;; (define (dboard:areas-update-rundat tabdat runnamepatt numruns testnamepatt keypatts) (let* ((access-mode (dboard:tabdat-access-mode tabdat)) | | < | < | | 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 | ;; this calls dboard:get-tests-for-run-duplicate for each run ;; ;; create a virtual table of all the tests ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) ;; (define (dboard:areas-update-rundat tabdat runnamepatt numruns testnamepatt keypatts) (let* ((access-mode (dboard:tabdat-access-mode tabdat)) (keys (dboard:tabdat-keys tabdat)) (last-runs-update (- (dboard:tabdat-last-runs-update tabdat) 2)) (allruns (rmt:get-runs runnamepatt numruns (dboard:tabdat-start-run-offset tabdat) keypatts)) ;;(allruns-tree (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f)) (allruns-tree (rmt:get-runs-by-patt keys "%" #f #f #f #f 0)) ;; last-runs-update));;'("id" "runname") (header (db:get-header allruns)) (runs (db:get-rows allruns)) ;; RA => Filtered as per runpatt selected (runs-tree (db:get-rows allruns-tree)) ;; RA => Returns complete list of runs (start-time (current-seconds)) (runs-hash (let ((ht (make-hash-table))) (for-each (lambda (run) (hash-table-set! ht (db:get-value-by-header run header "id") run)) |
︙ | ︙ | |||
341 342 343 344 345 346 347 | dbkeys) res)))) fres)))) (define (dashboard:areas-get-runs-hash tabdat) (let* ((access-mode (dboard:tabdat-access-mode tabdat)) (last-runs-update 0);;(dboard:tabdat-last-runs-update tabdat)) | < | | 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 | dbkeys) res)))) fres)))) (define (dashboard:areas-get-runs-hash tabdat) (let* ((access-mode (dboard:tabdat-access-mode tabdat)) (last-runs-update 0);;(dboard:tabdat-last-runs-update tabdat)) (runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)) (runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records (runs (vector-ref runs-dat 1)) (run-id (dboard:tabdat-curr-run-id tabdat)) (runs-hash (let ((ht (make-hash-table))) (for-each (lambda (run) (hash-table-set! ht (db:get-value-by-header run runs-header "id") run)) runs) ht))) |
︙ | ︙ |
Modified dashboard.scm from [954bbe82a3] to [1354cb557a].
︙ | ︙ | |||
347 348 349 350 351 352 353 | (dboard:tabdat-dbdir-set! tabdat (db:dbfile-path)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) (dboard:tabdat-dbfpath-set! tabdat (db:dbfile-path)) (dboard:tabdat-monitor-db-path-set! tabdat (conc (dboard:tabdat-dbdir tabdat) "/monitor.db")) ;; HACK ALERT: this is a hack, please fix. (dboard:tabdat-ro-set! tabdat (not (file-read-access? (dboard:tabdat-dbfpath tabdat)))) | | | 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 | (dboard:tabdat-dbdir-set! tabdat (db:dbfile-path)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) (dboard:tabdat-dbfpath-set! tabdat (db:dbfile-path)) (dboard:tabdat-monitor-db-path-set! tabdat (conc (dboard:tabdat-dbdir tabdat) "/monitor.db")) ;; HACK ALERT: this is a hack, please fix. (dboard:tabdat-ro-set! tabdat (not (file-read-access? (dboard:tabdat-dbfpath tabdat)))) (dboard:tabdat-keys-set! tabdat (rmt:get-keys)) (dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname"))) (dboard:tabdat-tot-runs-set! tabdat (rmt:get-num-runs "%")) ) ;; RADT => Matrix defstruct addition (defstruct dboard:graph-dat ((id #f) : string) |
︙ | ︙ | |||
575 576 577 578 579 580 581 | db-pth))) (db-mod-time (common:lazy-sqlite-db-modification-time db-path)) (db-modified (>= db-mod-time last-db-time)) (multi-get (> (dboard:rundat-run-data-offset run-dat) 0)) ;; multi-get in progress (tmptests (if (or do-not-use-db-file-timestamps (dboard:tabdat-filters-changed tabdat) db-modified) | < | | 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 | db-pth))) (db-mod-time (common:lazy-sqlite-db-modification-time db-path)) (db-modified (>= db-mod-time last-db-time)) (multi-get (> (dboard:rundat-run-data-offset run-dat) 0)) ;; multi-get in progress (tmptests (if (or do-not-use-db-file-timestamps (dboard:tabdat-filters-changed tabdat) db-modified) (rmt:get-tests-for-run run-id testnamepatt states statuses ;; run-id testpatt states statuses (dboard:rundat-run-data-offset run-dat) ;; query offset num-to-get (dboard:tabdat-hide-not-hide tabdat) ;; no-in sort-by ;; sort-by sort-order ;; sort-order #f ;; 'shortlist ;; qrytype last-update ;; last-update |
︙ | ︙ | |||
650 651 652 653 654 655 656 | ;; this calls dboard:get-tests-for-run-duplicate for each run ;; ;; create a virtual table of all the tests ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) ;; (define (update-rundat tabdat runnamepatt numruns testnamepatt keypatts) (let* ((access-mode (dboard:tabdat-access-mode tabdat)) | | < | < | | 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 | ;; this calls dboard:get-tests-for-run-duplicate for each run ;; ;; create a virtual table of all the tests ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) ;; (define (update-rundat tabdat runnamepatt numruns testnamepatt keypatts) (let* ((access-mode (dboard:tabdat-access-mode tabdat)) (keys (rmt:get-keys)) (last-runs-update (- (dboard:tabdat-last-runs-update tabdat) 2)) (allruns (rmt:get-runs runnamepatt numruns (dboard:tabdat-start-run-offset tabdat) keypatts)) ;;(allruns-tree (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f)) (allruns-tree (rmt:get-runs-by-patt keys "%" #f #f #f #f last-runs-update)) ;;'("id" "runname") (header (db:get-header allruns)) (runs (db:get-rows allruns)) ;; RA => Filtered as per runpatt selected (runs-tree (db:get-rows allruns-tree)) ;; RA => Returns complete list of runs (start-time (current-seconds)) (runs-hash (let ((ht (make-hash-table))) (for-each (lambda (run) (hash-table-set! ht (db:get-value-by-header run header "id") run)) |
︙ | ︙ | |||
733 734 735 736 737 738 739 | ;; create a virtual table of all the tests ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) ;; (define (dboard:update-rundat tabdat runnamepatt numruns testnamepatt keypatts) (let* ((access-mode (dboard:tabdat-access-mode tabdat)) (keys (dboard:tabdat-keys tabdat)) ;; (db:dispatch-query access-mode rmt:get-keys db:get-keys))) (last-runs-update (- (dboard:tabdat-last-runs-update tabdat) 2)) | < | < | | 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 | ;; create a virtual table of all the tests ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) ;; (define (dboard:update-rundat tabdat runnamepatt numruns testnamepatt keypatts) (let* ((access-mode (dboard:tabdat-access-mode tabdat)) (keys (dboard:tabdat-keys tabdat)) ;; (db:dispatch-query access-mode rmt:get-keys db:get-keys))) (last-runs-update (- (dboard:tabdat-last-runs-update tabdat) 2)) (allruns (rmt:get-runs runnamepatt numruns (dboard:tabdat-start-run-offset tabdat) keypatts)) ;;(allruns-tree (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f)) (allruns-tree (rmt:get-runs-by-patt keys "%" #f #f #f #f 0)) ;; last-runs-update));;'("id" "runname") (header (db:get-header allruns)) (runs (db:get-rows allruns)) ;; RA => Filtered as per runpatt selected (runs-tree (db:get-rows allruns-tree)) ;; RA => Returns complete list of runs (start-time (current-seconds)) (runs-hash (let ((ht (make-hash-table))) (for-each (lambda (run) (hash-table-set! ht (db:get-value-by-header run header "id") run)) |
︙ | ︙ | |||
1681 1682 1683 1684 1685 1686 1687 | (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 runs-header "event_time")) (time-b (db:get-value-by-header record-b runs-header "event_time"))) (< time-a time-b))))) (changed #f) (last-runs-update (dboard:tabdat-last-runs-update tabdat))) | < | | 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 | (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 runs-header "event_time")) (time-b (db:get-value-by-header record-b runs-header "event_time"))) (< time-a time-b))))) (changed #f) (last-runs-update (dboard:tabdat-last-runs-update tabdat))) ;; (runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update))) (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2)) (for-each (lambda (run-id) (let* ((run-record (hash-table-ref/default runs-hash run-id #f)) (key-vals (map (lambda (key)(db:get-value-by-header run-record runs-header key)) (dboard:tabdat-keys tabdat))) (run-name (db:get-value-by-header run-record runs-header "runname")) (col-name (conc (string-intersperse key-vals "\n") "\n" run-name)) |
︙ | ︙ | |||
1753 1754 1755 1756 1757 1758 1759 | hide-clean: hide-clean) #f))) (define (dashboard:get-runs-hash tabdat) (let* ((access-mode (dboard:tabdat-access-mode tabdat)) (last-runs-update 0);;(dboard:tabdat-last-runs-update tabdat)) | < | < < | | 1747 1748 1749 1750 1751 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 | hide-clean: hide-clean) #f))) (define (dashboard:get-runs-hash tabdat) (let* ((access-mode (dboard:tabdat-access-mode tabdat)) (last-runs-update 0);;(dboard:tabdat-last-runs-update tabdat)) (runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)) (runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records (runs (vector-ref runs-dat 1)) (run-id (dboard:tabdat-curr-run-id tabdat)) (runs-hash (let ((ht (make-hash-table))) (for-each (lambda (run) (hash-table-set! ht (db:get-value-by-header run runs-header "id") run)) runs) ht))) runs-hash)) (define (dashboard:runs-summary-updater commondat tabdat tb cell-lookup run-matrix) ;; (if (dashboard:database-changed? commondat tabdat context-key: 'runs-summary-rundat) (dashboard:do-update-rundat tabdat) ;; ) (dboard:runs-summary-control-panel-updater tabdat) (let* ((last-runs-update (dboard:tabdat-last-runs-update tabdat)) (runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)) (runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records (runs (vector-ref runs-dat 1)) (run-id (dboard:tabdat-curr-run-id tabdat)) (runs-hash (dashboard:get-runs-hash tabdat)) ;; (runs-hash (let ((ht (make-hash-table))) ;; (for-each (lambda (run) ;; (hash-table-set! ht (db:get-value-by-header run runs-header "id") run)) |
︙ | ︙ | |||
2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 | (update-search commondat tabdat "test-name" val)) "make-controls"))) (iup:hbox (iup:button "Quit" #:action (lambda (obj) (exit)) #:expand "NO" #:size "40x15") (iup:button "Refresh" #:action (lambda (obj) (mark-for-update tabdat)) #:expand "NO" #:size "40x15") (iup:button "Collapse" #:action (lambda (obj) (debug:catch-and-dump (lambda () (let ((myname (iup:attribute obj "TITLE"))) (if (equal? myname "Collapse") | > > > > > > > > > > | 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 | (update-search commondat tabdat "test-name" val)) "make-controls"))) (iup:hbox (iup:button "Quit" #:action (lambda (obj) (exit)) #:expand "NO" #:size "40x15") (iup:button "Refresh" #:action (lambda (obj) (dboard:tabdat-last-data-update-set! tabdat 0) (dboard:tabdat-last-runs-update-set! tabdat 0) (dboard:tabdat-run-update-times-set! tabdat (make-hash-table)) (dboard:tabdat-last-test-dat-set! tabdat (make-hash-table)) (dboard:tabdat-allruns-set! tabdat '()) (dboard:tabdat-allruns-by-id-set! tabdat (make-hash-table)) (dboard:tabdat-done-runs-set! tabdat '()) (dboard:tabdat-not-done-runs-set! tabdat '()) (dboard:tabdat-view-changed-set! tabdat #t) (dboard:commondat-please-update-set! commondat #t) (mark-for-update tabdat)) #:expand "NO" #:size "40x15") (iup:button "Collapse" #:action (lambda (obj) (debug:catch-and-dump (lambda () (let ((myname (iup:attribute obj "TITLE"))) (if (equal? myname "Collapse") |
︙ | ︙ | |||
2987 2988 2989 2990 2991 2992 2993 | (db:test-get-event_time (hash-table-ref testsdat (car b)))))))))) ;; run times tab data updater ;; (define (dashboard:run-times-tab-run-data-updater commondat tabdat tab-num) (let* ((access-mode (dboard:tabdat-access-mode tabdat)) (last-runs-update (dboard:tabdat-last-runs-update tabdat)) | < < | | 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 | (db:test-get-event_time (hash-table-ref testsdat (car b)))))))))) ;; run times tab data updater ;; (define (dashboard:run-times-tab-run-data-updater commondat tabdat tab-num) (let* ((access-mode (dboard:tabdat-access-mode tabdat)) (last-runs-update (dboard:tabdat-last-runs-update tabdat)) (runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)) (runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records (runs-hash (let ((ht (make-hash-table))) (for-each (lambda (run) (hash-table-set! ht (db:get-value-by-header run runs-header "id") run)) (vector-ref runs-dat 1)) ht)) (run-ids (sort (filter number? (hash-table-keys runs-hash)) |
︙ | ︙ |
Name change from emergency-patch-1.scm to emergency-patches/emergency-patch-1.scm.
︙ | ︙ |
Name change from emergency-patch-2.scm to emergency-patches/emergency-patch-2.scm.
︙ | ︙ |
Name change from emergency-patch-3.scm to emergency-patches/emergency-patch-3.scm.
︙ | ︙ |
Modified megatest-version.scm from [6d86b7dff8] to [4677c6dd43].
1 2 3 4 5 | ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00.. (declare (unit megatest-version)) | | | 1 2 3 4 5 6 7 | ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00.. (declare (unit megatest-version)) (define megatest-version 1.6428) |
Modified megatest.scm from [bb9c6de280] to [d2c3028f31].
︙ | ︙ | |||
1579 1580 1581 1582 1583 1584 1585 | "-runall" "run all tests" (lambda (target runname keys keyvals) (if (args:get-arg "-rerun-clean") ;; first set states/statuses correct (let ((states (or (configf:lookup *configdat* "validvalues" "cleanrerun-states") "KILLREQ,KILLED,UNKNOWN,INCOMPLETE,STUCK,NOT_STARTED")) (statuses (or (configf:lookup *configdat* "validvalues" "cleanrerun-statuses") | | | 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 | "-runall" "run all tests" (lambda (target runname keys keyvals) (if (args:get-arg "-rerun-clean") ;; first set states/statuses correct (let ((states (or (configf:lookup *configdat* "validvalues" "cleanrerun-states") "KILLREQ,KILLED,UNKNOWN,INCOMPLETE,STUCK,NOT_STARTED")) (statuses (or (configf:lookup *configdat* "validvalues" "cleanrerun-statuses") "FAIL,INCOMPLETE,ABORT,CHECK,DEAD"))) (hash-table-set! args:arg-hash "-preclean" #t) (runs:operate-on 'set-state-status target (common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname")) "%" ;; (common:args-get-testpatt #f) ;; (args:get-arg "-testpatt") state: states ;; status: statuses |
︙ | ︙ |
Modified server.scm from [0b4350005b] to [cebb70c145].
︙ | ︙ | |||
243 244 245 246 247 248 249 | (> (length rec) 2)) (let ((start-time (list-ref rec 3)) (mod-time (list-ref rec 0))) ;; (print "start-time: " start-time " mod-time: " mod-time) (and start-time mod-time (> (- now start-time) 0) ;; been running at least 0 seconds (< (- now mod-time) 16) ;; still alive - file touched in last 16 seconds | | | 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 | (> (length rec) 2)) (let ((start-time (list-ref rec 3)) (mod-time (list-ref rec 0))) ;; (print "start-time: " start-time " mod-time: " mod-time) (and start-time mod-time (> (- now start-time) 0) ;; been running at least 0 seconds (< (- now mod-time) 16) ;; still alive - file touched in last 16 seconds (< (- now start-time) (+ (- (string->number (or (configf:lookup *configdat* "server" "runtime") "3600")) 180) (random 360))) ;; under one hour running time +/- 180 )) #f)) srvlst) (lambda (a b) |
︙ | ︙ | |||
442 443 444 445 446 447 448 | #f))) ;; timeout is hms string: 1h 5m 3s, default is 1 minute ;; (define (server:expiration-timeout) (let ((tmo (configf:lookup *configdat* "server" "timeout"))) (if (and (string? tmo) | | | 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 | #f))) ;; timeout is hms string: 1h 5m 3s, default is 1 minute ;; (define (server:expiration-timeout) (let ((tmo (configf:lookup *configdat* "server" "timeout"))) (if (and (string? tmo) (common:hms-string->seconds tmo)) ;; BUG: hms-string->seconds is broken, if given "10" returns 0. Also, it doesn't belong in this logic unless the string->number is changed below (* 3600 (string->number tmo)) 60))) ;; moving this here as it needs access to db and cannot be in common. ;; (define (server:writable-watchdog dbstruct) (thread-sleep! 0.05) ;; delay for startup |
︙ | ︙ |
Modified tcmt.scm from [06a53b1301] to [3e1895cf52].
︙ | ︙ | |||
39 40 41 42 43 44 45 | ;; ##teamcity[testStarted name='suite.testName'] ;; ##teamcity[testStdOut name='suite.testName' out='text'] ;; ##teamcity[testStdErr name='suite.testName' out='error text'] ;; ##teamcity[testFailed name='suite.testName' message='failure message' details='message and stack trace'] ;; ##teamcity[testFinished name='suite.testName' duration='50'] ;; | | > | | | | | | | > > > > | | | | | | | | | | | | > | | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 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 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | ;; ##teamcity[testStarted name='suite.testName'] ;; ##teamcity[testStdOut name='suite.testName' out='text'] ;; ##teamcity[testStdErr name='suite.testName' out='error text'] ;; ##teamcity[testFailed name='suite.testName' message='failure message' details='message and stack trace'] ;; ##teamcity[testFinished name='suite.testName' duration='50'] ;; ;; flush; #f, normal call. #t, last call, print out something for NOT_STARTED, etc. ;; (define (print-changes-since data run-ids last-update tsname target runname flowid flush) ;; (let ((now (current-seconds))) (handle-exceptions exn (begin (print-call-chain) (print "Error message: " ((condition-property-accessor 'exn 'message) exn))) (for-each (lambda (run-id) (let* ((tests (rmt:get-tests-for-run run-id "%" '() '() #f #f #f #f #f #f last-update #f))) ;; (print "DEBUG: got tests=" tests) (for-each (lambda (testdat) (let* ((testn (db:test-get-fullname testdat)) (testname (db:test-get-testname testdat)) (itempath (db:test-get-item-path testdat)) (tctname (if (string=? itempath "") testname (conc testname "." (string-translate itempath "/" ".")))) (state (db:test-get-state testdat)) (status (db:test-get-status testdat)) (duration (or (any->number (db:test-get-run_duration testdat)) 0)) (comment (db:test-get-comment testdat)) (logfile (db:test-get-final_logf testdat)) (prevstat (hash-table-ref/default data testn #f)) (newstat (cond ((equal? state "RUNNING") "RUNNING") ((equal? state "COMPLETED") status) (flush (conc state "/" status)) (else "UNK"))) (cmtstr (if (and (not flush) comment) (conc " message='" comment "' ") (if flush (conc "message='Test ended in state/status=" state "/" status (if (string-match "^\\s*$" comment) ", no Megatest comment found.' " (conc ", Megatest comment='" comment "' "))) ;; special case, we are handling stragglers " "))) (details (if (string-match ".*html$" logfile) (conc " details='" *toppath* "/lt/" target "/" runname "/" testname (if (equal? itempath "") "/" (conc "/" itempath "/")) logfile "' ") ""))) ;; (print "DEBUG: testn=" testn " state=" state " status=" status " prevstat=" prevstat " newstat=" newstat) (if (or (not prevstat) (not (equal? prevstat newstat))) (begin (case (string->symbol newstat) ((UNK) ) ;; do nothing ((RUNNING) (print "##teamcity[testStarted name='" tctname "' flowId='" flowid "']")) ((PASS SKIP WARN WAIVED) (print "##teamcity[testFinished name='" tctname "' duration='" (* 1e3 duration) "'" cmtstr details " flowId='" flowid "']")) (else (print "##teamcity[testFailed name='" tctname "' " cmtstr details " flowId='" flowid "']"))) (flush-output) (hash-table-set! data testn newstat))))) tests))) run-ids)) now)) (define (monitor pid) (let* ((run-ids #f) (testdat (make-hash-table)) (keys #f) (last-update 0) (target (or (args:get-arg "-target") (args:get-arg "-reqtarg"))) (runname (args:get-arg "-runname")) (tsname #f) (flowid (conc target "/" runname))) (if (and target runname) (begin (launch:setup) (set! keys (rmt:get-keys)))) (set! tsname (common:get-testsuite-name)) (print "TCMT: for testsuite=" tsname " found runname=" runname ", target=" target ", keys=" keys " and successfully ran launch:setup. Using " flowid " as the flowId.") (let loop () (handle-exceptions exn ;; (print "Process done.") (begin (print-call-chain) (print "Error message: " ((condition-property-accessor 'exn 'message) exn))) (let-values (((pidres exittype exitstatus) (process-wait pid #t))) |
︙ | ︙ | |||
129 130 131 132 133 134 135 | (header (db:get-header runs)) (rows (db:get-rows runs)) (run-ids-in (map (lambda (row) (db:get-value-by-header row header "id")) rows))) (set! run-ids run-ids-in))) ;; (print "TCMT: pidres=" pidres " exittype=" exittype " exitstatus=" exitstatus " run-ids=" run-ids) | < < > > > > | 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 | (header (db:get-header runs)) (rows (db:get-rows runs)) (run-ids-in (map (lambda (row) (db:get-value-by-header row header "id")) rows))) (set! run-ids run-ids-in))) ;; (print "TCMT: pidres=" pidres " exittype=" exittype " exitstatus=" exitstatus " run-ids=" run-ids) (if (eq? pidres 0) (begin (if keys (set! last-update (print-changes-since testdat run-ids last-update tsname target runname flowid #f))) (thread-sleep! 3) (loop)) (begin ;; (print "TCMT: pidres=" pidres " exittype=" exittype " exitstatus=" exitstatus " run-ids=" run-ids) (print "TCMT: processing any tests that did not formally complete.") (print-changes-since testdat run-ids 0 tsname target runname flowid #t) ;; call in flush mode (print "TCMT: All done.") ))))))) ;; (if (not (eq? pidres 0)) ;; (not exitstatus)) ;; (begin ;; (thread-sleep! 3) ;; (loop)) |
︙ | ︙ |