Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -821,11 +821,11 @@ (or (args:get-arg "-status")(args:get-arg ":status"))) (define (common:args-get-testpatt rconf) (let* ((tagexpr (args:get-arg "-tagexpr")) (tags-testpatt (if tagexpr (string-join (runs:get-tests-matching-tags tagexpr) ",") #f)) - (testpatt-key (if (args:get-arg "-mode") (args:get-arg "-mode") "TESTPATT")) + (testpatt-key (if (args:get-arg "--modepatt") (args:get-arg "--modepatt") "TESTPATT")) (args-testpatt (or (args:get-arg "-testpatt") (args:get-arg "-runtests") "%")) (rtestpatt (if rconf (runconfigs-get rconf testpatt-key) #f))) (cond (tags-testpatt (debug:print-info 0 *default-log-port* "-tagexpr "tagexpr" selects testpatt "tags-testpatt) @@ -1087,10 +1087,24 @@ (define (common:lazy-modification-time fpath) (handle-exceptions exn 0 (file-modification-time fpath))) + +;; find timestamp of newest file associated with a sqlite db file +(define (common:lazy-sqlite-db-modification-time fpath) + (let* ((glob-list (handle-exceptions + exn + '("/no/such/file") + (glob (conc fpath "*")))) + (file-list (if (eq? 0 (length glob-list)) + '("/no/such/file") + glob-list))) + (apply max + (map + common:lazy-modification-time + file-list)))) ;; return a nice clean pathname made absolute (define (common:nice-path dir) (let ((match (string-match "^(~[^\\/]*)(\\/.*|)$" dir))) (if match ;; using ~ for home? Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -366,15 +366,15 @@ rowsused ;; hash of lists covering what areas used - replace with quadtree hierdat ;; put hierarchial sorted list here tests ;; hash of id => testdat ((tests-by-name (make-hash-table)) : hash-table) ;; hash of testfullname => testdat key-vals - ((last-update 0) : fixnum) ;; last query to db got records from before last-update - ((data-changed #f) : boolean) - ((run-data-offset 0) : number) ;; get only 100 items per call, set back to zero when received less that 100 items - (db-path #f) - ) + ((last-update 0) : number) ;; last query to db got records from before last-update + ((last-db-time 0) : number) ;; last timestamp on megatest.db + ((data-changed #f) : boolean) + ((run-data-offset 0) : number) ;; get only 100 items per call, set back to zero when received less than 100 items + (db-path #f)) ;; register dboard:rundat with BBpp ;; this is used by BBpp (Brandon's pretty printer) to convert dboard:rundat into a composition of lists that pp will handle (hash-table-set! *BBpp_custom_expanders_list* RUNDAT: (cons dboard:rundat? @@ -515,78 +515,87 @@ ;; gets all the tests for run-id that match testnamepatt and key-vals, merges them ;; ;; NOTE: Yes, this is used ;; (define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals) - (let* ((access-mode (dboard:tabdat-access-mode tabdat)) - (num-to-get - (let ((num-tests-from-config (configf:lookup *configdat* "setup" "num-tests-to-get"))) - (if num-tests-from-config - (begin - (BB> "override num-tests 100 -> "num-tests-from-config) - (string->number num-tests-from-config)) - 100))) - (states (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat))) - (statuses (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat))) - (do-not-use-db-file-timestamps #t) ;; (configf:lookup *configdat* "setup" "do-not-use-db-file-timestamps")) ;; this still hosts runs-summary-tab - (do-not-use-query-timestamps #t) ;; (configf:lookup *configdat* "setup" "do-not-use-query-timestamps")) ;; this no longer troubles runs-summary-tab - (sort-info (get-curr-sort)) - (sort-by (vector-ref sort-info 1)) - (sort-order (vector-ref sort-info 2)) - (bubble-type (if (member sort-order '(testname)) - 'testname - 'itempath)) + (let* ((start-time (current-seconds)) + (access-mode (dboard:tabdat-access-mode tabdat)) + (num-to-get (string->number (or (configf:lookup *configdat* "setup" "num-tests-to-get") + "200"))) + (states (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat))) + (statuses (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat))) + (do-not-use-db-file-timestamps #f) ;; (configf:lookup *configdat* "setup" "do-not-use-db-file-timestamps")) ;; this still hosts runs-summary-tab + (do-not-use-query-timestamps #f) ;; (configf:lookup *configdat* "setup" "do-not-use-query-timestamps")) ;; this no longer troubles runs-summary-tab + (sort-info (get-curr-sort)) + (sort-by (vector-ref sort-info 1)) + (sort-order (vector-ref sort-info 2)) + (bubble-type (if (member sort-order '(testname)) + 'testname + 'itempath)) ;; note: the rundat is normally created in "update-rundat". - (run-dat (or (hash-table-ref/default (dboard:tabdat-allruns-by-id tabdat) run-id #f) - (let ((rd (dboard:rundat-make-init run: run key-vals: key-vals))) - (hash-table-set! (dboard:tabdat-allruns-by-id tabdat) run-id rd) - rd))) + (run-dat (or (hash-table-ref/default (dboard:tabdat-allruns-by-id tabdat) run-id #f) + (let ((rd (dboard:rundat-make-init run: run key-vals: key-vals))) + (hash-table-set! (dboard:tabdat-allruns-by-id tabdat) run-id rd) + rd))) ;; (prev-tests (dboard:rundat-tests prev-dat)) ;; (vector-ref prev-dat 1)) - (last-update - (if do-not-use-query-timestamps - 0 - (dboard:rundat-last-update run-dat) - ;;(hash-table-ref/default (dboard:tabdat-run-update-times tabdat) run-id 0) - )) - - (db-path (or (dboard:rundat-db-path run-dat) - (let* ((db-dir (tasks:get-task-db-path)) - (db-pth (conc db-dir "/" run-id ".db"))) - (dboard:rundat-db-path-set! run-dat db-pth) - db-pth))) - (tmptests (if (or do-not-use-db-file-timestamps - (>= (common:lazy-modification-time db-path) last-update)) - (db:dispatch-query access-mode rmt:get-tests-for-run db:get-tests-for-run - run-id testnamepatt states statuses ;; run-id testpatt states statuses - (dboard:rundat-run-data-offset run-dat) - num-to-get - (dboard:tabdat-hide-not-hide tabdat) ;; no-in - sort-by ;; sort-by - sort-order ;; sort-order - #f ;; 'shortlist ;; qrytype - (if (dboard:tabdat-filters-changed tabdat) - 0 - last-update) ;; last-update - *dashboard-mode*) ;; use dashboard mode - '())) + (last-update (if (or do-not-use-query-timestamps + (dboard:tabdat-filters-changed tabdat)) + 0 + (dboard:rundat-last-update run-dat))) + (last-db-time (if do-not-use-db-file-timestamps + 0 + (dboard:rundat-last-db-time run-dat))) + (db-path (or (dboard:rundat-db-path run-dat) + (let* ((db-dir (common:get-db-tmp-area)) + (db-pth (conc db-dir "/megatest.db"))) + (dboard:rundat-db-path-set! run-dat db-pth) + 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) + (db:dispatch-query access-mode rmt:get-tests-for-run db: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 + *dashboard-mode*) ;; use dashboard mode + '())) (use-new (dboard:tabdat-hide-not-hide tabdat)) (tests-ht (if (dboard:tabdat-filters-changed tabdat) (let ((ht (make-hash-table))) (dboard:rundat-tests-set! run-dat ht) ht) - (dboard:rundat-tests run-dat)))) - ;;(start-time (current-seconds))) + (dboard:rundat-tests run-dat))) + (got-all (< (length tmptests) num-to-get)) ;; got all for this round + ) + + ;; if we saw the db modified, reset it (the signal has already been used) + (if (and got-all ;; (not multi-get) + db-modified) + (dboard:rundat-last-db-time-set! run-dat (- start-time 2))) ;; to limit the amount of data transferred each cycle use limit of num-to-get and offset - (dboard:rundat-run-data-offset-set! - run-dat - (if (< (length tmptests) num-to-get) - 0 - (let ((newval (+ num-to-get (dboard:rundat-run-data-offset run-dat)))) - ;; (print "Incremental get, offset=" (dboard:rundat-run-data-offset run-dat) " retrieved: " (length tmptests) " newval: " newval) - newval))) - + ;; DO NOT bump time indexes last-update and last-db-time until all the first pass of the + ;; data has been read + ;; set last-update to 0 if still getting data incrementally ;; NO NEED, handled above + ;; + ;; (debug:print 0 *default-log-port* "got-all: " got-all " multi-get: " multi-get " num-to-get: " num-to-get " (length tmptests): " (length tmptests) " db-modified: " db-modified " db-mod-time: " db-mod-time " db-path: " db-path) + (if got-all + (begin + (dboard:rundat-last-update-set! run-dat (- start-time 2)) + (dboard:rundat-run-data-offset-set! run-dat 0)) + (begin + (dboard:rundat-run-data-offset-set! run-dat + (+ num-to-get (dboard:rundat-run-data-offset run-dat))))) + (for-each (lambda (tdat) (let ((test-id (db:test-get-id tdat)) (state (db:test-get-state tdat))) (dboard:rundat-data-changed-set! run-dat #t) @@ -593,22 +602,10 @@ (if (equal? state "DELETED") (hash-table-delete! tests-ht test-id) (hash-table-set! tests-ht test-id tdat)))) tmptests) - ;; set last-update to 0 if still getting data incrementally - - (if (> (dboard:rundat-run-data-offset run-dat) 0) - (begin - ;; (print "run-data-offset: " (dboard:rundat-run-data-offset run-dat) ", setting last-update to 0") - ;; (dboard:rundat-last-update-set! run-dat 0) - (dboard:rundat-last-update-set! run-dat 0)) - ;; (hash-table-set! (dboard:tabdat-run-update-times tabdat) run-id (- start-time 3)) - - (dboard:rundat-last-update-set! run-dat (- (current-seconds) 2))) ;; go back two seconds in time to ensure all changes are captured. - - ;; (debug:print-info 0 *default-log-port* "tests-ht: " (hash-table-keys tests-ht)) tests-ht)) ;; tmptests - new tests data ;; prev-tests - old tests data ;; @@ -2692,11 +2689,11 @@ (get-environment-variable "DASHBOARDROWS") "15")))) (define *tim* (iup:timer)) (define *ord* #f) -(iup:attribute-set! *tim* "TIME" 300) +(iup:attribute-set! *tim* "TIME" 300 ) (iup:attribute-set! *tim* "RUN" "YES") (define *last-recalc-ended-time* 0) (define (dashboard:recalc modtime please-update-buttons last-db-update-time) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -145,11 +145,11 @@ dbstruct)) (use-mutex (> *api-process-request-count* 25))) (if (and use-mutex (common:low-noise-print 120 "over-50-parallel-api-requests")) (debug:print-info 0 *default-log-port* *api-process-request-count* " parallel api requests being processed in process " (current-process-id) ", throttling access")) - (if (common:low-noise-print 120 (conc "parallel-api-requests" *max-api-process-requests*)) + (if (common:low-noise-print 600 (conc "parallel-api-requests" *max-api-process-requests*)) (debug:print-info 0 *default-log-port* "Parallel api request count: " *api-process-request-count* " max parallel requests: " *max-api-process-requests*)) (handle-exceptions exn (begin (print-call-chain (current-error-port)) Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -1,7 +1,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.6304) +(define megatest-version 1.6305) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -67,10 +67,11 @@ version " megatest-version " license GPL, Copyright Matt Welland 2006-2015 Usage: megatest [options] -h : this help + -manual : show the Megatest user manual -version : print megatest version (currently " megatest-version ") Launching and managing runs -runall : run all tests or as specified by -testpatt -remove-runs : remove the data for a run, requires -runname and -testpatt @@ -93,11 +94,11 @@ -reqtarg key1/key2/... : run for key1, key2, etc. but key1/key2 must be in runconfig -testpatt patt1/patt2,patt3/... : % is wildcard -runname : required, name for this particular test run -state : Applies to runs, tests or steps depending on context -status : Applies to runs, tests or steps depending on context - -mode key : load testpatt from in runconfigs instead of default TESTPATT + --modepatt key : load testpatt from in runconfigs instead of default TESTPATT if -testpatt and -tagexpr are not specified -tagexpr tag1,tag2%,.. : select tests with tags matching expression Test helpers (for use inside tests) -step stepname -test-status : set the state and status of a test (use :state and :status) @@ -212,11 +213,11 @@ "-state" ":status" "-status" "-list-runs" "-testpatt" - "-mode" + "--modepatt" "-tagexpr" "-itempatt" "-setlog" "-set-toplog" "-runstep" Index: utils/homehost_check.sh ================================================================== --- utils/homehost_check.sh +++ utils/homehost_check.sh @@ -1,6 +1,6 @@ -#!/bin/sh +#! /bin/bash #exits 1 when current host is not homehost. if [[ ! -e .homehost ]]; then exit 0 Index: utils/mk_wrapper ================================================================== --- utils/mk_wrapper +++ utils/mk_wrapper @@ -27,10 +27,22 @@ # echo "exec $prefix/bin/.\$(lsb_release -sr)/$cmd \"\$@\"" >> $target echo "#!/bin/bash" > $target if [[ $cmd =~ dboard ]]; then cat >> $target <<'EOF' + +# disable if not running on homehost +if [[ -e .homehost ]]; then + homehostname=$( host `cat .homehost` | awk '{print $NF}' | sed 's/\.$//' ) + hostname=$( hostname -f ) + + if [[ ! ($homehostname == $hostname) ]]; then + echo "ERROR: this host ($hostname) is not the homehost ($homehostname) for this megatest run area. Cannot start dashboard." + echo " Please log into homehost before launching dashboard." + exit 1 + fi +fi # check that $DISPLAY is set if [[ -z $DISPLAY ]]; then echo 'ERROR: $DISPLAY environment variable is not set; megatest dashboard requires X display address to be set in $DISPLAY.' exit 1