Changes In Branch v1.60-zero-local-access Through [29908b23ed] Excluding Merge-Ins
This is equivalent to a diff from ab348d3b46 to 29908b23ed
2015-11-12
| ||
14:11 | Be more lazy on running sync to megatest.db check-in: 27552d9089 user: mrwellan tags: v1.60 | |
2015-11-11
| ||
23:00 | Merging in v1.60-zero-local-access to v1.60 Closed-Leaf check-in: c6c921401e user: matt tags: v1.60-zero-local-access | |
22:58 | Added simple lock to on-exit call of sync to megatest.db. Set lots of vars when triggers are called. check-in: 2bae638e0f user: matt tags: v1.60-zero-local-access | |
22:28 | Added back sync'ing to megatest.db but with simple file locking and much longer delay check-in: 29908b23ed user: matt tags: v1.60-zero-local-access | |
20:50 | Merged in recent changes to v1.60 in prep for meld check-in: ab0d1e7633 user: matt tags: v1.60-zero-local-access | |
20:47 | All states supported now check-in: ab348d3b46 user: matt tags: v1.60 | |
20:47 | Fix typo Closed-Leaf check-in: 56036da5c4 user: matt tags: launcher-exit-handling-refactor | |
11:27 | Merged logpro-abort-check into v1.60/28 but abort not quite right yet check-in: b6900f572f user: mrwellan tags: v1.60 | |
Modified api.scm from [7425d00411] to [d2df3c2dd1].
︙ | ︙ | |||
214 215 216 217 218 219 220 221 222 223 224 225 226 227 | ((get-runs) (apply db:get-runs dbstruct params)) ((get-num-runs) (apply db:get-num-runs dbstruct params)) ((get-all-run-ids) (db:get-all-run-ids dbstruct)) ((get-prev-run-ids) (apply db:get-prev-run-ids dbstruct params)) ((get-run-ids-matching-target) (apply db:get-run-ids-matching-target dbstruct params)) ((get-runs-by-patt) (apply db:get-runs-by-patt dbstruct params)) ((get-run-name-from-id) (apply db:get-run-name-from-id dbstruct params)) ;; STEPS ((get-steps-data) (apply db:get-steps-data dbstruct params)) ((get-steps-for-test) (apply db:get-steps-for-test dbstruct params)) ;; MISC ((have-incompletes?) (apply db:have-incompletes? dbstruct params)) | > | 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 | ((get-runs) (apply db:get-runs dbstruct params)) ((get-num-runs) (apply db:get-num-runs dbstruct params)) ((get-all-run-ids) (db:get-all-run-ids dbstruct)) ((get-prev-run-ids) (apply db:get-prev-run-ids dbstruct params)) ((get-run-ids-matching-target) (apply db:get-run-ids-matching-target dbstruct params)) ((get-runs-by-patt) (apply db:get-runs-by-patt dbstruct params)) ((get-run-name-from-id) (apply db:get-run-name-from-id dbstruct params)) ((get-run-stats) (apply db:get-run-stats dbstruct params)) ;; STEPS ((get-steps-data) (apply db:get-steps-data dbstruct params)) ((get-steps-for-test) (apply db:get-steps-for-test dbstruct params)) ;; MISC ((have-incompletes?) (apply db:have-incompletes? dbstruct params)) |
︙ | ︙ |
Modified common.scm from [2955bbfc6b] to [6b9cb42343].
︙ | ︙ | |||
266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 | ;;====================================================================== ;; E X I T H A N D L I N G ;;====================================================================== (define (common:legacy-sync-recommended) (or (args:get-arg "-runtests") (args:get-arg "-server") (args:get-arg "-set-run-status") (args:get-arg "-remove-runs") (args:get-arg "-get-run-status") )) (define (common:legacy-sync-required) (configf:lookup *configdat* "setup" "megatest-db")) (define (std-exit-procedure) | > > > > > > > > | | > | > > > > | 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 | ;;====================================================================== ;; E X I T H A N D L I N G ;;====================================================================== (define (common:legacy-sync-recommended) (or (args:get-arg "-runtests") (args:get-arg "-run") (args:get-arg "-server") (args:get-arg "-set-run-status") (args:get-arg "-remove-runs") (args:get-arg "-get-run-status") )) (define (common:legacy-sync-required) (configf:lookup *configdat* "setup" "megatest-db")) (define (std-exit-procedure) ;; (let ((dbpath (db:dbfile-path run-id)) ;; (lockf (conc dbpath "/." run-id ".lck"))) ;; (common:simple-file-lock lockf) ;; (db:multi-db-sync (list run-id) 'new2old) ;; (common:simple-file-release-lock lockf)) (let* ((dbpath (db:dbfile-path run-id)) (lockf (conc dbpath "/." run-id ".lck")) (no-hurry (if *time-to-exit* ;; hurry up #f (begin (set! *time-to-exit* #t) #t)))) (debug:print-info 4 "starting exit process, finalizing databases.") (if (and no-hurry (debug:debug-mode 18)) (rmt:print-db-stats)) (let ((th1 (make-thread (lambda () ;; thread for cleaning up, give it five seconds (let ((run-ids (hash-table-keys *db-local-sync*))) (if (and (not (null? run-ids)) (configf:lookup *configdat* "setup" "megatest-db")) ;; was if no-hurry but I always want it sync'd I think ... ;; (if no-hurry (db:multi-db-sync run-ids 'new2old)))) (begin (common:simple-file-lock lockf) (db:multi-db-sync run-ids 'new2old) (common:simple-file-release-lock lockf)))) (if *dbstruct-db* (db:close-all *dbstruct-db*)) (if *inmemdb* (db:close-all *inmemdb*)) (if (and *megatest-db* (sqlite3:database? *megatest-db*)) (begin (sqlite3:interrupt! *megatest-db*) (sqlite3:finalize! *megatest-db* #t) |
︙ | ︙ |
Modified dashboard.scm from [3d081ca889] to [7bcb6b3970].
︙ | ︙ | |||
88 89 90 91 92 93 94 | (print "Failed to find megatest.config, exiting") (exit 1))) (define *useserver* (or(not (args:get-arg "-use-local")) (configf:lookup *configdat* "dashboard" "use-server"))) (define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) | | > > | | 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | (print "Failed to find megatest.config, exiting") (exit 1))) (define *useserver* (or(not (args:get-arg "-use-local")) (configf:lookup *configdat* "dashboard" "use-server"))) (define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) (define *dbstruct-local* (if *useserver* #f (make-dbr:dbstruct path: *dbdir* local: #t))) (define *db-file-path* (db:dbfile-path 0)) ;; HACK ALERT: this is a hack, please fix. (define *read-only* (not (file-read-access? *db-file-path*))) (define toplevel #f) (define dlg #f) |
︙ | ︙ |
Modified db.scm from [3b21c0f4f0] to [d10bf78e86].
︙ | ︙ | |||
136 137 138 139 140 141 142 | ;; (let ((fdb (db:get-filedb dbstruct))) ;; (filedb:get-path db id))) ;; NB// #f => return dbdir only ;; (was planned to be; zeroth db with name=main.db) ;; (define (db:dbfile-path run-id) | > | > | > > > > > | 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 | ;; (let ((fdb (db:get-filedb dbstruct))) ;; (filedb:get-path db id))) ;; NB// #f => return dbdir only ;; (was planned to be; zeroth db with name=main.db) ;; (define (db:dbfile-path run-id) (let* ((dbdirs (filter string? (list (configf:lookup *configdat* "setup" "dbdir") (conc *toppath* "/.db") (conc (configf:lookup *configdat* "setup" "linktree") "/.db")))) (existing-dirs (filter file-exists? dbdirs)) (dbdir (if (null? existing-dirs) (or (configf:lookup *configdat* "setup" "dbdir") (conc *toppath* "/.db")) (car existing-dirs))) (fname (if run-id (if (eq? run-id 0) "main.db" (conc run-id ".db")) #f))) (handle-exceptions exn (begin (debug:print 0 "ERROR: Couldn't create path to " dbdir) |
︙ | ︙ | |||
1820 1821 1822 1823 1824 1825 1826 | "SELECT id FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;") (reverse run-ids))))) ;; get some basic run stats ;; ;; ( (runname (( state count ) ... )) ;; ( ... | | | | < < < < < < < < < < < | | | | | | | | | | | | | | | | | | | < | 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 | "SELECT id FROM runs WHERE state != 'deleted' ORDER BY event_time DESC;") (reverse run-ids))))) ;; get some basic run stats ;; ;; ( (runname (( state count ) ... )) ;; ( ... (define (db:get-run-stats dbstruct run-id run-name) (let* ((dbdat (db:get-db dbstruct run-id)) (db (db:dbdat-get-db dbdat)) (totals (make-hash-table)) (curr (make-hash-table)) (res '()) (runs-info '())) ;; First get all the runname/run-ids ;; (db:delay-if-busy dbdat) (db:with-db dbstruct run-id #f (lambda (db) (sqlite3:for-each-row (lambda (state status count) (let ((netstate (if (equal? state "COMPLETED") status state))) (if (string? netstate) (begin (hash-table-set! totals netstate (+ (hash-table-ref/default totals netstate 0) count)) (hash-table-set! curr netstate (+ (hash-table-ref/default curr netstate 0) count)))))) db "SELECT state,status,count(id) FROM tests AS t GROUP BY state,status ORDER BY state,status DESC;") ;; add the per run counts to res (for-each (lambda (state) (set! res (cons (list run-name state (hash-table-ref curr state)) res))) (sort (hash-table-keys curr) string>=)) (set! curr (make-hash-table)))) (for-each (lambda (state) (set! res (cons (list "Totals" state (hash-table-ref totals state)) res))) (sort (hash-table-keys totals) string>=)) res)) ;; db:get-runs-by-patt ;; get runs by list of criteria |
︙ | ︙ | |||
3160 3161 3162 3163 3164 3165 3166 | (hash-table-set! tests-hash full-testname testdat)))) results) (if (null? tal) (map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests (loop (car tal)(cdr tal)))))))))) (define (db:delay-if-busy dbdat #!key (count 6)) | | | 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 | (hash-table-set! tests-hash full-testname testdat)))) results) (if (null? tal) (map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests (loop (car tal)(cdr tal)))))))))) (define (db:delay-if-busy dbdat #!key (count 6)) (if #f ;; (not (configf:lookup *configdat* "server" "delay-on-busy")) (and dbdat (db:dbdat-get-db dbdat)) (if dbdat (let* ((dbpath (db:dbdat-get-path dbdat)) (db (db:dbdat-get-db dbdat)) ;; we'll return this so (db:delay--if-busy can be called inline (dbfj (conc dbpath "-journal"))) (if (handle-exceptions exn |
︙ | ︙ |
Modified dcommon.scm from [5d1caffec5] to [f2eb55f8d3].
︙ | ︙ | |||
398 399 400 401 402 403 404 | general-matrix)) (define (dcommon:run-stats dbstruct) (let* ((stats-matrix (iup:matrix expand: "YES")) (changed #f) (updater (lambda () | | > > | 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 | general-matrix)) (define (dcommon:run-stats dbstruct) (let* ((stats-matrix (iup:matrix expand: "YES")) (changed #f) (updater (lambda () (let* ((run-stats (if dbstruct (db:get-run-stats dbstruct) (rmt:get-all-run-stats))) (indices (common:sparse-list-generate-index run-stats)) ;; proc: set-cell)) (row-indices (car indices)) (col-indices (cadr indices)) (max-row (if (null? row-indices) 1 (apply max (map cadr row-indices)))) (max-col (if (null? col-indices) 1 (apply max (map cadr col-indices)))) (max-visible (max (- *num-tests* 15) 3)) |
︙ | ︙ |
Modified megatest.scm from [47f4506230] to [a6b3a87608].
︙ | ︙ | |||
325 326 327 328 329 330 331 | (define *watchdog* (make-thread (lambda () (thread-sleep! 0.05) ;; delay for startup (let ((legacy-sync (common:legacy-sync-required)) (debug-mode (debug:debug-mode 1)) (last-time (current-seconds))) | > | | 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 | (define *watchdog* (make-thread (lambda () (thread-sleep! 0.05) ;; delay for startup (let ((legacy-sync (common:legacy-sync-required)) (debug-mode (debug:debug-mode 1)) (last-time (current-seconds))) (if legacy-sync ;; (common:legacy-sync-recommended)) (let loop () ;; sync for filesystem local db writes ;; (let ((start-time (current-seconds)) (servers-started (make-hash-table))) (for-each (lambda (run-id) |
︙ | ︙ |
Modified rmt.scm from [58033889c8] to [1253a2efe8].
︙ | ︙ | |||
620 621 622 623 624 625 626 627 628 629 630 631 632 633 | (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path ": " results) (if (and (null? results) (not (null? tal))) (loop (car tal)(cdr tal)) (if (null? results) #f (car results)))))))))) ;;====================================================================== ;; S T E P S ;;====================================================================== ;; Getting steps is more complicated. ;; ;; If given work area | > > > > > > > > > > > > > > > > > > > > | 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 | (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path ": " results) (if (and (null? results) (not (null? tal))) (loop (car tal)(cdr tal)) (if (null? results) #f (car results)))))))))) ;; call with run-id #f ;; (define (rmt:get-all-run-stats) (let* ((runs-dat (rmt:get-runs "%" #f #f '())) (header (db:get-header runs-dat)) (runs (db:get-rows runs-dat))) (fold (lambda (run currdat) (let* ((run-id (db:get-value-by-header run header "id")) (run-name (db:get-value-by-header run header "runname"))) (if (and run-id run-name) (append (rmt:get-run-stats run-id run-name) currdat) (begin (debug:print 0 "ERROR: Bad run-id or run-name in " run) currdat)))) '() runs))) (define (rmt:get-run-stats run-id run-name) (rmt:send-receive 'get-run-stats run-id (list run-id run-name))) ;;====================================================================== ;; S T E P S ;;====================================================================== ;; Getting steps is more complicated. ;; ;; If given work area |
︙ | ︙ |