Overview
Comment: | wip |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65-try3 |
Files: | files | file ages | folders |
SHA1: |
d6f3b7c58c9ec886897422a482ca2512 |
User & Date: | matt on 2019-11-03 20:36:44 |
Other Links: | branch diff | manifest | tags |
Context
2019-11-03
| ||
22:05 | wip-compiles check-in: 566a3b0cf8 user: matt tags: v1.65-try3 | |
20:36 | wip check-in: d6f3b7c58c user: matt tags: v1.65-try3 | |
19:40 | wip check-in: 016c7dba29 user: matt tags: v1.65-try3 | |
Changes
Modified api-inc.scm from [ec44434b7a] to [611db9dbf8].
︙ | ︙ | |||
70 71 72 73 74 75 76 | get-steps-for-test read-test-data read-test-data* login tasks-get-last testmeta-get-record have-incompletes? | | | 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | get-steps-for-test read-test-data read-test-data* login tasks-get-last testmeta-get-record have-incompletes? ;; synchash-get get-changed-record-ids get-run-record-ids get-not-completed-cnt)) (define api:write-queries '( get-keys-write ;; dummy "write" query to force server start |
︙ | ︙ | |||
273 274 275 276 277 278 279 | ((test-get-records-for-index-file) (apply db:test-get-records-for-index-file dbstruct params)) ((get-testinfo-state-status) (apply db:get-testinfo-state-status dbstruct params)) ((test-get-top-process-pid) (apply db:test-get-top-process-pid dbstruct params)) ((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params)) ((get-prereqs-not-met) (apply db:get-prereqs-not-met dbstruct params)) ((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id dbstruct params)) ((get-not-completed-cnt) (apply db:get-not-completed-cnt dbstruct params)) | | | 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 | ((test-get-records-for-index-file) (apply db:test-get-records-for-index-file dbstruct params)) ((get-testinfo-state-status) (apply db:get-testinfo-state-status dbstruct params)) ((test-get-top-process-pid) (apply db:test-get-top-process-pid dbstruct params)) ((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params)) ((get-prereqs-not-met) (apply db:get-prereqs-not-met dbstruct params)) ((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id dbstruct params)) ((get-not-completed-cnt) (apply db:get-not-completed-cnt dbstruct params)) ;; ((synchash-get) (apply synchash:server-get dbstruct params)) ((get-raw-run-stats) (apply db:get-raw-run-stats dbstruct params)) ((get-test-times) (apply db:get-test-times dbstruct params)) ;; RUNS ((get-run-info) (apply db:get-run-info dbstruct params)) ((get-run-status) (apply db:get-run-status dbstruct params)) ((get-run-state) (apply db:get-run-state dbstruct params)) |
︙ | ︙ |
Modified common-inc.scm from [243b419338] to [0cd45c61d6].
︙ | ︙ | |||
869 870 871 872 873 874 875 | (define (common:get-db-tmp-area . junk) (if *db-cache-path* *db-cache-path* (if *toppath* ;; common:get-create-writeable-dir (handle-exceptions exn (begin | | | 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 | (define (common:get-db-tmp-area . junk) (if *db-cache-path* *db-cache-path* (if *toppath* ;; common:get-create-writeable-dir (handle-exceptions exn (begin (debug:print-error 0 *default-log-port* "Couldn't create path to " *db-cache-path*) (exit 1)) (let ((dbpath (common:get-create-writeable-dir (list (conc "/tmp/" (current-user-name) "/megatest_localdb/" (common:get-testsuite-name) "/" (string-translate *toppath* "/" ".")))))) ;; #t)))) (set! *db-cache-path* dbpath) |
︙ | ︙ |
Modified configf-inc.scm from [66ff6bae7e] to [18b89c30b2].
︙ | ︙ | |||
647 648 649 650 651 652 653 | (set! sechash newhash)) (set! sechash section-hash)) (set! new hed) ;; will append this at the bottom of the loop (set! secname section-name) )) ;; No need to process key cmd, let it fall though to key val (configf:key-val-pr ( x key val ) | | | 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 | (set! sechash newhash)) (set! sechash section-hash)) (set! new hed) ;; will append this at the bottom of the loop (set! secname section-name) )) ;; No need to process key cmd, let it fall though to key val (configf:key-val-pr ( x key val ) (let ((newval (config-lookup indat secname key))) ;; was sec, bug or correct? ;; can handle newval == #f here => that means key is removed (cond ((equal? newval val) (set! res (append res (list hed)))) ((not newval) ;; key has been removed (set! new #f)) ((not (equal? newval val)) |
︙ | ︙ |
Modified dashboard.scm from [1630992df3] to [4053038c34].
︙ | ︙ | |||
2421 2422 2423 2424 2425 2426 2427 | (define *tim* (iup:timer)) (define *ord* #f) (iup:attribute-set! *tim* "TIME" (or (configf:lookup *configdat* "dashboard" "poll-interval") "1000")) (iup:attribute-set! *tim* "RUN" "YES") (define *last-recalc-ended-time* 0) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 | (define *tim* (iup:timer)) (define *ord* #f) (iup:attribute-set! *tim* "TIME" (or (configf:lookup *configdat* "dashboard" "poll-interval") "1000")) (iup:attribute-set! *tim* "RUN" "YES") (define *last-recalc-ended-time* 0) ;; (define *monitor-db-path* #f) (define *last-monitor-update-time* 0) ;; Force creation of the db in case it isn't already there. ;; (tasks:open-db) ;;Not reference anywhere ;; ;; can a bar be placed in row "rownum" covering x1 to x2 without overlapping with existing ;; bars? Use num-rows to check that a block will fit from rownum to (+ rownum num-rows) ;; (define (dashboard:row-collision rowhash rownum x1 x2 #!key (num-rows #f)) (let ((lastrow (if num-rows (+ rownum num-rows) rownum))) |
︙ | ︙ |
Modified db_records.scm from [37c233f08b] to [f694be569d].
︙ | ︙ | |||
74 75 76 77 78 79 80 | ;; (dbr:dbstruct-path-set! v path) ;; (dbr:dbstruct-local-set! v local) ;; (dbr:dbstruct-locdbs-set! v (make-hash-table)) ;; v)) ;; Returns the database for a particular run-id fron the dbstruct:localdbs ;; | | | | 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 | ;; (dbr:dbstruct-path-set! v path) ;; (dbr:dbstruct-local-set! v local) ;; (dbr:dbstruct-locdbs-set! v (make-hash-table)) ;; v)) ;; Returns the database for a particular run-id fron the dbstruct:localdbs ;; #;(define (dbr:dbstruct-localdb v run-id) (hash-table-ref/default (dbr:dbstruct-locdbs v) run-id #f)) #;(define (dbr:dbstruct-localdb-set! v run-id db) (hash-table-set! (dbr:dbstruct-locdbs v) run-id db)) (define (make-db:test)(make-vector 20)) (define-inline (db:test-get-id vec) (vector-ref vec 0)) (define-inline (db:test-get-run_id vec) (vector-ref vec 1)) (define-inline (db:test-get-testname vec) (vector-ref vec 2)) |
︙ | ︙ |
Modified dcommon-inc.scm from [938895af07] to [9124642923].
︙ | ︙ | |||
125 126 127 128 129 130 131 | ;; modify a cell if the data is changed, return #t or-ed with previous if modified, #f elsewise ;; (define (dcommon:modifiy-if-different mtrx cell-name new-val prev-changed) (let ((curr-val (iup:attribute mtrx cell-name))) (if (not (equal? curr-val new-val)) (begin | | | 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 | ;; modify a cell if the data is changed, return #t or-ed with previous if modified, #f elsewise ;; (define (dcommon:modifiy-if-different mtrx cell-name new-val prev-changed) (let ((curr-val (iup:attribute mtrx cell-name))) (if (not (equal? curr-val new-val)) (begin (iup:attribute-set! mtrx cell-name new-val) ;; was col-name #t) ;; need a re-draw prev-changed))) ;; TO-DO ;; 1. Make "data" hash-table hierarchial store of all displayed data ;; 2. Update synchash to understand "get-runs", "get-tests" etc. |
︙ | ︙ | |||
1388 1389 1390 1391 1392 1393 1394 1395 | (if (and (eq? (dboard:commondat-curr-tab-num commondat) 0) (or (> monitor-modtime *last-monitor-update-time*) (> (- run-update-time *last-monitor-update-time*) 5))) ;; update every 1/2 minute just in case (begin (set! *last-monitor-update-time* run-update-time) ;; monitor-modtime) #t) #f))) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 | (if (and (eq? (dboard:commondat-curr-tab-num commondat) 0) (or (> monitor-modtime *last-monitor-update-time*) (> (- run-update-time *last-monitor-update-time*) 5))) ;; update every 1/2 minute just in case (begin (set! *last-monitor-update-time* run-update-time) ;; monitor-modtime) #t) #f))) ;; DOES NOT WORK RELIABLY WITH /tmp WAL mode files. Timestamps only change when the db ;; is closed (I think). If db dir starts with /tmp always return true ;; (define (dashboard:database-changed? commondat tabdat #!key (context-key 'default)) (let* ((run-update-time (current-seconds)) (dbdir (dboard:tabdat-dbdir tabdat)) (modtime (dashboard:get-youngest-run-db-mod-time dbdir)) (recalc (dashboard:recalc modtime (dboard:commondat-please-update commondat) (dboard:get-last-db-update tabdat context-key)))) ;; (dboard:tabdat-last-db-update tabdat)))) (if recalc (dboard:set-last-db-update! tabdat context-key run-update-time)) (dboard:commondat-please-update-set! commondat #f) recalc)) (define (dashboard:get-youngest-run-db-mod-time dbdir) (handle-exceptions exn (begin (debug:print 2 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn) " db-dir="dbdir) (current-seconds)) ;; something went wrong - just print an error and return current-seconds (common:max (map (lambda (filen) (file-modification-time filen)) (glob (conc dbdir "/*.db*")))))) (define (dboard:get-last-db-update tabdat context) (hash-table-ref/default (dboard:tabdat-last-db-update tabdat) context 0)) (define (dboard:set-last-db-update! tabdat context newtime) (hash-table-set! (dboard:tabdat-last-db-update tabdat) context newtime)) ;; point inside line ;; (define-inline (dashboard:px-between px lx1 lx2) (and (< lx1 px)(> lx2 px))) (define (dashboard:recalc modtime please-update-buttons last-db-update-time) (or please-update-buttons (and ;; (> (current-milliseconds)(+ *last-recalc-ended-time* 150)) ;; can't use this - it needs to be tab specific (> modtime (- last-db-update-time 3)) ;; add three seconds of margin (> (current-seconds)(+ last-db-update-time 1))))) |
Modified megamod.scm from [7c1e7c9cb3] to [c04176f17d].
︙ | ︙ | |||
143 144 145 146 147 148 149 150 151 152 153 154 155 156 | (include "megatest-fossil-hash.scm") (include "megatest-version.scm") ;; globals (define *writes-total-delay* 0) (define *exit-started* #f) (define *tim* (iup:timer)) ;; The watchdog is to keep an eye on things like db sync etc. ;; ;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage | > | 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 | (include "megatest-fossil-hash.scm") (include "megatest-version.scm") ;; globals (define *writes-total-delay* 0) (define *exit-started* #f) (define *last-monitor-update-time* 0) (define *tim* (iup:timer)) ;; The watchdog is to keep an eye on things like db sync etc. ;; ;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage |
︙ | ︙ |
Modified rmt-inc.scm from [da7bfbaed8] to [4c2ae2a597].
︙ | ︙ | |||
513 514 515 516 517 518 519 | (debug:print 0 *default-log-port* "WARNING: Bad data handed to rmt:get-test-info-by-id run-id=" run-id ", test-id=" test-id) (print-call-chain (current-error-port)) #f))) (define (rmt:test-get-rundir-from-test-id run-id test-id) (rmt:send-receive 'test-get-rundir-from-test-id run-id (list run-id test-id))) | | | 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 | (debug:print 0 *default-log-port* "WARNING: Bad data handed to rmt:get-test-info-by-id run-id=" run-id ", test-id=" test-id) (print-call-chain (current-error-port)) #f))) (define (rmt:test-get-rundir-from-test-id run-id test-id) (rmt:send-receive 'test-get-rundir-from-test-id run-id (list run-id test-id))) (define (rmt:open-test-db-by-test-id run-id test-id #!key (work-area #f)) (let* ((test-path (if (string? work-area) work-area (rmt:test-get-rundir-from-test-id run-id test-id)))) (debug:print 3 *default-log-port* "TEST PATH: " test-path) (open-test-db test-path))) ;; WARNING: This currently bypasses the transaction wrapped writes system |
︙ | ︙ |
Modified tdb-inc.scm from [589ce570e2] to [d3c11dafac].
︙ | ︙ | |||
55 56 57 58 59 60 61 | (sqlite3:open-database ":memory:")) ;; open an in-memory db to allow readonly access (if (or work-area-writeable dbexists) (sqlite3:open-database dbpath) (sqlite3:open-database ":memory:")))) (tdb-writeable (and (file-write-access? work-area) (file-write-access? dbpath))) | | | | | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | (sqlite3:open-database ":memory:")) ;; open an in-memory db to allow readonly access (if (or work-area-writeable dbexists) (sqlite3:open-database dbpath) (sqlite3:open-database ":memory:")))) (tdb-writeable (and (file-write-access? work-area) (file-write-access? dbpath))) (handler (sqlite3:make-busy-timeout (if (args:get-arg "-override-timeout") (string->number (args:get-arg "-override-timeout")) 136000)))) (if (and tdb-writeable *db-write-access*) (sqlite3:set-busy-handler! db handler)) (if (not dbexists) (begin (db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = FULL;") |
︙ | ︙ |